{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}{-|
Maintainer: Thomas.DuBuisson@gmail.com
Stability: beta
Portability: portable
This is the heart of the crypto-api package. By making (or having)
an instance of Hash, AsymCipher, BlockCipher or StreamCipher you provide (or obtain)
access to any infrastructure built on these primitives include block cipher modes
of operation, hashing, hmac, signing, etc. These classes allow users to build
routines that are agnostic to the algorithm used so changing algorithms is as simple
as changing a type signature.
-}moduleCrypto.Classes(-- * Hash class and helper functionsHash(..),hashFunc,hashFunc'-- * Cipher classes and helper functions,BlockCipher(..),blockSizeBytes,keyLengthBytes,buildKeyIO,StreamCipher(..),buildStreamKeyIO,AsymCipher(..),buildKeyPairIO,Signing(..),buildSigningKeyPairIO-- * Misc helper functions,encode,incIV,moduleCrypto.Util)whereimportData.SerializeimportqualifiedData.ByteString.LazyasLimportqualifiedData.ByteStringasBimportqualifiedData.ByteString.InternalasIimportData.ByteString.Unsafe(unsafeUseAsCStringLen)importControl.Monad.Trans.Class(lift)importControl.Monad.Trans.State(StateT(..),runStateT)importData.Bits((.|.),xor,shiftR)importData.List(foldl',genericDrop)importData.Word(Word8,Word16,Word64)importData.TaggedimportCrypto.TypesimportCrypto.RandomimportCrypto.UtilimportSystem.IO.Unsafe(unsafePerformIO)importForeign(Ptr)importForeign.C(CChar(..),CInt(..))importSystem.Entropy-- |The Hash class is intended as the generic interface-- targeted by maintainers of Haskell digest implementations.-- Using this generic interface, higher level functions-- such as 'hash' and 'hash'' provide a useful API-- for comsumers of hash implementations.---- Any instantiated implementation must handle unaligned data.---- Minimum complete definition: 'outputLength', 'blockLength', 'initialCtx',-- 'updateCtx', and 'finalize'.class(Serialized,Eqd,Ordd)=>Hashctxd|d->ctx,ctx->dwhereoutputLength::TaggeddBitLength-- ^ The size of the digest when encodedblockLength::TaggeddBitLength-- ^ The amount of data operated on in each round of the digest computationinitialCtx::ctx-- ^ An initial context, provided with the first call to 'updateCtx'updateCtx::ctx->B.ByteString->ctx-- ^ Used to update a context, repeatedly called until all data is exhausted-- must operate correctly for imputs of @n*blockLength@ bytes for @n `elem` [0..]@finalize::ctx->B.ByteString->d-- ^ Finializing a context, plus any message data less than the block size, into a digest-- |Hash a lazy ByteString, creating a digesthash::(Hashctxd)=>L.ByteString->dhashmsg=reswhereres=finalizectxendctx=foldl'updateCtxinitialCtxblks(blks,end)=makeBlocksmsgblockLenblockLen=(blockLength.::.res)`div`8-- |Hash a strict ByteString, creating a digesthash'::(Hashctxd)=>B.ByteString->dhash'msg=reswhereres=finalize(updateCtxinitialCtxtop)end(top,end)=B.splitAtremlenmsgremlen=B.lengthmsg-(B.lengthmsg`rem`bLen)bLen=blockLength`for`res`div`8-- |Obtain a lazy hash function whose result is the same type-- as the given digest, which is discarded. If the type is already inferred then-- consider using the 'hash' function instead.hashFunc::Hashcd=>d->(L.ByteString->d)hashFuncd=fwheref=hasha=fundefined`asTypeOf`d-- |Obtain a strict hash function whose result is the same type-- as the given digest, which is discarded. If the type is already inferred then-- consider using the 'hash'' function instead.hashFunc'::Hashcd=>d->(B.ByteString->d)hashFunc'd=fwheref=hash'a=fundefined`asTypeOf`d{-# INLINABLE makeBlocks #-}makeBlocks::L.ByteString->ByteLength->([B.ByteString],B.ByteString)makeBlocksmsglen=go(L.toChunksmsg)wherego[]=([],B.empty)go(x:xs)|B.lengthx>=len=letl=B.lengthx-B.lengthx`rem`len(top,end)=B.splitAtlx(rest,trueEnd)=go(end:xs)in(top:rest,trueEnd)|otherwise=casexsof[]->([],x)(a:as)->go(B.appendxa:as)-- |The BlockCipher class is intended as the generic interface-- targeted by maintainers of Haskell cipher implementations.-- Using this generic interface higher level functions-- such as 'cbc', and other functions from Data.Crypto.Modes, provide a useful API-- for comsumers of cipher implementations.---- Instances must handle unaligned dataclass(Serializek)=>BlockCipherkwhereblockSize::TaggedkBitLength-- ^ The size of a single block; the smallest unit on which the cipher operates.encryptBlock::k->B.ByteString->B.ByteString-- ^ encrypt data of size @n*blockSize@ where @n `elem` [0..]@ (ecb encryption)decryptBlock::k->B.ByteString->B.ByteString-- ^ decrypt data of size @n*blockSize@ where @n `elem` [0..]@ (ecb decryption)buildKey::B.ByteString->Maybek-- ^ smart constructor for keys from a bytestring.keyLength::TaggedkBitLength-- ^ length of the cryptographic key-- * Modes of operation over strict bytestrings-- | Electronic Cookbook (encryption)ecb::k->B.ByteString->B.ByteStringecb=modeEcb'-- | Electronic Cookbook (decryption)unEcb::k->B.ByteString->B.ByteStringunEcb=modeUnEcb'-- | Cipherblock Chaining (encryption)cbc::k->IVk->B.ByteString->(B.ByteString,IVk)cbc=modeCbc'-- | Cipherblock Chaining (decryption)unCbc::k->IVk->B.ByteString->(B.ByteString,IVk)unCbc=modeUnCbc'-- | Counter (encryption)ctr::k->IVk->B.ByteString->(B.ByteString,IVk)ctr=modeCtr'incIV-- | Counter (decryption)unCtr::k->IVk->B.ByteString->(B.ByteString,IVk)unCtr=modeUnCtr'incIV-- | Ciphertext feedback (encryption)cfb::k->IVk->B.ByteString->(B.ByteString,IVk)cfb=modeCfb'-- | Ciphertext feedback (decryption)unCfb::k->IVk->B.ByteString->(B.ByteString,IVk)unCfb=modeUnCfb'-- | Output feedback (encryption)ofb::k->IVk->B.ByteString->(B.ByteString,IVk)ofb=modeOfb'-- | Output feedback (decryption)unOfb::k->IVk->B.ByteString->(B.ByteString,IVk)unOfb=modeUnOfb'-- |The number of bytes in a block cipher blockblockSizeBytes::(BlockCipherk)=>TaggedkByteLengthblockSizeBytes=fmap(`div`8)blockSize-- |The number of bytes in a block cipher key (assuming it is an even-- multiple of 8 bits)keyLengthBytes::(BlockCipherk)=>TaggedkByteLengthkeyLengthBytes=fmap(`div`8)keyLength-- |Build a symmetric key using the system entropy (see 'System.Crypto.Random')buildKeyIO::(BlockCipherk)=>IOkbuildKeyIO=buildKeyMgetEntropyfail-- |Build a symmetric key using a given 'Crypto.Random.CryptoRandomGen'buildKeyGen::(BlockCipherk,CryptoRandomGeng)=>g->EitherGenError(k,g)buildKeyGen=runStateT(buildKeyM(StateT.genBytes)(lift.Left.GenErrorOther))buildKeyM::(BlockCipherk,Monadm)=>(Int->mB.ByteString)->(String->mk)->mkbuildKeyMgetMoreerr=go(0::Int)wherego1000=err"Tried 1000 times to generate a key from the system entropy.\
\ No keys were returned! Perhaps the system entropy is broken\
\ or perhaps the BlockCipher instance being used has a non-flat\
\ keyspace."goi=doletbs=keyLengthkd<-getMore((7+untagbs)`div`8)casebuildKeykdofNothing->go(i+1)Justk->return$k`asTaggedTypeOf`bs-- |Asymetric ciphers (common ones being RSA or EC based)class(Serializep,Serializev)=>AsymCipherpv|p->v,v->pwherebuildKeyPair::CryptoRandomGeng=>g->BitLength->EitherGenError((p,v),g)-- ^ build a public/private key pair using the provided generatorencryptAsym::(CryptoRandomGeng)=>g->p->B.ByteString->EitherGenError(B.ByteString,g)-- ^ Asymetric encryptiondecryptAsym::v->B.ByteString->MaybeB.ByteString-- ^ Asymetric decryptionpublicKeyLength::p->BitLengthprivateKeyLength::v->BitLength-- |Build a pair of asymmetric keys using the system random generator.buildKeyPairIO::AsymCipherpv=>BitLength->IO(EitherGenError(p,v))buildKeyPairIObl=dog<-newGenIO::IOSystemRandomcasebuildKeyPairgblofLefterr->return(Lefterr)Right(k,_)->return(Rightk)-- |Flipped 'buildKeyPair' for ease of use with state monads.buildKeyPairGen::(CryptoRandomGeng,AsymCipherpv)=>BitLength->g->EitherGenError((p,v),g)buildKeyPairGen=flipbuildKeyPair-- | A stream cipher class. Instance are expected to work on messages as small as one byte-- The length of the resulting cipher text should be equal-- to the length of the input message.class(Serializek)=>StreamCipherkiv|k->ivwherebuildStreamKey::B.ByteString->MaybekencryptStream::k->iv->B.ByteString->(B.ByteString,iv)decryptStream::k->iv->B.ByteString->(B.ByteString,iv)streamKeyLength::TaggedkBitLength-- |Build a stream key using the system random generatorbuildStreamKeyIO::StreamCipherkiv=>IOkbuildStreamKeyIO=buildStreamKeyMgetEntropyfail-- |Build a stream key using the provided random generatorbuildStreamKeyGen::(StreamCipherkiv,CryptoRandomGeng)=>g->EitherGenError(k,g)buildStreamKeyGen=runStateT(buildStreamKeyM(StateT.genBytes)(lift.Left.GenErrorOther))buildStreamKeyM::(Monadm,StreamCipherkiv)=>(Int->mB.ByteString)->(String->mk)->mkbuildStreamKeyMgetMoreerr=go(0::Int)wherego1000=err"Tried 1000 times to generate a stream key from the system entropy.\
\ No keys were returned! Perhaps the system entropy is broken\
\ or perhaps the BlockCipher instance being used has a non-flat\
\ keyspace."goi=doletk=streamKeyLengthkd<-getMore((untagk+7)`div`8)casebuildStreamKeykdofNothing->go(i+1)Justk'->return$k'`asTaggedTypeOf`k-- | A class for signing operations which inherently can not be as generic-- as asymetric ciphers (ex: DSA).class(Serializep,Serializev)=>Signingpv|p->v,v->pwheresign::CryptoRandomGeng=>g->v->L.ByteString->EitherGenError(B.ByteString,g)verify::p->L.ByteString->B.ByteString->BoolbuildSigningPair::CryptoRandomGeng=>g->BitLength->EitherGenError((p,v),g)signingKeyLength::v->BitLengthverifyingKeyLength::p->BitLength-- |Build a signing key using the system random generatorbuildSigningKeyPairIO::(Signingpv)=>BitLength->IO(EitherGenError(p,v))buildSigningKeyPairIObl=dog<-newGenIO::IOSystemRandomcasebuildSigningPairgblofLefterr->return$LefterrRight(k,_)->return$Rightk-- |Flipped 'buildSigningPair' for ease of use with state monads.buildSigningKeyPairGen::(Signingpv,CryptoRandomGeng)=>BitLength->g->EitherGenError((p,v),g)buildSigningKeyPairGen=flipbuildSigningPair-- | Like `ecb` but for strict bytestringsmodeEcb'::BlockCipherk=>k->B.ByteString->B.ByteStringmodeEcb'kmsg=letchunks=chunkFor'kmsginB.concat$map(encryptBlockk)chunks{-# INLINE modeEcb' #-}-- |Decryption complement to `ecb'`modeUnEcb'::BlockCipherk=>k->B.ByteString->B.ByteStringmodeUnEcb'kct=letchunks=chunkFor'kctinB.concat$map(decryptBlockk)chunks{-# INLINE modeUnEcb' #-}-- |Cipher block chaining encryption mode on strict bytestringsmodeCbc'::BlockCipherk=>k->IVk->B.ByteString->(B.ByteString,IVk)modeCbc'k(IVv)plaintext=letblks=chunkFor'kplaintext(cts,iv)=goblksvin(B.concatcts,IViv)wherego[]iv=([],iv)go(b:bs)iv=letc=encryptBlockk(zwp'ivb)(cs,ivFinal)=gobscin(c:cs,ivFinal){-# INLINEABLE modeCbc' #-}-- |Cipher block chaining decryption for strict bytestringsmodeUnCbc'::BlockCipherk=>k->IVk->B.ByteString->(B.ByteString,IVk)modeUnCbc'k(IVv)ciphertext=letblks=chunkFor'kciphertext(pts,iv)=goblksvin(B.concatpts,IViv)wherego[]iv=([],iv)go(c:cs)iv=letp=zwp'(decryptBlockkc)iv(ps,ivFinal)=gocscin(p:ps,ivFinal){-# INLINEABLE modeUnCbc' #-}-- |Output feedback mode for strict bytestringsmodeOfb'::BlockCipherk=>k->IVk->B.ByteString->(B.ByteString,IVk)modeOfb'=modeUnOfb'{-# INLINEABLE modeOfb' #-}-- |Output feedback mode for strict bytestringsmodeUnOfb'::BlockCipherk=>k->IVk->B.ByteString->(B.ByteString,IVk)modeUnOfb'k(IViv)msg=letivStr=collect(B.lengthmsg+ivLen)(drop1(iterate(encryptBlockk)iv))ivLen=B.lengthivmLen=fromIntegral(B.lengthmsg)newIV=IV.B.concat.L.toChunks.L.take(fromIntegralivLen).L.dropmLen.L.fromChunks$ivStrin(zwp'(B.concativStr)msg,newIV){-# INLINEABLE modeUnOfb' #-}-- |Counter mode for strict bytestringsmodeCtr'::BlockCipherk=>(IVk->IVk)->k->IVk->B.ByteString->(B.ByteString,IVk)modeCtr'=modeUnCtr'{-# INLINEABLE modeCtr' #-}-- |Counter mode for strict bytestringsmodeUnCtr'::BlockCipherk=>(IVk->IVk)->k->IVk->B.ByteString->(B.ByteString,IVk)modeUnCtr'fkivmsg=letfa(st,IViv)c|B.nullst=fa(encryptBlockkiv,f(IViv))c|otherwise=letJust(s,nst)=B.unconsstin((nst,IViv),xorcs)((_,newIV),res)=B.mapAccumLfa(B.empty,iv)msgin(res,newIV){-# INLINEABLE modeUnCtr' #-}-- |Ciphertext feed-back encryption mode for strict bytestrings (with-- s == blockSize)modeCfb'::BlockCipherk=>k->IVk->B.ByteString->(B.ByteString,IVk)modeCfb'k(IVv)msg=letblks=chunkFor'kmsg(cs,ivF)=govblksin(B.concatcs,IVivF)wheregoiv[]=([],iv)goiv(b:bs)=letc=zwp'(encryptBlockkiv)b(cs,ivFinal)=gocbsin(c:cs,ivFinal){-# INLINEABLE modeCfb' #-}-- |Ciphertext feed-back decryption mode for strict bytestrings (with s == blockSize)modeUnCfb'::BlockCipherk=>k->IVk->B.ByteString->(B.ByteString,IVk)modeUnCfb'k(IVv)msg=letblks=chunkFor'kmsg(ps,ivF)=govblksin(B.concatps,IVivF)wheregoiv[]=([],iv)goiv(b:bs)=letp=zwp'(encryptBlockkiv)b(ps,ivF)=gobbsin(p:ps,ivF){-# INLINEABLE modeUnCfb' #-}chunkFor'::(BlockCipherk)=>k->B.ByteString->[B.ByteString]chunkFor'k=gowhereblkSz=(blockSize`for`k)`div`8gobs|B.lengthbs<blkSz=[]|otherwise=let(blk,rest)=B.splitAtblkSzbsinblk:gorest{-# INLINE chunkFor' #-}-- |Increase an `IV` by one. This is way faster than decoding,-- increasing, encodingincIV::BlockCipherk=>IVk->IVkincIV(IVb)=IV$snd$B.mapAccumR(incw)1bwhereincw::Word16->Word8->(Word16,Word8)incwiw=letnw=i+(fromIntegralw)in(shiftRnw8,fromIntegralnw)-- gather a specified number of bytes from the list of bytestringscollect::Int->[B.ByteString]->[B.ByteString]collect0_=[]collect_[]=[]collecti(b:bs)|len<i=b:collect(i-len)bs|len>=i=[B.takeib]wherelen=B.lengthb{-# INLINE collect #-}