raaz 0.0.2 → 0.1.0

raw patch · 84 files changed

+4670/−2213 lines, 84 filesdep +prettydep ~basedep ~bytestringdep ~criterionnew-component:exe:raazPVP ok

version bump matches the API change (PVP)

Dependencies added: pretty

Dependency ranges changed: base, bytestring, criterion, deepseq, mtl, raaz, vector

API changes (from Hackage documentation)

Files

• Raaz.hs +2/−1
• Raaz/Cipher.hs +18/−2
• Raaz/Cipher/AES/CBC/Implementation/CPortable.hs +42/−35
• Raaz/Cipher/AES/Internal.hs +37/−19
• Raaz/Cipher/AES/Recommendation.hs +3/−3
• Raaz/Cipher/ChaCha20.hs +10/−0
• Raaz/Cipher/ChaCha20/Implementation/CPortable.hs +53/−0
• Raaz/Cipher/ChaCha20/Implementation/Vector128.hs +39/−0
• Raaz/Cipher/ChaCha20/Implementation/Vector256.hs +51/−0
• Raaz/Cipher/ChaCha20/Internal.hs +91/−0
• Raaz/Cipher/ChaCha20/Recommendation.hs +88/−0
• Raaz/Cipher/Internal.hs +129/−41
• Raaz/Core.hs +0/−2
• Raaz/Core/ByteSource.hs +22/−19
• Raaz/Core/Encode/Base16.hs +12/−1
• Raaz/Core/Encode/Base64.hs +10/−2
• Raaz/Core/Encode/Internal.hs +8/−9
• Raaz/Core/Memory.hs +190/−101
• Raaz/Core/MonoidalAction.hs +1/−7
• Raaz/Core/Parse/Applicative.hs +18/−24
• Raaz/Core/Primitives.hs +39/−24
• Raaz/Core/Random.hs +0/−104
• Raaz/Core/Transfer.hs +309/−0
• Raaz/Core/Types.hs +43/−52
• Raaz/Core/Types/Aligned.hs +83/−0
• Raaz/Core/Types/Copying.hs +52/−0
• Raaz/Core/Types/Endian.hs +226/−76
• Raaz/Core/Types/Equality.hs +180/−105
• Raaz/Core/Types/Pointer.hs +219/−91
• Raaz/Core/Types/Tuple.hs +69/−55
• Raaz/Core/Util/ByteString.hs +23/−18
• Raaz/Core/Write.hs +0/−147
• Raaz/Hash.hs +7/−2
• Raaz/Hash/Internal.hs +32/−12
• Raaz/Hash/Internal/HMAC.hs +19/−22
• Raaz/Hash/Sha/Util.hs +99/−78
• Raaz/Hash/Sha1.hs +21/−4
• Raaz/Hash/Sha1/Implementation/CPortable.hs +6/−2
• Raaz/Hash/Sha1/Internal.hs +0/−4
• Raaz/Hash/Sha224/Implementation/CPortable.hs +6/−5
• Raaz/Hash/Sha224/Internal.hs +0/−1
• Raaz/Hash/Sha256/Implementation/CPortable.hs +7/−2
• Raaz/Hash/Sha256/Internal.hs +0/−1
• Raaz/Hash/Sha384/Implementation/CPortable.hs +6/−5
• Raaz/Hash/Sha512/Implementation/CPortable.hs +6/−2
• Raaz/Hash/Sha512/Internal.hs +0/−1
• Raaz/Random.hs +263/−0
• Raaz/Random/ChaCha20PRG.hs +123/−0
• benchmarks/BenchPrimitives.hs +181/−0
• benchmarks/BlazeVsWrite.hs +2/−2
• benchmarks/Cipher.hs +79/−0
• bin/Command/Checksum.lhs +320/−0
• bin/Command/Rand.lhs +86/−0
• bin/Main.hs +86/−0
• bin/checksum.lhs +0/−316
• cbits/raaz/cipher/chacha20/common.h +53/−0
• cbits/raaz/cipher/chacha20/cportable.c +126/−0
• cbits/raaz/cipher/chacha20/vector128.c +175/−0
• cbits/raaz/cipher/chacha20/vector256.c +179/−0
• cbits/raaz/core/endian.c +67/−134
• cbits/raaz/core/endian.h +69/−19
• cbits/raaz/hash/blake256/portable.c +0/−481
• cbits/raaz/hash/sha1/portable.c +18/−17
• cbits/raaz/hash/sha256/portable.c +18/−17
• cbits/raaz/hash/sha512/portable.c +18/−17
• entropy/arc4random/Raaz/Entropy.hs +20/−0
• entropy/urandom/Raaz/Entropy.hs +12/−0
• raaz.cabal +205/−76
• spec/Common/Cipher.hs +83/−5
• spec/Common/Imports.hs +3/−2
• spec/Common/Instances.hs +13/−0
• spec/Common/Utils.hs +43/−4
• spec/Raaz/Cipher/AESSpec.hs +3/−3
• spec/Raaz/Cipher/ChaCha20Spec.hs +118/−0
• spec/Raaz/Core/EncodeSpec.hs +2/−2
• spec/Raaz/Core/SystemPRGSpec.hs +0/−12
• spec/Raaz/Core/Types/WordSpec.hs +4/−8
• spec/Raaz/Core/Util/ByteStringSpec.hs +8/−9
• spec/Raaz/Hash/Sha1Spec.hs +1/−2
• spec/Raaz/Hash/Sha224Spec.hs +1/−2
• spec/Raaz/Hash/Sha256Spec.hs +1/−2
• spec/Raaz/Hash/Sha384Spec.hs +1/−2
• spec/Raaz/Hash/Sha512Spec.hs +2/−2
• spec/Raaz/RandomSpec.hs +11/−0

@@ -5,6 +5,7 @@        ( module Raaz.Cipher        , module Raaz.Core        , module Raaz.Hash+       , module Raaz.Random        , version        ) where @@ -14,7 +15,7 @@ import           Raaz.Core import           Raaz.Hash import           Raaz.Cipher-+import           Raaz.Random  -- | Raaz library version number. version :: Version

@@ -4,14 +4,30 @@ module Raaz.Cipher        ( -- * Ciphers          -- $cipherdoc$-         aes128cbc, aes192cbc, aes256cbc+         StreamCipher+       , transform, chacha20+       , Cipher+       , aes128cbc, aes192cbc, aes256cbc        ) where   import Raaz.Cipher.AES      ( aes128cbc, aes192cbc, aes256cbc)+import Raaz.Cipher.ChaCha20+import Raaz.Cipher.Internal (transform, Cipher, StreamCipher)  -- $cipherdoc$ -- -- The raaz library exposes symmetric key encryption using instances -- of the class `Cipher`. For a cipher @c@, the type family @`Key` c@--- gives the type of its key.+-- gives the type of its key. As of now, we only support the safe+-- usage of stream ciphers. Encryption and Decryption are the same for+-- stream ciphers and we call this combinator `transform`. Block+-- ciphers do not have a natural way to handle streams that are of+-- size less than their block size. A future release will handle these+-- issues.+--+-- If you are thinking of encryption using private keys consider+-- encrypted-authenticated modes. Currently we do not have support for+-- this either but hopefully this will also be fixed soon.+--+-- TODO: Fix the above documentation when it is done.

@@ -8,6 +8,9 @@  import Control.Applicative import Control.Monad.IO.Class   ( liftIO )+import Foreign.Ptr              ( Ptr    )+import Prelude+ import Raaz.Core import Raaz.Cipher.Internal import Raaz.Cipher.AES.Internal@@ -20,15 +23,15 @@                  }  instance Memory M128  where-  memoryAlloc   = M128 <$> memoryAlloc <*> memoryAlloc-  underlyingPtr = underlyingPtr . m128ekey+  memoryAlloc     = M128 <$> memoryAlloc <*> memoryAlloc+  unsafeToPointer = unsafeToPointer . m128ekey  instance Initialisable M128 (KEY128, IV) where   initialise (k,iv) = do-    liftSubMT m128ekey $ do initialise k-                            withPointer $ c_transpose 11-    liftSubMT m128iv   $ do initialise iv-                            withPointer $ c_transpose 1+    onSubMemory m128ekey $ do initialise k+                              withCellPointer $ c_transpose 11+    onSubMemory m128iv   $ do initialise iv+                              withCellPointer $ c_transpose 1  ------------- Memory for 192-bit cbc -------------- @@ -38,15 +41,15 @@                  }  instance Memory M192  where-  memoryAlloc   = M192 <$> memoryAlloc <*> memoryAlloc-  underlyingPtr = underlyingPtr . m192ekey+  memoryAlloc     = M192 <$> memoryAlloc <*> memoryAlloc+  unsafeToPointer = unsafeToPointer . m192ekey  instance Initialisable M192 (KEY192, IV) where   initialise (k,iv) = do-    liftSubMT m192ekey $ do initialise k-                            withPointer $ c_transpose 13-    liftSubMT m192iv   $ do initialise iv-                            withPointer $ c_transpose 1+    onSubMemory m192ekey $ do initialise k+                              withCellPointer $ c_transpose 13+    onSubMemory m192iv   $ do initialise iv+                              withCellPointer $ c_transpose 1   ------------- Memory for 256-bit cbc --------------@@ -57,15 +60,15 @@                  }  instance Memory M256  where-  memoryAlloc   = M256 <$> memoryAlloc <*> memoryAlloc-  underlyingPtr = underlyingPtr . m256ekey+  memoryAlloc     = M256 <$> memoryAlloc <*> memoryAlloc+  unsafeToPointer = unsafeToPointer . m256ekey  instance Initialisable M256 (KEY256, IV) where   initialise (k,iv) = do-    liftSubMT m256ekey $ do initialise k-                            withPointer $ c_transpose 15-    liftSubMT m256iv   $ do initialise iv-                            withPointer $ c_transpose 1+    onSubMemory m256ekey $ do initialise k+                              withCellPointer $ c_transpose 15+    onSubMemory m256iv   $ do initialise iv+                              withCellPointer $ c_transpose 1  ------------------- 128-bit CBC Implementation ---------------- @@ -81,20 +84,21 @@             "128-bit AES in cbc mode implemented in Portable C"           , encryptBlocks = cbc128Encrypt           , decryptBlocks = cbc128Decrypt+          , cipherStartAlignment = wordAlignment           }  -- | The encryption action. cbc128Encrypt :: Pointer -> BLOCKS (AES 128 'CBC) -> MT M128 () cbc128Encrypt buf nBlocks =-  do eKeyPtr <- liftSubMT m128ekey getMemoryPointer-     ivPtr   <- liftSubMT m128iv   getMemoryPointer+  do eKeyPtr <- onSubMemory m128ekey getCellPointer+     ivPtr   <- onSubMemory m128iv   getCellPointer      liftIO $ c_aes_cbc_e buf (fromEnum nBlocks) 10 eKeyPtr ivPtr  -- | The decryption action. cbc128Decrypt :: Pointer -> BLOCKS (AES 128 'CBC) -> MT M128 () cbc128Decrypt buf nBlocks =-  do eKeyPtr <- liftSubMT m128ekey getMemoryPointer-     ivPtr   <- liftSubMT m128iv   getMemoryPointer+  do eKeyPtr <- onSubMemory m128ekey getCellPointer+     ivPtr   <- onSubMemory m128iv   getCellPointer      liftIO $ c_aes_cbc_d buf (fromEnum nBlocks) 10 eKeyPtr ivPtr  @@ -113,20 +117,21 @@             "192-bit AES in cbc mode implemented in Portable C"           , encryptBlocks = cbc192Encrypt           , decryptBlocks = cbc192Decrypt+          , cipherStartAlignment = wordAlignment           }  -- | The encryption action. cbc192Encrypt :: Pointer -> BLOCKS (AES 192 'CBC) -> MT M192 () cbc192Encrypt buf nBlocks =-  do eKeyPtr <- liftSubMT m192ekey getMemoryPointer-     ivPtr   <- liftSubMT m192iv   getMemoryPointer+  do eKeyPtr <- onSubMemory m192ekey getCellPointer+     ivPtr   <- onSubMemory m192iv   getCellPointer      liftIO $ c_aes_cbc_e buf (fromEnum nBlocks) 12 eKeyPtr ivPtr  -- | The decryption action. cbc192Decrypt :: Pointer -> BLOCKS (AES 192 'CBC) -> MT M192 () cbc192Decrypt buf nBlocks =-  do eKeyPtr <- liftSubMT m192ekey getMemoryPointer-     ivPtr   <- liftSubMT m192iv   getMemoryPointer+  do eKeyPtr <- onSubMemory m192ekey getCellPointer+     ivPtr   <- onSubMemory m192iv   getCellPointer      liftIO $ c_aes_cbc_d buf (fromEnum nBlocks) 12 eKeyPtr ivPtr  ------------------- 256-bit CBC Implementation ----------------@@ -143,20 +148,22 @@             "256-bit AES in cbc mode implemented in Portable C"           , encryptBlocks = cbc256Encrypt           , decryptBlocks = cbc256Decrypt+          , cipherStartAlignment = wordAlignment+           }  -- | The encryption action. cbc256Encrypt :: Pointer -> BLOCKS (AES 256 'CBC) -> MT M256 () cbc256Encrypt buf nBlocks =-  do eKeyPtr <- liftSubMT m256ekey getMemoryPointer-     ivPtr   <- liftSubMT m256iv   getMemoryPointer+  do eKeyPtr <- onSubMemory m256ekey getCellPointer+     ivPtr   <- onSubMemory m256iv   getCellPointer      liftIO $ c_aes_cbc_e buf (fromEnum nBlocks) 14 eKeyPtr ivPtr  -- | The decryption action. cbc256Decrypt :: Pointer -> BLOCKS (AES 256 'CBC) -> MT M256 () cbc256Decrypt buf nBlocks =-  do eKeyPtr <- liftSubMT m256ekey getMemoryPointer-     ivPtr   <- liftSubMT m256iv   getMemoryPointer+  do eKeyPtr <- onSubMemory m256ekey getCellPointer+     ivPtr   <- onSubMemory m256iv   getCellPointer      liftIO $ c_aes_cbc_d buf (fromEnum nBlocks) 14 eKeyPtr ivPtr  --------------------- Foreign functions ------------------------@@ -164,7 +171,7 @@ -- | Transpose AES matrices. foreign import ccall unsafe   "raaz/cipher/aes/common.h raazAESTranspose"-  c_transpose :: Int -> Pointer -> IO ()+  c_transpose :: Int -> Ptr ekey -> IO ()   -- | CBC encrypt.@@ -173,8 +180,8 @@   c_aes_cbc_e :: Pointer  -- Input               -> Int      -- number of blocks               -> Int      -- rounds-              -> Pointer  -- extended key-              -> Pointer  -- iv+              -> Ptr ekey -- extended key+              -> Ptr iv   -- iv               -> IO () -- | CBC decrypt foreign import ccall unsafe@@ -182,6 +189,6 @@   c_aes_cbc_d :: Pointer  -- Input               -> Int      -- number of blocks               -> Int      -- rounds-              -> Pointer  -- extened key-              -> Pointer  -- iv+              -> Ptr ekey -- extened key+              -> Ptr iv  -- iv               -> IO ()

