haskell/cryptonite
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

remove all the byteArray prefix from byteArray function.

Browse Source 
instead expect module import to be qualified for functions.
This commit is contained in:
Vincent Hanquez 2015-04-24 06:54:33 +01:00
parent e52a75af75
commit ec4e0c4ed9
20 changed files with 351 additions and 334 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
Crypto/Cipher/AES/Primitive.hs
View File

@ -58,18 +58,19 @@ module Crypto.Cipher.AES.Primitive
, ocbFinish , ocbFinish
) where ) where
import Data.Word import Data.Word
import Foreign.Ptr import Foreign.Ptr
import Foreign.C.Types import Foreign.C.Types
import Foreign.C.String import Foreign.C.String
import Data.ByteString.Internal import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString as B import qualified Data.ByteString as BS
import Crypto.Error import Crypto.Error
import Crypto.Cipher.Types import Crypto.Cipher.Types
import Crypto.Cipher.Types.Block (IV(..)) import Crypto.Cipher.Types.Block (IV(..))
import Crypto.Internal.Compat import Crypto.Internal.Compat
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, SecureBytes, withByteArray)
import qualified Crypto.Internal.ByteArray as B
instance Cipher AES where instance Cipher AES where
cipherName _ = "AES" cipherName _ = "AES"
@ -133,7 +134,7 @@ ivCopyPtr :: IV AES -> (Ptr Word8 -> IO a) -> IO (a, IV AES)
ivCopyPtr (IV iv) f = (\(x,y) -> (x, IV y)) `fmap` copyAndModify iv f ivCopyPtr (IV iv) f = (\(x,y) -> (x, IV y)) `fmap` copyAndModify iv f
where where
copyAndModify :: ByteArray ba => ba -> (Ptr Word8 -> IO a) -> IO (a, ba) copyAndModify :: ByteArray ba => ba -> (Ptr Word8 -> IO a) -> IO (a, ba)
copyAndModify ba f' = byteArrayCopyRet ba f' copyAndModify ba f' = B.copyRet ba f'
withKeyAndIV :: ByteArrayAccess iv => AES -> iv -> (Ptr AES -> Ptr Word8 -> IO a) -> IO a withKeyAndIV :: ByteArrayAccess iv => AES -> iv -> (Ptr AES -> Ptr Word8 -> IO a) -> IO a
withKeyAndIV ctx iv f = keyToPtr ctx $ \kptr -> ivToPtr iv $ \ivp -> f kptr ivp withKeyAndIV ctx iv f = keyToPtr ctx $ \kptr -> ivToPtr iv $ \ivp -> f kptr ivp
@ -145,17 +146,17 @@ withKey2AndIV key1 key2 iv f =
withGCMKeyAndCopySt :: AES -> AESGCM -> (Ptr AESGCM -> Ptr AES -> IO a) -> IO (a, AESGCM) withGCMKeyAndCopySt :: AES -> AESGCM -> (Ptr AESGCM -> Ptr AES -> IO a) -> IO (a, AESGCM)
withGCMKeyAndCopySt aes (AESGCM gcmSt) f = withGCMKeyAndCopySt aes (AESGCM gcmSt) f =
keyToPtr aes $ \aesPtr -> do keyToPtr aes $ \aesPtr -> do
newSt <- byteArrayCopy gcmSt (\_ -> return ()) newSt <- B.copy gcmSt (\_ -> return ())
a <- withByteArray newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr a <- withByteArray newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr
return (a, AESGCM newSt) return (a, AESGCM newSt)
withNewGCMSt :: AESGCM -> (Ptr AESGCM -> IO ()) -> IO AESGCM withNewGCMSt :: AESGCM -> (Ptr AESGCM -> IO ()) -> IO AESGCM
withNewGCMSt (AESGCM gcmSt) f = byteArrayCopy gcmSt (f . castPtr) >>= \sm2 -> return (AESGCM sm2) withNewGCMSt (AESGCM gcmSt) f = B.copy gcmSt (f . castPtr) >>= \sm2 -> return (AESGCM sm2)
withOCBKeyAndCopySt :: AES -> AESOCB -> (Ptr AESOCB -> Ptr AES -> IO a) -> IO (a, AESOCB) withOCBKeyAndCopySt :: AES -> AESOCB -> (Ptr AESOCB -> Ptr AES -> IO a) -> IO (a, AESOCB)
withOCBKeyAndCopySt aes (AESOCB gcmSt) f = withOCBKeyAndCopySt aes (AESOCB gcmSt) f =
keyToPtr aes $ \aesPtr -> do keyToPtr aes $ \aesPtr -> do
newSt <- byteArrayCopy gcmSt (\_ -> return ()) newSt <- B.copy gcmSt (\_ -> return ())
a <- withByteArray newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr a <- withByteArray newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr
return (a, AESOCB newSt) return (a, AESOCB newSt)
@ -168,8 +169,8 @@ initAES k
| len == 24 = CryptoPassed $ initWithRounds 12 | len == 24 = CryptoPassed $ initWithRounds 12
| len == 32 = CryptoPassed $ initWithRounds 14 | len == 32 = CryptoPassed $ initWithRounds 14
| otherwise = CryptoFailed CryptoError_KeySizeInvalid | otherwise = CryptoFailed CryptoError_KeySizeInvalid
where len = byteArrayLength k where len = B.length k
initWithRounds nbR = AES $ byteArrayAllocAndFreeze (16+2*2*16*nbR) aesInit initWithRounds nbR = AES $ B.allocAndFreeze (16+2*2*16*nbR) aesInit
aesInit ptr = withByteArray k $ \ikey -> aesInit ptr = withByteArray k $ \ikey ->
c_aes_init (castPtr ptr) (castPtr ikey) (fromIntegral len) c_aes_init (castPtr ptr) (castPtr ikey) (fromIntegral len)
@ -200,8 +201,8 @@ genCTR :: ByteArray ba
-> Int -- ^ length of bytes required. -> Int -- ^ length of bytes required.
-> ba -> ba
genCTR ctx (IV iv) len genCTR ctx (IV iv) len
| len <= 0 = empty | len <= 0 = B.empty
| otherwise = byteArrayAllocAndFreeze (nbBlocks * 16) generate | otherwise = B.allocAndFreeze (nbBlocks * 16) generate
where generate o = withKeyAndIV ctx iv $ \k i -> c_aes_gen_ctr (castPtr o) k i (fromIntegral nbBlocks) where generate o = withKeyAndIV ctx iv $ \k i -> c_aes_gen_ctr (castPtr o) k i (fromIntegral nbBlocks)
(nbBlocks',r) = len `quotRem` 16 (nbBlocks',r) = len `quotRem` 16
nbBlocks = if r == 0 then nbBlocks' else nbBlocks' + 1 nbBlocks = if r == 0 then nbBlocks' else nbBlocks' + 1
@ -221,11 +222,11 @@ genCounter :: ByteArray ba
-> Int -> Int
-> (ba, IV AES) -> (ba, IV AES)
genCounter ctx iv len genCounter ctx iv len
| len <= 0 = (empty, iv) | len <= 0 = (B.empty, iv)
| otherwise = unsafeDoIO $ | otherwise = unsafeDoIO $
keyToPtr ctx $ \k -> keyToPtr ctx $ \k ->
ivCopyPtr iv $ \i -> ivCopyPtr iv $ \i ->
byteArrayAlloc outputLength $ \o -> do B.alloc outputLength $ \o -> do
c_aes_gen_ctr_cont (castPtr o) k i (fromIntegral nbBlocks) c_aes_gen_ctr_cont (castPtr o) k i (fromIntegral nbBlocks)
where where
(nbBlocks',r) = len `quotRem` 16 (nbBlocks',r) = len `quotRem` 16
@ -246,12 +247,12 @@ encryptCTR :: ByteArray ba
-> ba -- ^ plaintext input -> ba -- ^ plaintext input
-> ba -- ^ ciphertext output -> ba -- ^ ciphertext output
encryptCTR ctx iv input encryptCTR ctx iv input
| len <= 0 = empty | len <= 0 = B.empty
| byteArrayLength iv /= 16 = error $ "AES error: IV length must be block size (16). Its length is: " ++ (show $ byteArrayLength iv) | B.length iv /= 16 = error $ "AES error: IV length must be block size (16). Its length is: " ++ (show $ B.length iv)
| otherwise = byteArrayAllocAndFreeze len doEncrypt | otherwise = B.allocAndFreeze len doEncrypt
where doEncrypt o = withKeyAndIV ctx iv $ \k v -> withByteArray input $ \i -> where doEncrypt o = withKeyAndIV ctx iv $ \k v -> withByteArray input $ \i ->
c_aes_encrypt_ctr (castPtr o) k v i (fromIntegral len) c_aes_encrypt_ctr (castPtr o) k v i (fromIntegral len)
len = byteArrayLength input len = B.length input
-- | encrypt using Galois counter mode (GCM) -- | encrypt using Galois counter mode (GCM)
-- return the encrypted bytestring and the tag associated -- return the encrypted bytestring and the tag associated
@ -347,26 +348,26 @@ doECB :: ByteArray ba
-> AES -> ba -> ba -> AES -> ba -> ba
doECB f ctx input doECB f ctx input
| r /= 0 = error $ "Encryption error: input length must be a multiple of block size (16). Its length is: " ++ (show len) | r /= 0 = error $ "Encryption error: input length must be a multiple of block size (16). Its length is: " ++ (show len)
| otherwise = byteArrayAllocAndFreeze len $ \o -> | otherwise = B.allocAndFreeze len $ \o ->
keyToPtr ctx $ \k -> keyToPtr ctx $ \k ->
withByteArray input $ \i -> withByteArray input $ \i ->
f (castPtr o) k i (fromIntegral nbBlocks) f (castPtr o) k i (fromIntegral nbBlocks)
where (nbBlocks, r) = len `quotRem` 16 where (nbBlocks, r) = len `quotRem` 16
len = byteArrayLength input len = B.length input
{-# INLINE doCBC #-} {-# INLINE doCBC #-}
doCBC :: ByteArray ba doCBC :: ByteArray ba
=> (Ptr b -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()) => (Ptr b -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ())
-> AES -> IV AES -> ba -> ba -> AES -> IV AES -> ba -> ba
doCBC f ctx (IV iv) input doCBC f ctx (IV iv) input
| len == 0 = empty | len == 0 = B.empty
| r /= 0 = error $ "Encryption error: input length must be a multiple of block size (16). Its length is: " ++ (show len) | r /= 0 = error $ "Encryption error: input length must be a multiple of block size (16). Its length is: " ++ (show len)
| otherwise = byteArrayAllocAndFreeze len $ \o -> | otherwise = B.allocAndFreeze len $ \o ->
withKeyAndIV ctx iv $ \k v -> withKeyAndIV ctx iv $ \k v ->
withByteArray input $ \i -> withByteArray input $ \i ->
f (castPtr o) k v i (fromIntegral nbBlocks) f (castPtr o) k v i (fromIntegral nbBlocks)
where (nbBlocks, r) = len `quotRem` 16 where (nbBlocks, r) = len `quotRem` 16
len = byteArrayLength input len = B.length input
{-# INLINE doXTS #-} {-# INLINE doXTS #-}
doXTS :: ByteArray ba doXTS :: ByteArray ba
@ -377,12 +378,12 @@ doXTS :: ByteArray ba
-> ba -> ba
-> ba -> ba
doXTS f (key1,key2) iv spoint input doXTS f (key1,key2) iv spoint input
| len == 0 = empty | len == 0 = B.empty
| r /= 0 = error $ "Encryption error: input length must be a multiple of block size (16) for now. Its length is: " ++ (show len) | r /= 0 = error $ "Encryption error: input length must be a multiple of block size (16) for now. Its length is: " ++ (show len)
| otherwise = byteArrayAllocAndFreeze len $ \o -> withKey2AndIV key1 key2 iv $ \k1 k2 v -> withByteArray input $ \i -> | otherwise = B.allocAndFreeze len $ \o -> withKey2AndIV key1 key2 iv $ \k1 k2 v -> withByteArray input $ \i ->
f (castPtr o) k1 k2 v (fromIntegral spoint) i (fromIntegral nbBlocks) f (castPtr o) k1 k2 v (fromIntegral spoint) i (fromIntegral nbBlocks)
where (nbBlocks, r) = len `quotRem` 16 where (nbBlocks, r) = len `quotRem` 16
len = byteArrayLength input len = B.length input
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- GCM -- GCM
@ -406,9 +407,9 @@ doGCM f ctx iv aad input = (output, tag)
{-# NOINLINE gcmInit #-} {-# NOINLINE gcmInit #-}
gcmInit :: ByteArrayAccess iv => AES -> iv -> AESGCM gcmInit :: ByteArrayAccess iv => AES -> iv -> AESGCM
gcmInit ctx iv = unsafeDoIO $ do gcmInit ctx iv = unsafeDoIO $ do
sm <- byteArrayAlloc sizeGCM $ \gcmStPtr -> sm <- B.alloc sizeGCM $ \gcmStPtr ->
withKeyAndIV ctx iv $ \k v -> withKeyAndIV ctx iv $ \k v ->
c_aes_gcm_init (castPtr gcmStPtr) k v (fromIntegral $ byteArrayLength iv) c_aes_gcm_init (castPtr gcmStPtr) k v (fromIntegral $ B.length iv)
return $ AESGCM sm return $ AESGCM sm
-- | append data which is going to just be authentified to the GCM context. -- | append data which is going to just be authentified to the GCM context.
@ -420,7 +421,7 @@ gcmAppendAAD gcmSt input = unsafeDoIO doAppend
where doAppend = where doAppend =
withNewGCMSt gcmSt $ \gcmStPtr -> withNewGCMSt gcmSt $ \gcmStPtr ->
withByteArray input $ \i -> withByteArray input $ \i ->
c_aes_gcm_aad gcmStPtr i (fromIntegral $ byteArrayLength input) c_aes_gcm_aad gcmStPtr i (fromIntegral $ B.length input)
-- | append data to encrypt and append to the GCM context -- | append data to encrypt and append to the GCM context
-- --
@ -429,9 +430,9 @@ gcmAppendAAD gcmSt input = unsafeDoIO doAppend
{-# NOINLINE gcmAppendEncrypt #-} {-# NOINLINE gcmAppendEncrypt #-}
gcmAppendEncrypt :: ByteArray ba => AES -> AESGCM -> ba -> (ba, AESGCM) gcmAppendEncrypt :: ByteArray ba => AES -> AESGCM -> ba -> (ba, AESGCM)
gcmAppendEncrypt ctx gcm input = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doEnc gcmAppendEncrypt ctx gcm input = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doEnc
where len = byteArrayLength input where len = B.length input
doEnc gcmStPtr aesPtr = doEnc gcmStPtr aesPtr =
byteArrayAlloc len $ \o -> B.alloc len $ \o ->
withByteArray input $ \i -> withByteArray input $ \i ->
c_aes_gcm_encrypt (castPtr o) gcmStPtr aesPtr i (fromIntegral len) c_aes_gcm_encrypt (castPtr o) gcmStPtr aesPtr i (fromIntegral len)
@ -442,17 +443,17 @@ gcmAppendEncrypt ctx gcm input = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doEnc
{-# NOINLINE gcmAppendDecrypt #-} {-# NOINLINE gcmAppendDecrypt #-}
gcmAppendDecrypt :: ByteArray ba => AES -> AESGCM -> ba -> (ba, AESGCM) gcmAppendDecrypt :: ByteArray ba => AES -> AESGCM -> ba -> (ba, AESGCM)
gcmAppendDecrypt ctx gcm input = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doDec gcmAppendDecrypt ctx gcm input = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doDec
where len = byteArrayLength input where len = B.length input
doDec gcmStPtr aesPtr = doDec gcmStPtr aesPtr =
byteArrayAlloc len $ \o -> B.alloc len $ \o ->
withByteArray input $ \i -> withByteArray input $ \i ->
c_aes_gcm_decrypt (castPtr o) gcmStPtr aesPtr i (fromIntegral len) c_aes_gcm_decrypt (castPtr o) gcmStPtr aesPtr i (fromIntegral len)
-- | Generate the Tag from GCM context -- | Generate the Tag from GCM context
{-# NOINLINE gcmFinish #-} {-# NOINLINE gcmFinish #-}
gcmFinish :: AES -> AESGCM -> Int -> AuthTag gcmFinish :: AES -> AESGCM -> Int -> AuthTag
gcmFinish ctx gcm taglen = AuthTag $ B.take taglen computeTag gcmFinish ctx gcm taglen = AuthTag $ BS.take taglen computeTag
where computeTag = unsafeCreate 16 $ \t -> where computeTag = BS.unsafeCreate 16 $ \t ->
withGCMKeyAndCopySt ctx gcm (c_aes_gcm_finish (castPtr t)) >> return () withGCMKeyAndCopySt ctx gcm (c_aes_gcm_finish (castPtr t)) >> return ()
------------------------------------------------------------------------ ------------------------------------------------------------------------
@ -477,9 +478,9 @@ doOCB f ctx iv aad input = (output, tag)
{-# NOINLINE ocbInit #-} {-# NOINLINE ocbInit #-}
ocbInit :: ByteArrayAccess iv => AES -> iv -> AESOCB ocbInit :: ByteArrayAccess iv => AES -> iv -> AESOCB
ocbInit ctx iv = unsafeDoIO $ do ocbInit ctx iv = unsafeDoIO $ do
sm <- byteArrayAlloc sizeOCB $ \ocbStPtr -> sm <- B.alloc sizeOCB $ \ocbStPtr ->
withKeyAndIV ctx iv $ \k v -> withKeyAndIV ctx iv $ \k v ->
c_aes_ocb_init (castPtr ocbStPtr) k v (fromIntegral $ byteArrayLength iv) c_aes_ocb_init (castPtr ocbStPtr) k v (fromIntegral $ B.length iv)
return $ AESOCB sm return $ AESOCB sm
-- | append data which is going to just be authentified to the OCB context. -- | append data which is going to just be authentified to the OCB context.
@ -490,7 +491,7 @@ ocbAppendAAD :: ByteArrayAccess aad => AES -> AESOCB -> aad -> AESOCB
ocbAppendAAD ctx ocb input = unsafeDoIO (snd `fmap` withOCBKeyAndCopySt ctx ocb doAppend) ocbAppendAAD ctx ocb input = unsafeDoIO (snd `fmap` withOCBKeyAndCopySt ctx ocb doAppend)
where doAppend ocbStPtr aesPtr = where doAppend ocbStPtr aesPtr =
withByteArray input $ \i -> withByteArray input $ \i ->
c_aes_ocb_aad ocbStPtr aesPtr i (fromIntegral $ byteArrayLength input) c_aes_ocb_aad ocbStPtr aesPtr i (fromIntegral $ B.length input)
-- | append data to encrypt and append to the OCB context -- | append data to encrypt and append to the OCB context
-- --
@ -499,9 +500,9 @@ ocbAppendAAD ctx ocb input = unsafeDoIO (snd `fmap` withOCBKeyAndCopySt ctx ocb
{-# NOINLINE ocbAppendEncrypt #-} {-# NOINLINE ocbAppendEncrypt #-}
ocbAppendEncrypt :: ByteArray ba => AES -> AESOCB -> ba -> (ba, AESOCB) ocbAppendEncrypt :: ByteArray ba => AES -> AESOCB -> ba -> (ba, AESOCB)
ocbAppendEncrypt ctx ocb input = unsafeDoIO $ withOCBKeyAndCopySt ctx ocb doEnc ocbAppendEncrypt ctx ocb input = unsafeDoIO $ withOCBKeyAndCopySt ctx ocb doEnc
where len = byteArrayLength input where len = B.length input
doEnc ocbStPtr aesPtr = doEnc ocbStPtr aesPtr =
byteArrayAlloc len $ \o -> B.alloc len $ \o ->
withByteArray input $ \i -> withByteArray input $ \i ->
c_aes_ocb_encrypt (castPtr o) ocbStPtr aesPtr i (fromIntegral len) c_aes_ocb_encrypt (castPtr o) ocbStPtr aesPtr i (fromIntegral len)
@ -512,17 +513,17 @@ ocbAppendEncrypt ctx ocb input = unsafeDoIO $ withOCBKeyAndCopySt ctx ocb doEnc
{-# NOINLINE ocbAppendDecrypt #-} {-# NOINLINE ocbAppendDecrypt #-}
ocbAppendDecrypt :: ByteArray ba => AES -> AESOCB -> ba -> (ba, AESOCB) ocbAppendDecrypt :: ByteArray ba => AES -> AESOCB -> ba -> (ba, AESOCB)
ocbAppendDecrypt ctx ocb input = unsafeDoIO $ withOCBKeyAndCopySt ctx ocb doDec ocbAppendDecrypt ctx ocb input = unsafeDoIO $ withOCBKeyAndCopySt ctx ocb doDec
where len = byteArrayLength input where len = B.length input
doDec ocbStPtr aesPtr = doDec ocbStPtr aesPtr =
byteArrayAlloc len $ \o -> B.alloc len $ \o ->
withByteArray input $ \i -> withByteArray input $ \i ->
c_aes_ocb_decrypt (castPtr o) ocbStPtr aesPtr i (fromIntegral len) c_aes_ocb_decrypt (castPtr o) ocbStPtr aesPtr i (fromIntegral len)
-- | Generate the Tag from OCB context -- | Generate the Tag from OCB context
{-# NOINLINE ocbFinish #-} {-# NOINLINE ocbFinish #-}
ocbFinish :: AES -> AESOCB -> Int -> AuthTag ocbFinish :: AES -> AESOCB -> Int -> AuthTag
ocbFinish ctx ocb taglen = AuthTag $ B.take taglen computeTag ocbFinish ctx ocb taglen = AuthTag $ BS.take taglen computeTag
where computeTag = unsafeCreate 16 $ \t -> where computeTag = BS.unsafeCreate 16 $ \t ->
withOCBKeyAndCopySt ctx ocb (c_aes_ocb_finish (castPtr t)) >> return () withOCBKeyAndCopySt ctx ocb (c_aes_ocb_finish (castPtr t)) >> return ()
------------------------------------------------------------------------ ------------------------------------------------------------------------

41
Crypto/Cipher/Blowfish/Primitive.hs
View File

@ -18,16 +18,17 @@ module Crypto.Cipher.Blowfish.Primitive
, decrypt , decrypt
) where ) where
import Control.Monad (forM_, when) import Control.Monad (forM_, when)
import Data.Bits import Data.Bits
import Data.Word import Data.Word
import Crypto.Error import Crypto.Error
import Crypto.Internal.Compat import Crypto.Internal.Compat
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)
import Crypto.Internal.Words import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.WordArray import Crypto.Internal.Words
import Crypto.Cipher.Blowfish.Box import Crypto.Internal.WordArray
import Crypto.Cipher.Blowfish.Box
-- | variable keyed blowfish state -- | variable keyed blowfish state
data Context = BF (Int -> Word32) -- p data Context = BF (Int -> Word32) -- p
@ -45,15 +46,15 @@ decryptContext (BF p s0 s1 s2 s3) = BF (\i -> p (17-i)) s0 s1 s2 s3
cipher :: ByteArray ba => Context -> ba -> ba cipher :: ByteArray ba => Context -> ba -> ba
cipher ctx b cipher ctx b
| byteArrayLength b == 0 = empty | B.length b == 0 = B.empty
| byteArrayLength b `mod` 8 /= 0 = error "invalid data length" | B.length b `mod` 8 /= 0 = error "invalid data length"
| otherwise = byteArrayMapAsWord64 (coreCrypto ctx) b | otherwise = B.mapAsWord64 (coreCrypto ctx) b
initBlowfish :: ByteArray key => key -> CryptoFailable Context initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context
initBlowfish key initBlowfish key
| len > (448 `div` 8) = CryptoFailed $ CryptoError_KeySizeInvalid | len > (448 `div` 8) = CryptoFailed $ CryptoError_KeySizeInvalid
| otherwise = CryptoPassed $ makeKeySchedule key | otherwise = CryptoPassed $ makeKeySchedule key
where len = byteArrayLength key where len = B.length key
coreCrypto :: Context -> Word64 -> Word64 coreCrypto :: Context -> Word64 -> Word64
coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0 coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0
@ -76,16 +77,16 @@ coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0
d = s3 (fromIntegral $ t .&. 0xff) d = s3 (fromIntegral $ t .&. 0xff)
in fromIntegral (((a + b) `xor` c) + d) `shiftL` 32 in fromIntegral (((a + b) `xor` c) + d) `shiftL` 32
makeKeySchedule :: ByteArray key => key -> Context makeKeySchedule :: ByteArrayAccess key => key -> Context
makeKeySchedule key = makeKeySchedule key =
let v = unsafeDoIO $ do let v = unsafeDoIO $ do
let len = byteArrayLength key let len = B.length key
mv <- createKeySchedule mv <- createKeySchedule
when (len > 0) $ forM_ [0..17] $ \i -> do when (len > 0) $ forM_ [0..17] $ \i -> do
let a = byteArrayIndex key ((i * 4 + 0) `mod` len) let a = B.index key ((i * 4 + 0) `mod` len)
b = byteArrayIndex key ((i * 4 + 1) `mod` len) b = B.index key ((i * 4 + 1) `mod` len)
c = byteArrayIndex key ((i * 4 + 2) `mod` len) c = B.index key ((i * 4 + 2) `mod` len)
d = byteArrayIndex key ((i * 4 + 3) `mod` len) d = B.index key ((i * 4 + 3) `mod` len)
k = (fromIntegral a `shiftL` 24) .|. k = (fromIntegral a `shiftL` 24) .|.
(fromIntegral b `shiftL` 16) .|. (fromIntegral b `shiftL` 16) .|.
(fromIntegral c `shiftL` 8) .|. (fromIntegral c `shiftL` 8) .|.

27
Crypto/Cipher/Camellia/Primitive.hs
View File

@ -16,15 +16,16 @@ module Crypto.Cipher.Camellia.Primitive
, decrypt , decrypt
) where ) where
import Data.Word import Data.Word
import Data.Bits import Data.Bits
import qualified Data.ByteString as B import qualified Data.ByteString as B hiding (length)
import qualified Data.ByteString.Unsafe as B import qualified Data.ByteString.Unsafe as B
import Crypto.Error import Crypto.Error
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)
import Crypto.Internal.Words import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.WordArray import Crypto.Internal.Words
import Crypto.Internal.WordArray
data Mode = Decrypt | Encrypt data Mode = Decrypt | Encrypt
@ -115,9 +116,9 @@ data Camellia = Camellia
, ke :: Array64 , ke :: Array64
} }
setKeyInterim :: ByteArray key => key -> (Word128, Word128, Word128, Word128) setKeyInterim :: ByteArrayAccess key => key -> (Word128, Word128, Word128, Word128)
setKeyInterim keyseed = (w64tow128 kL, w64tow128 kR, w64tow128 kA, w64tow128 kB) setKeyInterim keyseed = (w64tow128 kL, w64tow128 kR, w64tow128 kA, w64tow128 kB)
where kL = (byteArrayToW64BE keyseed 0, byteArrayToW64BE keyseed 8) where kL = (B.toW64BE keyseed 0, B.toW64BE keyseed 8)
kR = (0, 0) kR = (0, 0)
kA = let d1 = (fst kL `xor` fst kR) kA = let d1 = (fst kL `xor` fst kR)
@ -144,8 +145,8 @@ initCamellia :: ByteArray key
=> key -- ^ The key to create the camellia context => key -- ^ The key to create the camellia context
-> CryptoFailable Camellia -> CryptoFailable Camellia
initCamellia key initCamellia key
| byteArrayLength key /= 16 = CryptoFailed $ CryptoError_KeySizeInvalid | B.length key /= 16 = CryptoFailed $ CryptoError_KeySizeInvalid
| otherwise = | otherwise =
let (kL, _, kA, _) = setKeyInterim key in let (kL, _, kA, _) = setKeyInterim key in
let (Word128 kw1 kw2) = (kL `rotl128` 0) in let (Word128 kw1 kw2) = (kL `rotl128` 0) in
@ -274,11 +275,11 @@ encrypt :: ByteArray ba
=> Camellia -- ^ The key to use => Camellia -- ^ The key to use
-> ba -- ^ The data to encrypt -> ba -- ^ The data to encrypt
-> ba -> ba
encrypt key = byteArrayMapAsWord128 (encryptBlock key) encrypt key = B.mapAsWord128 (encryptBlock key)
-- | Decrypts the given ByteString using the given Key -- | Decrypts the given ByteString using the given Key
decrypt :: ByteArray ba decrypt :: ByteArray ba
=> Camellia -- ^ The key to use => Camellia -- ^ The key to use
-> ba -- ^ The data to decrypt -> ba -- ^ The data to decrypt
-> ba -> ba
decrypt key = byteArrayMapAsWord128 (decryptBlock key) decrypt key = B.mapAsWord128 (decryptBlock key)

52
Crypto/Cipher/ChaCha.hs
View File

@ -17,18 +17,18 @@ module Crypto.Cipher.ChaCha
, StateSimple , StateSimple
) where ) where
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as B import qualified Data.ByteString as BS
import qualified Data.ByteString as B import qualified Data.ByteString.Internal as BS
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, SecureBytes, withByteArray)
import Crypto.Internal.Compat import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Imports import Crypto.Internal.Compat
import Data.Byteable import Crypto.Internal.Imports
import Data.Bits (xor) import Data.Bits (xor)
import Foreign.Ptr import Foreign.Ptr
import Foreign.ForeignPtr import Foreign.ForeignPtr
import Foreign.C.Types import Foreign.C.Types
import Foreign.Storable import Foreign.Storable
-- | ChaCha context -- | ChaCha context
data State = State Int -- number of rounds data State = State Int -- number of rounds
@ -57,12 +57,12 @@ initialize nbRounds key nonce
| not (nonceLen `elem` [8,12]) = error "ChaCha: nonce length should be 64 or 96 bits" | not (nonceLen `elem` [8,12]) = error "ChaCha: nonce length should be 64 or 96 bits"
| not (nbRounds `elem` [8,12,20]) = error "ChaCha: rounds should be 8, 12 or 20" | not (nbRounds `elem` [8,12,20]) = error "ChaCha: rounds should be 8, 12 or 20"
| otherwise = unsafeDoIO $ do | otherwise = unsafeDoIO $ do
stPtr <- byteArrayAlloc 64 $ \stPtr -> stPtr <- B.alloc 64 $ \stPtr ->
withByteArray nonce $ \noncePtr -> withByteArray nonce $ \noncePtr ->
withByteArray key $ \keyPtr -> withByteArray key $ \keyPtr ->
ccryptonite_chacha_init (castPtr stPtr) kLen keyPtr nonceLen noncePtr ccryptonite_chacha_init (castPtr stPtr) kLen keyPtr nonceLen noncePtr
return $ State nbRounds stPtr B.empty return $ State nbRounds stPtr B.empty
where kLen = byteArrayLength key where kLen = B.length key
nonceLen = B.length nonce nonceLen = B.length nonce
-- | Initialize simple ChaCha State -- | Initialize simple ChaCha State
@ -72,12 +72,12 @@ initializeSimple :: ByteArray seed
initializeSimple seed initializeSimple seed
| sLen /= 40 = error "ChaCha Random: seed length should be 40 bytes" | sLen /= 40 = error "ChaCha Random: seed length should be 40 bytes"
| otherwise = unsafeDoIO $ do | otherwise = unsafeDoIO $ do
stPtr <- byteArrayAlloc 64 $ \stPtr -> stPtr <- B.alloc 64 $ \stPtr ->
withByteArray seed $ \seedPtr -> withByteArray seed $ \seedPtr ->
ccryptonite_chacha_init (castPtr stPtr) 32 seedPtr 8 (seedPtr `plusPtr` 32) ccryptonite_chacha_init (castPtr stPtr) 32 seedPtr 8 (seedPtr `plusPtr` 32)
return $ StateSimple stPtr return $ StateSimple stPtr
where where
sLen = byteArrayLength seed sLen = B.length seed
-- | Combine the chacha output and an arbitrary message with a xor, -- | Combine the chacha output and an arbitrary message with a xor,
-- and return the combined output and the new state. -- and return the combined output and the new state.
@ -89,8 +89,8 @@ combine prev@(State nbRounds prevSt prevOut) src
| outputLen <= prevBufLen = | outputLen <= prevBufLen =
-- we have enough byte in the previous buffer to complete the query -- we have enough byte in the previous buffer to complete the query
-- without having to generate any extra bytes -- without having to generate any extra bytes
let (b1,b2) = B.splitAt outputLen prevOut let (b1,b2) = BS.splitAt outputLen prevOut
in (B.pack $ B.zipWith xor b1 src, State nbRounds prevSt b2) in (BS.pack $ BS.zipWith xor b1 src, State nbRounds prevSt b2)
| otherwise = unsafeDoIO $ do | otherwise = unsafeDoIO $ do
-- adjusted len is the number of bytes lefts to generate after -- adjusted len is the number of bytes lefts to generate after
-- copying from the previous buffer. -- copying from the previous buffer.
@ -98,15 +98,15 @@ combine prev@(State nbRounds prevSt prevOut) src
(roundedAlready, newBytesToGenerate) = round64 adjustedLen (roundedAlready, newBytesToGenerate) = round64 adjustedLen
nextBufLen = newBytesToGenerate - adjustedLen nextBufLen = newBytesToGenerate - adjustedLen
fptr <- B.mallocByteString (newBytesToGenerate + prevBufLen) fptr <- BS.mallocByteString (newBytesToGenerate + prevBufLen)
newSt <- withForeignPtr fptr $ \dstPtr -> newSt <- withForeignPtr fptr $ \dstPtr ->
withByteArray src $ \srcPtr -> do withByteArray src $ \srcPtr -> do
-- copy the previous buffer by xor if any -- copy the previous buffer by xor if any
withBytePtr prevOut $ \prevPtr -> withByteArray prevOut $ \prevPtr ->
loopXor dstPtr srcPtr prevPtr prevBufLen loopXor dstPtr srcPtr prevPtr prevBufLen
-- then create a new mutable copy of state -- then create a new mutable copy of state
st <- byteArrayCopy prevSt (\_ -> return ()) st <- B.copy prevSt (\_ -> return ())
withByteArray st $ \stPtr -> withByteArray st $ \stPtr ->
ccryptonite_chacha_combine nbRounds ccryptonite_chacha_combine nbRounds
(dstPtr `plusPtr` prevBufLen) (dstPtr `plusPtr` prevBufLen)
@ -115,8 +115,8 @@ combine prev@(State nbRounds prevSt prevOut) src
(fromIntegral newBytesToGenerate) (fromIntegral newBytesToGenerate)
return st return st
-- return combined byte -- return combined byte
return ( B.PS fptr 0 outputLen return ( BS.PS fptr 0 outputLen
, State nbRounds newSt (if roundedAlready then B.empty else B.PS fptr outputLen nextBufLen)) , State nbRounds newSt (if roundedAlready then BS.empty else BS.PS fptr outputLen nextBufLen))
where where
outputLen = B.length src outputLen = B.length src
prevBufLen = B.length prevOut prevBufLen = B.length prevOut
@ -133,7 +133,7 @@ combine prev@(State nbRounds prevSt prevOut) src
generate :: State -- ^ the current ChaCha state generate :: State -- ^ the current ChaCha state
-> Int -- ^ the length of data to generate -> Int -- ^ the length of data to generate
-> (ByteString, State) -> (ByteString, State)
generate st len = combine st (B.replicate len 0) generate st len = combine st (BS.replicate len 0)
-- | similar to 'generate' but assume certains values -- | similar to 'generate' but assume certains values
generateSimple :: ByteArray ba generateSimple :: ByteArray ba
@ -141,8 +141,8 @@ generateSimple :: ByteArray ba
-> Int -> Int
-> (ba, StateSimple) -> (ba, StateSimple)
generateSimple (StateSimple prevSt) nbBytes = unsafeDoIO $ do generateSimple (StateSimple prevSt) nbBytes = unsafeDoIO $ do
newSt <- byteArrayCopy prevSt (\_ -> return ()) newSt <- B.copy prevSt (\_ -> return ())
output <- byteArrayAlloc nbBytes $ \dstPtr -> output <- B.alloc nbBytes $ \dstPtr ->
withByteArray newSt $ \stPtr -> withByteArray newSt $ \stPtr ->
ccryptonite_chacha_random 8 dstPtr (castPtr stPtr) (fromIntegral nbBytes) ccryptonite_chacha_random 8 dstPtr (castPtr stPtr) (fromIntegral nbBytes)
return (output, StateSimple newSt) return (output, StateSimple newSt)

