diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012, Piyush P Kurur + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Piyush P Kurur nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Raaz.hs b/Raaz.hs new file mode 100644 --- /dev/null +++ b/Raaz.hs @@ -0,0 +1,21 @@ +-- | This is the top-level module for the Raaz cryptographic library. +-- By importing this module you get a rather high-level access to the +-- primitives provided by the library. +module Raaz + ( version + , module Raaz.Cipher + , module Raaz.Core + , module Raaz.Hash + ) where + +import Data.Version (Version) +import qualified Paths_raaz as P + +import Raaz.Core +import Raaz.Hash +import Raaz.Cipher + + +-- | Raaz library version number. +version :: Version +version = P.version diff --git a/Raaz/Cipher.hs b/Raaz/Cipher.hs new file mode 100644 --- /dev/null +++ b/Raaz/Cipher.hs @@ -0,0 +1,17 @@ +-- | This module exposes all the ciphers provided by raaz. The +-- interface here is pretty low level and it is usually the case that +-- you would not need to work at this level of detail. +module Raaz.Cipher + ( -- * Ciphers + -- $cipherdoc$ + aes128cbc, aes192cbc, aes256cbc + ) where + + +import Raaz.Cipher.AES ( aes128cbc, aes192cbc, aes256cbc) + +-- $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. diff --git a/Raaz/Cipher/AES.hs b/Raaz/Cipher/AES.hs new file mode 100644 --- /dev/null +++ b/Raaz/Cipher/AES.hs @@ -0,0 +1,11 @@ +module Raaz.Cipher.AES + ( AES, KEY128, KEY192, KEY256, IV + -- * Some AES cipher modes. + , aes128cbc, aes192cbc, aes256cbc + , aes128ctr + ) where + +import Raaz.Cipher.AES.Internal +import Raaz.Cipher.AES.Recommendation() + +{-# ANN module "HLint: ignore Use import/export shortcut" #-} diff --git a/Raaz/Cipher/AES/CBC/Implementation/CPortable.hs b/Raaz/Cipher/AES/CBC/Implementation/CPortable.hs new file mode 100644 --- /dev/null +++ b/Raaz/Cipher/AES/CBC/Implementation/CPortable.hs @@ -0,0 +1,187 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +module Raaz.Cipher.AES.CBC.Implementation.CPortable + ( aes128cbcI, aes192cbcI, aes256cbcI + ) where + +import Control.Applicative +import Control.Monad.IO.Class ( liftIO ) +import Raaz.Core +import Raaz.Cipher.Internal +import Raaz.Cipher.AES.Internal + +------------- Memory for 128-bit cbc -------------- + +-- | Memory for aes-128-cbc +data M128 = M128 { m128ekey :: MemoryCell EKEY128 + , m128iv :: MemoryCell IV + } + +instance Memory M128 where + memoryAlloc = M128 <$> memoryAlloc <*> memoryAlloc + underlyingPtr = underlyingPtr . 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 + +------------- Memory for 192-bit cbc -------------- + +-- | Memory for aes-192-cbc +data M192 = M192 { m192ekey :: MemoryCell EKEY192 + , m192iv :: MemoryCell IV + } + +instance Memory M192 where + memoryAlloc = M192 <$> memoryAlloc <*> memoryAlloc + underlyingPtr = underlyingPtr . 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 + + +------------- Memory for 256-bit cbc -------------- + +-- | Memory for aes-256-cbc +data M256 = M256 { m256ekey :: MemoryCell EKEY256 + , m256iv :: MemoryCell IV + } + +instance Memory M256 where + memoryAlloc = M256 <$> memoryAlloc <*> memoryAlloc + underlyingPtr = underlyingPtr . 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 + +------------------- 128-bit CBC Implementation ---------------- + +-- | Implementation of 128-bit AES in CBC mode using Portable C. +aes128cbcI :: Implementation (AES 128 CBC) +aes128cbcI = SomeCipherI cbc128CPortable + +-- | 128-bit AES in CBC mode using Portable C. +cbc128CPortable :: CipherI (AES 128 CBC) M128 M128 +cbc128CPortable = + CipherI { cipherIName = "aes128cbc-cportable" + , cipherIDescription = + "128-bit AES in cbc mode implemented in Portable C" + , encryptBlocks = cbc128Encrypt + , decryptBlocks = cbc128Decrypt + } + +-- | The encryption action. +cbc128Encrypt :: Pointer -> BLOCKS (AES 128 CBC) -> MT M128 () +cbc128Encrypt buf nBlocks = + do eKeyPtr <- liftSubMT m128ekey getMemoryPointer + ivPtr <- liftSubMT m128iv getMemoryPointer + 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 + liftIO $ c_aes_cbc_d buf (fromEnum nBlocks) 10 eKeyPtr ivPtr + + + +------------------- 192-bit CBC Implementation ---------------- + +-- | Implementation of 192-bit AES in CBC mode using Portable C. +aes192cbcI :: Implementation (AES 192 CBC) +aes192cbcI = SomeCipherI cbc192CPortable + +-- | 192-bit AES in CBC mode using Portable C. +cbc192CPortable :: CipherI (AES 192 CBC) M192 M192 +cbc192CPortable = + CipherI { cipherIName = "aes192cbc-cportable" + , cipherIDescription = + "192-bit AES in cbc mode implemented in Portable C" + , encryptBlocks = cbc192Encrypt + , decryptBlocks = cbc192Decrypt + } + +-- | The encryption action. +cbc192Encrypt :: Pointer -> BLOCKS (AES 192 CBC) -> MT M192 () +cbc192Encrypt buf nBlocks = + do eKeyPtr <- liftSubMT m192ekey getMemoryPointer + ivPtr <- liftSubMT m192iv getMemoryPointer + 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 + liftIO $ c_aes_cbc_d buf (fromEnum nBlocks) 12 eKeyPtr ivPtr + +------------------- 256-bit CBC Implementation ---------------- + +-- | Implementation of 256-bit AES in CBC mode using Portable C. +aes256cbcI :: Implementation (AES 256 CBC) +aes256cbcI = SomeCipherI cbc256CPortable + +-- | 256-bit AES in CBC mode using Portable C. +cbc256CPortable :: CipherI (AES 256 CBC) M256 M256 +cbc256CPortable = + CipherI { cipherIName = "aes256cbc-cportable" + , cipherIDescription = + "256-bit AES in cbc mode implemented in Portable C" + , encryptBlocks = cbc256Encrypt + , decryptBlocks = cbc256Decrypt + } + +-- | The encryption action. +cbc256Encrypt :: Pointer -> BLOCKS (AES 256 CBC) -> MT M256 () +cbc256Encrypt buf nBlocks = + do eKeyPtr <- liftSubMT m256ekey getMemoryPointer + ivPtr <- liftSubMT m256iv getMemoryPointer + 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 + liftIO $ c_aes_cbc_d buf (fromEnum nBlocks) 14 eKeyPtr ivPtr + +--------------------- Foreign functions ------------------------ + +-- | Transpose AES matrices. +foreign import ccall unsafe + "raaz/cipher/aes/common.h raazAESTranspose" + c_transpose :: Int -> Pointer -> IO () + + +-- | CBC encrypt. +foreign import ccall unsafe + "raaz/cipher/aes/cportable.h raazAESCBCEncryptCPortable" + c_aes_cbc_e :: Pointer -- Input + -> Int -- number of blocks + -> Int -- rounds + -> Pointer -- extended key + -> Pointer -- iv + -> IO () +-- | CBC decrypt +foreign import ccall unsafe + "raaz/cipher/aes/cportable.h raazAESCBCDecryptCPortable" + c_aes_cbc_d :: Pointer -- Input + -> Int -- number of blocks + -> Int -- rounds + -> Pointer -- extened key + -> Pointer -- iv + -> IO () diff --git a/Raaz/Cipher/AES/Internal.hs b/Raaz/Cipher/AES/Internal.hs new file mode 100644 --- /dev/null +++ b/Raaz/Cipher/AES/Internal.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} + +module Raaz.Cipher.AES.Internal + (-- * AES cipher. + AES(..) + -- ** AES key types. + , KEY128, KEY192, KEY256 + , EKEY128, EKEY192, EKEY256, IV + , aes128cbc, aes192cbc, aes256cbc + , aes128ctr + ) where + +import Data.String +import Data.Word + +import Foreign.Ptr (castPtr ) +import Foreign.Storable (Storable, poke) +import GHC.TypeLits + + +import Raaz.Core +import Raaz.Cipher.Internal + +--------------- Basic types associated with AES ------------- + +-- | The type associated with AES ciphers. Raaz provides AES variants +-- with key lengths 128, 192 and 256. The key types for the above +-- ciphers in cbc mode are given by the types @(`KEY128`, IV)@, +-- @(`KEY192`, IV)@ @(`KEY256`, IV)@ respectively. +data AES (n :: Nat) (mode :: CipherMode) = AES + +-- | The basic word used in AES. +type WORD = BE Word32 + +-- | A tuple of AES words. +type TUPLE n = Tuple n WORD + +-- | Key used for AES-128 +newtype KEY128 = KEY128 (TUPLE 4) deriving (Storable, EndianStore) + + +-- | Key used for AES-128 +newtype KEY192 = KEY192 (TUPLE 6) deriving (Storable, EndianStore) + +-- | Key used for AES-128 +newtype KEY256 = KEY256 (TUPLE 8) deriving (Storable, EndianStore) + +instance Encodable KEY128 +instance Encodable KEY192 +instance Encodable KEY256 + +instance Random KEY128 +instance Random KEY192 +instance Random KEY256 + +-- | Expects in base 16 +instance IsString KEY128 where + fromString = fromBase16 + +-- | Shows in base 16 +instance Show KEY128 where + show = showBase16 + +-- | Expects in base 16 +instance IsString KEY192 where + fromString = fromBase16 + +-- | Shows in base 16 +instance Show KEY192 where + show = showBase16 + +-- | Expects in base 16 +instance IsString KEY256 where + fromString = fromBase16 + +-- | Shows in base 16 +instance Show KEY256 where + show = showBase16 + +--------------- AES CBC --------------------------------- + +-- | The IV used by the CBC mode. +newtype IV = IV (TUPLE 4) deriving (Storable, EndianStore) + +instance Encodable IV +instance Random IV + +-- | Expects in base16. +instance IsString IV where + fromString = fromBase16 + +-- | Shown as a its base16 encoding. +instance Show IV where + show = showBase16 + +----------------- AES 128 CBC ------------------------------ + +-- | 128-bit aes cipher in `CBC` mode. +aes128cbc :: AES 128 CBC +aes128cbc = AES + +-- | The 128-bit aes cipher in cbc mode. +instance Primitive (AES 128 CBC) where + blockSize _ = BYTES 16 + 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) + +instance Cipher (AES 128 CBC) + +----------------- AES 192 CBC -------------------------------- + +-- | 128-bit aes cipher in `CBC` mode. +aes192cbc :: AES 192 CBC +aes192cbc = AES + +-- | The 192-bit aes cipher in cbc mode. +instance Primitive (AES 192 CBC) where + blockSize _ = BYTES 16 + 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) + +instance Cipher (AES 192 CBC) + +------------------- AES 256 CBC ----------------------------- + +-- | 128-bit aes cipher in `CBC` mode. +aes256cbc :: AES 256 CBC +aes256cbc = AES + +-- | The 256-bit aes cipher in cbc mode. +instance Primitive (AES 256 CBC) where + blockSize _ = BYTES 16 + 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) + +instance Cipher (AES 256 CBC) + + +------------------- AES CTR mode --------------------------- + +-- | Smart constructors for AES 128 ctr. +aes128ctr :: AES 128 CTR +aes128ctr = AES + +-------------- Memory for storing extended keys --------- + +newtype EKEY128 = EKEY128 (TUPLE 44) deriving (Storable, EndianStore) +newtype EKEY192 = EKEY192 (TUPLE 52) deriving (Storable, EndianStore) +newtype EKEY256 = EKEY256 (TUPLE 60) deriving (Storable, EndianStore) + +instance Initialisable (MemoryCell EKEY128) KEY128 where + initialise k = withPointer $ pokeAndExpand k (c_expand 4) + +instance Initialisable (MemoryCell EKEY192) KEY192 where + initialise k = withPointer $ pokeAndExpand k (c_expand 6) + +instance Initialisable (MemoryCell EKEY256) KEY256 where + initialise k = withPointer $ pokeAndExpand k (c_expand 8) + +foreign import ccall unsafe + "raaz/cipher/aes/common.h raazAESExpand" + c_expand :: Int -> Pointer -> 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. + -> IO () +pokeAndExpand k expander ptr = poke (castPtr ptr) k >> expander ptr diff --git a/Raaz/Cipher/AES/Recommendation.hs b/Raaz/Cipher/AES/Recommendation.hs new file mode 100644 --- /dev/null +++ b/Raaz/Cipher/AES/Recommendation.hs @@ -0,0 +1,26 @@ +-- | This sets up the recommended implementation of various AES cipher +-- modes. + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +-- +-- The orphan instance declaration separates the implementation and +-- setting the recommended instances. Therefore, we ignore the warning. +-- + +module Raaz.Cipher.AES.Recommendation where + +import Raaz.Core +import Raaz.Cipher.Internal +import Raaz.Cipher.AES.Internal +import qualified Raaz.Cipher.AES.CBC.Implementation.CPortable as CPCBC + +instance Recommendation (AES 128 CBC) where + recommended _ = CPCBC.aes128cbcI + +instance Recommendation (AES 192 CBC) where + recommended _ = CPCBC.aes192cbcI + +instance Recommendation (AES 256 CBC) where + recommended _ = CPCBC.aes256cbcI diff --git a/Raaz/Cipher/Internal.hs b/Raaz/Cipher/Internal.hs new file mode 100644 --- /dev/null +++ b/Raaz/Cipher/Internal.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ConstraintKinds #-} + +-- | This module exposes the low-level internal details of ciphers. Do +-- not import this module unless you want to implement a new cipher or +-- give a new implementation of an existing cipher. +module Raaz.Cipher.Internal + ( + -- * Internals of a cipher. + -- $cipherdoc$ + Cipher, CipherMode(..) + -- ** Cipher implementation + , CipherI(..), SomeCipherI(..) + -- + -- ** Unsafe encryption and decryption. + -- $unsafecipher$ + -- + , unsafeEncrypt, unsafeDecrypt, unsafeEncrypt', unsafeDecrypt' + ) where + + +import Data.ByteString.Internal as IB +import Foreign.Ptr (castPtr) + +import Raaz.Core +import Raaz.Core.Util.ByteString as B + +-- $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. +-- +-- Implementations of ciphers 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 +-- used internally by the implementation. +-- +-- [`SomeCipherI`:] The existentially quantified version of `CipherI` +-- over its memory element. By wrapping the memory element inside the +-- existential quantifier, values of this type exposes only the +-- interface and not the internals of the implementation. The +-- `Implementation` associated type of a cipher is the type +-- `SomeCipherI` +-- +-- To support a new cipher, a developer needs to: +-- +-- 1. Define a new type which captures the cipher. This type should be +-- an instance of the class `Cipher`. +-- +-- 2. Define an implementation, i.e. a value of the type `SomeCipherI`. +-- +-- 3. Define a recommended implementation, i.e. an instance of the +-- type class `Raaz.Core.Primitives.Recommendation` +-- + + + +-- | Block cipher modes. +data CipherMode = CBC -- ^ Cipher-block chaining + | CTR -- ^ Counter + deriving (Show, Eq) + +-- | The implementation of a block cipher. +data CipherI cipher encMem decMem = CipherI + { cipherIName :: String + , cipherIDescription :: String + -- | The underlying block encryption function. + , encryptBlocks :: Pointer -> BLOCKS cipher -> MT encMem () + -- | The underlying block decryption function. + , decryptBlocks :: Pointer -> BLOCKS cipher -> MT decMem () + } + +instance Describable (CipherI cipher encMem decMem) where + name = cipherIName + description = cipherIDescription + + +instance Describable (SomeCipherI cipher) where + name (SomeCipherI cI) = name cI + description (SomeCipherI cI) = description cI + + +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) + => Cipher cipher + +------------------ Unsafe cipher operations ------------------------ + +-- $unsafecipher$ +-- +-- We expose some unsafe functions to encrypt and decrypt bytestrings. +-- These function works correctly only if the input byte string has a +-- length which is a multiple of the block size of the cipher and +-- hence are unsafe to use as general methods of encryption and +-- decryption of data. Use these functions for testing and +-- benchmarking and nothing else. +-- +-- There are multiple ways to handle arbitrary sized strings like +-- padding, cipher block stealing etc. They are not exposed here +-- though. + +-- | Encrypt 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. +unsafeEncrypt' :: Cipher c + => c -- ^ The cipher to use + -> Implementation c -- ^ The implementation to use + -> 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 + +-- | 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. +unsafeEncrypt :: (Cipher c, Recommendation c) + => c -- ^ The cipher + -> Key c -- ^ The key to use + -> ByteString -- ^ The string to encrypt + -> 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. +unsafeDecrypt' :: Cipher c + => c -- ^ The cipher to use + -> Implementation c -- ^ The implementation to use + -> 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 + +-- | Decrypt 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. +unsafeDecrypt :: (Cipher c, Recommendation c) + => c -- ^ The cipher + -> Key c -- ^ The key to use + -> ByteString -- ^ The string to encrypt + -> ByteString +unsafeDecrypt c = unsafeDecrypt' c $ recommended c diff --git a/Raaz/Core.hs b/Raaz/Core.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core.hs @@ -0,0 +1,27 @@ +{-| + +Core functions, data types and classes of the raaz package. + +-} + +module Raaz.Core + ( module Raaz.Core.ByteSource + , module Raaz.Core.Constants + , 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 + +import Raaz.Core.ByteSource +import Raaz.Core.Constants +import Raaz.Core.Encode +import Raaz.Core.Memory +import Raaz.Core.Primitives +import Raaz.Core.Random +import Raaz.Core.Types +import Raaz.Core.Util + +{-# ANN module "HLint: ignore Use import/export shortcut" #-} diff --git a/Raaz/Core/ByteSource.hs b/Raaz/Core/ByteSource.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/ByteSource.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DefaultSignatures #-} +-- | Module define byte sources. +module Raaz.Core.ByteSource + ( ByteSource(..), fill, processChunks + , InfiniteSource(..), slurp + , PureByteSource + , FillResult(..) + , 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) + +import Raaz.Core.MonoidalAction +import Raaz.Core.Types (BYTES, Pointer, LengthUnit (..)) +import Raaz.Core.Util.ByteString( unsafeCopyToPointer + , unsafeNCopyToPointer + , length + ) +import Raaz.Core.Types.Pointer (hFillBuf) + + +-- | This type captures the result of a fill operation. +data FillResult a = Remaining a -- ^ the buffer is filled completely + | Exhausted (BYTES Int) -- ^ source exhausted with so much + -- bytes read. + +instance Functor FillResult where + fmap f (Remaining a ) = Remaining $ f a + fmap _ (Exhausted sz) = Exhausted sz + +-- | Combinator to handle a fill result. +withFillResult :: (a -> b) -- ^ stuff to do when filled + -> (BYTES Int -> b) -- ^ stuff to do when exhausted + -> FillResult a -- ^ the fill result to process + -> b +withFillResult continueWith _ (Remaining a) = continueWith a +withFillResult _ endBy (Exhausted sz) = endBy sz + +------------------------ Byte sources ---------------------------------- + +-- | Abstract byte sources. A bytesource is something that you can use +-- to fill a buffer. +class ByteSource src where + -- | Fills a buffer from the source. + fillBytes :: BYTES Int -- ^ Buffer size + -> 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 + +-- | A version of fillBytes that takes type safe lengths as input. +fill :: ( LengthUnit len + , ByteSource src + ) + => len + -> src + -> Pointer + -> IO (FillResult src) +fill = fillBytes . inBytes +{-# INLINE fill #-} + +slurp :: ( LengthUnit len + , InfiniteSource src + ) + => len + -> src + -> Pointer + -> 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, + -> (BYTES Int -> m b) -- action on the last partial chunk, + -> src -- the source + -> chunkSize -- size of the chunksize + -> Pointer -- buffer to fill the chunk in + -> m b +processChunks mid end source csz ptr = go source + where fillChunk src = liftIO $ fill csz src ptr + step src = mid >> go src + go src = fillChunk src >>= withFillResult step end + + +-- | A byte source src is pure if filling from it does not have any +-- other side effect on the state of the byte source. Formally, two +-- different fills form the same source should fill the buffer with +-- the same bytes. This additional constraint on the source helps to +-- /purify/ certain crypto computations like computing the hash or mac +-- of the source. Usualy sources like `B.ByteString` etc are pure byte +-- sources. A file handle is a byte source that is /not/ a pure +-- source. +class ByteSource src => PureByteSource src where + +----------------------- Instances of byte source ----------------------- + +instance ByteSource Handle where + {-# INLINE fillBytes #-} + fillBytes sz hand cptr = do + count <- hFillBuf hand cptr sz + return + (if count < sz then Exhausted count + else Remaining hand) + +instance ByteSource B.ByteString where + {-# INLINE fillBytes #-} + fillBytes sz bs cptr | l < sz = do unsafeCopyToPointer bs cptr + return $ Exhausted l + | otherwise = do unsafeNCopyToPointer sz bs cptr + return $ Remaining rest + where l = length bs + rest = B.drop (fromIntegral sz) bs + +instance ByteSource L.ByteString where + {-# INLINE fillBytes #-} + fillBytes sz bs = liftM (fmap L.fromChunks) + . fillBytes sz (L.toChunks bs) + + +instance ByteSource src => ByteSource (Maybe src) where + {-# INLINE fillBytes #-} + fillBytes sz ma cptr = maybe exhausted fillIt ma + where exhausted = return $ Exhausted 0 + fillIt a = fmap Just <$> fillBytes sz a cptr + +instance ByteSource src => ByteSource [src] where + fillBytes _ [] _ = return $ Exhausted 0 + fillBytes sz (x:xs) cptr = do + result <- fillBytes sz x cptr + case result of + Exhausted rbytes -> let nptr = Sum rbytes <.> cptr + in fillBytes (sz - rbytes) xs nptr + Remaining nx -> return $ Remaining $ nx:xs + +--------------------- Instances of pure byte source -------------------- + +instance PureByteSource B.ByteString where +instance PureByteSource L.ByteString where +instance PureByteSource src => PureByteSource [src] +instance PureByteSource src => PureByteSource (Maybe src) diff --git a/Raaz/Core/Constants.hs b/Raaz/Core/Constants.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Constants.hs @@ -0,0 +1,8 @@ +module Raaz.Core.Constants + ( l1Cache + ) where +import Raaz.Core.Types + +-- | Typical size of L1 cache. Used for selecting buffer size etc in crypto operations. +l1Cache :: BYTES Int +l1Cache = 32768 diff --git a/Raaz/Core/DH.hs b/Raaz/Core/DH.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/DH.hs @@ -0,0 +1,23 @@ +-- | This module provides an abstract interface for Diffie Hellman Key Exchange. + +{-# LANGUAGE TypeFamilies #-} + +module Raaz.Core.DH + ( DH(..) ) where + +-- | The DH (Diffie-Hellman) typeclass provides an interface for key +-- exchanges. 'Secret' represents the secret generated by each party +-- & known only to itself. 'PublicToken' represents the token +-- generated from the 'Secret' which is sent to the other party. +-- 'SharedSecret' represents the common secret generated by both +-- parties from the respective public tokens. 'publicToken' takes the +-- generator of the group and a secret and generates the public token. +-- 'sharedSecret' takes the generator of the group, secret of one party +-- and public token of the other party and generates the shared secret. +class DH d where + type Secret d :: * + type PublicToken d :: * + type SharedSecret d :: * + + publicToken :: d -> Secret d -> PublicToken d + sharedSecret :: d -> Secret d -> PublicToken d -> SharedSecret d diff --git a/Raaz/Core/Encode.hs b/Raaz/Core/Encode.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Encode.hs @@ -0,0 +1,40 @@ +-- +module Raaz.Core.Encode + ( -- * The encodable type + -- $encodable$ + Encodable(..) + -- * Encoding formats + -- $encodingformat$ + , Format(..) + , encode, decode, unsafeDecode + -- ** The base 16 encoding fromat + , Base16, fromBase16, showBase16 + ) where + +import Raaz.Core.Encode.Internal +import Raaz.Core.Encode.Base16 + +-- $encodable$ +-- +-- Many types like cryptographic hashes, secret keys etc can be +-- encoded into bytes. This module gives an interface to such objects +-- using the `Encodable` type class. To ease their printing most types +-- of this class have a `Show` instances. Similarly, to make it easy +-- to defines constants of these types in source code, they often are +-- instances of `Data.String.IsString`. Typically for cryptographic +-- types like hashes, secret keys etc the `Show` and +-- `Data.String.IsString` instances correspond to the base-16 encoding +-- of these types. + + + + +-- $encodingformat$ +-- +-- We also give facilities to encode any instance of `Encodable` into +-- multiple formats. For type safety, encoding formats are +-- distinguished by their types. All such formats have to be members +-- of the `Format` type class and this allows encoding and decoding +-- any type that is an instance of `Encodable` into any of the desired +-- format. +-- diff --git a/Raaz/Core/Encode/Base16.hs b/Raaz/Core/Encode/Base16.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Encode/Base16.hs @@ -0,0 +1,90 @@ +-- | Base 16 or hexadecimal encoding of objects. +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Raaz.Core.Encode.Base16( Base16, fromBase16, showBase16 ) where + +import Data.Char +import Data.Bits +import Data.String + +import Data.ByteString as B +import Data.ByteString.Char8 as C8 +import Data.ByteString.Internal (c2w ) + +import Data.ByteString.Unsafe(unsafeIndex) +import Data.Monoid +import Data.Word +import Raaz.Core.Encode.Internal + +-- | The base16 type. +newtype Base16 = Base16 {unBase16 :: ByteString} deriving (Eq, Monoid) + +-- Developers note: Internally base16 just stores the bytestring as +-- is. The conversion happens when we do an encode and decode of +-- actual base16. + +instance Encodable Base16 where + toByteString = hex . unBase16 + + fromByteString bs + | odd (B.length bs) = Nothing + | badCharacter bs = Nothing + | otherwise = Just $ Base16 $ unsafeFromHex bs + where badCharacter = C8.all (not . isHexDigit) + + unsafeFromByteString = Base16 . unsafeFromHex + + +instance Show Base16 where + show = C8.unpack . toByteString + +instance IsString Base16 where + fromString = unsafeFromByteString . fromString + + +instance Format Base16 where + encodeByteString = Base16 + {-# INLINE encodeByteString #-} + + decodeFormat = unBase16 + {-# INLINE decodeFormat #-} + +-- TODO: Since the encoding to base16 is usually used for user interaction +-- we can afford to be slower here. +hex :: ByteString -> ByteString +hex bs = fst $ B.unfoldrN (2 * B.length bs) gen 0 + where gen i | rm == 0 = Just (hexDigit $ top4 w, i+1) + | otherwise = Just (hexDigit $ bot4 w, i+1) + where (idx, rm) = quotRem i 2 + w = unsafeIndex bs idx + +hexDigit :: Word8 -> Word8 +hexDigit x | x < 10 = c2w '0' + x + | otherwise = c2w 'a' + (x - 10) + +top4 :: Word8 -> Word8; top4 x = x `shiftR` 4 +bot4 :: Word8 -> Word8; bot4 x = x .&. 0x0F + + +unsafeFromHex :: ByteString -> ByteString +unsafeFromHex 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 + gen i = Just (shiftL w0 4 .|. w1, i + 1) + where w0 = fromHexWord $ unsafeIndex bs (2 * i) + w1 = fromHexWord $ unsafeIndex bs (2 * i + 1) + fromHexWord x + | c2w '0' <= x && x <= c2w '9' = x - c2w '0' + | c2w 'a' <= x && x <= c2w 'f' = 10 + (x - c2w 'a') + | c2w 'A' <= x && x <= c2w 'F' = 10 + (x - c2w 'A') + | otherwise = error "bad base16 character" + + +-- | Base16 variant of `fromString`. Useful in definition of +-- `IsString` instances as well as in cases where the default +-- `IsString` instance does not parse from a base16 encoding. +fromBase16 :: Encodable a => String -> a +fromBase16 str = unsafeDecode (fromString str :: Base16) + +-- | Base16 variant of `show`. +showBase16 :: Encodable a => a -> String +showBase16 a = show (encode a :: Base16) diff --git a/Raaz/Core/Encode/Internal.hs b/Raaz/Core/Encode/Internal.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Encode/Internal.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} + +-- | Internal module that has the encode class and some utility functions. +module Raaz.Core.Encode.Internal + ( Encodable(..), Format(..) + , encode, decode, unsafeDecode + ) where + + +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 Prelude hiding (length) +import System.IO.Unsafe (unsafePerformIO) + +import Raaz.Core.Types.Endian +import Raaz.Core.Types.Pointer +import Raaz.Core.Util.ByteString(length, withByteString) + + +-- | The type class `Encodable` captures all the types can be encoding into `ByteString`. +class Encodable a where + -- | Convert stuff to bytestring + toByteString :: a -> ByteString + + -- | Try parsing back a value. Returns nothing on failure. + fromByteString :: ByteString -> Maybe a + + -- | Unsafe version of `fromByteString` + unsafeFromByteString :: ByteString -> a + + default toByteString :: EndianStore a => a -> ByteString + toByteString w = unsafeCreate (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 + | otherwise = Nothing + where w = unsafePerformIO $ withByteString bs (load . castPtr) + proxy = undefined `asTypeOf` w + + unsafeFromByteString = fromMaybe (error "fromByteString error") . fromByteString + +instance Encodable (LE Word32) +instance Encodable (LE Word64) +instance Encodable (BE Word32) +instance Encodable (BE Word64) + +instance Encodable ByteString where + toByteString = id + {-# INLINE toByteString #-} + fromByteString = Just . id + {-# INLINE fromByteString #-} + unsafeFromByteString = id + {-# INLINE unsafeFromByteString #-} + +instance Encodable a => Encodable (BITS a) where + toByteString (BITS a) = toByteString a + fromByteString = fmap BITS . fromByteString + unsafeFromByteString = BITS . unsafeFromByteString + + + +instance Encodable a => Encodable (BYTES a) where + toByteString (BYTES a) = toByteString a + fromByteString = fmap BYTES . fromByteString + unsafeFromByteString = BYTES . unsafeFromByteString + + +-- | A binary encoding format is something for which there is a 1:1 +-- correspondence with bytestrings. We also insist that it is an +-- instance of `IsString`, so that it can be easily included in source +-- code, and `Show`, so that it can be easily printed out. +class (IsString fmt, Show fmt, Encodable fmt) => Format fmt where + encodeByteString :: ByteString -> fmt + decodeFormat :: fmt -> ByteString + +-- | Bytestring itself is an encoding format (namely binary format). +instance Format ByteString where + encodeByteString = id + {-# INLINE encodeByteString #-} + decodeFormat = id + {-# INLINE decodeFormat #-} + + +-- | Encode in a given format. +encode :: (Encodable a, Format fmt) => a -> fmt +encode = encodeByteString . toByteString + +-- | Decode from a given format. It results in Nothing if there is a +-- parse error. +decode :: (Format fmt, Encodable a) => fmt -> Maybe a +decode = fromByteString . decodeFormat + +-- | The unsafe version of `decode`. +unsafeDecode :: (Format fmt, Encodable a) => fmt -> a +unsafeDecode = unsafeFromByteString . decodeFormat diff --git a/Raaz/Core/Memory.hs b/Raaz/Core/Memory.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Memory.hs @@ -0,0 +1,377 @@ +{-| + +The memory subsystem associated with raaz. + +-} + +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +module Raaz.Core.Memory + ( + -- * The Memory subsystem + -- $memorysubsystem$ + + -- ** Memory monads + MonadMemory(..) + , MT, execute, getMemory, liftSubMT + , MemoryM, runMT + -- *** Some low level functions. + , getMemoryPointer, withPointer + , allocate + -- ** Memory elements. + , Memory(..), copyMemory + , Initialisable(..), Extractable(..), modify + -- *** Some basic memory elements. + , MemoryCell + -- ** Memory allocation + , Alloc, pointerAlloc + ) where + +import Control.Applicative +import Control.Monad.IO.Class +import Data.Monoid (Sum (..)) +import Foreign.Storable(Storable(..)) +import Foreign.Ptr (castPtr) +import Raaz.Core.MonoidalAction +import Raaz.Core.Types + +-- $memorysubsystem$ +-- +-- The memory subsystem consists of two main components. +-- +-- 1. Abstract elements captured by the `Memory` type class. +-- +-- 2. Abstract memory actions captured by the type class `MonadMemory`. +-- + +-- | A class that captures monads that use an internal memory element. +-- +-- Any instance of `MonadMemory` can be executed `securely` in which +-- case all allocations are performed from a locked pool of +-- memory. which at the end of the operation is also wiped clean +-- before deallocation. +-- +-- Systems often put tight restriction on the amount of memory a +-- process can lock. Therefore, secure memory is often to be used +-- judiciously. Instances of this class /should/ also implement the +-- the combinator `insecurely` which allocates all memory from an +-- unlocked memory pool. +-- +-- This library exposes two instances of `MonadMemory` +-- +-- 1. /Memory threads/ captured by the type `MT`, which are a sequence +-- of actions that use the same memory element and +-- +-- 2. /Memory actions/ captured by the type `MemoryM`. +-- +-- /WARNING:/ Be careful with `liftIO`. +-- +-- The rule of thumb to follow is that the action being lifted should +-- itself never unlock any memory. In particular, the following code +-- is bad because the `securely` action unlocks some portion of the +-- memory after @foo@ is executed. +-- +-- > +-- > liftIO $ securely $ foo +-- > +-- +-- On the other hand the following code is fine +-- +-- > +-- > liftIO $ insecurely $ someMemoryAction +-- > +-- +-- Whether an @IO@ action unlocks memory is difficult to keep track +-- of; for all you know, it might be a FFI call that does an +-- @memunlock@. +-- +-- As to why this is dangerous, it has got to do with the fact that +-- @mlock@ and @munlock@ do not nest correctly. A single @munlock@ can +-- unlock multiple calls of @mlock@ on the same page. +-- +class (Monad m, MonadIO m) => MonadMemory m where + -- | Perform the memory action where all memory elements are allocated + -- locked memory. All memory allocated will be locked and hence will + -- never be swapped out by the operating system. It will also be wiped + -- clean before releasing. + -- + -- Memory locking is an expensive operation and usually there would be + -- a limit to how much locked memory can be allocated. Nonetheless, + -- actions that work with sensitive information like passwords should + -- use this to run an memory action. + securely :: m a -> IO a + + + -- | Perform the memory action where all memory elements are + -- allocated unlocked memory. Use this function when you work with + -- data that is not sensitive to security considerations (for example, + -- when you want to verify checksums of files). + insecurely :: m a -> IO a + + +-- | An action of type @`MT` mem a@ is an action that uses internally +-- a a single memory object of type @mem@ and returns a result of type +-- @a@. All the actions are performed on a single memory element and +-- hence the side effects persist. It is analogues to the @ST@ +-- 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) + +-- | Run a given memory action in the memory thread. +execute :: (mem -> IO a) -> MT mem a +{-# INLINE execute #-} +execute = MT + +getMemory :: MT mem mem +getMemory = execute return + +-- | Get the pointer associated with the given memory. +getMemoryPointer :: Memory mem => MT mem Pointer +getMemoryPointer = underlyingPtr <$> getMemory + +-- | 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 #-} + +-- | 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 + +instance Applicative (MT mem) where + pure = MT . const . pure + mf <*> ma = MT $ \ m -> unMT mf m <*> unMT ma m + +instance Monad (MT mem) where + return = MT . const . return + ma >>= f = MT runIt + where runIt mem = unMT ma mem >>= \ a -> unMT (f a) mem + +instance MonadIO (MT mem) where + liftIO = MT . const + +instance Memory mem => MonadMemory (MT mem) where + + securely = withSecureMemory . unMT + insecurely = withMemory . unMT + +-- | A runner of a memory state thread. +type Runner mem b = MT mem b -> IO b + +-- | A memory action that uses some sort of memory element +-- internally. +newtype MemoryM a = MemoryM + { unMemoryM :: (forall mem b. Memory mem => Runner mem b) -> IO a } + + +instance Functor MemoryM where + fmap f mem = MemoryM $ \ runner -> f <$> unMemoryM mem runner + +instance Applicative MemoryM where + pure x = MemoryM $ \ _ -> return x + -- Beware: do not follow the hlint suggestion. The ugly definition + -- is to avoid usage of impredicative polymorphism. + + memF <*> memA = MemoryM $ \ runner -> unMemoryM memF runner <*> unMemoryM memA runner + +instance Monad MemoryM where + return = pure + memA >>= f = MemoryM $ \ runner -> do a <- unMemoryM memA runner + unMemoryM (f a) runner + +instance MonadIO MemoryM where + liftIO io = MemoryM $ \ _ -> io + -- Beware: do not follow the hlint suggestion. The ugly definition + -- is to avoid usage of impredicative polymorphism. + +instance MonadMemory MemoryM where + + securely mem = unMemoryM mem securely + insecurely mem = unMemoryM mem insecurely + + +-- | Run the memory thread to obtain a memory action. +runMT :: Memory mem => MT mem a -> MemoryM a +runMT mem = MemoryM $ \ runner -> runner mem + +------------------------ 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 + +-- | 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) + +-- | Allocates a buffer of size @l@ and returns the pointer to it pointer. +pointerAlloc :: LengthUnit l => l -> Alloc Pointer +pointerAlloc l = makeAlloc l id + +--------------------------------------------------------------------- + +-- | Any cryptographic primitives use memory to store stuff. This +-- class abstracts all types that hold some memory. Cryptographic +-- application often requires securing the memory from being swapped +-- out (think of memory used to store private keys or passwords). This +-- abstraction supports memory securing. If your platform supports +-- memory locking, then securing a memory will prevent the memory from +-- being swapped to the disk. Once secured the memory location is +-- overwritten by nonsense before being freed. +-- +-- While some basic memory elements like `MemoryCell` are exposed from +-- the library, often we require compound memory objects built out of +-- simpler ones. The `Applicative` instance of the `Alloc` can be made +-- use of in such situation to simplify such instance declaration as +-- illustrated in the instance declaration for a pair of memory +-- elements. +-- +-- > instance (Memory ma, Memory mb) => Memory (ma, mb) where +-- > +-- > memoryAlloc = (,) <$> memoryAlloc <*> memoryAlloc +-- > +-- > underlyingPtr (ma, _) = underlyingPtr ma +-- +class Memory m where + + -- | Returns an allocator for this memory. + memoryAlloc :: Alloc m + + -- | Returns the pointer to the underlying buffer. + underlyingPtr :: m -> Pointer + +class Memory m => Initialisable m v where + initialise :: v -> MT m () + +class Memory m => Extractable m v where + extract :: MT m v + +instance ( Memory ma, Memory mb ) => Memory (ma, mb) where + memoryAlloc = (,) <$> memoryAlloc <*> memoryAlloc + underlyingPtr (ma, _) = underlyingPtr ma + +instance ( Memory ma + , Memory mb + , Memory mc + ) + => Memory (ma, mb, mc) where + memoryAlloc = (,,) + <$> memoryAlloc + <*> memoryAlloc + <*> memoryAlloc + underlyingPtr (ma,_,_) = underlyingPtr ma + +instance ( Memory ma + , Memory mb + , Memory mc + , Memory md + ) + => Memory (ma, mb, mc, md) where + memoryAlloc = (,,,) + <$> memoryAlloc + <*> memoryAlloc + <*> memoryAlloc + <*> memoryAlloc + + underlyingPtr (ma,_,_,_) = underlyingPtr 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 + -> IO () +copyMemory dest src = memcpy (underlyingPtr dest) (underlyingPtr src) sz + where sz = getSum $ twistMonoidValue $ getAlloc src + getAlloc :: Memory m => m -> Alloc m + getAlloc _ = memoryAlloc + +-- | Perform an action which makes use of this memory. The memory +-- allocated will automatically be freed when the action finishes +-- either gracefully or with some exception. Besides being safer, +-- this method might be more efficient as the memory might be +-- allocated from the stack directly and will have very little GC +-- 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 + + +-- | Similar to `withMemory` but allocates a secure memory for the +-- action. Secure memories are never swapped on to disk and will be +-- wiped clean of sensitive data after use. However, be careful when +-- using this function in a child thread. Due to the daemonic nature +-- of Haskell threads, if the main thread exists before the child +-- thread is done with its job, sensitive data can leak. This is +-- essentially a limitation of the bracket which is used internally. +withSecureMemory :: Memory m => (m -> IO a) -> IO a +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 + 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 } + + +-- | 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 #-} + +-- | Apply the given function to the value in the cell. +modify :: (Initialisable m a, Extractable m b) => (b -> a) -> MT m () +modify f = extract >>= initialise . f + +instance Storable a => Memory (MemoryCell a) where + + memoryAlloc = allocator undefined + where allocator :: Storable b => b -> Alloc (MemoryCell b) + allocator b = makeAlloc (byteSize b) MemoryCell + + underlyingPtr (MemoryCell cptr) = cptr + +instance Storable a => Initialisable (MemoryCell a) a where + initialise a = withCell (flip poke a . castPtr) + {-# INLINE initialise #-} + +instance Storable a => Extractable (MemoryCell a) a where + extract = withCell (peek . castPtr) + {-# INLINE extract #-} diff --git a/Raaz/Core/MonoidalAction.hs b/Raaz/Core/MonoidalAction.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/MonoidalAction.hs @@ -0,0 +1,242 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | A module that abstracts out monoidal actions. +module Raaz.Core.MonoidalAction + ( -- * Monoidal action + -- $basics$ + LAction (..), Distributive, SemiR (..), (<++>), semiRSpace, semiRMonoid + -- ** Monoidal action on functors + , LActionF(..), DistributiveF, TwistRF(..), twistFunctorValue, twistMonoidValue + -- * Fields + -- $fields$ + , FieldA, FieldM, Field, computeField, runFieldM, liftToFieldM + ) where + +import Control.Arrow +import Control.Applicative +import Data.Monoid + +------------------ Actions and Monoidal actions ----------------------- + +-- $basics$ +-- +-- Consider any instance @l@ of a length unit as a monoid under +-- addition. Length units acts on pointers by displacing them. It +-- turns out that this action is crucial in abstracting out many +-- pointer manipulations in our library. In particular, Applicative +-- parsers, memory allocators and data serialisers can be abstractly +-- captured using this action. +-- +-- We start with setting up some terminology. Our setting here is a +-- space of points (captured by the type @space@) on which a monoid +-- (captured by the type @m@) acts. The space which we are most +-- interested in is the space of `CryptoPtr` and the monoid that act +-- on it can be any instance of `LengthUnit` as described above. +-- +-- In this module, we consider /left/ actions of monoids, although +-- right actions can be analogously defined as well. For applications +-- we have in mind, namely for parsers etc, it is sufficient to +-- restrict our attention to left actions. The left action will be +-- written in multiplicative notation with the operator `<.>` being the +-- multiplication. + +-- | A monoid @m@ acting on the left of a space. Think of a left +-- action as a multiplication with the monoid. It should satisfy the +-- law: +-- +-- > 1 <.> p = p -- identity +-- > a <> b <.> p = a <.> b <.> p -- successive displacements +-- +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 <++> + + +-- | Uniform action of a monoid on a functor. The laws that should +-- be satisfied are: +-- +-- > 1 <<.>> fx = fx +-- > (a <> b) <<.>> fx = a . (b <<.>> fx) +-- > m <<.>> fmap f u = fmap f (m <<.>> u) -- acts uniformly +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 ------------------------ + +-- | A left-monoid action on a monoidal-space, i.e. the space on which +-- the monoid acts is itself a monoid, is /distributive/ if it +-- satisfies the law: +-- +-- > a <.> p <> q = (a <.> p) <> (a <.> q). +-- +-- The above law implies that every element @m@ is a monoid +-- homomorphism. +class (LAction m space, Monoid space) => Distributive m space + +-- | The semidirect product Space ⋊ Monoid. For monoids acting on +-- monoidal spaces distributively the semi-direct product is itself a +-- monoid. It turns out that data serialisers can essentially seen as +-- a semidirect product. +data SemiR space m = SemiR space !m + + +instance Distributive m space => Monoid (SemiR space m) where + + mempty = SemiR mempty mempty + {-# INLINE mempty #-} + + mappend (SemiR x a) (SemiR y b) = SemiR (x <++> a <.> y) (a <> b) + {-# INLINE mappend #-} + + mconcat = foldr mappend mempty + {-# INLINE mconcat #-} + +-- | From the an element of semi-direct product Space ⋊ Monoid return +-- the point. +semiRSpace :: SemiR space m -> space +{-# INLINE semiRSpace #-} +semiRSpace (SemiR space _) = space + +-- | From the an element of semi-direct product Space ⋊ Monoid return +-- the monoid element. +semiRMonoid :: SemiR space m -> m +{-# INLINE semiRMonoid #-} +semiRMonoid (SemiR _ m) = m + +--------------------------- Twisted functors ---------------------------- + + + +-- | The generalisation of distributivity to applicative +-- functors. This generalisation is what allows us to capture +-- applicative functors like parsers. For an applicative functor, and +-- a monoid acting uniformly on it, we say that the action is +-- distributive if the following laws are satisfied: +-- +-- > m <<.>> (pure a) = pure a -- pure values are stoic +-- > m <<.>> (a <*> b) = (m <<.>> a) <*> (m <<.>> b) -- dist +class (Applicative f, LActionF m f) => DistributiveF m f + +-- | The twisted functor is essentially a generalisation of +-- semi-direct product to applicative functors. +data TwistRF f m a = TwistRF (f a) !m + +-- | Get the underlying functor value. +twistFunctorValue :: TwistRF f m a -> f a +twistFunctorValue (TwistRF fa _) = fa +{-# INLINE twistFunctorValue #-} + +-- | Get the underlying monoid value. +twistMonoidValue :: TwistRF f m a -> m +twistMonoidValue (TwistRF _ m) = m +{-# INLINE twistMonoidValue #-} + +instance Functor f => Functor (TwistRF f m) where + fmap f (TwistRF x m) = TwistRF (fmap f x) m + +-- Proof of functor laws. +-- +-- fmap id (TwistRF (x, m)) = TwistRF (fmap id x, m) +-- = TwistRF (x, m) +-- +-- fmap (f . g) (TwistRF fx m) = TwistRF (fmap (f . g) x, m) +-- = TwistRF (fmap f . fmap g $ x, m) +-- = TwistRF (fmap f (fmap g x), m) +-- = fmap f $ TwistRF (fmap g x, m) +-- = (fmap f . fmap g) (TwistRF fx) m) +-- + +instance DistributiveF m f => Applicative (TwistRF f m) where + pure a = TwistRF (pure a) mempty + {-# INLINE pure #-} + + (TwistRF f mf) <*> (TwistRF val mval) = TwistRF res mres + where res = f <*> mf <<.>> val + mres = mf <> mval + +-- Consider an expression @u = u1 <*> u2 <*> ... @ where +-- ui = TwistRF fi mi +-- +-- u = TwistRF f m where m = m1 <> m2 <> .. <> mr +-- f = f1 <*> m1 f2 <*> (m1 m2) f3 ... <*> (m1 m2 .. mr-1) fr. +-- +-- We will separately verify the functor part and the monoid +-- part of the ofNow we can verify the laws of applicative +-- +-- + + +------------------------- A generic field ----------------------------------- + +-- $fields$ +-- +-- The main goal behind looking at monoidal actions are to captures +-- concrete objects of interest to us like parsers, serialisers and +-- memory allocators. These are essentially functions with domain +-- `CryptoPtr`. For example, a parser is a function that takes a +-- `CryptoPtr`, reads @n@ bytes say and produces a result a. To +-- sequence the next parse we need to essentially keep track of this +-- @n@. If we abstract this out to the general setting we need to +-- consider functions whose domain is the space of points. We use the +-- physicist's terminology and call them fields. The action of the +-- monoid on a space of points naturally extends to fields on them +-- +-- @F^g = λ x -> F (x^g) @ +-- +-- For our applications, we need to define generalised fields +-- associated with arrows. This is because we often have to deal with +-- functions that have side effects (i.e. `Kleisli` arrows). However, +-- for conceptual understanding, it is sufficient to stick to ordinary +-- functions. In fact, the informal proofs that we have scattered in +-- the source all have been written only for the arrow @->@. + +-- | A field on the space is a function from the points in the space +-- to some value. Here we define it for a general arrow. + +type FieldA arrow = WrappedArrow arrow + + +-- | A field where the underlying arrow is the (->). This is normally +-- what we call a field. +type Field = FieldA (->) + +-- | Compute the value of a field at a given point in the space. +computeField :: Field space b -> space -> b +computeField = unwrapArrow +{-# INLINE computeField #-} + +-- | A monadic arrow field. +type FieldM monad = FieldA (Kleisli monad) + +-- | Lift a monadic action to FieldM. +liftToFieldM :: Monad m => (a -> m b) -> FieldM m a b +liftToFieldM = WrapArrow . Kleisli +{-# INLINE liftToFieldM #-} +-- | Runs a monadic field at a given point in the space. +runFieldM :: FieldM monad space b -> space -> monad b +runFieldM = runKleisli . unwrapArrow +{-# INLINE runFieldM #-} + +-- | The action on the space translates to the action on field. +instance (Arrow arrow, LAction m space) => LActionF m (WrappedArrow arrow space) where + m <<.>> field = WrapArrow $ unwrapArrow field <<^ (m<.>) + {-# INLINE (<<.>>) #-} + +instance (Arrow arrow, LAction m space) => DistributiveF m (WrappedArrow arrow space) diff --git a/Raaz/Core/Parse/Applicative.hs b/Raaz/Core/Parse/Applicative.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Parse/Applicative.hs @@ -0,0 +1,121 @@ +-- | An applicative version of parser. This provides a restricted +-- parser which has only an applicative instance. + +module Raaz.Core.Parse.Applicative + ( Parser, parseWidth, parseError + , unsafeRunParser + , parse, parseStorable + , parseVector, parseStorableVector + , unsafeParseVector, unsafeParseStorableVector + , parseByteString + ) 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 Raaz.Core.MonoidalAction +import Raaz.Core.Types.Endian +import Raaz.Core.Types.Pointer +import Raaz.Core.Util.ByteString (createFrom) + + +type BytesMonoid = Sum (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) + +-- | A parser that fails with a given error message. +parseError :: String -> Parser a +parseError msg = makeParser (0 :: BYTES Int) $ \ _ -> fail msg + +-- | Return the bytes that this parser will read. +parseWidth :: Parser a -> BYTES Int +parseWidth = getSum . 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 + +-} + +-- | Run the parser without checking the length constraints. +unsafeRunParser :: Parser a -> Pointer -> IO a +unsafeRunParser = runFieldM . twistFunctorValue + +-- | The primary purpose of this function is to satisfy type checkers. +undefParse :: Parser a -> a +undefParse _ = undefined + +-- | Parses a value which is an instance of Storable. Beware that this +-- parser expects that the value is stored in machine endian. Mostly +-- it is useful in defining the `peek` function in a complicated +-- `Storable` instance. +parseStorable :: Storable a => Parser a +parseStorable = pa + where pa = makeParser (byteSize $ 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 +-- external source. You can also use this to define the `load` +-- function in a complicated `EndianStore` instance. +parse :: EndianStore a => Parser a +parse = pa + where pa = makeParser (byteSize $ undefParse pa) load + +-- | Parses a strict bytestring of a given length. +parseByteString :: LengthUnit l => l -> Parser ByteString +parseByteString l = makeParser l $ createFrom l + +-- | Similar to @parseStorableVector@ but is expected to be slightly +-- faster. It does not check whether the length parameter is +-- non-negative and hence is unsafe. Use it only if you can prove that +-- the length parameter is non-negative. +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) + undefA :: (Storable a, Vector v a)=> Parser (v a) -> a + undefA _ = undefined + getA = peekElemOff . castPtr + +-- | Similar to @parseVector@ but is expected to be slightly +-- faster. It does not check whether the length parameter is +-- non-negative and hence is unsafe. Use it only if you can prove that +-- 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) + undefA :: (EndianStore a, Vector v a)=> Parser (v a) -> a + undefA _ = undefined + +-- | Similar to `parseVector` but parses according to the host +-- endian. This function is essentially used to define storable +-- instances of complicated data. It is unlikely to be of use when +-- parsing externally serialised data as one would want to keep track +-- of the endianness of the data. +parseStorableVector :: (Storable a, Vector v a) => Int -> Parser (v a) +parseStorableVector n | n < 0 = parseError $ "parseStorableVector on " ++ show n + | otherwise = unsafeParseStorableVector n + +-- | Parses a vector of elements. It takes care of the correct endian +-- conversion. This is the function to use while parsing external +-- data. +parseVector :: (EndianStore a, Vector v a) => Int -> Parser (v a) +parseVector n | n < 0 = parseError $ "parseVector on " ++ show n + | otherwise = unsafeParseVector n diff --git a/Raaz/Core/Primitives.hs b/Raaz/Core/Primitives.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Primitives.hs @@ -0,0 +1,95 @@ +{-| + +Generic cryptographic block primtives and their implementations. This +module exposes low-level generic code used in the raaz system. Most +likely, one would not need to stoop so low and it might be better to +use a more high level interface. + +-} + +{-# LANGUAGE TypeFamilies #-} +{-# 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(..) + , BLOCKS, blocksOf + ) where + +import Raaz.Core.Types +----------------------- A primitive ------------------------------------ + + +-- | The type class that captures an abstract block cryptographic +-- primitive. Bulk cryptographic primitives like hashes, ciphers etc +-- often acts on blocks of data. The size of the block is captured by +-- the member `blockSize`. +-- +-- As a library, raaz believes in providing multiple implementations +-- 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 + + -- | The block size. + blockSize :: p -> BYTES Int + + -- | Associated type that captures an implementation of this + -- primitive. + type Implementation p :: * + +-- | Primitives that have a recommended implementations. +class Primitive p => Recommendation p where + -- | 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 + + +------------------- Type safe lengths in units of block ---------------- + +-- | Type safe message length in units of blocks of the primitive. +-- When dealing with buffer lengths for a primitive, it is often +-- better to use the type safe units `BLOCKS`. Functions in the raaz +-- 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 + deriving (Show, Eq, Ord, Enum, Real, Num, Integral) + +instance Primitive p => LengthUnit (BLOCKS p) where + inBytes p@(BLOCKS x) = scale * blockSize (getPrimitiveType p) + where scale = BYTES x + getPrimitiveType :: BLOCKS p -> p + getPrimitiveType _ = undefined + +-- | The expression @n `blocksOf` p@ specifies the message lengths in +-- units of the block length of the primitive @p@. This expression is +-- sometimes required to make the type checker happy. +blocksOf :: Primitive p => Int -> p -> BLOCKS p +blocksOf n _ = BLOCKS n diff --git a/Raaz/Core/Random.hs b/Raaz/Core/Random.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Random.hs @@ -0,0 +1,104 @@ +{-# 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 diff --git a/Raaz/Core/Types.hs b/Raaz/Core/Types.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Types.hs @@ -0,0 +1,50 @@ +-- | 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 +-- +-- [Timing safe equality:] 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. Instance for basic word +-- types are given here 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 aware types:] When serialising data, we need to be +-- careful about the endianness of the machine. Instance of the +-- `EndianStore` type class correctly stores and loads data from +-- memory, irrespective of the endianness of the machine. We +-- define endian aware variants of `Word32` and `Word64` here and +-- expect other cryptographic types to use such endian explicit +-- types in their definition. +-- +-- [Pointer and Length units:] 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. +module Raaz.Core.Types + ( -- * Timing safe equality checking. + module Raaz.Core.Types.Equality + -- * Endianess aware types. + , module Raaz.Core.Types.Endian + -- * The pointer type and Length offsets. + , module Raaz.Core.Types.Pointer + -- * Tuples with length encoded in their types. + , module Raaz.Core.Types.Tuple + , Describable(..) + ) where + +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 + +{-# ANN module "HLint: ignore Use import/export shortcut" #-} diff --git a/Raaz/Core/Types/Describe.hs b/Raaz/Core/Types/Describe.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Types/Describe.hs @@ -0,0 +1,14 @@ +-- | This module exposes ways to attach descriptions to types of the +-- library. +module Raaz.Core.Types.Describe + ( Describable(..) + ) where + +-- | This class captures all types that have some sort of description +-- attached to it. +class Describable d where + -- | Short name that describes the object. + name :: d -> String + + -- | Longer description + description :: d -> String diff --git a/Raaz/Core/Types/Endian.hs b/Raaz/Core/Types/Endian.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Types/Endian.hs @@ -0,0 +1,297 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TypeFamilies #-} + +module Raaz.Core.Types.Endian + ( EndianStore(..) + -- ** Endian explicit word types. + , LE, BE, littleEndian, bigEndian + -- ** Helper functions for endian aware storing and loading. + , storeAt, storeAtIndex + , loadFrom, loadFromIndex + ) where + +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 qualified Data.Vector.Generic as GV +import qualified Data.Vector.Generic.Mutable as GVM + +import Raaz.Core.MonoidalAction +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. +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 + -> IO () + + -- | Load the value from the location pointed by the pointer. + load :: Pointer -> IO w + +instance EndianStore Word8 where + store = poke . castPtr + load = peek . castPtr + +{--} +-- | 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 + -- 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 + +-- | 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 + -> IO w +{-# INLINE loadFromIndex #-} +loadFromIndex cptr index = loadP undefined + where loadP :: (EndianStore w, Storable w) => w -> IO w + loadP w = loadFrom cptr offset + where offset = toEnum index * byteSize 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 + -> IO w +{-# INLINE loadFrom #-} +loadFrom cptr offset = load (Sum offset <.> cptr) + +--} + +{- +Developers notes: +----------------- + +Make sure that the endian encoded version does not have any +performance penalty. We may have to stare at the core code generated +by ghc. + +-} + +-- | Little endian version of the word type @w@ +newtype LE w = LE w + deriving ( Bounded, Enum, Read, Show + , Integral, Num, Real, Eq, Equality, Ord + , Bits, Storable, Typeable, NFData + ) + +-- | Big endian version of the word type @w@ +newtype BE w = BE w + deriving ( Bounded, Enum, Read, Show + , Integral, Num, Real, Eq, Equality, Ord + , Bits, Storable, Typeable, NFData + ) + +-- | Convert to the little endian variant. +littleEndian :: w -> LE w +{-# INLINE littleEndian #-} +littleEndian = LE + +-- | Convert to the big endian variants. +bigEndian :: w -> BE w +bigEndian = BE + +------------------- Endian store for LE 32 ------------------------ + +foreign import ccall unsafe "raaz/core/endian.h raazLoadLE32" + c_loadLE32 :: Pointer -> IO Word32 + +foreign import ccall unsafe "raaz/core/endian.h raazStoreLE32" + c_storeLE32 :: Pointer -> Word32 -> IO () + +instance EndianStore (LE Word32) where + load = fmap LE . c_loadLE32 + store ptr (LE w) = c_storeLE32 ptr w + +------------------- Endian store for BE 32 ------------------------ + +foreign import ccall unsafe "raaz/core/endian.h raazLoadBE32" + c_loadBE32 :: Pointer -> IO Word32 + +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 + + +------------------- Endian store for LE 64 ------------------------ + +foreign import ccall unsafe "raaz/core/endian.h raazLoadLE64" + c_loadLE64 :: Pointer -> IO Word64 + +foreign import ccall unsafe "raaz/core/endian.h raazStoreLE64" + c_storeLE64 :: Pointer -> Word64 -> IO () + +instance EndianStore (LE Word64) where + load = fmap LE . c_loadLE64 + store ptr (LE w) = c_storeLE64 ptr w + + +------------------- Endian store for BE 64 ------------------------ + +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 (BE Word64) where + load = fmap BE . c_loadBE64 + store ptr (BE w) = c_storeBE64 ptr w + + +------------------- Unboxed vector of Endian word types --------------- + +instance Unbox w => Unbox (LE w) +instance Unbox w => Unbox (BE w) + +------------------- Defining the vector types -------------------------- + +newtype instance MVector s (LE w) = MV_LE (MVector s w) +newtype instance Vector (LE w) = V_LE (Vector w) + +newtype instance MVector s (BE w) = MV_BE (MVector s w) +newtype instance Vector (BE w) = V_BE (Vector w) + +instance Unbox w => GVM.MVector MVector (LE w) 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_LE v) = GVM.basicLength v + basicUnsafeSlice i n (MV_LE v) = MV_LE $ GVM.basicUnsafeSlice i n v + basicOverlaps (MV_LE v1) (MV_LE v2) = GVM.basicOverlaps v1 v2 + + basicUnsafeRead (MV_LE v) i = LE `liftM` GVM.basicUnsafeRead v i + basicUnsafeWrite (MV_LE v) i (LE x) = GVM.basicUnsafeWrite v i x + + basicClear (MV_LE v) = GVM.basicClear v + basicSet (MV_LE v) (LE x) = GVM.basicSet v x + + basicUnsafeNew n = MV_LE `liftM` GVM.basicUnsafeNew n + basicUnsafeReplicate n (LE x) = MV_LE `liftM` GVM.basicUnsafeReplicate n x + basicUnsafeCopy (MV_LE v1) (MV_LE v2) = GVM.basicUnsafeCopy v1 v2 + basicUnsafeGrow (MV_LE v) n = MV_LE `liftM` GVM.basicUnsafeGrow v n + +#if MIN_VERSION_vector(0,11,0) + basicInitialize (MV_LE v) = GVM.basicInitialize v +#endif + +instance Unbox w => GV.Vector Vector (LE w) where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze (MV_LE v) = V_LE `liftM` GV.basicUnsafeFreeze v + basicUnsafeThaw (V_LE v) = MV_LE `liftM` GV.basicUnsafeThaw v + basicLength (V_LE v) = GV.basicLength v + basicUnsafeSlice i n (V_LE v) = V_LE $ GV.basicUnsafeSlice i n v + basicUnsafeIndexM (V_LE v) i = LE `liftM` GV.basicUnsafeIndexM v i + + basicUnsafeCopy (MV_LE mv) (V_LE v) = GV.basicUnsafeCopy mv v + elemseq _ (LE x) = GV.elemseq (undefined :: Vector a) x + + +instance Unbox w => GVM.MVector MVector (BE w) 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_BE v) = GVM.basicLength v + basicUnsafeSlice i n (MV_BE v) = MV_BE $ GVM.basicUnsafeSlice i n v + basicOverlaps (MV_BE v1) (MV_BE v2) = GVM.basicOverlaps v1 v2 + + basicUnsafeRead (MV_BE v) i = BE `liftM` GVM.basicUnsafeRead v i + basicUnsafeWrite (MV_BE v) i (BE x) = GVM.basicUnsafeWrite v i x + + basicClear (MV_BE v) = GVM.basicClear v + basicSet (MV_BE v) (BE x) = GVM.basicSet v x + + basicUnsafeNew n = MV_BE `liftM` GVM.basicUnsafeNew n + basicUnsafeReplicate n (BE x) = MV_BE `liftM` GVM.basicUnsafeReplicate n x + basicUnsafeCopy (MV_BE v1) (MV_BE v2) = GVM.basicUnsafeCopy v1 v2 + basicUnsafeGrow (MV_BE v) n = MV_BE `liftM` GVM.basicUnsafeGrow v n + +#if MIN_VERSION_vector(0,11,0) + basicInitialize (MV_BE v) = GVM.basicInitialize v +#endif + + + +instance Unbox w => GV.Vector Vector (BE w) where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze (MV_BE v) = V_BE `liftM` GV.basicUnsafeFreeze v + basicUnsafeThaw (V_BE v) = MV_BE `liftM` GV.basicUnsafeThaw v + basicLength (V_BE v) = GV.basicLength v + basicUnsafeSlice i n (V_BE v) = V_BE $ GV.basicUnsafeSlice i n v + basicUnsafeIndexM (V_BE v) i = BE `liftM` GV.basicUnsafeIndexM v i + + basicUnsafeCopy (MV_BE mv) (V_BE v) = GV.basicUnsafeCopy mv v + elemseq _ (BE x) = GV.elemseq (undefined :: Vector a) x diff --git a/Raaz/Core/Types/Equality.hs b/Raaz/Core/Types/Equality.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Types/Equality.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +module Raaz.Core.Types.Equality + ( Equality(..), (===) + -- ** The result of comparion. + , Result, isSuccessful + -- ** Comparing vectors. + , oftenCorrectEqVector, eqVector + ) where + +import Control.Monad ( liftM ) +import Data.Bits + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid -- Import only when base < 4.8.0 +#endif + +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as GM +import Data.Vector.Unboxed ( MVector(..), Vector, Unbox ) +import Data.Word + +-- | An opaque type that captures the result of a comparison. The monoid +-- instances allows us to combine the results of two equality comparisons +-- in a timing independent manner. We have the following properties. +-- +-- > isSuccessful mempty = True +-- > isSuccessful (r `mappend` s) = isSuccessful r && isSuccessful s +-- +newtype Result = Result { unResult :: Word } + +-- | Checks whether a given equality comparison is successful. +isSuccessful :: Result -> Bool +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 +-- 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. +-- +-- 1. Define an instance of `Equality`. +-- +-- 2. Make use of the above instance to define `Eq` instance as follows. +-- +-- > data SomeSensitiveType = ... +-- > +-- > instance Equality SomeSensitiveType where +-- > eq a b = ... +-- > +-- > instance Eq SomeSensitiveType where +-- > (==) a b = a === b +-- +class Equality a where + eq :: a -> a -> Result + +-- | Check whether two values are equal using the timing safe `eq` +-- function. Use this function when defining the `Eq` instance for a +-- Sensitive data type. +(===) :: Equality a => a -> a -> Bool +(===) a b = isSuccessful $ eq a b + +instance Equality Word where + eq a b = Result $ a `xor` b + +instance Equality Word8 where + eq w1 w2 = Result $ fromIntegral $ xor w1 w2 + +instance Equality Word16 where + eq w1 w2 = Result $ fromIntegral $ xor w1 w2 + +instance Equality Word32 where + eq w1 w2 = Result $ fromIntegral $ xor w1 w2 + + +#include "MachDeps.h" +instance Equality Word64 where +-- It assumes that Word size is atleast 32 Bits +#if WORD_SIZE_IN_BITS < 64 + eq w1 w2 = eq w11 w21 `mappend` eq w12 w22 + where + w11 :: Word + w12 :: Word + w21 :: Word + w22 :: Word + w11 = fromIntegral $ w1 `shiftR` 32 + w12 = fromIntegral w1 + w21 = fromIntegral $ w2 `shiftR` 32 + w22 = fromIntegral w2 +#else + eq w1 w2 = Result $ fromIntegral $ xor w1 w2 +#endif + + +-- | 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 +-- > +-- + + +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 + +-- | 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 diff --git a/Raaz/Core/Types/Pointer.hs b/Raaz/Core/Types/Pointer.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Types/Pointer.hs @@ -0,0 +1,295 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CPP #-} + +module Raaz.Core.Types.Pointer + ( -- ** The pointer type. + Pointer + -- ** Type safe length units. + , LengthUnit(..), movePtr + , BYTES(..), BITS(..), ALIGN, Align, inBits + -- ** Some length arithmetic + , bitsQuotRem, bytesQuotRem + , bitsQuot, bytesQuot + , atLeast, atMost + -- * Helper function that uses generalised length units. + , allocaBuffer, allocaSecure, mallocBuffer + , hFillBuf, byteSize + , memset, memmove, memcpy + ) 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 Raaz.Core.MonoidalAction +import Raaz.Core.Types.Equality + +-- 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. + + +-- | A type whose only purpose in this universe is to provide +-- alignment safe pointers. +newtype Align = Align Word deriving Storable + +-- | The pointer type used by all cryptographic library. +type Pointer = Ptr Align + + +-- | In cryptographic settings, we need to measure pointer offsets and +-- buffer sizes in different units. To avoid 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 + -- | Express the length units in bytes. + inBytes :: u -> BYTES Int + +-- | Type safe lengths/offsets in units of bytes. +newtype BYTES a = BYTES a + deriving ( Show, Eq, Equality, Ord, Enum, Integral + , Real, Num, Storable + ) + +-- | Type safe lengths/offsets in units of bits. +newtype BITS a = BITS a + deriving ( Show, Eq, Equality, Ord, Enum, Integral + , Real, Num, Storable + ) + +newtype ALIGN = ALIGN Int + deriving ( Show, Eq,Ord, Enum, Integral + , Real, Num, Storable + ) + +instance LengthUnit ALIGN where + inBytes (ALIGN x) = BYTES $ x * alignment (undefined :: Align) + {-# INLINE inBytes #-} + +instance LengthUnit (BYTES Int) where + inBytes = id + {-# INLINE inBytes #-} + +-- | Express the length units in bits. +inBits :: LengthUnit u => u -> BITS Word64 +inBits u = BITS $ 8 * fromIntegral by + where BYTES by = inBytes u + +-- | Express length unit @src@ in terms of length unit @dest@ rounding +-- upwards. +atLeast :: ( LengthUnit src + , LengthUnit dest + ) + => src + -> dest +atLeast src | r == 0 = u + | otherwise = u + 1 + where (u , r) = bytesQuotRem $ inBytes src + +-- | Express length unit @src@ in terms of length unit @dest@ rounding +-- downwards. +atMost :: ( LengthUnit src + , LengthUnit dest + ) + => src + -> dest +atMost = fst . bytesQuotRem . inBytes + +-- | A length unit @u@ is usually a multiple of bytes. The function +-- `bytesQuotRem` is like `quotRem`: the value @byteQuotRem bytes@ is +-- a tuple @(x,r)@, where @x@ is @bytes@ expressed in the unit @u@ +-- with @r@ being the reminder. +bytesQuotRem :: LengthUnit u + => BYTES Int + -> (u , BYTES Int) +bytesQuotRem bytes = (u , r) + where divisor = inBytes (1 `asTypeOf` u) + (q, r) = bytes `quotRem` divisor + u = toEnum $ fromEnum 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) + q = bytes `quot` divisor + u = toEnum $ fromEnum q + + +-- | Function similar to `bytesQuotRem` but works with bits instead. +bitsQuotRem :: LengthUnit u + => BITS Word64 + -> (u , BITS Word64) +bitsQuotRem bits = (u , r) + where divisor = inBits (1 `asTypeOf` u) + (q, r) = bits `quotRem` divisor + u = toEnum $ fromEnum q + +-- | Function similar to `bitsQuotRem` but returns only the quotient. +bitsQuot :: LengthUnit u + => BITS Word64 + -> u +bitsQuot bits = u + where divisor = inBits (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 + {-# INLINE (<.>) #-} + +movePtr :: LengthUnit u => Pointer -> u -> Pointer +movePtr ptr u = Sum u <.> ptr +{-# INLINE movePtr #-} + +------------------------------------------------------------------- + + +-------------------- Sizes, offsets and pointer arithmetic ------- + +-- | Similar to `sizeOf` but returns the length in type safe units. +byteSize :: Storable a => a -> BYTES Int +{-# INLINE byteSize #-} +byteSize = BYTES . sizeOf + + +------------------------ Allocation -------------------------------- + +-- | 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) + +-- | 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 +-- wiped clean and deallocated when the action terminates either +-- directly or indirectly via errors. While this is mostly secure, +-- there can be strange situations in multi-threaded application where +-- the memory is not wiped out. For example if you run a +-- crypto-sensitive action inside a child thread and the main thread +-- gets exists, then the child thread is killed (due to the demonic +-- nature of haskell threads) immediately and might not give it chance +-- to wipe the memory clean. This is a problem inherent to how the +-- `bracket` combinator works inside a child thread. +-- +-- TODO: File this insecurity in the wiki. +-- +allocaSecure :: LengthUnit l + => l + -> (Pointer -> IO a) + -> IO a + +#ifdef HAVE_MLOCK + +foreign import ccall unsafe "sys/mman.h mlock" + c_mlock :: Pointer -> Int -> IO Int + + +foreign import ccall unsafe "sys/mman.h munlock" + c_munlock :: Pointer -> Int -> IO () + +allocaSecure l action = allocaBuffer actualSz actualAction + where actualSz = atLeast l :: ALIGN + BYTES sz = inBytes actualSz + 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 + in bracket_ lockIt releaseIt $ action cptr + +#else + +allocaSecure _ _ = fail "memory locking not supported on this platform" + +#endif + +-- | Creates a memory of given size. It is better to use over +-- @`mallocBytes`@ as it uses typesafe length. +mallocBuffer :: LengthUnit l + => l -- ^ buffer length + -> IO Pointer +{-# INLINE mallocBuffer #-} +mallocBuffer l = mallocBytes bytes + where BYTES bytes = inBytes l + + +-------------------- Low level pointer operations ------------------ + +-- | A version of `hGetBuf` which works for any type safe length units. +hFillBuf :: LengthUnit bufSize + => Handle + -> Pointer + -> bufSize + -> IO (BYTES Int) +{-# INLINE hFillBuf #-} +hFillBuf handle cptr bufSize = BYTES <$> hGetBuf handle cptr bytes + where BYTES bytes = inBytes bufSize + +------------------- Copy move and set contents ---------------------------- + +-- | Some common PTR functions abstracted over type safe length. +foreign import ccall unsafe "string.h memcpy" c_memcpy + :: Pointer -> 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 + +{-# SPECIALIZE memcpy :: Pointer -> Pointer -> BYTES Int -> IO () #-} + +foreign import ccall unsafe "string.h memmove" c_memmove + :: Pointer -> 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 () #-} + +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 + => Pointer -- ^ Target + -> Word8 -- ^ Value byte to set + -> l -- ^ Number of bytes to set + -> IO () +memset p w = void . c_memset p w . inBytes +{-# SPECIALIZE memset :: Pointer -> Word8 -> BYTES Int -> IO () #-} diff --git a/Raaz/Core/Types/Tuple.hs b/Raaz/Core/Types/Tuple.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Types/Tuple.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +module Raaz.Core.Types.Tuple + ( -- * Length encoded tuples + Tuple, dimension, initial + -- ** Unsafe operations + , unsafeFromList + ) where + +import Control.Applicative +import qualified Data.List as L +import Data.Monoid + +#if MIN_VERSION_base(4,7,0) +import Data.Proxy +#endif + +import qualified Data.Vector.Unboxed as V +import GHC.TypeLits +import Foreign.Ptr ( castPtr ) +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.Parse.Applicative + +-- | Tuples that encode their length in their types. For tuples, we call +-- the length its dimension +newtype Tuple (dim :: Nat) a = Tuple { unTuple :: V.Vector a } + deriving Show + +instance (V.Unbox a, Equality a) => Equality (Tuple dim a) where + eq (Tuple u) (Tuple v) = V.foldl' mappend mempty $ V.zipWith eq u v + +-- | Equality checking is timing safe. +instance (V.Unbox a, Equality a) => Eq (Tuple dim a) where + (==) = (===) + + +-- | Function to make the type checker happy +getA :: Tuple dim a -> a +getA _ = undefined + +-- | 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) + => Proxy dim + -> Tuple dim a + -> Int +dimensionP sz _ = fromEnum $ natVal sz +dimension = dimensionP Proxy +#endif + +-- | Get the dimension to parser +#if !MIN_VERSION_base(4,7,0) +getParseDimension :: (V.Unbox a, SingI dim) + => Parser (Tuple dim a) -> Int +getTupFromP :: (V.Unbox a, SingI 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) + => Storable (Tuple dim a) where +#endif + sizeOf tup = dimension tup * sizeOf (getA tup) + alignment = alignment . getA + + peek = unsafeRunParser tupParser . castPtr + where len = getParseDimension tupParser + tupParser = Tuple <$> unsafeParseStorableVector len + + 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) + => 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 + +-- | 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 xs + | dimension tup == L.length xs = tup + | otherwise = wrongLengthMesg + where tup = Tuple $ V.fromList xs + wrongLengthMesg = error "tuple: unsafeFromList: wrong length" + +-- | 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) + => Tuple dim1 a + -> Tuple dim0 a +#endif +initial tup = tup0 + where tup0 = Tuple $ V.take (dimension tup0) $ unTuple tup diff --git a/Raaz/Core/Util.hs b/Raaz/Core/Util.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Util.hs @@ -0,0 +1,11 @@ +{-| + +Some useful utility functions and combinators. + +-} + +module Raaz.Core.Util + ( module Raaz.Core.Util.ByteString + ) where + +import Raaz.Core.Util.ByteString diff --git a/Raaz/Core/Util/ByteString.hs b/Raaz/Core/Util/ByteString.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Util/ByteString.hs @@ -0,0 +1,86 @@ +{-| + +Some utility function for byte strings. + +-} + +{-# LANGUAGE FlexibleContexts #-} +module Raaz.Core.Util.ByteString + ( length, replicate + , fromByteStringStorable + , createFrom + , withByteString + , unsafeCopyToPointer + , unsafeNCopyToPointer + ) where + +import Prelude hiding (length, replicate) +import qualified Data.ByteString as B +import Data.ByteString (ByteString) +import Data.ByteString.Internal( toForeignPtr + , create + ) +import Data.Word +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Ptr (castPtr, plusPtr) +import Foreign.Storable (peek, Storable) + +import System.IO.Unsafe (unsafePerformIO) + +import Raaz.Core.Types.Pointer + +-- | A typesafe length for Bytestring +length :: ByteString -> BYTES Int +length = BYTES . B.length + +-- | A type safe version of replicate +replicate :: LengthUnit l => l -> Word8 -> ByteString +replicate l = B.replicate sz + where BYTES sz = inBytes l + +-- | Copy the bytestring to the crypto buffer. This operation leads to +-- 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 () +unsafeCopyToPointer bs cptr = withForeignPtr fptr $ + \ p -> memcpy dest (p `plusPtr` offset) (BYTES n) + where (fptr, offset,n) = toForeignPtr bs + dest = castPtr cptr + + +-- | Similar to `unsafeCopyToPointer` but takes an additional input +-- @n@ which is the number of bytes (expressed in type safe length +-- units) to transfer. This operation leads to undefined behaviour if +-- either the bytestring is shorter than @n@ or the crypto pointer +-- points to an area smaller than @n@. +unsafeNCopyToPointer :: LengthUnit n + => n -- ^ length of data to be copied + -> ByteString -- ^ The source byte string + -> 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 + +-- | 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 + +-- | Get the value from the bytestring using `peek`. +fromByteStringStorable :: Storable k => ByteString -> k +fromByteStringStorable src = unsafePerformIO $ withByteString src (peek . castPtr) + +-- | 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 + +---------------------- Hexadecimal encoding. ----------------------------------- diff --git a/Raaz/Core/Write.hs b/Raaz/Core/Write.hs new file mode 100644 --- /dev/null +++ b/Raaz/Core/Write.hs @@ -0,0 +1,147 @@ +-- | 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 diff --git a/Raaz/Hash.hs b/Raaz/Hash.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash.hs @@ -0,0 +1,87 @@ +{-| + +This module exposes all the cryptographic hash functions available +under the raaz library. + +-} + +module Raaz.Hash + ( + -- * Cryptographic hashes and hmacs. + -- $computingHash$ + + -- ** Encoding and displaying. + -- $encoding$ + -- + Hash, hash, hashFile, hashSource + , HMAC, hmac, hmacFile, hmacSource + -- * Exposing individual hashes. + -- $individualHashes$ + + , module Raaz.Hash.Sha1 + , module Raaz.Hash.Sha224 + , module Raaz.Hash.Sha256 + , module Raaz.Hash.Sha384 + , module Raaz.Hash.Sha512 + -- , module Raaz.Hash.Blake256 + + ) where + +-- import Raaz.Hash.Blake256 +import Raaz.Hash.Sha1 +import Raaz.Hash.Sha224 +import Raaz.Hash.Sha256 +import Raaz.Hash.Sha384 +import Raaz.Hash.Sha512 + +import Raaz.Hash.Internal ( Hash, hash, hashFile, hashSource ) +import Raaz.Hash.Internal.HMAC ( HMAC, hmac, hmacFile, hmacSource ) + +-- $computingHash$ +-- +-- The cryptographic hashes provided by raaz give the following +-- guarantees: +-- +-- 1. Distinct hashes are distinct types and hence it is a compiler +-- error to compare two different hashes. +-- +-- 2. A hash and its associated hmac are distinct types and hence +-- it is an compile time error to compare a hash with its hmac. +-- +-- 3. The `Eq` instance for hashes and the corresponding hmacs use +-- a constant time equality test and hence it is safe to check +-- equality using the operator `==`. +-- +-- The functions `hash`, `hashFile`, and `hashSource` provide a rather +-- high level interface for computing hashes. For hmacs the associated +-- functions are `hmac`, `hmacFile`, and `hmacSource` + +-- $encoding$ +-- +-- When interfacing with other applications or when printing output to +-- users, it is often necessary to encode hash, hmac or their keys as +-- strings. Applications usually present hashes encoded in base16. The +-- `Show` and `Data.String.IsString` instances for the hashes exposed +-- here follow this convention. +-- +-- More generaly, hashes, hmacs and their key are instances of type +-- class `Raaz.Core.Encode.Encodable` and can hence can be encoded in +-- any of the formats supported in raaz. + +-- $individualHashes$ +-- +-- Individual hash and hmacs are exposed via their respective modules. +-- These module also export the specialized variants for `hashSource`, +-- `hash` and `hashFile` for specific hashes. For example, if you are +-- interested only in say `SHA512` you can import the module +-- "Raaz.Hash.Sha512". This will expose the functions `sha512Source`, +-- `sha512` and `sha512File` which are specialized variants of +-- `hashSource` `hash` and `hashFile` respectively for the hash +-- `SHA512`. For example, if you want to print the sha512 checksum of +-- a file, you can use the following. +-- +-- > sha512Checksum :: FilePath -> IO () +-- > -- print the sha512 checksum of a given file. +-- > sha512Checksum fname = sha512File fname >>= print + +{-# ANN module "HLint: ignore Use import/export shortcut" #-} diff --git a/Raaz/Hash/Internal.hs b/Raaz/Hash/Internal.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Internal.hs @@ -0,0 +1,265 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ConstraintKinds #-} + +-- | This module exposes the low-level internal details of +-- cryptographic hashes. Do not import this module unless you want to +-- implement a new hash or give a new implementation of an existing +-- hash. +module Raaz.Hash.Internal + ( -- * Cryptographic hashes and their implementations. + -- $hashdoc$ + Hash(..) + , hash, hashFile, hashSource + -- ** Computing hashes using non-standard implementations. + , hash', hashFile', hashSource' + -- * Hash implementations. + , HashI(..), SomeHashI(..), HashM + -- ** Implementation of truncated hashes. + , truncatedI + -- * Memory used by most hashes. + , HashMemory(..), extractLength, updateLength + -- * Some low level functions. + , completeHashing + ) where + + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import Data.Word +import Foreign.Storable +import System.IO +import System.IO.Unsafe (unsafePerformIO) + +import Raaz.Core + +-- $hashdoc$ +-- +-- Each cryptographic hash is a distinct type and are instances of a +-- the type class `Hash`. The standard idiom that we follow for hash +-- implementations are the following: +-- +-- [`HashI`:] This type captures implementations of a the hash. This +-- type is parameterised over the memory element used by the +-- implementation. +-- +-- [`SomeHashI`:] This type is the existentially quantified version of +-- `HashI` over its memory element. Thus it exposes only the interface +-- and not the internals of the implementation. The `Implementation` +-- associated type of a hash is the type `SomeHashI` +-- +-- To support a new hash, a developer needs to: +-- +-- 1. Define a new type which captures the result of hashing. This +-- type should be an instance of the class `Hash`. +-- +-- 2. Define an implementation, i.e. a value of the type `SomeHashI`. +-- +-- 3. Define a recommended implementation, i.e. an instance of the +-- type class `Raaz.Core.Primitives.Recommendation` + +-------------------- Hash Implementations -------------------------- + +-- | The Hash implementation. Implementations should ensure the +-- following. +-- +-- 1. The action @compress impl ptr blks@ should only read till the +-- @blks@ offset starting at ptr and never write any data. +-- +-- 2. The action @padFinal impl ptr byts@ should touch at most +-- @⌈byts/blocksize⌉ + padBlocks@ blocks starting at ptr. It should +-- not write anything till the @byts@ offset but may write stuff +-- beyond that. +-- +-- An easy to remember this rule is to remember that computing hash of +-- a payload should not modify the payload. +-- +data HashI h m = HashI + { hashIName :: String + , hashIDescription :: String + , compress :: Pointer -> BLOCKS h -> MT m () + -- ^ compress the blocks, + , compressFinal :: Pointer -> BYTES Int -> MT m () + -- ^ pad and process the final bytes, + } + +-- | The constraints that a memory used by a hash implementation +-- should satisfy. +type HashM h m = (Initialisable m (), Extractable m h) + +-- | Some implementation of a given hash. The existentially +-- quantification allows us freedom to choose the best memory type +-- suitable for each implementations. +data SomeHashI h = forall m . HashM h m => + SomeHashI (HashI h m) + +instance Describable (HashI h m) where + name = hashIName + description = hashIDescription + + +instance Describable (SomeHashI h) where + name (SomeHashI hI) = name hI + description (SomeHashI hI) = description hI + + +-- | Certain hashes are essentially bit-truncated versions of other +-- hashes. For example, SHA224 is obtained from SHA256 by dropping the +-- last 32-bits. This combinator can be used build an implementation +-- of truncated hash from the implementation of its parent hash. +truncatedI :: (BLOCKS htrunc -> BLOCKS h) + -> (mtrunc -> m) + -> HashI h m -> HashI htrunc mtrunc +truncatedI coerce unMtrunc (HashI{..}) + = HashI { hashIName = hashIName + , hashIDescription = hashIDescription + , compress = comp + , compressFinal = compF + } + where comp ptr = liftSubMT unMtrunc . compress ptr . coerce + compF ptr = liftSubMT unMtrunc . compressFinal ptr + +---------------------- The Hash class --------------------------------- + +-- | Type class capturing a cryptographic hash. +class ( Primitive h + , EndianStore h + , Encodable h + , Eq h + , Implementation h ~ SomeHashI h + ) => Hash h where + -- | Cryptographic hashes can be computed for messages that are not + -- a multiple of the block size. This combinator computes the + -- maximum size of padding that can be attached to a message. + additionalPadBlocks :: h -> BLOCKS h + +---------------------- Helper combinators -------------------------- + +-- | Compute the hash of a pure byte source like, `B.ByteString`. +hash :: ( Hash h, Recommendation h, PureByteSource src ) + => src -- ^ Message + -> h +hash = unsafePerformIO . hashSource +{-# INLINEABLE hash #-} +{-# SPECIALIZE hash :: (Hash h, Recommendation h) => B.ByteString -> h #-} +{-# SPECIALIZE hash :: (Hash h, Recommendation h) => L.ByteString -> h #-} + +-- | Compute the hash of file. +hashFile :: ( Hash h, Recommendation h) + => FilePath -- ^ File to be hashed + -> IO h +hashFile fileName = withBinaryFile fileName ReadMode hashSource +{-# INLINEABLE hashFile #-} + + +-- | Compute the hash of a generic byte source. +hashSource :: ( Hash h, Recommendation h, ByteSource src ) + => src -- ^ Message + -> IO h +hashSource = go undefined + where go :: (Hash h, Recommendation h, ByteSource src) => h -> src -> IO h + go h = hashSource' $ recommended h + +{-# INLINEABLE hashSource #-} +{-# SPECIALIZE hashSource :: (Hash h, Recommendation h) => Handle -> IO h #-} + + +-- | Similar to `hash` but the user can specify the implementation to +-- use. +hash' :: ( PureByteSource src + , Hash h + ) + => Implementation h -- ^ Implementation + -> src -- ^ the message as a byte source. + -> h +hash' imp = unsafePerformIO . hashSource' imp +{-# INLINEABLE hash' #-} + + +-- | Similar to hashFile' but the user can specify the implementation +-- to use. +hashFile' :: Hash h + => Implementation h -- ^ Implementation + -> FilePath -- ^ File to be hashed + -> IO h +hashFile' imp fileName = withBinaryFile fileName ReadMode $ hashSource' imp +{-# INLINEABLE hashFile' #-} + + +-- | Similar to @hashSource@ but the user can specify the +-- implementation to use. +hashSource' :: (Hash h, ByteSource src) + => Implementation h + -> src + -> IO h +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). +completeHashing :: (Hash h, ByteSource src, HashM h m) + => HashI h m + -> src + -> MT m h +completeHashing (HashI{..}) src = + allocate totalSize $ \ 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 + +----------------------- Hash memory ---------------------------------- + +-- | Computing cryptographic hashes usually involves chunking the +-- message into blocks and compressing one block at a time. Usually +-- this compression makes use of the hash of the previous block and +-- the length of the message seen so far to compressing the current +-- block. Most implementations therefore need to keep track of only +-- hash and the length of the message seen so. This memory can be used +-- in such situations. +data HashMemory h = + HashMemory + { hashCell :: MemoryCell h + -- ^ Cell to store the hash + , messageLengthCell :: MemoryCell (BITS Word64) + -- ^ Cell to store the length + } + +instance Storable h => Memory (HashMemory h) where + + memoryAlloc = HashMemory <$> memoryAlloc <*> memoryAlloc + + underlyingPtr = underlyingPtr . hashCell + +instance Storable h => Initialisable (HashMemory h) h where + initialise h = do + liftSubMT hashCell $ initialise h + liftSubMT messageLengthCell $ initialise (0 :: BITS Word64) + +instance Storable h => Extractable (HashMemory h) h where + extract = liftSubMT hashCell extract + +-- | Extract the length of the message hashed so far. +extractLength :: MT (HashMemory h) (BITS Word64) +extractLength = liftSubMT 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 +) + where nBits :: BITS Word64 + nBits = inBits u diff --git a/Raaz/Hash/Internal/HMAC.hs b/Raaz/Hash/Internal/HMAC.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Internal/HMAC.hs @@ -0,0 +1,221 @@ +-- |The HMAC construction for a cryptographic hash + + +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ConstraintKinds #-} +module Raaz.Hash.Internal.HMAC + ( HMAC (..) + -- * Combinators for computing HMACs + , hmac, hmacFile, hmacSource + -- ** Computing HMACs using non-standard implementations. + , hmac', hmacFile', hmacSource' + ) where + +import Control.Applicative +import Control.Monad.IO.Class (liftIO) +import Data.Bits (xor) +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import Data.Monoid +import Data.String +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.Parse.Applicative +import Raaz.Core.Write + +import Raaz.Hash.Internal + +--------------------------- The HMAC Key ----------------------------- + +-- | The HMAC key type. The HMAC keys are usually of size at most the +-- block size of the associated hash, although the hmac construction +-- allows using keys arbitrary size. Using keys of small size, in +-- particular smaller than the size of the corresponding hash, can can +-- compromise security. +-- +-- == A note on `Show` and `IsString` instances of keys. +-- +-- As any other cryptographic type HMAC keys also have a `IsString` +-- and `Show` instance which is essentially the key expressed in +-- base16. Keys larger than the block size of the underlying hashes +-- are shortened by applying the appropriate hash. As a result the +-- `show` and `fromString` need not be inverses of each other. +-- +newtype HMACKey h = HMACKey { unKey :: B.ByteString } deriving Monoid + +instance (Hash h, Recommendation h) => Storable (HMACKey h) where + + sizeOf _ = fromIntegral $ blockSize (undefined :: h) + + alignment _ = alignment (undefined :: Align) + + peek = unsafeRunParser (HMACKey <$> parseByteString (blockSize (undefined :: h))) . castPtr + + poke ptr key = unsafeWrite (writeByteString $ hmacAdjustKey key) $ castPtr ptr + +hmacAdjustKey :: (Hash h, Recommendation h, Encodable h) + => HMACKey h -- ^ the key. + -> ByteString +hmacAdjustKey key = padIt trimedKey + where keyStr = unKey key + trimedKey = if length keyStr > sz + then toByteString + $ hash keyStr `asTypeOf` theHash key + else keyStr + padIt k = k <> replicate (sz - length k) 0 + sz = blockSize $ theHash key + theHash :: HMACKey h -> h + theHash _ = undefined + +instance (Hash h, Recommendation h, Encodable h) => EndianStore (HMACKey h) where + store = poke . castPtr + load = peek . castPtr + +instance (Hash h, Recommendation h, Encodable h) => Random (HMACKey h) + +instance (Hash h, Recommendation h, Encodable h) => Encodable (HMACKey h) + +-- | Base16 representation of the string. +instance IsString (HMACKey h) where + fromString = HMACKey + . (decodeFormat :: Base16 -> ByteString) + . fromString + +instance Show (HMACKey h) where + show = show . (encodeByteString :: ByteString -> Base16) . unKey + +---------------- The HMAC type ----------------------------------------- + +-- | The HMAC associated to a hash value. The HMAC type is essentially +-- the underlying hash type wrapped inside a newtype. Therefore, the +-- `Eq` instance for HMAC is essentially the `Eq` instance for the +-- underlying hash. It is safe against timing attack provided the +-- underlying hash comparison is safe under timing attack. +newtype HMAC h = HMAC {unHMAC :: h} deriving ( Eq, Storable + , EndianStore + , Encodable + , IsString + ) +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 + +-- | Compute the hash of a pure byte source like, `B.ByteString`. +hmac :: ( Hash h, Recommendation h, PureByteSource src ) + => Key (HMAC h) + -> src -- ^ Message + -> HMAC h +hmac key = unsafePerformIO . hmacSource key +{-# INLINEABLE hmac #-} +{-# SPECIALIZE hmac :: (Hash h, Recommendation h) => Key (HMAC h) -> B.ByteString -> HMAC h #-} +{-# SPECIALIZE hmac :: (Hash h, Recommendation h) => Key (HMAC h) -> L.ByteString -> HMAC h #-} + +-- | Compute the hash of file. +hmacFile :: (Hash h, Recommendation h) + => Key (HMAC h) + -> FilePath -- ^ File to be hashed + -> IO (HMAC h) +hmacFile key fileName = withBinaryFile fileName ReadMode $ hmacSource key +{-# INLINEABLE hmacFile #-} + +-- | Compute the hash of a generic byte source. +hmacSource :: ( Hash h, Recommendation h, ByteSource src ) + => Key (HMAC h) + -> src -- ^ Message + -> IO (HMAC h) +hmacSource = go undefined + where go :: (Hash h, Recommendation h, ByteSource src) + => h -> Key (HMAC h) -> src -> IO (HMAC h) + go h = hmacSource' (recommended h) + +{-# INLINEABLE hmacSource #-} +{-# SPECIALIZE hmacSource :: (Hash h, Recommendation h) => Key (HMAC h) -> Handle -> IO (HMAC h) #-} + + +-- | Compute the hash of a pure byte source like, `B.ByteString`. +hmac' :: ( Hash h, Recommendation h, PureByteSource src ) + => Implementation h + -> Key (HMAC h) + -> src -- ^ Message + -> HMAC h +hmac' impl key = unsafePerformIO . hmacSource' impl key +{-# INLINEABLE hmac' #-} +{-# SPECIALIZE hmac' :: (Hash h, Recommendation h) + => Implementation h + -> Key (HMAC h) + -> B.ByteString + -> HMAC h + #-} +{-# SPECIALIZE hmac' :: (Hash h, Recommendation h) + => Implementation h + -> Key (HMAC h) + -> L.ByteString + -> HMAC h + #-} + + +-- | Compute the hash of file. +hmacFile' :: (Hash h, Recommendation h) + => Implementation h + -> Key (HMAC h) + -> FilePath -- ^ File to be hashed + -> IO (HMAC h) +hmacFile' impl key fileName = withBinaryFile fileName ReadMode $ hmacSource' impl key +{-# INLINEABLE hmacFile' #-} + + +hmacSource' :: (Hash h, Recommendation h, ByteSource src) + => Implementation h + -> Key (HMAC h) + -> src + -> IO (HMAC h) +hmacSource' (SomeHashI hI) key src = + insecurely $ do + + -- Hash the first block for the inner hash + initialise () + allocate bufSize $ \ ptr -> do + liftIO $ unsafeCopyToPointer innerFirstBlock ptr + compress hI ptr 1 + + -- Finish it by hashing the source. + innerHash <- completeHashing hI src + + + -- Hash the outer block. + initialise () + allocate bufSize $ \ 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 + outerFirstBlock = B.map (xor 0x5c) $ hmacAdjustKey key + bufSize = length innerFirstBlock diff --git a/Raaz/Hash/Sha/Util.hs b/Raaz/Hash/Sha/Util.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha/Util.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +module Raaz.Hash.Sha.Util + ( shaImplementation, portableC + , length64Write + , length128Write + , Compressor + ) where + +import Control.Monad.IO.Class +import Data.Monoid ( (<>) ) +import Data.Word +import Foreign.Storable + +import Raaz.Core +import Raaz.Core.Write +import Raaz.Hash.Internal + + +-- | 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 () + +-- | 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 + } + +{-# 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" + + + +-- | 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 + 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 + +-- | 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 + +-- | 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 diff --git a/Raaz/Hash/Sha1.hs b/Raaz/Hash/Sha1.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha1.hs @@ -0,0 +1,61 @@ +{-| + +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" #-} + ( + -- * The SHA1 cryptographic hash + SHA1 + , sha1, sha1File, sha1Source + -- * HMAC computation using SHA1 + , hmacSha1, hmacSha1File, hmacSha1Source + ) where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L + +import Raaz.Core + +import Raaz.Hash.Internal ( hashSource, hash, hashFile ) +import Raaz.Hash.Internal.HMAC ( hmacSource, hmac, hmacFile, HMAC ) +import Raaz.Hash.Sha1.Internal ( SHA1 ) +import Raaz.Hash.Sha1.Recommendation() + +{-# DEPRECATED sha1, sha1File, sha1Source + "SHA1 is almost broken, avoid it as much as possible" #-} +-- | 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 +sha1 = hash + + +{-# SPECIALIZE sha1 :: B.ByteString -> SHA1 #-} +{-# SPECIALIZE sha1 :: L.ByteString -> SHA1 #-} + + +-- | Compute the sha1 hash of a file. +sha1File :: FilePath -> IO SHA1 +sha1File = hashFile + +-- | Compute the sha1 hash of a general byte source. +sha1Source :: ByteSource src => src -> IO SHA1 +sha1Source = hashSource + + +{-# DEPRECATED hmacSha1, hmacSha1File, hmacSha1Source + "SHA1 is almost broken, avoid it for hmac-ing" #-} + +-- | Compute the message authentication code using hmac-sha1. +hmacSha1 :: PureByteSource src => Key (HMAC SHA1) -> src -> HMAC SHA1 +hmacSha1 = hmac + +-- | Compute the message authentication code for a file. +hmacSha1File :: Key (HMAC SHA1) -> FilePath -> IO (HMAC SHA1) +hmacSha1File = hmacFile + +-- | Compute the message authetication code for a generic byte source. +hmacSha1Source :: ByteSource src => Key (HMAC SHA1) -> src -> IO (HMAC SHA1) +hmacSha1Source = hmacSource diff --git a/Raaz/Hash/Sha1/Implementation/CPortable.hs b/Raaz/Hash/Sha1/Implementation/CPortable.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha1/Implementation/CPortable.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +-- | The portable C-implementation of SHA1 +module Raaz.Hash.Sha1.Implementation.CPortable + ( implementation + ) where + +import Raaz.Core +import Raaz.Hash.Internal +import Raaz.Hash.Sha.Util +import Raaz.Hash.Sha1.Internal + +-- | The portable C implementation of SHA1. +implementation :: Implementation SHA1 +implementation = SomeHashI cPortable + +cPortable :: HashI SHA1 (HashMemory SHA1) +cPortable = portableC c_sha1_compress length64Write + +foreign import ccall unsafe + "raaz/hash/sha1/portable.h raazHashSha1PortableCompress" + c_sha1_compress :: Pointer -> Int -> Pointer -> IO () diff --git a/Raaz/Hash/Sha1/Internal.hs b/Raaz/Hash/Sha1/Internal.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha1/Internal.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} + +{-# LANGUAGE MultiParamTypeClasses #-} +{-# CFILES raaz/hash/sha1/portable.c #-} + +{-| + +This module exposes the `SHA1` hash constructor. You would hardly need +to import the module directly as you would want to treat the `SHA1` +type as an opaque type for type safety. This module is exported only +for special uses like writing a test case or defining a binary +instance etc. + +-} + +module Raaz.Hash.Sha1.Internal (SHA1(..)) where + +import Data.String +import Data.Word +import Foreign.Storable ( Storable(..) ) + +import Raaz.Core + +import Raaz.Hash.Internal + +-- | The cryptographic hash SHA1. +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 + fromString = fromBase16 + +instance Show SHA1 where + show = showBase16 + +instance Initialisable (HashMemory SHA1) () where + initialise _ = initialise $ SHA1 $ unsafeFromList [ 0x67452301 + , 0xefcdab89 + , 0x98badcfe + , 0x10325476 + , 0xc3d2e1f0 + ] + + +instance Primitive SHA1 where + blockSize _ = BYTES 64 + type Implementation SHA1 = SomeHashI SHA1 + +instance Hash SHA1 where + additionalPadBlocks _ = 1 diff --git a/Raaz/Hash/Sha1/Recommendation.hs b/Raaz/Hash/Sha1/Recommendation.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha1/Recommendation.hs @@ -0,0 +1,15 @@ +-- | This sets up the recommended implementation of Sha1. +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- +-- The orphan instance declaration separates the implementation and +-- setting the recommended instances. Therefore, we ignore the warning. +-- + +module Raaz.Hash.Sha1.Recommendation where + +import Raaz.Core +import Raaz.Hash.Sha1.Internal +import qualified Raaz.Hash.Sha1.Implementation.CPortable as CPortable + +instance Recommendation SHA1 where + recommended _ = CPortable.implementation diff --git a/Raaz/Hash/Sha224.hs b/Raaz/Hash/Sha224.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha224.hs @@ -0,0 +1,61 @@ +{-| + +This module exposes combinators to compute the SHA224 hash and the +associated HMAC for some common types. + +-} + +module Raaz.Hash.Sha224 + ( -- * The SHA224 cryptographic hash + SHA224 + , sha224, sha224File, sha224Source + -- * HMAC computation using SHA224 + , hmacSha224, hmacSha224File, hmacSha224Source + ) where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L + +import Raaz.Core + +import Raaz.Hash.Internal ( hashSource, hash, hashFile ) +import Raaz.Hash.Internal.HMAC ( hmacSource, hmac, hmacFile, HMAC ) +import Raaz.Hash.Sha224.Internal ( SHA224 ) +import Raaz.Hash.Sha224.Recommendation() + +-- | Compute the sha224 hash of an instance of `PureByteSource`. Use +-- this for computing the sha224 hash of a strict or lazy byte string. +sha224 :: PureByteSource src => src -> SHA224 +sha224 = hash +{-# SPECIALIZE sha224 :: B.ByteString -> SHA224 #-} +{-# SPECIALIZE sha224 :: L.ByteString -> SHA224 #-} + + +-- | Compute the sha224 hash of a file. +sha224File :: FilePath -> IO SHA224 +sha224File = hashFile + +-- | Compute the sha224 hash of a general byte source. +sha224Source :: ByteSource src => src -> IO SHA224 +sha224Source = hashSource + +-- | Compute the message authentication code using hmac-sha224. +hmacSha224 :: PureByteSource src + => Key (HMAC SHA224) -- ^ Key to use + -> src -- ^ pure source whose hmac is to be + -- computed + -> HMAC SHA224 +hmacSha224 = hmac + +-- | Compute the message authentication code for a file. +hmacSha224File :: Key (HMAC SHA224) -- ^ Key to use + -> FilePath -- ^ File whose hmac is to be computed + -> IO (HMAC SHA224) +hmacSha224File = hmacFile + +-- | Compute the message authetication code for a generic byte source. +hmacSha224Source :: ByteSource src + => Key (HMAC SHA224) + -> src + -> IO (HMAC SHA224) +hmacSha224Source = hmacSource diff --git a/Raaz/Hash/Sha224/Implementation/CPortable.hs b/Raaz/Hash/Sha224/Implementation/CPortable.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha224/Implementation/CPortable.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE MultiParamTypeClasses #-} +-- | The portable C-implementation of SHA224 +module Raaz.Hash.Sha224.Implementation.CPortable + ( implementation + ) where + +import Control.Applicative +import Raaz.Core +import Raaz.Hash.Internal +import Raaz.Hash.Sha224.Internal + +import Raaz.Hash.Sha256.Internal ( SHA256(..) ) +import qualified Raaz.Hash.Sha256.Implementation.CPortable as SHA256I + + +newtype SHA224Memory = SHA224Memory { unSHA224Mem :: HashMemory SHA256 } + +instance Memory SHA224Memory where + memoryAlloc = SHA224Memory <$> memoryAlloc + underlyingPtr = underlyingPtr . unSHA224Mem + +instance Initialisable SHA224Memory () where + initialise _ = liftSubMT unSHA224Mem $ + initialise $ SHA256 $ unsafeFromList [ 0xc1059ed8 + , 0x367cd507 + , 0x3070dd17 + , 0xf70e5939 + , 0xffc00b31 + , 0x68581511 + , 0x64f98fa7 + , 0xbefa4fa4 + ] + +instance Extractable SHA224Memory SHA224 where + extract = trunc <$> liftSubMT unSHA224Mem extract + where trunc (SHA256 tup) = SHA224 $ initial tup + +-- | The portable C implementation of SHA224. +implementation :: Implementation SHA224 +implementation = SomeHashI cPortable + +cPortable :: HashI SHA224 SHA224Memory +cPortable = truncatedI fromIntegral unSHA224Mem SHA256I.cPortable diff --git a/Raaz/Hash/Sha224/Internal.hs b/Raaz/Hash/Sha224/Internal.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha224/Internal.hs @@ -0,0 +1,50 @@ +{-| + +This module exposes the `SHA224` hash constructor. You would hardly +need to import the module directly as you would want to treat the +`SHA224` type as an opaque type for type safety. This module is +exported only for special uses like writing a test case or defining a +binary instance etc. + +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# CFILES raaz/hash/sha1/portable.c #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DataKinds #-} + +module Raaz.Hash.Sha224.Internal + ( SHA224(..) + ) where + +import Data.String +import Data.Word +import Foreign.Storable ( Storable ) + +import Raaz.Core +import Raaz.Hash.Internal + +----------------------------- SHA224 ------------------------------------------- + +-- | Sha224 hash value which consist of 7 32bit words. +newtype SHA224 = SHA224 (Tuple 7 (BE Word32)) + deriving (Eq, Equality, Storable, EndianStore) + +instance Encodable SHA224 + +instance IsString SHA224 where + fromString = fromBase16 + +instance Show SHA224 where + show = showBase16 + +instance Primitive SHA224 where + blockSize _ = BYTES 64 + type Implementation SHA224 = SomeHashI SHA224 + +instance Hash SHA224 where + additionalPadBlocks _ = 1 diff --git a/Raaz/Hash/Sha224/Recommendation.hs b/Raaz/Hash/Sha224/Recommendation.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha224/Recommendation.hs @@ -0,0 +1,15 @@ +-- | This sets up the recommended implementation of Sha224. +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- +-- The orphan instance declaration separates the implementation and +-- setting the recommended instances. Therefore, we ignore the warning. +-- + +module Raaz.Hash.Sha224.Recommendation where + +import Raaz.Core +import Raaz.Hash.Sha224.Internal +import qualified Raaz.Hash.Sha224.Implementation.CPortable as CPortable + +instance Recommendation SHA224 where + recommended _ = CPortable.implementation diff --git a/Raaz/Hash/Sha256.hs b/Raaz/Hash/Sha256.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha256.hs @@ -0,0 +1,61 @@ +{-| + +This module exposes combinators to compute the SHA256 hash and the +associated HMAC for some common types. + +-} + +module Raaz.Hash.Sha256 + ( -- * The SHA256 cryptographic hash + SHA256 + , sha256, sha256File, sha256Source + -- * HMAC computation using SHA256 + , hmacSha256, hmacSha256File, hmacSha256Source + ) where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L + +import Raaz.Core + +import Raaz.Hash.Internal ( hashSource, hash, hashFile ) +import Raaz.Hash.Internal.HMAC ( hmacSource, hmac, hmacFile, HMAC ) +import Raaz.Hash.Sha256.Internal ( SHA256 ) +import Raaz.Hash.Sha256.Recommendation() + +-- | Compute the sha256 hash of an instance of `PureByteSource`. Use +-- this for computing the sha256 hash of a strict or lazy byte string. +sha256 :: PureByteSource src => src -> SHA256 +sha256 = hash +{-# SPECIALIZE sha256 :: B.ByteString -> SHA256 #-} +{-# SPECIALIZE sha256 :: L.ByteString -> SHA256 #-} + + +-- | Compute the sha256 hash of a file. +sha256File :: FilePath -> IO SHA256 +sha256File = hashFile + +-- | Compute the sha256 hash of a general byte source. +sha256Source :: ByteSource src => src -> IO SHA256 +sha256Source = hashSource + +-- | Compute the message authentication code using hmac-sha256. +hmacSha256 :: PureByteSource src + => Key (HMAC SHA256) -- ^ Key to use + -> src -- ^ pure source whose hmac is to be + -- computed + -> HMAC SHA256 +hmacSha256 = hmac + +-- | Compute the message authentication code for a file. +hmacSha256File :: Key (HMAC SHA256) -- ^ Key to use + -> FilePath -- ^ File whose hmac is to be computed + -> IO (HMAC SHA256) +hmacSha256File = hmacFile + +-- | Compute the message authetication code for a generic byte source. +hmacSha256Source :: ByteSource src + => Key (HMAC SHA256) + -> src + -> IO (HMAC SHA256) +hmacSha256Source = hmacSource diff --git a/Raaz/Hash/Sha256/Implementation/CPortable.hs b/Raaz/Hash/Sha256/Implementation/CPortable.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha256/Implementation/CPortable.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +-- | The portable C-implementation of SHA1 +module Raaz.Hash.Sha256.Implementation.CPortable + ( implementation, cPortable + ) where + +import Raaz.Core +import Raaz.Hash.Internal +import Raaz.Hash.Sha.Util +import Raaz.Hash.Sha256.Internal + +-- | The portable C implementation of SHA256. +implementation :: Implementation SHA256 +implementation = SomeHashI cPortable + +cPortable :: HashI SHA256 (HashMemory SHA256) +cPortable = portableC c_sha256_compress length64Write + +foreign import ccall unsafe + "raaz/hash/sha256/portable.h raazHashSha256PortableCompress" + c_sha256_compress :: Pointer -> Int -> Pointer -> IO () diff --git a/Raaz/Hash/Sha256/Internal.hs b/Raaz/Hash/Sha256/Internal.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha256/Internal.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# CFILES raaz/hash/sha1/portable.c #-} + +module Raaz.Hash.Sha256.Internal + ( SHA256(..) + ) where + + +import Data.String +import Data.Word +import Foreign.Storable ( Storable ) + +import Raaz.Core + +import Raaz.Hash.Internal + +----------------------------- SHA256 ------------------------------------------- + +-- | The Sha256 hash value. +newtype SHA256 = SHA256 (Tuple 8 (BE Word32)) + deriving (Eq, Equality, Storable, EndianStore) + +instance Encodable SHA256 + +instance IsString SHA256 where + fromString = fromBase16 + +instance Show SHA256 where + show = showBase16 + +instance Initialisable (HashMemory SHA256) () where + initialise _ = initialise $ SHA256 $ unsafeFromList [ 0x6a09e667 + , 0xbb67ae85 + , 0x3c6ef372 + , 0xa54ff53a + , 0x510e527f + , 0x9b05688c + , 0x1f83d9ab + , 0x5be0cd19 + ] + +instance Primitive SHA256 where + blockSize _ = BYTES 64 + type Implementation SHA256 = SomeHashI SHA256 + +instance Hash SHA256 where + additionalPadBlocks _ = 1 diff --git a/Raaz/Hash/Sha256/Recommendation.hs b/Raaz/Hash/Sha256/Recommendation.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha256/Recommendation.hs @@ -0,0 +1,15 @@ +-- | This sets up the recommended implementation of Sha256. +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- +-- The orphan instance declaration separates the implementation and +-- setting the recommended instances. Therefore, we ignore the warning. +-- + +module Raaz.Hash.Sha256.Recommendation where + +import Raaz.Core +import Raaz.Hash.Sha256.Internal +import qualified Raaz.Hash.Sha256.Implementation.CPortable as CPortable + +instance Recommendation SHA256 where + recommended _ = CPortable.implementation diff --git a/Raaz/Hash/Sha384.hs b/Raaz/Hash/Sha384.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha384.hs @@ -0,0 +1,61 @@ +{-| + +This module exposes combinators to compute the SHA384 hash and the +associated HMAC for some common types. + +-} + +module Raaz.Hash.Sha384 + ( -- * The SHA384 cryptographic hash + SHA384 + , sha384, sha384File, sha384Source + -- * HMAC computation using SHA384 + , hmacSha384, hmacSha384File, hmacSha384Source + ) where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L + +import Raaz.Core + +import Raaz.Hash.Internal ( hashSource, hash, hashFile ) +import Raaz.Hash.Internal.HMAC ( hmacSource, hmac, hmacFile, HMAC ) +import Raaz.Hash.Sha384.Internal ( SHA384 ) +import Raaz.Hash.Sha384.Recommendation() + +-- | Compute the sha384 hash of an instance of `PureByteSource`. Use +-- this for computing the sha384 hash of a strict or lazy byte string. +sha384 :: PureByteSource src => src -> SHA384 +sha384 = hash +{-# SPECIALIZE sha384 :: B.ByteString -> SHA384 #-} +{-# SPECIALIZE sha384 :: L.ByteString -> SHA384 #-} + + +-- | Compute the sha384 hash of a file. +sha384File :: FilePath -> IO SHA384 +sha384File = hashFile + +-- | Compute the sha384 hash of a general byte source. +sha384Source :: ByteSource src => src -> IO SHA384 +sha384Source = hashSource + +-- | Compute the message authentication code using hmac-sha384. +hmacSha384 :: PureByteSource src + => Key (HMAC SHA384) -- ^ Key to use + -> src -- ^ pure source whose hmac is to be + -- computed + -> HMAC SHA384 +hmacSha384 = hmac + +-- | Compute the message authentication code for a file. +hmacSha384File :: Key (HMAC SHA384) -- ^ Key to use + -> FilePath -- ^ File whose hmac is to be computed + -> IO (HMAC SHA384) +hmacSha384File = hmacFile + +-- | Compute the message authetication code for a generic byte source. +hmacSha384Source :: ByteSource src + => Key (HMAC SHA384) + -> src + -> IO (HMAC SHA384) +hmacSha384Source = hmacSource diff --git a/Raaz/Hash/Sha384/Implementation/CPortable.hs b/Raaz/Hash/Sha384/Implementation/CPortable.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha384/Implementation/CPortable.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE MultiParamTypeClasses #-} +-- | The portable C-implementation of SHA384 +module Raaz.Hash.Sha384.Implementation.CPortable + ( implementation + ) where + +import Control.Applicative +import Raaz.Core +import Raaz.Hash.Internal +import Raaz.Hash.Sha384.Internal +import Raaz.Hash.Sha512.Internal + +import qualified Raaz.Hash.Sha512.Implementation.CPortable as SHA512I + + +newtype SHA384Memory = SHA384Memory { unSHA384Mem :: HashMemory SHA512 } + +instance Memory SHA384Memory where + memoryAlloc = SHA384Memory <$> memoryAlloc + underlyingPtr = underlyingPtr . unSHA384Mem + +instance Initialisable SHA384Memory () where + initialise _ = liftSubMT unSHA384Mem + $ initialise + $ SHA512 + $ unsafeFromList [ 0xcbbb9d5dc1059ed8 + , 0x629a292a367cd507 + , 0x9159015a3070dd17 + , 0x152fecd8f70e5939 + , 0x67332667ffc00b31 + , 0x8eb44a8768581511 + , 0xdb0c2e0d64f98fa7 + , 0x47b5481dbefa4fa4 + ] + +instance Extractable SHA384Memory SHA384 where + extract = trunc <$> liftSubMT unSHA384Mem extract + where trunc (SHA512 v) = SHA384 $ initial v + +-- | The portable C implementation of SHA384. +implementation :: Implementation SHA384 +implementation = SomeHashI cPortable + +cPortable :: HashI SHA384 SHA384Memory +cPortable = truncatedI fromIntegral unSHA384Mem SHA512I.cPortable diff --git a/Raaz/Hash/Sha384/Internal.hs b/Raaz/Hash/Sha384/Internal.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha384/Internal.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# CFILES raaz/hash/sha1/portable.c #-} + +module Raaz.Hash.Sha384.Internal + ( SHA384(..) + ) where + +import Data.String +import Data.Word +import Foreign.Storable ( Storable(..) ) + +import Raaz.Core +import Raaz.Hash.Internal + + +----------------------------- SHA384 ------------------------------------------- + +-- | The Sha384 hash value. +newtype SHA384 = SHA384 (Tuple 6 (BE Word64)) + deriving (Eq, Equality, Storable, EndianStore) + +instance Encodable SHA384 + +instance IsString SHA384 where + fromString = fromBase16 + +instance Show SHA384 where + show = showBase16 +instance Primitive SHA384 where + blockSize _ = BYTES 128 + type Implementation SHA384 = SomeHashI SHA384 + +instance Hash SHA384 where + additionalPadBlocks _ = 1 diff --git a/Raaz/Hash/Sha384/Recommendation.hs b/Raaz/Hash/Sha384/Recommendation.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha384/Recommendation.hs @@ -0,0 +1,15 @@ +-- | This sets up the recommended implementation of Sha384. +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- +-- The orphan instance declaration separates the implementation and +-- setting the recommended instances. Therefore, we ignore the warning. +-- + +module Raaz.Hash.Sha384.Recommendation where + +import Raaz.Core +import Raaz.Hash.Sha384.Internal +import qualified Raaz.Hash.Sha384.Implementation.CPortable as CPortable + +instance Recommendation SHA384 where + recommended _ = CPortable.implementation diff --git a/Raaz/Hash/Sha512.hs b/Raaz/Hash/Sha512.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha512.hs @@ -0,0 +1,61 @@ +{-| + +This module exposes combinators to compute the SHA512 hash and the +associated HMAC for some common types. + +-} + +module Raaz.Hash.Sha512 + ( -- * The SHA512 cryptographic hash + SHA512 + , sha512, sha512File, sha512Source + -- * HMAC computation using SHA512 + , hmacSha512, hmacSha512File, hmacSha512Source + ) where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L + +import Raaz.Core + +import Raaz.Hash.Internal ( hashSource, hash, hashFile ) +import Raaz.Hash.Internal.HMAC ( hmacSource, hmac, hmacFile, HMAC ) +import Raaz.Hash.Sha512.Internal ( SHA512 ) +import Raaz.Hash.Sha512.Recommendation() + +-- | Compute the sha512 hash of an instance of `PureByteSource`. Use +-- this for computing the sha512 hash of a strict or lazy byte string. +sha512 :: PureByteSource src => src -> SHA512 +sha512 = hash +{-# SPECIALIZE sha512 :: B.ByteString -> SHA512 #-} +{-# SPECIALIZE sha512 :: L.ByteString -> SHA512 #-} + + +-- | Compute the sha512 hash of a file. +sha512File :: FilePath -> IO SHA512 +sha512File = hashFile + +-- | Compute the sha512 hash of a general byte source. +sha512Source :: ByteSource src => src -> IO SHA512 +sha512Source = hashSource + +-- | Compute the message authentication code using hmac-sha512. +hmacSha512 :: PureByteSource src + => Key (HMAC SHA512) -- ^ Key to use + -> src -- ^ pure source whose hmac is to be + -- computed + -> HMAC SHA512 +hmacSha512 = hmac + +-- | Compute the message authentication code for a file. +hmacSha512File :: Key (HMAC SHA512) -- ^ Key to use + -> FilePath -- ^ File whose hmac is to be computed + -> IO (HMAC SHA512) +hmacSha512File = hmacFile + +-- | Compute the message authetication code for a generic byte source. +hmacSha512Source :: ByteSource src + => Key (HMAC SHA512) + -> src + -> IO (HMAC SHA512) +hmacSha512Source = hmacSource diff --git a/Raaz/Hash/Sha512/Implementation/CPortable.hs b/Raaz/Hash/Sha512/Implementation/CPortable.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha512/Implementation/CPortable.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +-- | The portable C-implementation of SHA1 +module Raaz.Hash.Sha512.Implementation.CPortable + ( implementation, cPortable + ) where + +import Raaz.Core +import Raaz.Hash.Internal +import Raaz.Hash.Sha.Util +import Raaz.Hash.Sha512.Internal + +-- | The portable C implementation of SHA512. +implementation :: Implementation SHA512 +implementation = SomeHashI cPortable + +cPortable :: HashI SHA512 (HashMemory SHA512) +cPortable = portableC c_sha512_compress length128Write + +foreign import ccall unsafe + "raaz/hash/sha512/portable.h raazHashSha512PortableCompress" + c_sha512_compress :: Pointer -> Int -> Pointer -> IO () diff --git a/Raaz/Hash/Sha512/Internal.hs b/Raaz/Hash/Sha512/Internal.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha512/Internal.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DataKinds #-} +{-# CFILES raaz/hash/sha1/portable.c #-} + +module Raaz.Hash.Sha512.Internal (SHA512(..)) where + + +import Data.String +import Data.Word +import Foreign.Storable ( Storable(..) ) + +import Raaz.Core + + +import Raaz.Hash.Internal + +----------------------------- SHA512 --------------------------------- + +-- | The Sha512 hash value. Used in implementation of Sha384 as well. +newtype SHA512 = SHA512 (Tuple 8 (BE Word64)) + deriving (Eq, Equality, Storable, EndianStore) + +instance Encodable SHA512 + +instance IsString SHA512 where + fromString = fromBase16 + +instance Show SHA512 where + show = showBase16 + +instance Primitive SHA512 where + blockSize _ = BYTES 128 + type Implementation SHA512 = SomeHashI SHA512 + +instance Initialisable (HashMemory SHA512) () where + initialise _ = initialise $ SHA512 + $ unsafeFromList [ 0x6a09e667f3bcc908 + , 0xbb67ae8584caa73b + , 0x3c6ef372fe94f82b + , 0xa54ff53a5f1d36f1 + , 0x510e527fade682d1 + , 0x9b05688c2b3e6c1f + , 0x1f83d9abfb41bd6b + , 0x5be0cd19137e2179 + ] + +instance Hash SHA512 where + additionalPadBlocks _ = 1 diff --git a/Raaz/Hash/Sha512/Recommendation.hs b/Raaz/Hash/Sha512/Recommendation.hs new file mode 100644 --- /dev/null +++ b/Raaz/Hash/Sha512/Recommendation.hs @@ -0,0 +1,15 @@ +-- | This sets up the recommended implementation of Sha512. +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- +-- The orphan instance declaration separates the implementation and +-- setting the recommended instances. Therefore, we ignore the warning. +-- + +module Raaz.Hash.Sha512.Recommendation where + +import Raaz.Core +import Raaz.Hash.Sha512.Internal +import qualified Raaz.Hash.Sha512.Implementation.CPortable as CPortable + +instance Recommendation SHA512 where + recommended _ = CPortable.implementation diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/benchmarks/BlazeVsWrite.hs b/benchmarks/BlazeVsWrite.hs new file mode 100644 --- /dev/null +++ b/benchmarks/BlazeVsWrite.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleInstances #-} +import Control.Monad +import Criterion +import Criterion.Main +import qualified Blaze.ByteString.Builder as BB +import qualified Blaze.ByteString.Builder.Internal.Write as BB + +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import Data.Monoid +import Data.Word +import Foreign.Ptr (castPtr) + +import Raaz.Core.Types +import qualified Raaz.Core.Write as RW +import qualified Raaz.Core.Encode as E + +-- Why 4000 entries. The result size is roughly 32k which is the L1 cache +-- size. 4 * 8 bytes * 1 kilo +maxVal :: Num n => n +maxVal = 40000 + +ws :: [Word] +ws = [1..maxVal] + +w64s :: [Word64] +w64s = [1..maxVal] + +le64s :: [LE Word64] +le64s = [1..maxVal] + +be64s :: [BE Word64] +be64s = [1..maxVal] + +main :: IO () +main = defaultMain + [ bgroup "Words" + [ bench "blaze/write" + $ nf (blazeWrite BB.writeStorable) ws + , bench "write" + $ nf (raazWrite RW.writeStorable) ws + ] + , bgroup "LE64s" + [ bench "blaze/write" + $ nf (blazeWrite BB.writeWord64le) w64s + , bench "write" + $ nf (raazWrite RW.write) le64s + ] + , bgroup "BE64s" + [ bench "blaze/write" + $ nf (blazeWrite BB.writeWord64be) w64s + , bench "write" + $ nf (raazWrite RW.write) be64s + ] + ] +blazeWrite :: (a -> BB.Write) -> [a] -> ByteString +blazeWrite fn = BB.writeToByteString . mconcat . map fn + +raazWrite :: (a -> RW.Write) -> [a] -> ByteString +raazWrite fn = E.toByteString . mconcat . map fn diff --git a/bin/checksum.lhs b/bin/checksum.lhs new file mode 100644 --- /dev/null +++ b/bin/checksum.lhs @@ -0,0 +1,316 @@ +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 diff --git a/cbits/raaz/cipher/aes/common.c b/cbits/raaz/cipher/aes/common.c new file mode 100644 --- /dev/null +++ b/cbits/raaz/cipher/aes/common.c @@ -0,0 +1,135 @@ +#include "common.h" + +static const Column rcon[] = +{ + 0x8d000000, 0x01000000, 0x02000000, 0x04000000, + 0x08000000, 0x10000000, 0x20000000, 0x40000000, + 0x80000000, 0x1b000000, 0x36000000, 0x6c000000, + 0xd8000000, 0xab000000 +}; + +/* Don't ask Don't tell Endianess policy: See header files for + * details. + */ +void raazAESExpand(int Nk, Column *eKey) +{ + Column temp; + int Nr; + int i; + switch (Nk) + { + case 4: /* AES 128 */ + Nr = 10; break; + case 6: /* AES 192 */ + Nr = 12; break; + case 8: /* AES 256 */ + Nr = 14; break; + } + for(i = Nk; i < (Nr + 1) * 4; ++i) + { + temp = eKey[i-1]; + if (i % Nk == 0) + { + temp = SBoxWord(temp); + temp = RotateL(temp,8); + temp ^= rcon[i/Nk]; + } else if ( Nk > 6 && (i % Nk == 4) ) { temp = SBoxWord(temp);} + + eKey[i] = eKey[i - Nk ] ^ temp; + } +} + +void raazAESTranspose(int n, Matrix *state) +{ + register Word w0,w1,w2,w3; + int i; + for(i = 0; i < n; ++i) + { + w0 = state[i][0]; + w1 = state[i][1]; + w2 = state[i][2]; + w3 = state[i][3]; + + state[i][0] = MkW(B3(w0),B3(w1),B3(w2),B3(w3)); + state[i][1] = MkW(B2(w0),B2(w1),B2(w2),B2(w3)); + state[i][2] = MkW(B1(w0),B1(w1),B1(w2),B1(w3)); + state[i][3] = MkW(B0(w0),B0(w1),B0(w2),B0(w3)); + + } +} + +/******************* SBOX and inverse SBOX **************/ + +const Byte sbox[256] = +{ + 0x63, 0x7c, 0x77, 0x7b, 0xf2, 0x6b, 0x6f, 0xc5, + 0x30, 0x01, 0x67, 0x2b, 0xfe, 0xd7, 0xab, 0x76, + 0xca, 0x82, 0xc9, 0x7d, 0xfa, 0x59, 0x47, 0xf0, + 0xad, 0xd4, 0xa2, 0xaf, 0x9c, 0xa4, 0x72, 0xc0, + 0xb7, 0xfd, 0x93, 0x26, 0x36, 0x3f, 0xf7, 0xcc, + 0x34, 0xa5, 0xe5, 0xf1, 0x71, 0xd8, 0x31, 0x15, + 0x04, 0xc7, 0x23, 0xc3, 0x18, 0x96, 0x05, 0x9a, + 0x07, 0x12, 0x80, 0xe2, 0xeb, 0x27, 0xb2, 0x75, + 0x09, 0x83, 0x2c, 0x1a, 0x1b, 0x6e, 0x5a, 0xa0, + 0x52, 0x3b, 0xd6, 0xb3, 0x29, 0xe3, 0x2f, 0x84, + 0x53, 0xd1, 0x00, 0xed, 0x20, 0xfc, 0xb1, 0x5b, + 0x6a, 0xcb, 0xbe, 0x39, 0x4a, 0x4c, 0x58, 0xcf, + 0xd0, 0xef, 0xaa, 0xfb, 0x43, 0x4d, 0x33, 0x85, + 0x45, 0xf9, 0x02, 0x7f, 0x50, 0x3c, 0x9f, 0xa8, + 0x51, 0xa3, 0x40, 0x8f, 0x92, 0x9d, 0x38, 0xf5, + 0xbc, 0xb6, 0xda, 0x21, 0x10, 0xff, 0xf3, 0xd2, + 0xcd, 0x0c, 0x13, 0xec, 0x5f, 0x97, 0x44, 0x17, + 0xc4, 0xa7, 0x7e, 0x3d, 0x64, 0x5d, 0x19, 0x73, + 0x60, 0x81, 0x4f, 0xdc, 0x22, 0x2a, 0x90, 0x88, + 0x46, 0xee, 0xb8, 0x14, 0xde, 0x5e, 0x0b, 0xdb, + 0xe0, 0x32, 0x3a, 0x0a, 0x49, 0x06, 0x24, 0x5c, + 0xc2, 0xd3, 0xac, 0x62, 0x91, 0x95, 0xe4, 0x79, + 0xe7, 0xc8, 0x37, 0x6d, 0x8d, 0xd5, 0x4e, 0xa9, + 0x6c, 0x56, 0xf4, 0xea, 0x65, 0x7a, 0xae, 0x08, + 0xba, 0x78, 0x25, 0x2e, 0x1c, 0xa6, 0xb4, 0xc6, + 0xe8, 0xdd, 0x74, 0x1f, 0x4b, 0xbd, 0x8b, 0x8a, + 0x70, 0x3e, 0xb5, 0x66, 0x48, 0x03, 0xf6, 0x0e, + 0x61, 0x35, 0x57, 0xb9, 0x86, 0xc1, 0x1d, 0x9e, + 0xe1, 0xf8, 0x98, 0x11, 0x69, 0xd9, 0x8e, 0x94, + 0x9b, 0x1e, 0x87, 0xe9, 0xce, 0x55, 0x28, 0xdf, + 0x8c, 0xa1, 0x89, 0x0d, 0xbf, 0xe6, 0x42, 0x68, + 0x41, 0x99, 0x2d, 0x0f, 0xb0, 0x54, 0xbb, 0x16 +}; + +/* The actual inverse box array */ + +const Byte inv_sbox[256] = +{ + 0x52, 0x09, 0x6a, 0xd5, 0x30, 0x36, 0xa5, 0x38, + 0xbf, 0x40, 0xa3, 0x9e, 0x81, 0xf3, 0xd7, 0xfb, + 0x7c, 0xe3, 0x39, 0x82, 0x9b, 0x2f, 0xff, 0x87, + 0x34, 0x8e, 0x43, 0x44, 0xc4, 0xde, 0xe9, 0xcb, + 0x54, 0x7b, 0x94, 0x32, 0xa6, 0xc2, 0x23, 0x3d, + 0xee, 0x4c, 0x95, 0x0b, 0x42, 0xfa, 0xc3, 0x4e, + 0x08, 0x2e, 0xa1, 0x66, 0x28, 0xd9, 0x24, 0xb2, + 0x76, 0x5b, 0xa2, 0x49, 0x6d, 0x8b, 0xd1, 0x25, + 0x72, 0xf8, 0xf6, 0x64, 0x86, 0x68, 0x98, 0x16, + 0xd4, 0xa4, 0x5c, 0xcc, 0x5d, 0x65, 0xb6, 0x92, + 0x6c, 0x70, 0x48, 0x50, 0xfd, 0xed, 0xb9, 0xda, + 0x5e, 0x15, 0x46, 0x57, 0xa7, 0x8d, 0x9d, 0x84, + 0x90, 0xd8, 0xab, 0x00, 0x8c, 0xbc, 0xd3, 0x0a, + 0xf7, 0xe4, 0x58, 0x05, 0xb8, 0xb3, 0x45, 0x06, + 0xd0, 0x2c, 0x1e, 0x8f, 0xca, 0x3f, 0x0f, 0x02, + 0xc1, 0xaf, 0xbd, 0x03, 0x01, 0x13, 0x8a, 0x6b, + 0x3a, 0x91, 0x11, 0x41, 0x4f, 0x67, 0xdc, 0xea, + 0x97, 0xf2, 0xcf, 0xce, 0xf0, 0xb4, 0xe6, 0x73, + 0x96, 0xac, 0x74, 0x22, 0xe7, 0xad, 0x35, 0x85, + 0xe2, 0xf9, 0x37, 0xe8, 0x1c, 0x75, 0xdf, 0x6e, + 0x47, 0xf1, 0x1a, 0x71, 0x1d, 0x29, 0xc5, 0x89, + 0x6f, 0xb7, 0x62, 0x0e, 0xaa, 0x18, 0xbe, 0x1b, + 0xfc, 0x56, 0x3e, 0x4b, 0xc6, 0xd2, 0x79, 0x20, + 0x9a, 0xdb, 0xc0, 0xfe, 0x78, 0xcd, 0x5a, 0xf4, + 0x1f, 0xdd, 0xa8, 0x33, 0x88, 0x07, 0xc7, 0x31, + 0xb1, 0x12, 0x10, 0x59, 0x27, 0x80, 0xec, 0x5f, + 0x60, 0x51, 0x7f, 0xa9, 0x19, 0xb5, 0x4a, 0x0d, + 0x2d, 0xe5, 0x7a, 0x9f, 0x93, 0xc9, 0x9c, 0xef, + 0xa0, 0xe0, 0x3b, 0x4d, 0xae, 0x2a, 0xf5, 0xb0, + 0xc8, 0xeb, 0xbb, 0x3c, 0x83, 0x53, 0x99, 0x61, + 0x17, 0x2b, 0x04, 0x7e, 0xba, 0x77, 0xd6, 0x26, + 0xe1, 0x69, 0x14, 0x63, 0x55, 0x21, 0x0c, 0x7d +}; diff --git a/cbits/raaz/cipher/aes/common.h b/cbits/raaz/cipher/aes/common.h new file mode 100644 --- /dev/null +++ b/cbits/raaz/cipher/aes/common.h @@ -0,0 +1,128 @@ +#ifndef _RAAZ_AES_COMMON_H_ +#define _RAAZ_AES_COMMON_H_ +#include +#include + +typedef uint8_t Byte; +typedef Byte Block[16]; /* The AES block */ + +/* + +Representing the AES block/state as 4 words. +-------------------------------------------- + +AES state a 4x4 matrix of bytes. This could be represented either as +4, 32-bit word each of which is a row of the matrix or 4, 32 bit words +each of which is a column. Although the C-Language will be agnostic to +our distinction and hence no type safety in this, we use such distinct +names mainly for documentation purposes + +*/ + +typedef uint32_t Word; /* A Word used in aes */ +typedef Word Row; /* A row of the aes state matrix */ +typedef Word Column; /* A column of the aes state matrix */ + +typedef Word Matrix[4]; /* AES matrix */ +typedef Row RMatrix[4]; /* AES matrix as an array of 4 rows */ +typedef Column CMatrix[4]; /* AES matrix as an array of 4 columns */ + +extern const Byte sbox[256]; /* The AES SBOX as an array */ +extern const Byte inv_sbox[256]; /* The AES inverse sbox as an array */ + + +/******************** Common functions ********************************/ +/* + +Endian assumption: Don't ask, don't tell + +All functions should not be bothered about doing endian gymnastics. It +is assumed that these gymnastics are handled at the haskell level and +these functions are merely FFI stubs. What this means is the following: + + +It is the callers, in this case the haskell functions duty to ensure a +function that is expecting a Matrix M in column order, i.e. expecting +an an argument of type CMatrix, should be fed 4 words such that the +ith word 0 <= i <= 3 should have M[0][i] as the most significant byte +followed by M[1][i] as the next significant byte etc. + +An easy way to ensure the above is to make the type signature use BE +Word32 for the columns. + +These functions, if they write data out would have this ostrich like +behaviour towards endianness and it is up to the haskell code to +compensate. + +*/ + +extern void raazAESTranspose(int n, Matrix *state); /* Transpose all matrices */ +extern void raazAESExpand(int Nk, Column *eKey); /* Key expansion */ + + + +/* Compute the ith byte of a row */ +#define B0(row) (Byte) (row) +#define B1(row) (Byte) ((row) >> 8 ) +#define B2(row) (Byte) ((row) >> 16) +#define B3(row) (Byte) ((row) >> 24) + +/* Move the byte to the appropriate offset inside a row */ +#define B0ToR(b) (Row)(b) +#define B1ToR(b) (B0ToR(b)) << 8 +#define B2ToR(b) (B0ToR(b)) << 16 +#define B3ToR(b) (B0ToR(b)) << 24 + +/* Make a row out of the bytes given */ +#define MkW(w3,w2,w1,w0) (B0ToR(w0))|(B1ToR(w1))|(B2ToR(w2))|(B3ToR(w3)) + +/* The SBOX of a word */ + +#define SB0(r) sbox[B0(r)] +#define SB1(r) sbox[B1(r)] +#define SB2(r) sbox[B2(r)] +#define SB3(r) sbox[B3(r)] + +#define ISB0(r) inv_sbox[B0(r)] +#define ISB1(r) inv_sbox[B1(r)] +#define ISB2(r) inv_sbox[B2(r)] +#define ISB3(r) inv_sbox[B3(r)] + +/* Computing the sbox of a row */ + +#define SBoxWord(r) (MkW(SB3(r), SB2(r), SB1(r), SB0(r))) + +/* With shifts */ +#define SBoxWordShift8(r) (MkW(SB2(r), SB1(r), SB0(r), SB3(r))) +#define SBoxWordShift16(r) (MkW(SB1(r), SB0(r), SB3(r), SB2(r))) +#define SBoxWordShift24(r) (MkW(SB0(r), SB3(r), SB2(r), SB1(r))) + +#define SubBytesAndShift(r) \ + { \ + r##0 = SBoxWord(r##0); \ + r##1 = SBoxWordShift8(r##1); \ + r##2 = SBoxWordShift16(r##2); \ + r##3 = SBoxWordShift24(r##3); \ + } + + +#define ISBoxWord(r) (MkW(ISB3(r), ISB2(r), ISB1(r), ISB0(r))) +#define ISBoxWordShift8(r) (MkW(ISB0(r), ISB3(r), ISB2(r), ISB1(r))) +#define ISBoxWordShift16(r) (MkW(ISB1(r), ISB0(r), ISB3(r), ISB2(r))) +#define ISBoxWordShift24(r) (MkW(ISB2(r), ISB1(r), ISB0(r), ISB3(r))) + + +#define InvSubBytesAndShift(r) \ + { \ + r##0 = ISBoxWord(r##0); \ + r##1 = ISBoxWordShift8(r##1); \ + r##2 = ISBoxWordShift16(r##2); \ + r##3 = ISBoxWordShift24(r##3); \ + } + + + +#define RotateL(r, n) ((r) << n) | ((r) >> (32 - n)) +#define RotateR(r, n) ((r) >> n) | ((r) << (32 - n)) + +#endif diff --git a/cbits/raaz/cipher/aes/cportable.c b/cbits/raaz/cipher/aes/cportable.c new file mode 100644 --- /dev/null +++ b/cbits/raaz/cipher/aes/cportable.c @@ -0,0 +1,269 @@ +#include "common.h" + +#define ShiftLeftBytes(r) ((r << 1) & 0xfefefefe) +#define CycleBits(r) ((r >> 7) & 0x01010101) +#define Mult02(r) ShiftLeftBytes(r) ^ (CycleBits(r) * 0x1b) + + +/* Loading a state */ + +#define Load(r,in) \ + { \ + r##0 = MkW((in)[0],(in)[4],(in)[8] ,(in)[12]); \ + r##1 = MkW((in)[1],(in)[5],(in)[9] ,(in)[13]); \ + r##2 = MkW((in)[2],(in)[6],(in)[10],(in)[14]); \ + r##3 = MkW((in)[3],(in)[7],(in)[11],(in)[15]); \ + } + +/* n = r */ + +#define Copy(n,r) \ + { n##0 = r##0; n##1 = r##1; n##2 = r##2; n##3 = r##3; } + +/* n ^= r */ + +#define XOR(n,r) \ + { n##0 ^= r##0; n##1 ^= r##1; n##2 ^= r##2; n##3 ^= r##3; } + +#define Store(r,out) \ + { \ + (out)[0] = B3(r##0); \ + (out)[4] = B2(r##0); \ + (out)[8] = B1(r##0); \ + (out)[12] = B0(r##0); \ + \ + (out)[1] = B3(r##1); \ + (out)[5] = B2(r##1); \ + (out)[9] = B1(r##1); \ + (out)[13] = B0(r##1); \ + \ + (out)[2] = B3(r##2); \ + (out)[6] = B2(r##2); \ + (out)[10] = B1(r##2); \ + (out)[14] = B0(r##2); \ + \ + (out)[3] = B3(r##3); \ + (out)[7] = B2(r##3); \ + (out)[11] = B1(r##3); \ + (out)[15] = B0(r##3); \ + } + +#define AddRoundKey(r,s) \ + { \ + r##0 ^= s[0]; \ + r##1 ^= s[1]; \ + r##2 ^= s[2]; \ + r##3 ^= s[3]; \ + } + + +#define AddRoundKeyAssign(n,r,key) \ + { \ + n##0 = r##0 ^ key[0]; \ + n##1 = r##1 ^ key[1]; \ + n##2 = r##2 ^ key[2]; \ + n##3 = r##3 ^ key[3]; \ + } + +#define MixColumns(n,r) \ + { \ + n##0 = r##1 ^ r##2 ^ r##3 ; \ + n##1 = r##2 ^ r##3 ^ r##0 ; \ + n##2 = r##3 ^ r##0 ^ r##1 ; \ + n##3 = r##0 ^ r##1 ^ r##2 ; \ + \ + r##0 = Mult02(r##0); \ + r##1 = Mult02(r##1); \ + r##2 = Mult02(r##2); \ + r##3 = Mult02(r##3); \ + \ + n##0 ^= r##0 ^ r##1; \ + n##1 ^= r##1 ^ r##2; \ + n##2 ^= r##2 ^ r##3; \ + n##3 ^= r##3 ^ r##0; \ + } + + +#define InvMixColumns(n,r) \ + { \ + MixColumns(n,r) \ + \ + r##0 ^= r##2 ; \ + r##1 ^= r##3 ; \ + \ + r##0 = Mult02(r##0); \ + r##1 = Mult02(r##1); \ + \ + n##0 ^= r##0; \ + n##1 ^= r##1; \ + n##2 ^= r##0; \ + n##3 ^= r##1; \ + \ + r##0 = Mult02(r##0); \ + r##1 = Mult02(r##1); \ + r##0 ^= r##1; \ + \ + n##0 ^= r##0; \ + n##1 ^= r##0; \ + n##2 ^= r##0; \ + n##3 ^= r##0; \ + } + +#define DECL_MATRIX_REGISTER(r) \ + register Row r##0; \ + register Row r##1; \ + register Row r##2; \ + register Row r##3; + +#define DECL_MATRIX(r) \ + Row r##0; \ + Row r##1; \ + Row r##2; \ + Row r##3; + + +/* The encryption macro + + Uses variables state, temp, eKey, r and nRounds + + If state contained the block that needs to be encrypted then by the + end of ENCRYPT state will contain the encrypted block. + + */ + +#define ENCRYPT { \ + AddRoundKey(state, eKey[0]); \ + for(r = 1; r < nRounds; ++r) \ + { \ + SubBytesAndShift(state); \ + MixColumns(temp,state); \ + AddRoundKeyAssign(state,temp, eKey[r]); \ + } \ + SubBytesAndShift(state); \ + AddRoundKey(state,eKey[nRounds]); \ +} + +/* The decryption macro + + Uses variables state, temp, eKey, r and nRounds + + If state contained the block that needs to be encrypted then by the + end of DECRYPT the variable state will contain the decrypted block. + + */ + + +#define DECRYPT { \ + AddRoundKey(state,eKey[nRounds]); \ + for(r = nRounds - 1; r > 0; --r) \ + { \ + InvSubBytesAndShift(state); \ + AddRoundKeyAssign(temp,state, eKey[r]); \ + InvMixColumns(state,temp); \ + } \ + InvSubBytesAndShift(state); \ + AddRoundKey(state,eKey[0]); \ +} + +void raazAESCBCEncryptCPortable( + Block *inp, int nBlocks, + int nRounds, RMatrix *eKey, + RMatrix iv) +{ + int r; + DECL_MATRIX_REGISTER(state); + DECL_MATRIX_REGISTER(temp); + + state0 = iv[0]; + state1 = iv[1]; + state2 = iv[2]; + state3 = iv[3]; + + /* Invariant: State contains the iv for the current block */ + while( nBlocks ) + { + /* Load the actual block into temp */ + Load(temp, *inp); + + /* XOR with the iv that is in state and store it in state */ + + XOR(state, temp); + + ENCRYPT; /* now state contains the encrypted block which is + also the iv for the next block. + */ + + Store(state, *inp); + + --nBlocks; + ++inp; + } + + iv[0] = state0; + iv[1] = state1; + iv[2] = state2; + iv[3] = state3; + +} + + +void raazAESCBCDecryptCPortable( + Block *inp, int nBlocks, + int nRounds, RMatrix *eKey, + RMatrix iv) +{ + int cursor, r; + + DECL_MATRIX(endIV) + DECL_MATRIX_REGISTER(state); + DECL_MATRIX_REGISTER(temp); + + + Load(state, inp[nBlocks - 1]); /* Start from the last block */ + + /* The last encrypted block is also the IV for the subsequent + blocks. So keep track of it. + */ + + Copy(endIV, state); + + /* + The invariant kept track of is that the variable state contains + the current block that is to be decrypted. + */ + + for(cursor = nBlocks - 1; cursor > 0 ; --cursor) + { + + DECRYPT; + + /* Load the IV for the current block into temp */ + Load(temp, inp[cursor - 1]); + + /* Recover the actual block */ + XOR(state,temp) + + /* Store the decrypted block */ + Store(state, inp[cursor]); + + /* Maintain the invariant by moving stuff in temp to state */ + Copy(state, temp); + + } + + /* For the first block */ + DECRYPT; + + state0 ^= iv[0]; + state1 ^= iv[1]; + state2 ^= iv[2]; + state3 ^= iv[3]; + + Store(state, inp[0]); + + iv[0] = endIV0; + iv[1] = endIV1; + iv[2] = endIV2; + iv[3] = endIV3; + +} diff --git a/cbits/raaz/cipher/aes/cportable.h b/cbits/raaz/cipher/aes/cportable.h new file mode 100644 --- /dev/null +++ b/cbits/raaz/cipher/aes/cportable.h @@ -0,0 +1,11 @@ +#pragma once + +extern void raazAESCBCEncryptCPortable( + Block *inp, int nBlocks, + int nRounds, RMatrix *eKey, + RMatrix iv); + +extern void raazAESCBCDecryptCPortable( + Block *inp, int nBlocks, + int nRounds, RMatrix *eKey, + RMatrix iv); diff --git a/cbits/raaz/core/endian.c b/cbits/raaz/core/endian.c new file mode 100644 --- /dev/null +++ b/cbits/raaz/core/endian.c @@ -0,0 +1,161 @@ +# include +/* + * 32-bit Little endian load and store + */ + +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 + */ + +uint32_t raazLoadBE32(uint32_t *wPtr) +{ +#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 +} + +void raazStoreBE32(uint32_t *wPtr , uint32_t w) +{ +#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; +} + +/* + * 64-bit Little endian load and store + */ + +uint64_t raazLoadLE64(uint64_t *wPtr) +{ +#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 +} + +void raazStoreLE64(uint64_t *wPtr , uint64_t w) +{ +#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; +} + + +/* + * 64-bit Big endian load and store + */ + +uint64_t raazLoadBE64(uint64_t *wPtr) +{ +#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 +} + +void raazStoreBE64(uint64_t *wPtr , uint64_t w) +{ +#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; +} diff --git a/cbits/raaz/core/endian.h b/cbits/raaz/core/endian.h new file mode 100644 --- /dev/null +++ b/cbits/raaz/core/endian.h @@ -0,0 +1,24 @@ +#ifndef __RAAZ_ENDIAN_H_ +#define __RAAZ_ENDIAN_H_ +#include + +/* Include the right header file based on the platform */ +#ifdef PLATFORM_LINUX +#include +#elif defined(PLATFORM_BSD) || defined(PLATFORM_OPENBSD) +#include +#endif + +/* 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 *); + +/* 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); + +#endif diff --git a/cbits/raaz/hash/blake256/portable.c b/cbits/raaz/hash/blake256/portable.c new file mode 100644 --- /dev/null +++ b/cbits/raaz/hash/blake256/portable.c @@ -0,0 +1,481 @@ +/* + +Portable C implementation of BLAKE256 Hash. +This is a part of raaz cryptographic library. + +*/ + +#include +#include +#include +#include + +#define HASH_SIZE 8 /* Size of input hash */ +#define BLOCK_SIZE 16 /* Size of a block */ +#define SALT_SIZE 4 /* Size of input salt */ + +#define ROTATER(x,n) ((x >> n) | (x << (32-n))) + +typedef uint32_t Word; /* Basic unit for BLAKE hash */ +typedef Word Hash[HASH_SIZE]; +typedef Word Block[BLOCK_SIZE]; +typedef Word Salt[SALT_SIZE]; + +/* Defining 16 Constants for Blake Hash */ +#define c0 0x243F6A88 +#define c1 0x85A308D3 +#define c2 0x13198A2E +#define c3 0x03707344 +#define c4 0xA4093822 +#define c5 0x299F31D0 +#define c6 0x082EFA98 +#define c7 0xEC4E6C89 +#define c8 0x452821E6 +#define c9 0x38D01377 +#define c10 0xBE5466CF +#define c11 0x34E90C6C +#define c12 0xC0AC29B7 +#define c13 0xC97C50DD +#define c14 0x3F84D5B5 +#define c15 0xB5470917 + + +/* Gi(a,b,c,d) function in Blake - + + a = a + b + (m[sigma[r][2i]] 'xor' c[sigma[r][2i+1]]) + d = (d 'xor' a) >>> 16 + c = c + d + b = (b 'xor' c) >>> 12 + a = a + b + (m[sigma[r][2i+1]] 'xor' c[sigma[r][2i]]) + d = (d 'xor' a) >>> 8 + c = c + d + b = (b 'xor' c) >>> 7 + where (x >>> n) means rotation of n bits towards less significant bits in x + + + The Gi(i = 0 to 7) function macros defined below takes four input variables - + (M0, M1) where M0 = m[sigma[r][2i]], M1 = m[sigma[r][2i+1]] + (C0, C1) where C0 = c[sigma[r][2i]], C1 = c[sigma[r][2i+1]] + + The state variables are defined inside each macro rather than passing as arguments. + + ROTATER(x,n) is defined as a macro which will serve the function of (x >>> n). + + Here, we have used variables instead of an array since computing array indexes + and then accessing array elements will definitely consume more time and will + slow down the performance. + +*/ + + +/* G function for first column */ +#define G0(M0, M1, C0, C1) \ +{ \ + v0 += v4 + ((M0) ^ (C1)); \ + v12 = ROTATER(((v12) ^ (v0)), 16); \ + v8 += v12; \ + v4 = ROTATER(((v4) ^ (v8)), 12); \ + v0 += v4 + ((M1) ^ (C0)); \ + v12 = ROTATER(((v12) ^ (v0)), 8); \ + v8 += v12; \ + v4 = ROTATER(((v4) ^ (v8)),7); \ +} + +/* G function for second column */ +#define G1(M0, M1, C0, C1) \ +{ \ + v1 += v5 + (M0 ^ C1); \ + v13 = ROTATER((v13 ^ v1), 16); \ + v9 += v13; \ + v5 = ROTATER((v5 ^ v9), 12); \ + v1 += v5 + (M1 ^ C0); \ + v13 = ROTATER((v13 ^ v1), 8); \ + v9 += v13; \ + v5 = ROTATER((v5 ^ v9), 7); \ +} + +/* G function for third column */ +#define G2(M0, M1, C0, C1) \ +{ \ + v2 += v6 + (M0 ^ C1); \ + v14 = ROTATER((v14 ^ v2), 16); \ + v10 += v14; \ + v6 = ROTATER((v6 ^ v10), 12); \ + v2 += v6 + (M1 ^ C0); \ + v14 = ROTATER((v14 ^ v2), 8); \ + v10 += v14; \ + v6 = ROTATER((v6 ^ v10), 7); \ +} + +/* G function for fourth column */ +#define G3(M0, M1, C0, C1) \ +{ \ + v3 += v7 + (M0 ^ C1); \ + v15 = ROTATER((v15 ^ v3), 16); \ + v11 += v15; \ + v7 = ROTATER((v7 ^ v11), 12); \ + v3 += v7 + (M1 ^ C0); \ + v15 = ROTATER((v15 ^ v3), 8); \ + v11 += v15; \ + v7 = ROTATER((v7 ^ v11), 7); \ +} + +/* G function for first diagonal */ +#define G4(M0, M1, C0, C1) \ +{ \ + v0 += v5 + (M0 ^ C1); \ + v15 = ROTATER((v15 ^ v0), 16); \ + v10 += v15; \ + v5 = ROTATER((v5 ^ v10), 12); \ + v0 += v5 + (M1 ^ C0); \ + v15 = ROTATER((v15 ^ v0), 8); \ + v10 += v15; \ + v5 = ROTATER((v5 ^ v10), 7); \ +} + +/* G function for second diagonal */ +#define G5(M0, M1, C0, C1) \ +{ \ + v1 += v6 + (M0 ^ C1); \ + v12 = ROTATER((v12 ^ v1), 16); \ + v11 += v12; \ + v6 = ROTATER((v6 ^ v11), 12); \ + v1 += v6 + (M1 ^ C0); \ + v12 = ROTATER((v12 ^ v1), 8); \ + v11 += v12; \ + v6 = ROTATER((v6 ^ v11), 7); \ +} + +/* G function for third diagonal */ +#define G6(M0, M1, C0, C1) \ +{ \ + v2 += v7 + (M0 ^ C1); \ + v13 = ROTATER((v13 ^ v2), 16); \ + v8 += v13; \ + v7 = ROTATER((v7 ^ v8), 12); \ + v2 += v7 + (M1 ^ C0); \ + v13 = ROTATER((v13 ^ v2), 8); \ + v8 += v13; \ + v7 = ROTATER((v7 ^ v8), 7); \ +} + + +/* G function for fourth diagonal */ +#define G7(M0, M1, C0, C1) \ +{ \ + v3 += v4 + (M0 ^ C1); \ + v14 = ROTATER((v14 ^ v3), 16); \ + v9 += v14; \ + v4 = ROTATER((v4 ^ v9), 12); \ + v3 += v4 + (M1 ^ C0); \ + v14 = ROTATER((v14 ^ v3), 8); \ + v9 += v14; \ + v4 = ROTATER((v4 ^ v9), 7); \ +} + + +void raazHashBlake256PortableCompress(Hash hash, Salt salt, uint64_t counter, int nblocks, Block *mesg) +{ + + Word t0,t1; /* Counter variables */ + + /* Message variables */ + Word m0; + Word m1; + Word m2; + Word m3; + Word m4; + Word m5; + Word m6; + Word m7; + Word m8; + Word m9; + Word m10; + Word m11; + Word m12; + Word m13; + Word m14; + Word m15; + + /* State variables - stored in registers so as to make the code faster */ + register Word v0; + register Word v1; + register Word v2; + register Word v3; + register Word v4; + register Word v5; + register Word v6; + register Word v7; + register Word v8; + register Word v9; + register Word v10; + register Word v11; + register Word v12; + register Word v13; + register Word v14; + register Word v15; + + + while(nblocks > 0) + { + /* Incrementing counter by message bits */ + counter = counter + 512; + + t0 = (Word)counter; + t1 = (Word)(counter >> 32); + + /* Initialization of the state consisting of 16 words */ + v0 = hash[0]; + v1 = hash[1]; + v2 = hash[2]; + v3 = hash[3]; + v4 = hash[4]; + v5 = hash[5]; + v6 = hash[6]; + v7 = hash[7]; + v8 = salt[0] ^ c0; + v9 = salt[1] ^ c1; + v10 = salt[2] ^ c2; + v11 = salt[3] ^ c3; + v12 = t0 ^ c4; + v13 = t0 ^ c5; + v14 = t1 ^ c6; + v15 = t1 ^ c7; + + /* Loading the message into 16 words */ + m0 = raazLoadBE32((Word *)mesg); + m1 = raazLoadBE32((Word *)mesg + 1); + m2 = raazLoadBE32((Word *)mesg + 2); + m3 = raazLoadBE32((Word *)mesg + 3); + m4 = raazLoadBE32((Word *)mesg + 4); + m5 = raazLoadBE32((Word *)mesg + 5); + m6 = raazLoadBE32((Word *)mesg + 6); + m7 = raazLoadBE32((Word *)mesg + 7); + m8 = raazLoadBE32((Word *)mesg + 8); + m9 = raazLoadBE32((Word *)mesg + 9); + m10 = raazLoadBE32((Word *)mesg + 10); + m11 = raazLoadBE32((Word *)mesg + 11); + m12 = raazLoadBE32((Word *)mesg + 12); + m13 = raazLoadBE32((Word *)mesg + 13); + m14 = raazLoadBE32((Word *)mesg + 14); + m15 = raazLoadBE32((Word *)mesg + 15); + + /* End of reading the message block */ + + + /* + Loop unrollings are being done after every round so as to improve the + performance. + */ + + /* Round 1 */ + /* Column Steps 0-3 */ + G0( m0, m1, c0, c1 ); + G1( m2, m3, c2, c3 ); + G2( m4, m5, c4, c5 ); + G3( m6, m7, c6, c7 ); + + /* Diagonal-Step 4-7 */ + G4( m8 , m9 , c8 , c9 ); + G5( m10, m11, c10, c11 ); + G6( m12, m13, c12, c13 ); + G7( m14, m15, c14, c15 ); + + + /* Round 2 */ + /* Column Step 0-3 */ + G0( m14, m10, c14, c10 ); + G1( m4 , m8 , c4 , c8 ); + G2( m9 , m15, c9 , c15 ); + G3( m13, m6 , c13, c6 ); + + /* Diagonal Step 4-7 */ + G4( m1 , m12, c1 , c12 ); + G5( m0 , m2 , c0 , c2 ); + G6( m11, m7 , c11, c7 ); + G7( m5 , m3 , c5 , c3 ); + + + /* Round 3 */ + /* Column Step 0-3 */ + G0( m11, m8 , c11, c8 ); + G1( m12, m0 , c12, c0 ); + G2( m5 , m2 , c5 , c2 ); + G3( m15, m13, c15, c13 ); + + /* Diagonal Step 4-7 */ + G4( m10, m14, c10, c14 ); + G5( m3 , m6 , c3 , c6 ); + G6( m7 , m1 , c7 , c1 ); + G7( m9 , m4 , c9 , c4 ); + + + /* Round 4 */ + /* Column Step 0-3 */ + G0( m7 , m9 , c7 , c9 ); + G1( m3 , m1 , c3 , c1 ); + G2( m13, m12, c13, c12 ); + G3( m11, m14, c11, c14 ); + + /* Diagonal Step 4-7 */ + G4( m2 , m6 , c2 , c6 ); + G5( m5 , m10, c5 , c10 ); + G6( m4 , m0 , c4 , c0 ); + G7( m15, m8 , c15, c8 ); + + + /* Round 5 */ + /* Column Step 0-3 */ + G0( m9 , m0 , c9 , c0 ); + G1( m5 , m7 , c5 , c7 ); + G2( m2 , m4 , c2 , c4 ); + G3( m10, m15, c10, c15 ); + + /* Diagonal Step 4-7 */ + G4( m14, m1 , c14, c1 ); + G5( m11, m12, c11, c12 ); + G6( m6 , m8 , c6 , c8 ); + G7( m3 , m13, c3 , c13 ); + + + /* Round 6 */ + /* Column Step 0-3 */ + G0( m2, m12, c2, c12 ); + G1( m6, m10, c6, c10 ); + G2( m0, m11, c0, c11 ); + G3( m8, m3 , c8, c3 ); + + /* Diagonal Step 4-7 */ + G4( m4 , m13, c4 , c13 ); + G5( m7 , m5 , c7 , c5 ); + G6( m15, m14, c15, c14 ); + G7( m1 , m9 , c1 , c9 ); + + + /* Round 7 */ + /* Column Step 0-3 */ + G0( m12, m5 , c12, c5 ); + G1( m1 , m15, c1 , c15 ); + G2( m14, m13, c14, c13 ); + G3( m4 , m10, c4 , c10 ); + + /* Diagonal Step 4-7 */ + G4( m0, m7 , c0, c7 ); + G5( m6, m3 , c6, c3 ); + G6( m9, m2 , c9, c2 ); + G7( m8, m11, c8, c11 ); + + + /* Round 8 */ + /* Column Step 0-3 */ + G0( m13, m11, c13, c11 ); + G1( m7 , m14, c7 , c14 ); + G2( m12, m1 , c12, c1 ); + G3( m3 , m9 , c3 , c9 ); + + /* Diagonal Step 4-7 */ + G4( m5 , m0 , c5 , c0 ); + G5( m15, m4 , c15, c4 ); + G6( m8 , m6 , c8 , c6 ); + G7( m2 , m10, c2 , c10 ); + + + /* Round 9 */ + /* Column Step 0-3 */ + G0( m6 , m15, c6 , c15 ); + G1( m14, m9 , c14, c9 ); + G2( m11, m3 , c11, c3 ); + G3( m0 , m8 , c0 , c8 ); + + /* Diagonal Step 4-7 */ + G4( m12, m2, c12, c2 ); + G5( m13, m7, c13, c7 ); + G6( m1 , m4, c1 , c4 ); + G7( m10, m5, c10, c5 ); + + + /* Round 10 */ + /* Column Step 0-3 */ + G0( m10, m2, c10, c2 ); + G1( m8 , m4, c8 , c4 ); + G2( m7 , m6, c7 , c6 ); + G3( m1 , m5, c1 , c5 ); + + /* Diagonal Step 4-7 */ + G4( m15, m11, c15, c11 ); + G5( m9 , m14, c9 , c14 ); + G6( m3 , m12, c3 , c12 ); + G7( m13, m0 , c13, c0 ); + + + /* Round 11 */ + /* Column Steps 0-3 */ + G0( m0, m1, c0, c1 ); + G1( m2, m3, c2, c3 ); + G2( m4, m5, c4, c5 ); + G3( m6, m7, c6, c7 ); + + /* Diagonal-Step 4-7 */ + G4( m8 , m9 , c8 , c9 ); + G5( m10, m11, c10, c11 ); + G6( m12, m13, c12, c13 ); + G7( m14, m15, c14, c15 ); + + + /* Round 12 */ + /* Column Step 0-3 */ + G0( m14, m10, c14, c10 ); + G1( m4 , m8 , c4 , c8 ); + G2( m9 , m15, c9 , c15 ); + G3( m13, m6 , c13, c6 ); + + /* Diagonal Step 4-7 */ + G4( m1 , m12, c1 , c12 ); + G5( m0 , m2 , c0 , c2 ); + G6( m11, m7 , c11, c7 ); + G7( m5 , m3 , c5 , c3 ); + + + /* Round 13 */ + /* Column Step 0-3 */ + G0( m11, m8 , c11, c8 ); + G1( m12, m0 , c12, c0 ); + G2( m5 , m2 , c5 , c2 ); + G3( m15, m13, c15, c13 ); + + /* Diagonal Step 4-7 */ + G4( m10, m14, c10, c14 ); + G5( m3 , m6 , c3 , c6 ); + G6( m7 , m1 , c7 , c1 ); + G7( m9 , m4 , c9 , c4 ); + + + /* Round 14 */ + /* Column Step 0-3 */ + G0( m7 , m9 , c7 , c9 ); + G1( m3 , m1 , c3 , c1 ); + G2( m13, m12, c13, c12 ); + G3( m11, m14, c11, c14 ); + + /* Diagonal Step 4-7 */ + G4( m2 , m6 , c2 , c6 ); + G5( m5 , m10, c5 , c10 ); + G6( m4 , m0 , c4 , c0 ); + G7( m15, m8 , c15, c8 ); + + + + /* Updation of hash variables with the new chain value */ + hash[0] = hash[0] ^ salt[0] ^ v0 ^ v8; + hash[1] = hash[1] ^ salt[1] ^ v1 ^ v9; + hash[2] = hash[2] ^ salt[2] ^ v2 ^ v10; + hash[3] = hash[3] ^ salt[3] ^ v3 ^ v11; + hash[4] = hash[4] ^ salt[0] ^ v4 ^ v12; + hash[5] = hash[5] ^ salt[1] ^ v5 ^ v13; + hash[6] = hash[6] ^ salt[2] ^ v6 ^ v14; + hash[7] = hash[7] ^ salt[3] ^ v7 ^ v15; + + ++mesg; /* Incrementing to the next block */ + --nblocks; + } +} diff --git a/cbits/raaz/hash/sha1/portable.c b/cbits/raaz/hash/sha1/portable.c new file mode 100644 --- /dev/null +++ b/cbits/raaz/hash/sha1/portable.c @@ -0,0 +1,335 @@ +/* + +Portable C implementation of SHA1 hashing. The implementation is part +of the raaz cryptographic network library and is not meant to be used +as a standalone sha1 function. + +Copyright (c) 2012, Piyush P Kurur + +All rights reserved. + +This software is distributed under the terms and conditions of the +BSD3 license. See the accompanying file LICENSE for exact terms and +condition. + +*/ + +#include +#include + +typedef uint32_t Word; /* basic unit of sha1 hash */ +#define HASH_SIZE 5 /* Number of words in a Hash */ +#define BLOCK_SIZE 16 /* Number of words in a block */ + + +typedef Word Hash [ HASH_SIZE ]; +typedef Word Block[ BLOCK_SIZE ]; + +void raazHashSha1PortableCompress(Block *mesg, int nblocks, Hash hash); + +/* WARNING: Macro variables not protected use only simple + * expressions. + * + * Notes to Developers: Lot of the code is just repetative loop + * unrollings. The comment after these blocks contain elisp macros + * that generate them (with some tweaks). Preserve these of ease of + * updating the code. + * +*/ + +#define RotateL(x,n) ((x << n) | (x >> (32 - (n)))) +#define RotL30(x) ((x << 30) | (x >> 2)) +#define RotL1(x) ((x << 1) | (x >> 31)) +#define RotL5(x) ((x << 5) | (x >> 27)) + +/* The round constants */ +#define K0 0x5a827999 +#define K20 0x6ed9eba1 +#define K40 0x8f1bbcdc +#define K60 0xca62c1d6 + +/* The round functions */ +#define F0(x,y,z) CH(x,y,z) +#define F20(x,y,z) PARITY(x,y,z) +#define F40(x,y,z) MAJ(x,y,z) +#define F60(x,y,z) PARITY(x,y,z) + +#define CH(x,y,z) ((x & y) ^ (~x & z)) +#define PARITY(x,y,z) (x^y^z) +#define MAJ(x,y,z) ((x & (y | z)) | (y & z)) + +/* One step in the hash function + + a' = (rotateL a 5 + (f t) b c d + e + k t + w0) + b' = a + c' = rotateL b 30 + d' = c + e' = d + +Notice the values of a,c,d are carried over but b and e gets updated. + +*/ + + +#define Step(a,b,c,d,e,w) \ + { \ + e += RotL5(a) + F(b,c,d) + K + w; \ + b = RotL30(b); \ + } \ + +/* Message scheduling is done as + + w16 = rotateL (w13 `xor` w8 `xor` w2 `xor` w0) 1 + +*/ + +/* Message scheduling */ +#define SCHEDULE \ + { \ + w0 ^= w13 ^ w8 ^ w2; w0 = RotL1(w0); \ + w1 ^= w14 ^ w9 ^ w3; w1 = RotL1(w1); \ + w2 ^= w15 ^ w10 ^ w4; w2 = RotL1(w2); \ + w3 ^= w0 ^ w11 ^ w5; w3 = RotL1(w3); \ + w4 ^= w1 ^ w12 ^ w6; w4 = RotL1(w4); \ + w5 ^= w2 ^ w13 ^ w7; w5 = RotL1(w5); \ + w6 ^= w3 ^ w14 ^ w8; w6 = RotL1(w6); \ + w7 ^= w4 ^ w15 ^ w9; w7 = RotL1(w7); \ + w8 ^= w5 ^ w0 ^ w10; w8 = RotL1(w8); \ + w9 ^= w6 ^ w1 ^ w11; w9 = RotL1(w9); \ + w10 ^= w7 ^ w2 ^ w12; w10 = RotL1(w10); \ + w11 ^= w8 ^ w3 ^ w13; w11 = RotL1(w11); \ + w12 ^= w9 ^ w4 ^ w14; w12 = RotL1(w12); \ + w13 ^= w10 ^ w5 ^ w15; w13 = RotL1(w13); \ + w14 ^= w11 ^ w6 ^ w0; w14 = RotL1(w14); \ + w15 ^= w12 ^ w7 ^ w1; w15 = RotL1(w15); \ + } + +/* + (dotimes (i 16) + (setq j (% (+ i 13) 16)) + (setq k (% (+ i 8) 16)) + (setq l (% (+ i 2) 16)) + (insert (format "w%d ^= w%d ^ w%d ^ w%d; " i j k l)) + (insert (format "w%d = RotL1(w%d);\\\n" i i))) +*/ + + +/* + + This is the compress routine of sha1. It is safe in the sense that + it does not overwrite the message. However, it does overwrite the + hash array. + +*/ + +void raazHashSha1PortableCompress(Block *mesg, int nblocks, Hash hash) +{ + + register Word a,b,c,d,e; /* Stores the hash state */ + + /* + The message variables: + + (dotimes (i 16)(insert (format "Word w%d;\n" i))) + + Why not an array? Memory wise these two will be more or less + same as local arrays will be allocated on stack. However in + machines with a large number of general purpose registers the + compiler has a chance of allocating all of them to registers + making them faster. It might also improve cache hits. + + */ + + Word w0; + Word w1; + Word w2; + Word w3; + Word w4; + Word w5; + Word w6; + Word w7; + Word w8; + Word w9; + Word w10; + Word w11; + Word w12; + Word w13; + Word w14; + Word w15; + + while (nblocks > 0) + { + /* initialisation of the hash state */ + a = hash[0]; b = hash[1]; c = hash[2]; d = hash[3]; e = hash[4]; + + /* Reading in the message + + (dotimes (i 16) + (insert (format "w%d = raazLoad32BE( (Word *) mesg, %d);\n" i i))) + + */ + + w0 = raazLoadBE32( (Word *) mesg); + w1 = raazLoadBE32( (Word *) mesg + 1); + w2 = raazLoadBE32( (Word *) mesg + 2); + w3 = raazLoadBE32( (Word *) mesg + 3); + w4 = raazLoadBE32( (Word *) mesg + 4); + w5 = raazLoadBE32( (Word *) mesg + 5); + w6 = raazLoadBE32( (Word *) mesg + 6); + w7 = raazLoadBE32( (Word *) mesg + 7); + w8 = raazLoadBE32( (Word *) mesg + 8); + w9 = raazLoadBE32( (Word *) mesg + 9); + w10 = raazLoadBE32( (Word *) mesg + 10); + w11 = raazLoadBE32( (Word *) mesg + 11); + w12 = raazLoadBE32( (Word *) mesg + 12); + w13 = raazLoadBE32( (Word *) mesg + 13); + w14 = raazLoadBE32( (Word *) mesg + 14); + w15 = raazLoadBE32( (Word *) mesg + 15); + + /* End of reading the message */ + +#undef K +#undef F +#define K K0 +#define F F0 + + /* 0-4 */ + Step(a,b,c,d,e,w0 ); + Step(e,a,b,c,d,w1 ); + Step(d,e,a,b,c,w2 ); + Step(c,d,e,a,b,w3 ); + Step(b,c,d,e,a,w4 ); + + /* 5-9 */ + Step(a,b,c,d,e,w5 ); + Step(e,a,b,c,d,w6 ); + Step(d,e,a,b,c,w7 ); + Step(c,d,e,a,b,w8 ); + Step(b,c,d,e,a,w9 ); + + /* 10-14 */ + Step(a,b,c,d,e,w10); + Step(e,a,b,c,d,w11); + Step(d,e,a,b,c,w12); + Step(c,d,e,a,b,w13); + Step(b,c,d,e,a,w14); + + /* 15-19 */ + Step(a,b,c,d,e,w15); SCHEDULE; + Step(e,a,b,c,d,w0 ); + Step(d,e,a,b,c,w1 ); + Step(c,d,e,a,b,w2 ); + Step(b,c,d,e,a,w3 ); + +#undef K +#undef F +#define K K20 +#define F F20 + + /* 20-24 */ + Step(a,b,c,d,e,w4 ); + Step(e,a,b,c,d,w5 ); + Step(d,e,a,b,c,w6 ); + Step(c,d,e,a,b,w7 ); + Step(b,c,d,e,a,w8 ); + + /* 25-29 */ + Step(a,b,c,d,e,w9 ); + Step(e,a,b,c,d,w10); + Step(d,e,a,b,c,w11); + Step(c,d,e,a,b,w12); + Step(b,c,d,e,a,w13); + + /* 30-34 */ + Step(a,b,c,d,e,w14); + Step(e,a,b,c,d,w15); SCHEDULE; + Step(d,e,a,b,c,w0 ); + Step(c,d,e,a,b,w1 ); + Step(b,c,d,e,a,w2 ); + + /* 35-39 */ + Step(a,b,c,d,e,w3 ); + Step(e,a,b,c,d,w4 ); + Step(d,e,a,b,c,w5 ); + Step(c,d,e,a,b,w6 ); + Step(b,c,d,e,a,w7 ); + +#undef K +#undef F +#define K K40 +#define F F40 + + /* 40-44 */ + + Step(a,b,c,d,e,w8 ); + Step(e,a,b,c,d,w9 ); + Step(d,e,a,b,c,w10); + Step(c,d,e,a,b,w11); + Step(b,c,d,e,a,w12); + + /* 45-49 */ + Step(a,b,c,d,e,w13); + Step(e,a,b,c,d,w14); + Step(d,e,a,b,c,w15); SCHEDULE; + Step(c,d,e,a,b,w0 ); + Step(b,c,d,e,a,w1 ); + + /* 50-54 */ + Step(a,b,c,d,e,w2 ); + Step(e,a,b,c,d,w3 ); + Step(d,e,a,b,c,w4 ); + Step(c,d,e,a,b,w5 ); + Step(b,c,d,e,a,w6 ); + + /* 55-59 */ + Step(a,b,c,d,e,w7 ); + Step(e,a,b,c,d,w8 ); + Step(d,e,a,b,c,w9 ); + Step(c,d,e,a,b,w10); + Step(b,c,d,e,a,w11); + +#undef K +#undef F +#define K K60 +#define F F60 + + /* 60-64 */ + Step(a,b,c,d,e,w12); + Step(e,a,b,c,d,w13); + Step(d,e,a,b,c,w14); + Step(c,d,e,a,b,w15); SCHEDULE; + Step(b,c,d,e,a,w0 ); + + /* 65-69 */ + Step(a,b,c,d,e,w1 ); + Step(e,a,b,c,d,w2 ); + Step(d,e,a,b,c,w3 ); + Step(c,d,e,a,b,w4 ); + Step(b,c,d,e,a,w5 ); + + /* 70-74 */ + Step(a,b,c,d,e,w6 ); + Step(e,a,b,c,d,w7 ); + Step(d,e,a,b,c,w8 ); + Step(c,d,e,a,b,w9 ); + Step(b,c,d,e,a,w10); + + /* 75-79 */ + Step(a,b,c,d,e,w11); + Step(e,a,b,c,d,w12); + Step(d,e,a,b,c,w13); + Step(c,d,e,a,b,w14); + Step(b,c,d,e,a,w15); + + /* Update the hash */ + hash[0] += a; + hash[1] += b; + hash[2] += c; + hash[3] += d; + hash[4] += e; + + /* Move to next block */ + --nblocks; ++mesg; + } + return; +} diff --git a/cbits/raaz/hash/sha256/portable.c b/cbits/raaz/hash/sha256/portable.c new file mode 100644 --- /dev/null +++ b/cbits/raaz/hash/sha256/portable.c @@ -0,0 +1,336 @@ +/* + +Portable C implementation of SHA256 hashing. The implementation is +part of the raaz cryptographic network library and is not meant to be +used as a standalone sha256 function. + +Copyright (c) 2012, Piyush P Kurur and Satvik Chauhan + +All rights reserved. + +This software is distributed under the terms and conditions of the +BSD3 license. See the accompanying file LICENSE for exact terms and +condition. + +*/ + +#include +#include + +typedef uint32_t Word; /* basic unit of sha256 hash */ +#define HASH_SIZE 8 /* Number of words in a Hash */ +#define BLOCK_SIZE 16 /* Number of words in a block */ + +typedef Word Hash [ HASH_SIZE ]; +typedef Word Block[ BLOCK_SIZE ]; + +void raazHashSha256PortableCompress(Block *mesg, int nblocks, Hash h); + +/* WARNING: Macro variables not protected use only simple + * expressions. + * + * Notes to Developers: Lot of the code is just repetative loop + * unrollings. The comment after these blocks contain elisp macros + * that generate them (with some tweaks). Preserve these of ease of + * updating the code. + * +*/ + +#define RotateL(x,n) ((x << n) | (x >> (32 - (n)))) +#define RotateR(x,n) ((x >> n) | (x << (32 - (n)))) +#define ShiftR(x,n) (x >> n) + +/* The round constants */ + +#define K0 0x428a2f98 +#define K1 0x71374491 +#define K2 0xb5c0fbcf +#define K3 0xe9b5dba5 +#define K4 0x3956c25b +#define K5 0x59f111f1 +#define K6 0x923f82a4 +#define K7 0xab1c5ed5 +#define K8 0xd807aa98 +#define K9 0x12835b01 +#define K10 0x243185be +#define K11 0x550c7dc3 +#define K12 0x72be5d74 +#define K13 0x80deb1fe +#define K14 0x9bdc06a7 +#define K15 0xc19bf174 +#define K16 0xe49b69c1 +#define K17 0xefbe4786 +#define K18 0x0fc19dc6 +#define K19 0x240ca1cc +#define K20 0x2de92c6f +#define K21 0x4a7484aa +#define K22 0x5cb0a9dc +#define K23 0x76f988da +#define K24 0x983e5152 +#define K25 0xa831c66d +#define K26 0xb00327c8 +#define K27 0xbf597fc7 +#define K28 0xc6e00bf3 +#define K29 0xd5a79147 +#define K30 0x06ca6351 +#define K31 0x14292967 +#define K32 0x27b70a85 +#define K33 0x2e1b2138 +#define K34 0x4d2c6dfc +#define K35 0x53380d13 +#define K36 0x650a7354 +#define K37 0x766a0abb +#define K38 0x81c2c92e +#define K39 0x92722c85 +#define K40 0xa2bfe8a1 +#define K41 0xa81a664b +#define K42 0xc24b8b70 +#define K43 0xc76c51a3 +#define K44 0xd192e819 +#define K45 0xd6990624 +#define K46 0xf40e3585 +#define K47 0x106aa070 +#define K48 0x19a4c116 +#define K49 0x1e376c08 +#define K50 0x2748774c +#define K51 0x34b0bcb5 +#define K52 0x391c0cb3 +#define K53 0x4ed8aa4a +#define K54 0x5b9cca4f +#define K55 0x682e6ff3 +#define K56 0x748f82ee +#define K57 0x78a5636f +#define K58 0x84c87814 +#define K59 0x8cc70208 +#define K60 0x90befffa +#define K61 0xa4506ceb +#define K62 0xbef9a3f7 +#define K63 0xc67178f2 + +/* The round functions */ +#define CH(x,y,z) ((x & y) ^ (~x & z)) +#define MAJ(x,y,z) ((x & (y | z)) | (y & z)) + +#define SIGB0(x) (RotateR(x,2) ^ RotateR(x,13) ^ RotateR(x,22)) +#define SIGB1(x) (RotateR(x,6) ^ RotateR(x,11) ^ RotateR(x,25)) +#define SIGS0(x) (RotateR(x,7) ^ RotateR(x,18) ^ ShiftR(x,3)) +#define SIGS1(x) (RotateR(x,17) ^ RotateR(x,19) ^ ShiftR(x,10)) + +/* One step in the hash function + + t1 = h + SIGB1 e + CH e f g + k t + w t + t2 = SIGB0 a + MAJ a b c + a' = t1 + t2 + b' = a + c' = b + d' = c + e' = d + t1 + f' = e + g' = f + h' = g + +Notice the values of a,b,c,e,f,g are carried over but d and h gets updated. + +*/ + +#define Step(a,b,c,d,e,f,g,h,w,k) \ + { \ + temp = h + SIGB1(e) + CH(e,f,g) + k + w; \ + d += temp; \ + h = temp + SIGB0(a) + MAJ(a,b,c); \ + } + +/* Message scheduling is done as + + w16 = SIGS1(w14) + w9 + SIGS0(w1) + w0 + +*/ + +/* Message scheduling + + (dotimes (i 16) + (setq j (% (+ i 14) 16)) + (setq k (% (+ i 9) 16)) + (setq l (% (+ i 1) 16)) + (insert (format "\t\t\tw%d += SIGS1(w%d) + w%d + SIGS0(w%d); \\\n" i j k l))) + +*/ + +#define SCHEDULE \ + { \ + w0 += SIGS1(w14) + w9 + SIGS0(w1); \ + w1 += SIGS1(w15) + w10 + SIGS0(w2); \ + w2 += SIGS1(w0) + w11 + SIGS0(w3); \ + w3 += SIGS1(w1) + w12 + SIGS0(w4); \ + w4 += SIGS1(w2) + w13 + SIGS0(w5); \ + w5 += SIGS1(w3) + w14 + SIGS0(w6); \ + w6 += SIGS1(w4) + w15 + SIGS0(w7); \ + w7 += SIGS1(w5) + w0 + SIGS0(w8); \ + w8 += SIGS1(w6) + w1 + SIGS0(w9); \ + w9 += SIGS1(w7) + w2 + SIGS0(w10); \ + w10 += SIGS1(w8) + w3 + SIGS0(w11); \ + w11 += SIGS1(w9) + w4 + SIGS0(w12); \ + w12 += SIGS1(w10) + w5 + SIGS0(w13); \ + w13 += SIGS1(w11) + w6 + SIGS0(w14); \ + w14 += SIGS1(w12) + w7 + SIGS0(w15); \ + w15 += SIGS1(w13) + w8 + SIGS0(w0); \ + } + +/* + + This is the compress routine of sha256. It is safe in the sense + that it does not overwrite the message. However, it does overwrite + the hash array. + +*/ + +void raazHashSha256PortableCompress(Block *mesg, int nblocks, Hash hash) +{ + + register Word a,b,c,d,e,f,g,h; /* Stores the hash state */ + + register Word temp; /* A temproray variable */ + /* + The message variables: + + (dotimes (i 16)(insert (format "\t\tWord w%d;\n" i))) + + Why not an array? Memory wise these two will be more or less + same as local arrays will be allocated on stack. However in + machines with a large number of general purpose registers the + compiler has a chance of allocating all of them to registers + making them faster. It might also improve cache hits. + + */ + + Word w0; + Word w1; + Word w2; + Word w3; + Word w4; + Word w5; + Word w6; + Word w7; + Word w8; + Word w9; + Word w10; + Word w11; + Word w12; + Word w13; + Word w14; + Word w15; + + /* Looping over all the blocks */ + while (nblocks > 0) + { + /* initialisation of the hash state */ + a = hash[0]; b = hash[1]; c = hash[2]; d = hash[3]; e = hash[4]; + f = hash[5]; g = hash[6]; h = hash[7]; + + /* Reading in the message + + (dotimes (i 16) + (insert (format "\t\t\t\tw%d = raazLoad32BE( (Word *) mesg, %d);\n" i i))) + + */ + + w0 = raazLoadBE32( (Word *) mesg); + w1 = raazLoadBE32( (Word *) mesg + 1); + w2 = raazLoadBE32( (Word *) mesg + 2); + w3 = raazLoadBE32( (Word *) mesg + 3); + w4 = raazLoadBE32( (Word *) mesg + 4); + w5 = raazLoadBE32( (Word *) mesg + 5); + w6 = raazLoadBE32( (Word *) mesg + 6); + w7 = raazLoadBE32( (Word *) mesg + 7); + w8 = raazLoadBE32( (Word *) mesg + 8); + w9 = raazLoadBE32( (Word *) mesg + 9); + w10 = raazLoadBE32( (Word *) mesg + 10); + w11 = raazLoadBE32( (Word *) mesg + 11); + w12 = raazLoadBE32( (Word *) mesg + 12); + w13 = raazLoadBE32( (Word *) mesg + 13); + w14 = raazLoadBE32( (Word *) mesg + 14); + w15 = raazLoadBE32( (Word *) mesg + 15); + + /* End of reading the message */ + + /* 0-63 */ + Step(a,b,c,d,e,f,g,h,w0,K0); + Step(h,a,b,c,d,e,f,g,w1,K1); + Step(g,h,a,b,c,d,e,f,w2,K2); + Step(f,g,h,a,b,c,d,e,w3,K3); + Step(e,f,g,h,a,b,c,d,w4,K4); + Step(d,e,f,g,h,a,b,c,w5,K5); + Step(c,d,e,f,g,h,a,b,w6,K6); + Step(b,c,d,e,f,g,h,a,w7,K7); + Step(a,b,c,d,e,f,g,h,w8,K8); + Step(h,a,b,c,d,e,f,g,w9,K9); + Step(g,h,a,b,c,d,e,f,w10,K10); + Step(f,g,h,a,b,c,d,e,w11,K11); + Step(e,f,g,h,a,b,c,d,w12,K12); + Step(d,e,f,g,h,a,b,c,w13,K13); + Step(c,d,e,f,g,h,a,b,w14,K14); + Step(b,c,d,e,f,g,h,a,w15,K15); SCHEDULE; + Step(a,b,c,d,e,f,g,h,w0,K16); + Step(h,a,b,c,d,e,f,g,w1,K17); + Step(g,h,a,b,c,d,e,f,w2,K18); + Step(f,g,h,a,b,c,d,e,w3,K19); + Step(e,f,g,h,a,b,c,d,w4,K20); + Step(d,e,f,g,h,a,b,c,w5,K21); + Step(c,d,e,f,g,h,a,b,w6,K22); + Step(b,c,d,e,f,g,h,a,w7,K23); + Step(a,b,c,d,e,f,g,h,w8,K24); + Step(h,a,b,c,d,e,f,g,w9,K25); + Step(g,h,a,b,c,d,e,f,w10,K26); + Step(f,g,h,a,b,c,d,e,w11,K27); + Step(e,f,g,h,a,b,c,d,w12,K28); + Step(d,e,f,g,h,a,b,c,w13,K29); + Step(c,d,e,f,g,h,a,b,w14,K30); + Step(b,c,d,e,f,g,h,a,w15,K31); SCHEDULE; + Step(a,b,c,d,e,f,g,h,w0,K32); + Step(h,a,b,c,d,e,f,g,w1,K33); + Step(g,h,a,b,c,d,e,f,w2,K34); + Step(f,g,h,a,b,c,d,e,w3,K35); + Step(e,f,g,h,a,b,c,d,w4,K36); + Step(d,e,f,g,h,a,b,c,w5,K37); + Step(c,d,e,f,g,h,a,b,w6,K38); + Step(b,c,d,e,f,g,h,a,w7,K39); + Step(a,b,c,d,e,f,g,h,w8,K40); + Step(h,a,b,c,d,e,f,g,w9,K41); + Step(g,h,a,b,c,d,e,f,w10,K42); + Step(f,g,h,a,b,c,d,e,w11,K43); + Step(e,f,g,h,a,b,c,d,w12,K44); + Step(d,e,f,g,h,a,b,c,w13,K45); + Step(c,d,e,f,g,h,a,b,w14,K46); + Step(b,c,d,e,f,g,h,a,w15,K47); SCHEDULE; + Step(a,b,c,d,e,f,g,h,w0,K48); + Step(h,a,b,c,d,e,f,g,w1,K49); + Step(g,h,a,b,c,d,e,f,w2,K50); + Step(f,g,h,a,b,c,d,e,w3,K51); + Step(e,f,g,h,a,b,c,d,w4,K52); + Step(d,e,f,g,h,a,b,c,w5,K53); + Step(c,d,e,f,g,h,a,b,w6,K54); + Step(b,c,d,e,f,g,h,a,w7,K55); + Step(a,b,c,d,e,f,g,h,w8,K56); + Step(h,a,b,c,d,e,f,g,w9,K57); + Step(g,h,a,b,c,d,e,f,w10,K58); + Step(f,g,h,a,b,c,d,e,w11,K59); + Step(e,f,g,h,a,b,c,d,w12,K60); + Step(d,e,f,g,h,a,b,c,w13,K61); + Step(c,d,e,f,g,h,a,b,w14,K62); + Step(b,c,d,e,f,g,h,a,w15,K63); + + /* Update the hash */ + hash[0] += a; + hash[1] += b; + hash[2] += c; + hash[3] += d; + hash[4] += e; + hash[5] += f; + hash[6] += g; + hash[7] += h; + + /* Move to next block */ + --nblocks; ++mesg; + } + return; +} diff --git a/cbits/raaz/hash/sha512/portable.c b/cbits/raaz/hash/sha512/portable.c new file mode 100644 --- /dev/null +++ b/cbits/raaz/hash/sha512/portable.c @@ -0,0 +1,371 @@ +/* + +Portable C implementation of SHA512 hashing. The implementation is +part of the raaz cryptographic network library and is not meant to be +used as a standalone sha512 function. + +Copyright (c) 2012, Piyush P Kurur and Satvik Chauhan + +All rights reserved. + +This software is distributed under the terms and conditions of the +BSD3 license. See the accompanying file LICENSE for exact terms and +condition. + +*/ + +#include +#include + +typedef uint64_t Word; /* basic unit of sha512 hash */ +#define HASH_SIZE 8 /* Number of words in a Hash */ +#define BLOCK_SIZE 16 /* Number of words in a block */ + +typedef Word Hash [ HASH_SIZE ]; +typedef Word Block[ BLOCK_SIZE ]; + +void raazHashSha512PortableCompress(Block *mesg, int nblocks, Hash hash); + +/* WARNING: Macro variables not protected use only simple + * expressions. + * + * Notes to Developers: Lot of the code is just repetative loop + * unrollings. The comment after these blocks contain elisp macros + * that generate them (with some tweaks). Preserve these of ease of + * updating the code. + * +*/ + +#define RotateL(x,n) ((x << n) | (x >> (64 - (n)))) +#define RotateR(x,n) ((x >> n) | (x << (64 - (n)))) +#define ShiftR(x,n) ( x >> n ) + +/* The round constants */ + +#define K0 0x428a2f98d728ae22 +#define K1 0x7137449123ef65cd +#define K2 0xb5c0fbcfec4d3b2f +#define K3 0xe9b5dba58189dbbc +#define K4 0x3956c25bf348b538 +#define K5 0x59f111f1b605d019 +#define K6 0x923f82a4af194f9b +#define K7 0xab1c5ed5da6d8118 +#define K8 0xd807aa98a3030242 +#define K9 0x12835b0145706fbe +#define K10 0x243185be4ee4b28c +#define K11 0x550c7dc3d5ffb4e2 +#define K12 0x72be5d74f27b896f +#define K13 0x80deb1fe3b1696b1 +#define K14 0x9bdc06a725c71235 +#define K15 0xc19bf174cf692694 +#define K16 0xe49b69c19ef14ad2 +#define K17 0xefbe4786384f25e3 +#define K18 0x0fc19dc68b8cd5b5 +#define K19 0x240ca1cc77ac9c65 +#define K20 0x2de92c6f592b0275 +#define K21 0x4a7484aa6ea6e483 +#define K22 0x5cb0a9dcbd41fbd4 +#define K23 0x76f988da831153b5 +#define K24 0x983e5152ee66dfab +#define K25 0xa831c66d2db43210 +#define K26 0xb00327c898fb213f +#define K27 0xbf597fc7beef0ee4 +#define K28 0xc6e00bf33da88fc2 +#define K29 0xd5a79147930aa725 +#define K30 0x06ca6351e003826f +#define K31 0x142929670a0e6e70 +#define K32 0x27b70a8546d22ffc +#define K33 0x2e1b21385c26c926 +#define K34 0x4d2c6dfc5ac42aed +#define K35 0x53380d139d95b3df +#define K36 0x650a73548baf63de +#define K37 0x766a0abb3c77b2a8 +#define K38 0x81c2c92e47edaee6 +#define K39 0x92722c851482353b +#define K40 0xa2bfe8a14cf10364 +#define K41 0xa81a664bbc423001 +#define K42 0xc24b8b70d0f89791 +#define K43 0xc76c51a30654be30 +#define K44 0xd192e819d6ef5218 +#define K45 0xd69906245565a910 +#define K46 0xf40e35855771202a +#define K47 0x106aa07032bbd1b8 +#define K48 0x19a4c116b8d2d0c8 +#define K49 0x1e376c085141ab53 +#define K50 0x2748774cdf8eeb99 +#define K51 0x34b0bcb5e19b48a8 +#define K52 0x391c0cb3c5c95a63 +#define K53 0x4ed8aa4ae3418acb +#define K54 0x5b9cca4f7763e373 +#define K55 0x682e6ff3d6b2b8a3 +#define K56 0x748f82ee5defb2fc +#define K57 0x78a5636f43172f60 +#define K58 0x84c87814a1f0ab72 +#define K59 0x8cc702081a6439ec +#define K60 0x90befffa23631e28 +#define K61 0xa4506cebde82bde9 +#define K62 0xbef9a3f7b2c67915 +#define K63 0xc67178f2e372532b +#define K64 0xca273eceea26619c +#define K65 0xd186b8c721c0c207 +#define K66 0xeada7dd6cde0eb1e +#define K67 0xf57d4f7fee6ed178 +#define K68 0x06f067aa72176fba +#define K69 0x0a637dc5a2c898a6 +#define K70 0x113f9804bef90dae +#define K71 0x1b710b35131c471b +#define K72 0x28db77f523047d84 +#define K73 0x32caab7b40c72493 +#define K74 0x3c9ebe0a15c9bebc +#define K75 0x431d67c49c100d4c +#define K76 0x4cc5d4becb3e42b6 +#define K77 0x597f299cfc657e2a +#define K78 0x5fcb6fab3ad6faec +#define K79 0x6c44198c4a475817 + +/* The round functions */ +#define CH(x,y,z) ((x & y) ^ (~x & z)) +#define MAJ(x,y,z) ((x & (y | z)) | (y & z)) + +#define SIGB0(x) (RotateR(x,28) ^ RotateR(x,34) ^ RotateR(x,39)) +#define SIGB1(x) (RotateR(x,14) ^ RotateR(x,18) ^ RotateR(x,41)) +#define SIGS0(x) (RotateR(x,1) ^ RotateR(x,8) ^ ShiftR(x,7)) +#define SIGS1(x) (RotateR(x,19) ^ RotateR(x,61) ^ ShiftR(x,6)) + +/* One step in the hash function + + t1 = h + SIGB1 e + CH e f g + k t + w t + t2 = SIGB0 a + MAJ a b c + a' = t1 + t2 + b' = a + c' = b + d' = c + e' = d + t1 + f' = e + g' = f + h' = g + +Notice the values of a,b,c,e,f,g are carried over but d and h gets updated. + +*/ + +#define Step(a,b,c,d,e,f,g,h,w,k) \ + { \ + temp = h + SIGB1(e) + CH(e,f,g) + k + w; \ + d += temp; \ + h = temp + SIGB0(a) + MAJ(a,b,c); \ + } + +/* Message scheduling is done as + + w16 = SIGS1(w14) + w9 + SIGS0(w1) + w0 + +*/ + +/* Message scheduling + + (dotimes (i 16) + (setq j (% (+ i 14) 16)) + (setq k (% (+ i 9) 16)) + (setq l (% (+ i 1) 16)) + (insert (format "\t\t\tw%d += SIGS1(w%d) + w%d + SIGS0(w%d);\\\n" i j k l))) + +*/ + +#define SCHEDULE \ + { \ + w0 += SIGS1(w14) + w9 + SIGS0(w1); \ + w1 += SIGS1(w15) + w10 + SIGS0(w2); \ + w2 += SIGS1(w0) + w11 + SIGS0(w3); \ + w3 += SIGS1(w1) + w12 + SIGS0(w4); \ + w4 += SIGS1(w2) + w13 + SIGS0(w5); \ + w5 += SIGS1(w3) + w14 + SIGS0(w6); \ + w6 += SIGS1(w4) + w15 + SIGS0(w7); \ + w7 += SIGS1(w5) + w0 + SIGS0(w8); \ + w8 += SIGS1(w6) + w1 + SIGS0(w9); \ + w9 += SIGS1(w7) + w2 + SIGS0(w10); \ + w10 += SIGS1(w8) + w3 + SIGS0(w11); \ + w11 += SIGS1(w9) + w4 + SIGS0(w12); \ + w12 += SIGS1(w10) + w5 + SIGS0(w13); \ + w13 += SIGS1(w11) + w6 + SIGS0(w14); \ + w14 += SIGS1(w12) + w7 + SIGS0(w15); \ + w15 += SIGS1(w13) + w8 + SIGS0(w0); \ + } + + + +/* + + This is the compress routine of sha512. It is safe in the sense + that it does not overwrite the message. However, it does overwrite + the hash array. + +*/ + +void raazHashSha512PortableCompress(Block *mesg, int nblocks, Hash hash) +{ + + register Word a,b,c,d,e,f,g,h; /* Stores the hash state */ + + register Word temp; + + /* + The message variables: + + (dotimes (i 16)(insert (format "\t\tWord w%d;\n" i))) + + Why not an array? Memory wise these two will be more or less + same as local arrays will be allocated on stack. However in + machines with a large number of general purpose registers the + compiler has a chance of allocating all of them to registers + making them faster. It might also improve cache hits. + + */ + + Word w0; + Word w1; + Word w2; + Word w3; + Word w4; + Word w5; + Word w6; + Word w7; + Word w8; + Word w9; + Word w10; + Word w11; + Word w12; + Word w13; + Word w14; + Word w15; + + /* Looping over the blocks */ + while (nblocks > 0) + { + /* initialisation of the hash state */ + a = hash[0]; b = hash[1]; c = hash[2]; d = hash[3]; e = hash[4]; + f = hash[5]; g = hash[6]; h = hash[7]; + + /* Reading in the message + + (dotimes (i 16) + (insert (format "\t\t\t\tw%d = raazLoad64BE( (Word *) mesg, %d);\n" i i))) + + */ + + w0 = raazLoadBE64( (Word *) mesg); + w1 = raazLoadBE64( (Word *) mesg + 1); + w2 = raazLoadBE64( (Word *) mesg + 2); + w3 = raazLoadBE64( (Word *) mesg + 3); + w4 = raazLoadBE64( (Word *) mesg + 4); + w5 = raazLoadBE64( (Word *) mesg + 5); + w6 = raazLoadBE64( (Word *) mesg + 6); + w7 = raazLoadBE64( (Word *) mesg + 7); + w8 = raazLoadBE64( (Word *) mesg + 8); + w9 = raazLoadBE64( (Word *) mesg + 9); + w10 = raazLoadBE64( (Word *) mesg + 10); + w11 = raazLoadBE64( (Word *) mesg + 11); + w12 = raazLoadBE64( (Word *) mesg + 12); + w13 = raazLoadBE64( (Word *) mesg + 13); + w14 = raazLoadBE64( (Word *) mesg + 14); + w15 = raazLoadBE64( (Word *) mesg + 15); + + + /* End of reading the message */ + + /* 0-79 */ + Step(a,b,c,d,e,f,g,h,w0,K0); + Step(h,a,b,c,d,e,f,g,w1,K1); + Step(g,h,a,b,c,d,e,f,w2,K2); + Step(f,g,h,a,b,c,d,e,w3,K3); + Step(e,f,g,h,a,b,c,d,w4,K4); + Step(d,e,f,g,h,a,b,c,w5,K5); + Step(c,d,e,f,g,h,a,b,w6,K6); + Step(b,c,d,e,f,g,h,a,w7,K7); + Step(a,b,c,d,e,f,g,h,w8,K8); + Step(h,a,b,c,d,e,f,g,w9,K9); + Step(g,h,a,b,c,d,e,f,w10,K10); + Step(f,g,h,a,b,c,d,e,w11,K11); + Step(e,f,g,h,a,b,c,d,w12,K12); + Step(d,e,f,g,h,a,b,c,w13,K13); + Step(c,d,e,f,g,h,a,b,w14,K14); + Step(b,c,d,e,f,g,h,a,w15,K15); SCHEDULE; + Step(a,b,c,d,e,f,g,h,w0,K16); + Step(h,a,b,c,d,e,f,g,w1,K17); + Step(g,h,a,b,c,d,e,f,w2,K18); + Step(f,g,h,a,b,c,d,e,w3,K19); + Step(e,f,g,h,a,b,c,d,w4,K20); + Step(d,e,f,g,h,a,b,c,w5,K21); + Step(c,d,e,f,g,h,a,b,w6,K22); + Step(b,c,d,e,f,g,h,a,w7,K23); + Step(a,b,c,d,e,f,g,h,w8,K24); + Step(h,a,b,c,d,e,f,g,w9,K25); + Step(g,h,a,b,c,d,e,f,w10,K26); + Step(f,g,h,a,b,c,d,e,w11,K27); + Step(e,f,g,h,a,b,c,d,w12,K28); + Step(d,e,f,g,h,a,b,c,w13,K29); + Step(c,d,e,f,g,h,a,b,w14,K30); + Step(b,c,d,e,f,g,h,a,w15,K31); SCHEDULE; + Step(a,b,c,d,e,f,g,h,w0,K32); + Step(h,a,b,c,d,e,f,g,w1,K33); + Step(g,h,a,b,c,d,e,f,w2,K34); + Step(f,g,h,a,b,c,d,e,w3,K35); + Step(e,f,g,h,a,b,c,d,w4,K36); + Step(d,e,f,g,h,a,b,c,w5,K37); + Step(c,d,e,f,g,h,a,b,w6,K38); + Step(b,c,d,e,f,g,h,a,w7,K39); + Step(a,b,c,d,e,f,g,h,w8,K40); + Step(h,a,b,c,d,e,f,g,w9,K41); + Step(g,h,a,b,c,d,e,f,w10,K42); + Step(f,g,h,a,b,c,d,e,w11,K43); + Step(e,f,g,h,a,b,c,d,w12,K44); + Step(d,e,f,g,h,a,b,c,w13,K45); + Step(c,d,e,f,g,h,a,b,w14,K46); + Step(b,c,d,e,f,g,h,a,w15,K47); SCHEDULE; + Step(a,b,c,d,e,f,g,h,w0,K48); + Step(h,a,b,c,d,e,f,g,w1,K49); + Step(g,h,a,b,c,d,e,f,w2,K50); + Step(f,g,h,a,b,c,d,e,w3,K51); + Step(e,f,g,h,a,b,c,d,w4,K52); + Step(d,e,f,g,h,a,b,c,w5,K53); + Step(c,d,e,f,g,h,a,b,w6,K54); + Step(b,c,d,e,f,g,h,a,w7,K55); + Step(a,b,c,d,e,f,g,h,w8,K56); + Step(h,a,b,c,d,e,f,g,w9,K57); + Step(g,h,a,b,c,d,e,f,w10,K58); + Step(f,g,h,a,b,c,d,e,w11,K59); + Step(e,f,g,h,a,b,c,d,w12,K60); + Step(d,e,f,g,h,a,b,c,w13,K61); + Step(c,d,e,f,g,h,a,b,w14,K62); + Step(b,c,d,e,f,g,h,a,w15,K63); SCHEDULE; + Step(a,b,c,d,e,f,g,h,w0,K64); + Step(h,a,b,c,d,e,f,g,w1,K65); + Step(g,h,a,b,c,d,e,f,w2,K66); + Step(f,g,h,a,b,c,d,e,w3,K67); + Step(e,f,g,h,a,b,c,d,w4,K68); + Step(d,e,f,g,h,a,b,c,w5,K69); + Step(c,d,e,f,g,h,a,b,w6,K70); + Step(b,c,d,e,f,g,h,a,w7,K71); + Step(a,b,c,d,e,f,g,h,w8,K72); + Step(h,a,b,c,d,e,f,g,w9,K73); + Step(g,h,a,b,c,d,e,f,w10,K74); + Step(f,g,h,a,b,c,d,e,w11,K75); + Step(e,f,g,h,a,b,c,d,w12,K76); + Step(d,e,f,g,h,a,b,c,w13,K77); + Step(c,d,e,f,g,h,a,b,w14,K78); + Step(b,c,d,e,f,g,h,a,w15,K79); + + /* Update the hash */ + hash[0] += a; + hash[1] += b; + hash[2] += c; + hash[3] += d; + hash[4] += e; + hash[5] += f; + hash[6] += g; + hash[7] += h; + /* Move to next block */ + --nblocks; ++mesg; + } + return; +} diff --git a/raaz.cabal b/raaz.cabal new file mode 100644 --- /dev/null +++ b/raaz.cabal @@ -0,0 +1,218 @@ +name: raaz +version: 0.0.1 + +synopsis: The raaz cryptographic library. + +description: Raaz is a cryptographic network library for Haskell + designed to use strong typing to eliminate some common errors that + occur in cryptographic settings like side channel attacks. This + package implements basic types and cryptographic primitives like + hashes, macs etc. Actual network protocols are expected to use this + library. Common abstractions like for example packet parsing should + be part of this library. + +homepage: http://github.com/raaz-crypto/raaz + +license: BSD3 +license-file: LICENSE +author: Piyush P Kurur +maintainer: ppk@cse.iitk.ac.in + +category: Codec, Raaz +build-type: Simple +cabal-version: >=1.9.2 + +bug-reports: https://github.com/raaz-crypto/raaz/issues + +source-repository head + type: git + location: https://github.com/raaz-crypto/raaz + +library + + ghc-options: -Wall + -- Conditional compilation using CPP + + -- 1. Configuring system PRG. + -- + -- * HAVE_SYSTEM_PRG: If a system prg is exposed. + -- + -- * HAVE_DEV_URANDON: If the device /dev/urandom exists. + -- + if os(linux) || os(freebsd) || os(openbsd) || os(netbsd) || os(osx) + cpp-options: -DHAVE_SYSTEM_PRG + -DHAVE_DEV_URANDOM + -- 2. Memory Locking + -- System supports mlock/munlock calls. + -- configurations for memory locking + if !os(windows) + cpp-options: -DHAVE_MLOCK + + -- 3. Platform macros for endian conversion functions + -- + if os(linux) + cc-options: -DPLATFORM_LINUX + if os(freebsd) || os(netbsd) + cc-options: -DPLATFORM_BSD + if os(openbsd) + cc-options: -DPLATFORM_OPENBSD + + + exposed-modules: Raaz + , Raaz.Core + , Raaz.Core.ByteSource + , Raaz.Core.DH + , Raaz.Core.Encode + , Raaz.Core.Memory + , Raaz.Core.MonoidalAction + , Raaz.Core.Parse.Applicative + , Raaz.Core.Primitives + , Raaz.Core.Random + , Raaz.Core.Types + , Raaz.Core.Util + , Raaz.Core.Write + -- + -- Cryptographic hashes + -- + , Raaz.Hash + , Raaz.Hash.Internal + + -- , Raaz.Hash.Blake256 + -- , Raaz.Hash.Blake256.Internal + , Raaz.Hash.Sha1 + , Raaz.Hash.Sha1.Implementation.CPortable + , Raaz.Hash.Sha224 + , Raaz.Hash.Sha224.Implementation.CPortable + , Raaz.Hash.Sha256 + , Raaz.Hash.Sha256.Implementation.CPortable + , Raaz.Hash.Sha384 + , Raaz.Hash.Sha384.Implementation.CPortable + , Raaz.Hash.Sha512 + , Raaz.Hash.Sha512.Implementation.CPortable + -- + -- Ciphers + -- + , Raaz.Cipher + , Raaz.Cipher.Internal + , Raaz.Cipher.AES + -- Exposed Implementations of AES. + , Raaz.Cipher.AES.CBC.Implementation.CPortable + -- , Raaz.Cipher.AES.CTR + -- , Raaz.Cipher.Salsa20 + -- , Raaz.Cipher.Salsa20.Internal + other-modules: Raaz.Core.Constants + , Raaz.Core.Encode.Internal + , Raaz.Core.Encode.Base16 + , Raaz.Core.Util.ByteString + , Raaz.Core.Types.Pointer + , Raaz.Core.Types.Tuple + , Raaz.Core.Types.Equality + , Raaz.Core.Types.Endian + , Raaz.Core.Types.Describe + -- + -- Hashes + -- + , Raaz.Hash.Internal.HMAC + , Raaz.Hash.Sha.Util + , Raaz.Hash.Sha1.Internal + , Raaz.Hash.Sha1.Recommendation + , Raaz.Hash.Sha256.Recommendation + , Raaz.Hash.Sha256.Internal + , Raaz.Hash.Sha224.Recommendation + , Raaz.Hash.Sha224.Internal + , Raaz.Hash.Sha384.Recommendation + , Raaz.Hash.Sha384.Internal + , Raaz.Hash.Sha512.Recommendation + , Raaz.Hash.Sha512.Internal + -- , Raaz.Hash.Blake256.Instance + -- , Raaz.Hash.Blake256.Ref + -- , Raaz.Hash.Blake256.CPortable + -- , Raaz.Hash.Blake256.Type + -- , Raaz.Hash.Blake.Util + + -- + -- Internal modules from cipher + -- + , Raaz.Cipher.AES.Internal + , Raaz.Cipher.AES.Recommendation + + -- , Raaz.Cipher.AES.CTR.CPortable + -- , Raaz.Cipher.AES.CTR.Instance + -- , Raaz.Cipher.AES.CTR.Ref + -- , Raaz.Cipher.AES.CTR.Type + -- , Raaz.Cipher.Salsa20.Block.Internal + -- , Raaz.Cipher.Salsa20.Block.Type + -- , Raaz.Cipher.Salsa20.Instances + -- , Raaz.Cipher.AES.Block.Internal + , Paths_raaz + build-depends: base >= 4.5 && < 5.0 + , bytestring >= 0.9 + , deepseq + , mtl >= 2.1 + , transformers + , vector + + c-sources: cbits/raaz/core/endian.c + -- hash implementations + , cbits/raaz/hash/sha1/portable.c + , cbits/raaz/hash/blake256/portable.c + , cbits/raaz/hash/sha256/portable.c + , cbits/raaz/hash/sha512/portable.c + -- ciphers + , cbits/raaz/cipher/aes/common.c + , cbits/raaz/cipher/aes/cportable.c + include-dirs: cbits + includes: raaz/core/endian.h + -- ciphers + , raaz/cipher/aes/common.h + , raaz/cipher/aes/cportable.h + install-includes: raaz/core/endian.h + , raaz/cipher/aes/common.h + , raaz/cipher/aes/cportable.h +executable checksum + hs-source-dirs: bin + main-is: checksum.lhs + build-depends: base >= 4.5 && < 5.0 + , raaz == 0.0.1 + +test-Suite spec + type: exitcode-stdio-1.0 + hs-source-dirs: spec + main-is: Spec.hs + ghc-options: -Wall + other-modules: Common + , Common.Cipher + , Common.Hash + , Common.Instances + , Common.Utils + , Raaz.Cipher.AESSpec + , Raaz.Core.Encode.Base16Spec + , Raaz.Core.MemorySpec + , Raaz.Core.Types.WordSpec + , Raaz.Core.Util.ByteStringSpec + , Raaz.Hash.Sha1Spec + , Raaz.Hash.Sha224Spec + , Raaz.Hash.Sha256Spec + , Raaz.Hash.Sha384Spec + , Raaz.Hash.Sha512Spec + , Raaz.Hash.Blake256Spec + + + build-depends: base >= 4.5 && < 5.0 + , bytestring >= 0.9 + , HUnit >= 1.2 + , QuickCheck >= 2.4 + , hspec + , transformers + , raaz == 0.0.1 + , vector + +benchmark blaze-vs-write + hs-source-dirs: benchmarks + main-is: BlazeVsWrite.hs + type: exitcode-stdio-1.0 + build-depends: base + , blaze-builder + , bytestring + , criterion + , raaz diff --git a/spec/Common.hs b/spec/Common.hs new file mode 100644 --- /dev/null +++ b/spec/Common.hs @@ -0,0 +1,6 @@ +-- Common stuff need by all test modules +module Common (module E) where + +import Common.Imports as E +import Common.Instances () +import Common.Utils as E diff --git a/spec/Common/Cipher.hs b/spec/Common/Cipher.hs new file mode 100644 --- /dev/null +++ b/spec/Common/Cipher.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE FlexibleContexts #-} +module Common.Cipher where + +import Common.Imports +import Common.Utils + + +encryptVsDecrypt :: ( Arbitrary (Key c) + , Show (Key c) + , Cipher c, Recommendation c + ) + => c -> Spec +encryptVsDecrypt c = describe "decrypt . encrypt" $ do + it "trivial on strings of a length that is a multiple of the block size" + $ property $ forAll genKeyStr prop_EvsD + where genKeyStr = (,) <$> arbitrary <*> blocks c + prop_EvsD (k,bs) = unsafeDecrypt c k (unsafeEncrypt c k bs) == bs + + +encryptsTo :: (Cipher c, Recommendation c, Format fmt1, Format fmt2) + => c + -> fmt1 + -> fmt2 + -> Key c + -> Spec +encryptsTo c inp expected key + = it msg $ result `shouldBe` (decodeFormat expected) + where result = unsafeEncrypt c key $ decodeFormat inp + msg = unwords [ "encrypts" + , shortened $ show inp + , "to" + , shortened $ show expected + ] diff --git a/spec/Common/Hash.hs b/spec/Common/Hash.hs new file mode 100644 --- /dev/null +++ b/spec/Common/Hash.hs @@ -0,0 +1,39 @@ +-- Generic tests for hash. + +module Common.Hash + ( hashesTo + , hmacsTo + ) where + +import Common.Imports hiding (replicate) +import Common.Utils + +-- +-- For unit tests for hash we have the following idiom +-- +-- using sha1 [ hashing x1 shouldGive y1, hashing x2 shouldGive y2] +-- where y1 is the hexadecimal encoding of the hash of x2. +-- + +hashesTo :: (Hash h, Recommendation h, Encodable h, Show h) + => ByteString + -> h + -> Spec +hashesTo str h = it msg (hash str `shouldBe` h) + where msg = unwords [ "hashes" + , shortened $ show str + , "to" + , shortened $ show h + ] + +hmacsTo :: ( Hash h, Recommendation h, Show h) + => ByteString + -> HMAC h + -> Key (HMAC h) + -> Spec +hmacsTo str hm key = it mesg $ hmac key str `shouldBe` hm + where mesg = unwords [ "with key", shortened $ show key + , shortened $ show str + , "hmacs to" + , shortened $ show hm + ] diff --git a/spec/Common/Instances.hs b/spec/Common/Instances.hs new file mode 100644 --- /dev/null +++ b/spec/Common/Instances.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Some common instances that are required by the test cases. +module Common.Instances where + +import Common.Imports +import Common.Utils +import Raaz.Cipher.AES as AES + +instance Arbitrary w => Arbitrary (LE w) where + arbitrary = littleEndian <$> arbitrary + +instance Arbitrary w => Arbitrary (BE w) where + arbitrary = bigEndian <$> arbitrary + +instance Arbitrary w => Arbitrary (BYTES w) where + arbitrary = BYTES <$> arbitrary + + +instance Arbitrary w => Arbitrary (BITS w) where + arbitrary = BITS <$> arbitrary + +instance Arbitrary ALIGN where + arbitrary = toEnum <$> arbitrary + +instance Arbitrary ByteString where + arbitrary = pack <$> arbitrary + + +--------------- Arbitrary instances for Hashes ---------------- + +instance Arbitrary SHA1 where + arbitrary = genEncodable + +instance Arbitrary SHA224 where + arbitrary = genEncodable + +instance Arbitrary SHA256 where + arbitrary = genEncodable + +instance Arbitrary SHA512 where + arbitrary = genEncodable + +instance Arbitrary SHA384 where + arbitrary = genEncodable + +instance Arbitrary Base16 where + arbitrary = (encodeByteString . pack) <$> listOf arbitrary + +------------------ Arbitrary instances for Keys --------------- + +instance Arbitrary AES.KEY128 where + arbitrary = genEncodable + +instance Arbitrary AES.KEY192 where + arbitrary = genEncodable + +instance Arbitrary AES.KEY256 where + arbitrary = genEncodable + +instance Arbitrary AES.IV where + arbitrary = genEncodable diff --git a/spec/Common/Utils.hs b/spec/Common/Utils.hs new file mode 100644 --- /dev/null +++ b/spec/Common/Utils.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE CPP #-} +module Common.Utils where + +import Common.Imports hiding (length, replicate) + +import Data.ByteString as B (concat) + +-- | Run a spec with a give key. +with :: key -> (key -> Spec) -> Spec +with key hmsto = hmsto key + +-- | Store and the load the given value. +storeAndThenLoad :: EndianStore a + => a -> IO a +storeAndThenLoad a = allocaBuffer (byteSize a) runStoreLoad + where runStoreLoad ptr = store ptr a >> load ptr + +-- | Shorten a string to make it readable in tests. +shortened :: String -> String +shortened x | l <= 11 = paddedx + | otherwise = prefix ++ "..." ++ suffix + where l = length x + prefix = take 4 x + suffix = drop (l - 4) x + paddedx = x ++ replicate (11 - l) ' ' + +genEncodable :: (Encodable a, Storable a) => Gen a +genEncodable = go undefined + where go :: (Encodable a, Storable a) => a -> Gen a + go x = unsafeFromByteString . pack <$> vector (sizeOf x) + +-- | Generate bytestrings that are multiples of block size of a +-- primitive. +blocks :: Primitive prim => prim -> Gen ByteString +blocks prim = B.concat <$> listOf singleBlock + where singleBlock = pack <$> vector sz + BYTES sz = blockSize prim + + +-- | Run a property with a given generator. +feed :: (Testable pr, Show a) + => Gen a -> (a -> IO pr) -> Property +feed gen pr = monadicIO $ pick gen >>= (run . pr) + +repeated :: Monoid m => m -> Int -> m +repeated m n = mconcat $ replicate n m diff --git a/spec/Raaz/Cipher/AESSpec.hs b/spec/Raaz/Cipher/AESSpec.hs new file mode 100644 --- /dev/null +++ b/spec/Raaz/Cipher/AESSpec.hs @@ -0,0 +1,154 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DataKinds #-} + +module Raaz.Cipher.AESSpec where + +import Common +import qualified Common.Cipher as C +import Raaz.Cipher.AES +import Raaz.Cipher.Internal + +spec :: Spec +spec = do describe "128bit CBC" $ aes128cbcSpec + describe "192bit CBC" $ aes192cbcSpec + describe "256bit CBC" $ aes256cbcSpec + +----------------- AES 128 CBC ------------------------------ + +aes128cbcSpec :: Spec +aes128cbcSpec = do + C.encryptVsDecrypt aes128cbc + + with ( "06a9214036b8a15b512e03d534120006" + , "3dafba429d9eb430b422da802c9fac41") + $ ("Single block msg" :: ByteString) + `encryptsTo` ("e353779c1079aeb82708942dbe77181a" :: Base16) + + with ( "c286696d887c9aa0611bbb3e2025a45a" + , "562e17996d093d28ddb3ba695a2e6f58")$ + ( "000102030405060708090a0b0c0d0e0f" <> + "101112131415161718191a1b1c1d1e1f" :: Base16) + `encryptsTo` + ( "d296cd94c2cccf8a3a863028b5e1dc0a" <> + "7586602d253cfff91b8266bea6d61ab1" ::Base16) + + + with ( "6c3ea0477630ce21a2ce334aa746c2cd" + , "c782dc4c098c66cbd9cd27d825682c81" )$ + ( "This is a 48-byte message (exactly 3 AES blocks)" :: ByteString) + `encryptsTo` + ( "d0a02b3836451753d493665d33f0e886" <> + "2dea54cdb293abc7506939276772f8d5" <> + "021c19216bad525c8579695d83ba2684" :: Base16 + ) + + with ( "56e47a38c5598974bc46903dba290349" + , "8ce82eefbea0da3c44699ed7db51b7d9" ) $ + ( "a0a1a2a3a4a5a6a7a8a9aaabacadaeaf" <> + "b0b1b2b3b4b5b6b7b8b9babbbcbdbebf" <> + "c0c1c2c3c4c5c6c7c8c9cacbcccdcecf" <> + "d0d1d2d3d4d5d6d7d8d9dadbdcdddedf" :: Base16 ) + `encryptsTo` + ( "c30e32ffedc0774e6aff6af0869f71aa" <> + "0f3af07a9a31a9c684db207eb0ef8e4e" <> + "35907aa632c3ffdf868bb7b29d3d46ad" <> + "83ce9f9a102ee99d49a53e87f4c3da55" :: Base16 + ) + + with ( "2b7e151628aed2a6abf7158809cf4f3c" + , "000102030405060708090a0b0c0d0e0f") $ + ( "6bc1bee22e409f96e93d7e117393172a" :: Base16 ) + `encryptsTo` + ( "7649abac8119b246cee98e9b12e9197d" :: Base16 ) + + with ( "2b7e151628aed2a6abf7158809cf4f3c" + , "7649abac8119b246cee98e9b12e9197d") $ + ( "ae2d8a571e03ac9c9eb76fac45af8e51" :: Base16 ) + `encryptsTo` + ( "5086cb9b507219ee95db113a917678b2" :: Base16 ) + + with ( "2b7e151628aed2a6abf7158809cf4f3c" + , "5086cb9b507219ee95db113a917678b2") $ + ( "30c81c46a35ce411e5fbc1191a0a52ef" :: Base16 ) + `encryptsTo` + ( "73bed6b8e3c1743b7116e69e22229516" :: Base16 ) + + with ( "2b7e151628aed2a6abf7158809cf4f3c" + , "73bed6b8e3c1743b7116e69e22229516") $ + ( "f69f2445df4f9b17ad2b417be66c3710" :: Base16 ) + `encryptsTo` + ( "3ff1caa1681fac09120eca307586e1a7" :: Base16 ) + + where encryptsTo :: (Format fmt1, Format fmt2) + => fmt1 -> fmt2 -> Key (AES 128 CBC) -> Spec + encryptsTo = C.encryptsTo aes128cbc + +------------------ AES 192 CBC --------------------------- + +aes192cbcSpec :: Spec +aes192cbcSpec = do + C.encryptVsDecrypt aes192cbc + + with ( "8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b" + , "000102030405060708090a0b0c0d0e0f") $ + ( "6bc1bee22e409f96e93d7e117393172a" :: Base16 ) + `encryptsTo` + ( "4f021db243bc633d7178183a9fa071e8" :: Base16 ) + + with ( "8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b" + , "4f021db243bc633d7178183a9fa071e8" ) $ + ( "ae2d8a571e03ac9c9eb76fac45af8e51" :: Base16 ) + `encryptsTo` + ( "b4d9ada9ad7dedf4e5e738763f69145a" :: Base16 ) + + with ( "8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b" + , "b4d9ada9ad7dedf4e5e738763f69145a" ) $ + ( "30c81c46a35ce411e5fbc1191a0a52ef" :: Base16 ) + `encryptsTo` + ( "571b242012fb7ae07fa9baac3df102e0" :: Base16 ) + + with ( "8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b" + , "571b242012fb7ae07fa9baac3df102e0") $ + ( "f69f2445df4f9b17ad2b417be66c3710" :: Base16 ) + `encryptsTo` + ( "08b0e27988598881d920a9e64f5615cd" :: Base16 ) + + where encryptsTo :: (Format fmt1, Format fmt2) + => fmt1 -> fmt2 -> Key (AES 192 CBC) -> Spec + encryptsTo = C.encryptsTo aes192cbc + +------------------ AES 192 CBC --------------------------- + +aes256cbcSpec :: Spec +aes256cbcSpec = do + C.encryptVsDecrypt aes256cbc + + with ( "603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4" + , "000102030405060708090a0b0c0d0e0f" ) $ + ( "6bc1bee22e409f96e93d7e117393172a" :: Base16) + `encryptsTo` + ( "f58c4c04d6e5f1ba779eabfb5f7bfbd6" :: Base16) + + with ( "603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4" + , "f58c4c04d6e5f1ba779eabfb5f7bfbd6" ) $ + ( "ae2d8a571e03ac9c9eb76fac45af8e51" :: Base16 ) + `encryptsTo` + ( "9cfc4e967edb808d679f777bc6702c7d" :: Base16 ) + + with ( "603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4" + , "9cfc4e967edb808d679f777bc6702c7d") $ + ( "30c81c46a35ce411e5fbc1191a0a52ef" :: Base16 ) + `encryptsTo` + ( "39f23369a9d9bacfa530e26304231461" :: Base16 ) + + with ( "603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4" + , "39f23369a9d9bacfa530e26304231461" ) $ + ( "f69f2445df4f9b17ad2b417be66c3710" :: Base16 ) + `encryptsTo` + ( "b2eb05e2c39be9fcda6c19078c6a9d1b" :: Base16 ) + + where encryptsTo :: (Format fmt1, Format fmt2) + => fmt1 -> fmt2 -> Key (AES 256 CBC) -> Spec + encryptsTo = C.encryptsTo aes256cbc diff --git a/spec/Raaz/Core/Encode/Base16Spec.hs b/spec/Raaz/Core/Encode/Base16Spec.hs new file mode 100644 --- /dev/null +++ b/spec/Raaz/Core/Encode/Base16Spec.hs @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +module Raaz.Core.Encode.Base16Spec where + +import Common + +spec :: Spec +spec = do + prop "unsafeFromByteString . toByteString = id" $ \ (x :: Base16) -> + unsafeFromByteString (toByteString x) `shouldBe` x + prop "correctly encodes a 64-bit big endian word." $ \ (w :: Word64) -> + (read $ "0x" ++ showBase16 (bigEndian w)) == w diff --git a/spec/Raaz/Core/MemorySpec.hs b/spec/Raaz/Core/MemorySpec.hs new file mode 100644 --- /dev/null +++ b/spec/Raaz/Core/MemorySpec.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Raaz.Core.MemorySpec where + +import Common + +spec :: Spec +spec = do prop "store followed by read gives identical values" + $ \ (x :: Word) -> securely (storeAndRead x) `shouldReturn` x + where storeAndRead :: Word -> MT (MemoryCell Word) Word + storeAndRead x = initialise x >> extract diff --git a/spec/Raaz/Core/Types/WordSpec.hs b/spec/Raaz/Core/Types/WordSpec.hs new file mode 100644 --- /dev/null +++ b/spec/Raaz/Core/Types/WordSpec.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Raaz.Core.Types.WordSpec where + +import Common +import Data.ByteString as B +import Data.Bits + + +msbFirst :: (Bits a, Integral a) => B.ByteString -> a +msbFirst = B.foldl (\ x b -> shiftL x 8 + fromIntegral b) 0 +lsbFirst :: (Bits a, Integral a) => B.ByteString -> a +lsbFirst = B.foldr (\ b x -> shiftL x 8 + fromIntegral b) 0 + + +spec :: Spec +spec = do + + describe "little and big endian encodings are opposites" $ do + + prop "for 32-bit quantities" $ \ (x :: Word32) -> + toByteString (littleEndian x) `shouldBe` B.reverse (toByteString $ bigEndian x) + + prop "for 64-bit quantities" $ \ (x :: Word64) -> + toByteString (littleEndian x) `shouldBe` B.reverse (toByteString $ bigEndian x) + + + describe "32-bit little endian" $ do + + prop "store followed by load returns original value" $ \ (x :: LE Word32) -> + storeAndThenLoad x `shouldReturn` x + + prop "size of encodings of is 4 bytes" $ \ (w :: LE Word32) -> + B.length (toByteString w) `shouldBe` 4 + + prop "toByteString in lsb first order" $ \ (x :: LE Word32) -> + lsbFirst (toByteString x) `shouldBe` x + + prop "unsafeFromByteString . toByteString = id" $ \ (x :: LE Word32) -> + unsafeFromByteString (toByteString x) `shouldBe` x + + describe "64-bit little endian" $ do + + prop "store followed by load returns original value" $ \ (x :: LE Word64) -> + storeAndThenLoad x `shouldReturn` x + + prop "size of encodings of is 8 bytes" $ \ (w :: LE Word64) -> + B.length (toByteString w) `shouldBe` 8 + + prop "toByteString in lsb first order" $ \ (x :: LE Word64) -> + lsbFirst (toByteString x) `shouldBe` x + + prop "unsafeFromByteString . toByteString = id" $ \ (x :: LE Word64) -> + unsafeFromByteString (toByteString x) `shouldBe` x + + describe "32-bit big endian" $ do + + prop "store followed by load returns original value" $ \ (x :: BE Word32) -> + storeAndThenLoad x `shouldReturn` x + + prop "size of encodings of is 4 bytes" $ \ (w :: BE Word32) -> + B.length (toByteString w) `shouldBe` 4 + + prop "toByteString in lsb first order" $ \ (x :: BE Word32) -> + msbFirst (toByteString x) `shouldBe` x + + prop "unsafeFromByteString . toByteString = id" $ \ (x :: BE Word32) -> + unsafeFromByteString (toByteString x) `shouldBe` x + + describe "64-bit big endian" $ do + + prop "store followed by load returns original value" $ \ (x :: BE Word64) -> + storeAndThenLoad x `shouldReturn` x + + prop "size of encodings of is 8 bytes" $ \ (w :: BE Word64) -> + B.length (toByteString w) `shouldBe` 8 + + prop "toByteString in lsb first order" $ \ (x :: BE Word64) -> + msbFirst (toByteString x) `shouldBe` x + + prop "unsafeFromByteString . toByteString = id" $ \ (x :: BE Word64) -> + unsafeFromByteString (toByteString x) `shouldBe` x diff --git a/spec/Raaz/Core/Util/ByteStringSpec.hs b/spec/Raaz/Core/Util/ByteStringSpec.hs new file mode 100644 --- /dev/null +++ b/spec/Raaz/Core/Util/ByteStringSpec.hs @@ -0,0 +1,37 @@ +module Raaz.Core.Util.ByteStringSpec where + +import Common +import Prelude hiding (length, take) +import Data.ByteString.Internal(create, createAndTrim) +import Data.ByteString as B +import Foreign.Ptr + +import Raaz.Core as RC + + +spec :: Spec +spec = do context "unsafeCopyToPointer" $ + it "creates the same copy at the input pointer" + $ feed arbitrary $ \ bs -> (== bs) <$> clone bs + + let gen = do bs <- arbitrary + l <- choose (0, B.length bs) + return (bs, l) + in context "unsafeNCopyToPointer" + $ it "creates the same prefix of at the input pointer" + $ feed gen $ \ (bs,n) -> (==) (take n bs) + <$> clonePrefix (bs,n) + + context "createFrom" + $ it "reads exactly the same bytes from the byte string pointer" + $ feed arbitrary $ \ bs -> (==bs) <$> readFrom bs + + where clone bs = create (B.length bs) + $ RC.unsafeCopyToPointer bs . castPtr + clonePrefix (bs,n) + = createAndTrim (B.length bs) + $ \ cptr -> do RC.unsafeNCopyToPointer (BYTES n) bs + $ castPtr cptr + return n + readFrom bs = RC.withByteString bs + $ RC.createFrom (RC.length bs) diff --git a/spec/Raaz/Hash/Blake256Spec.hs b/spec/Raaz/Hash/Blake256Spec.hs new file mode 100644 --- /dev/null +++ b/spec/Raaz/Hash/Blake256Spec.hs @@ -0,0 +1,47 @@ + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Raaz.Hash.Blake256Spec where + +import Common + +{- +import qualified Common.Hash as CH + + +hashesTo :: ByteString -> BLAKE256 -> Spec +hashesTo = GH.hashesTo +-} + +spec :: Spec +spec = it "Blake tests" $ pendingWith "Blake" +{- +spec = do + + prop "store followed by load returns original value" $ \ (x :: BLAKE256) -> + storeAndThenLoad x `shouldReturn` x + + prop "checks that the padding string has the same length as padLength" $ + \ w -> padLen w == (RC.length $ pad w) + + prop "length after padding should be an integral multiple of block size" $ + \ w -> (padLen w + bitsQuot w) `rem` blockSz == 0 + -- + -- Some unit tests + -- + "BLAKE" `hashesTo` "07663e00cf96fbc136cf7b1ee099c95346ba3920893d18cc8851f22ee2e36aa6" + + "Go" `hashesTo` "fd7282ecc105ef201bb94663fc413db1b7696414682090015f17e309b835f1c2" + + "The quick brown fox jumps over the lazy dog" `hashesTo` "7576698ee9cad30173080678e5965916adbb11cb5245d386bf1ffda1cb26c9d7" + + "HELP! I'm trapped in hash!" `hashesTo` "1e75db2a709081f853c2229b65fd1558540aa5e7bd17b04b9a4b31989effa711" + + "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec a diam lectus. Sed sit amet ipsum mauris. Maecenas congu" + `hashesTo` "af95fffc7768821b1e08866a2f9f66916762bfc9d71c4acb5fd515f31fd6785a" + + "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec a diam lectus. Sed sit amet ipsum mauris. Maecenas congue ligula ac quam viverra nec consectetur ante hendrerit. Donec et mollis dolor. Praesent et diam eget libero egestas mattis sit amet vitae augue. Nam tincidunt congue enim, ut porta lorem lacinia consectetur. Donec ut libero sed arcu vehicula ultricies a non tortor. Lorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean ut gravida lorem. Ut turpis felis, pulvinar a semper sed, adipiscing id dolor. Pellentesque auctor nisi id magna consequat sagittis. Curabitur dapibus enim sit amet elit pharetra tincidunt feugiat nisl imperdiet. Ut convallis libero in urna ultrices accumsan. Donec sed odio eros. Donec viverra mi quis quam pulvinar at malesuada arcu rhoncus. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. In rutrum accumsan ultricies. Mauris vitae nisi at sem facilisis semper ac in est." `hashesTo` + "4181475cb0c22d58ae847e368e91b4669ea2d84bcd55dbf01fe24bae6571dd08" +-} diff --git a/spec/Raaz/Hash/Sha1Spec.hs b/spec/Raaz/Hash/Sha1Spec.hs new file mode 100644 --- /dev/null +++ b/spec/Raaz/Hash/Sha1Spec.hs @@ -0,0 +1,53 @@ + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Raaz.Hash.Sha1Spec where + +import Prelude hiding (replicate) + +import Common +import qualified Common.Hash as CH + +-- Particular case for SHA1 +hashesTo :: ByteString -> SHA1 -> Spec +hashesTo = CH.hashesTo + +hmacsTo :: ByteString -> HMAC SHA1 -> Key (HMAC SHA1) -> Spec +hmacsTo = CH.hmacsTo + +spec :: Spec +spec = do + + prop "store followed by load returns original value" $ \ (x :: SHA1) -> + storeAndThenLoad x `shouldReturn` x + + -- + -- Some unit tests + -- + "" `hashesTo` "da39a3ee5e6b4b0d3255bfef95601890afd80709" + "abc" `hashesTo` "a9993e364706816aba3e25717850c26c9cd0d89d" + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" `hashesTo` "84983e441c3bd26ebaae4aa1f95129e5e54670f1" + "The quick brown fox jumps over the lazy dog" `hashesTo` "2fd4e1c67a2d28fced849ee1bb76e7391b93eb12" + "The quick brown fox jumps over the lazy cog" `hashesTo` "de9f2c7fd25e1b3afad3e85a0bd17d9b100db4b3" + "The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog" + `hashesTo` "5957a404e7e74dc746bea2d0d47645ddb387a7de" + + -- Tests for HMAC SHA1 + hmacSpecs + +hmacSpecs :: Spec +hmacSpecs = do + with ("0b" `repeated` 20) $ "Hi There" `hmacsTo` "b617318655057264e28bc0b6fb378c8ef146be00" + with ("aa" `repeated` 20) $ + replicate (50 :: BYTES Int) 0xdd `hmacsTo` "125d7342b9ac11cd91a39af48aa17b4f63f175d3" + with ("aa" `repeated` 80) + $ "Test Using Larger Than Block-Size Key - Hash Key First" `hmacsTo` "aa4ae5e15272d00e95705637ce8a3b55ed402112" + with ("aa" `repeated` 80) $ + "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" `hmacsTo` "e8e99d0f45237d786d6bbaa7965c7808bbff1a91" + + let key = fromString + $ (show :: Base16 -> String) + $ encodeByteString "Jefe" + in with key $ "what do ya want for nothing?" `hmacsTo` "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79" diff --git a/spec/Raaz/Hash/Sha224Spec.hs b/spec/Raaz/Hash/Sha224Spec.hs new file mode 100644 --- /dev/null +++ b/spec/Raaz/Hash/Sha224Spec.hs @@ -0,0 +1,37 @@ + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Raaz.Hash.Sha224Spec where + +import Common +import qualified Common.Hash as CH + +hashesTo :: ByteString -> SHA224 -> Spec +hashesTo = CH.hashesTo + +spec :: Spec +spec = do + + prop "store followed by load returns original value" $ \ (x :: SHA224) -> + storeAndThenLoad x `shouldReturn` x + + -- + -- Some unit tests + -- + "" `hashesTo` "d14a028c2a3a2bc9476102bb288234c415a2b01f828ea62ac5b3e42f" + + "abc" `hashesTo` "23097d223405d8228642a477bda255b32aadbce4bda0b3f7e36c9da7" + + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" `hashesTo` + "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" + + "The quick brown fox jumps over the lazy dog" `hashesTo` + "730e109bd7a8a32b1cb9d9a09aa2325d2430587ddbc0c38bad911525" + + "The quick brown fox jumps over the lazy cog" `hashesTo` + "fee755f44a55f20fb3362cdc3c493615b3cb574ed95ce610ee5b1e9b" + + "The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog" `hashesTo` + "72a1a34c088733e432fa2e61e93a3e69af178870aa6b5ce0864ca60b" diff --git a/spec/Raaz/Hash/Sha256Spec.hs b/spec/Raaz/Hash/Sha256Spec.hs new file mode 100644 --- /dev/null +++ b/spec/Raaz/Hash/Sha256Spec.hs @@ -0,0 +1,58 @@ + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Raaz.Hash.Sha256Spec where + +import Prelude hiding (replicate) + +import Common +import qualified Common.Hash as CH + +hashesTo :: ByteString -> SHA256 -> Spec +hashesTo = CH.hashesTo + +hmacsTo :: ByteString -> HMAC SHA256 -> Key (HMAC SHA256) -> Spec +hmacsTo = CH.hmacsTo + +spec :: Spec +spec = do + + prop "store followed by load returns original value" $ \ (x :: SHA256) -> + storeAndThenLoad x `shouldReturn` x + + -- + -- Some unit tests + -- + "" `hashesTo` "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" + + "abc" `hashesTo` "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" + + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" `hashesTo` + "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1" + + "The quick brown fox jumps over the lazy dog" `hashesTo` + "d7a8fbb307d7809469ca9abcb0082e4f8d5651e46d3cdb762d02d0bf37c9e592" + + "The quick brown fox jumps over the lazy cog" `hashesTo` + "e4c4d8f3bf76b692de791a173e05321150f7a345b46484fe427f6acc7ecc81be" + + "The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog" `hashesTo` + "86c55ba51d6b4aef51f4ae956077a0f661d0b876c5774fef3172c4f56092cbbd" + + hmacSpec + +hmacSpec :: Spec +hmacSpec = do + with ("0b" `repeated` 20) $ "Hi There" `hmacsTo` "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" + + with ("aa" `repeated` 20) $ (replicate (50 :: BYTES Int) 0xdd) `hmacsTo` "773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe" + + with ("aa" `repeated` 131) $ "Test Using Larger Than Block-Size Key - Hash Key First" `hmacsTo` + "60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54" + + with ("aa" `repeated` 131) $ "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm." `hmacsTo` "9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2" + + let key = fromString $ (show :: Base16 -> String) $ encodeByteString "Jefe" + in with key $ "what do ya want for nothing?" `hmacsTo` "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843" diff --git a/spec/Raaz/Hash/Sha384Spec.hs b/spec/Raaz/Hash/Sha384Spec.hs new file mode 100644 --- /dev/null +++ b/spec/Raaz/Hash/Sha384Spec.hs @@ -0,0 +1,34 @@ + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Raaz.Hash.Sha384Spec where + +import Common +import qualified Common.Hash as CH + +hashesTo :: ByteString -> SHA384 -> Spec +hashesTo = CH.hashesTo + +spec :: Spec +spec = do + + prop "store followed by load returns original value" $ \ (x :: SHA384) -> + storeAndThenLoad x `shouldReturn` x + + -- + -- Some unit tests + -- + "" `hashesTo` "38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b" + + "abc" `hashesTo` "cb00753f45a35e8bb5a03d699ac65007272c32ab0eded1631a8b605a43ff5bed8086072ba1e7cc2358baeca134c825a7" + + "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" `hashesTo` + "09330c33f71147e83d192fc782cd1b4753111b173b3b05d22fa08086e3b0f712fcc7c71a557e2db966c3e9fa91746039" + "The quick brown fox jumps over the lazy dog" `hashesTo` + "ca737f1014a48f4c0b6dd43cb177b0afd9e5169367544c494011e3317dbf9a509cb1e5dc1e85a941bbee3d7f2afbc9b1" + "The quick brown fox jumps over the lazy cog" `hashesTo` + "098cea620b0978caa5f0befba6ddcf22764bea977e1c70b3483edfdf1de25f4b40d6cea3cadf00f809d422feb1f0161b" + "The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog" `hashesTo` + "ef06b4ee875361dd5b9737c835c5fbb1d47fc59edb3430fec50341c627c4296e7e3f80b3a7b1295a6aaf14f0ef2418a9" diff --git a/spec/Raaz/Hash/Sha512Spec.hs b/spec/Raaz/Hash/Sha512Spec.hs new file mode 100644 --- /dev/null +++ b/spec/Raaz/Hash/Sha512Spec.hs @@ -0,0 +1,67 @@ + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Raaz.Hash.Sha512Spec where + +import Prelude hiding (replicate) + +import Common +import qualified Common.Hash as CH + + +hashesTo :: ByteString -> SHA512 -> Spec +hashesTo = CH.hashesTo + +hmacsTo :: ByteString -> HMAC SHA512 -> Key (HMAC SHA512) -> Spec +hmacsTo = CH.hmacsTo + +spec :: Spec +spec = do + + prop "store followed by load returns original value" $ \ (x :: SHA512) -> + storeAndThenLoad x `shouldReturn` x + -- + -- Some unit tests + -- + "" `hashesTo` + "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" + + "abc" `hashesTo` + "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f" + + "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" `hashesTo` + "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" + + "The quick brown fox jumps over the lazy dog" `hashesTo` + "07e547d9586f6a73f73fbac0435ed76951218fb7d0c8d788a309d785436bbb642e93a252a954f23912547d1e8a3b5ed6e1bfd7097821233fa0538f3db854fee6" + + "The quick brown fox jumps over the lazy cog" `hashesTo` + "3eeee1d0e11733ef152a6c29503b3ae20c4f1f3cda4cb26f1bc1a41f91c7fe4ab3bd86494049e201c4bd5155f31ecb7a3c8606843c4cc8dfcab7da11c8ae5045" + + "The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog The quick brown fox jumps over the lazy dog" `hashesTo` + "e489dcc2e8867d0bbeb0a35e6b94951a11affd7041ef39fa21719eb01800c29a2c3522924443939a7848fde58fb1dbd9698fece092c0c2b412c51a47602cfd38" + + -- Some hmac specs + hmacSpec + + +hmacSpec :: Spec +hmacSpec = do + with ("0b" `repeated` 20) $ "Hi There" `hmacsTo` + "87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cdedaa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854" + + with ("aa" `repeated` 20) $ (replicate (50 :: BYTES Int) 0xdd) `hmacsTo` + "fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb" + + with ("aa" `repeated` 131) $ "Test Using Larger Than Block-Size Key - Hash Key First" `hmacsTo` + "80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f3526b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598" + + with ("aa" `repeated` 131) $ + "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm." `hmacsTo` + "e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58" + + let key = fromString $ (show :: Base16 -> String) $ encodeByteString "Jefe" + in with key $ "what do ya want for nothing?" `hmacsTo` + "164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737" diff --git a/spec/Spec.hs b/spec/Spec.hs new file mode 100644 --- /dev/null +++ b/spec/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}