moduleNetwork.WindowsLive.App(App,AppID,appId,new,decode,verifier)whereimportControl.Monad(replicateM,liftM)importControl.Monad.Error(MonadError)importqualifiedText.ParserCombinators.ParsecasParsecimportqualifiedNetwork.WindowsLive.SecretasSecretimportqualifiedCodec.Binary.Base64asBase64importqualifiedCodec.Encryption.AESasAESimportCodec.Encryption.Modes(unCbc)importCodec.Utils(Octet,fromOctets,toOctets,listFromOctets)importControl.Monad(when)importqualifiedData.Digest.SHA256asSHA256importData.HMAC(hmac,HashMethod(..))importData.LargeWord(Word128)importData.List.Split(splitOn)importData.Time.Clock.POSIX(POSIXTime)importNetwork.URI(unEscapeString)importData.URLEncoded((%=),(%&),URLEncoded)importqualifiedData.URLEncodedasURLEnc-- |Create a new 'App', validating the Application ID and Secret keynew::MonadErrorem=>String->String->mAppnewappIdStrsecretStr=dovalidateAppIdappIdStrAppappIdStr`liftM`Secret.newsecretStrvalidateAppId::MonadErrorem=>String->m()validateAppId=either(fail.show)(const$return()).Parsec.parse(replicateM16Parsec.hexDigit)"appid"-- |Visit-- <https://lx.azure.microsoft.com/Cloud/Provisioning/Default.aspx> to-- get your application's Application ID and Secret keydataApp=App{appId::AppID,secret::Secret.Secret}typeAppID=StringencryptionKey::App->Secret.KeyencryptionKey=Secret.encryptionKey.secretsigningKey::App->Secret.KeysigningKey=Secret.signingKey.secret-- |Decrypt a token (failing if it cannot be decrypted)decodeOnly::MonadErrorem=>App->String->mStringdecodeOnlyapptokStr=do-- First, the string is URL-unescaped and base64 decodedencryptedBytes<-u64tokStrwhen(nullencryptedBytes)$fail"Missing initialization vector"when((lengthencryptedBytes`mod`16)/=0)$fail"Attempted to decode invalid token"-- Second, the IV is extracted from the first 16 bytes of the stringletinitVector:encryptedBlocks=toBlocksencryptedBytes-- Finally, the string is decrypted using the encryption keykey=fromOctets(256::Integer)$encryptionKeyapp::Word128decryptedBlocks=unCbcAES.decryptinitVectorkeyencryptedBlocksreturn$stripEOT$toStringdecryptedBlocks-- |Decode, validate, and parse a String containing x-www-urlencoded-- |data encrypted with this application's secretdecode::MonadErrorem=>App->String->mURLEncodeddecodeapps=dodecoded<-decodeOnlyappsvalidateappdecodedURLEnc.importStringdecoded-- |decode a Base64 encoded, URL-escaped string into a sequence of bytesu64::MonadErrorem=>String->m[Octet]u64str=caseBase64.decode$unEscapeStringstrofNothing->fail"Data was not valid base64"Justbs->returnbs-- |Check the signature of this token (failing if it is not valid)validate::MonadErrorem=>App->String->m()validateapptok=do(body,sig)<-casesplitOn"&sig="tokof[b,s]->return(b,s)[_]->fail$"No sig found: "++showtokunexpected->fail$"More than one sig found: "++showunexpectedextractedSig<-u64sigletcalculatedSig=signappbodywhen(extractedSig/=calculatedSig)$fail$"Signature did not match: extracted="++showextractedSig++" /= calculated="++showcalculatedSigsign::App->String->[Octet]signapp=hmac(HashMethodSHA256.hash512)(signingKeyapp).toBytesstripEOT::String->StringstripEOT=reverse.dropWhile(=='\EOT').reversetoBytes::String->[Octet]toBytes=map(toEnum.fromEnum)toString::[Word128]->StringtoString=map(toEnum.fromEnum).concatMap(toOctets(256::Integer))toBlocks::[Octet]->[Word128]toBlocks=reverse.listFromOctets.reverse-- |Generate an application verifier to prove to the server that we-- know the secret and application IDverifier::App->POSIXTime->URLEncodedverifierappts=letq="appid"%=appIdapp%&"ts"%=show(roundts::Integer)sig=Base64.encode$signapp$URLEnc.exportqinq%&"sig"%=sig