21
Crypto/Cipher/DES.hs
View File

@ -9,11 +9,12 @@ module Crypto.Cipher.DES
( DES ( DES
) where ) where
import Data.Word import Data.Word
import Crypto.Error import Crypto.Error
import Crypto.Cipher.Types import Crypto.Cipher.Types
import Crypto.Cipher.DES.Primitive import Crypto.Cipher.DES.Primitive
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
-- | DES Context -- | DES Context
data DES = DES Word64 data DES = DES Word64
@ -26,12 +27,12 @@ instance Cipher DES where
instance BlockCipher DES where instance BlockCipher DES where
blockSize _ = 8 blockSize _ = 8
ecbEncrypt (DES key) = byteArrayMapAsWord64 (unBlock . encrypt key . Block) ecbEncrypt (DES key) = B.mapAsWord64 (unBlock . encrypt key . Block)
ecbDecrypt (DES key) = byteArrayMapAsWord64 (unBlock . decrypt key . Block) ecbDecrypt (DES key) = B.mapAsWord64 (unBlock . decrypt key . Block)
initDES :: ByteArray key => key -> CryptoFailable DES initDES :: ByteArrayAccess key => key -> CryptoFailable DES
initDES k initDES k
| len == 8 = CryptoPassed $ DES key | len == 8 = CryptoPassed $ DES key
| otherwise = CryptoFailed $ CryptoError_KeySizeInvalid | otherwise = CryptoFailed $ CryptoError_KeySizeInvalid
where len = byteArrayLength k where len = B.length k
key = byteArrayToW64BE k 0 key = B.toW64BE k 0