@@ -19,12 +19,13 @@ import Data.String import Data.Word -import Foreign.Ptr      (castPtr )+import Foreign.Ptr      ( castPtr, Ptr ) import Foreign.Storable (Storable, poke) import GHC.TypeLits - import Raaz.Core+import Raaz.Random+ import Raaz.Cipher.Internal  --------------- Basic types associated with AES -------------@@ -55,10 +56,16 @@ instance Encodable KEY192 instance Encodable KEY256 -instance Random KEY128-instance Random KEY192-instance Random KEY256+instance Random KEY128 where+  random = unsafeStorableRandom ++instance Random KEY192 where+  random = unsafeStorableRandom++instance Random KEY256 where+  random = unsafeStorableRandom+ -- | Expects in base 16 instance IsString KEY128 where   fromString = fromBase16@@ -89,7 +96,8 @@ newtype IV  = IV (TUPLE 4) deriving (Storable, EndianStore)  instance Encodable IV-instance Random IV+instance Random IV where+  random = unsafeStorableRandom  -- | Expects in base16. instance IsString IV where@@ -111,9 +119,12 @@   type Implementation (AES 128 'CBC) = SomeCipherI (AES 128 'CBC)  -- | Key is @(`KEY128`,`IV`)@ pair.-instance Symmetric (AES 128 'CBC) where-  type Key (AES 128 'CBC) = (KEY128,IV)+type instance Key (AES 128 'CBC) = (KEY128,IV) +instance Describable (AES 128 'CBC) where+  name _ = "aes-128-cbc"+  description _ = "The AES cipher in CBC mode with 128-bit key"+ instance Cipher (AES 128 'CBC)  ----------------- AES 192 CBC --------------------------------@@ -128,9 +139,12 @@   type Implementation (AES 192 'CBC) = SomeCipherI (AES 192 'CBC)  -- | Key is @(`KEY192`,`IV`)@ pair.-instance Symmetric (AES 192 'CBC) where-  type Key (AES 192 'CBC) = (KEY192,IV)+type instance Key (AES 192 'CBC) = (KEY192,IV) +instance Describable (AES 192 'CBC) where+  name _ = "aes-192-cbc"+  description _ = "The AES cipher in CBC mode with 192-bit key"+ instance Cipher (AES 192 'CBC)  ------------------- AES 256 CBC -----------------------------@@ -145,9 +159,13 @@   type Implementation (AES 256 'CBC) = SomeCipherI (AES 256 'CBC)  -- | Key is @(`KEY256`,`IV`)@ pair.-instance Symmetric (AES 256 'CBC) where-  type Key (AES 256 'CBC) = (KEY256,IV)+type instance Key (AES 256 'CBC) = (KEY256,IV) ++instance Describable (AES 256 'CBC) where+  name _ = "aes-256-cbc"+  description _ = "The AES cipher in CBC mode with 256-bit key"+ instance Cipher (AES 256 'CBC)  @@ -164,22 +182,22 @@ newtype EKEY256 = EKEY256 (TUPLE 60) deriving (Storable, EndianStore)  instance Initialisable (MemoryCell EKEY128) KEY128 where-  initialise k = withPointer $ pokeAndExpand k (c_expand 4)+  initialise k = withCellPointer $ pokeAndExpand k (c_expand 4)  instance Initialisable (MemoryCell EKEY192) KEY192 where-  initialise k = withPointer $ pokeAndExpand k (c_expand 6)+  initialise k = withCellPointer $ pokeAndExpand k (c_expand 6)  instance Initialisable (MemoryCell EKEY256) KEY256 where-  initialise k = withPointer $ pokeAndExpand k (c_expand 8)+  initialise k = withCellPointer $ pokeAndExpand k (c_expand 8)  foreign import ccall unsafe   "raaz/cipher/aes/common.h raazAESExpand"-  c_expand :: Int -> Pointer -> IO ()+  c_expand :: Int -> Ptr ekey -> IO ()  -- | Poke a key and expand it with the given routine. pokeAndExpand :: Storable k-              => k                   -- ^ key to poke-              -> (Pointer -> IO ())  -- ^ expansion algorithm-              -> Pointer             -- ^ buffer pointer.+              => k                    -- ^ key to poke+              -> (Ptr ekey -> IO ())  -- ^ expansion algorithm+              -> Ptr ekey             -- ^ buffer pointer.               -> IO () pokeAndExpand k expander ptr = poke (castPtr ptr) k >> expander ptr

@@ -16,11 +16,11 @@ import           Raaz.Cipher.AES.Internal import qualified Raaz.Cipher.AES.CBC.Implementation.CPortable as CPCBC -instance Recommendation (AES 128 CBC) where+instance Recommendation (AES 128 'CBC) where          recommended _ = CPCBC.aes128cbcI -instance Recommendation (AES 192 CBC) where+instance Recommendation (AES 192 'CBC) where          recommended _ = CPCBC.aes192cbcI -instance Recommendation (AES 256 CBC) where+instance Recommendation (AES 256 'CBC) where          recommended _ = CPCBC.aes256cbcI

@@ -0,0 +1,10 @@+module Raaz.Cipher.ChaCha20+       ( ChaCha20, chacha20, KEY, IV, Counter+       ) where++import Raaz.Cipher.ChaCha20.Internal+import Raaz.Cipher.ChaCha20.Recommendation()++-- | The chacha20 stream cipher.+chacha20 :: ChaCha20+chacha20 = ChaCha20

@@ -0,0 +1,53 @@+{-# LANGUAGE ForeignFunctionInterface         #-}+{-# LANGUAGE MultiParamTypeClasses            #-}+{-# LANGUAGE FlexibleInstances                #-}+{-# LANGUAGE DataKinds                        #-}++module Raaz.Cipher.ChaCha20.Implementation.CPortable+       ( implementation, chacha20Random+       ) where++import Control.Monad.IO.Class   ( liftIO )+import Foreign.Ptr              ( Ptr    )++import Raaz.Core+import Raaz.Cipher.Internal+import Raaz.Cipher.ChaCha20.Internal++implementation :: SomeCipherI ChaCha20+implementation  = SomeCipherI chacha20Portable++-- | Chacha20 block transformation.+foreign import ccall unsafe+  "raaz/cipher/chacha20/cportable.h raazChaCha20Block"+  c_chacha20_block :: Pointer      -- Message+                   -> Int          -- number of blocks+                   -> Ptr KEY      -- key+                   -> Ptr IV       -- iv+                   -> Ptr Counter  -- Counter value+                   -> IO ()+++++-- | Encrypting/Decrypting a block of chacha20.+chacha20Block :: Pointer -> BLOCKS ChaCha20 -> MT ChaCha20Mem ()+chacha20Block msgPtr nblocks = do keyPtr <- onSubMemory keyCell     getCellPointer+                                  ivPtr  <- onSubMemory ivCell      getCellPointer+                                  ctrPtr <- onSubMemory counterCell getCellPointer+                                  liftIO $ c_chacha20_block msgPtr (fromEnum nblocks) keyPtr ivPtr ctrPtr++-- | The chacha20 randomness generator.+chacha20Random :: Pointer -> BLOCKS ChaCha20 -> MT ChaCha20Mem ()+chacha20Random = chacha20Block++---------------------- DANGEROUS CODE --------------------------------------++-- | The chacha20 randomness generator. We have set the alignment to+-- 32 because this allows gcc to further optimise the implementation.+chacha20Portable :: CipherI ChaCha20 ChaCha20Mem ChaCha20Mem+chacha20Portable = makeCipherI+                   "chacha20-cportable"+                   "Implementation of the chacha20 stream cipher (RFC7539)"+                   chacha20Block+                   32

@@ -0,0 +1,39 @@+{-# LANGUAGE ForeignFunctionInterface         #-}+{-# LANGUAGE MultiParamTypeClasses            #-}+{-# LANGUAGE FlexibleInstances                #-}++module Raaz.Cipher.ChaCha20.Implementation.Vector128+       ( implementation+       ) where++import Control.Monad.IO.Class   ( liftIO )+import Foreign.Ptr              ( Ptr    )++import Raaz.Core+import Raaz.Cipher.Internal+import Raaz.Cipher.ChaCha20.Internal++implementation :: SomeCipherI ChaCha20+implementation  = SomeCipherI chacha20Vector++-- | Chacha20 block transformation.+foreign import ccall unsafe "raazChaCha20BlockVector"+  c_chacha20_block :: Pointer      -- Message+                   -> Int          -- number of blocks+                   -> Ptr KEY      -- key+                   -> Ptr IV       -- iv+                   -> Ptr Counter  -- Counter value+                   -> IO ()++chacha20Block :: Pointer -> BLOCKS ChaCha20 -> MT ChaCha20Mem ()+chacha20Block msgPtr nblocks = do keyPtr <- onSubMemory keyCell     getCellPointer+                                  ivPtr  <- onSubMemory ivCell      getCellPointer+                                  ctrPtr <- onSubMemory counterCell getCellPointer+                                  liftIO $ c_chacha20_block msgPtr (fromEnum nblocks) keyPtr ivPtr ctrPtr++chacha20Vector :: CipherI ChaCha20 ChaCha20Mem ChaCha20Mem+chacha20Vector = makeCipherI+                   "chacha20-vector-128"+                   "Implementation of the chacha20 stream cipher using the gcc's vector instructions"+                   chacha20Block+                   16

@@ -0,0 +1,51 @@+{-# LANGUAGE ForeignFunctionInterface         #-}+{-# LANGUAGE MultiParamTypeClasses            #-}+{-# LANGUAGE FlexibleInstances                #-}+{-# LANGUAGE DataKinds                        #-}++module Raaz.Cipher.ChaCha20.Implementation.Vector256+       ( implementation, chacha20Random+       ) where++import Control.Monad.IO.Class   ( liftIO )+import Foreign.Ptr              ( Ptr    )+import Raaz.Core+import Raaz.Cipher.Internal+import Raaz.Cipher.ChaCha20.Internal++--------------------------- Setting up the implementation ----------------------------++implementation :: SomeCipherI ChaCha20+implementation  = SomeCipherI chacha20Vector+++chacha20Vector :: CipherI ChaCha20 ChaCha20Mem ChaCha20Mem+chacha20Vector = makeCipherI+                 "chacha20-vector-256"+                 "Implementation of the chacha20 stream cipher using the gcc's 256-bit vector instructions"+                 chacha20Block+                 32++----------------------------- The block transformation ---------------------------------++-- | Chacha20 block transformation.+foreign import ccall unsafe+  "raazChaCha20BlockVector256"+  c_chacha20_block :: Pointer      -- Message+                   -> Int          -- number of blocks+                   -> Ptr KEY      -- key+                   -> Ptr IV       -- iv+                   -> Ptr Counter  -- Counter value+                   -> IO ()++chacha20Block :: Pointer -> BLOCKS ChaCha20 -> MT ChaCha20Mem ()+chacha20Block msgPtr nblocks = do keyPtr <- onSubMemory keyCell     getCellPointer+                                  ivPtr  <- onSubMemory ivCell      getCellPointer+                                  ctrPtr <- onSubMemory counterCell getCellPointer+                                  liftIO $ c_chacha20_block msgPtr (fromEnum nblocks) keyPtr ivPtr ctrPtr+++----------------------------- The chacha20 stream cipher ----------------------------------++chacha20Random :: Pointer -> BLOCKS ChaCha20 -> MT ChaCha20Mem ()+chacha20Random = chacha20Block

@@ -0,0 +1,91 @@+{-# LANGUAGE DataKinds                        #-}+{-# LANGUAGE GeneralizedNewtypeDeriving       #-}+{-# LANGUAGE FlexibleInstances                #-}+{-# LANGUAGE MultiParamTypeClasses            #-}+{-# LANGUAGE TypeFamilies                     #-}++module Raaz.Cipher.ChaCha20.Internal+       ( ChaCha20(..), WORD, Counter(..), IV(..), KEY(..), ChaCha20Mem(..)+       ) where++import Control.Applicative+import Data.Word+import Data.String+import Foreign.Storable+import Prelude+++import Raaz.Core+import Raaz.Cipher.Internal++-- | The chacha20 stream cipher.+++-- | The word type+type WORD     = LE Word32++-- | The IV for the chacha20+newtype IV       = IV (Tuple 3 (LE Word32))     deriving (Storable, EndianStore)++instance Encodable IV++instance Show IV where+  show = showBase16+instance IsString IV where+  fromString = fromBase16++-- | The counter type for chacha20+newtype Counter  = Counter (LE Word32) deriving (Num, Storable, EndianStore, Show, Eq, Ord)+++-- | The key type.+newtype KEY      = ChaCha20Key (Tuple 8 WORD) deriving (Storable, EndianStore)++instance Encodable KEY++instance Show KEY where+  show = showBase16++instance IsString KEY where+  fromString = fromBase16+++data ChaCha20 = ChaCha20++instance Primitive ChaCha20 where+  blockSize _ = BYTES 64+  type Implementation ChaCha20 = SomeCipherI ChaCha20++-- | The key for ChaCha20.+type instance Key ChaCha20 = (KEY, IV, Counter)++instance Describable ChaCha20 where+  name        _ = "chacha20"+  description _ = "The ChaCha20 cipher"++instance Cipher ChaCha20++instance StreamCipher ChaCha20++++---------- Memory for ChaCha20 implementations  ------------------+-- | chacha20 memory+data ChaCha20Mem = ChaCha20Mem { keyCell      :: MemoryCell KEY+                               , ivCell       :: MemoryCell IV+                               , counterCell  :: MemoryCell Counter+                               }+++instance Memory ChaCha20Mem where+  memoryAlloc     = ChaCha20Mem <$> memoryAlloc <*> memoryAlloc <*> memoryAlloc+  unsafeToPointer = unsafeToPointer . keyCell++instance Initialisable ChaCha20Mem (KEY, IV, Counter) where+  initialise (k,iv,ctr) = do onSubMemory keyCell     $ initialise k+                             onSubMemory ivCell      $ initialise iv+                             onSubMemory counterCell $ initialise ctr+++instance Initialisable ChaCha20Mem (KEY, IV) where+  initialise (k, iv) = initialise (k, iv, 0 :: Counter)

@@ -0,0 +1,88 @@+-- | This sets up the recommended implementation of chacha20 cipher.++{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE CPP                  #-}++--+-- The orphan instance declaration separates the implementation and+-- setting the recommended instances. Therefore, we ignore the warning.+--++module Raaz.Cipher.ChaCha20.Recommendation+       ( chacha20Random, RandomBuf, getBufferPointer, randomBufferSize+       ) where++import Control.Applicative+import Prelude++import Raaz.Core+import Raaz.Cipher.ChaCha20.Internal++#ifdef HAVE_VECTOR_256+import Raaz.Cipher.ChaCha20.Implementation.Vector256+#else+import Raaz.Cipher.ChaCha20.Implementation.CPortable+#endif++------------ Setting the recommended implementation -------------------++instance Recommendation ChaCha20 where+         recommended _ = implementation+++--------------- Some information used by Raaz/Random/ChaCha20PRG.hs -------------++-- | The chacha stream cipher is also used as the prg for generating+-- random bytes. Such a prg needs to keep an auxilary buffer type so+-- that one can generate random bytes not just of block size but+-- smaller. This memory type is essentially for maintaining such a+-- buffer.++newtype RandomBuf = RandomBuf { unBuf :: Pointer }++++instance Memory RandomBuf where++  memoryAlloc     = RandomBuf <$> pointerAlloc sz+    where sz = atLeastAligned randomBufferSize randomBufferAlignment++  unsafeToPointer = unBuf++-- | Get the actual location where the data is to be stored. Ensures+-- that the pointer is aligned to the @randomBufferAlignment@+-- restriction.+getBufferPointer :: MT RandomBuf Pointer+getBufferPointer = actualPtr <$> getMemory+  where actualPtr = flip alignPtr randomBufferAlignment . unBuf+++--------------------- DANGEROUS CODE --------------------------------++-- Things to take care in this module+-- ==================================+--+-- 1. ENSURE randomBufferSize IS THE MAXIMUM FOR ALL IMPLEMENTATIONS of+--    chacha20 random stream. OTHERWISE BUFFER OVERFLOW.+--+-- 2. Ensure that the alignment requirement is the maximum so that any+--    implementation can use the same memory.+++++-- | The size of the buffer in blocks of ChaCha20. While the+-- implementations should handle any multiple of blocks, often+-- implementations naturally handle some multiple of blocks, for+-- example the Vector256 implementation handles 2-chacha blocks. Set+-- this quantity to the maximum supported by all implementations.+randomBufferSize :: BLOCKS ChaCha20+randomBufferSize = 4  `blocksOf` ChaCha20++-- | Implementations are also designed to work with a specific+-- alignment boundary. Unaligned access can slow down the primitives+-- quite a bit. Set this to the maximum of alignment supported by all+-- implementations+randomBufferAlignment :: Alignment+randomBufferAlignment = 32 -- For 256-bit vector instructions.

@@ -17,16 +17,22 @@          Cipher, CipherMode(..)          -- ** Cipher implementation        , CipherI(..), SomeCipherI(..)-       --++         -- ** Stream ciphers.+         -- $streamcipher$+       , StreamCipher, makeCipherI+       , transform, transform'        -- ** Unsafe encryption and decryption.        -- $unsafecipher$        --        , unsafeEncrypt, unsafeDecrypt, unsafeEncrypt', unsafeDecrypt'-       ) where +       ) where +import Control.Monad.IO.Class          (liftIO) import Data.ByteString.Internal as IB-import Foreign.Ptr (castPtr)+import Foreign.Ptr                     (castPtr)+import System.IO.Unsafe                (unsafePerformIO)  import Raaz.Core import Raaz.Core.Util.ByteString as B@@ -34,14 +40,15 @@ -- $cipherdoc$ -- -- Ciphers provide symmetric encryption in the raaz library and are--- captured by the type class `Cipher`. Instances of `Cipher` are full--- encryption/decryption algorithms. For a block cipher this means--- that one also needs to specify the `CipherMode` to make it an--- instance of the class `Cipher`. They are instances of the class--- `Symmetric` and the associated type `Key` captures the encryption--- key for the cipher.+-- captured by the type class `Cipher`.  They are instances of the+-- class `Symmetric` and the associated type `Key` captures the all+-- that is required to determine the encryption and decryption+-- process. In most ciphers, this includes what is know as the+-- _encryption key_ as well as the _initialisation vector_. ----- Implementations of ciphers are captured by two types.+-- Instances of `Cipher` is only required to provide full block+-- encryption/decryption algorithms.  Implementations are captured by+-- two types. -- -- [`CipherI`:] Values of this type that captures implementations of a -- cipher.  This type is parameterised over the memory element that is@@ -65,6 +72,17 @@ --    type class `Raaz.Core.Primitives.Recommendation` -- +-- $streamcipher$+--+-- Stream ciphers are special class of ciphers which can encrypt+-- messages of any length (not necessarily multiples of block length).+-- Typically, stream ciphers are obtained by xoring the data with a+-- stream of prg values that the stream ciphers generate. As a+-- consequence, the encryption and decryption is the same algorithm.+-- one can also use the stream cipher as a pseudo-random generator.+--+-- We have the class `StreamCipher` that captures valid stream ciphers.+--   -- | Block cipher modes.@@ -80,8 +98,25 @@      , encryptBlocks :: Pointer -> BLOCKS cipher -> MT encMem ()        -- | The underlying block decryption function.      , decryptBlocks :: Pointer -> BLOCKS cipher -> MT decMem ()+     , cipherStartAlignment :: Alignment      } +-- | Type constraints on the memory of a block cipher implementation.+type CipherM cipher encMem decMem = ( Initialisable encMem (Key cipher)+                                    , Initialisable decMem (Key cipher)+                                    , Primitive cipher+                                    ) -- TODO: More need initialisable from buffer.++-- | Some implementation of a block cipher. This type is existentially+-- quantifies over the memory used in the implementation.+data SomeCipherI cipher =+  forall encMem decMem . CipherM cipher encMem decMem+  => SomeCipherI (CipherI cipher encMem decMem)+++instance BlockAlgorithm (CipherI cipher encMem decMem) where+  bufferStartAlignment = cipherStartAlignment+ instance Describable (CipherI cipher encMem decMem) where   name        = cipherIName   description = cipherIDescription@@ -91,20 +126,46 @@   name         (SomeCipherI cI) = name cI   description  (SomeCipherI cI) = description cI +instance BlockAlgorithm (SomeCipherI cipher) where+  bufferStartAlignment (SomeCipherI imp) = bufferStartAlignment imp -type CipherM cipher encMem decMem = ( Initialisable encMem (Key cipher)-                                    , Initialisable decMem (Key cipher)-                                    ) --- | Some implementation of a block cipher. This type existentially--- quantifies over the memory used in the implementation.-data SomeCipherI cipher =-  forall encMem decMem . CipherM cipher encMem decMem-  => SomeCipherI (CipherI cipher encMem decMem)--class (Symmetric cipher, Implementation cipher ~ SomeCipherI cipher)+-- | Class capturing ciphers. The implementation of this class should+-- give an encryption and decryption algorithm for messages of length+-- which is a multiple of the block size.  Needless to say, the+-- encryption and decryption should be inverses of each other for such+-- messages.+class (Primitive cipher, Implementation cipher ~ SomeCipherI cipher, Describable cipher)       => Cipher cipher +-- | Class that captures stream ciphers. An instance of `StreamCipher`+-- should be an instance of `Cipher`, with the following additional+-- constraints.+--+-- 1. The encryption and decryption should be the same algorithm.+--+-- 2. Encryption/decryption can be applied to a messages of length @l@+--    even if @l@ is not a multiple of block length.+--+-- 3. The encryption of a prefix of a length @l@ of a message @m@+--    should be the same as the @l@ length prefix of the encryption of+--    @m@.+--+-- It is the duty of the implementer of the cipher to ensure that the+-- above conditions are true before declaring an instance of a stream+-- cipher.+class Cipher cipher => StreamCipher cipher+++-- | Constructs a `CipherI`  value out of a stream transformation function. Useful in+--   building a Cipher instance of a stream cipher.+makeCipherI :: String                                -- ^ name+            -> String                                -- ^ description+            -> (Pointer -> BLOCKS prim -> MT mem ()) -- ^ stream transformer+            -> Alignment                             -- ^ buffer starting alignment+            -> CipherI prim mem mem+makeCipherI nm des trans = CipherI nm des trans trans+ ------------------ Unsafe cipher operations ------------------------  -- $unsafecipher$@@ -129,11 +190,47 @@                -> Key c            -- ^ The key to use                -> ByteString       -- ^ The string to encrypt.                -> ByteString-unsafeEncrypt' c (SomeCipherI imp) key = makeCopyRun c encryptAction-  where encryptAction ptr blks-          = insecurely $ do initialise key-                            encryptBlocks imp ptr blks+unsafeEncrypt' c simp@(SomeCipherI imp) key bs = IB.unsafeCreate sbytes go+  where sz           = atMost (B.length bs) `asTypeOf` blocksOf 1 c+        BYTES sbytes = inBytes sz+        go    ptr    = allocBufferFor simp sz $ \ buf -> insecurely $ do+          initialise key+          liftIO $ unsafeNCopyToPointer sz bs buf -- Copy the input to buffer.+          encryptBlocks imp buf sz+          liftIO $ Raaz.Core.memcpy (destination (castPtr ptr)) (source buf) sz +-- | Transforms a given bytestring using a stream cipher. We use the+-- transform instead of encrypt/decrypt because for stream ciphers+-- these operations are same.++transform' :: StreamCipher c+           => c+           -> Implementation c+           -> Key c+           -> ByteString+           -> ByteString+transform' c simp@(SomeCipherI imp) key bs = unsafePerformIO $ IB.createAndTrim (fromEnum $ inBytes blks) action+   where blks          = atLeast len `asTypeOf` blocksOf 1 c+         len           = B.length bs+         action ptr    = allocBufferFor simp blks $ \ buf -> insecurely $ do+           initialise key+           liftIO $ unsafeCopyToPointer bs buf -- copy data into the buffer+           encryptBlocks imp buf blks          -- encrypt it+           liftIO $ Raaz.Core.memcpy (destination (castPtr ptr)) (source buf) len+                                               -- copy it back to the actual pointer.+           return $ fromIntegral len++-- | Transform a given bytestring using the recommended implementation+-- of a stream cipher.+transform :: (StreamCipher c, Recommendation c)+           => c+           -> Key c+           -> ByteString+           -> ByteString+transform c = transform' c $ recommended c+++ -- | Encrypt using the recommended implementation. This function is -- unsafe because it only works correctly when the input `ByteString` -- is of length which is a multiple of the block length of the cipher.@@ -144,19 +241,6 @@               -> ByteString unsafeEncrypt c = unsafeEncrypt' c $ recommended c --- | Make a copy and run the given action.-makeCopyRun :: Cipher c-            => c-            -> (Pointer -> BLOCKS c -> IO ())-            -> ByteString-            -> ByteString-makeCopyRun c action bs-  = IB.unsafeCreate bytes-    $ \ptr -> do unsafeNCopyToPointer len bs (castPtr ptr)-                 action (castPtr ptr) len-  where len         = atMost (B.length bs) `asTypeOf` blocksOf 1 c-        BYTES bytes = inBytes len- -- | Decrypts the given `ByteString`. This function is unsafe because -- it only works correctly when the input `ByteString` is of length -- which is a multiple of the block length of the cipher.@@ -166,10 +250,14 @@                -> Key c            -- ^ The key to use                -> ByteString       -- ^ The string to encrypt.                -> ByteString-unsafeDecrypt' c (SomeCipherI imp) key = makeCopyRun c decryptAction-  where decryptAction ptr blks-          = insecurely $ do initialise key-                            decryptBlocks imp ptr blks+unsafeDecrypt' c simp@(SomeCipherI imp) key bs = IB.unsafeCreate sbytes go+  where sz           = atMost (B.length bs) `asTypeOf` blocksOf 1 c+        BYTES sbytes = inBytes sz+        go    ptr    = allocBufferFor simp sz $ \ buf -> insecurely $ do+          initialise key+          liftIO $ unsafeNCopyToPointer sz bs buf -- Copy the input to buffer.+          decryptBlocks imp buf sz+          liftIO $ Raaz.Core.memcpy (destination (castPtr ptr)) (source buf) sz  -- | Decrypt using the recommended implementation. This function is -- unsafe because it only works correctly when the input `ByteString`

@@ -10,7 +10,6 @@        , module Raaz.Core.Encode        , module Raaz.Core.Memory        , module Raaz.Core.Primitives-       , module Raaz.Core.Random        , module Raaz.Core.Types        , module Raaz.Core.Util        ) where@@ -20,7 +19,6 @@ import Raaz.Core.Encode import Raaz.Core.Memory import Raaz.Core.Primitives-import Raaz.Core.Random import Raaz.Core.Types import Raaz.Core.Util 

@@ -1,22 +1,20 @@ {-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE DefaultSignatures #-} -- | Module define byte sources. module Raaz.Core.ByteSource        ( -- * Byte sources.          -- $bytesource$-         InfiniteSource(..)-       , ByteSource(..), PureByteSource++         ByteSource(..), PureByteSource+       --    InfiniteSource(..)        , FillResult(..)-       , fill, slurp, processChunks+       , fill, processChunks        , withFillResult        ) where  import           Control.Applicative-import           Control.Monad        (liftM) import           Control.Monad.IO.Class import qualified Data.ByteString      as B import qualified Data.ByteString.Lazy as L-import           Data.Monoid import           Prelude hiding(length) import           System.IO            (Handle) @@ -73,17 +71,9 @@             -> src        -- ^ The source to fill.             -> Pointer  -- ^ Buffer pointer             -> IO (FillResult src)-  default fillBytes :: InfiniteSource src => BYTES Int ->  src -> Pointer -> IO (FillResult src)-  fillBytes sz src pointer = Remaining <$> slurp sz src pointer --- | Never ending stream of bytes. The reads to the stream might get--- delayed but it will always return the number of bytes that were--- asked for.-class InfiniteSource src where-  slurpBytes :: BYTES Int -- ^ bytes to read,-             -> src       -- ^ the source to fill from,-             -> Pointer   -- ^ the buffer source to fill.-             -> IO src+--  default fillBytes :: InfiniteSource src => BYTES Int ->  src -> Pointer -> IO (FillResult src)+--  fillBytes sz src pointer = Remaining <$> slurp sz src pointer  -- | A version of fillBytes that takes type safe lengths as input. fill :: ( LengthUnit len@@ -96,6 +86,18 @@ fill = fillBytes . inBytes {-# INLINE fill #-} +{--++-- | Never ending stream of bytes. The reads to the stream might get+-- delayed but it will always return the number of bytes that were+-- asked for.+class InfiniteSource src where+  slurpBytes :: BYTES Int -- ^ bytes to read,+             -> src       -- ^ the source to fill from,+             -> Pointer   -- ^ the buffer source to fill.+             -> IO src++ -- | A version of slurp that takes type safe lengths as input. slurp :: ( LengthUnit len          , InfiniteSource src@@ -106,6 +108,8 @@        -> IO src slurp = slurpBytes . inBytes +--}+ -- | Process data from a source in chunks of a particular size. processChunks :: ( MonadIO m, LengthUnit chunkSize, ByteSource src)               => m a                 -- action on a complete chunk,@@ -151,8 +155,7 @@  instance ByteSource L.ByteString where   {-# INLINE fillBytes #-}-  fillBytes sz bs = liftM (fmap L.fromChunks)-                    . fillBytes sz (L.toChunks bs)+  fillBytes sz bs = fmap (fmap L.fromChunks) . fillBytes sz (L.toChunks bs)   instance ByteSource src => ByteSource (Maybe src) where@@ -166,7 +169,7 @@   fillBytes sz (x:xs) cptr = do     result <- fillBytes sz x cptr     case result of-      Exhausted rbytes -> let nptr = Sum rbytes <.> cptr+      Exhausted rbytes -> let nptr = rbytes <.> cptr                           in  fillBytes (sz - rbytes) xs nptr       Remaining nx     -> return $ Remaining $ nx:xs 

@@ -16,6 +16,9 @@ import Data.ByteString.Unsafe(unsafeIndex) import Data.Monoid import Data.Word++import Prelude+ import Raaz.Core.Encode.Internal  -- | The type corresponding to base-16 or hexadecimal encoding. The@@ -24,6 +27,10 @@ -- `IsString` instance. The combinators `fromBase16` and `showBase16` -- are exposed mainly to make these definitions easy. --+-- The base16 encoding only produces valid hex characters. However, to+-- aid easy presentation of long hexadecimal strings, a user can add+-- add arbitrary amount of spaces, newlines and the character ':'. The+-- decoding ignores these characters. newtype Base16 = Base16 {unBase16 :: ByteString} deriving (Eq, Monoid)  -- Developers note: Internally base16 just stores the bytestring as@@ -74,7 +81,11 @@   unsafeFromHex :: ByteString -> ByteString-unsafeFromHex bs+unsafeFromHex  = unsafeFromHexP . C8.filter (not . useless)+  where useless c = isSpace c || c == ':'++unsafeFromHexP :: ByteString -> ByteString+unsafeFromHexP bs   | odd (B.length bs) = error "base16 encoding is always of even size"   | otherwise         = fst $ B.unfoldrN len gen 0   where len   = B.length bs `quot` 2

@@ -17,7 +17,10 @@   -- | The type corresponding to the standard padded base-64 binary--- encoding.+-- encoding.  The base-64 encoding only produces valid base-64+-- characters. However, to aid easy presentation of long base-64+-- strings, a user can add add arbitrary amount of spaces and+-- newlines. The decoding ignores these characters. newtype Base64 = Base64 {unBase64 :: ByteString} deriving (Eq, Monoid)  -- Developers note: Internally base16 just stores the bytestring as@@ -147,8 +150,13 @@ merg1 a b = (unB64 a `shiftL` 4) .|. top6 (unB64 b) merg2 a b = (unB64 a `shiftL` 6) .|. unB64 b + unsafeFromB64 :: ByteString -> ByteString-unsafeFromB64 bs = fst (B.unfoldrN (3*n) gen 0) <> unPad+unsafeFromB64 = unsafeFromB64P . C8.filter (not . useless)+  where useless = isSpace++unsafeFromB64P :: ByteString -> ByteString+unsafeFromB64P bs = fst (B.unfoldrN (3*n) gen 0) <> unPad   where n         = B.length bs `quot` 4 - 1         gen i     = Just (byte i, i + 1)         at blk i  = unsafeIndex bs $ 4 * blk + i

@@ -9,12 +9,11 @@  import Data.Maybe -import Data.ByteString              (ByteString)-import Data.ByteString.Internal     (unsafeCreate)-import Data.String-import Data.Word-import Foreign.Ptr-import Foreign.Storable+import           Data.ByteString              (ByteString)+import           Data.ByteString.Internal     (unsafeCreate)+import           Data.String+import           Data.Word+import           Foreign.Ptr import Prelude hiding               (length) import System.IO.Unsafe   (unsafePerformIO) @@ -49,12 +48,12 @@   unsafeFromByteString  :: ByteString  -> a    default toByteString :: EndianStore a => a -> ByteString-  toByteString w    = unsafeCreate (sizeOf w) putit+  toByteString w    = unsafeCreate (fromEnum $ sizeOf w) putit     where putit ptr = store (castPtr ptr) w     default fromByteString :: EndianStore a => ByteString -> Maybe a-  fromByteString bs  | byteSize proxy == length bs = Just w+  fromByteString bs  | sizeOf proxy == length bs   = Just w                      | otherwise                   = Nothing          where w     = unsafePerformIO $ withByteString bs (load . castPtr)                proxy = undefined `asTypeOf` w@@ -69,7 +68,7 @@ instance Encodable ByteString where   toByteString         = id   {-# INLINE toByteString #-}-  fromByteString       = Just . id+  fromByteString       = Just   {-# INLINE fromByteString #-}   unsafeFromByteString = id   {-# INLINE unsafeFromByteString #-}

@@ -2,9 +2,13 @@  The memory subsystem associated with raaz. ++__Warning:__ This module is pretty low level and should not be needed in typical+use cases. Only developers of protocols and primitives might have a+reason to look into this module.+ -} -{-# LANGUAGE DefaultSignatures          #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE GADTs                      #-} {-# LANGUAGE RankNTypes                 #-}@@ -15,17 +19,19 @@        (        -- * The Memory subsystem.        -- $memorysubsystem$-       -- ** Memory elements-         Memory(..), copyMemory-       -- *** A basic memory cell.-       , MemoryCell-       -- *** Initialising and extracting.++       -- ** Initialisation and Extraction.+       -- $init-extract$+         Memory(..), VoidMemory, copyMemory        , Initialisable(..), Extractable(..)+       , InitialisableFromBuffer(..), ExtractableToBuffer(..)+       -- *** A basic memory cell.+       , MemoryCell, withCellPointer, getCellPointer        -- *** Actions on memory elements.-       , MT,  execute, getMemory, liftSubMT, modify+       , MT,  execute, getMemory, onSubMemory, liftSubMT,  modify        -- **** Some low level `MT` actions.-       , getMemoryPointer, withPointer-       , allocate++       , liftPointerAction        -- ** Generic memory monads.        , MonadMemory(..)        , MemoryM, runMT@@ -35,35 +41,37 @@  import           Control.Applicative import           Control.Monad.IO.Class-import           Data.Monoid (Sum (..))-import           Foreign.Storable(Storable(..))-import           Foreign.Ptr (castPtr)+import           Foreign.Storable            ( Storable )+import           Foreign.Ptr                 ( castPtr, Ptr ) import           Raaz.Core.MonoidalAction+import           Raaz.Core.Transfer import           Raaz.Core.Types  -- $memorysubsystem$ ----- The memory subsystem consists of two main components.+-- Cryptographic operations often need to keep sensitive information+-- in its memory space. If this memory is swapped out to the disk,+-- this can be dangerous. The primary purpose of the memory subsystem+-- is to provide a way to allocate and manage /secure memory/,+-- i.e. memory that will not be swapped out during the execution of+-- the process and will be wiped clean after use. There are there+-- important parts to the memory subsystem: ----- [The `Memory` type class] A memory element is some type that holds--- an internal buffer inside it. The operations that are allowed on--- the element is controlled by the associated type. Certain memory--- element have a default way in which it can be initialised by values--- of type @a@. An instance declaration @`Initialisable` mem a@ for--- the memory type @mem@ is done in such case. Similary, if values of--- type @b@ can be extracted out of a memory element @mem@, we can--- indicate it with an instance of @`Extractable` mem a@.+-- [The `Memory` type class:] A memory element is some type that holds+-- an internal buffer inside it. ----- [The `Alloc` type and memory allocation] The most important and--- often error prone operation while using low level memory buffers is--- its allocation. The `Alloc` types gives the allocation strategy for--- a memory element keeping track of the necessary book keeping--- involved in it.  The `Alloc` type is an instance of `Applicative`+-- [The `Alloc` type:] Memory elements need to be allocated and this+-- is involves a lot of low lever pointer arithmetic. The `Alloc`+-- types gives a high level interface for memory allocation. For a+-- memory type `mem`, the type `Alloc mem` can be seen as the+-- _allocation strategy_ for mem. For example, one of the things that+-- it keeps track of the space required to create an memory element of+-- type `mem`. There is a natural applicative instance for `Alloc` -- which helps build the allocation strategy for a compound memory--- type from its components in a modular fashion without any explicit+-- type from its components in a modular fashion _without_ explicit -- size calculation or offset computation. ----- [The `MonadMemory` class] Instances of these classes are actions+-- [The `MonadMemory` class:] Instances of these classes are actions -- that use some kind of memory elements, i.e. instances of the class -- `Memory`, inside it. Any such monad can either be run using the -- combinator `securely` or the combinator `insecurely`. If one use@@ -73,6 +81,29 @@ -- we expose from this library. -- +-- $init-extract$+--+-- Memory elements often needs to be initialised. Similarly data needs+-- to be extracted out of memory. An instance declaration+-- @`Initialisable` mem a@ for the memory type @mem@ indicates that it+-- can be initialised with the pure value @a@. Similary, if values of+-- type @b@ can be extracted out of a memory element @mem@, we can+-- indicate it with an instance of @`Extractable` mem a@.+--+-- There is an inherent danger in initialising and extracting pure+-- values out of memory. Pure values are stored on the Haskell stack+-- and hence can be swapped out. Consider a memory element @mem@ that+-- stores some sensitive information, say for example the unencrypted+-- private key. Now suppose that we need to extracting out the key as+-- a pure value before its encryption and storage into the key file,+-- it is likely that the key is swapped out to the disk as part of the+-- haskell heap.+--+-- The `InitialiseFromBuffer` (`ExtractableToBuffer`) class gives an+-- interface for reading from (writing to) buffers directly minimising+-- the chances of inadvertent exposure of sensitive information from+-- the Haskell heap due to swapping.+ -- | A class that captures monads that use an internal memory element. -- -- Any instance of `MonadMemory` can be executed `securely` in which@@ -145,13 +176,22 @@ -- monad. newtype MT mem a = MT { unMT :: mem -> IO a } --- | Given an memory thread-allocate :: LengthUnit bufSize-         => bufSize -> (Pointer -> MT mem a) -> MT mem a-allocate bufSize bufAction-  = execute $ \ mem ->-  allocaBuffer bufSize (\ptr -> unMT (bufAction ptr) mem)+------------- Lifting pointer actions ----------------------------- +-- | A pointer action inside a monad @m@ is some function that takes a+-- pointer action of type @Pointer -> m a@ and supplies it with an+-- appropriate pointer. In particular, memory allocators are pointer+-- actions.+type PointerAction m a b = (Pointer -> m a) -> m b++-- | An IO allocator can be lifted to the memory thread level as follows.+liftPointerAction :: PointerAction IO a b -> PointerAction (MT mem) a b+liftPointerAction allocator mtAction+  = execute $ \ mem -> allocator (\ ptr -> unMT (mtAction ptr) mem)++-- TODO: This is a very general pattern needs more exploration.++ -- | Run a given memory action in the memory thread. execute :: (mem -> IO a) -> MT mem a {-# INLINE execute #-}@@ -160,28 +200,26 @@ getMemory :: MT mem mem getMemory = execute return --- | Get the pointer associated with the given memory.-getMemoryPointer :: Memory mem => MT mem Pointer-getMemoryPointer = underlyingPtr <$> getMemory+-- | The combinator @onSubMemory@ allows us to run a memory action on a+-- sub-memory element. Given a memory element of type @mem@ and a+-- sub-element of type @submem@ which can be obtained from the+-- compound memory element of type @mem@ using the projection @proj@,+-- then @onSubMemory proj@ lifts the a memory thread of the sub+-- element to the compound element.+--+onSubMemory :: (mem -> submem) -- ^ Projection from the compound element+                               -- to sub memory element.+            -> MT submem a     -- ^ Memory thread of the sub-element.+            -> MT mem    a+onSubMemory proj mt' = execute $ unMT mt' . proj --- | Work with the underlying pointer of the memory element. Useful--- while working with ffi functions.-withPointer :: Memory mem => (Pointer -> IO b) -> MT mem b-withPointer fp  = execute $ fp . underlyingPtr-{-# INLINE withPointer #-}+{-# DEPRECATED liftSubMT "use onSubMemory instead" #-}+-- | Alternate name for onSubMemory.+liftSubMT :: (mem -> submem)+          -> MT submem a+          -> MT mem    a+liftSubMT = onSubMemory --- | Compound memory elements might intern be composed of--- sub-elements. Often one might want to /lift/ the memory thread for--- a sub-element to the compound element. Given a sub-element of type--- @mem'@ which can be obtained from the compound memory element of--- type @mem@ using the projection @proj@, @liftSubMT proj@ lifts the--- a memory thread of the sub element to the compound element.----liftSubMT :: (mem -> mem') -- ^ Projection from the compound element-                           -- to sub-element-          -> MT mem' a     -- ^ Memory thread of the sub-element.-          -> MT mem  a-liftSubMT proj mt' = execute $ unMT mt' . proj  instance Functor (MT mem) where   fmap f mst = MT $ \ m -> f <$> unMT mst m@@ -244,18 +282,17 @@  ------------------------ A memory allocator ----------------------- -type ALIGNMonoid = Sum ALIGN  type AllocField = Field Pointer  -- | A memory allocator for the memory type @mem@. The `Applicative` -- instance of @Alloc@ can be used to build allocations for -- complicated memory elements from simpler ones.-type Alloc mem = TwistRF AllocField ALIGNMonoid mem+type Alloc mem = TwistRF AllocField (BYTES Int) mem  -- | Make an allocator for a given memory type. makeAlloc :: LengthUnit l => l -> (Pointer -> mem) -> Alloc mem-makeAlloc l memCreate = TwistRF (WrapArrow memCreate) (Sum $ atLeast l)+makeAlloc l memCreate = TwistRF (WrapArrow memCreate) $ atLeast l  -- | Allocates a buffer of size @l@ and returns the pointer to it pointer. pointerAlloc :: LengthUnit l => l -> Alloc Pointer@@ -281,38 +318,39 @@ -- -- > instance (Memory ma, Memory mb) => Memory (ma, mb) where -- >--- >    memoryAlloc   = (,) <$> memoryAlloc <*> memoryAlloc+-- >    memoryAlloc             = (,) <$> memoryAlloc <*> memoryAlloc -- >--- >    underlyingPtr (ma, _) =  underlyingPtr ma+-- >    unsafeToPointer (ma, _) =  unsafeToPointer ma -- class Memory m where    -- | Returns an allocator for this memory.-  memoryAlloc    :: Alloc m+  memoryAlloc     :: Alloc m    -- | Returns the pointer to the underlying buffer.-  underlyingPtr  :: m -> Pointer+  unsafeToPointer :: m -> Pointer -class Memory m => Initialisable m v where-  initialise :: v -> MT m ()+-- | A memory element that holds nothing.+data VoidMemory = VoidMemory { unVoidMemory :: Pointer  } -class Memory m => Extractable m v where-  extract  :: MT m v+instance Memory VoidMemory where+  memoryAlloc      = makeAlloc (0 :: BYTES Int) $ VoidMemory+  unsafeToPointer  = unVoidMemory  instance ( Memory ma, Memory mb ) => Memory (ma, mb) where-    memoryAlloc           = (,) <$> memoryAlloc <*> memoryAlloc-    underlyingPtr (ma, _) =  underlyingPtr ma+    memoryAlloc             = (,) <$> memoryAlloc <*> memoryAlloc+    unsafeToPointer (ma, _) =  unsafeToPointer ma  instance ( Memory ma          , Memory mb          , Memory mc          )          => Memory (ma, mb, mc) where-    memoryAlloc           = (,,)-                            <$> memoryAlloc-                            <*> memoryAlloc-                            <*> memoryAlloc-    underlyingPtr (ma,_,_) =  underlyingPtr ma+  memoryAlloc              = (,,)+                             <$> memoryAlloc+                             <*> memoryAlloc+                             <*> memoryAlloc+  unsafeToPointer (ma,_,_) =  unsafeToPointer ma  instance ( Memory ma          , Memory mb@@ -320,23 +358,23 @@          , Memory md          )          => Memory (ma, mb, mc, md) where-    memoryAlloc           = (,,,)-                            <$> memoryAlloc-                            <*> memoryAlloc-                            <*> memoryAlloc-                            <*> memoryAlloc+  memoryAlloc                = (,,,)+                               <$> memoryAlloc+                               <*> memoryAlloc+                               <*> memoryAlloc+                               <*> memoryAlloc -    underlyingPtr (ma,_,_,_) =  underlyingPtr ma+  unsafeToPointer (ma,_,_,_) =  unsafeToPointer ma  -- | Copy data from a given memory location to the other. The first -- argument is destionation and the second argument is source to match -- with the convention followed in memcpy.-copyMemory :: Memory m => m -- ^ Destination-                       -> m -- ^ Source+copyMemory :: Memory m => Dest m -- ^ Destination+                       -> Src  m -- ^ Source                        -> IO ()-copyMemory dest src = memcpy (underlyingPtr dest) (underlyingPtr src) sz-  where sz = getSum $ twistMonoidValue $ getAlloc src-        getAlloc :: Memory m => m -> Alloc m+copyMemory dmem smem = memcpy (unsafeToPointer <$> dmem) (unsafeToPointer <$> smem) sz+  where sz       = twistMonoidValue $ getAlloc smem+        getAlloc :: Memory m => Src m -> Alloc m         getAlloc _ = memoryAlloc  -- | Perform an action which makes use of this memory. The memory@@ -347,10 +385,12 @@ -- overhead. withMemory   :: Memory m => (m -> IO a) -> IO a withMemory   = withM memoryAlloc-  where withM :: Memory m => Alloc m -> (m -> IO a) -> IO a-        withM alctr action = allocaBuffer sz $ action . getM-          where sz     = getSum $ twistMonoidValue alctr-                getM   = computeField $ twistFunctorValue alctr+  where withM :: Alloc m -> (m -> IO a) -> IO a+        withM alctr action = allocaBuffer sz actualAction+          where sz                 = twistMonoidValue alctr+                getM               = computeField $ twistFunctorValue alctr+                wipeIt cptr        = memset cptr 0 sz+                actualAction  cptr = action (getM cptr) <* wipeIt cptr   -- | Similar to `withMemory` but allocates a secure memory for the@@ -364,22 +404,28 @@ withSecureMemory = withSM memoryAlloc   where -- withSM :: Memory m => Alloc m -> (m -> IO a) -> IO a         withSM alctr action = allocaSecure sz $ action . getM-          where sz     = getSum $ twistMonoidValue alctr+          where sz     = twistMonoidValue alctr                 getM   = computeField $ twistFunctorValue alctr ---------------------- Some instances of Memory -------------------- --- | A memory location to store a value of type having `Storable`--- instance.-newtype MemoryCell a = MemoryCell { unMemoryCell :: Pointer }+----------------------- Initialising and Extracting stuff ---------------------- +-- | Memories that can be initialised with a pure value. The pure+-- value resides in the Haskell heap and hence can potentially be+-- swapped. Therefore, this class should be avoided if compromising+-- the initialisation value can be dangerous. Consider using+-- `InitialiseableFromBuffer`+-- --- | Perform some pointer action on MemoryCell. Useful while working--- with ffi functions.-withCell :: (Pointer -> IO b) -> MT (MemoryCell a) b-withCell fp  = execute $ fp . unMemoryCell-{-# INLINE withCell #-}+class Memory m => Initialisable m v where+  initialise :: v -> MT m () +-- | Memories from which pure values can be extracted. Once a pure value is+-- extracted,+class Memory m => Extractable m v where+  extract  :: MT m v++ -- | Apply the given function to the value in the cell. For a function @f :: b -> a@, -- the action @modify f@ first extracts a value of type @b@ from the -- memory element, applies @f@ to it and puts the result back into the@@ -391,18 +437,61 @@ modify :: (Initialisable m a, Extractable m b) =>  (b -> a) -> MT m () modify f = extract >>= initialise . f +-- | A memory type that can be initialised from a pointer buffer. The initialisation performs+-- a direct copy from the input buffer and hence the chances of the+-- initialisation value ending up in the swap is minimised.+class Memory m => InitialisableFromBuffer m where+  initialiser :: m -> ReadM (MT m)++-- | A memory type that can extract bytes into a buffer. The extraction will perform+-- a direct copy and hence the chances of the extracted value ending+-- up in the swap space is minimised.+class Memory m => ExtractableToBuffer m where+  extractor :: m -> WriteM (MT m)+++--------------------- Some instances of Memory --------------------++-- | A memory location to store a value of type having `Storable`+-- instance.+newtype MemoryCell a = MemoryCell { unMemoryCell :: Ptr a }++ instance Storable a => Memory (MemoryCell a) where    memoryAlloc = allocator undefined     where allocator :: Storable b => b -> Alloc (MemoryCell b)-          allocator b = makeAlloc (byteSize b) MemoryCell+          allocator b = makeAlloc (alignedSizeOf b) $ MemoryCell . castPtr -  underlyingPtr (MemoryCell cptr) = cptr+  unsafeToPointer  = castPtr . unMemoryCell +-- | The location where the actual storing of element happens. This+-- pointer is guaranteed to be aligned to the alignment restriction of @a@+actualCellPtr :: Storable a => MemoryCell a -> Ptr a+actualCellPtr = nextAlignedPtr . unMemoryCell++-- | Work with the underlying pointer of the memory cell. Useful while+-- working with ffi functions.+withCellPointer :: Storable a => (Ptr a -> IO b) -> MT (MemoryCell a) b+{-# INLINE withCellPointer #-}+withCellPointer action = execute $ action . actualCellPtr+++-- | Get the pointer associated with the given memory cell.+getCellPointer :: Storable a => MT (MemoryCell a) (Ptr a)+{-# INLINE getCellPointer #-}+getCellPointer = actualCellPtr <$> getMemory+ instance Storable a => Initialisable (MemoryCell a) a where-  initialise a = withCell (flip poke a . castPtr)+  initialise a = execute $ flip pokeAligned a . unMemoryCell   {-# INLINE initialise #-}  instance Storable a => Extractable (MemoryCell a) a where-  extract = withCell (peek . castPtr)+  extract = execute $ peekAligned . unMemoryCell   {-# INLINE extract #-}++instance EndianStore a => InitialisableFromBuffer (MemoryCell a) where+  initialiser  = readInto 1 . destination . actualCellPtr++instance EndianStore a => ExtractableToBuffer (MemoryCell a) where+  extractor  = writeFrom 1 . source . actualCellPtr

@@ -51,15 +51,12 @@ class Monoid m => LAction m space where   (<.>) :: m -> space -> space -{-# RULES "monoid-action/identity"-   (<.>) mempty = id #-}  infixr 5 <.>  -- | An alternate symbol for <> more useful in the additive context. (<++>) :: Monoid m => m -> m -> m (<++>) = (<>)-{-# INLINE (<++>) #-}  infixr 5 <++> @@ -73,9 +70,6 @@ class (Monoid m, Functor f) => LActionF m f where   (<<.>>) :: m -> f a -> f a -{-# RULES "monoid-action-functor/identity"-   (<<.>>) mempty = id #-}- infixr 5 <<.>>  ---------------------- The semi-direct products ------------------------@@ -226,7 +220,7 @@ type FieldM monad = FieldA (Kleisli monad)  -- | Lift a monadic action to FieldM.-liftToFieldM :: Monad m => (a -> m b) -> FieldM m a b+liftToFieldM :: (a -> m b) -> FieldM m a b liftToFieldM = WrapArrow . Kleisli {-# INLINE liftToFieldM #-} -- | Runs a monadic field at a given point in the space.

@@ -1,8 +1,7 @@ -- | An applicative version of parser. This provides a restricted -- parser which has only an applicative instance.- module Raaz.Core.Parse.Applicative-       ( Parser, parseWidth, parseError+       ( Parser, parseWidth, parseError, runParser        , unsafeRunParser        , parse, parseStorable        , parseVector, parseStorableVector@@ -11,26 +10,26 @@        ) where  import           Data.ByteString           (ByteString)-import           Data.Monoid               (Sum(..)) import           Data.Vector.Generic       (Vector, generateM) import           Foreign.Ptr               (castPtr) import           Foreign.Storable          (Storable, peek, peekElemOff)-+import           Prelude          hiding   ( length )+import           System.IO.Unsafe          (unsafePerformIO)  import           Raaz.Core.MonoidalAction import           Raaz.Core.Types.Endian import           Raaz.Core.Types.Pointer-import           Raaz.Core.Util.ByteString (createFrom)+import           Raaz.Core.Util.ByteString (createFrom, length, withByteString)  -type BytesMonoid   = Sum (BYTES Int)+type BytesMonoid   = BYTES Int type ParseAction   = FieldM IO Pointer  -- | An applicative parser type for reading data from a pointer. type Parser = TwistRF ParseAction BytesMonoid  makeParser :: LengthUnit l => l -> (Pointer -> IO a) -> Parser a-makeParser l action = TwistRF (liftToFieldM action) (Sum $ inBytes l)+makeParser l action = TwistRF (liftToFieldM action) $ inBytes l  -- | A parser that fails with a given error message. parseError  :: String -> Parser a@@ -38,20 +37,15 @@  -- | Return the bytes that this parser will read. parseWidth :: Parser a -> BYTES Int-parseWidth =  getSum . twistMonoidValue+parseWidth =  twistMonoidValue -{---- | Run the given parser.-runParser :: Parser a -> CryptoBuffer -> IO (Maybe a)-runParser pr cbuf = withCryptoBuffer cbuf $ \ sz cptr ->-  if sz < parseWidth pr then return Nothing-  else Just <$> unsafeRunParser pr cptr --- | Run the parser given the-runParser' :: Parser a -> CryptoBuffer -> IO a-runParser' pr = fmap fromJust . runParser pr---}+-- | Runs a parser on a byte string. It returns `Nothing` if the byte string is smaller than+-- what the parser would consume.+runParser :: Parser a -> ByteString -> Maybe a+runParser pr bs+  | length bs < parseWidth pr = Nothing+  | otherwise                 = Just $ unsafePerformIO $ withByteString bs $ unsafeRunParser pr  -- | Run the parser without checking the length constraints. unsafeRunParser :: Parser a -> Pointer -> IO a@@ -67,7 +61,7 @@ -- `Storable` instance. parseStorable :: Storable a => Parser a parseStorable = pa-  where pa = makeParser (byteSize $ undefParse pa) (peek . castPtr)+  where pa = makeParser (sizeOf $ undefParse pa) (peek . castPtr)  -- | Parse a crypto value. Endian safety is take into account -- here. This is what you would need when you parse packets from an@@ -75,7 +69,7 @@ -- function in a complicated `EndianStore` instance. parse :: EndianStore a => Parser a parse = pa-  where pa = makeParser (byteSize $ undefParse pa) load+  where pa = makeParser (sizeOf $ undefParse pa) (load . castPtr)  -- | Parses a strict bytestring of a given length. parseByteString :: LengthUnit l => l -> Parser ByteString@@ -88,7 +82,7 @@ unsafeParseStorableVector :: (Storable a, Vector v a) => Int -> Parser (v a) unsafeParseStorableVector n = pvec   where pvec      = makeParser  width $ \ cptr -> generateM n (getA cptr)-        width     = fromIntegral n * byteSize (undefA pvec)+        width     = fromIntegral n * sizeOf (undefA pvec)         undefA    :: (Storable a, Vector v a)=> Parser (v a) -> a         undefA _  = undefined         getA      = peekElemOff . castPtr@@ -99,8 +93,8 @@ -- the length parameter is non-negative. unsafeParseVector :: (EndianStore a, Vector v a) => Int -> Parser (v a) unsafeParseVector n = pvec-  where pvec     = makeParser  width $ \ cptr -> generateM n (loadFromIndex cptr)-        width    = fromIntegral n * byteSize (undefA pvec)+  where pvec     = makeParser  width $ \ cptr -> generateM n (loadFromIndex (castPtr cptr))+        width    = fromIntegral n * sizeOf (undefA pvec)         undefA   :: (EndianStore a, Vector v a)=> Parser (v a) -> a         undefA _ = undefined 

@@ -11,18 +11,32 @@ {-# LANGUAGE MultiParamTypeClasses       #-} {-# LANGUAGE GeneralizedNewtypeDeriving  #-} {-# LANGUAGE FlexibleContexts            #-}-{-# LANGUAGE DefaultSignatures           #-} {-# LANGUAGE CPP                         #-} {-# LANGUAGE ConstraintKinds             #-} {-# LANGUAGE ExistentialQuantification   #-}  module Raaz.Core.Primitives        ( -- * Primtives and their implementations.-         Primitive(..), Symmetric(..), Asymmetric(..), Recommendation(..)+         Primitive(..), BlockAlgorithm(..), Key, Recommendation(..)        , BLOCKS, blocksOf+       , allocBufferFor        ) where +import Data.Monoid+import Prelude+ import Raaz.Core.Types++-- | Implementation of block primitives work on buffers. Often for optimal+-- performance, and in some case for safety, we need restrictions on+-- the size and alignment of the buffer pointer. This type class+-- captures such restrictions.+class Describable a => BlockAlgorithm a where++  -- | The alignment expected for the buffer pointer.+  bufferStartAlignment :: a -> Alignment++ ----------------------- A primitive ------------------------------------  @@ -35,12 +49,11 @@ -- for a given primitive. The associated type `Implementation` -- captures implementations of the primitive. ----- There is a /reference implementation/ where the emphasis is on--- correctness rather than speed or security. They are used to verify--- the correctness of the other implementations for the same--- primitive. Apart from this, for production use, we have a--- recommended implementation.-class (Describable (Implementation p)) => Primitive p where+-- For use in production code, the library recommends a particular+-- implementation using the `Recommendation` class. By default this is+-- the implementation used when no explicit implementation is+-- specified.+class BlockAlgorithm (Implementation p) => Primitive p where    -- | The block size.   blockSize :: p -> BYTES Int@@ -54,22 +67,20 @@   -- | The recommended implementation for the primitive.   recommended :: p -> Implementation p --- | A symmetric primitive. An example would be primitives like--- Ciphers, HMACs etc.-class Primitive prim => Symmetric prim where--  -- | The key for the primitive.-  type Key prim---- | An asymmetric primitive.-class Asymmetric prim where--  -- | The public key-  type PublicKey prim--  -- | The private key-  type PrivateKey prim+-- | Allocate a buffer a particular implementation of a primitive prim.+-- algorithm @algo@. It ensures that the memory passed is aligned+-- according to the demands of the implementation.+allocBufferFor :: Primitive prim+               => Implementation prim+               -> BLOCKS prim+               -> (Pointer -> IO b)+               -> IO b+allocBufferFor imp l  = allocaAligned (bufferStartAlignment imp) l +-- | Some primitives like ciphers have an encryption/decryption key. This+-- type family captures the key associated with a primitive if it has+-- any.+type family  Key prim :: *  ------------------- Type safe lengths in units of block ---------------- @@ -79,8 +90,12 @@ -- package that take lengths usually allow any type safe length as -- long as they can be converted to bytes. This can avoid a lot of -- tedious and error prone length calculations.-newtype BLOCKS p = BLOCKS Int+newtype BLOCKS p = BLOCKS {unBLOCKS :: Int}                  deriving (Show, Eq, Ord, Enum, Real, Num, Integral)++instance Monoid (BLOCKS p) where+  mempty      = BLOCKS 0+  mappend x y = BLOCKS $ unBLOCKS x + unBLOCKS y  instance Primitive p => LengthUnit (BLOCKS p) where   inBytes p@(BLOCKS x) = scale * blockSize (getPrimitiveType p)

@@ -1,104 +0,0 @@-{-# LANGUAGE TypeFamilies      #-}-{-# LANGUAGE KindSignatures    #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE CPP               #-}-module Raaz.Core.Random-  ( PRG(..), Random(..)--#ifdef HAVE_SYSTEM_PRG-  , SystemPRG-#endif--  ) where--import Control.Applicative-import Control.Monad   (void)-import Data.Word-import Foreign.Ptr     (castPtr)-import Foreign.Storable(Storable, peek)---import System.IO ( openBinaryFile, Handle, IOMode(ReadMode)-                 , BufferMode(NoBuffering), hSetBuffering-                 )--import Raaz.Core.ByteSource(InfiniteSource, slurpBytes)-import Raaz.Core.Types---- | The class that captures pseudo-random generators. Essentially the--- a pseudo-random generator (PRG) is a byte sources that can be--- seeded.-class InfiniteSource prg => PRG prg where--  -- | Associated type that captures the seed for the PRG.-  type Seed prg :: *--  -- | Creates a new pseudo-random generators-  newPRG :: Seed prg -> IO prg--  -- | Re-seeding the prg.-  reseed :: Seed prg -> prg -> IO ()---- | Stuff that can be generated by a pseudo-random generator.-class Random r where-  random :: PRG prg => prg -> IO r--  default random :: (PRG prg, Storable r) => prg -> IO r-  random = go undefined-    where go       :: (PRG prg, Storable a) => a -> prg -> IO a-          go w prg = let sz = byteSize w in-            allocaBuffer sz $ \ ptr -> do-              void $ slurpBytes sz prg ptr-              peek $ castPtr ptr--instance Random Word-instance Random Word16-instance Random Word32-instance Random Word64--instance Random w => Random (LE w) where-  random = fmap littleEndian . random--instance Random w => Random (BE w) where-  random = fmap bigEndian . random--instance (Random a, Random b) => Random (a,b) where-  random prg = (,) <$> random prg <*> random prg--instance (Random a, Random b, Random c) => Random (a,b,c) where-  random prg = (,,) <$> random prg <*> random prg <*> random prg--#ifdef HAVE_SYSTEM_PRG--- | The system wide pseudo-random generator. The source is expected--- to be of high quality, albeit a bit slow due to system call--- overheads. It is expected that this source is automatically seeded--- from the entropy pool maintained by the platform. Hence, it is--- neither necessary nor possible to seed this generator which--- reflected by the fact that the associated type @`Seed` `SystemPRG`@--- is the unit type @()@.-#endif----- Currently only POSIX platforms are supported where the file--- @\/dev\/urandom@ acts as the underlying randomness source.------ TODO: Support other platforms.----#ifdef HAVE_DEV_URANDOM-newtype SystemPRG = SystemPRG Handle---instance InfiniteSource SystemPRG where-  slurpBytes sz sprg@(SystemPRG hand) cptr = hFillBuf hand cptr sz >> return sprg---instance PRG SystemPRG where-  type Seed SystemPRG = ()--  newPRG _ = do h <- openBinaryFile "/dev/urandom" ReadMode-                hSetBuffering h NoBuffering-                return $ SystemPRG h-  reseed _ _ = return ()--#endif

@@ -0,0 +1,309 @@+-- | Module to reading from and writing into buffers.++{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE TypeSynonymInstances       #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+++module Raaz.Core.Transfer+       ( -- * Transfer actions.+         -- $transfer$++         -- ** Read action+         ReadM, ReadIO, bytesToRead, unsafeRead+       , readBytes, readInto++         -- ** Write action.+       ,  WriteM, WriteIO, bytesToWrite, unsafeWrite+       , write, writeStorable, writeVector, writeStorableVector+       , writeFrom, writeBytes+       , padWrite, prependWrite, glueWrites+       , writeByteString, skipWrite++       ) where++import           Control.Monad.IO.Class+import           Data.ByteString           (ByteString)+import           Data.String+import           Data.ByteString.Internal  (unsafeCreate)+import           Data.Monoid+import qualified Data.Vector.Generic       as G+import           Data.Word                 (Word8)+import           Foreign.Ptr               (castPtr, Ptr)+import           Foreign.Storable          ( Storable, poke )++import           Raaz.Core.MonoidalAction+import           Raaz.Core.Types.Copying+import           Raaz.Core.Types.Endian+import           Raaz.Core.Types.Pointer+import           Raaz.Core.Util.ByteString as BU+import           Raaz.Core.Encode++-- $transfer$+--+-- Low level buffer operations are problematic portions of any+-- crypto-library. Buffers are usually represented by the starting+-- pointer and one needs to keep track of the buffer sizes+-- carefully. An operation that writes into a buffer, if it writes+-- beyond the actual size of the buffer, can lead to a possible remote+-- code execution. On the other hand, when reading from a buffer, if+-- we read beyond the buffer it can leak private data to the attacker+-- (as in the case of Heart bleed bug). This module is indented to+-- give a relatively high level interface to this problem. We expose+-- two types, the `ReadM` and the `WriteM` type which deals with these+-- two aspects. Both these actions keep track of the number of bytes+-- that they transfer.++-- Complex reads and writes can be constructed using the monoid+-- instance of these types.++++-- | This monoid captures a transfer action.+newtype TransferM m = TransferM { unTransferM :: m () }++instance Monad m => Monoid (TransferM m) where+  mempty        = TransferM $ return ()+  {-# INLINE mempty #-}++  mappend wa wb = TransferM $ unTransferM wa >> unTransferM wb+  {-# INLINE mappend #-}++  mconcat = TransferM . mapM_ unTransferM+  {-# INLINE mconcat #-}++-- | A action that transfers bytes from its input pointer. Transfer+-- could either be writing or reading.+type TransferAction m = Pointer -> TransferM m++instance LAction (BYTES Int) (TransferAction m) where+  offset <.> action = action . (offset<.>)+  {-# INLINE (<.>) #-}++instance Monad m => Distributive (BYTES Int) (TransferAction m)++-- | Byte transfers that keep track of the number of bytes that were+-- transferred (from/into) its input buffer.+type Transfer m = SemiR (TransferAction m) (BYTES Int)++-- | Make an explicit transfer action given.+makeTransfer :: LengthUnit u => u -> (Pointer -> m ()) -> Transfer m+{-# INLINE makeTransfer #-}+makeTransfer sz action = SemiR (TransferM . action) $ inBytes sz+++-------------------------- Monoid for writing stuff --------------------------------------++-- | An element of type `WriteM m` is an action which when executed transfers bytes+-- /into/ its input buffer.  The type @`WriteM` m@ forms a monoid and+-- hence can be concatnated using the `<>` operator.+newtype WriteM m = WriteM { unWriteM :: Transfer m } deriving Monoid++-- | A write io-action.+type WriteIO = WriteM IO++-- | Returns the bytes that will be written when the write action is performed.+bytesToWrite :: WriteM m -> BYTES Int+bytesToWrite = semiRMonoid . unWriteM++-- | Perform the write action without any checks of the buffer+unsafeWrite :: WriteM m+            -> Pointer   -- ^ The pointer for the buffer to be written into.+            -> m ()+unsafeWrite wr =  unTransferM . semiRSpace (unWriteM wr)++-- | Function that explicitly constructs a write action.+makeWrite     :: LengthUnit u => u -> (Pointer -> m ()) -> WriteM m+makeWrite sz  = WriteM . makeTransfer sz+++-- | The expression @`writeStorable` a@ gives a write action that+-- stores a value @a@ in machine endian. The type of the value @a@ has+-- to be an instance of `Storable`. This should be used when we want+-- to talk with C functions and not when talking to the outside world+-- (otherwise this could lead to endian confusion). To take care of+-- endianness use the `write` combinator.+writeStorable :: (MonadIO m, Storable a) => a -> WriteM m+writeStorable a = WriteM $ makeTransfer (sizeOf a) pokeIt+  where pokeIt = liftIO . flip poke a . castPtr+-- | The expression @`write` a@ gives a write action that stores a+-- value @a@. One needs the type of the value @a@ to be an instance of+-- `EndianStore`. Proper endian conversion is done irrespective of+-- what the machine endianness is. The man use of this write is to+-- serialize data for the consumption of the outside world.+write :: (MonadIO m, EndianStore a) => a -> WriteM m+write a = makeWrite (sizeOf a) $ liftIO . flip (store . castPtr) a++-- | Write many elements from the given buffer+writeFrom :: (MonadIO m, EndianStore a) => Int -> Src (Ptr a) -> WriteM m+writeFrom n src = makeWrite (sz undefined src)+                  $ \ ptr -> liftIO  $ copyToBytes (destination ptr) src n+  where sz :: Storable a => a -> Src (Ptr a) -> BYTES Int+        sz a _ = toEnum n * sizeOf a++-- | The vector version of `writeStorable`.+writeStorableVector :: (Storable a, G.Vector v a, MonadIO m) => v a -> WriteM m+{-# INLINE writeStorableVector #-}+writeStorableVector = G.foldl' foldFunc mempty+  where foldFunc w a =  w <> writeStorable a++{-++TODO: This function can be slow due to the fact that each time we use+the semi-direct product, we incur a cost due to the lambda being not+lifted.++-}++-- | The vector version of `write`.+writeVector :: (EndianStore a, G.Vector v a, MonadIO m) => v a -> WriteM m+{-# INLINE writeVector #-}+{- TODO: improve this using the fact that the size is known -}++writeVector = G.foldl' foldFunc mempty+  where foldFunc w a =  w <> write a+{- TODO: Same as in writeStorableVector -}+++-- | The combinator @writeBytes n b@ writes @b@ as the next @n@+-- consecutive bytes.+writeBytes :: (LengthUnit n, MonadIO m) => Word8 -> n -> WriteM m+writeBytes w8 n = makeWrite n memsetIt+  where memsetIt cptr = liftIO $ memset cptr w8 n++{-+-- | The write action @padWriteTo w n wr@ is wr padded with the byte @w@ so that the total length+-- is n. If the total bytes written by @wr@ is greater than @n@ then this throws an error.+padWriteTo :: ( LengthUnit n, MonadIO m)+              => Word8     -- ^ the padding byte to use+              -> n         -- ^ the total length to pad to+              -> WriteM m  -- ^ the write that needs padding+              -> WriteM m+padWriteTo w8 n wrm | pl < 0    = error "padToLength: padding length smaller than total length"+                    | otherwise = wrm <> writeBytes w8 n+  where pl = inBytes n - bytesToWrite wrm++-}++-- | The combinator @glueWrites w n hdr ftr@ is equivalent to+-- @hdr <> glue <> ftr@ where the write @glue@ writes as many bytes+-- @w@ so that the total length is aligned to the boundary @n@.+glueWrites :: ( LengthUnit n, MonadIO m)+           =>  Word8    -- ^ The bytes to use in the glue+           -> n        -- ^ The length boundary to align to.+           -> WriteM m -- ^ The header write+           -> WriteM m -- ^ The footer write+           -> WriteM m+glueWrites w8 n hdr ftr = hdr <> writeBytes w8 lglue <> ftr+  where lhead   = bytesToWrite hdr+        lfoot   = bytesToWrite ftr+        lexceed = (lhead + lfoot) `rem` nBytes  -- bytes exceeding the boundary.+        lglue   = nBytes - lexceed+        nBytes  = inBytes n++++-- | The write action @prependWrite w n wr@ is wr pre-pended with the byte @w@ so that the total length+-- ends at a multiple of @n@.+prependWrite  :: ( LengthUnit n, MonadIO m)+              => Word8     -- ^ the byte to pre-pend with.+              -> n         -- ^ the length to align the message to+              -> WriteM m  -- ^ the message that needs pre-pending+              -> WriteM m+prependWrite w8 n = glueWrites w8 n mempty++-- | The write action @padWrite w n wr@ is wr padded with the byte @w@ so that the total length+-- ends at a multiple of @n@.+padWrite :: ( LengthUnit n, MonadIO m)+         => Word8     -- ^ the padding byte to use+         -> n         -- ^ the length to align message to+         -> WriteM m  -- ^ the message that needs padding+         -> WriteM m+padWrite w8 n = flip (glueWrites w8 n) mempty++-- | Writes a strict bytestring.+writeByteString :: MonadIO m => ByteString -> WriteM m+writeByteString bs = makeWrite (BU.length bs) $ liftIO  . BU.unsafeCopyToPointer bs++-- | A write action that just skips over the given bytes.+skipWrite :: (LengthUnit u, Monad m) => u -> WriteM m+skipWrite = flip makeWrite $ const $ return ()++instance MonadIO m => IsString (WriteM m)  where+  fromString = writeByteString . fromString++instance Encodable (WriteM IO) where+  {-# INLINE toByteString #-}+  toByteString w  = unsafeCreate n $ unsafeWrite w . castPtr+    where BYTES n = bytesToWrite w++  {-# INLINE unsafeFromByteString #-}+  unsafeFromByteString = writeByteString++  {-# INLINE fromByteString #-}+  fromByteString       = Just . writeByteString++------------------------  Read action ----------------------------++-- | The `ReadM` is the type that captures the act of reading from a buffer+-- and possibly doing some action on the bytes read. Although+-- inaccurate, it is helpful to think of elements of `ReadM` as action+-- that on an input buffer transfers data from it to some unspecified+-- source.+--+-- Read actions form a monoid with the following semantics: if @r1@+-- and @r2@ are two read actions then @r1 `<>` r2@ first reads the+-- data associated from @r1@ and then the read associated with the+-- data @r2@.++newtype ReadM m = ReadM { unReadM :: Transfer m} deriving Monoid++-- | A read io-action.+type ReadIO = ReadM IO++-- | Function that explicitly constructs a write action.+makeRead     :: LengthUnit u => u -> (Pointer -> m ()) -> ReadM m+makeRead sz  = ReadM . makeTransfer sz+++-- | The expression @bytesToRead r@ gives the total number of bytes that+-- would be read from the input buffer if the action @r@ is performed.+bytesToRead :: ReadM m -> BYTES Int+bytesToRead = semiRMonoid . unReadM++-- | The action @unsafeRead r ptr@ results in reading @bytesToRead r@+-- bytes from the buffer pointed by @ptr@. This action is unsafe as it+-- will not (and cannot) check if the action reads beyond what is+-- legally stored at @ptr@.+unsafeRead :: ReadM m+           -> Pointer   -- ^ The pointer for the buffer to be written into.+           -> m ()+unsafeRead rd =  unTransferM . semiRSpace (unReadM rd)++-- | The action @readBytes sz dptr@ gives a read action, which if run on+-- an input buffer, will transfers @sz@ to the destination buffer+-- pointed by @dptr@. Note that it is the responsibility of the user+-- to make sure that @dptr@ has enough space to receive @sz@ units of+-- data if and when the read action is executed.+readBytes :: ( LengthUnit sz, MonadIO m)+          => sz             -- ^ how much to read.+          -> Dest Pointer   -- ^ buffer to read the bytes into+          -> ReadM m+readBytes sz dest = makeRead sz+                    $ \ ptr -> liftIO  $ memcpy dest (source ptr) sz++-- | The action @readInto n dptr@ gives a read action which if run on an+-- input buffer, will transfers @n@ elements of type @a@ into the+-- buffer pointed by @dptr@. In particular, the read action @readInto n+-- dptr@ is the same as @readBytes (fromIntegral n :: BYTES Int) dptr@+-- when the type @a@ is `Word8`.+readInto :: (EndianStore a, MonadIO m)+         => Int             -- ^ how many elements to read.+         -> Dest (Ptr a)    -- ^ buffer to read the elements into+         -> ReadM m+readInto n dest = makeRead (sz undefined dest)+                  $ \ ptr -> liftIO $ copyFromBytes dest (source ptr) n+  where sz :: Storable a => a -> Dest (Ptr a) -> BYTES Int+        sz a _ = toEnum n * sizeOf a

@@ -1,77 +1,68 @@ -- | This module exposes some core types used through out the Raaz -- library. One of the major goals of the raaz cryptographic library--- use the type safety of Haskell to catch some common bugs at compile--- time. As of now we address three kinds of errors+-- is to use the type safety of Haskell to catch some common+-- bugs at compile time. --+-- __WARNING:__ If you are just a user of this library, it is unlikely+-- that you will need to import this module. It is only required if+-- you are a developer and want to define a new cryptographic data+-- type.  module Raaz.Core.Types-       ( -- * Timing safe equality checking.-         -- $timingSafeEquality$+       ( -- * Overview.+         -- $overview$          module Raaz.Core.Types.Equality-         -- * Endianess aware types.-         -- $endianness$        , module Raaz.Core.Types.Endian-         -- * The pointer type and Length offsets.-         -- $typesafeLength$        , module Raaz.Core.Types.Pointer-         -- * Tuples with length encoded in their types.+       , module Raaz.Core.Types.Aligned        , module Raaz.Core.Types.Tuple+       , module Raaz.Core.Types.Copying        , Describable(..)        ) where +import Raaz.Core.Types.Aligned import Raaz.Core.Types.Describe import Raaz.Core.Types.Equality import Raaz.Core.Types.Endian import Raaz.Core.Types.Pointer import Raaz.Core.Types.Tuple+import Raaz.Core.Types.Copying( Src, Dest, source, destination) --- $timingSafeEquality$++-- $overview$ ----- We need a consistent way to build timing safe equality--- comparisons. The type class `Equality` plays the role of `Eq` for--- us. The comparison result is of type `Result` and not `Bool` so as--- to avoid timing attacks due to short-circuting of the--- AND-operation.+-- A lot of cryptographic code is low level and involves quite a bit+-- of boilerplate and are therefore fertile grounds for bugs. This+-- module describes types specific to raaz that are designed to catch+-- bugs in such low level code. The three principles that we follow+-- in the design are: ----- The `Result` type is an opaque type to avoid the user from--- compromising the equality comparisons by pattern matching on it. To--- combine the results of two comparisons one can use the monoid--- instance of `Result`, i.e. if @r1@ and @r2@ are the results of two--- comparisons then @r1 `mappend` r2@ essentially takes the AND of--- these results but this and is not short-circuited and is timing--- independent.+-- 1. Define distinct types for semantically different objects. For+--    example, distinguish between buffer length/pointer offset in+--    bytes versus other units (see `LengthUnit`) or make endian aware+--    variants of standard word types (see `BE` and `LE`) etc. ----- Instance for basic word types are provided by the library and users--- are expected to build the `Equality` instances of compound types by--- combine the results of comparisons using the monoid instance of--- `Result`. We also give timing safe equality comparisons for--- `Vector` types using the `eqVector` and `oftenCorrectEqVector`--- functions.  Once an instance for `Equality` is defined for a--- cryptographically sensitive data type, we define the `Eq` for it--- indirectly using the `Equality` instance and the operation `===`.----- $endianness$+-- 2. Make sure that the low level functions are sensitive to these+--    types. For example, the function `sizeOf` exposed here returns+--    @`BYTES` `Int`@ instead of just `Int` and functions like+--    `allocaBuffer` are generic enough to work with any length units. ----- Cryptographic primitives often consider their input as an array of--- words of a particular endianness. Endianness is only relevant when--- the data is being read or written to. It makes sense therefore to--- keep track of the endianness in the type and perform necessary--- transformations depending on the endianness of the--- machine. Such types are captured by the type class `EndianStore`. They--- support the `load` and `store` combinators that automatically compensates--- for the endianness of the machine.+-- 3. Provide obvious instances for some basic type and have and+--    idiom/design pattern to build such interfaces for user defined+--    types. For example, we have a very specific way to build timing+--    safe equality functions for arbitrary types. Most of the time,+--    in our case it just amounts to handling product types. ----- This libraray exposes endian aware variants of `Word32` and--- `Word64` here and expect other cryptographic types to use such--- endian explicit types in their definition.----- $typesafeLength$+-- == Role of Monoids. ----- We have the generic pointer type `Pointer` and distinguish between--- different length units at the type level. This helps in to avoid a--- lot of length conversion errors.--+-- Monoids play an important role in facilitating the top down+-- approach to type safety that we mentioned above. Some types+-- described here have a natural monoid semantics. For example, when+-- dealing with pointer offsets and buffer sizes, we use type safe+-- length units like `BYTES`. These length units are instances of+-- monoids where the underlying operation is addition. On the other+-- hand, when it comes to pointer alignment which is captured by the+-- type `Alignment`, the monoid operation is taking the lowest common+-- multiple.+-- {-# ANN module "HLint: ignore Use import/export shortcut" #-}

@@ -0,0 +1,83 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE ConstraintKinds      #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}++-- | This module gives ways to force the alignment of types.+module Raaz.Core.Types.Aligned+  ( -- * Types to force alignment.+    Aligned, unAligned, aligned16Bytes, aligned32Bytes, aligned64Bytes+  ) where+++#if MIN_VERSION_base(4,7,0)+import           Data.Proxy+#endif++import           GHC.TypeLits+import           Foreign.Ptr                 ( castPtr      )+import           Foreign.Storable            ( Storable(..) )+import           Prelude hiding              ( length       )+++-- | A type @w@ forced to be aligned to the alignment boundary @alg@+newtype Aligned (align :: Nat) w+  = Aligned { unAligned :: w -- ^ The underlying unAligned value.+            }++-- | Align the value to 16-byte boundary+aligned16Bytes :: w -> Aligned 16 w+{-# INLINE aligned16Bytes #-}++-- | Align the value to 32-byte boundary+aligned32Bytes :: w -> Aligned 32 w+{-# INLINE aligned32Bytes #-}++-- | Align the value to 64-byte boundary+aligned64Bytes :: w -> Aligned 64 w+{-# INLINE aligned64Bytes #-}++aligned16Bytes = Aligned+aligned32Bytes = Aligned+aligned64Bytes = Aligned++#if MIN_VERSION_base(4,7,0)++-- | The constraint on the alignment o(since base 4.7.0).+type AlignBoundary (alg :: Nat) = KnownNat alg++alignmentBoundary :: AlignBoundary alg => Aligned alg a -> Int+alignmentBoundary = aB Proxy+  where aB :: AlignBoundary algn => Proxy algn -> Aligned algn a -> Int+        aB algn _ = fromEnum $ natVal algn++#else++-- | The constraint on the alignment (pre base 4.7.0).+type AlignBoundary (alg :: Nat) = SingI alg++alignmentBoundary :: AlignBoundary algn => Aligned algn a -> Int+alignmentBoundary = withSing aB+  where aB        ::  AlignBoundary algn => Sing algn      -> Aligned algn a -> Int+        aB algn _ = fromEnum $ fromSing algn+++#endif+++instance (Storable a, AlignBoundary alg) => Storable (Aligned alg a) where++  sizeOf = sizeOf . unAligned++  alignment alg = lcm valueAlignment forceAlignment+    where valueAlignment = alignment $ unAligned alg+          forceAlignment = alignmentBoundary alg++  peek = fmap Aligned .  peek . castPtr++  poke ptr = poke (castPtr ptr) . unAligned

@@ -0,0 +1,52 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-- | Types to avoid source destination confusion while copying.+module Raaz.Core.Types.Copying+       (+         -- * Copying.+         -- $copyconvention$+         Src(..), Dest(..), source, destination+       ) where++import Foreign.Storable ( Storable )++-- $copyconvention$+--+-- Consider a copy operation that involves copying data between two+-- entities of the same type. If the source and target is confused+-- this can lead to bugs. The types `Src` and `Dest` helps in avoiding+-- this confusion. The convention that we follow is that copy function+-- mark its destination and source explicitly at the type level. The+-- actual constructors for the type `Src` and `Dest` are not available+-- to users of the library. Instead they use the smart constructors+-- `source` and `destination` when passing arguments to these+-- functions.+--+-- The developers of the raaz library do have access to the+-- constructors. However, it is unlikely one would need it. Since both+-- `Src` and `Dest` derive the underlying `Storable` instance, one can+-- mark `Src` and `Dest` in calls to `FFI` functions as well.+++-- | The source of a copy operation.+newtype Src  a = Src { unSrc :: a } deriving Storable++-- | smart constructor for source+source :: a -> Src a+source = Src++instance Functor Src where+  fmap f = Src . f . unSrc++-- | The destination of a copy operation.+--+-- Note to Developers of Raaz: Since the `Dest` type inherits the+-- Storable instance of the base type, one can use this type in+-- foreign functions.+newtype Dest a = Dest { unDest :: a } deriving Storable++-- | smart constructor for destionation.+destination :: a -> Dest a+destination = Dest++instance Functor Dest where+  fmap f = Dest . f . unDest

@@ -6,8 +6,11 @@ {-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE TypeFamilies               #-} +-- | Endian safe types. module Raaz.Core.Types.Endian-       ( EndianStore(..)+       ( -- * Endianess aware types.+         -- $endianness$+         EndianStore(..), copyFromBytes, copyToBytes        -- ** Endian explicit word types.        , LE, BE, littleEndian, bigEndian        -- ** Helper functions for endian aware storing and loading.@@ -15,93 +18,209 @@        , loadFrom, loadFromIndex        ) where +import           Control.Applicative import           Control.DeepSeq             ( NFData) import           Control.Monad               ( liftM ) import           Data.Bits-import           Data.Monoid import           Data.Typeable import           Data.Vector.Unboxed         ( MVector(..), Vector, Unbox )-import           Data.Word                   ( Word32, Word64, Word8      )-import           Foreign.Ptr                 ( castPtr      )-import           Foreign.Storable            ( Storable(..) )+import           Data.Word+import           Foreign.Ptr                 ( castPtr, Ptr )+import           Foreign.Storable            ( Storable, peek, poke ) +import           Prelude  import qualified Data.Vector.Generic         as GV import qualified Data.Vector.Generic.Mutable as GVM -import           Raaz.Core.MonoidalAction++import           Raaz.Core.Types.Copying import           Raaz.Core.Types.Pointer import           Raaz.Core.Types.Equality --- | This class is the starting point of an endian agnostic interface--- to basic cryptographic data types. Endianness only matters when we--- first load the data from the buffer or when we finally write the--- data out. Any multi-byte type that are meant to be serialised--- should define and instance of this class. The `load` and `store`--- should takes care of the appropriate endian conversion.+#include "MachDeps.h"++-- $endianness$+--+-- Cryptographic primitives often consider their input as an array of+-- words of a particular endianness. Endianness is only relevant when+-- serialising to (or de-serialising from) their encoding to the+-- outside world. Raaz strives to use types to provide an endian+-- agnostic interface to all data that is relevant to the outside+-- world.+--+-- The starting point of an endian agnostic interface is the class+-- `EndianStore`. Instances of this class support an endian agnostic+-- `load` and `store`. Endian adjusted copying is also provided for+-- these types through the helper functions `copyFromBytes` and+-- `copyToBytes`.+--+-- It is tedious to think about endianness for each new type one might+-- encounter. As before, we have a top down approach to defining such+-- an interface. To start with, the library exposes endian aware+-- variants of `Word32` and `Word64` and functions @littleEndian@ and+-- @bigEndian@ for conversions. The `Tuple` type inherits the+-- endianness of its element type, i.e for example @Tuple 10 (LE+-- Word32)@ when loded (or stored) will load (or store) 10 32-bit+-- words assuming that the words are expressed in little endian. Other+-- types are then built out of these endian aware types. For example,+-- cryptographic type `SHA512` is defined as.+--+-- >+-- > newtype SHA512 = SHA512 (Tuple 8 (BE Word64))+-- >                      deriving (Equality, Eq, Storable, EndianStore)+-- >+--++-- | This class captures types which provides an endian agnostic way+-- of loading from and storing to data buffers. Any multi-byte type+-- that is meant to be serialised to the outside world should be an+-- instance of this class. When defining the `load`, `store`,+-- `adjustEndian` member functions, care should be taken to ensure+-- proper endian conversion.+-- class Storable w => EndianStore w where -  -- | Store the given value at the locating pointed by the pointer-  store :: Pointer   -- ^ the location.-        -> w           -- ^ value to store+  -- | The action @store ptr w@ stores @w@ at the location pointed by+  -- @ptr@.  Endianness of the type @w@ is taken care of when storing.+  -- For example, irrespective of the endianness of the machine,+  -- @store ptr (0x01020304 :: BE Word32)@ will store the bytes+  -- @0x01@, @0x02@, @0x03@, @0x04@ respectively at locations @ptr@,+  -- @ptr +1@, @ptr+2@ and @ptr+3@. On the other hand @store ptr+  -- (0x01020304 :: LE Word32)@ would store @0x04@, @0x03@, @0x02@,+  -- @0x01@ at the above locations.++  store :: Ptr w   -- ^ the location.+        -> w       -- ^ value to store         -> IO () -  -- | Load the value from the location pointed by the pointer.-  load  :: Pointer -> IO w+  -- | The action @load ptr@ loads the value stored at the @ptr@. Like+  -- store, it takes care of the endianness of the data type.  For+  -- example, if @ptr@ points to a buffer containing the bytes @0x01@,+  -- @0x02@, @0x03@, @0x04@, irrespective of the endianness of the+  -- machine, @load ptr :: IO (BE Word32)@ will load the vale+  -- @0x01020304@ of type @BE Word32@ and @load ptr :: IO (LE Word32)@+  -- will load @0x04030201@ of type @LE Word32@.+  load  :: Ptr w -> IO w +  -- | The action @adjustEndian ptr n@ adjusts the encoding of bytes+  -- stored at the location @ptr@ to conform with the endianness of+  -- the underlying data type. For example, assume that @ptr@ points+  -- to a buffer containing the bytes @0x01 0x02 0x03 0x04@, and we+  -- are on a big endian machine, then @adjustEndian (ptr :: Ptr (LE+  -- Word32)) 1@ will result in @ptr@ pointing to the sequence @0x04+  -- 0x03 0x02 0x01@. On the other hand if we were on a little endian+  -- machine, the sequence should remain the same.  In particular, the+  -- following equalities should hold.+  --+  -- >+  -- > store ptr w          = poke ptr w >> adjustEndian ptr 1+  -- >+  --+  -- Similarly the value loaded by @load ptr@ should be same as the+  -- value returned by @adjustEndian ptr 1 >> peak ptr@, although the+  -- former does not change the contents stored at @ptr@ where as the+  -- latter might does modify the contents pointed by @ptr@ if the+  -- endianness of the machine and the time do not agree.+  --+  -- The action @adjustEndian ptr n >> adjustEndian ptr n @ should be+  -- equivalent to @return ()@.+  --+  adjustEndian :: Ptr w  -- ^ buffer pointers,+               -> Int    -- ^ how many w's are present,+               -> IO ()++ instance EndianStore Word8 where-  store = poke . castPtr-  load  = peek . castPtr+  store                  = poke+  load                   = peek+  adjustEndian  _ _      = return () -{--}+instance EndianStore w => EndianStore (BYTES w) where+  store ptr (BYTES w)  = store (castPtr ptr) w+  load                 = fmap BYTES . load . castPtr+  adjustEndian         = adjustEndian . castToPtrW+    where castToPtrW :: Ptr (BYTES w) -> Ptr w+          castToPtrW = castPtr++-- | Store the given value at an offset from the crypto pointer. The+-- offset is given in type safe units.+storeAt :: ( EndianStore w+           , LengthUnit offset+           )+        => Ptr w     -- ^ the pointer+        -> offset    -- ^ the absolute offset in type safe length units.+        -> w         -- ^ value to store+        -> IO ()+{-# INLINE storeAt #-}+storeAt ptr = store . movePtr ptr+ -- | Store the given value as the @n@-th element of the array -- pointed by the crypto pointer. storeAtIndex :: EndianStore w-             => Pointer        -- ^ the pointer to the first element of the+             => Ptr w          -- ^ the pointer to the first element of the                                -- array              -> Int            -- ^ the index of the array              -> w              -- ^ the value to store              -> IO () {-# INLINE storeAtIndex #-} storeAtIndex cptr index w = storeAt cptr offset w-  where offset = toEnum index * byteSize w+  where offset = toEnum index * sizeOf w --- | Store the given value at an offset from the crypto pointer. The--- offset is given in type safe units.-storeAt :: ( EndianStore w-           , LengthUnit offset-           )-        => Pointer   -- ^ the pointer-        -> offset      -- ^ the absolute offset in type safe length units.-        -> w           -- ^ value to store-        -> IO ()-{-# INLINE storeAt #-}-storeAt cptr offset = store (Sum offset <.> cptr)  -- | Load the @n@-th value of an array pointed by the crypto pointer. loadFromIndex :: EndianStore w-              => Pointer -- ^ the pointer to the first element of-                           -- the array-              -> Int       -- ^ the index of the array+              => Ptr w   -- ^ the pointer to the first element of+                         -- the array+              -> Int     -- ^ the index of the array               -> IO w {-# INLINE loadFromIndex #-}-loadFromIndex cptr index = loadP undefined-   where loadP ::  EndianStore w => w -> IO w-         loadP w = loadFrom cptr offset-           where offset = toEnum index * byteSize w+loadFromIndex cptr index = load (shiftPtr cptr undefined)+  where shiftPtr :: Storable w => Ptr w -> w -> Ptr w+        shiftPtr ptr w = movePtr ptr (toEnum index * sizeOf w)  -- | Load from a given offset. The offset is given in type safe units. loadFrom :: ( EndianStore w             , LengthUnit offset             )-         => Pointer -- ^ the pointer-         -> offset    -- ^ the offset+         => Ptr w    -- ^ the pointer+         -> offset   -- ^ the offset          -> IO w {-# INLINE loadFrom #-}-loadFrom cptr offset = load (Sum offset <.> cptr)+loadFrom ptr = load . movePtr ptr ---}+-- | For the type @w@, the action @copyFromBytes dest src n@ copies @n@-elements from+-- @src@ to @dest@. Copy performed by this combinator accounts for the+-- endianness of the data in @dest@ and is therefore /not/ a mere copy+-- of @n * sizeOf(w)@ bytes. This action does not modify the @src@+-- pointer in any way. +copyFromBytes :: EndianStore w+              => Dest (Ptr w)+              -> Src  Pointer+              -> Int          -- ^ How many items.+              -> IO ()+copyFromBytes dest@(Dest ptr) src n =  memcpy (castPtr <$> dest) src (sz dest undefined)+                                       >> adjustEndian ptr n+  where sz     :: Storable w => Dest (Ptr w) -> w -> BYTES Int+        sz _ w =  sizeOf w * toEnum n++-- | Similar to @copyFromBytes@ but the transfer is done in the other direction. The copy takes+-- care of performing the appropriate endian encoding.+copyToBytes :: EndianStore w+            => Dest Pointer+            -> Src (Ptr w)+            -> Int+            -> IO ()+copyToBytes dest@(Dest dptr) src n =  memcpy dest  (castPtr <$> src) (sz src undefined)+                                     >> adjust src (castPtr dptr)+  where adjust :: EndianStore w => Src (Ptr w) -> Ptr w -> IO ()+        adjust _ ptr = adjustEndian ptr n++        sz     :: Storable w => Src (Ptr w) -> w -> BYTES Int+        sz _ w =  sizeOf w * toEnum n++ {- Developers notes: -----------------@@ -113,19 +232,25 @@ -}  -- | Little endian version of the word type @w@-newtype LE w = LE w+newtype LE w = LE { unLE :: w }     deriving ( Bounded, Enum, Read, Show              , Integral, Num, Real, Eq, Equality, Ord              , Bits, Storable, Typeable, NFData              ) +instance Functor LE where+  fmap f = LE . f . unLE+ -- | Big endian version of the word type @w@-newtype BE w = BE w+newtype BE w = BE { unBE :: w }     deriving ( Bounded, Enum, Read, Show              , Integral, Num, Real, Eq, Equality, Ord              , Bits, Storable, Typeable, NFData              ) +instance Functor BE where+  fmap f = BE . f . unBE+ -- | Convert to the little endian variant. littleEndian :: w -> LE w {-# INLINE littleEndian #-}@@ -133,58 +258,83 @@  -- | Convert to the big endian variants. bigEndian :: w -> BE w+{-# INLINE bigEndian #-} bigEndian = BE -------------------- Endian store for LE 32 ------------------------+---------------- The foreign function calls ---------------------- -foreign import ccall unsafe "raaz/core/endian.h raazLoadLE32"-  c_loadLE32 :: Pointer -> IO Word32+foreign import ccall unsafe "raaz/core/endian.h raazSwap32Array"+  c_Swap32Array :: Ptr Word32 -> Int -> IO ()+foreign import ccall unsafe "raaz/core/endian.h raazSwap64Array"+  c_Swap64Array :: Ptr Word64 -> Int -> IO () -foreign import ccall unsafe "raaz/core/endian.h raazStoreLE32"-  c_storeLE32 :: Pointer -> Word32 -> IO ()+# if !MIN_VERSION_base(4,7,0) +foreign import ccall unsafe "raaz/core/endian.h raazSwap32"+  byteSwap32  :: Word32 -> Word32+foreign import ccall unsafe "raaz/core/endian.h raazSwap64"+  byteSwap64  :: Word64 -> Word64++# endif++#ifdef WORDS_BIGENDIAN++unLEPtr :: Ptr (LE w) -> Ptr w+unLEPtr = castPtr+ instance EndianStore (LE Word32) where-  load             = fmap LE .  c_loadLE32-  store ptr (LE w) = c_storeLE32 ptr w+  load  ptr    = fmap byteSwap32 <$>  peek ptr+  store ptr    = poke ptr  . fmap byteSwap32+  adjustEndian = c_Swap32Array . unLEPtr -------------------- Endian store for BE 32 ------------------------ -foreign import ccall unsafe "raaz/core/endian.h raazLoadBE32"-  c_loadBE32 :: Pointer -> IO Word32+instance EndianStore (LE Word64) where+  load          = fmap byteSwap64    <$> peek+  store ptr     = poke ptr  . fmap byteSwap64+  adjustEndian  = c_Swap64Array . unLEPtr -foreign import ccall unsafe "raaz/core/endian.h raazStoreBE32"-  c_storeBE32 :: Pointer -> Word32 -> IO ()  instance EndianStore (BE Word32) where-  load             = fmap BE .  c_loadBE32-  store ptr (BE w) = c_storeBE32 ptr w+  load             = peek+  store ptr        = poke+  adjustEndian _ _ = return () +instance EndianStore (BE Word64) where+  load             = peek+  store ptr        = poke+  adjustEndian _ _ = return () -------------------- Endian store for LE 64 ------------------------+# else -foreign import ccall unsafe "raaz/core/endian.h raazLoadLE64"-  c_loadLE64 :: Pointer -> IO Word64+unBEPtr :: Ptr (BE w) -> Ptr w+unBEPtr = castPtr -foreign import ccall unsafe "raaz/core/endian.h raazStoreLE64"-  c_storeLE64 :: Pointer -> Word64 -> IO ()+--- We are in a little endian machine. -instance EndianStore (LE Word64) where-  load             = fmap LE .  c_loadLE64-  store ptr (LE w) = c_storeLE64 ptr w+instance EndianStore (BE Word32) where+  load  ptr    = fmap byteSwap32 <$> peek ptr+  store ptr    = poke ptr . fmap byteSwap32+  adjustEndian = c_Swap32Array . unBEPtr  -------------------- Endian store for BE 64 ------------------------+instance EndianStore (BE Word64) where+  load  ptr    = fmap byteSwap64 <$> peek ptr+  store ptr    = poke ptr . fmap byteSwap64+  adjustEndian = c_Swap64Array . unBEPtr -foreign import ccall unsafe "raaz/core/endian.h raazLoadBE64"-  c_loadBE64 :: Pointer -> IO Word64 -foreign import ccall unsafe "raaz/core/endian.h raazStoreBE64"-  c_storeBE64 :: Pointer -> Word64 -> IO ()+instance EndianStore (LE Word32) where+  load             = peek+  store            = poke+  adjustEndian _ _ = return () -instance EndianStore (BE Word64) where-  load             = fmap BE .  c_loadBE64-  store ptr (BE w) = c_storeBE64 ptr w+instance EndianStore (LE Word64) where+  load              = peek+  store             = poke+  adjustEndian _ _  = return () ++#endif  ------------------- Unboxed vector of Endian word types --------------- 

@@ -2,12 +2,14 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts      #-}++-- | This module defines combinators, types and instances for defining+-- timing safe equality checks. module Raaz.Core.Types.Equality-       ( Equality(..), (===)-       -- ** The result of comparion.+       ( -- * Timing safe equality checking.+         -- $timingSafeEquality$+         Equality(..), (===)        , Result-       -- ** Comparing vectors.-       , oftenCorrectEqVector, eqVector        ) where  import           Control.Monad               ( liftM )@@ -22,84 +24,40 @@ import           Data.Vector.Unboxed         ( MVector(..), Vector, Unbox ) import           Data.Word --- | The result of a comparison. This is an opaque type and the monoid instance essentially takes--- AND of two comparisons in a timing safe way.-newtype Result =  Result { unResult :: Word } --- | Checks whether a given equality comparison is successful.-isSuccessful :: Result -> Bool-{-# INLINE isSuccessful #-}-isSuccessful = (==0) . unResult -instance Monoid Result where-  mempty      = Result 0-  mappend a b = Result (unResult a .|. unResult b)-  {-# INLINE mempty  #-}-  {-# INLINE mappend #-}---- | MVector for Results.-newtype instance MVector s Result = MV_Result (MVector s Word)--- | Vector of Results.-newtype instance Vector    Result = V_Result  (Vector Word)--instance Unbox Result--instance GM.MVector MVector Result where-  {-# INLINE basicLength #-}-  {-# INLINE basicUnsafeSlice #-}-  {-# INLINE basicOverlaps #-}-  {-# INLINE basicUnsafeNew #-}-  {-# INLINE basicUnsafeReplicate #-}-  {-# INLINE basicUnsafeRead #-}-  {-# INLINE basicUnsafeWrite #-}-  {-# INLINE basicClear #-}-  {-# INLINE basicSet #-}-  {-# INLINE basicUnsafeCopy #-}-  {-# INLINE basicUnsafeGrow #-}-  basicLength          (MV_Result v)            = GM.basicLength v-  basicUnsafeSlice i n (MV_Result v)            = MV_Result $ GM.basicUnsafeSlice i n v-  basicOverlaps (MV_Result v1) (MV_Result v2)   = GM.basicOverlaps v1 v2--  basicUnsafeRead  (MV_Result v) i              = Result `liftM` GM.basicUnsafeRead v i-  basicUnsafeWrite (MV_Result v) i (Result x)   = GM.basicUnsafeWrite v i x--  basicClear (MV_Result v)                      = GM.basicClear v-  basicSet   (MV_Result v)         (Result x)   = GM.basicSet v x--  basicUnsafeNew n                              = MV_Result `liftM` GM.basicUnsafeNew n-  basicUnsafeReplicate n     (Result x)         = MV_Result `liftM` GM.basicUnsafeReplicate n x-  basicUnsafeCopy (MV_Result v1) (MV_Result v2) = GM.basicUnsafeCopy v1 v2-  basicUnsafeGrow (MV_Result v)   n             = MV_Result `liftM` GM.basicUnsafeGrow v n--#if MIN_VERSION_vector(0,11,0)-  basicInitialize (MV_Result v)               = GM.basicInitialize v-#endif----instance G.Vector Vector Result where-  {-# INLINE basicUnsafeFreeze #-}-  {-# INLINE basicUnsafeThaw #-}-  {-# INLINE basicLength #-}-  {-# INLINE basicUnsafeSlice #-}-  {-# INLINE basicUnsafeIndexM #-}-  {-# INLINE elemseq #-}-  basicUnsafeFreeze (MV_Result v)             = V_Result  `liftM` G.basicUnsafeFreeze v-  basicUnsafeThaw (V_Result v)                = MV_Result `liftM` G.basicUnsafeThaw v-  basicLength (V_Result v)                    = G.basicLength v-  basicUnsafeSlice i n (V_Result v)           = V_Result $ G.basicUnsafeSlice i n v-  basicUnsafeIndexM (V_Result v) i            = Result   `liftM`  G.basicUnsafeIndexM v i--  basicUnsafeCopy (MV_Result mv) (V_Result v) = G.basicUnsafeCopy mv v-  elemseq _ (Result x)                        = G.elemseq (undefined :: Vector a) x------ | In a cryptographic setting, naive equality checking is--- dangerous. This class is the timing safe way of doing equality--- checking. The recommended method of defining equality checking for--- cryptographically sensitive data is as follows.+-- $timingSafeEquality$ --+-- Many cryptographic setting require comparing two secrets and such+-- comparisons should be timing safe, i.e. the time taken to make the+-- comparison should not depend on the actual values that are+-- compared. Unfortunately, the equality comparison of may Haskell+-- types like `ByteString`, provided via the class `Eq` is /not/+-- timing safe. In raaz we take special care in defining the `Eq`+-- instance of all cryptographically sensitive types which make them+-- timing safe . For example, if we compare two digests @dgst1 ==+-- dgst2@, the `Eq` instance is defined in such a way that the time+-- taken is constant irrespective of the actual values. We also give a+-- mechanism to build timing safe equality for more complicated types+-- that user might need to define in her use cases as we now describe.+--+-- The starting point of defining such timing safe equality is the+-- class `Equality` which plays the role `Eq`. The member function+-- `eq` playing the role of (`==`) with an important difference.  The+-- comparison function `eq` returns the type type `Result` instead of+-- `Bool` and it is timing safe. The `Eq` instance is then defined by+-- making use of the operator (`===`). Thus a user of the library can+-- stick to the familiar `Eq` class and get the benefits of timing+-- safe comparison+--+-- == Building timing safe equality for Custom types.+--+-- For basic types like `Word32`, `Word64` this module defines+-- instances of `Equality`. The `Tuple` type inherits the `Equality`+-- instance from its base type. As a developer, new crypto-primitives+-- or protocols often need to define timing safe equality for types+-- other than those exported here. This is done in two stages.+-- -- 1. Define an instance of `Equality`. -- -- 2. Make use of the above instance to define `Eq` instance as follows.@@ -112,6 +70,82 @@ -- > instance Eq SomeSensitiveType where -- >      (==) a b = a === b --+-- === Combining multiple comparisons using Monoid operations+--+-- The `Result` type is an opaque type and does not allow inspection+-- via a pattern match or conversion to `Bool`. However, while+-- defining the `Equality` instance, we often need to perform an AND+-- of multiple comparison (think of comparing a tuple). This is where+-- the monoid instance of `Result` is useful. If @r1@ and @r2@ are the+-- results of two comparisons then @r1 `mappend` r2@ essentially takes+-- the AND of these results. However, unlike in the case of AND-ing in+-- `Bool`, `mappend` on the `Result` type does not short-circuit.  In+-- fact, the whole point of using `Result` type instead of `Bool` is+-- to avoid this short circuiting.+--+-- To illustrate, we have the following code fragment+--+-- > data Foo = Foo Word32 Word64+-- >+-- > instance Equality Foo where+-- >    eq (Foo a b) (Foo c d) = eq a c `mapped` eq b d+-- >+-- > instance Eq Foo where+-- >    (=) = (===)+--+-- == Automatic deriving of `Equality` instances.+--+-- We often find ourselves wrapping existing types in new types+-- keeping in line with the philosophy of distinguishing sematically+-- distinct data with their types. It would be tedious to repeat the+-- above process for each such type. Often, we can get away by just+-- deriving these instances thereby saving a lot of boilerplate. For+-- example, consider a data type that needs to keep a 128-byte+-- secret. A simple deriving class would work in such cases.+--+-- >+-- > newtype Secret = Secret (Tuple 128 Word8) deriving (Equality, Eq)+-- >+--+-- The `Eq` instance here would be timing safe because it is+-- essentially the `Eq` instance of tuples. The deriving `Equality` is+-- not strictly required here. However, we suggest keeping it so that+-- on can define timing safe equality for other types that contain a+-- component of type `Secret`.+--+-- === Beware: deriving clause can be dangerous+--+-- The deriving clause that we defined above while convenient, hides a+-- danger when not used properly. For example, consider the following+-- definitions.+--+-- > data    Bad      = Bad Bar Biz deriving Eq+-- > newtype BadAgain = BadAgain (Bar, Biz) deriving (Eq, Equality)+-- >+--+-- The comparison for the elements of the type `Bad` would leak some+-- timing information /even/ when `Bar` and `Biz` are instances of+-- `Equality` and thus have timing safe equalities themselves. This is+-- because the automatic derivation of `Eq` instances in the above two+-- cases performs a component by component comparison and combines the+-- result using @`and`@. Due to boolean short circuiting, this+-- will lead to timing information being leaked.+--+-- For product types, we can safely derive the `Equality` instance and use+-- it to define the @Eq@ instance as follows+--+-- >+-- > newtype Okey2 = Okey (Foo, Bar) deriving Equality+-- >+-- > instance Eq Okey2 where+-- >    (=) = (===)+-- >+--+--++++-- | All types that support timing safe equality are instances of this class. class Equality a where   eq :: a -> a -> Result @@ -223,32 +257,73 @@                                                      eq a7 b7  --- | Timing independent equality checks for vector of values. /Do not/--- use this to check the equality of two general vectors in a timing--- independent manner (use `eqVector` instead) because:------ 1. They do not work for vectors of unequal lengths,------ 2. They do not work for empty vectors.------ The use case is for defining equality of data types which have--- fixed size vector quantities in it. Like for example------ > import Data.Vector.Unboxed--- > newtype Sha1 = Sha1 (Vector (BE Word32))--- >--- > instance Eq Sha1 where--- >    (==) (Sha1 g) (Sha1 h) = oftenCorrectEqVector g h--- >---+-- | The result of a comparison. This is an opaque type and the monoid instance essentially takes+-- AND of two comparisons in a timing safe way.+newtype Result =  Result { unResult :: Word } +instance Monoid Result where+  mempty      = Result 0+  mappend a b = Result (unResult a .|. unResult b)+  {-# INLINE mempty  #-}+  {-# INLINE mappend #-} -oftenCorrectEqVector :: (G.Vector v a, Equality a, G.Vector v Result) => v a -> v a -> Bool-oftenCorrectEqVector v1 v2 =  isSuccessful $ G.foldl1' mappend $ G.zipWith eq v1 v2+-- | Checks whether a given equality comparison is successful.+isSuccessful :: Result -> Bool+{-# INLINE isSuccessful #-}+isSuccessful = (==0) . unResult --- | Timing independent equality checks for vectors. If you know that--- the vectors are not empty and of equal length, you may use the--- slightly faster `oftenCorrectEqVector`-eqVector :: (G.Vector v a, Equality a, G.Vector v Result) => v a -> v a -> Bool-eqVector v1 v2 | G.length v1 == G.length v2 = isSuccessful $ G.foldl' mappend (Result 0) $ G.zipWith eq v1 v2-               | otherwise                  = False+-- | MVector for Results.+newtype instance MVector s Result = MV_Result (MVector s Word)+-- | Vector of Results.+newtype instance Vector    Result = V_Result  (Vector Word)++instance Unbox Result++instance GM.MVector MVector Result where+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicOverlaps #-}+  {-# INLINE basicUnsafeNew #-}+  {-# INLINE basicUnsafeReplicate #-}+  {-# INLINE basicUnsafeRead #-}+  {-# INLINE basicUnsafeWrite #-}+  {-# INLINE basicClear #-}+  {-# INLINE basicSet #-}+  {-# INLINE basicUnsafeCopy #-}+  {-# INLINE basicUnsafeGrow #-}+  basicLength          (MV_Result v)            = GM.basicLength v+  basicUnsafeSlice i n (MV_Result v)            = MV_Result $ GM.basicUnsafeSlice i n v+  basicOverlaps (MV_Result v1) (MV_Result v2)   = GM.basicOverlaps v1 v2++  basicUnsafeRead  (MV_Result v) i              = Result `liftM` GM.basicUnsafeRead v i+  basicUnsafeWrite (MV_Result v) i (Result x)   = GM.basicUnsafeWrite v i x++  basicClear (MV_Result v)                      = GM.basicClear v+  basicSet   (MV_Result v)         (Result x)   = GM.basicSet v x++  basicUnsafeNew n                              = MV_Result `liftM` GM.basicUnsafeNew n+  basicUnsafeReplicate n     (Result x)         = MV_Result `liftM` GM.basicUnsafeReplicate n x+  basicUnsafeCopy (MV_Result v1) (MV_Result v2) = GM.basicUnsafeCopy v1 v2+  basicUnsafeGrow (MV_Result v)   n             = MV_Result `liftM` GM.basicUnsafeGrow v n++#if MIN_VERSION_vector(0,11,0)+  basicInitialize (MV_Result v)               = GM.basicInitialize v+#endif++++instance G.Vector Vector Result where+  {-# INLINE basicUnsafeFreeze #-}+  {-# INLINE basicUnsafeThaw #-}+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicUnsafeIndexM #-}+  {-# INLINE elemseq #-}+  basicUnsafeFreeze (MV_Result v)             = V_Result  `liftM` G.basicUnsafeFreeze v+  basicUnsafeThaw (V_Result v)                = MV_Result `liftM` G.basicUnsafeThaw v+  basicLength (V_Result v)                    = G.basicLength v+  basicUnsafeSlice i n (V_Result v)           = V_Result $ G.basicUnsafeSlice i n v+  basicUnsafeIndexM (V_Result v) i            = Result   `liftM`  G.basicUnsafeIndexM v i++  basicUnsafeCopy (MV_Result mv) (V_Result v) = G.basicUnsafeCopy mv v+  elemseq _ (Result x)                        = G.elemseq (undefined :: Vector a) x

@@ -4,39 +4,70 @@ {-# LANGUAGE ForeignFunctionInterface   #-} {-# LANGUAGE CPP                        #-} +-- | This module exposes types that builds in type safety into some of+-- the low level pointer operations. The functions here are pretty low+-- level and will be required only by developers of the library that+-- to the core of the library. module Raaz.Core.Types.Pointer-       ( -- ** The pointer type.+       ( -- * Pointers, offsets, and alignment          Pointer          -- ** Type safe length units.-       , LengthUnit(..), movePtr-       , BYTES(..), BITS(..),  ALIGN, Align, inBits-         -- ** Some length arithmetic+       , LengthUnit(..)+       , BYTES(..), BITS(..), inBits+       , sizeOf+         -- *** Some length arithmetic        , bitsQuotRem, bytesQuotRem        , bitsQuot, bytesQuot-       , atLeast, atMost-         -- * Helper function that uses generalised length units.-       , allocaBuffer, allocaSecure, mallocBuffer-       , hFillBuf, byteSize+       , atLeast, atLeastAligned, atMost+         -- ** Types measuring alignment+       , Alignment, wordAlignment+       , ALIGN+       , alignment, alignPtr, movePtr, alignedSizeOf, nextAlignedPtr, peekAligned, pokeAligned+         -- ** Allocation functions.+       , allocaAligned, allocaSecureAligned, allocaBuffer, allocaSecure, mallocBuffer+         -- ** Some buffer operations        , memset, memmove, memcpy+       , hFillBuf        ) where  -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative   ( (<$>)   )-#endif -import Control.Exception     ( bracket_)-import Control.Monad         ( void, when )-import Data.Monoid-import Data.Word-import Foreign.Marshal.Alloc-import Foreign.Ptr           ( Ptr, plusPtr)-import Foreign.Storable      (Storable, sizeOf, alignment)-import System.IO             (hGetBuf, Handle)+import           Control.Applicative+import           Control.Exception     ( bracket_)+import           Control.Monad         ( void, when )+import           Control.Monad.IO.Class+import           Data.Monoid+import           Data.Word+import           Foreign.Marshal.Alloc+import           Foreign.Ptr           ( Ptr         )+import qualified Foreign.Ptr           as FP+import           Foreign.Storable      ( Storable, peek, poke )+import qualified Foreign.Storable      as FS+import           System.IO             (hGetBuf, Handle) +import Prelude -- To stop the annoying warnings of Applicatives and Monoids.+ import Raaz.Core.MonoidalAction import Raaz.Core.Types.Equality+import Raaz.Core.Types.Copying +-- $basics$+--+-- The main concepts introduced here are the following+--+-- [`Pointer`:] The generic pointer type that is used through the+-- library.+--+-- [`LengthUnit`:] This class captures types units of length.+--+-- [`Alignment`:] A dedicated type that is used to keep track of+-- alignment constraints.  offsets in We have the generic pointer type+-- `Pointer` and distinguish between different length units at the+-- type level. This helps in to avoid a lot of length conversion+-- errors.+++ -- Developers notes: I assumes that word alignment is alignment -- safe. If this is not the case one needs to fix this to avoid -- performance degradation or worse incorrect load/store.@@ -51,11 +82,24 @@   -- | In cryptographic settings, we need to measure pointer offsets and--- buffer sizes in different units. To avoid errors due to unit+-- buffer sizes. The smallest of length/offset that we have is bytes+-- measured using the type `BYTES`. In various other circumstances, it+-- would be more natural to measure these in multiples of bytes. For+-- example, when allocating buffer to use encrypt using a block cipher+-- it makes sense to measure the buffer size in multiples of block of+-- the cipher. Explicit conversion between these length units, while+-- allocating or moving pointers, involves a lot of low level scaling+-- that is also error prone. To avoid these errors due to unit -- conversions, we distinguish between different length units at the--- type level. This type class capturing such types, i.e. types that--- stand of length units.-class (Num u, Enum u) => LengthUnit u where+-- type level. This type class capturing all such types, i.e. types+-- that stand of length units. Allocation functions and pointer+-- arithmetic are generalised to these length units.+--+-- All instances of a `LengthUnit` are required to be instances of+-- `Monoid` where the monoid operation gives these types the natural+-- size/offset addition semantics: i.e. shifting a pointer by offset+-- @a `mappend` b@ is same as shifting it by @a@ and then by @b@.+class (Enum u, Monoid u) => LengthUnit u where   -- | Express the length units in bytes.   inBytes :: u -> BYTES Int @@ -71,13 +115,24 @@                  , Real, Num, Storable                  ) -newtype ALIGN    = ALIGN Int+-- | Type safe length unit that measures offsets in multiples of word+-- length. This length unit can be used if one wants to make sure that+-- all offsets are word aligned.+newtype ALIGN    = ALIGN { unALIGN :: Int }                  deriving ( Show, Eq,Ord, Enum, Integral                           , Real, Num, Storable                           ) +instance Num a => Monoid (BYTES a) where+  mempty  = 0+  mappend = (+)++instance Monoid ALIGN where+  mempty  = ALIGN 0+  mappend x y = ALIGN $ unALIGN x + unALIGN y+ instance LengthUnit ALIGN where-  inBytes (ALIGN x) = BYTES $ x * alignment (undefined :: Align)+  inBytes (ALIGN x) = BYTES $ x * FS.alignment (undefined :: Align)   {-# INLINE inBytes #-}  instance LengthUnit (BYTES Int) where@@ -97,9 +152,26 @@         => src         -> dest atLeast src | r == 0    = u-            | otherwise = u + 1+            | otherwise = succ u     where (u , r) = bytesQuotRem $ inBytes src ++-- | Often we want to allocate a buffer of size @l@. We also want to+-- make sure that the buffer starts at an alignment boundary+-- @a@. However, the standard word allocation functions might return a+-- pointer that is not aligned as desired. The @atLeastAligned l a@+-- returns a length @n@ such the length @n@ is big enough to ensure+-- that there is at least @l@ length of valid buffer starting at the+-- next pointer aligned at boundary @a@. If the alignment required in+-- @a@ then allocating @l + a - 1 should do the trick.+atLeastAligned :: LengthUnit l => l -> Alignment -> ALIGN+atLeastAligned l a = n + pad - 1+  where n = atLeast l+        -- Alignment adjusted to word boundary.+        algn = wordAlignment   <> a+        pad  = atLeast $ BYTES  $ unAlignment $ algn++ -- | Express length unit @src@ in terms of length unit @dest@ rounding -- downwards. atMost :: ( LengthUnit src@@ -117,16 +189,16 @@              => BYTES Int              -> (u , BYTES Int) bytesQuotRem bytes = (u , r)-  where divisor = inBytes (1 `asTypeOf` u)-        (q, r)  = bytes `quotRem` divisor-        u       = toEnum $ fromEnum q+  where divisor       = inBytes (toEnum 1 `asTypeOf` u)+        (BYTES q, r)  = bytes `quotRem` divisor+        u             = toEnum q  -- | Function similar to `bytesQuotRem` but returns only the quotient. bytesQuot :: LengthUnit u           => BYTES Int           -> u bytesQuot bytes = u-  where divisor = inBytes (1 `asTypeOf` u)+  where divisor = inBytes (toEnum 1 `asTypeOf` u)         q       = bytes `quot` divisor         u       = toEnum $ fromEnum q @@ -136,7 +208,7 @@             => BITS Word64             -> (u , BITS Word64) bitsQuotRem bits = (u , r)-  where divisor = inBits (1 `asTypeOf` u)+  where divisor = inBits (toEnum 1 `asTypeOf` u)         (q, r)  = bits `quotRem` divisor         u       = toEnum $ fromEnum q @@ -145,49 +217,90 @@          => BITS Word64          -> u bitsQuot bits = u-  where divisor = inBits (1 `asTypeOf` u)+  where divisor = inBits (toEnum 1 `asTypeOf` u)         q       = bits `quot` divisor         u       = toEnum $ fromEnum q  -- | The most interesting monoidal action for us.-instance LengthUnit u => LAction (Sum u) Pointer where-  a <.> ptr  = plusPtr ptr offset-    where BYTES offset = inBytes $ getSum a+instance LengthUnit u => LAction u Pointer where+  a <.> ptr  = movePtr ptr a   {-# INLINE (<.>) #-} -movePtr :: LengthUnit u => Pointer -> u -> Pointer-movePtr ptr u = Sum u <.> ptr-{-# INLINE movePtr #-}+------------------------ Alignment -------------------------------- --------------------------------------------------------------------+-- | Types to measure alignment in units of bytes.+newtype Alignment = Alignment { unAlignment :: Int }+        deriving ( Show, Eq, Ord, Enum, Integral+                 , Real, Num+                 ) +-- | The default alignment to use is word boundary.+wordAlignment :: Alignment+wordAlignment = alignment (undefined :: Align) --------------------- Sizes, offsets and pointer arithmetic -------+instance Monoid Alignment where+  mempty  = Alignment 1+  mappend = lcm --- | Similar to `sizeOf` but returns the length in type safe units.-byteSize :: Storable a => a -> BYTES Int-{-# INLINE byteSize #-}-byteSize = BYTES . sizeOf +---------- Type safe versions of some pointer functions ----------------- ------------------------- Allocation --------------------------------+-- | Compute the size of a storable element.+sizeOf :: Storable a => a -> BYTES Int+sizeOf = BYTES . FS.sizeOf --- | The expression @allocaBuffer l action@ allocates a local buffer--- of length @l@ and passes it on to the IO action @action@. No--- explicit freeing of the memory is required as the memory is--- allocated locally and freed once the action finishes. It is better--- to use this function than @`allocaBytes`@ as it does type safe--- scaling. This function also ensure that the allocated buffer is--- word aligned.-allocaBuffer :: LengthUnit l-             => l                    -- ^ buffer length-             -> (Pointer -> IO b)  -- ^ the action to run-             -> IO b-{-# INLINE allocaBuffer #-}-allocaBuffer l = allocaBytesAligned bytes align-  where BYTES bytes = inBytes l-        BYTES align = inBytes (1 :: ALIGN)+-- | Size of the buffer to be allocated to store an element of type+-- @a@ so as to guarantee that there exist enough space to store the+-- element after aligning the pointer. If the size of the element is+-- @s@ and its alignment is @a@ then this quantity is essentially+-- equal to @s + a - 1@. All units measured in word alignment.+alignedSizeOf  :: Storable a => a -> ALIGN+alignedSizeOf a =  atLeastAligned (sizeOf a) $ alignment a +-- | Compute the alignment for a storable object.+alignment :: Storable a => a -> Alignment+alignment =  Alignment . FS.alignment++-- | Align a pointer to the appropriate alignment.+alignPtr :: Ptr a -> Alignment -> Ptr a+alignPtr ptr = FP.alignPtr ptr . unAlignment++-- | Move the given pointer with a specific offset.+movePtr :: LengthUnit l => Ptr a -> l -> Ptr a+movePtr ptr l = FP.plusPtr ptr offset+  where BYTES offset = inBytes l++-- | Compute the next aligned pointer starting from the given pointer+-- location.+nextAlignedPtr :: Storable a => Ptr a -> Ptr a+nextAlignedPtr ptr = alignPtr ptr $ alignment $ elementOfPtr ptr+  where elementOfPtr :: Ptr b -> b+        elementOfPtr _ = undefined++-- | Peek the element from the next aligned location.+peekAligned :: Storable a => Ptr a -> IO a+peekAligned = peek . nextAlignedPtr++-- | Poke the element from the next aligned location.+pokeAligned     :: Storable a => Ptr a -> a -> IO ()+pokeAligned ptr =  poke $ nextAlignedPtr ptr++-- | The expression @allocaAligned a l action@ allocates a local+-- buffer of length @l@ and alignment @a@ and passes it on to the IO+-- action @action@. No explicit freeing of the memory is required as+-- the memory is allocated locally and freed once the action+-- finishes. It is better to use this function than+-- @`allocaBytesAligned`@ as it does type safe scaling and alignment.+allocaAligned :: LengthUnit l+              => Alignment          -- ^ the alignment of the buffer+              -> l                  -- ^ size of the buffer+              -> (Pointer -> IO b)  -- ^ the action to run+              -> IO b+allocaAligned algn l = allocaBytesAligned b a+  where BYTES     b = inBytes l+        Alignment a = algn++ -- | This function allocates a chunk of "secure" memory of a given -- size and runs the action. The memory (1) exists for the duration of -- the action (2) will not be swapped during that time and (3) will be@@ -203,35 +316,50 @@ -- -- TODO: File this insecurity in the wiki. ---allocaSecure :: LengthUnit l-              => l-              -> (Pointer -> IO a)-              -> IO a+allocaSecureAligned :: LengthUnit l+                    => Alignment+                    -> l+                    -> (Pointer -> IO a)+                    -> IO a  #ifdef HAVE_MLOCK  foreign import ccall unsafe "sys/mman.h mlock"-  c_mlock :: Pointer -> Int -> IO Int+  c_mlock :: Pointer -> BYTES Int -> IO Int   foreign import ccall unsafe "sys/mman.h munlock"-  c_munlock :: Pointer -> Int -> IO ()+  c_munlock :: Pointer -> BYTES Int -> IO () -allocaSecure l action = allocaBuffer actualSz actualAction-  where actualSz = atLeast l :: ALIGN-        BYTES sz = inBytes actualSz+allocaSecureAligned a l action = allocaAligned a l actualAction+  where sz = inBytes l         actualAction cptr = let           lockIt    = do c <- c_mlock cptr sz                          when (c /= 0) $ fail "secure memory: unable to lock memory"-          releaseIt =  memset cptr 0 actualSz >>  c_munlock cptr sz+          releaseIt =  memset cptr 0 l >>  c_munlock cptr sz           in bracket_ lockIt releaseIt $ action cptr  #else--allocaSecure _ _ = fail "memory locking not supported on this platform"+allocaSecureAligned _ _ = fail "memory locking not supported on this platform"  #endif+-- | A less general version of `allocaAligned` where the pointer passed+-- is aligned to word boundary.+allocaBuffer :: LengthUnit l+             => l                  -- ^ buffer length+             -> (Pointer -> IO b)  -- ^ the action to run+             -> IO b+{-# INLINE allocaBuffer #-}+allocaBuffer = allocaAligned wordAlignment +-- | A less general version of `allocaSecureAligned` where the pointer passed+-- is aligned to word boundary+allocaSecure :: LengthUnit l+             => l+             -> (Pointer -> IO b)+             -> IO b+allocaSecure = allocaSecureAligned wordAlignment+ -- | Creates a memory of given size. It is better to use over -- @`mallocBytes`@ as it uses typesafe length. mallocBuffer :: LengthUnit l@@ -258,38 +386,38 @@  -- | Some common PTR functions abstracted over type safe length. foreign import ccall unsafe "string.h memcpy" c_memcpy-    :: Pointer -> Pointer -> BYTES Int -> IO Pointer+    :: Dest Pointer -> Src Pointer -> BYTES Int -> IO Pointer  -- | Copy between pointers.-memcpy :: LengthUnit l-       => Pointer -- ^ Dest-       -> Pointer -- ^ Src-       -> l         -- ^ Number of Bytes to copy-       -> IO ()-memcpy p q = void . c_memcpy p q . inBytes+memcpy :: (MonadIO m, LengthUnit l)+       => Dest Pointer -- ^ destination+       -> Src  Pointer -- ^ src+       -> l            -- ^ Number of Bytes to copy+       -> m ()+memcpy dest src = liftIO . void . c_memcpy dest src . inBytes -{-# SPECIALIZE memcpy :: Pointer -> Pointer -> BYTES Int -> IO () #-}+{-# SPECIALIZE memcpy :: Dest Pointer -> Src Pointer -> BYTES Int -> IO () #-}  foreign import ccall unsafe "string.h memmove" c_memmove-    :: Pointer -> Pointer -> BYTES Int -> IO Pointer+    :: Dest Pointer -> Src Pointer -> BYTES Int -> IO Pointer  -- | Move between pointers.-memmove :: LengthUnit l-        => Pointer -- ^ Dest-        -> Pointer -- ^ Src-        -> l         -- ^ Number of Bytes to copy-        -> IO ()-memmove p q = void . c_memmove p q . inBytes-{-# SPECIALIZE memmove :: Pointer -> Pointer -> BYTES Int -> IO () #-}+memmove :: (MonadIO m, LengthUnit l)+        => Dest Pointer -- ^ destination+        -> Src Pointer  -- ^ source+        -> l            -- ^ Number of Bytes to copy+        -> m ()+memmove dest src = liftIO . void . c_memmove dest src . inBytes+{-# SPECIALIZE memmove :: Dest Pointer -> Src Pointer -> BYTES Int -> IO () #-}  foreign import ccall unsafe "string.h memset" c_memset     :: Pointer -> Word8 -> BYTES Int -> IO Pointer  -- | Sets the given number of Bytes to the specified value.-memset :: LengthUnit l+memset :: (MonadIO m, LengthUnit l)        => Pointer -- ^ Target        -> Word8     -- ^ Value byte to set        -> l         -- ^ Number of bytes to set-       -> IO ()-memset p w = void . c_memset p w . inBytes+       -> m ()+memset p w = liftIO . void . c_memset p w . inBytes {-# SPECIALIZE memset :: Pointer -> Word8 -> BYTES Int -> IO () #-}

@@ -1,5 +1,6 @@ {-# LANGUAGE CPP                   #-} {-# LANGUAGE DataKinds             #-}+{-# LANGUAGE ConstraintKinds      #-} {-# LANGUAGE KindSignatures        #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances     #-}@@ -10,7 +11,8 @@  module Raaz.Core.Types.Tuple        ( -- * Length encoded tuples-         Tuple, dimension, initial+         Tuple, Dimension, dimension, initial, diagonal+       , repeatM          -- ** Unsafe operations        , unsafeFromList        ) where@@ -25,18 +27,18 @@  import qualified Data.Vector.Unboxed as V import           GHC.TypeLits-import           Foreign.Ptr                 ( castPtr      )+import           Foreign.Ptr                 ( castPtr, Ptr ) import           Foreign.Storable            ( Storable(..) ) import           Prelude hiding              ( length       )   import Raaz.Core.Types.Equality import Raaz.Core.Types.Endian-import Raaz.Core.Write+import Raaz.Core.Transfer import Raaz.Core.Parse.Applicative  -- | Tuples that encode their length in their types. For tuples, we call--- the length its dimension+-- the length its dimension. newtype Tuple (dim :: Nat) a = Tuple { unTuple :: V.Vector a }                              deriving Show @@ -55,50 +57,50 @@ -- | Function that returns the dimension of the tuple. The dimension -- is calculated without inspecting the tuple and hence the term -- @`dimension` (undefined :: Tuple 5 Int)@ will evaluate to 5.-#if !MIN_VERSION_base(4,7,0)-dimension  :: (V.Unbox a, SingI dim) => Tuple dim a -> Int-dimensionP :: (SingI dim, V.Unbox a)-           => Sing dim-           -> Tuple dim a-           -> Int-dimension       = withSing dimensionP-dimensionP sz _ = fromEnum $ fromSing sz-#else-dimension  :: (V.Unbox a, KnownNat dim) => Tuple dim a -> Int-dimensionP :: (KnownNat dim, V.Unbox a)+#if MIN_VERSION_base(4,7,0)++-- | The constaint on the dimension of the tuple (since base 4.7.0)+type Dimension (dim :: Nat) = KnownNat dim++-- | This combinator returns the dimension of the tuple.+dimension  :: Dimension dim => Tuple dim a -> Int+dimensionP :: Dimension dim            => Proxy dim            -> Tuple dim a            -> Int dimensionP sz _ = fromEnum $ natVal sz dimension = dimensionP Proxy++#else++-- | The constaint on the dimension of the tuple (pre base 4.7.0)+type Dimension (dim :: Nat) = SingI dim++-- | This combinator returns the dimension of the tuple.+dimension  :: (V.Unbox a, Dimension  dim) => Tuple dim a -> Int+dimensionP :: (Dimension dim, V.Unbox a)+           => Sing dim+           -> Tuple dim a+           -> Int+dimension       = withSing dimensionP+dimensionP sz _ = fromEnum $ fromSing sz+ #endif  -- | Get the dimension to parser-#if !MIN_VERSION_base(4,7,0)-getParseDimension :: (V.Unbox a, SingI dim)+getParseDimension :: (V.Unbox a, Dimension dim)                   => Parser (Tuple dim a) -> Int-getTupFromP       :: (V.Unbox a, SingI dim)+getTupFromP       :: (V.Unbox a, Dimension dim)                   => Parser (Tuple dim a) -> Tuple dim a-#else-getParseDimension :: (V.Unbox a, KnownNat dim)-                  => Parser (Tuple dim a)-                  -> Int-getTupFromP   :: (V.Unbox a, KnownNat dim)-              => Parser (Tuple dim a)-              -> Tuple dim a-#endif  getParseDimension = dimension . getTupFromP getTupFromP _     = undefined  -#if !MIN_VERSION_base(4,7,0)-instance (V.Unbox a, Storable a, SingI dim)-         => Storable (Tuple dim a) where-#else-instance (V.Unbox a, Storable a, KnownNat dim)++instance (V.Unbox a, Storable a, Dimension dim)          => Storable (Tuple dim a) where-#endif+   sizeOf tup = dimension tup * sizeOf (getA tup)   alignment  = alignment . getA @@ -109,28 +111,39 @@   poke ptr tup = unsafeWrite writeTup cptr     where writeTup = writeStorableVector $ unTuple tup           cptr     = castPtr ptr-#if !MIN_VERSION_base(4,7,0)-instance (V.Unbox a, EndianStore a, SingI dim)-         => EndianStore (Tuple dim a) where-#else-instance (V.Unbox a, EndianStore a, KnownNat dim)+++instance (V.Unbox a, EndianStore a, Dimension dim)          => EndianStore (Tuple dim a) where-#endif-  load = unsafeRunParser $ tupParser-    where tupParser = Tuple <$> unsafeParseVector len-          len       = getParseDimension tupParser -  store cptr tup = unsafeWrite writeTup cptr-    where writeTup = writeVector $ unTuple tup+  load = unsafeRunParser tupParser . castPtr+     where tupParser = Tuple <$> unsafeParseVector len+           len       = getParseDimension tupParser +  store ptr tup = unsafeWrite writeTup cptr+     where writeTup = writeVector $ unTuple tup+           cptr     = castPtr ptr++  adjustEndian ptr n = adjustEndian (unTupPtr ptr) $ nos ptr undefined+       where nos     :: Ptr (Tuple dim a) -> Tuple dim a -> Int+             nos _ w = dimension w * n+             unTupPtr   :: Ptr (Tuple dim a) -> Ptr a+             unTupPtr   = castPtr+++-- | Construct a tuple by repeating a monadic action.+repeatM :: (Functor m, Monad m, V.Unbox a, Dimension dim) => m a -> m (Tuple dim a)+repeatM action = result+  where result = Tuple <$> V.replicateM sz action+        sz     = dimension $ getTup result+        getTup :: (Monad m, Dimension n)=> m (Tuple n a) -> Tuple n a+        getTup _ = undefined+ -- | Construct a tuple out of the list. This function is unsafe and -- will result in run time error if the list is not of the correct -- dimension.-#if !MIN_VERSION_base(4,7,0)-unsafeFromList :: (V.Unbox a, SingI dim) => [a] -> Tuple dim a-#else-unsafeFromList :: (V.Unbox a, KnownNat dim) => [a] -> Tuple dim a-#endif++unsafeFromList :: (V.Unbox a, Dimension dim) => [a] -> Tuple dim a unsafeFromList xs   | dimension tup == L.length xs = tup   | otherwise                    = wrongLengthMesg@@ -139,14 +152,15 @@  -- | Computes the initial fragment of a tuple. No length needs to be given -- as it is infered from the types.-#if !MIN_VERSION_base(4,7,0)-initial :: (V.Unbox a, SingI dim0, SingI dim1)-         => Tuple dim1 a-         -> Tuple dim0 a-#else-initial :: (V.Unbox a, KnownNat dim0, KnownNat dim1)+initial ::  (V.Unbox a, Dimension dim0)          => Tuple dim1 a          -> Tuple dim0 a-#endif initial tup = tup0   where tup0 = Tuple $ V.take (dimension tup0) $ unTuple tup++-- TODO: Put a constraint that dim0 <= dim1++-- | The @diagonal a@ gives a tuple, all of whose entries is @a@.+diagonal :: (V.Unbox a, Dimension dim) => a -> Tuple dim a+diagonal a = tup+  where tup = Tuple $ V.replicate (dimension tup) a

@@ -8,7 +8,7 @@ module Raaz.Core.Util.ByteString        ( length, replicate        , fromByteStringStorable-       , createFrom+       , create, createFrom        , withByteString        , unsafeCopyToPointer        , unsafeNCopyToPointer@@ -17,9 +17,7 @@ import           Prelude            hiding (length, replicate) import qualified Data.ByteString    as B import           Data.ByteString    (ByteString)-import           Data.ByteString.Internal( toForeignPtr-                                         , create-                                         )+import qualified Data.ByteString.Internal as BI import           Data.Word import           Foreign.ForeignPtr (withForeignPtr) import           Foreign.Ptr        (castPtr, plusPtr)@@ -28,6 +26,7 @@ import           System.IO.Unsafe   (unsafePerformIO)  import           Raaz.Core.Types.Pointer+import           Raaz.Core.Types.Copying  -- | A typesafe length for Bytestring length :: ByteString -> BYTES Int@@ -42,12 +41,12 @@ -- undefined behaviour if the crypto pointer points to an area smaller -- than the size of the byte string. unsafeCopyToPointer :: ByteString   -- ^ The source.-                      -> Pointer    -- ^ The destination.-                      -> IO ()+                    -> Pointer      -- ^ The destination.+                    -> IO () unsafeCopyToPointer bs cptr =  withForeignPtr fptr $-           \ p -> memcpy dest (p `plusPtr` offset) (BYTES n)-    where (fptr, offset,n) = toForeignPtr bs-          dest = castPtr cptr+           \ p -> memcpy dptr (source $ p `plusPtr` offset) (BYTES n)+    where (fptr, offset,n) = BI.toForeignPtr bs+          dptr = destination $ castPtr cptr   -- | Similar to `unsafeCopyToPointer` but takes an additional input@@ -58,29 +57,35 @@ unsafeNCopyToPointer :: LengthUnit n                        => n              -- ^ length of data to be copied                        -> ByteString     -- ^ The source byte string-                       -> Pointer      -- ^ The buffer+                       -> Pointer        -- ^ The buffer                        -> IO () unsafeNCopyToPointer n bs cptr = withForeignPtr fptr $-           \ p -> memcpy dest (p `plusPtr` offset) n-    where (fptr, offset,_) = toForeignPtr bs-          dest    = castPtr cptr+           \ p -> memcpy dptr (source $ p `plusPtr` offset) n+    where (fptr, offset,_) = BI.toForeignPtr bs+          dptr             = destination $ castPtr cptr  -- | Works directly on the pointer associated with the -- `ByteString`. This function should only read and not modify the -- contents of the pointer. withByteString :: ByteString -> (Pointer -> IO a) -> IO a withByteString bs f = withForeignPtr fptr (f . flip plusPtr off . castPtr)-  where (fptr, off, _) = toForeignPtr bs+  where (fptr, off, _) = BI.toForeignPtr bs  -- | Get the value from the bytestring using `peek`. fromByteStringStorable :: Storable k => ByteString -> k-fromByteStringStorable src = unsafePerformIO $ withByteString src (peek . castPtr)+fromByteStringStorable str = unsafePerformIO $ withByteString str (peek . castPtr) ++-- | The action @create l act@ creates a length @l@ bytestring where+-- the contents are filled using the the @act@ to fill the buffer.+create :: LengthUnit l => l -> (Pointer -> IO ()) -> IO ByteString+create l act = myCreate (act . castPtr)+  where myCreate =  BI.create $ fromIntegral $ inBytes l+ -- | The IO action @createFrom n cptr@ creates a bytestring by copying -- @n@ bytes from the pointer @cptr@. createFrom :: LengthUnit l => l -> Pointer -> IO ByteString-createFrom l cptr = create bytes filler-  where filler dest = memcpy (castPtr dest) cptr l-        BYTES bytes = inBytes l+createFrom l cptr = create l filler+  where filler dptr = memcpy (destination $ castPtr dptr) (source cptr) l  ----------------------  Hexadecimal encoding. -----------------------------------

@@ -1,147 +0,0 @@--- | Module to write stuff to buffers. As opposed to similar functions--- exposed in "Raaz.Core.Write.Unsafe", the writes exposed here are--- safe as necessary range checks are done on the buffer before--- writing stuff to it.--{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE TypeSynonymInstances       #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE MultiParamTypeClasses      #-}--module Raaz.Core.Write-       ( Write, bytesToWrite, unsafeWrite-       , write, writeStorable, writeVector, writeStorableVector-       , writeBytes, writeByteString, skipWrite-       ) where--import           Data.ByteString           (ByteString)-import           Data.String-import           Data.ByteString.Internal  (unsafeCreate)-import           Data.Monoid-import qualified Data.Vector.Generic       as G-import           Data.Word                 (Word8)-import           Foreign.Ptr               (castPtr)-import           Foreign.Storable--import           Raaz.Core.MonoidalAction-import           Raaz.Core.Types.Endian-import           Raaz.Core.Types.Pointer-import           Raaz.Core.Util.ByteString as BU-import           Raaz.Core.Encode---- | The monoid for write.-newtype WriteM = WriteM { unWriteM :: IO () }--instance Monoid WriteM where-  mempty        = WriteM $ return ()-  {-# INLINE mempty #-}--  mappend wa wb = WriteM $ unWriteM wa >> unWriteM wb-  {-# INLINE mappend #-}--  mconcat = WriteM . mapM_ unWriteM-  {-# INLINE mconcat #-}---- | A write action is nothing but an IO action that returns () on--- input a pointer.-type WriteAction = Pointer -> WriteM--type BytesMonoid = Sum (BYTES Int)--instance LAction BytesMonoid WriteAction where-  m <.> action = action . (m<.>)-  {-# INLINE (<.>) #-}--instance Distributive BytesMonoid WriteAction---- | A write is an action which when executed using `runWrite` writes--- bytes to the input buffer. It is similar to the `WU.Write` type--- exposed from the "Raaz.Write.Unsafe" module except that it keeps--- track of the total bytes that would be written to the buffer if the--- action is run. The `runWrite` action will raise an error if the--- buffer it is provided with is of size smaller. `Write`s are monoid--- and hence can be concatnated using the `<>` operator.-type Write = SemiR WriteAction BytesMonoid---- | Create a write action.-makeWrite :: LengthUnit u => u -> (Pointer -> IO ()) -> Write-{-# INLINE makeWrite #-}-makeWrite sz action = SemiR (WriteM . action) $ Sum (inBytes sz)---- | Returns the bytes that will be written when the write action is performed.-bytesToWrite :: Write -> BYTES Int-bytesToWrite = getSum . semiRMonoid---- | Perform the write action without any checks.-unsafeWrite :: Write -> Pointer -> IO ()-unsafeWrite wr =  unWriteM . semiRSpace wr--{---- | The function tries to write the given `Write` action on the--- buffer and returns `True` if successful.-tryWriting :: Write         -- ^ The write action.-           -> CryptoBuffer  -- ^ The buffer to which the bytes are to-                            -- be written.-           -> IO Bool-tryWriting wr cbuf = withCryptoBuffer cbuf $ \ sz cptr ->-  if sz < bytesToWrite wr then return False-  else do unsafeWrite wr cptr; return True---}---- | The expression @`writeStorable` a@ gives a write action that--- stores a value @a@ in machine endian. The type of the value @a@ has--- to be an instance of `Storable`. This should be used when we want--- to talk with C functions and not when talking to the outside world--- (otherwise this could lead to endian confusion). To take care of--- endianness use the `write` combinator.-writeStorable :: Storable a => a -> Write-writeStorable a = makeWrite (byteSize a) pokeIt-  where pokeIt = flip poke a . castPtr--- | The expression @`write` a@ gives a write action that stores a--- value @a@. One needs the type of the value @a@ to be an instance of--- `EndianStore`. Proper endian conversion is done irrespective of--- what the machine endianness is. The man use of this write is to--- serialize data for the consumption of the outside world.-write :: EndianStore a => a -> Write-write a = makeWrite (byteSize a) $ flip store a---- | The vector version of `writeStorable`.-writeStorableVector :: (Storable a, G.Vector v a) => v a -> Write-{-# INLINE writeStorableVector #-}-writeStorableVector = G.foldl' foldFunc mempty-  where foldFunc w a =  w <> writeStorable a---- | The vector version of `write`.-writeVector :: (EndianStore a, G.Vector v a) => v a -> Write-{-# INLINE writeVector #-}-writeVector = G.foldl' foldFunc mempty-  where foldFunc w a =  w <> write a---- | The combinator @writeBytes n b@ writes @b@ as the next @n@--- consecutive bytes.-writeBytes :: LengthUnit n => Word8 -> n -> Write-writeBytes w8 n = makeWrite n memsetIt-  where memsetIt cptr = memset cptr w8 n---- | Writes a strict bytestring.-writeByteString :: ByteString -> Write-writeByteString bs = makeWrite (BU.length bs) $  BU.unsafeCopyToPointer bs---- | A write action that just skips over the given bytes.-skipWrite :: LengthUnit u => u -> Write-skipWrite = flip makeWrite $ const $ return ()--instance IsString Write where-  fromString = writeByteString . fromString--instance Encodable Write where-  {-# INLINE toByteString #-}-  toByteString w  = unsafeCreate n $ unsafeWrite w . castPtr-    where BYTES n = bytesToWrite w--  {-# INLINE unsafeFromByteString #-}-  unsafeFromByteString = writeByteString--  {-# INLINE fromByteString #-}-  fromByteString       = Just . writeByteString

@@ -4,6 +4,7 @@ under the raaz library.  -}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}  module Raaz.Hash        (@@ -18,7 +19,6 @@          -- * Exposing individual hashes.          -- $individualHashes$ -       , module Raaz.Hash.Sha1        , module Raaz.Hash.Sha224        , module Raaz.Hash.Sha256        , module Raaz.Hash.Sha384@@ -28,7 +28,6 @@        ) where  -- import Raaz.Hash.Blake256-import Raaz.Hash.Sha1 import Raaz.Hash.Sha224 import Raaz.Hash.Sha256 import Raaz.Hash.Sha384@@ -39,6 +38,12 @@  -- $computingHash$ --+-- === NOTE: SHA1 is broken.+--+-- SHA1 is no more available form this module, its use is highly+-- depreciated. If you want to use it for transition please import+-- Raaz.Hash.Sha1 specifically+ -- The cryptographic hashes provided by raaz give the following -- guarantees: --

@@ -91,11 +91,15 @@                       -- ^ compress the blocks,   , compressFinal  :: Pointer -> BYTES Int -> MT m ()                       -- ^ pad and process the final bytes,+  , compressStartAlignment :: Alignment   } +instance BlockAlgorithm (HashI h m) where+  bufferStartAlignment = compressStartAlignment+ -- | The constraints that a memory used by a hash implementation -- should satisfy.-type HashM h m = (Initialisable m (), Extractable m h)+type HashM h m = (Initialisable m (), Extractable m h, Primitive h)  -- | Some implementation of a given hash. The existentially -- quantification allows us freedom to choose the best memory type@@ -112,6 +116,8 @@   name         (SomeHashI hI) = name hI   description  (SomeHashI hI) = description hI +instance BlockAlgorithm (SomeHashI h) where+  bufferStartAlignment (SomeHashI imp) = bufferStartAlignment imp  -- | Certain hashes are essentially bit-truncated versions of other -- hashes. For example, SHA224 is obtained from SHA256 by dropping the@@ -125,9 +131,10 @@           , hashIDescription = hashIDescription           , compress         = comp           , compressFinal    = compF+          , compressStartAlignment = compressStartAlignment           }-  where comp  ptr = liftSubMT unMtrunc . compress ptr . coerce-        compF ptr = liftSubMT unMtrunc . compressFinal ptr+  where comp  ptr = onSubMemory unMtrunc . compress ptr . coerce+        compF ptr = onSubMemory unMtrunc . compressFinal ptr  ---------------------- The Hash class --------------------------------- @@ -185,6 +192,17 @@ hash' imp = unsafePerformIO . hashSource' imp {-# INLINEABLE hash' #-} +-- TODO: For bytestrings (strict and lazy) we can do better. We can+-- avoid copying as the bytestring exposes the underlying+-- pointer. However, there is a huge cost if the underlying pointer+-- does not start at the machine alignment boundary. The idea+-- therefore is to process strict bytestring is multiples of blocks+-- directly if the starting pointer is aligned.+--+-- More details in the bug report #256.+--+-- https://github.com/raaz-crypto/raaz/issues/256+--  -- | Similar to hashFile' but the user can specify the implementation -- to use.@@ -205,6 +223,7 @@ hashSource' (SomeHashI impl) src =   insecurely $ initialise () >> completeHashing impl src + -- | Gives a memory action that completes the hashing procedure with -- the rest of the source. Useful to compute the hash of a source with -- some prefix (like in the HMAC procedure).@@ -212,13 +231,14 @@                 => HashI h m                 -> src                 -> MT m h-completeHashing (HashI{..}) src =-  allocate totalSize $ \ ptr -> let+completeHashing imp@(HashI{..}) src =+  allocate $ \ ptr -> let     comp                = compress ptr bufSize     finish bytes        = compressFinal ptr bytes >> extract     in processChunks comp finish src bufSize ptr   where bufSize             = atLeast l1Cache + 1         totalSize           = bufSize + additionalPadBlocks undefined+        allocate            = liftPointerAction $ allocBufferFor (SomeHashI imp) totalSize  ----------------------- Hash memory ---------------------------------- @@ -239,27 +259,27 @@  instance Storable h => Memory (HashMemory h) where -  memoryAlloc   = HashMemory <$> memoryAlloc <*> memoryAlloc+  memoryAlloc     = HashMemory <$> memoryAlloc <*> memoryAlloc -  underlyingPtr = underlyingPtr . hashCell+  unsafeToPointer = unsafeToPointer . hashCell  instance Storable h => Initialisable (HashMemory h) h where   initialise h = do-    liftSubMT hashCell          $ initialise h-    liftSubMT messageLengthCell $ initialise (0 :: BITS Word64)+    onSubMemory hashCell          $ initialise h+    onSubMemory messageLengthCell $ initialise (0 :: BITS Word64)  instance Storable h => Extractable (HashMemory h) h where-  extract = liftSubMT hashCell extract+  extract = onSubMemory hashCell extract  -- | Extract the length of the message hashed so far. extractLength :: MT (HashMemory h) (BITS Word64)-extractLength = liftSubMT messageLengthCell extract+extractLength = onSubMemory messageLengthCell extract {-# INLINE extractLength #-}   -- | Update the message length by a given amount. updateLength :: LengthUnit u => u -> MT (HashMemory h) () {-# INLINE updateLength #-}-updateLength u = liftSubMT messageLengthCell $ modify (nBits +)+updateLength u = onSubMemory messageLengthCell $ modify (nBits +)   where nBits :: BITS Word64         nBits =  inBits u

@@ -26,15 +26,17 @@ import qualified Data.ByteString.Lazy      as L import           Data.Monoid import           Data.String+import           Data.Word import           Foreign.Ptr               ( castPtr      ) import           Foreign.Storable          ( Storable(..) ) import           Prelude                   hiding (length, replicate) import           System.IO import           System.IO.Unsafe     (unsafePerformIO) -import           Raaz.Core+import           Raaz.Core          hiding (alignment) import           Raaz.Core.Parse.Applicative-import           Raaz.Core.Write+import           Raaz.Core.Transfer+import           Raaz.Random  import           Raaz.Hash.Internal @@ -60,7 +62,7 @@    sizeOf    _  = fromIntegral $ blockSize (undefined :: h) -  alignment _  = alignment (undefined :: Align)+  alignment _  = alignment (undefined :: Word8)    peek         = unsafeRunParser (HMACKey <$> parseByteString (blockSize (undefined :: h))) . castPtr @@ -80,11 +82,14 @@         theHash     :: HMACKey h -> h         theHash  _  = undefined +-- The HMACKey is just stored as a binary data. instance (Hash h, Recommendation h) => EndianStore (HMACKey h) where-  store = poke . castPtr-  load  = peek . castPtr+  store            = poke+  load             = peek+  adjustEndian _ _ = return () -instance (Hash h, Recommendation h) => Random (HMACKey h)+instance (Hash h, Recommendation h) => Random (HMACKey h) where+  random = unsafeStorableRandom  instance (Hash h, Recommendation h) => Encodable (HMACKey h) @@ -112,18 +117,8 @@ instance Show h => Show (HMAC h) where   show  = show . unHMAC -instance (Hash h) => Primitive (HMAC h) where -  blockSize _ = blockSize (undefined :: h)--  type Implementation (HMAC h) = Implementation h--instance (Hash h, Recommendation h) => Recommendation (HMAC h) where--  recommended _ =  recommended (undefined :: h)--instance Hash h => Symmetric (HMAC h) where-  type Key (HMAC h) = HMACKey h+type instance  Key (HMAC h) = HMACKey h  -- | Compute the hash of a pure byte source like, `B.ByteString`. hmac :: ( Hash h, Recommendation h, PureByteSource src )@@ -194,12 +189,12 @@             -> Key (HMAC h)             -> src             -> IO (HMAC h)-hmacSource' (SomeHashI hI) key src =+hmacSource' imp@(SomeHashI hI) key src =   insecurely $ do      -- Hash the first block for the inner hash     initialise ()-    allocate bufSize $ \ ptr -> do+    allocate $ \ ptr -> do       liftIO $ unsafeCopyToPointer innerFirstBlock ptr       compress hI ptr 1 @@ -209,13 +204,15 @@      -- Hash the outer block.     initialise ()-    allocate bufSize $ \ ptr -> do+    allocate $ \ ptr -> do       liftIO $ unsafeCopyToPointer outerFirstBlock ptr       compress hI ptr 1      -- Finish it with hashing the  hash computed above     HMAC <$> completeHashing hI (toByteString innerHash) -  where innerFirstBlock = B.map (xor 0x36) $ hmacAdjustKey key+  where allocate = liftPointerAction $ allocBufferFor imp $ 1 `asTypeOf` (theBlock key)+        innerFirstBlock = B.map (xor 0x36) $ hmacAdjustKey key         outerFirstBlock = B.map (xor 0x5c) $ hmacAdjustKey key-        bufSize         = length innerFirstBlock+        theBlock :: Key (HMAC h) -> BLOCKS h+        theBlock _ = toEnum 1

@@ -1,103 +1,124 @@ {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE ConstraintKinds            #-}+ module Raaz.Hash.Sha.Util-       ( shaImplementation, portableC+       ( shaImplementation+       -- ** Writing message lengths.+       -- $lengthwrites$        , length64Write        , length128Write        , Compressor        ) where -import Control.Monad.IO.Class import Data.Monoid                  ( (<>)      ) import Data.Word-import Foreign.Storable+import Foreign.Ptr                  ( Ptr       )+import Foreign.Storable             ( Storable  )  import Raaz.Core-import Raaz.Core.Write+import Raaz.Core.Transfer import Raaz.Hash.Internal +-- | The utilities in this module can be used on primitives which+-- satisfies the following constraint.+type IsSha h    = (Primitive h, Storable h, Memory (HashMemory h)) --- | The type alias for the raw compressor function.-type Compressor = Pointer  -- ^ The buffer to compress-                -> Int     -- ^ The number of blocks to compress-                -> Pointer -- ^ The cell memory containing the hash-                -> IO ()+-- | All actions here are in the following monad+type ShaMonad h = MT (HashMemory h) --- | Creates an implementation for a sha hash given the compressor and--- the length writer.-shaImplementation :: ( Primitive h-                     , Storable h-                     , Initialisable (HashMemory h) ()-                     )-                  => String                   -- ^ Name-                  -> String                   -- ^ Description-                  -> Compressor-                  -> (BITS Word64 -> Write)-                  -> HashI h (HashMemory h)-shaImplementation nam des comp lenW-  = HashI { hashIName        = nam-          , hashIDescription = des-          , compress         = shaCompress comp-          , compressFinal    = shaCompressFinal undefined lenW comp-          }+-- | The Writes used in this module.+type ShaWrite h = WriteM (ShaMonad h)+--+-- The message in the sha1 family of hashes pads the message, the last+-- few bytes of which are used to store the message length. Hashes+-- like sha1, sha256 etc writes the message lengths in 64-bits while+-- sha512 uses lengths in 128 bits. The generic writes `length64Write`+-- and `length128Write` are write actions that support this. -{-# INLINE shaImplementation #-}-{-# INLINE portableC         #-}-portableC :: ( Primitive h-             , Storable h-             , Initialisable (HashMemory h) ()-             )-          => Compressor-          -> (BITS Word64 -> Write)-          -> HashI h (HashMemory h)-portableC = shaImplementation "portable-c-ffi"-            "Implementation using portable C and Haskell FFI"+-- | Type that captures length writes.+type LengthWrite h = BITS Word64 -> ShaWrite h +-- | The length encoding that uses 64-bits.+length64Write :: LengthWrite h+length64Write (BITS w) = write $ bigEndian w +-- | The length encoding that uses 128-bits.+length128Write :: LengthWrite h+length128Write w = writeStorable (0 :: Word64) <> length64Write w --- | The generic compress function for the sha family of hashes.-shaCompress :: (Primitive h, Storable h)-            => Compressor -- ^ raw compress function.-            -> Pointer    -- ^ buffer pointer-            -> BLOCKS h   -- ^ number of blocks-            -> MT (HashMemory h) ()-shaCompress comp ptr nblocks = do-  liftSubMT  hashCell $ withPointer $ comp ptr $ fromEnum nblocks-  updateLength nblocks --- | The compressor for the last function.-shaCompressFinal :: (Primitive h, Storable h)-                  => h-                  -> (BITS Word64 -> Write) -- ^ the length writer-                  -> Compressor             -- ^ the raw compressor-                  -> Pointer                -- ^ the buffer-                  -> BYTES Int              -- ^ the message length-                  -> MT (HashMemory h) ()-shaCompressFinal h lenW comp ptr nbytes = do-  updateLength nbytes+-- | The type alias for the raw compressor function. The compressor function+-- does not need to know the length of the message so far and hence+-- this is not supposed to update lengths.+type Compressor h = Pointer -- ^ The buffer to compress+                  -> Int    -- ^ The number of blocks to compress+                  -> Ptr h  -- ^ The cell memory containing the hash+                  -> IO ()++-- | Action on a Buffer+type ShaBufferAction bufSize h = Pointer       -- ^ The data buffer+                               -> bufSize      -- ^ Total data present+                               -> ShaMonad h ()++-- | Lifts the raw compressor to a buffer action. This function does not update+-- the lengths.+liftCompressor          :: IsSha h => Compressor h -> ShaBufferAction (BLOCKS h) h+liftCompressor comp ptr = onSubMemory hashCell . withCellPointer . comp ptr . fromEnum+++-- | The combinator `shaBlocks` on an input compressor @comp@ gives a buffer action+-- that process blocks of data.+shaBlocks :: Primitive h+          => ShaBufferAction (BLOCKS h) h -- ^ the compressor function+          -> ShaBufferAction (BLOCKS h) h+shaBlocks comp ptr nblocks =+  comp ptr nblocks >> updateLength nblocks++-- | The combinator `shaFinal` on an input compressor @comp@ gives+-- buffer action for the final chunk of data.+shaFinal :: (Primitive h, Storable h)+         => ShaBufferAction (BLOCKS h) h   -- ^ the raw compressor+         -> LengthWrite h                  -- ^ the length writer+         -> ShaBufferAction (BYTES Int) h+shaFinal comp lenW ptr msgLen = do+  updateLength msgLen   totalBits <- extractLength-  let pad       = paddedMesg (lenW totalBits) h nbytes-      blocks    = atMost (bytesToWrite pad) `asTypeOf` blocksOf 1 h-    in do liftIO $ unsafeWrite pad ptr-          liftSubMT hashCell $ withPointer $ comp ptr $ fromEnum blocks+  let pad      = shaPad undefined msgLen $ lenW totalBits+      blocks   = atMost $ bytesToWrite pad+      in unsafeWrite pad ptr >> comp ptr blocks --- | The length encoding that uses 64-bits.-length64Write :: BITS Word64 ->  Write-length64Write (BITS w) = write $ bigEndian w --- | The length encoding that uses 128-bits.-length128Write :: BITS Word64 -> Write-length128Write w = writeStorable (0 :: Word64) <> length64Write w+-- | Padding is message followed by a single bit 1 and a glue of zeros+-- followed by the length so that the message is aligned to the block boundary.+shaPad :: IsSha h+       => h+       -> BYTES Int -- Message length+       -> ShaWrite h+       -> ShaWrite h+shaPad h msgLen = glueWrites 0 boundary hdr+  where skipMessage = skipWrite msgLen+        oneBit      = writeStorable (0x80 :: Word8)+        hdr         = skipMessage <> oneBit+        boundary    = blocksOf 1 h --- | The padding to be used-paddedMesg :: Primitive h-           => Write        -- ^ The length encoding-           -> h            -- ^ The hash-           -> BYTES Int    -- ^ The message length-           -> Write-paddedMesg lenW h msgLen = start <> zeros <> lenW-   where start      = skipWrite msgLen <> writeStorable (0x80 :: Word8)-         zeros      = writeBytes    0    sz-         totalBytes = bytesToWrite start + bytesToWrite lenW-         sz         = inBytes (atLeast totalBytes `asTypeOf` blocksOf 1 h)-                    - totalBytes+++-- | Creates an implementation for a sha hash given the compressor and+-- the length writer.+shaImplementation :: IsSha h+                  => String                   -- ^ Name+                  -> String                   -- ^ Description+                  -> Compressor  h+                  -> LengthWrite h+                  -> HashI h (HashMemory h)+shaImplementation nam des comp lenW+  = HashI { hashIName               = nam+          , hashIDescription        = des+          , compress                = shaBlocks shaComp+          , compressFinal           = shaFinal  shaComp lenW+          , compressStartAlignment  = wordAlignment+          }+  where shaComp = liftCompressor comp++{-# INLINE shaImplementation #-}

@@ -3,11 +3,13 @@ This module exposes combinators to compute the SHA1 hash and the associated HMAC for some common types. + -} module Raaz.Hash.Sha1-{-# DEPRECATED "sha1 and its hmac is mostly broken. Avoid if possible" #-}+{-# DEPRECATED "SHA1 is broken. This module is here only for transition." #-}        (-         -- * The SHA1 cryptographic hash+         -- * The broken SHA1 cryptographic hash.+         -- $sha1$          SHA1        , sha1, sha1File, sha1Source          -- * HMAC computation using SHA1@@ -24,8 +26,23 @@ import Raaz.Hash.Sha1.Internal ( SHA1 ) import Raaz.Hash.Sha1.Recommendation() +-- $sha1$+--+-- We already have a collision for SHA1:+-- <https://security.googleblog.com/2017/02/announcing-first-sha1-collision.html>+--+-- While it does not yet rule out SHA1 for some specific tasks, there+-- is no reason for its continual usage. This module is present only+-- to facilitate the transition to a better hash. Use it assuming no+-- security guarantees. Raaz will not try to optimise the+-- implementations given here and will remove this module at some+-- point of time. So do not rely on this for your software.+--+--+--+ {-# DEPRECATED sha1, sha1File, sha1Source-               "SHA1 is almost broken, avoid it as much as possible" #-}+               "SHA1 is broken. This functions are here only for transition." #-} -- | Compute the sha1 hash of an instance of `PureByteSource`. Use -- this for computing the sha1 hash of a strict or lazy byte string. sha1       :: PureByteSource src => src -> SHA1@@ -46,7 +63,7 @@   {-# DEPRECATED hmacSha1, hmacSha1File, hmacSha1Source-               "SHA1 is almost broken, avoid it for hmac-ing" #-}+               "SHA1 is broken. This functions are here only for transition." #-}  -- | Compute the message authentication code using hmac-sha1. hmacSha1 :: PureByteSource src  => Key (HMAC SHA1) -> src -> HMAC SHA1

@@ -4,6 +4,7 @@        ( implementation        ) where +import Foreign.Ptr              ( Ptr ) import Raaz.Core import Raaz.Hash.Internal import Raaz.Hash.Sha.Util@@ -14,8 +15,11 @@ implementation =  SomeHashI cPortable  cPortable :: HashI SHA1 (HashMemory SHA1)-cPortable = portableC c_sha1_compress length64Write+cPortable = shaImplementation+            "sha1-cportable"+            "Sha1 Implementation using portable C and Haskell FFI"+            c_sha1_compress length64Write  foreign import ccall unsafe   "raaz/hash/sha1/portable.h raazHashSha1PortableCompress"-  c_sha1_compress  :: Pointer -> Int -> Pointer -> IO ()+  c_sha1_compress  :: Pointer -> Int -> Ptr SHA1 -> IO ()

@@ -31,10 +31,6 @@ newtype SHA1 = SHA1 (Tuple 5 (BE Word32))              deriving (Storable, EndianStore, Equality, Eq) --{-# DEPRECATED SHA1-    "SHA1 is almost broken, avoid it in modern applications." #-}- instance Encodable SHA1  instance IsString SHA1 where

@@ -1,4 +1,3 @@-{-# LANGUAGE ForeignFunctionInterface   #-} {-# LANGUAGE MultiParamTypeClasses      #-} -- | The portable C-implementation of SHA224 module Raaz.Hash.Sha224.Implementation.CPortable@@ -6,6 +5,8 @@        ) where  import Control.Applicative+import Prelude+ import Raaz.Core import Raaz.Hash.Internal import Raaz.Hash.Sha224.Internal@@ -17,11 +18,11 @@ newtype SHA224Memory  = SHA224Memory { unSHA224Mem :: HashMemory SHA256 }  instance Memory SHA224Memory where-  memoryAlloc   = SHA224Memory <$> memoryAlloc-  underlyingPtr = underlyingPtr . unSHA224Mem+  memoryAlloc     = SHA224Memory <$> memoryAlloc+  unsafeToPointer = unsafeToPointer . unSHA224Mem  instance Initialisable SHA224Memory () where-  initialise _ = liftSubMT unSHA224Mem $+  initialise _ = onSubMemory unSHA224Mem $                  initialise $ SHA256 $ unsafeFromList [ 0xc1059ed8                                                       , 0x367cd507                                                       , 0x3070dd17@@ -33,7 +34,7 @@                                                       ]  instance Extractable SHA224Memory SHA224 where-  extract = trunc <$> liftSubMT unSHA224Mem extract+  extract = trunc <$> onSubMemory unSHA224Mem extract     where trunc (SHA256 tup) = SHA224 $ initial tup  -- | The portable C implementation of SHA224.

@@ -15,7 +15,6 @@ {-# LANGUAGE MultiParamTypeClasses      #-} {-# CFILES raaz/hash/sha1/portable.c    #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE DataKinds                  #-}  module Raaz.Hash.Sha224.Internal        ( SHA224(..)

@@ -4,6 +4,7 @@        ( implementation, cPortable        ) where +import Foreign.Ptr               ( Ptr ) import Raaz.Core import Raaz.Hash.Internal import Raaz.Hash.Sha.Util@@ -14,8 +15,12 @@ implementation =  SomeHashI cPortable  cPortable :: HashI SHA256 (HashMemory SHA256)-cPortable = portableC c_sha256_compress length64Write+cPortable = shaImplementation+            "sha256-cportable"+            "Sha256 Implementation using portable C and Haskell FFI"+            c_sha256_compress length64Write + foreign import ccall unsafe   "raaz/hash/sha256/portable.h raazHashSha256PortableCompress"-  c_sha256_compress  :: Pointer -> Int -> Pointer -> IO ()+  c_sha256_compress  :: Pointer -> Int -> Ptr SHA256 -> IO ()

@@ -3,7 +3,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE ForeignFunctionInterface   #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# CFILES raaz/hash/sha1/portable.c    #-} 

@@ -1,4 +1,3 @@-{-# LANGUAGE ForeignFunctionInterface   #-} {-# LANGUAGE MultiParamTypeClasses       #-} -- | The portable C-implementation of SHA384 module Raaz.Hash.Sha384.Implementation.CPortable@@ -6,6 +5,8 @@        ) where  import Control.Applicative+import Prelude+ import Raaz.Core import Raaz.Hash.Internal import Raaz.Hash.Sha384.Internal@@ -17,11 +18,11 @@ newtype SHA384Memory = SHA384Memory { unSHA384Mem :: HashMemory SHA512 }  instance Memory SHA384Memory where-  memoryAlloc   = SHA384Memory <$> memoryAlloc-  underlyingPtr = underlyingPtr . unSHA384Mem+  memoryAlloc     = SHA384Memory <$> memoryAlloc+  unsafeToPointer = unsafeToPointer . unSHA384Mem  instance Initialisable SHA384Memory () where-  initialise _ = liftSubMT unSHA384Mem+  initialise _ = onSubMemory unSHA384Mem                  $ initialise                  $ SHA512                  $ unsafeFromList [ 0xcbbb9d5dc1059ed8@@ -35,7 +36,7 @@                                   ]  instance Extractable SHA384Memory SHA384 where-  extract = trunc <$> liftSubMT unSHA384Mem extract+  extract = trunc <$> onSubMemory unSHA384Mem extract     where trunc (SHA512 v) = SHA384 $ initial v  -- | The portable C implementation of SHA384.

@@ -4,6 +4,7 @@        ( implementation, cPortable        ) where +import Foreign.Ptr                ( Ptr ) import Raaz.Core import Raaz.Hash.Internal import Raaz.Hash.Sha.Util@@ -14,8 +15,11 @@ implementation =  SomeHashI cPortable  cPortable :: HashI SHA512 (HashMemory SHA512)-cPortable = portableC c_sha512_compress length128Write+cPortable = shaImplementation+            "sha512-cportable"+            "Sha512 Implementation using portable C and Haskell FFI"+            c_sha512_compress length128Write  foreign import ccall unsafe   "raaz/hash/sha512/portable.h raazHashSha512PortableCompress"-  c_sha512_compress  :: Pointer -> Int -> Pointer -> IO ()+  c_sha512_compress  :: Pointer -> Int -> Ptr SHA512 -> IO ()

@@ -2,7 +2,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE ForeignFunctionInterface   #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE DataKinds                  #-} {-# CFILES raaz/hash/sha1/portable.c    #-}

@@ -0,0 +1,263 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-- | Interface for cryptographically secure random byte generators.+module Raaz.Random+       ( -- * Cryptographically secure randomness.+         -- $randomness$+         RandM, RT, liftMT+       , randomByteString+       -- ** Types that can be generated randomly+       , Random(..)+         -- * Low level access to randomness.+       , fillRandomBytes+       , unsafeStorableRandom+       , reseed+       ) where++import Control.Applicative+import Control.Monad+import Control.Monad.IO.Class+import Data.ByteString             ( ByteString             )+import Data.Int+import Data.Vector.Unboxed  hiding ( replicateM, create     )+import Data.Word++import Foreign.Ptr      ( Ptr     , castPtr)+import Foreign.Storable ( Storable, peek   )+import Prelude++import Raaz.Core+import Raaz.Cipher.ChaCha20.Internal(KEY, IV)+import Raaz.Random.ChaCha20PRG+++-- $randomness$+--+-- The raaz library gives a relatively high level interface to+-- randomness. The monad `RandM` captures a batch of actions that+-- generate/use cryptographically secure random bytes. In particular,+-- you can use the functions `random` and `randomByteString` to+-- actually generate random elements.+--+--+-- = Running a random action+--+-- Depending on whether the random bytes generated are sensitive or+-- not, you can use either of the combinators `securely` or+-- `insecurely`.  The combinator `securely` ensures that the seed of+-- the PRG is stored in a locked memory and hence will not be swapped+-- out to the disk. A use case for this is when you use the random+-- bytes to generate say a long term public key. On the other hand+-- locked memory is limited on most systems. So for cases where the+-- secrecy of the bytes are not important, we would recommend using+-- `insecurely`.+--+-- > -- Generate a pair of random Word8's+-- > import Raaz+-- > import Data.Word+-- >+-- > main :: IO ()+-- > main = insecurely rPair >>= print+-- >    where rPair :: RandM (Word8, Word8)+-- >          rPair = (,) <$> random <$> random+-- >+--+--+-- > -- A version of hello world that has gone nuts. Printed in base16+-- > -- to save some terminal grief.+-- >+-- > main = insecurely who >>= \ w -> putStrLn $ "hello " ++ showBase16 w+-- >   where who :: RandM ByteString+-- >         who = randomByteString 10+-- >+--+-- Some times you need additional memory to keep track of other+-- stuff. The monad @`RT` mem@ is meant for such uses. It should be+-- seen as the analogue of the monad @`MT` mem@ which in addition+-- allows you to pick cryptographically secure random data. In fact,+-- the combinator `liftMT` allows you to lift an `MT` action to the+-- corresponding `RT` action.+--+-- = Internal details+--+-- Generating unpredictable stream of bytes is one task that has burnt+-- the fingers of a lot of programmers. Unfortunately, getting it+-- correct is something of a black art.  Raaz uses a stream cipher+-- (chacha20), initialised with a starting random key/iv. The starting+-- seed is then drawn from the system entropy pool.+--+-- TODO: For system entropy we use @\/dev\/urandom@ on a posix systems+-- (no windows support yet). Even on posix systems, depending on+-- underlying operating system, there are better options. The+-- recommended way to generate randomness on an OpenBSD system is+-- through the function `arc4random` (note that arc4random does not+-- use rc4 cipher anymore).  Recent Linux kernels support the+-- `getrandom` system call which unfortunately is not yet+-- popular. These system specific calls are better because they take+-- into consideration many edge cases like for example+-- @\/dev\/urandom@ not being accessible or protection from interrupts+-- Eventually we will be supporting these calls.+++-- | A batch of actions on the memory element @mem@ that uses some+-- randomness.+newtype RT mem a = RT { unMT :: MT (RandomState, mem) a }+                 deriving (Functor, Applicative, Monad, MonadIO)++-- | The monad for generating cryptographically secure random data.+type RandM = RT VoidMemory++-- | Lift a memory action to the corresponding RT action.+liftMT :: MT mem a -> RT mem a+liftMT = RT . onSubMemory snd++-- | Run a randomness thread. In particular, this combinator takes+-- care of seeding the internal prg at the start.+runRT :: RT m a+      -> MT (RandomState, m) a+runRT action = onSubMemory fst reseedMT >> unMT action++++instance Memory mem => MonadMemory (RT mem) where+  insecurely = insecurely . runRT+  securely   = securely   . runRT++-- | Reseed from the system entropy pool. There is never a need to+-- explicitly seed your generator. The insecurely and securely calls+-- makes sure that your generator is seed before+-- starting. Furthermore, the generator also reseeds after every few+-- GB of random bytes generates. Generating random data from the+-- system entropy is usually an order of magnitude slower than using a+-- fast stream cipher. Reseeding often can slow your program+-- considerably without any additional security advantage.+--+reseed :: RT mem ()+reseed = RT $ onSubMemory fst reseedMT++-- | Fill the given input pointer with random bytes.+fillRandomBytes :: LengthUnit l => l ->  Pointer -> RT mem ()+fillRandomBytes l = RT . onSubMemory fst . fillRandomBytesMT l+++-- | Types that can be generated at random. It might appear that all+-- storables should be an instance of this class, after all we know+-- the size of the element why not write that many random bytes. In+-- fact, this module provides an `unsafeStorableRandom` which does+-- exactly that. However, we do not give a blanket definition for all+-- storables because for certain refinements of a given type, like for+-- example, Word8's modulo 10, `unsafeStorableRandom` introduces+-- unacceptable skews.+class Random a where++  random :: Memory mem => RT mem a++-- | Generate a random element. The element picked is+-- crypto-graphically pseudo-random.+--+-- This is a helper function that has been exported to simplify the+-- definition of a `Random` instance for `Storable` types. However,+-- there is a reason why we do not give a blanket instance for all+-- instances `Storable` and why this function is unsafe? This function+-- generates a random element of type @a@ by generating @n@ random+-- bytes where @n@ is the size of the elements of @a@. For instances+-- that range the entire @n@ byte space this is fine. However, if the+-- type is actually a refinement of such a type --- consider for+-- example, @`Word8`@ modulo @10@ -- this function generates an+-- unacceptable skew in the distribution. Hence this function is+-- prefixed unsafe.+--+unsafeStorableRandom :: (Memory mem, Storable a) => RT mem a+unsafeStorableRandom = RT $ onSubMemory fst retA+  where retA = liftPointerAction alloc $ getIt . castPtr++        getIt        :: Storable a => Ptr a -> MT RandomState a+        getIt ptr    = unsafePokeManyRandom 1 ptr >> liftIO (peek ptr)+        getElement   :: MT RandomState a -> a+        getElement _ = undefined++        algn         = alignment $ getElement retA+        sz           = sizeOf    $ getElement retA++        alloc        = allocaAligned algn sz+++-- | Generate a random byteString.++randomByteString :: LengthUnit l+                 => l+                 -> RT mem ByteString+randomByteString l = RT $ onSubMemory fst  $ liftPointerAction (create l) $ fillRandomBytesMT l++------------------------------- Some instances of Random ------------------------++instance Random Word8 where+  random = unsafeStorableRandom++instance Random Word16 where+  random = unsafeStorableRandom++instance Random Word32 where+  random = unsafeStorableRandom++instance Random Word64 where+  random = unsafeStorableRandom++instance Random Word where+  random = unsafeStorableRandom++instance Random Int8 where+  random = unsafeStorableRandom++instance Random Int16 where+  random = unsafeStorableRandom++instance Random Int32 where+  random = unsafeStorableRandom++instance Random Int64 where+  random = unsafeStorableRandom++instance Random Int where+  random = unsafeStorableRandom++instance Random KEY where+  random = unsafeStorableRandom++instance Random IV where+  random = unsafeStorableRandom+++instance Random w => Random (LE w) where+  random = littleEndian <$> random++instance Random w => Random (BE w) where+  random = bigEndian <$> random++instance (Dimension d, Unbox w, Random w) => Random (Tuple d w) where+  random = repeatM random++-------------------------- Now comes the boring tuples -----------------++instance (Random a, Random b) => Random (a,b) where+  random = (,) <$> random <*> random++instance (Random a, Random b, Random c) => Random (a,b,c) where+  random = (,,) <$> random <*> random <*> random++instance (Random a, Random b, Random c, Random d) => Random (a,b,c,d) where+  random = (,,,) <$> random <*> random <*> random <*> random++instance (Random a, Random b, Random c, Random d, Random e) => Random (a,b,c,d,e) where+  random = (,,,,) <$> random <*> random <*> random <*> random <*> random++-- | The action @unsafePokeManyRandom n ptr@ pokes @n@ random elements+-- at the location starting at ptr.  If the underlying type does not+-- saturate its entire binary size (think of say Word8 modulo 5), the+-- distribution of elements can be rather skewed . Hence the prefix+-- unsafe. This function is exported to simplify the definition+-- `Random` instance. Do not use it unwisely.+unsafePokeManyRandom :: Storable a => Int -> Ptr a -> MT RandomState ()+unsafePokeManyRandom n ptr = fillRandomBytesMT totalSz $ castPtr ptr+  where totalSz = fromIntegral n * sizeOf (getElement ptr)+        getElement :: Ptr a -> a+        getElement _ = undefined

@@ -0,0 +1,123 @@+-- | The module exposes the ChaCha20 based PRG.+{-# LANGUAGE FlexibleContexts #-}+module Raaz.Random.ChaCha20PRG+       ( reseedMT, fillRandomBytesMT, RandomState(..)+       ) where++import Control.Applicative+import Control.Monad+import Foreign.Ptr   (Ptr, castPtr)+import Prelude++import Raaz.Core+import Raaz.Cipher.ChaCha20.Internal+import Raaz.Cipher.ChaCha20.Recommendation+import Raaz.Entropy++-- | The maximum value of counter before reseeding from entropy+-- source. Currently set to 1024 * 1024 * 1024. Which will generate+-- 64GB before reseeding.+--+-- The counter is a 32-bit quantity. Which means that one can generate+-- 2^32 blocks of data before the counter roles over and starts+-- repeating. We have choosen a conservative 2^30 blocks here.+maxCounterVal :: Counter+maxCounterVal = 1024 * 1024 * 1024++-- | Memory for strong the internal memory state.+data RandomState = RandomState { chacha20State  :: ChaCha20Mem+                               , auxBuffer      :: RandomBuf+                               , remainingBytes :: MemoryCell (BYTES Int)+                               }++-------------------------- Some helper functions on random state -------------------++-- | Run an action on the auxilary buffer.+withAuxBuffer :: (Ptr something -> MT RandomState a) -> MT RandomState a+withAuxBuffer action = onSubMemory auxBuffer getBufferPointer >>= action . castPtr++-- | Get the number of bytes in the buffer.+getRemainingBytes :: MT RandomState (BYTES Int)+getRemainingBytes = onSubMemory remainingBytes extract++-- | Set the number of remaining bytes.+setRemainingBytes :: BYTES Int -> MT RandomState ()+setRemainingBytes = onSubMemory remainingBytes . initialise++instance Memory RandomState where+  memoryAlloc     = RandomState <$> memoryAlloc <*> memoryAlloc <*> memoryAlloc+  unsafeToPointer = unsafeToPointer  . chacha20State++-- | This fills in the random block with some new randomness+newSample :: MT RandomState ()+newSample = do setRemainingBytes $ inBytes randomBufferSize+               onSubMemory chacha20State seedIfReq+               withAuxBuffer $ onSubMemory chacha20State . flip chacha20Random randomBufferSize++-- | See the PRG from system entropy.+seed :: MT ChaCha20Mem ()+seed = do onSubMemory counterCell $ initialise (0 :: Counter)+          onSubMemory keyCell getCellPointer >>= void . getEntropy keySize . castPtr+          onSubMemory ivCell  getCellPointer >>= void . getEntropy ivSize  . castPtr+  where keySize = sizeOf (undefined :: KEY)+        ivSize  = sizeOf (undefined :: IV)++-- | Seed if we have already generated maxCounterVal blocks of random+-- bytes.+seedIfReq :: MT ChaCha20Mem ()+seedIfReq = do c <- onSubMemory counterCell extract+               when (c > maxCounterVal) $ seed+++--------------------------- DANGEROUS CODE ---------------------------------------++++-- remaining bytes, this can produce a lot of nonsense.++-- | Reseed the prg.+reseedMT :: MT RandomState ()+reseedMT = onSubMemory chacha20State seed >> newSample++-- NONTRIVIALITY: Picking up the newSample is important when we first+-- reseed.++-- | The function to generate random bytes. Fills from existing bytes+-- and continues if not enough bytes are obtained.+fillRandomBytesMT :: LengthUnit l => l -> Pointer -> MT RandomState ()+fillRandomBytesMT l = go (inBytes l)+  where go m ptr+          | m  <= 0    = return ()   -- Nothing to do+          | otherwise  = do+              mGot <- fillExistingBytes m ptr   -- Fill some+              go+                (m - mGot)          -- bytes yet to get.+                $ movePtr ptr mGot  -- Shift by what is already got.+++-- | Fill from already existing bytes. Returns the number of bytes+-- filled. Let remaining bytes be r. Then fillExistingBytes will fill+-- min(r,m) bytes into the buffer, and return the number of bytes+-- filled.+fillExistingBytes :: BYTES Int -> Pointer -> MT RandomState (BYTES Int)+fillExistingBytes m ptr = do+  r <- getRemainingBytes+  withAuxBuffer $ \ sptr -> do+    if r <= m then do memcpy (destination ptr) (source sptr) r -- read the entire stuff.+                      newSample+                      return r+      else let leftOver = r - m                 -- Bytes leftover+               tailPtr  = movePtr sptr leftOver -- We read the last m bytes.+           in do memcpy (destination ptr) (source tailPtr) m+                 setRemainingBytes leftOver+                 return m+++-- The function fillExisting bytes reads from the end. See the picture+-- below+--+--+--    ---------------------------------------------------------------------+--    |   (r - m) remaining bytes        |     m bytes consumed           |+--    ---------------------------------------------------------------------+--

@@ -0,0 +1,181 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE RecordWildCards     #-}++-- | This module benchmarks all block function and shows the++import Control.Monad+import Criterion+import Criterion.Types hiding (measure)+import Criterion.Measurement+import Data.Int+import Data.List              (span)+import Text.PrettyPrint+import System.IO++import Raaz.Core+import Raaz.Cipher+import Raaz.Cipher.Internal+import Raaz.Hash.Internal+import Raaz.Random++import qualified Raaz.Hash.Sha1.Implementation.CPortable      as Sha1CP+import qualified Raaz.Hash.Sha256.Implementation.CPortable    as Sha256CP+import qualified Raaz.Hash.Sha512.Implementation.CPortable    as Sha512CP+import qualified Raaz.Cipher.AES.CBC.Implementation.CPortable as AesCbcCP+import qualified Raaz.Cipher.ChaCha20.Implementation.CPortable as ChaCha20CP++# ifdef HAVE_VECTOR_128+import qualified Raaz.Cipher.ChaCha20.Implementation.Vector128 as ChaCha20V128+# endif++# ifdef HAVE_VECTOR_256+import qualified Raaz.Cipher.ChaCha20.Implementation.Vector256 as ChaCha20V256+# endif++-- The total data processed+nBytes :: BYTES Int+nBytes = 32 * 1024++-- How many times to run each benchmark+nRuns :: Int64+nRuns = 10000++type Result            = (String, Measured)+type RaazBench         = (String, Benchmarkable)++allBench :: [RaazBench]+allBench =    [ memsetBench, randomnessBench ]+           ++ chacha20Benchs+           ++ aesBenchs+           ++ sha1Benchs+           ++ sha256Benchs+           ++ sha512Benchs++main :: IO ()+main = do results <- mapM runRaazBench allBench+          putStrLn $ "Buffer Size = " ++ show (fromIntegral nBytes :: Int)+          putStrLn $ "Iterations  = " ++ show nRuns+          putStrLn $ render $ vcat results+++pprMeasured :: Measured -> Doc+pprMeasured (Measured{..}) = vcat+  [ text "time       " <+> eq <+> text (secs tm)+  , text "cycles     " <+> eq <+> double cy+  , text "rate       " <+> eq <+> text rt   <> text "bps"+  , text "secs/byte  " <+> eq <+> text secB <> text "sec/byte"+  , text "cycles/byte" <+> eq <+> double cycB+  ]+  where tm    = measTime   / fromIntegral nRuns+        cy    = fromIntegral measCycles / fromIntegral nRuns+        bytes = fromIntegral nBytes+        secB  = humanise $ tm / bytes+        cycB  = cy    / bytes+        rt    = humanise $ 8 * bytes / tm+        eq    = text "="+++-------------  All benchmarks ---------------------------------------------++memsetBench :: RaazBench+memsetBench = ("memset", Benchmarkable $ memBench . fromIntegral )+  where memBench count = allocaBuffer nBytes $ \ ptr -> replicateM_ count (memset ptr 42 nBytes)+++sha1Benchs :: [ RaazBench ]+sha1Benchs = [ hashBench Sha1CP.implementation ]++sha256Benchs :: [ RaazBench ]+sha256Benchs = [ hashBench Sha256CP.implementation ]++sha512Benchs :: [ RaazBench ]+sha512Benchs = [ hashBench Sha512CP.implementation ]+++aesBenchs     :: [ RaazBench ]+aesBenchs      = [ encryptBench AesCbcCP.aes128cbcI+                 , decryptBench AesCbcCP.aes128cbcI+                 , encryptBench AesCbcCP.aes192cbcI+                 , decryptBench AesCbcCP.aes192cbcI+                 , encryptBench AesCbcCP.aes256cbcI+                 , decryptBench AesCbcCP.aes256cbcI+                 ]+chacha20Benchs :: [ RaazBench ]+chacha20Benchs = [ encryptBench ChaCha20CP.implementation+#               ifdef HAVE_VECTOR_256+                , encryptBench ChaCha20V256.implementation+#               endif+#               ifdef HAVE_VECTOR_128+                , encryptBench ChaCha20V128.implementation+#               endif+                ]+++--------------------------- Helper functions ---------------------------------------------------------------------------++encryptBench :: Cipher c => Implementation c -> RaazBench+encryptBench si@(SomeCipherI impl) = (nm , Benchmarkable $ encrBench . fromIntegral)+  where encrBench count = allocBufferFor si sz $ \ ptr -> insecurely $ replicateM_ count $ encryptBlocks impl ptr sz+        nm = name si ++ "-encrypt"+        sz = atLeast nBytes+++decryptBench :: Cipher c => Implementation c -> RaazBench+decryptBench si@(SomeCipherI impl) = (nm , Benchmarkable $ decrBench . fromIntegral)+  where decrBench count = allocBufferFor si sz $ \ ptr -> insecurely $ replicateM_ count $ decryptBlocks impl ptr sz+        nm = name si ++ "-decrypt"+        sz = atLeast nBytes++hashBench :: Hash h => Implementation h -> RaazBench+hashBench hi@(SomeHashI impl) = (nm, Benchmarkable $ compressBench . fromIntegral )+  where compressBench count = allocBufferFor hi sz $ \ ptr -> insecurely $ replicateM_ count $ compress impl ptr sz+        nm = name hi ++ "-compress"+        sz = atLeast nBytes++randomnessBench :: RaazBench+randomnessBench = ("random", Benchmarkable $ rand . fromIntegral)+  where rand count = allocaBuffer nBytes $ insecurely . replicateM_ count . fillIt+        fillIt :: Pointer -> RandM ()+        fillIt = fillRandomBytes nBytes++runRaazBench :: RaazBench -> IO Doc+runRaazBench (nm, bm) = do+  hPutStr  stderr $ "running " ++ nm ++ " ..."+  (memt,x) <- measure bm nRuns+  hPutStrLn stderr $ "done."+  return $ text nm $+$ nest 8 (pprMeasured memt)++-------------------------- Humanise output -----------------------------------++humanise :: Double -> String+humanise u | u < 1     = goL 0 u+           | otherwise = goU 0 u+  where goL e x | x > 1 || e == -3  = restrictDecimals 2  x ++ unitPrefix e+                | otherwise         = goL (e  - 1) (x * 1000)++        goU e x | x < 100 || e == 5 = restrictDecimals 2 x  ++ unitPrefix e+                | otherwise         = goU (e  + 1) (x / 1000)++++restrictDecimals :: Int -> Double -> String+restrictDecimals n x = u ++ take (n+1) v+  where (u,v) = span (/= '.') $ show x+++-- | @prefix n@ gives proper prefix every 10^{3n} exponent+unitPrefix :: Int -> String+unitPrefix ex+  | ex <  -3   = error "exponent too small name"+  | ex == -3   = "n"+  | ex == -2   = "μ"+  | ex == -1   = "m"+  | ex == 0    = ""+  | ex == 1    = "K"+  | ex == 2    = "M"+  | ex == 3    = "G"+  | ex == 4    = "T"+  | ex == 5    = "P"+  | otherwise  = error "exponent to large to name"

@@ -14,7 +14,7 @@ import           Foreign.Ptr (castPtr)  import           Raaz.Core.Types-import qualified Raaz.Core.Write  as RW+import qualified Raaz.Core.Transfer  as RW import qualified Raaz.Core.Encode as E  -- Why 4000 entries. The result size is roughly 32k which is the L1 cache@@ -58,5 +58,5 @@ blazeWrite :: (a -> BB.Write)   -> [a] -> ByteString blazeWrite fn = BB.writeToByteString . mconcat . map fn -raazWrite  :: (a -> RW.Write) -> [a] -> ByteString+raazWrite  :: (a -> RW.WriteIO) -> [a] -> ByteString raazWrite fn = E.toByteString . mconcat . map fn

@@ -0,0 +1,79 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE CPP                 #-}+import           Control.Monad+import           Criterion+import           Criterion.Main+import           Criterion.Types+import           Foreign.Marshal.Alloc++import           Raaz.Core+import           Raaz.Cipher+import           Raaz.Cipher.Internal+import qualified Raaz.Cipher.ChaCha20.Implementation.CPortable as CPortable+# ifdef HAVE_VECTOR_128+import qualified Raaz.Cipher.ChaCha20.Implementation.Vector128 as Vector128+# endif++# ifdef HAVE_VECTOR_256+import qualified Raaz.Cipher.ChaCha20.Implementation.Vector256 as Vector256+# endif++-- | Buffer size used+bufSize :: BYTES Int+bufSize = 32 * 1024+++main :: IO ()+main = defaultMain [ chacha20Bench, aesBench ]+++----------------- Benchmarks of individual ciphers. ------------------------+aesBench :: Benchmark+aesBench = bgroup "AES"+           [ benchCipher aes128cbc+           , benchCipher aes192cbc+           , benchCipher aes256cbc+           ]++chacha20Bench :: Benchmark+chacha20Bench = bgroup "ChaCha20"+                [ benchEncrypt' chacha20 CPortable.implementation+#               ifdef HAVE_VECTOR_128+                , benchEncrypt' chacha20 Vector128.implementation+#               endif+#               ifdef HAVE_VECTOR_256+                , benchEncrypt' chacha20 Vector256.implementation+#               endif+                ]+++------------------ Low level functions ---------------------------------------+benchCipher :: (Cipher c, Recommendation c) => c  -> Benchmark+benchCipher c = bgroup (name c) [benchEncrypt c, benchDecrypt c]++benchEncrypt :: (Cipher c, Recommendation c) => c -> Benchmark+benchEncrypt c = benchEncrypt' c $ recommended c++benchDecrypt  :: (Cipher c, Recommendation c) => c -> Benchmark+benchDecrypt c = benchDecrypt' c $ recommended c+++benchEncrypt' :: Cipher c => c -> Implementation c -> Benchmark+benchEncrypt' c si@(SomeCipherI imp) = bench nm $ nfIO go+  where go = allocBufferFor si sz $ \ ptr -> insecurely $ encryptBlocks imp ptr sz+        sz = atMost bufSize+        nm = "encrypt" ++ name si++benchDecrypt' :: Cipher c => c -> Implementation c -> Benchmark+benchDecrypt' c si@(SomeCipherI imp) = bench nm $ nfIO go+  where go = allocBufferFor si sz $ \ ptr -> insecurely $ decryptBlocks imp ptr sz+        sz = atMost bufSize+        nm = "decrypt" ++ name si++{--+-- | Compare ciphers with a plain memset.+benchMemSet :: Benchmark+benchMemSet = bench "memset" $ nfIO go+  where go = allocaBuffer bufSize $ \ ptr -> memset ptr 0 bufSize+--}

@@ -0,0 +1,320 @@+Introduction+------------++This command supports a generalised version of+sha1sum/sha256sum/sha512sum programs that are available on a standard+linux system. It supports generating checksum files and verifying them+for all the hashes exposed by the raaz library. The purpose of writing+this application is the following.++1. To give an example of of a non-trivial program written to use the+   raaz library.++2. To make sure that the implementations of hashes in this library are+   not too off in terms of performance.++The command line options of this command is similar to that of sha1sum+and hence can be used as a replacement.++This file is a literate haskell file and hence can be compiled+directly. The text is in markdown and hence you should be able to+produce the documentation for++We start by enabling some pragmas and importing some stuff which can+be ignored.++> {-# LANGUAGE GADTs           #-}+> {-# LANGUAGE RankNTypes      #-}+> {-# LANGUAGE RecordWildCards #-}+> {-# LANGUAGE ConstraintKinds #-}++> module Command.Checksum ( checksum ) where+>+> import Control.Applicative+> import Control.Monad+> import Data.List             (intercalate)+> import Data.Monoid+> import Data.String+> import Data.Version          (showVersion)+> import System.Environment+> import System.Exit+> import System.IO             (stdin, stderr, hPutStrLn)+> import System.Console.GetOpt++> import Raaz     hiding (Result)+> import Raaz.Hash.Sha1+++Verification Tokens+-------------------++Programs like sha1sum is typically used to verify that the contents of+a set of files have not been modified or corrupted. This program does+the following:++1. In compute mode it computes a set of verification tokens which+   uniquely identify the contents of the file.++2. In verification mode it takes a set of tokens are verify them.++Verification tokens are computed using the cryptographic hash. We+allow the use of any of the hashes exposed by the raaz library. Thus+for us, any hash that satisfies the constraint `TokenHash` should be+usable in computing and verifying tokens.+++> type TokenHash h = (Hash h, Recommendation h, Show h, IsString h)+>++The verification token is defined below. To make it opaque, we+existentially quantify over the underlying digest.++>+> data Token  = forall h . TokenHash h+>             => Token { tokenFile    :: FilePath+>                      , tokenDigest  :: h+>                      }+>+++A token can be verified easily. First we define the result type++> type Result = Either FilePath FilePath+>+> verify :: Token -> IO Result+> verify (Token{..}) = do c <- (==tokenDigest) <$> hashFile tokenFile+>                         return $ if c then Right tokenFile else Left tokenFile+++Computing tokens.+-----------------++To compute the verification token, we need a way to specify the+algorithm.  The following proxy helps us in this.++> data Algorithm h   = Algorithm++Here `h` varies over all the hashes supported by the library. We now+need an easy way to tabulate all the hash algorithm that we+support. Existential types comes to the rescue once more.++> data SomeAlgorithm = forall h . TokenHash h => SomeAlgorithm (Algorithm h)++Here is the table of algorithms that we support currently.++> algorithms :: [(String, SomeAlgorithm)]+> algorithms =  [ ("broken-sha1"  , SomeAlgorithm (Algorithm :: Algorithm SHA1)   )+>               , ("sha256", SomeAlgorithm (Algorithm :: Algorithm SHA256) )+>               , ("sha512", SomeAlgorithm (Algorithm :: Algorithm SHA512) )+>               -- Add new algorithms here.+>               ]++We now define the computation function. There are two variants, one for arbitrary files+and the other for standard input.++> -- | Compute the token using a given algorithm.+> token :: TokenHash h+>       => Algorithm h  -- ^ The hashing algorithm to use.+>       -> FilePath     -- ^ The file to compute the token for.+>       -> IO Token+> token algo fp = Token fp <$> hashIt algo+>   where hashIt :: TokenHash h => Algorithm h -> IO h+>         hashIt _ = hashFile fp+>+> tokenStdin :: TokenHash h => Algorithm h -> IO Token+> tokenStdin algo = Token "-" <$> hashIt algo+>   where hashIt :: TokenHash h => Algorithm h -> IO h+>         hashIt _ = hashSource stdin+>+++Printed form of tokens+----------------------++To inter-operate with programs like sha1sum, we follow the same+printed notation. The appropriate show instances for token is the+following. The format is `line := digest space mode filename`. The mode+has something to do with whether it is binary or text (we always put+a space for it).++> instance Show Token where+>   show (Token{..}) = show tokenDigest ++ "  " ++ tokenFile++We also define the associated parsing function which has to take the+the underlying algorithm as a parameter.++> parse :: TokenHash h => Algorithm h -> String -> Token+> parse algo str = Token { tokenFile   = drop 2 rest+>                        , tokenDigest = parseDigest algo digest+>                        }+>   where parseDigest    :: TokenHash h => Algorithm h -> String -> h+>         parseDigest _  = fromString+>         (digest, rest) = break (==' ') str -- break at the space.+++The main function.+------------------++The overall structure of the code is clear the details follow.++> checksum :: [String] -> IO ()+> checksum =  parseOpts >=> handleArgs++> handleArgs :: (Options, [FilePath])+>            -> IO ()+> handleArgs (opts@Options{..}, files) = do+>   when optHelp printHelp       -- When the help option is given print it and exit+>   flip (either badAlgorithm) optAlgo $ \ algo -> do+>     if optCheck  -- if asked to check.+>       then verifyMode opts  algo files >>= optPrintCount+>       else computeMode      algo files+++> badAlgorithm :: String -> IO ()+> badAlgorithm name = errorBailout ["Bad hash algorithm " ++ name]+++The compute mode.+-----------------++There are two important modes of operation for this program, _the+compute mode_ and the _verify mode_. In the compute mode, we are given+an a set of files and we need to print out the verification tokes for+those files.++> computeMode :: SomeAlgorithm  -- The algorithm to use+>             -> [FilePath]     -- files for which tokes need to be+>                               -- computed.+>             -> IO ()+> computeMode (SomeAlgorithm algo) files+>   | null files = tokenStdin algo >>= print  -- No files means compute it for stdin.+>   | otherwise  = mapM_ printToken files     -- Print the token for each file.+>   where printToken = token algo >=> print+++The verification mode of the algorithm is a bit more complicated than+the compute mode. Given a list of tokens let us first read+them. Recall the tokens are listed, one per line with the digest+followed by a space followed by the filename.+++> verifyMode :: Options+>            -> SomeAlgorithm+>            -> [FilePath]+>            -> IO Int+> verifyMode (Options{..}) algo files = verifyFiles algo files >>= foldM fldr (0 :: Int)+>   where fldr n = either whenFailed whenOkey+>           where whenOkey    :: FilePath -> IO Int+>                 whenOkey    = optOkey   >=> const (return n)     -- when okey do the okey action and keep the count+>                 whenFailed  = optFailed >=> const (return (n+1)) -- when failed do the failed action and increment++This function verify the token list given in a list of files. Each+file contains a list of tokens and each of these tokens have to be+verified.++> verifyFiles :: SomeAlgorithm+>             -> [FilePath]+>             -> IO [Result]+>+> verifyFiles (SomeAlgorithm algo) files+>   | null files = getContents >>= verifyTokenList+>   | otherwise  = concat <$> mapM verifyFile files+>   where+>     verifyFile      = readFile >=> verifyTokenList+>     verifyTokenList = mapM mapper . lines+>     mapper          = verify . parse algo+++This function prints the help for the program.++> printHelp :: IO ()+> printHelp = do putStrLn $ usage []+>                exitSuccess+++Command line parsing+--------------------++The options supported by the program is given by the following data+type. Fields should be self explanatory.++> data Options =+>   Options { optHelp    :: Bool+>           , optCheck   :: Bool+>           , optAlgo    :: Either String SomeAlgorithm+>           , optOkey    :: FilePath -> IO () -- ^ handle successful tokens+>           , optFailed  :: FilePath -> IO () -- ^ handle failed tokens.+>           , optPrintCount   :: Int -> IO () -- ^ print failure counts.+>           }+++The default options for the command is as follows.++> defaultOpts =+>   Options { optHelp       = False+>           , optCheck      = False+>           , optAlgo       = Right sha512Algorithm+>           , optOkey       = \ fp -> putStrLn (fp ++ ": OK")+>           , optFailed     = \ fp -> putStrLn (fp ++ ": FAILED")+>           , optPrintCount = printCount+>           }+>   where sha512Algorithm = SomeAlgorithm (Algorithm :: Algorithm SHA512)+>         printCount n  = when (n > 0) $ do+>           putStrLn $ show n ++ " failures."+>           exitFailure+>++We use the getOpts library to parse the command lines.  The options+are summarised in the following list. The `Endo` monoid helps in+summarising the changes to the option set.++> options :: [OptDescr (Endo Options)]+> options =+>   [ Option ['h'] ["help"]    (NoArg setHelp)    "print the help"+>   , Option ['c'] ["check"]   (NoArg setCheck)   "check instead of compute"+>   , Option ['q'] ["quiet"]   (NoArg setQuiet)   "print failure only"+>   , Option ['s'] ["status"]  (NoArg setStatusOnly)+>     "no output only return status"+>   , Option ['a'] ["algo"]    (ReqArg setAlgo "HASH")+>     $ "hash algorithm to use " ++ "[" ++ algOpts ++ "]. Default sha512"+>   ]+>   where setHelp      = Endo $ \ opt -> opt { optHelp    = True }+>         setCheck     = Endo $ \ opt -> opt { optCheck   = True }+>         setAlgo  str = Endo $ \ opt -> opt { optAlgo    = a    }+>                  where a = maybe (Left str) Right $ lookup str algorithms+>         algOpts          = intercalate "|" $ map fst algorithms+>         setQuiet      = Endo $ \ opt ->  opt { optOkey   = noPrint }+>         setStatusOnly = Endo $ \ opt ->  opt { optFailed      = noPrint+>                                              , optOkey        = noPrint+>                                              , optPrintCount  = returnStatus+>                                              }+>         noPrint           = const $ return ()+>         returnStatus n+>           | n > 0         = exitFailure+>           | otherwise     = exitSuccess+>++++The usage message for the program.++> usage :: [String] -> String+> usage errs+>       | null errs = usageInfo header options+>       | otherwise = "raaz checksum: " ++ unlines errs ++ usageInfo header options+>   where header ="Usage: raaz checksum [OPTIONS] FILE1 FILE2 ..."+++Parsing the options.++> parseOpts :: [String] -> IO (Options, [FilePath])+> parseOpts args = case getOpt Permute options args of+>                    (o,n,[])   -> return (appEndo (mconcat o) defaultOpts, n)+>                    (_,_,errs) -> errorBailout errs++Bail out with an error message.++> errorBailout :: [String]-> IO a+> errorBailout errs = do+>   hPutStrLn stderr $ usage errs+>   exitFailure

@@ -0,0 +1,86 @@+This command that spits out never ending stream of+cryptographically secure bytes. Other than being a replacement to+Yo-Yo Honey Singh (random > /dev/audio), it is used to test the+quality of the randomnes produced.+++> module Command.Rand ( rand ) where++> import Control.Applicative+> import Control.Monad.IO.Class(liftIO)+> import System.Exit+> import System.IO+> import Text.Read+> import Prelude+> import Raaz++So much bytes generated in one go before writing to stdout.++> bufSize :: BYTES Int+> bufSize = 32 * 1024+++The usage message for the program.++> usage :: [String] -> String+> usage errs | null errs = body+>            | otherwise = "raaz: " ++ unlines errs ++ body+>   where body = unlines $ [ "Usage: raaz random [N]"+>                          , "       raaz random [-h|--help]"+>                          , ""+>                          , "Generates never ending stream of cryptographically secure random bytes."+>                          , "With the option integral argument N, stops after generating N bytes."+>                          , "   -h\t--help\tprint this help"+>                          ]+++The main stuff.++> rand :: [String] -> IO ()+> rand args = case args of+>               ["-h"]     -> printHelp+>               ["--help"] -> printHelp+>               [n]        -> maybe (badArgs n) gen $ readNBytes n+>               []         -> withBuffer $ insecurely . genInfiniteBytes+>               _          -> tooManyArgs+>   where readNBytes     :: String -> Maybe (BYTES Int)+>         readNBytes   x = (toEnum <$> readMaybe x) >>= onlyPositive+>         onlyPositive x+>           | x >= 0     = Just x+>           | otherwise  = Nothing+>         badArgs n      = errorBailout ["Bar argument " ++ n ++ " expected integer (no of bytes)"]+>         tooManyArgs    = errorBailout ["too many args"]+>         gen n          = withBuffer $ insecurely . genBytes n+>         withBuffer = allocaBuffer bufSize+++> printHelp :: IO ()+> printHelp = do putStrLn $ usage []+>                exitSuccess+++> genInfiniteBytes :: Pointer -> RandM ()+> genInfiniteBytes ptr = goForEver+>   where goForEver = emitRand bufSize ptr >> goForEver+++Generate so many bytes.++> genBytes :: BYTES Int -> Pointer-> RandM ()+> genBytes n ptr = go n+>   where go m | m >= bufSize = do emitRand bufSize ptr; go (m - bufSize)+>              | otherwise    =    emitRand m ptr+++Bail out of errors++> errorBailout errs = do hPutStrLn stderr $ usage errs+>                        exitFailure+++-- Emit so may random bytes.++> emitRand :: BYTES Int -> Pointer-> RandM ()+> emitRand m ptr = do+>   fillRandomBytes m ptr+>   liftIO $ hPutBuf stdout ptr $ fromIntegral m

@@ -0,0 +1,86 @@+{-# LANGUAGE RecordWildCards #-}+--+-- The main function that drives other commands.+--++import Control.Monad+import Data.Version          (showVersion)+import Data.Monoid+import Raaz                  (version)+import System.Console.GetOpt+import System.Environment+import System.Exit+import System.IO++++import Command.Checksum+import Command.Rand+++-- The commands know to raaz executable.+commands :: [(String, [String] -> IO ())]+commands = [ ("checksum", checksum)+           , ("rand"    , rand    )+           ]++++----------------- Command line parsing -------------------------------------++data Options = Options { optVersion :: Bool+                       , optHelp    :: Bool+                       }++defaultOpts :: Options+defaultOpts = Options { optVersion    = False, optHelp  = False }++options :: [OptDescr (Endo Options)]+options = [ Option ['v'] ["version"] (NoArg setVersion) "print the version"+          , Option ['h'] ["help"]    (NoArg setHelp)    "print the help"+          ]+  where setVersion   = Endo $ \ opt -> opt { optVersion = True }+        setHelp      = Endo $ \ opt -> opt { optHelp    = True }+++-- | parse options+parseOpts :: [String] -> IO Options+parseOpts args = case getOpt Permute options args of+  (o,[],[])  -> return $ appEndo (mconcat o) defaultOpts+  (_,_,errs) -> errorBailout errs++-- The usage message for the program.+usage :: [String] -> String+usage errs | null errs = usageInfo header options+           | otherwise = "raaz: " ++ unlines errs ++ usageInfo header options+  where header = unlines $ [ "Usage: raaz [COMMAND] [OPTIONS]"+                           , "       raaz [OPTIONS]"+                           , ""+                           , "Supported Commands: "+                           ] ++ cmds+        cmds     = map (("\t"++) . fst) commands+++---------------------- The main function and stuff ------------------------------++main :: IO ()+main = do args <- getArgs+          case args of+            (c:restArgs) -> maybe (noCommand args) (runCmd restArgs) $ lookup c commands+            _ -> errorBailout ["empty command line"]+     where runCmd    = flip ($)+           noCommand = parseOpts >=> run++run :: Options -> IO ()+run (Options{..}) = do+  when optVersion $ printVersion+  when optHelp    $ printHelp+  where printHelp    = putStrLn $ usage []+        printVersion = putStrLn $ "raaz: " ++ showVersion version+++-- | Bail out on error+errorBailout :: [String]-> IO a+errorBailout errs = do+  hPutStrLn stderr $ usage errs+  exitFailure

@@ -1,316 +0,0 @@-Introduction-============--This is the generalised version of sha1sum/sha256sum/sha512sum-programs that are available on a standard linux system. It supports-generating checksum files and verifying them for all the hashes-exposed by the raaz library. The purpose of writing this application-is the following.--1. To give an example of of a non-trivial program written to use the-   raaz library.--2. To make sure that the implementations of hashes in this library are-   not too off in terms of performance.--The command line options of this program is similar to that of sha1sum-and hence can be used as a replacement.--This file is a literate haskell file and hence can be compiled-directly. The text is in markdown and hence you should be able to-produce the documentation for--We start by enabling some pragmas and importing some stuff which can-be ignored.--> {-# LANGUAGE GADTs           #-}-> {-# LANGUAGE RankNTypes      #-}-> {-# LANGUAGE RecordWildCards #-}-> {-# LANGUAGE ConstraintKinds #-}--> import Control.Applicative-> import Control.Monad-> import Data.List             (intercalate)-> import Data.String-> import Data.Version          (showVersion)-> import System.Environment-> import System.Exit-> import System.IO             (stdin, stderr, hPutStrLn)-> import System.Console.GetOpt--> import Raaz     hiding (Result)---Verification Tokens----------------------Programs like sha1sum is typically used to verify that the contents of-a set of files have not been modified or corrupted. This program does-the following:--1. In compute mode it computes a set of verification tokens which-   uniquely identify the contents of the file.--2. In verification mode it takes a set of tokens are verify them.--Verification tokens are computed using the cryptographic hash. We-allow the use of any of the hashes exposed by the raaz library. Thus-for us, any hash that satisfies the constraint `TokenHash` should be-usable in computing and verifying tokens.---> type TokenHash h = (Hash h, Recommendation h, Show h, IsString h)->--The verification token is defined below. To make it opaque, we-existentially quantify over the underlying digest.-->-> data Token  = forall h . TokenHash h->             => Token { tokenFile    :: FilePath->                      , tokenDigest  :: h->                      }->--The verification is quite simple and works opaquely.--> verify :: Token -> IO Bool-> verify (Token{..}) = (==tokenDigest) <$> hashFile tokenFile----Computing Tokens.--------------------For computing we need to somehow get access to the underlying hash-algorithm. We should be able to specify the algorithm-to use as an argument for the computing functions.--> -- | Compute the token using a given algorithm.-> token :: TokenHash h->       => Algorithm h  -- ^ The hashing algorithm to use.->       -> FilePath     -- ^ The file to compute the token for.->       -> IO Token---The algorithm data type is just a proxy which we define as follows.--> data Algorithm h   = Algorithm--Using the above proxy type we can define the token computation-function.--> token algo fp = Token fp <$> hashIt algo->   where hashIt :: TokenHash h => Algorithm h -> IO h->         hashIt _ = hashFile fp->--This function computes the verification token for the standard input.--> tokenStdin :: TokenHash h => Algorithm h -> IO Token-> tokenStdin algo = Token "-" <$> hashIt algo->   where hashIt :: TokenHash h => Algorithm h -> IO h->         hashIt _ = hashSource stdin->---Printed form of tokens--------------------------To inter-operate with programs like sha1sum, we follow the same-printed notation. The appropriate show instances for token is the-following.--> instance Show Token where->   show (Token{..}) = show tokenDigest ++ "  " ++ tokenFile--We also define the associated parsing function which has to take the-the underlying algorithm as a parameter.--> parse :: TokenHash h => Algorithm h -> String -> Token-> parse algo str      = Token { tokenFile   = drop 2 rest->                             , tokenDigest = parseDigest algo digest->                             }->   where parseDigest    :: TokenHash h => Algorithm h -> String -> h->         parseDigest _  = fromString->         (digest, rest) = break (==' ') str----We now need an easy way to tabulate all the hash algorithm that we-support. Existential types comes to the rescue once more.--> data SomeAlgorithm = forall h . TokenHash h =>->                      SomeAlgorithm (Algorithm h)--This is the table of algorithms that we support.  are given below.--> algorithms :: [(String, SomeAlgorithm)]-> algorithms =  [ ("sha1"  , SomeAlgorithm (Algorithm :: Algorithm SHA1)   )->               , ("sha256", SomeAlgorithm (Algorithm :: Algorithm SHA256) )->               , ("sha512", SomeAlgorithm (Algorithm :: Algorithm SHA512) )->               ]--The main function.---------------------There are two important modes of operation for this program. In the-first mode the--> computeMode :: SomeAlgorithm->             -> [FilePath]->             -> IO ()-> computeMode (SomeAlgorithm algo) files->   | null files = tokenStdin algo >>= print->   | otherwise  = mapM_ printToken files->   where printToken = token algo >=> print---The verification mode of the algorithm.--> verifyMode :: ( FilePath -> IO () ) -- ^ What to do for success.->            -> ( FilePath -> IO () ) -- ^ What to do for failure->            -> ( Int      -> IO () ) -- ^ Do something with the number.->            -> SomeAlgorithm->            -> [FilePath]->            -> IO ()->-> verifyMode okey failed printCount (SomeAlgorithm algo) files->   | null files = getContents >>= verifyInput 0 >>= result->   | otherwise  = verifyManyFiles files >>= result->   where->     parseTokens       = map (parse algo) . lines->     result n          = do printCount n->                            if (n > 0) then exitFailure->                              else exitSuccess->     -- Verify a list of files->     verifyManyFiles   = foldM verifyFile 0->     -- Verify a single file.->     verifyFile  n fp  = readFile fp          >>= verifyInput n->     -- verify all the digests listed in the given argument string.->     verifyInput n     = return . parseTokens >=> foldM verifyOne n->     -- Verify a single token and keep track of the total number of->     -- failures.->     verifyOne  n tok  = do->       status <- verify tok->       if status then do okey   $ tokenFile tok; return n->                 else do failed $ tokenFile tok; return (n+1)->---The main function.---------------------> main :: IO ()-> main =  parseOpts >>= handleArgs->-> handleArgs :: (Options, [FilePath])->            -> IO ()-> handleArgs (Options{..}, files) = do->   when optHelp printHelp->   when optVersion printVersion->   flip (either badAlgo) optAlgo $ \ algo ->->     if optCheck->     then verifyMode optOkey optFailed optPrintCount algo files->     else computeMode algo files->   where badAlgo name = errorBailout ["Bad hash algorithm " ++ name]-----This function prints the help for the program.--> printHelp :: IO ()-> printHelp = do putStrLn $ usage []->                exitSuccess--and this prints the version information.--> printVersion :: IO ()-> printVersion = do putStrLn $ "checksum: raaz-" ++ showVersion version->                   exitSuccess->---Command line parsing-----------------------We use the getOpts library to parse the command lines.  The options-are summarised in the following list.--> options :: [OptDescr (Options -> Options)]-> options =->   [ Option ['v'] ["version"] (NoArg setVersion) "print the version"->   , Option ['h'] ["help"]    (NoArg setHelp)    "print the help"->   , Option ['c'] ["check"]   (NoArg setCheck)   "check instead of compute"->   , Option ['q'] ["quiet"]   (NoArg setQuiet)   "print failure only"->   , Option ['s'] ["status"]  (NoArg setStatusOnly)->     "no output only return status"->   , Option ['a'] ["algo"]    (ReqArg setAlgo "HASH")->     $ "hash algorithm to use " ++ "(" ++ algOpts ++ ")"->   ]->   where setVersion opt   = opt { optVersion = True }->         setHelp    opt   = opt { optHelp    = True }->         setCheck   opt   = opt { optCheck   = True }->         setAlgo  str opt = opt { optAlgo    = a    }->                  where a = maybe (Left str) Right $ lookup str algorithms->         algOpts          = intercalate "|" $ map fst algorithms->         setQuiet      opt = opt          { optOkey   = noPrint }->         setStatusOnly opt = setQuiet opt { optFailed = noPrint->                                          , optPrintCount  = returnStatus->                                          }->         noPrint           = const $ return ()->         returnStatus n->           | n > 0         = exitFailure->           | otherwise     = exitSuccess->---The options data type. Fields should be self explanatory.--> data Options =->   Options { optVersion :: Bool->           , optHelp    :: Bool->           , optCheck   :: Bool->           , optAlgo    :: Either String SomeAlgorithm->           , optOkey    :: FilePath -> IO () -- ^ handle successful tokens->           , optFailed  :: FilePath -> IO () -- ^ handle failed tokens.->           , optPrintCount   :: Int -> IO () -- ^ print failure counts.->           }--The default options for the command is as follows.--> defOpts =->   Options { optVersion    = False->           , optHelp       = False->           , optCheck      = False->           , optAlgo       = Right sha1Algorithm->           , optOkey       = \ fp -> putStrLn (fp ++ ": OK")->           , optFailed     = \ fp -> putStrLn (fp ++ ": FAILED")->           , optPrintCount = printCount->           }->   where sha1Algorithm = SomeAlgorithm (Algorithm :: Algorithm SHA1)->         printCount n  = when (n > 0) $ do->           putStrLn $ show n ++ " failures."--The usage message for the program.--> usage :: [String] -> String-> usage errs = "checksum: " ++ unlines errs ++ usageInfo header options->   where header ="Usage: checksum [OPTIONS] FILE1 FILE2"--Parsing the options.--> parseOpts :: IO (Options, [FilePath])-> parseOpts = do args  <- getArgs->                case getOpt Permute options args of->                  (o,n,[])   -> return (foldl (flip id) defOpts o, n)->                  (_,_,errs) -> errorBailout errs--Bail out with an error message.--> errorBailout :: [String]-> IO a-> errorBailout errs = do->   hPutStrLn stderr $ usage errs->   exitFailure

@@ -0,0 +1,53 @@+#pragma once++#include <stdint.h>+#include <inttypes.h>+#include <raaz/core/endian.h>++typedef uint32_t Word;+typedef Word     State[16];+typedef Word     Block[16];++/* Implementation in accordance to RFC7539+ * https://tools.ietf.org/html/rfc7539+ *+ * Note that there is a difference in the rfc and the version+ * published by djb.  In the rfc one uses 32-bit counter and 96-bit+ * nounce, whereas the published version of djb uses 64bit counter and+ * 64bit nounce.+ *+ * As a result the maximum data that should be encrypted with this+ * cipher (for a given key, iv pair).+ *+ * 2^32 blocks = 256 GB.+ *+ */++typedef uint32_t Counter;+typedef Word     IV[3];+typedef Word     Key[8];++# define BLOCK_SIZE       (sizeof(State))++#define C0 ((Word) 0x61707865)+#define C1 ((Word) 0x3320646e)+#define C2 ((Word) 0x79622d32)+#define C3 ((Word) 0x6b206574)+++/* Vector types */++# ifdef HAVE_VECTOR_128+/* Type of 128-bit SIMD instructions */+typedef Word Vec  __attribute__ ((vector_size (16)));+# endif++# ifdef HAVE_VECTOR_256+/* Type of 256-bit SIMD instructions */+typedef Word Vec2 __attribute__ ((vector_size (32)));+# endif++# ifdef HAVE_VECTOR_512+/* Type of 512-bit SIMD instructions */+typedef Word Vec4 __attribute__ ((vector_size (64)));+# endif

@@ -0,0 +1,126 @@+#include "common.h"++/* The main chacha20 block transform for a complete block of data.+ *+ * Maximum bytes that should be encoded is 2^32 * 64 = 256GB.  The+ * counter repeats after that.+ *+ */++++/* Warnings all macros are unprotected use with care */++# define R(x,i) ((x << i) | (x >> (32 - i)))++# define QROUND(a,b,c,d)			\+    {						\+	a += b; d ^= a; d = R(d,16);		\+	c += d; b ^= c; b = R(b,12);		\+	a += b; d ^= a; d = R(d,8);		\+	c += d; b ^= c; b = R(b,7);		\+    }						\++++# define ROUND			  \+    {				  \+	QROUND(x0, x4, x8,  x12); \+	QROUND(x1, x5, x9,  x13); \+	QROUND(x2, x6, x10, x14); \+	QROUND(x3, x7, x11, x15); \+	QROUND(x0, x5, x10, x15); \+	QROUND(x1, x6, x11, x12); \+	QROUND(x2, x7, x8,  x13); \+	QROUND(x3, x4, x9,  x14); \+    }+++# define XOR(i,a)    (*msg)[i] ^= raaz_tole32(a)+# define EMIT(i,a)   (*msg)[i]  = a++/*++Some function for debugging.++# define PR(i)        printf("%8x  ", x##i)+# define PRM(i)       printf("%8x  ", (*msg)[i])+# define NEWLINE      printf("\n")+# define PRINTSTATE				\+    {						\+    PR(0); PR(1);   PR(2);    PR(3); NEWLINE;	\+    PR(4); PR(5);   PR(6);    PR(7); NEWLINE;	\+    PR(8); PR(9);   PR(10);   PR(11); NEWLINE;	\+    PR(12); PR(13); PR(14); PR(15); NEWLINE;	\+    }++# define PRINTMESG				\+    {						\+    PRM(0); PRM(1);   PRM(2);    PRM(3); NEWLINE;	\+    PRM(4); PRM(5);   PRM(6);    PRM(7); NEWLINE;	\+    PRM(8); PRM(9);   PRM(10);   PRM(11); NEWLINE;	\+    PRM(12); PRM(13); PRM(14); PRM(15); NEWLINE;	\+    }++*/++# ifdef __GNUC__++typedef Block MyBlock __attribute__ ((aligned (32)));++void raazChaCha20Block(MyBlock * msg, int nblocks, const Key key, const IV iv, Counter  *ctr)++# else++void raazChaCha20Block(Block * msg, int nblocks, const Key key, const IV iv, Counter  *ctr)++#endif++{+    register Word x0,  x1,  x2, x3;+    register Word x4,  x5,  x6, x7;+    register Word x8,  x9,  x10, x11;+    register Word x12, x13, x14, x15;+    register Word valCtr; /* value of the ctr */++    valCtr = *ctr;+    while( nblocks > 0){+++	x0  = C0     ; x1  = C1     ; x2  = C2     ; x3  = C3     ;+	x4  = key[0] ; x5  = key[1] ; x6  = key[2] ; x7  = key[3] ;+	x8  = key[4] ; x9  = key[5] ; x10 = key[6] ; x11 = key[7] ;+	x12 = valCtr ; x13 = iv[0]  ; x14 = iv[1]  ; x15 = iv[2]  ;+++	ROUND; /* 0,1   */+	ROUND; /* 2,3   */+	ROUND; /* 4,5   */+	ROUND; /* 6,7   */+	ROUND; /* 8,9   */+	ROUND; /* 10,11 */+	ROUND; /* 12,13 */+	ROUND; /* 14,15 */+	ROUND; /* 16,17 */+	ROUND; /* 18,19 */++++	x0  += C0     ; x1  += C1     ; x2  += C2     ; x3  += C3     ;+	x4  += key[0] ; x5  += key[1] ; x6  += key[2] ; x7  += key[3] ;+	x8  += key[4] ; x9  += key[5] ; x10 += key[6] ; x11 += key[7] ;+	x12 += valCtr ; x13 += iv[0]  ; x14 += iv[1]  ; x15 += iv[2]  ;+++	XOR(0,x0)   ; XOR(1, x1) ; XOR(2, x2)   ; XOR(3,  x3)  ;+	XOR(4,x4)   ; XOR(5, x5) ; XOR(6, x6)   ; XOR(7,  x7)  ;+	XOR(8,x8)   ; XOR(9, x9) ; XOR(10, x10) ; XOR(11, x11) ;+	XOR(12,x12) ; XOR(13,x13); XOR(14, x14) ; XOR(15, x15) ;+++	++ valCtr;+	--nblocks; ++msg; /* move to the next block */+    }+    *ctr = valCtr;         /* increment counter      */+    return;+}

@@ -0,0 +1,175 @@+#include "common.h"+++# define R(x,i) (  (x << ((Vec){i,i,i,i})) | (x >> ((Vec){32 - i, 32 - i, 32 - i, 32 - i})))++# define QROUND(a,b,c,d)			\+    {						\+	a += b; d ^= a; d = R(d,16);		\+	c += d; b ^= c; b = R(b,12);		\+	a += b; d ^= a; d = R(d,8);		\+	c += d; b ^= c; b = R(b,7);		\+    }						\++/*++  r0 = x0 x1 x2  x3+  r1 = x4 x5 x6  x7+  r2 = x8 x9 x10 x11+  r3 = x12 x13 x14 x15++  QROUND(r0, r1, r2, r3) : Handles row o++  d0 = x0  x1    x2   x3+  d1 = x5  x6    x7   x4+  d2 = x10 x11   x8   x9+  d3 = x15 x12   x13  x14++ */++# ifdef __clang__+#   define SIG  1 , 2 , 3 , 0+#   define SIG2 2 , 3 , 0 , 1+#   define SIG3 3 , 0 , 1 , 2+++#   define ISIG  SIG3+#   define ISIG2 SIG2+#   define ISIG3 SIG++#   define TODIAG					\+    {							\+	B = __builtin_shufflevector(B, B, SIG  );	\+	C = __builtin_shufflevector(C, C, SIG2 );	\+	D = __builtin_shufflevector(D, D, SIG3 );	\+    }++#   define TOROW					\+    {							\+	B = __builtin_shufflevector(B, B, ISIG  );	\+	C = __builtin_shufflevector(C, C, ISIG2 );	\+	D = __builtin_shufflevector(D, D, ISIG3 );	\+    }++# else++#   define SIG  ((Vec){ 1 , 2 , 3 , 0 })+#   define SIG2 ((Vec){ 2 , 3 , 0 , 1 })+#   define SIG3 ((Vec){ 3 , 0 , 1 , 2 })+++#   define ISIG  ((Vec){ 3 , 0 , 1 , 2 })+#   define ISIG2 ((Vec){ 2 , 3 , 0  ,1 })+#   define ISIG3 ((Vec){ 1 , 2 , 3 , 0 })++++#   define TODIAG				\+    {						\+	B = __builtin_shuffle ( B, SIG  );	\+	C = __builtin_shuffle ( C, SIG2 );	\+	D = __builtin_shuffle ( D, SIG3 );	\+    }+++#   define TOROW		      \+    {				      \+	B = __builtin_shuffle(B, ISIG  );	\+	C = __builtin_shuffle(C, ISIG2 );	\+	D = __builtin_shuffle(D, ISIG3 );	\+    }+++#endif+++# define ROUND							\+     { QROUND(A,B,C,D); TODIAG; QROUND(A,B,C,D); TOROW; }+++# define XORA(i) (*msg)[i] ^= raaz_tole32( A[i]    )+# define XORB(i) (*msg)[i] ^= raaz_tole32( B[i-4]  )+# define XORC(i) (*msg)[i] ^= raaz_tole32( C[i-8]  )+# define XORD(i) (*msg)[i] ^= raaz_tole32( D[i-12] )+++# define ChaChaConstantRow  ((Vec){ C0     , C1     , C2     ,  C3    })+++++# if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__+#   define INP(i) (((Vec *)msg)[i])+#   define WR(i,R) { MSG  = INP(i); MSG ^= R; INP(i) = MSG; }+#   define WRITE { WR(0,A); WR(1,B); WR(2,C); WR(3,D); }+# else+#   define XORA(i) (*msg)[i] ^= raaz_tole32( A[i]    )+#   define XORB(i) (*msg)[i] ^= raaz_tole32( B[i-4]  )+#   define XORC(i) (*msg)[i] ^= raaz_tole32( C[i-8]  )+#   define XORD(i) (*msg)[i] ^= raaz_tole32( D[i-12] )+#   define WRITE                                        \+    {   XORA(0)  ; XORA(1)  ; XORA(2)  ; XORA(3);       \+        XORB(4)  ; XORB(5)  ; XORB(6)  ; XORB(7);       \+        XORC(8)  ; XORC(9)  ; XORC(10) ; XORC(11);      \+        XORD(12) ; XORD(13) ; XORD(14) ; XORD(15);      \+    }+#  endif /* Byte order */+++/* One should ensure that msg is aligned to 16 bytes. */+static inline void chacha20vec128(Block *msg, int nblocks, const Key key, const IV iv, Counter *ctr)+{+    register Vec A , B, C, D;+    register Vec M1, M2, M3;+    register Vec MSG;++    /* TODO: Optimise with vector load (take care of alignments) */++    M1 =  (Vec){ key[0] , key[1] , key[2] , key[3] };+    M2 =  (Vec){ key[4] , key[5] , key[6] , key[7] };+    M3 =  (Vec){ *(ctr) , iv[0]  ,  iv[1] , iv[2]  };++    *ctr += nblocks;++    for(; nblocks > 0; -- nblocks, ++msg)+    {+	/* Initialise the state;+	   Except for the counter everything is the same+	 */++	A = ChaChaConstantRow;+	B = M1; C = M2; D = M3;++	ROUND; /* 0,1   */+	ROUND; /* 2,3   */+	ROUND; /* 4,5   */+	ROUND; /* 6,7   */+	ROUND; /* 8,9   */+	ROUND; /* 10,11 */+	ROUND; /* 12,13 */+	ROUND; /* 14,15 */+	ROUND; /* 16,17 */+	ROUND; /* 18,19 */++	A += ChaChaConstantRow;+++	B += M1;+	C += M2;+	D += M3;++	/* TODO: Optimise with vector load (take care of+	 * alignments) */++	WRITE;++	++M3[0];         /* increment counter      */++    }+    return;+}++void raazChaCha20BlockVector(Block *msg, int nblocks, const Key key, const IV iv, Counter *ctr)+{+    chacha20vec128(msg, nblocks, key, iv, ctr);+}

@@ -0,0 +1,179 @@+#include "common.h"++# define R(x,i) (                                                       \+        (x << (Vec2){i,i,i,i,i,i,i,i}) |                                \+        (x >> (Vec2){32 -i, 32 - i, 32 -i, 32 -i, 32 -i, 32 - i, 32 - i , 32 - i }) \+        )++/*+# define R(x,i) ( (x << i) | (x >> (32 - i)))+*/++# define QROUND(a,b,c,d)                        \+    {                                           \+        a += b; d ^= a; d = R(d,16);            \+        c += d; b ^= c; b = R(b,12);            \+        a += b; d ^= a; d = R(d,8);             \+        c += d; b ^= c; b = R(b,7);             \+    }                                           \++++/*++  r0 = x0 x1 x2  x3+  r1 = x4 x5 x6  x7+  r2 = x8 x9 x10 x11+  r3 = x12 x13 x14 x15++  QROUND(r0, r1, r2, r3) : Handles row o++  d0 = x0  x1    x2   x3+  d1 = x5  x6    x7   x4+  d2 = x10 x11   x8   x9+  d3 = x15 x12   x13  x14++ */++++# define SIG       1 , 2 , 3 , 0 , 5  , 6  , 7  , 4+# define SIG2      2 , 3 , 0 , 1 , 6  , 7  , 4  , 5+# define SIG3      3 , 0 , 1 , 2 , 7  , 4  , 5  , 6+# define MASK_LOW  0 , 1 , 2 , 3 , 8  , 9  , 10 , 11+# define MASK_HIGH 4 , 5 , 6 , 7 , 12 , 13 , 14 , 15++# define ISIG  SIG3+# define ISIG2 SIG2+# define ISIG3 SIG++#ifdef __clang__++#     define SIGMA(X)   (__builtin_shufflevector( X, X, SIG))+#     define SIGMA2(X)  (__builtin_shufflevector( X, X, SIG2))+#     define SIGMA3(X)  (__builtin_shufflevector( X, X, SIG3))+#     define ISIGMA(X)  (__builtin_shufflevector( X, X, ISIG))+#     define ISIGMA2(X) (__builtin_shufflevector( X, X, ISIG2))+#     define ISIGMA3(X) (__builtin_shufflevector( X, X, ISIG3))++#     define MERGE_LOW(X,Y)  (__builtin_shufflevector(X,Y, MASK_LOW))+#     define MERGE_HIGH(X,Y) (__builtin_shufflevector(X,Y, MASK_HIGH))++#else+++#     define SIGMA(X)   (__builtin_shuffle( X, (Vec2){SIG}))+#     define SIGMA2(X)  (__builtin_shuffle( X, (Vec2){SIG2}))+#     define SIGMA3(X)  (__builtin_shuffle( X, (Vec2){SIG3}))+#     define ISIGMA(X)  (__builtin_shuffle( X, (Vec2){ISIG}))+#     define ISIGMA2(X) (__builtin_shuffle( X, (Vec2){ISIG2}))+#     define ISIGMA3(X) (__builtin_shuffle( X, (Vec2){ISIG3}))++#     define MERGE_LOW(X,Y)  (__builtin_shuffle(X,Y, (Vec2){MASK_LOW} ))+#     define MERGE_HIGH(X,Y) (__builtin_shuffle(X,Y, (Vec2){MASK_HIGH}))++#endif++#  define TODIAG { B = SIGMA(B) ; C = SIGMA2(C) ; D = SIGMA3(D); }+#  define TOROW	 { B = ISIGMA(B); C = ISIGMA2(C); D = ISIGMA3(D); }+++# define ROUND              { QROUND(A,B,C,D); TODIAG; QROUND(A,B,C,D); TOROW; }+# define ChaChaConstantRow  (Vec2){ C0 , C1 , C2 , C3, C0 , C1 , C2  , C3}++# define LOW(X)          ((Vec){X[0],X[1],X[2],X[3]})+# define HIGH(X)         ((Vec){X[4],X[5],X[6],X[7]})++# if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__+#   define ADJUST_ENDIAN(A) {} /* do nothing */+# else+#   define SWAP(A,i) bswap_32(A[i])+#   define ADJUST_ENDIAN(A) {					   \+	A  = (Vec2){ SWAP(A,0), SWAP(A,1), SWAP(A,2), SWAP(A,3)	   \+		     SWAP(A,4), SWAP(A,5), SWAP(A,6), SWAP(A,7)};}+# endif++# define INP(i)            (((Vec*)msg)[i])+# define INP2(i)            (((Vec2*)msg)[i])++# ifdef HAVE_AVX2+#   define WRITE_LOW { 	MSG = MERGE_LOW(A,B); INP2(0) ^= MSG; MSG = MERGE_LOW(C,D); INP2(1) ^= MSG; }+#   define WRITE_HIGH { MSG = MERGE_HIGH(A,B); INP2(2) ^= MSG; MSG = MERGE_HIGH(C,D); INP2(3) ^= MSG; }+# else+#   define WRITE_LOW { INP(0) ^= LOW(A); INP(1) ^= LOW(B); INP(2) ^= LOW(C); INP(3) ^= LOW(D); }+#   define WRITE_HIGH { INP(4) ^= HIGH(A); INP(5) ^= HIGH(B); INP(6) ^= HIGH(C); INP(7) ^= HIGH(D); }+# endif++# define EMIT(X,i) ((Vec2 *)msg)[i] = X++void raazChaCha20BlockVector256(Block *msg, int nblocks, const Key key, const IV iv, Counter *ctr)+{++    register Vec2 A , B, C, D;+    register Vec2 M1, M2, M3;+    register Vec2 MSG;++    M1 =  (Vec2){+        key[0] , key[1] , key[2] , key[3],+        key[0] , key[1] , key[2] , key[3]+    };+    M2 =  (Vec2){+        key[4] , key[5] , key[6] , key[7],+        key[4] , key[5] , key[6] , key[7]+    };++    M3 =  (Vec2){+        *(ctr)   , iv[0]  ,  iv[1] , iv[2],+        *(ctr)+1 , iv[0]  ,  iv[1] , iv[2]+    };++    *ctr += nblocks;+    while(nblocks > 0)+    {+        /* Initialise the state;+           Except for the counter everything is the same+         */+++        A = ChaChaConstantRow;+        B = M1; C = M2; D = M3;++        ROUND; /* 0,1   */+        ROUND; /* 2,3   */+        ROUND; /* 4,5   */+        ROUND; /* 6,7   */+        ROUND; /* 8,9   */+        ROUND; /* 10,11 */+        ROUND; /* 12,13 */+        ROUND; /* 14,15 */+        ROUND; /* 16,17 */+        ROUND; /* 18,19 */++        A += ChaChaConstantRow;+++        B += M1;+        C += M2;+        D += M3;++++	/* Writing the stream */+++	ADJUST_ENDIAN(A); ADJUST_ENDIAN(B); ADJUST_ENDIAN(C); ADJUST_ENDIAN(D);++	WRITE_LOW; /* Write the lower block */++	if( nblocks == 1) break; /* nblocks was odd and hence we are done */+++	WRITE_HIGH;++	/* Move by two blocks at a time.	 */+	nblocks -= 2;   msg += 2;+	M3 += (Vec2){2,0,0,0,2,0,0,0};+    }++   return;+}

@@ -1,161 +1,94 @@-# include <raaz/core/endian.h>-/*- * 32-bit Little endian  load and store+#include <raaz/core/endian.h>+#ifdef __RAAZ_REQUIRE_PORTABLE_ENDIAN__++/* We were not able to detect the optimised platform specific versions+ * of the low level endian functions. We now proceed to define a+ * portable variant so that the extern declarations is satisfied.  */ -uint32_t raazLoadLE32(uint32_t *wPtr)-{-#if defined(PLATFORM_LINUX) || defined(PLATFORM_OPENBSD) || defined(PLATFORM_BSD)-  return htole32(*wPtr);-#else-  unsigned char *ptr;-  ptr = (unsigned char *) wPtr;-  return ((uint32_t)  (ptr[0]))-      |  (((uint32_t) (ptr[1])) << 8)-      |  (((uint32_t) (ptr[2])) << 16)-      |  (((uint32_t) (ptr[3])) << 24)-    ;-#endif-} -void raazStoreLE32(uint32_t *wPtr , uint32_t w)-{-#if defined(PLATFORM_LINUX) || defined(PLATFORM_OPENBSD)-    *wPtr = le32toh(w);-#elif defined(PLATFORM_BSD)-    *wPtr = letoh32(w);-#else-    unsigned char *ptr;-    ptr = (unsigned char *) wPtr;-    ptr[0] = (unsigned char) w;-    ptr[1] = (unsigned char) (w >> 8);-    ptr[2] = (unsigned char) (w >> 16);-    ptr[3] = (unsigned char) (w >> 24);-#endif-    return;-}  /*- * 32-bit Big endian  load and store+ *  These are declared as macros because they will work for both+ *  32-bit as well as 64-bit cases.  */ -uint32_t raazLoadBE32(uint32_t *wPtr)+# define MASK(i)       (0xFFULL << (8*(i))) /* mask to select the ith byte              */+# define SEL(a,i)      ((a) & MASK(i))      /* select the ith byte                      */+# define MOVL(a,i)      ((a) << (8*(i)))    /* shift the bytes i positions to the left  */+# define MOVR(a,i)      ((a) >> (8*(i)))    /* shift the bytes i positions to the right */+# define SWAP(a,i,j)   (MOVL(SEL(a,i),(j-i)) | MOVR(SEL(a,j), (j - i)))+                       /* This function swaps the ith and jth bytes and sets other bytes to 0 */+++uint32_t raaz_bswap32(uint32_t a){ return (SWAP(a,0,3) | SWAP(a,1,2)); }+uint64_t raaz_bswap64(uint64_t a){ return (SWAP(a,0,7) | SWAP(a,1,6)  | SWAP(a,2,5) | SWAP(a,3,4)); }++++++# define TO32(x)     ((uint32_t)(x))+# define TO64(x)     ((uint64_t)(x))++# define B32(ptr,i) (TO32(ptr[i]))+# define B64(ptr,i) (TO64(ptr[i]))++/* Make a 32-bit quantity out of the 4 bytes given in MSB first order */+# define MK32(a,b,c,d) ( (a) << 24 | (b) << 16 | (c) << 8 | (d) )++/* Similar to MK32 but for 64-bit quantities */+# define MK64(a,b,c,d,e,f,g,h)  \+    ((a) <<  56  | (b) << 48   | (c) << 40 | (d) << 32	| (e) << 24   | (f) << 16   | (g) << 8  | (h))+++uint32_t raaz_tobe32(uint32_t x) {-#if defined(PLATFORM_LINUX) || defined(PLATFORM_OPENBSD) || defined(PLATFORM_BSD)-    return htobe32(*wPtr);-#else-  unsigned char *ptr;-  ptr = (unsigned char *) wPtr;-  return ((uint32_t)  (ptr[3]))-    |    (((uint32_t) (ptr[2])) << 8)-    |    (((uint32_t) (ptr[1])) << 16)-    |    (((uint32_t) (ptr[0])) << 24)-    ;-#endif+    uint8_t *ptr = (uint8_t *) &x;+    return MK32(B32(ptr,0), B32(ptr,1), B32(ptr,2), B32(ptr,3)); } -void raazStoreBE32(uint32_t *wPtr , uint32_t w)++uint32_t raaz_tole32(uint32_t x) {-#if defined(PLATFORM_LINUX) || defined(PLATFORM_OPENBSD)-    *wPtr = be32toh(w);-#elif defined(PLATFORM_BSD)-    *wPtr = betoh32(w);-#else-    unsigned char *ptr;-    ptr = (unsigned char *) wPtr;-    ptr[3] = (unsigned char) w;-    ptr[2] = (unsigned char) (w >> 8);-    ptr[1] = (unsigned char) (w >> 16);-    ptr[0] = (unsigned char) (w >> 24);-#endif-    return;-}+    uint8_t *ptr = (uint8_t *) &x;+    return MK32(B32(ptr,3), B32(ptr,2), B32(ptr,1), B32(ptr,0)); -/*- * 64-bit Little endian  load and store- */+} -uint64_t raazLoadLE64(uint64_t *wPtr)+uint64_t raaz_tobe64(uint64_t x) {-#if defined(PLATFORM_LINUX) || defined(PLATFORM_OPENBSD) || defined(PLATFORM_BSD)-  return htole64(*wPtr);-#else-  unsigned char *ptr;-  ptr = (unsigned char *) wPtr;-  return ((uint64_t) (ptr[0]))-      |  (((uint64_t) (ptr[1])) << 8)-      |  (((uint64_t) (ptr[2])) << 16)-      |  (((uint64_t) (ptr[3])) << 24)-      |  (((uint64_t) (ptr[4])) << 32)-      |  (((uint64_t) (ptr[5])) << 40)-      |  (((uint64_t) (ptr[6])) << 48)-      |  (((uint64_t) (ptr[7])) << 56)-    ;-#endif+    uint8_t *ptr = (uint8_t *) &x;+    return MK64(B64(ptr,0), B64(ptr,1), B64(ptr,2), B64(ptr,3),+		B64(ptr,4), B64(ptr,5), B64(ptr,6), B64(ptr,7)); } -void raazStoreLE64(uint64_t *wPtr , uint64_t w)++uint64_t raaz_tole64(uint64_t x) {-#if defined(PLATFORM_LINUX) || defined(PLATFORM_OPENBSD)-    *wPtr = le64toh(w);-#elif defined(PLATFORM_BSD)-    *wPtr = letoh64(w);-#else-    unsigned char *ptr;-    ptr = (unsigned char *) wPtr;-    ptr[0] = (unsigned char) w;-    ptr[1] = (unsigned char) (w >> 8);-    ptr[2] = (unsigned char) (w >> 16);-    ptr[3] = (unsigned char) (w >> 24);-    ptr[4] = (unsigned char) (w >> 32);-    ptr[5] = (unsigned char) (w >> 40);-    ptr[6] = (unsigned char) (w >> 48);-    ptr[7] = (unsigned char) (w >> 56);-#endif-    return;+    uint8_t *ptr = (uint8_t *) &x;+    return MK64(B64(ptr,7), B64(ptr,6), B64(ptr,5), B64(ptr,4),+		B64(ptr,3), B64(ptr,2), B64(ptr,1), B64(ptr,0)); }  -/*- * 64-bit Big endian  load and store++#endif++/* Finally we define the functions that are called by Haskell as FFI+ * routines for their endian store instances. These should not be+ * declared static inline.  */ -uint64_t raazLoadBE64(uint64_t *wPtr)+uint32_t raazSwap32(uint32_t a){ return raaz_bswap32(a);}+uint64_t raazSwap64(uint64_t a){ return raaz_bswap64(a);}++void raazSwap32Array(uint32_t *ptr, int n) {-#if defined(PLATFORM_LINUX) || defined(PLATFORM_OPENBSD) || defined(PLATFORM_BSD)-  return htobe64(*wPtr);-#else-  unsigned char *ptr;-  ptr = (unsigned char *) wPtr;-  return ((uint64_t) (ptr[7]))-      |  (((uint64_t) (ptr[6])) << 8)-      |  (((uint64_t) (ptr[5])) << 16)-      |  (((uint64_t) (ptr[4])) << 24)-      |  (((uint64_t) (ptr[3])) << 32)-      |  (((uint64_t) (ptr[2])) << 40)-      |  (((uint64_t) (ptr[1])) << 48)-      |  (((uint64_t) (ptr[0])) << 56)-    ;-#endif+    for(;n > 0; ++ptr, --n){*ptr = raaz_bswap32(*ptr);} } -void raazStoreBE64(uint64_t *wPtr , uint64_t w)+void raazSwap64Array(uint64_t *ptr, int n) {-#if defined(PLATFORM_LINUX) || defined(PLATFORM_OPENBSD)-    *wPtr = be64toh(w);-#elif defined(PLATFORM_BSD)-    *wPtr = betoh64(w);-#else-    unsigned char *ptr;-    ptr = (unsigned char *) wPtr;-    ptr[7] = (unsigned char) w;-    ptr[6] = (unsigned char) (w >> 8);-    ptr[5] = (unsigned char) (w >> 16);-    ptr[4] = (unsigned char) (w >> 24);-    ptr[3] = (unsigned char) (w >> 32);-    ptr[2] = (unsigned char) (w >> 40);-    ptr[1] = (unsigned char) (w >> 48);-    ptr[0] = (unsigned char) (w >> 56);-#endif-    return;+    for(;n > 0; ++ptr, --n){*ptr = raaz_bswap64(*ptr);} }

@@ -1,24 +1,74 @@-#ifndef __RAAZ_ENDIAN_H_-#define __RAAZ_ENDIAN_H_-#include <stdint.h>+# pragma once+# include <stdint.h> -/* Include the right header file based on the platform */-#ifdef PLATFORM_LINUX-#include <endian.h>-#elif defined(PLATFORM_BSD) || defined(PLATFORM_OPENBSD)-#include <sys/endian.h>-#endif+/* These are the C functions that are exported for FFI calls to+ * Haskell. Their definitions are available in endian.c+ */ -/* Loads */-extern uint32_t raazLoadLE32(uint32_t *);-extern uint32_t raazLoadBE32(uint32_t *);-extern uint64_t raazLoadLE64(uint64_t *);-extern uint64_t raazLoadBE64(uint64_t *);+extern uint32_t raazSwap32      (uint32_t a);+extern uint64_t raazSwap64      (uint64_t a);+extern void     raazSwap32Array (uint32_t *ptr, int n);+extern void     raazSwap64Array (uint64_t *ptr, int n); -/* Stores */-extern void raazStoreLE32(uint32_t *, uint32_t);-extern void raazStoreBE32(uint32_t *, uint32_t);-extern void raazStoreLE64(uint64_t *, uint64_t);-extern void raazStoreBE64(uint64_t *, uint64_t);++/* This header also give interface to low level byteswap and endian+ * conversion in a platform agnostic way to both to the Haskell FFI+ * functions declared above as well as to crypto primitives defined in+ * other c sources. The should not be used directly for FFI as they+ * most likely are defined static inline and included with the source.+ */+++#ifndef __GNUC__+#define __RAAZ_REQUIRE_PORTABLE_ENDIAN__++/*  We are unable to detect if the compiler is gcc or a compatible+ *  one. So we declare all the low level functions to be extern and+ *  expect their definitions to be in endian.c The above #define line+ *  is used to indicate that we are in such a situation+ */++extern uint32_t raaz_bswap32(uint32_t x);+extern uint64_t raaz_bswap64(uint64_t x);++extern uint32_t raaz_tobe32(uint32_t x);+extern uint64_t raaz_tobe64(uint64_t x);+extern uint32_t raaz_tole32(uint32_t x);+extern uint64_t raaz_tole64(uint64_t x);++#else++/* We are in GCC, so pick up the relevant platform specific functions+ * and wrap it in a static inline declaration. These+ */++#  ifdef PLATFORM_OSX+#    include <libkern/OSByteOrder.h> /* For PLATFORM OSX */++     static inline uint32_t raaz_bswap32(uint32_t x){ return OSSwapInt32(x); }+     static inline uint64_t raaz_bswap64(uint64_t x){ return OSSwapInt64(x); }++#  else /* For other systems */+#    include <byteswap.h>+     static inline uint32_t raaz_bswap32(uint32_t x){ return bswap_32(x); }+     static inline uint64_t raaz_bswap64(uint64_t x){ return bswap_64(x); }+#  endif++#  if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__++   static inline uint32_t raaz_tobe32(uint32_t x){ return raaz_bswap32(x); }+   static inline uint64_t raaz_tobe64(uint64_t x){ return raaz_bswap64(x); }++   static inline uint32_t raaz_tole32(uint32_t x){ return x; }+   static inline uint64_t raaz_tole64(uint64_t x){ return x; }++#  else+   static inline uint32_t raaz_tobe32(uint32_t x){ return x; }+   static inline uint64_t raaz_tobe64(uint64_t x){ return x; }++   static inline uint32_t raaz_tole32(uint32_t x){ return raaz_bswap32(x); }+   static inline uint64_t raaz_tole64(uint64_t x){ return raaz_bswap64(x); }++#  endif /* Byte order */  #endif