4
Crypto/Cipher/DES/Serialization.hs
View File

@ -14,10 +14,10 @@ module Crypto.Cipher.DES.Serialization
import qualified Data.ByteString as B import qualified Data.ByteString as B
import Crypto.Cipher.DES.Primitive (Block(..)) import Crypto.Cipher.DES.Primitive (Block(..))
import Crypto.Internal.ByteArray import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Endian import Crypto.Internal.Endian
import Foreign.Storable import Foreign.Storable
toBS :: Block -> B.ByteString toBS :: Block -> B.ByteString
toBS (Block w) = byteArrayAllocAndFreeze 8 $ \ptr -> poke ptr (toBE64 w) toBS (Block w) = B.allocAndFreeze 8 $ \ptr -> poke ptr (toBE64 w)

39
Crypto/Cipher/TripleDES.hs
View File

@ -11,11 +11,12 @@ module Crypto.Cipher.TripleDES
, DES_EDE2 , DES_EDE2
) where ) where
import Data.Word import Data.Word
import Crypto.Error import Crypto.Error
import Crypto.Cipher.Types import Crypto.Cipher.Types
import Crypto.Cipher.DES.Primitive import Crypto.Cipher.DES.Primitive
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
-- | 3DES with 3 different keys used all in the same direction -- | 3DES with 3 different keys used all in the same direction
data DES_EEE3 = DES_EEE3 Word64 Word64 Word64 data DES_EEE3 = DES_EEE3 Word64 Word64 Word64
@ -55,34 +56,34 @@ instance Cipher DES_EEE2 where
instance BlockCipher DES_EEE3 where instance BlockCipher DES_EEE3 where
blockSize _ = 8 blockSize _ = 8
ecbEncrypt (DES_EEE3 k1 k2 k3) = byteArrayMapAsWord64 (unBlock . (encrypt k3 . encrypt k2 . encrypt k1) . Block) ecbEncrypt (DES_EEE3 k1 k2 k3) = B.mapAsWord64 (unBlock . (encrypt k3 . encrypt k2 . encrypt k1) . Block)
ecbDecrypt (DES_EEE3 k1 k2 k3) = byteArrayMapAsWord64 (unBlock . (decrypt k1 . decrypt k2 . decrypt k3) . Block) ecbDecrypt (DES_EEE3 k1 k2 k3) = B.mapAsWord64 (unBlock . (decrypt k1 . decrypt k2 . decrypt k3) . Block)
instance BlockCipher DES_EDE3 where instance BlockCipher DES_EDE3 where
blockSize _ = 8 blockSize _ = 8
ecbEncrypt (DES_EDE3 k1 k2 k3) = byteArrayMapAsWord64 (unBlock . (encrypt k3 . decrypt k2 . encrypt k1) . Block) ecbEncrypt (DES_EDE3 k1 k2 k3) = B.mapAsWord64 (unBlock . (encrypt k3 . decrypt k2 . encrypt k1) . Block)
ecbDecrypt (DES_EDE3 k1 k2 k3) = byteArrayMapAsWord64 (unBlock . (decrypt k1 . encrypt k2 . decrypt k3) . Block) ecbDecrypt (DES_EDE3 k1 k2 k3) = B.mapAsWord64 (unBlock . (decrypt k1 . encrypt k2 . decrypt k3) . Block)
instance BlockCipher DES_EEE2 where instance BlockCipher DES_EEE2 where
blockSize _ = 8 blockSize _ = 8
ecbEncrypt (DES_EEE2 k1 k2) = byteArrayMapAsWord64 (unBlock . (encrypt k1 . encrypt k2 . encrypt k1) . Block) ecbEncrypt (DES_EEE2 k1 k2) = B.mapAsWord64 (unBlock . (encrypt k1 . encrypt k2 . encrypt k1) . Block)
ecbDecrypt (DES_EEE2 k1 k2) = byteArrayMapAsWord64 (unBlock . (decrypt k1 . decrypt k2 . decrypt k1) . Block) ecbDecrypt (DES_EEE2 k1 k2) = B.mapAsWord64 (unBlock . (decrypt k1 . decrypt k2 . decrypt k1) . Block)
instance BlockCipher DES_EDE2 where instance BlockCipher DES_EDE2 where
blockSize _ = 8 blockSize _ = 8
ecbEncrypt (DES_EDE2 k1 k2) = byteArrayMapAsWord64 (unBlock . (encrypt k1 . decrypt k2 . encrypt k1) . Block) ecbEncrypt (DES_EDE2 k1 k2) = B.mapAsWord64 (unBlock . (encrypt k1 . decrypt k2 . encrypt k1) . Block)
ecbDecrypt (DES_EDE2 k1 k2) = byteArrayMapAsWord64 (unBlock . (decrypt k1 . encrypt k2 . decrypt k1) . Block) ecbDecrypt (DES_EDE2 k1 k2) = B.mapAsWord64 (unBlock . (decrypt k1 . encrypt k2 . decrypt k1) . Block)
init3DES :: ByteArray key => (Word64 -> Word64 -> Word64 -> a) -> key -> CryptoFailable a init3DES :: ByteArrayAccess key => (Word64 -> Word64 -> Word64 -> a) -> key -> CryptoFailable a
init3DES constr k init3DES constr k
| len == 24 = CryptoPassed $ constr k1 k2 k3 | len == 24 = CryptoPassed $ constr k1 k2 k3
| otherwise = CryptoFailed CryptoError_KeySizeInvalid | otherwise = CryptoFailed CryptoError_KeySizeInvalid
where len = byteArrayLength k where len = B.length k
(k1, k2, k3) = (byteArrayToW64BE k 0, byteArrayToW64BE k 8, byteArrayToW64BE k 16) (k1, k2, k3) = (B.toW64BE k 0, B.toW64BE k 8, B.toW64BE k 16)
init2DES :: ByteArray key => (Word64 -> Word64 -> a) -> key -> CryptoFailable a init2DES :: ByteArrayAccess key => (Word64 -> Word64 -> a) -> key -> CryptoFailable a
init2DES constr k init2DES constr k
| len == 16 = CryptoPassed $ constr k1 k2 | len == 16 = CryptoPassed $ constr k1 k2
| otherwise = CryptoFailed CryptoError_KeySizeInvalid | otherwise = CryptoFailed CryptoError_KeySizeInvalid
where len = byteArrayLength k where len = B.length k
(k1, k2) = (byteArrayToW64BE k 0, byteArrayToW64BE k 8) (k1, k2) = (B.toW64BE k 0, B.toW64BE k 8)

9
Crypto/Cipher/Types/AEAD.hs
View File

@ -11,9 +11,10 @@
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE Rank2Types #-}
module Crypto.Cipher.Types.AEAD where module Crypto.Cipher.Types.AEAD where
import Crypto.Cipher.Types.Base import Crypto.Cipher.Types.Base
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)
import Crypto.Internal.Imports import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Imports
data AEADModeImpl st = AEADModeImpl data AEADModeImpl st = AEADModeImpl
{ aeadImplAppendHeader :: forall ba . ByteArrayAccess ba => st -> ba -> st { aeadImplAppendHeader :: forall ba . ByteArrayAccess ba => st -> ba -> st
@ -64,5 +65,5 @@ aeadSimpleDecrypt aeadIni header input authTag
| otherwise = Nothing | otherwise = Nothing
where aead = aeadAppendHeader aeadIni header where aead = aeadAppendHeader aeadIni header
(output, aeadFinal) = aeadDecrypt aead input (output, aeadFinal) = aeadDecrypt aead input
tag = aeadFinalize aeadFinal (byteArrayLength authTag) tag = aeadFinalize aeadFinal (B.length authTag)

11
Crypto/Cipher/Types/Base.hs
View File

@ -17,11 +17,12 @@ module Crypto.Cipher.Types.Base
, DataUnitOffset , DataUnitOffset
) where ) where
import Data.Word import Data.Word
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, SecureBytes, withByteArray)
import Crypto.Error import qualified Crypto.Internal.ByteArray as B
import Crypto.Error
-- | Different specifier for key size in bytes -- | Different specifier for key size in bytes
data KeySizeSpecifier = data KeySizeSpecifier =
@ -38,7 +39,7 @@ newtype AuthTag = AuthTag { unAuthTag :: ByteString }
deriving (Show, ByteArrayAccess) deriving (Show, ByteArrayAccess)
instance Eq AuthTag where instance Eq AuthTag where
(AuthTag a) == (AuthTag b) = byteArrayConstEq a b (AuthTag a) == (AuthTag b) = B.constEq a b
-- | AEAD Mode -- | AEAD Mode
data AEADMode = data AEADMode =

59
Crypto/Cipher/Types/Block.hs
View File

@ -36,27 +36,28 @@ module Crypto.Cipher.Types.Block
--, cfb8Decrypt --, cfb8Decrypt
) where ) where
import Data.Byteable import Data.Byteable
import Data.Word import Data.Word
import Crypto.Error import Crypto.Error
import Crypto.Cipher.Types.Base import Crypto.Cipher.Types.Base
import Crypto.Cipher.Types.GF import Crypto.Cipher.Types.GF
import Crypto.Cipher.Types.AEAD import Crypto.Cipher.Types.AEAD
import Crypto.Cipher.Types.Utils import Crypto.Cipher.Types.Utils
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, withByteArray, Bytes)
import qualified Crypto.Internal.ByteArray as B
import Foreign.Ptr import Foreign.Ptr
import Foreign.Storable import Foreign.Storable
-- | an IV parametrized by the cipher -- | an IV parametrized by the cipher
data IV c = forall byteArray . ByteArray byteArray => IV byteArray data IV c = forall byteArray . ByteArray byteArray => IV byteArray
instance BlockCipher c => ByteArrayAccess (IV c) where instance BlockCipher c => ByteArrayAccess (IV c) where
withByteArray (IV z) f = withByteArray z f withByteArray (IV z) f = withByteArray z f
byteArrayLength (IV z) = byteArrayLength z length (IV z) = B.length z
instance Eq (IV c) where instance Eq (IV c) where
(IV a) == (IV b) = byteArrayEq a b (IV a) == (IV b) = B.eq a b
type XTS ba cipher = (cipher, cipher) type XTS ba cipher = (cipher, cipher)
-> IV cipher -- ^ Usually represent the Data Unit (e.g. disk sector) -> IV cipher -- ^ Usually represent the Data Unit (e.g. disk sector)
@ -157,7 +158,7 @@ makeIV b = toIV undefined
nullIV :: BlockCipher c => IV c nullIV :: BlockCipher c => IV c
nullIV = toIV undefined nullIV = toIV undefined
where toIV :: BlockCipher c => c -> IV c where toIV :: BlockCipher c => c -> IV c
toIV cipher = IV (byteArrayZero (blockSize cipher) :: Bytes) toIV cipher = IV (B.zero (blockSize cipher) :: Bytes)
-- | Increment an IV by a number. -- | Increment an IV by a number.
-- --
@ -165,9 +166,9 @@ nullIV = toIV undefined
ivAdd :: BlockCipher c => IV c -> Int -> IV c ivAdd :: BlockCipher c => IV c -> Int -> IV c
ivAdd (IV b) i = IV $ copy b ivAdd (IV b) i = IV $ copy b
where copy :: ByteArray bs => bs -> bs where copy :: ByteArray bs => bs -> bs
copy bs = byteArrayCopyAndFreeze bs $ \p -> do copy bs = B.copyAndFreeze bs $ \p -> do
let until0 accu = do let until0 accu = do
r <- loop accu (byteArrayLength bs - 1) p r <- loop accu (B.length bs - 1) p
case r of case r of
0 -> return () 0 -> return ()
_ -> until0 r _ -> until0 r
@ -185,42 +186,42 @@ ivAdd (IV b) i = IV $ copy b
else loop hi (ofs - 1) p else loop hi (ofs - 1) p
cbcEncryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba cbcEncryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
cbcEncryptGeneric cipher ivini input = byteArrayConcat $ doEnc ivini $ chunk (blockSize cipher) input cbcEncryptGeneric cipher ivini input = B.concat $ doEnc ivini $ chunk (blockSize cipher) input
where doEnc _ [] = [] where doEnc _ [] = []
doEnc iv (i:is) = doEnc iv (i:is) =
let o = ecbEncrypt cipher $ byteArrayXor iv i let o = ecbEncrypt cipher $ B.xor iv i
in o : doEnc (IV o) is in o : doEnc (IV o) is
cbcDecryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba cbcDecryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
cbcDecryptGeneric cipher ivini input = byteArrayConcat $ doDec ivini $ chunk (blockSize cipher) input cbcDecryptGeneric cipher ivini input = B.concat $ doDec ivini $ chunk (blockSize cipher) input
where where
doDec _ [] = [] doDec _ [] = []
doDec iv (i:is) = doDec iv (i:is) =
let o = byteArrayXor iv $ ecbDecrypt cipher i let o = B.xor iv $ ecbDecrypt cipher i
in o : doDec (IV i) is in o : doDec (IV i) is
cfbEncryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba cfbEncryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
cfbEncryptGeneric cipher ivini input = byteArrayConcat $ doEnc ivini $ chunk (blockSize cipher) input cfbEncryptGeneric cipher ivini input = B.concat $ doEnc ivini $ chunk (blockSize cipher) input
where where
doEnc _ [] = [] doEnc _ [] = []
doEnc (IV iv) (i:is) = doEnc (IV iv) (i:is) =
let o = byteArrayXor i $ ecbEncrypt cipher iv let o = B.xor i $ ecbEncrypt cipher iv
in o : doEnc (IV o) is in o : doEnc (IV o) is
cfbDecryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba cfbDecryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
cfbDecryptGeneric cipher ivini input = byteArrayConcat $ doDec ivini $ chunk (blockSize cipher) input cfbDecryptGeneric cipher ivini input = B.concat $ doDec ivini $ chunk (blockSize cipher) input
where where
doDec _ [] = [] doDec _ [] = []
doDec (IV iv) (i:is) = doDec (IV iv) (i:is) =
let o = byteArrayXor i $ ecbEncrypt cipher iv let o = B.xor i $ ecbEncrypt cipher iv
in o : doDec (IV i) is in o : doDec (IV i) is
ctrCombineGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba ctrCombineGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
ctrCombineGeneric cipher ivini input = byteArrayConcat $ doCnt ivini $ chunk (blockSize cipher) input ctrCombineGeneric cipher ivini input = B.concat $ doCnt ivini $ chunk (blockSize cipher) input
where doCnt _ [] = [] where doCnt _ [] = []
doCnt iv@(IV ivd) (i:is) = doCnt iv@(IV ivd) (i:is) =
let ivEnc = ecbEncrypt cipher ivd let ivEnc = ecbEncrypt cipher ivd
in byteArrayXor i ivEnc : doCnt (ivAdd iv 1) is in B.xor i ivEnc : doCnt (ivAdd iv 1) is
xtsEncryptGeneric :: (ByteArray ba, BlockCipher128 cipher) => XTS ba cipher xtsEncryptGeneric :: (ByteArray ba, BlockCipher128 cipher) => XTS ba cipher
xtsEncryptGeneric = xtsGeneric ecbEncrypt xtsEncryptGeneric = xtsGeneric ecbEncrypt
@ -236,19 +237,19 @@ xtsGeneric :: (ByteArray ba, BlockCipher128 cipher)
-> ba -> ba
-> ba -> ba
xtsGeneric f (cipher, tweakCipher) (IV iv) sPoint input = xtsGeneric f (cipher, tweakCipher) (IV iv) sPoint input =
byteArrayConcat $ doXts iniTweak $ chunk (blockSize cipher) input B.concat $ doXts iniTweak $ chunk (blockSize cipher) input
where encTweak = ecbEncrypt tweakCipher iv where encTweak = ecbEncrypt tweakCipher iv
iniTweak = iterate xtsGFMul encTweak !! fromIntegral sPoint iniTweak = iterate xtsGFMul encTweak !! fromIntegral sPoint
doXts _ [] = [] doXts _ [] = []
doXts tweak (i:is) = doXts tweak (i:is) =
let o = byteArrayXor (f cipher $ byteArrayXor i tweak) tweak let o = B.xor (f cipher $ B.xor i tweak) tweak
in o : doXts (xtsGFMul tweak) is in o : doXts (xtsGFMul tweak) is
{- {-
-- | Encrypt using CFB mode in 8 bit output -- | Encrypt using CFB mode in 8 bit output
-- --
-- Effectively turn a Block cipher in CFB mode into a Stream cipher -- Effectively turn a Block cipher in CFB mode into a Stream cipher
cfb8Encrypt :: BlockCipher a => a -> IV a -> B.ByteString -> B.ByteString cfb8Encrypt :: BlockCipher a => a -> IV a -> B.byteString -> B.byteString
cfb8Encrypt ctx origIv msg = B.unsafeCreate (B.length msg) $ \dst -> loop dst origIv msg cfb8Encrypt ctx origIv msg = B.unsafeCreate (B.length msg) $ \dst -> loop dst origIv msg
where loop d iv@(IV i) m where loop d iv@(IV i) m
| B.null m = return () | B.null m = return ()
@ -263,7 +264,7 @@ cfb8Encrypt ctx origIv msg = B.unsafeCreate (B.length msg) $ \dst -> loop dst or
-- | Decrypt using CFB mode in 8 bit output -- | Decrypt using CFB mode in 8 bit output
-- --
-- Effectively turn a Block cipher in CFB mode into a Stream cipher -- Effectively turn a Block cipher in CFB mode into a Stream cipher
cfb8Decrypt :: BlockCipher a => a -> IV a -> B.ByteString -> B.ByteString cfb8Decrypt :: BlockCipher a => a -> IV a -> B.byteString -> B.byteString
cfb8Decrypt ctx origIv msg = B.unsafeCreate (B.length msg) $ \dst -> loop dst origIv msg cfb8Decrypt ctx origIv msg = B.unsafeCreate (B.length msg) $ \dst -> loop dst origIv msg
where loop d iv@(IV i) m where loop d iv@(IV i) m
| B.null m = return () | B.null m = return ()

19
Crypto/Cipher/Types/GF.hs
View File

@ -13,12 +13,13 @@ module Crypto.Cipher.Types.GF
xtsGFMul xtsGFMul
) where ) where
import Control.Applicative import Control.Applicative
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArray, withByteArray)
import Foreign.Storable import qualified Crypto.Internal.ByteArray as B
import Foreign.Ptr import Foreign.Storable
import Data.Word import Foreign.Ptr
import Data.Bits import Data.Word
import Data.Bits
-- block size need to be 128 bits. -- block size need to be 128 bits.
-- --
@ -26,8 +27,8 @@ import Data.Bits
xtsGFMul :: ByteArray ba => ba -> ba xtsGFMul :: ByteArray ba => ba -> ba
xtsGFMul b xtsGFMul b
| len == 16 = | len == 16 =
byteArrayAllocAndFreeze len $ \dst -> B.allocAndFreeze len $ \dst ->
withByteArray b $ \src -> do withByteArray b $ \src -> do
(hi,lo) <- gf <$> peek (castPtr src) <*> peek (castPtr src `plusPtr` 8) (hi,lo) <- gf <$> peek (castPtr src) <*> peek (castPtr src `plusPtr` 8)
poke (castPtr dst) lo poke (castPtr dst) lo
poke (castPtr dst `plusPtr` 8) hi poke (castPtr dst `plusPtr` 8) hi
@ -39,7 +40,7 @@ xtsGFMul b
) )
where carryHi = srcHi `testBit` 63 where carryHi = srcHi `testBit` 63
carryLo = srcLo `testBit` 63 carryLo = srcLo `testBit` 63
len = byteArrayLength b len = B.length b
{- {-
const uint64_t gf_mask = cpu_to_le64(0x8000000000000000ULL); const uint64_t gf_mask = cpu_to_le64(0x8000000000000000ULL);
uint64_t r = ((a->q[1] & gf_mask) ? cpu_to_le64(0x87) : 0); uint64_t r = ((a->q[1] & gf_mask) ? cpu_to_le64(0x87) : 0);

7
Crypto/Cipher/Types/Utils.hs
View File

@ -9,11 +9,12 @@
-- --
module Crypto.Cipher.Types.Utils where module Crypto.Cipher.Types.Utils where
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArray)
import qualified Crypto.Internal.ByteArray as B
chunk :: ByteArray b => Int -> b -> [b] chunk :: ByteArray b => Int -> b -> [b]
chunk sz bs = split bs chunk sz bs = split bs
where split b | byteArrayLength b <= sz = [b] where split b | B.length b <= sz = [b]
| otherwise = | otherwise =
let (b1, b2) = byteArraySplit sz b let (b1, b2) = B.split sz b
in b1 : split b2 in b1 : split b2

191
Crypto/Internal/ByteArray.hs
View File

@ -10,6 +10,7 @@
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-} {-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Crypto.Internal.ByteArray module Crypto.Internal.ByteArray
( (
ByteArray(..) ByteArray(..)
@ -18,26 +19,26 @@ module Crypto.Internal.ByteArray
, Bytes , Bytes
, SecureBytes , SecureBytes
-- * methods -- * methods
, byteArrayAlloc , alloc
, byteArrayAllocAndFreeze , allocAndFreeze
, empty , empty
, byteArrayZero , zero
, byteArrayCopy , copy
, byteArrayConvert , convert
, byteArrayCopyRet , copyRet
, byteArrayCopyAndFreeze , copyAndFreeze
, byteArraySplit , split
, byteArrayXor , xor
, byteArrayEq , eq
, byteArrayIndex , index
, byteArrayConstEq , constEq
, byteArrayConcat , concat
, byteArrayToBS , toBS
, byteArrayFromBS , fromBS
, byteArrayToW64BE , toW64BE
, byteArrayToW64LE , toW64LE
, byteArrayMapAsWord64 , mapAsWord64
, byteArrayMapAsWord128 , mapAsWord128
) where ) where
import Data.SecureMem import Data.SecureMem
@ -54,118 +55,120 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString as B (length) import qualified Data.ByteString as B (length)
import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Internal as B
import Prelude (flip, return, div, (-), ($), (==), (/=), (<=), (>=), Int, Bool(..), IO, otherwise, sum, map, fmap, snd, (.), min)
class ByteArrayAccess ba where class ByteArrayAccess ba where
byteArrayLength :: ba -> Int length :: ba -> Int
withByteArray :: ba -> (Ptr p -> IO a) -> IO a withByteArray :: ba -> (Ptr p -> IO a) -> IO a
class ByteArrayAccess ba => ByteArray ba where class ByteArrayAccess ba => ByteArray ba where
byteArrayAllocRet :: Int -> (Ptr p -> IO a) -> IO (a, ba) allocRet :: Int -> (Ptr p -> IO a) -> IO (a, ba)
byteArrayAlloc :: ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba alloc :: ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
byteArrayAlloc n f = snd `fmap` byteArrayAllocRet n f alloc n f = snd `fmap` allocRet n f
instance ByteArrayAccess Bytes where instance ByteArrayAccess Bytes where
byteArrayLength = bytesLength length = bytesLength
withByteArray = withBytes withByteArray = withBytes
instance ByteArray Bytes where instance ByteArray Bytes where
byteArrayAllocRet = bytesAllocRet allocRet = bytesAllocRet
instance ByteArrayAccess ByteString where instance ByteArrayAccess ByteString where
byteArrayLength = B.length length = B.length
withByteArray b f = withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off) withByteArray b f = withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
where (fptr, off, _) = B.toForeignPtr b where (fptr, off, _) = B.toForeignPtr b
instance ByteArray ByteString where instance ByteArray ByteString where
byteArrayAllocRet sz f = do allocRet sz f = do
fptr <- B.mallocByteString sz fptr <- B.mallocByteString sz
r <- withForeignPtr fptr (f . castPtr) r <- withForeignPtr fptr (f . castPtr)
return (r, B.PS fptr 0 sz) return (r, B.PS fptr 0 sz)
instance ByteArrayAccess SecureMem where instance ByteArrayAccess SecureMem where
byteArrayLength = secureMemGetSize length = secureMemGetSize
withByteArray b f = withSecureMemPtr b (f . castPtr) withByteArray b f = withSecureMemPtr b (f . castPtr)
instance ByteArray SecureMem where instance ByteArray SecureMem where
byteArrayAllocRet sz f = do allocRet sz f = do
out <- allocateSecureMem sz out <- allocateSecureMem sz
r <- withSecureMemPtr out (f . castPtr) r <- withSecureMemPtr out (f . castPtr)
return (r, out) return (r, out)
byteArrayAllocAndFreeze :: ByteArray a => Int -> (Ptr p -> IO ()) -> a allocAndFreeze :: ByteArray a => Int -> (Ptr p -> IO ()) -> a
byteArrayAllocAndFreeze sz f = unsafeDoIO (byteArrayAlloc sz f) allocAndFreeze sz f = unsafeDoIO (alloc sz f)
empty :: ByteArray a => a empty :: ByteArray a => a
empty = unsafeDoIO (byteArrayAlloc 0 $ \_ -> return ()) empty = unsafeDoIO (alloc 0 $ \_ -> return ())
-- | Create a xor of bytes between a and b. -- | Create a xor of bytes between a and b.
-- --
-- the returns byte array is the size of the smallest input. -- the returns byte array is the size of the smallest input.
byteArrayXor :: (ByteArrayAccess a, ByteArrayAccess b, ByteArray c) => a -> b -> c xor :: (ByteArrayAccess a, ByteArrayAccess b, ByteArray c) => a -> b -> c
byteArrayXor a b = xor a b =
byteArrayAllocAndFreeze n $ \pc -> allocAndFreeze n $ \pc ->
withByteArray a $ \pa -> withByteArray a $ \pa ->
withByteArray b $ \pb -> withByteArray b $ \pb ->
bufXor pc pa pb n bufXor pc pa pb n
where where
n = min la lb n = min la lb
la = byteArrayLength a la = length a
lb = byteArrayLength b lb = length b
byteArrayIndex :: ByteArrayAccess a => a -> Int -> Word8 index :: ByteArrayAccess a => a -> Int -> Word8
byteArrayIndex b i = unsafeDoIO $ withByteArray b $ \p -> peek (p `plusPtr` i) index b i = unsafeDoIO $ withByteArray b $ \p -> peek (p `plusPtr` i)
byteArraySplit :: ByteArray bs => Int -> bs -> (bs, bs) split :: ByteArray bs => Int -> bs -> (bs, bs)
byteArraySplit n bs split n bs
| n <= 0 = (empty, bs) | n <= 0 = (empty, bs)
| n >= len = (bs, empty) | n >= len = (bs, empty)
| otherwise = unsafeDoIO $ do | otherwise = unsafeDoIO $ do
withByteArray bs $ \p -> do withByteArray bs $ \p -> do
b1 <- byteArrayAlloc n $ \r -> bufCopy r p n b1 <- alloc n $ \r -> bufCopy r p n
b2 <- byteArrayAlloc (len - n) $ \r -> bufCopy r (p `plusPtr` n) (len - n) b2 <- alloc (len - n) $ \r -> bufCopy r (p `plusPtr` n) (len - n)
return (b1, b2) return (b1, b2)
where len = byteArrayLength bs where len = length bs
byteArrayConcat :: ByteArray bs => [bs] -> bs concat :: ByteArray bs => [bs] -> bs
byteArrayConcat [] = empty concat [] = empty
byteArrayConcat allBs = byteArrayAllocAndFreeze total (loop allBs) concat allBs = allocAndFreeze total (loop allBs)
where where
total = sum $ map byteArrayLength allBs total = sum $ map length allBs
loop [] _ = return () loop [] _ = return ()
loop (b:bs) dst = do loop (b:bs) dst = do
let sz = byteArrayLength b let sz = length b
withByteArray b $ \p -> bufCopy dst p sz withByteArray b $ \p -> bufCopy dst p sz
loop bs (dst `plusPtr` sz) loop bs (dst `plusPtr` sz)
byteArrayCopy :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> IO bs2 copy :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> IO bs2
byteArrayCopy bs f = copy bs f =
byteArrayAlloc (byteArrayLength bs) $ \d -> do alloc (length bs) $ \d -> do
withByteArray bs $ \s -> bufCopy d s (byteArrayLength bs) withByteArray bs $ \s -> bufCopy d s (length bs)
f (castPtr d) f (castPtr d)
byteArrayCopyRet :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO a) -> IO (a, bs2) copyRet :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO a) -> IO (a, bs2)
byteArrayCopyRet bs f = copyRet bs f =
byteArrayAllocRet (byteArrayLength bs) $ \d -> do allocRet (length bs) $ \d -> do
withByteArray bs $ \s -> bufCopy d s (byteArrayLength bs) withByteArray bs $ \s -> bufCopy d s (length bs)
f (castPtr d) f (castPtr d)
byteArrayCopyAndFreeze :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> bs2 copyAndFreeze :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> bs2
byteArrayCopyAndFreeze bs f = copyAndFreeze bs f =
byteArrayAllocAndFreeze (byteArrayLength bs) $ \d -> do allocAndFreeze (length bs) $ \d -> do
withByteArray bs $ \s -> bufCopy d s (byteArrayLength bs) withByteArray bs $ \s -> bufCopy d s (length bs)
f (castPtr d) f (castPtr d)
byteArrayZero :: ByteArray ba => Int -> ba zero :: ByteArray ba => Int -> ba
byteArrayZero n = byteArrayAllocAndFreeze n $ \ptr -> bufSet ptr 0 n zero n = allocAndFreeze n $ \ptr -> bufSet ptr 0 n
byteArrayEq :: (ByteArrayAccess bs1, ByteArrayAccess bs2) => bs1 -> bs2 -> Bool eq :: (ByteArrayAccess bs1, ByteArrayAccess bs2) => bs1 -> bs2 -> Bool
byteArrayEq b1 b2 eq b1 b2
| l1 /= l2 = False | l1 /= l2 = False
| otherwise = unsafeDoIO $ | otherwise = unsafeDoIO $
withByteArray b1 $ \p1 -> withByteArray b1 $ \p1 ->
withByteArray b2 $ \p2 -> withByteArray b2 $ \p2 ->
loop l1 p1 p2 loop l1 p1 p2
where where
l1 = byteArrayLength b1 l1 = length b1
l2 = byteArrayLength b2 l2 = length b2
loop :: Int -> Ptr Word8 -> Ptr Word8 -> IO Bool loop :: Int -> Ptr Word8 -> Ptr Word8 -> IO Bool
loop 0 _ _ = return True loop 0 _ _ = return True
loop i p1 p2 = do loop i p1 p2 = do
@ -180,16 +183,16 @@ byteArrayEq b1 b2
-- compared to == , this function will go over all the bytes -- compared to == , this function will go over all the bytes
-- present before yielding a result even when knowing the -- present before yielding a result even when knowing the
-- overall result early in the processing. -- overall result early in the processing.
byteArrayConstEq :: (ByteArrayAccess bs1, ByteArrayAccess bs2) => bs1 -> bs2 -> Bool constEq :: (ByteArrayAccess bs1, ByteArrayAccess bs2) => bs1 -> bs2 -> Bool
byteArrayConstEq b1 b2 constEq b1 b2
| l1 /= l2 = False | l1 /= l2 = False
| otherwise = unsafeDoIO $ | otherwise = unsafeDoIO $
withByteArray b1 $ \p1 -> withByteArray b1 $ \p1 ->
withByteArray b2 $ \p2 -> withByteArray b2 $ \p2 ->
loop l1 True p1 p2 loop l1 True p1 p2
where where
l1 = byteArrayLength b1 l1 = length b1
l2 = byteArrayLength b2 l2 = length b2
loop :: Int -> Bool -> Ptr Word8 -> Ptr Word8 -> IO Bool loop :: Int -> Bool -> Ptr Word8 -> Ptr Word8 -> IO Bool
loop 0 !ret _ _ = return ret loop 0 !ret _ _ = return ret
loop i !ret p1 p2 = do loop i !ret p1 p2 = do
@ -203,25 +206,25 @@ byteArrayConstEq b1 b2
False &&! True = False False &&! True = False
False &&! False = False False &&! False = False
byteArrayToBS :: ByteArray bs => bs -> ByteString toBS :: ByteArray bs => bs -> ByteString
byteArrayToBS bs = byteArrayCopyAndFreeze bs (\_ -> return ()) toBS bs = copyAndFreeze bs (\_ -> return ())
byteArrayFromBS :: ByteArray bs => ByteString -> bs fromBS :: ByteArray bs => ByteString -> bs
byteArrayFromBS bs = byteArrayCopyAndFreeze bs (\_ -> return ()) fromBS bs = copyAndFreeze bs (\_ -> return ())
byteArrayToW64BE :: ByteArrayAccess bs => bs -> Int -> Word64 toW64BE :: ByteArrayAccess bs => bs -> Int -> Word64
byteArrayToW64BE bs ofs = unsafeDoIO $ withByteArray bs $ \p -> fromBE64 <$> peek (p `plusPtr` ofs) toW64BE bs ofs = unsafeDoIO $ withByteArray bs $ \p -> fromBE64 <$> peek (p `plusPtr` ofs)
byteArrayToW64LE :: ByteArrayAccess bs => bs -> Int -> Word64 toW64LE :: ByteArrayAccess bs => bs -> Int -> Word64
byteArrayToW64LE bs ofs = unsafeDoIO $ withByteArray bs $ \p -> fromLE64 <$> peek (p `plusPtr` ofs) toW64LE bs ofs = unsafeDoIO $ withByteArray bs $ \p -> fromLE64 <$> peek (p `plusPtr` ofs)
byteArrayMapAsWord128 :: ByteArray bs => (Word128 -> Word128) -> bs -> bs mapAsWord128 :: ByteArray bs => (Word128 -> Word128) -> bs -> bs
byteArrayMapAsWord128 f bs = mapAsWord128 f bs =
byteArrayAllocAndFreeze len $ \dst -> allocAndFreeze len $ \dst ->
withByteArray bs $ \src -> withByteArray bs $ \src ->
loop (len `div` 16) dst src loop (len `div` 16) dst src
where where
len = byteArrayLength bs len = length bs
loop 0 _ _ = return () loop 0 _ _ = return ()
loop i d s = do loop i d s = do
w1 <- peek s w1 <- peek s
@ -231,13 +234,13 @@ byteArrayMapAsWord128 f bs =
poke (d `plusPtr` 8) (toBE64 r2) poke (d `plusPtr` 8) (toBE64 r2)
loop (i-1) (d `plusPtr` 16) (s `plusPtr` 16) loop (i-1) (d `plusPtr` 16) (s `plusPtr` 16)
byteArrayMapAsWord64 :: ByteArray bs => (Word64 -> Word64) -> bs -> bs mapAsWord64 :: ByteArray bs => (Word64 -> Word64) -> bs -> bs
byteArrayMapAsWord64 f bs = mapAsWord64 f bs =
byteArrayAllocAndFreeze len $ \dst -> allocAndFreeze len $ \dst ->
withByteArray bs $ \src -> withByteArray bs $ \src ->
loop (len `div` 8) dst src loop (len `div` 8) dst src
where where
len = byteArrayLength bs len = length bs
loop 0 _ _ = return () loop 0 _ _ = return ()
loop i d s = do loop i d s = do
w <- peek s w <- peek s
@ -245,5 +248,5 @@ byteArrayMapAsWord64 f bs =
poke d (toBE64 r) poke d (toBE64 r)
loop (i-1) (d `plusPtr` 8) (s `plusPtr` 8) loop (i-1) (d `plusPtr` 8) (s `plusPtr` 8)
byteArrayConvert :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout convert :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout
byteArrayConvert = flip byteArrayCopyAndFreeze (\_ -> return ()) convert = flip copyAndFreeze (\_ -> return ())

17
Crypto/PubKey/Curve25519.hs
View File

@ -27,7 +27,8 @@ import Foreign.Ptr
import Crypto.Internal.Compat import Crypto.Internal.Compat
import Crypto.Internal.Imports import Crypto.Internal.Imports
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArrayAccess, SecureBytes, withByteArray)
import qualified Crypto.Internal.ByteArray as B
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
-- | A Curve25519 Secret key -- | A Curve25519 Secret key
@ -46,17 +47,17 @@ newtype DhSecret = DhSecret SecureBytes
-- | Try to build a public key from a bytearray -- | Try to build a public key from a bytearray
publicKey :: ByteArrayAccess bs => bs -> Either String PublicKey publicKey :: ByteArrayAccess bs => bs -> Either String PublicKey
publicKey bs publicKey bs
| byteArrayLength bs == 32 = Right $ PublicKey $ byteArrayCopyAndFreeze bs (\_ -> return ()) | B.length bs == 32 = Right $ PublicKey $ B.copyAndFreeze bs (\_ -> return ())
| otherwise = Left "invalid public key size" | otherwise = Left "invalid public key size"
-- | Try to build a secret key from a bytearray -- | Try to build a secret key from a bytearray
secretKey :: ByteArrayAccess bs => bs -> Either String SecretKey secretKey :: ByteArrayAccess bs => bs -> Either String SecretKey
secretKey bs secretKey bs
| byteArrayLength bs == 32 = unsafeDoIO $ do | B.length bs == 32 = unsafeDoIO $ do
withByteArray bs $ \inp -> do withByteArray bs $ \inp -> do
valid <- isValidPtr inp valid <- isValidPtr inp
if valid if valid
then Right . SecretKey <$> byteArrayCopy bs (\_ -> return ()) then Right . SecretKey <$> B.copy bs (\_ -> return ())
else return $ Left "invalid secret key" else return $ Left "invalid secret key"
| otherwise = Left "secret key invalid size" | otherwise = Left "secret key invalid size"
where where
@ -81,8 +82,8 @@ secretKey bs
-- | Create a DhSecret from a bytearray object -- | Create a DhSecret from a bytearray object
dhSecret :: ByteArrayAccess b => b -> Either String DhSecret dhSecret :: ByteArrayAccess b => b -> Either String DhSecret
dhSecret bs dhSecret bs
| byteArrayLength bs == 32 = Right $ DhSecret $ byteArrayCopyAndFreeze bs (\_ -> return ()) | B.length bs == 32 = Right $ DhSecret $ B.copyAndFreeze bs (\_ -> return ())
| otherwise = Left "invalid dh secret size" | otherwise = Left "invalid dh secret size"
basePoint :: PublicKey basePoint :: PublicKey
basePoint = PublicKey "\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" basePoint = PublicKey "\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
@ -90,7 +91,7 @@ basePoint = PublicKey "\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-- | Compute the Diffie Hellman secret from a public key and a secret key -- | Compute the Diffie Hellman secret from a public key and a secret key
dh :: PublicKey -> SecretKey -> DhSecret dh :: PublicKey -> SecretKey -> DhSecret
dh (PublicKey pub) (SecretKey sec) = DhSecret <$> dh (PublicKey pub) (SecretKey sec) = DhSecret <$>
byteArrayAllocAndFreeze 32 $ \result -> B.allocAndFreeze 32 $ \result ->
withByteArray sec $ \psec -> withByteArray sec $ \psec ->
withByteArray pub $ \ppub -> withByteArray pub $ \ppub ->
ccryptonite_curve25519 result psec ppub ccryptonite_curve25519 result psec ppub
@ -99,7 +100,7 @@ dh (PublicKey pub) (SecretKey sec) = DhSecret <$>
-- | Create a public key from a secret key -- | Create a public key from a secret key
toPublic :: SecretKey -> PublicKey toPublic :: SecretKey -> PublicKey
toPublic (SecretKey sec) = PublicKey <$> toPublic (SecretKey sec) = PublicKey <$>
byteArrayAllocAndFreeze 32 $ \result -> B.allocAndFreeze 32 $ \result ->
withByteArray sec $ \psec -> withByteArray sec $ \psec ->
withByteArray basePoint $ \pbase -> withByteArray basePoint $ \pbase ->
ccryptonite_curve25519 result psec pbase ccryptonite_curve25519 result psec pbase

23
Crypto/PubKey/Ed25519.hs
View File

@ -31,7 +31,8 @@ import Foreign.C.Types
import Crypto.Internal.Compat import Crypto.Internal.Compat
import Crypto.Internal.Imports import Crypto.Internal.Imports
import Crypto.Internal.Memory import Crypto.Internal.Memory
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArrayAccess, withByteArray)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Error import Crypto.Error
-- | An Ed25519 Secret key -- | An Ed25519 Secret key
@ -49,19 +50,19 @@ newtype Signature = Signature Bytes
-- | Try to build a public key from a bytearray -- | Try to build a public key from a bytearray
publicKey :: ByteArrayAccess ba => ba -> CryptoFailable PublicKey publicKey :: ByteArrayAccess ba => ba -> CryptoFailable PublicKey
publicKey bs publicKey bs
| byteArrayLength bs == publicKeySize = | B.length bs == publicKeySize =
CryptoPassed $ PublicKey $ byteArrayCopyAndFreeze bs (\_ -> return ()) CryptoPassed $ PublicKey $ B.copyAndFreeze bs (\_ -> return ())
| otherwise = | otherwise =
CryptoFailed $ CryptoError_PublicKeySizeInvalid CryptoFailed $ CryptoError_PublicKeySizeInvalid
-- | Try to build a secret key from a bytearray -- | Try to build a secret key from a bytearray
secretKey :: ByteArrayAccess ba => ba -> CryptoFailable SecretKey secretKey :: ByteArrayAccess ba => ba -> CryptoFailable SecretKey
secretKey bs secretKey bs
| byteArrayLength bs == secretKeySize = unsafeDoIO $ do | B.length bs == secretKeySize = unsafeDoIO $ do
withByteArray bs $ \inp -> do withByteArray bs $ \inp -> do
valid <- isValidPtr inp valid <- isValidPtr inp
if valid if valid
then CryptoPassed . SecretKey <$> byteArrayCopy bs (\_ -> return ()) then CryptoPassed . SecretKey <$> B.copy bs (\_ -> return ())
else return $ CryptoFailed CryptoError_SecretKeyStructureInvalid else return $ CryptoFailed CryptoError_SecretKeyStructureInvalid
| otherwise = CryptoFailed CryptoError_SecretKeyStructureInvalid | otherwise = CryptoFailed CryptoError_SecretKeyStructureInvalid
where where
@ -73,15 +74,15 @@ secretKey bs
-- | Try to build a signature from a bytearray -- | Try to build a signature from a bytearray
signature :: ByteArrayAccess ba => ba -> CryptoFailable Signature signature :: ByteArrayAccess ba => ba -> CryptoFailable Signature
signature bs signature bs
| byteArrayLength bs == signatureSize = | B.length bs == signatureSize =
CryptoPassed $ Signature $ byteArrayCopyAndFreeze bs (\_ -> return ()) CryptoPassed $ Signature $ B.copyAndFreeze bs (\_ -> return ())
| otherwise = | otherwise =
CryptoFailed CryptoError_SecretKeyStructureInvalid CryptoFailed CryptoError_SecretKeyStructureInvalid
-- | Create a public key from a secret key -- | Create a public key from a secret key
toPublic :: SecretKey -> PublicKey toPublic :: SecretKey -> PublicKey
toPublic (SecretKey sec) = PublicKey <$> toPublic (SecretKey sec) = PublicKey <$>
byteArrayAllocAndFreeze publicKeySize $ \result -> B.allocAndFreeze publicKeySize $ \result ->
withByteArray sec $ \psec -> withByteArray sec $ \psec ->
ccryptonite_ed25519_publickey psec result ccryptonite_ed25519_publickey psec result
{-# NOINLINE toPublic #-} {-# NOINLINE toPublic #-}
@ -89,13 +90,13 @@ toPublic (SecretKey sec) = PublicKey <$>
-- | Sign a message using the key pair -- | Sign a message using the key pair
sign :: ByteArrayAccess ba => SecretKey -> PublicKey -> ba -> Signature sign :: ByteArrayAccess ba => SecretKey -> PublicKey -> ba -> Signature
sign secret public message = sign secret public message =
Signature $ byteArrayAllocAndFreeze signatureSize $ \sig -> Signature $ B.allocAndFreeze signatureSize $ \sig ->
withByteArray secret $ \sec -> withByteArray secret $ \sec ->
withByteArray public $ \pub -> withByteArray public $ \pub ->
withByteArray message $ \msg -> withByteArray message $ \msg ->
ccryptonite_ed25519_sign msg (fromIntegral msgLen) sec pub sig ccryptonite_ed25519_sign msg (fromIntegral msgLen) sec pub sig
where where
!msgLen = byteArrayLength message !msgLen = B.length message
-- | Verify a message -- | Verify a message
verify :: ByteArrayAccess ba => PublicKey -> ba -> Signature -> Bool verify :: ByteArrayAccess ba => PublicKey -> ba -> Signature -> Bool
@ -106,7 +107,7 @@ verify public message signatureVal = unsafeDoIO $
r <- ccryptonite_ed25519_sign_open msg (fromIntegral msgLen) pub sig r <- ccryptonite_ed25519_sign_open msg (fromIntegral msgLen) pub sig
return (r == 0) return (r == 0)
where where
!msgLen = byteArrayLength message !msgLen = B.length message
publicKeySize :: Int publicKeySize :: Int
publicKeySize = 32 publicKeySize = 32

16
Crypto/Random/ChaChaDRG.hs
View File

@ -11,11 +11,11 @@ module Crypto.Random.ChaChaDRG
, initializeWords , initializeWords
) where ) where
import Crypto.Random.Types import Crypto.Random.Types
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArray, SecureBytes)
import Data.SecureMem import qualified Crypto.Internal.ByteArray as B
import Data.Word import Data.Word
import Foreign.Storable (pokeElemOff) import Foreign.Storable (pokeElemOff)
import qualified Crypto.Cipher.ChaCha as C import qualified Crypto.Cipher.ChaCha as C
@ -35,10 +35,10 @@ initialize seed = ChaChaDRG $ C.initializeSimple seed
-- | Initialize a new ChaCha context from 5-tuple of words64. -- | Initialize a new ChaCha context from 5-tuple of words64.
-- This interface is useful when creating a RNG out of tests generators (e.g. QuickCheck). -- This interface is useful when creating a RNG out of tests generators (e.g. QuickCheck).
initializeWords :: (Word64, Word64, Word64, Word64, Word64) -> ChaChaDRG initializeWords :: (Word64, Word64, Word64, Word64, Word64) -> ChaChaDRG
initializeWords (a,b,c,d,e) = initialize (byteArrayAllocAndFreeze 40 fill :: SecureMem) initializeWords (a,b,c,d,e) = initialize (B.allocAndFreeze 40 fill :: SecureBytes)
where fill s = mapM_ (uncurry (pokeElemOff s)) [(0,a), (1,b), (2,c), (3,d), (4,e)] where fill s = mapM_ (uncurry (pokeElemOff s)) [(0,a), (1,b), (2,c), (3,d), (4,e)]
generate :: ByteArray byteArray => Int -> ChaChaDRG -> (byteArray, ChaChaDRG) generate :: ByteArray output => Int -> ChaChaDRG -> (output, ChaChaDRG)
generate nbBytes st@(ChaChaDRG prevSt) generate nbBytes st@(ChaChaDRG prevSt)
| nbBytes <= 0 = (empty, st) | nbBytes <= 0 = (B.empty, st)
| otherwise = let (output, newSt) = C.generateSimple prevSt nbBytes in (output, ChaChaDRG newSt) | otherwise = let (output, newSt) = C.generateSimple prevSt nbBytes in (output, ChaChaDRG newSt)

9
Crypto/Random/Entropy.hs
View File

@ -9,13 +9,14 @@ module Crypto.Random.Entropy
( getEntropy ( getEntropy
) where ) where
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArray)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Random.Entropy.Unsafe import Crypto.Random.Entropy.Unsafe
-- | Get some entropy from the system source of entropy -- | Get some entropy from the system source of entropy
getEntropy :: ByteArray byteArray => Int -> IO byteArray getEntropy :: ByteArray byteArray => Int -> IO byteArray
getEntropy n = do getEntropy n = do
backends <- catMaybes `fmap` sequence supportedBackends backends <- catMaybes `fmap` sequence supportedBackends
byteArrayAlloc n (replenish n backends) B.alloc n (replenish n backends)

19
Crypto/Random/EntropyPool.hs
View File

@ -12,14 +12,15 @@ module Crypto.Random.EntropyPool
, getEntropyFrom , getEntropyFrom
) where ) where
import Control.Concurrent.MVar import Control.Concurrent.MVar
import Crypto.Random.Entropy.Unsafe import Crypto.Random.Entropy.Unsafe
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray (ByteArray)
import Data.SecureMem import qualified Crypto.Internal.ByteArray as B
import Data.Word (Word8) import Data.SecureMem
import Data.Maybe (catMaybes) import Data.Word (Word8)
import Foreign.Marshal.Utils (copyBytes) import Data.Maybe (catMaybes)
import Foreign.Ptr (plusPtr, Ptr) import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (plusPtr, Ptr)
-- | Pool of Entropy. contains a self mutating pool of entropy, -- | Pool of Entropy. contains a self mutating pool of entropy,
-- that is always guarantee to contains data. -- that is always guarantee to contains data.
@ -67,4 +68,4 @@ getEntropyPtr (EntropyPool backends posM sm) n outPtr =
-- | Grab a chunk of entropy from the entropy pool. -- | Grab a chunk of entropy from the entropy pool.
getEntropyFrom :: ByteArray byteArray => EntropyPool -> Int -> IO byteArray getEntropyFrom :: ByteArray byteArray => EntropyPool -> Int -> IO byteArray
getEntropyFrom pool n = byteArrayAlloc n (getEntropyPtr pool n) getEntropyFrom pool n = B.alloc n (getEntropyPtr pool n)

12
tests/BlockCipher.hs
View File

@ -12,11 +12,11 @@ module BlockCipher
, CipherInfo , CipherInfo
) where ) where
import Imports import Imports
import Data.Maybe import Data.Maybe
import Crypto.Error import Crypto.Error
import Crypto.Cipher.Types import Crypto.Cipher.Types
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray as B
import qualified Data.ByteString as B import qualified Data.ByteString as B
------------------------------------------------------------------------ ------------------------------------------------------------------------
@ -405,7 +405,7 @@ testBlockCipherAEAD cipher =
(dText, aeadD) = aeadDecrypt aead eText (dText, aeadD) = aeadDecrypt aead eText
eTag = aeadFinalize aeadE (blockSize ctx) eTag = aeadFinalize aeadE (blockSize ctx)
dTag = aeadFinalize aeadD (blockSize ctx) dTag = aeadFinalize aeadD (blockSize ctx)
in (plaintext `assertEq` dText) && (eTag `byteArrayEq` dTag) in (plaintext `assertEq` dText) && (eTag `B.eq` dTag)
CryptoFailed err CryptoFailed err
| err == CryptoError_AEADModeNotSupported -> True | err == CryptoError_AEADModeNotSupported -> True
| otherwise -> error ("testProperty_AEAD: " ++ show err) | otherwise -> error ("testProperty_AEAD: " ++ show err)

6
tests/KAT_Curve25519.hs
View File

@ -2,7 +2,7 @@
module KAT_Curve25519 ( tests ) where module KAT_Curve25519 ( tests ) where
import qualified Crypto.PubKey.Curve25519 as Curve25519 import qualified Crypto.PubKey.Curve25519 as Curve25519
import Crypto.Internal.ByteArray import Crypto.Internal.ByteArray as B
import Imports import Imports
alicePrivate = either error id $ Curve25519.secretKey ("\x77\x07\x6d\x0a\x73\x18\xa5\x7d\x3c\x16\xc1\x72\x51\xb2\x66\x45\xdf\x4c\x2f\x87\xeb\xc0\x99\x2a\xb1\x77\xfb\xa5\x1d\xb9\x2c\x2a" :: ByteString) alicePrivate = either error id $ Curve25519.secretKey ("\x77\x07\x6d\x0a\x73\x18\xa5\x7d\x3c\x16\xc1\x72\x51\xb2\x66\x45\xdf\x4c\x2f\x87\xeb\xc0\x99\x2a\xb1\x77\xfb\xa5\x1d\xb9\x2c\x2a" :: ByteString)
@ -13,8 +13,8 @@ aliceMultBob = "\x4a\x5d\x9d\x5b\xa4\xce\x2d\xe1\x72\x8e\x3b\xf4\x80\x35\x0f\x25
katTests :: [TestTree] katTests :: [TestTree]
katTests = katTests =
[ testCase "0" (aliceMultBob @=? byteArrayConvert (Curve25519.dh alicePublic bobPrivate)) [ testCase "0" (aliceMultBob @=? B.convert (Curve25519.dh alicePublic bobPrivate))
, testCase "1" (aliceMultBob @=? byteArrayConvert (Curve25519.dh bobPublic alicePrivate)) , testCase "1" (aliceMultBob @=? B.convert (Curve25519.dh bobPublic alicePrivate))
] ]
tests = testGroup "Curve25519" tests = testGroup "Curve25519"