raaz-0.1.1/Raaz/0000755000000000000000000000000013055622555011541 5ustar0000000000000000raaz-0.1.1/Raaz/Cipher/0000755000000000000000000000000013037202101012730 5ustar0000000000000000raaz-0.1.1/Raaz/Cipher/AES/0000755000000000000000000000000013043432667013363 5ustar0000000000000000raaz-0.1.1/Raaz/Cipher/AES/CBC/0000755000000000000000000000000012750426275013754 5ustar0000000000000000raaz-0.1.1/Raaz/Cipher/AES/CBC/Implementation/0000755000000000000000000000000013037202101016714 5ustar0000000000000000raaz-0.1.1/Raaz/Cipher/ChaCha20/0000755000000000000000000000000013055622555014224 5ustar0000000000000000raaz-0.1.1/Raaz/Cipher/ChaCha20/Implementation/0000755000000000000000000000000013055622555017211 5ustar0000000000000000raaz-0.1.1/Raaz/Core/0000755000000000000000000000000013055622555012431 5ustar0000000000000000raaz-0.1.1/Raaz/Core/Encode/0000755000000000000000000000000013037202101013603 5ustar0000000000000000raaz-0.1.1/Raaz/Core/Parse/0000755000000000000000000000000013037202101013460 5ustar0000000000000000raaz-0.1.1/Raaz/Core/Types/0000755000000000000000000000000013055624226013532 5ustar0000000000000000raaz-0.1.1/Raaz/Core/Util/0000755000000000000000000000000013055622535013344 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/0000755000000000000000000000000013055622555012424 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Internal/0000755000000000000000000000000013055622535014176 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Sha/0000755000000000000000000000000013042177016013130 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Sha1/0000755000000000000000000000000013006426545013215 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Sha1/Implementation/0000755000000000000000000000000013042177016016176 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Sha224/0000755000000000000000000000000013006426545013364 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Sha224/Implementation/0000755000000000000000000000000013037202101016331 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Sha256/0000755000000000000000000000000013006426545013371 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Sha256/Implementation/0000755000000000000000000000000013042177016016352 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Sha384/0000755000000000000000000000000012750426275013400 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Sha384/Implementation/0000755000000000000000000000000013037202101016340 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Sha512/0000755000000000000000000000000013006426545013364 5ustar0000000000000000raaz-0.1.1/Raaz/Hash/Sha512/Implementation/0000755000000000000000000000000013042177016016345 5ustar0000000000000000raaz-0.1.1/Raaz/Random/0000755000000000000000000000000013055622535012757 5ustar0000000000000000raaz-0.1.1/benchmarks/0000755000000000000000000000000013055622535012757 5ustar0000000000000000raaz-0.1.1/bin/0000755000000000000000000000000013055622535011412 5ustar0000000000000000raaz-0.1.1/bin/Command/0000755000000000000000000000000013055622555012772 5ustar0000000000000000raaz-0.1.1/cbits/0000755000000000000000000000000012750426275011752 5ustar0000000000000000raaz-0.1.1/cbits/raaz/0000755000000000000000000000000012750426275012707 5ustar0000000000000000raaz-0.1.1/cbits/raaz/cipher/0000755000000000000000000000000013006426545014154 5ustar0000000000000000raaz-0.1.1/cbits/raaz/cipher/aes/0000755000000000000000000000000012750426275014731 5ustar0000000000000000raaz-0.1.1/cbits/raaz/cipher/chacha20/0000755000000000000000000000000013055622555015530 5ustar0000000000000000raaz-0.1.1/cbits/raaz/core/0000755000000000000000000000000013006426545013632 5ustar0000000000000000raaz-0.1.1/cbits/raaz/hash/0000755000000000000000000000000012750426275013632 5ustar0000000000000000raaz-0.1.1/cbits/raaz/hash/sha1/0000755000000000000000000000000013006426545014461 5ustar0000000000000000raaz-0.1.1/cbits/raaz/hash/sha256/0000755000000000000000000000000013006426545014635 5ustar0000000000000000raaz-0.1.1/cbits/raaz/hash/sha512/0000755000000000000000000000000013006426545014630 5ustar0000000000000000raaz-0.1.1/entropy/0000755000000000000000000000000013043432667012344 5ustar0000000000000000raaz-0.1.1/entropy/arc4random/0000755000000000000000000000000013043432667014376 5ustar0000000000000000raaz-0.1.1/entropy/arc4random/Raaz/0000755000000000000000000000000013043432667015273 5ustar0000000000000000raaz-0.1.1/entropy/urandom/0000755000000000000000000000000013043432667014011 5ustar0000000000000000raaz-0.1.1/entropy/urandom/Raaz/0000755000000000000000000000000013043432667014706 5ustar0000000000000000raaz-0.1.1/spec/0000755000000000000000000000000012750426275011600 5ustar0000000000000000raaz-0.1.1/spec/Common/0000755000000000000000000000000013055622555013026 5ustar0000000000000000raaz-0.1.1/spec/Raaz/0000755000000000000000000000000013043432667012473 5ustar0000000000000000raaz-0.1.1/spec/Raaz/Cipher/0000755000000000000000000000000013037202101013662 5ustar0000000000000000raaz-0.1.1/spec/Raaz/Core/0000755000000000000000000000000013043432667013363 5ustar0000000000000000raaz-0.1.1/spec/Raaz/Core/Types/0000755000000000000000000000000013006426545014464 5ustar0000000000000000raaz-0.1.1/spec/Raaz/Core/Util/0000755000000000000000000000000013055622535014276 5ustar0000000000000000raaz-0.1.1/spec/Raaz/Hash/0000755000000000000000000000000013006426545013353 5ustar0000000000000000raaz-0.1.1/Raaz.hs0000644000000000000000000000112113043432667012070 0ustar0000000000000000-- | 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 ( module Raaz.Cipher , module Raaz.Core , module Raaz.Hash , module Raaz.Random , version ) where import Data.Version (Version) import qualified Paths_raaz as P import Raaz.Core import Raaz.Hash import Raaz.Cipher import Raaz.Random -- | Raaz library version number. version :: Version version = P.version raaz-0.1.1/Raaz/Core.hs0000644000000000000000000000110513043432667012762 0ustar0000000000000000{-| 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.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.Types import Raaz.Core.Util {-# ANN module "HLint: ignore Use import/export shortcut" #-} raaz-0.1.1/Raaz/Core/ByteSource.hs0000644000000000000000000001542313006426545015053 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} -- | Module define byte sources. module Raaz.Core.ByteSource ( -- * Byte sources. -- $bytesource$ ByteSource(..), PureByteSource -- InfiniteSource(..) , FillResult(..) , fill, processChunks , withFillResult ) where import Control.Applicative import Control.Monad.IO.Class import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L 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) -- $bytesource$ -- -- Cryptographic input come from various sources; they can come from -- network sockets or might be just a string in the Haskell. To give a -- uniform interfaces for all such inputs, we define the abstract -- concept of a /byte source/. Essentially a byte source is one from -- which we can fill a buffer with bytes. Depending on the nature of -- the source we have two classes: `ByteSource` which captures bounded -- sources and `InfiniteSource` that captures never ending source of -- bytes. -- -- Among instances of `ByteSource`, some like for example -- `B.ByteString` are /pure/ in the sense filling a buffer with bytes -- from such a source has no other side-effects. This is in contrast -- to a source like a sockets. The type class `PureByteSource` -- captures such byte sources. -- -- | 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 -- | 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 #-} {-- -- | Never ending stream of bytes. The reads to the stream might get -- delayed but it will always return the number of bytes that were -- asked for. class InfiniteSource src where slurpBytes :: BYTES Int -- ^ bytes to read, -> src -- ^ the source to fill from, -> Pointer -- ^ the buffer source to fill. -> IO src -- | A version of slurp that takes type safe lengths as input. slurp :: ( LengthUnit len , InfiniteSource src ) => 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 = fmap (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 = 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) raaz-0.1.1/Raaz/Core/DH.hs0000644000000000000000000000176212750426275013270 0ustar0000000000000000-- | 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 raaz-0.1.1/Raaz/Core/Encode.hs0000644000000000000000000000360012750426275014163 0ustar0000000000000000module Raaz.Core.Encode ( -- * Encoding of binary data. -- $encodable$ Encodable(..) , Format(..) , encode, decode, translate, unsafeDecode -- ** The base 16 encoding format , Base16 , fromBase16, showBase16 -- ** Other binary formats. , Base64 ) where import Raaz.Core.Encode.Internal import Raaz.Core.Encode.Base16 import Raaz.Core.Encode.Base64 -- $encodable$ -- -- Often one wants to represent cryptographic hashes, secret keys or -- just binary data into various enocoding formats like base64, -- hexadecimal etc. This module gives a generic interface for all such -- operations. There are two main classes that capture the essence of -- encoding. -- -- [`Format`] Each encoding supported by this module is an instance of -- this class. For printing and for easy inclusion in source code -- appropriate instances of `Show` and `Data.String.IsString` is -- provided for these types. -- -- [`Encodable`] Instances of this class are those that can be encoded -- into any of the available formats. Actual encoding and decoding -- of elements of this class can be done by the combinators -- `encode` and `decode` -- -- The raaz library exposes many instances of `Format` which are all -- some form of encoding of binary data. -- -- | 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 -- | Translate from one format to another. translate :: (Format fmt1, Format fmt2) => fmt1 -> fmt2 translate = encodeByteString . decodeFormat raaz-0.1.1/Raaz/Core/Memory.hs0000644000000000000000000004564713055622555014255 0ustar0000000000000000{-| The memory subsystem associated with raaz. __Warning:__ This module is pretty low level and should not be needed in typical use cases. Only developers of protocols and primitives might have a reason to look into this module. -} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Raaz.Core.Memory ( -- * The Memory subsystem. -- $memorysubsystem$ -- ** Initialisation and Extraction. -- $init-extract$ Memory(..), VoidMemory, copyMemory , Initialisable(..), Extractable(..) , InitialisableFromBuffer(..), ExtractableToBuffer(..) -- *** A basic memory cell. , MemoryCell, withCellPointer, getCellPointer -- *** Actions on memory elements. , MT, execute, getMemory, onSubMemory, liftSubMT, modify -- **** Some low level `MT` actions. , liftPointerAction -- ** Generic memory monads. , MonadMemory(..) , MemoryM, runMT -- ** Memory allocation , Alloc, pointerAlloc ) where import Control.Applicative import Control.Monad.IO.Class import Foreign.Storable ( Storable ) import Foreign.Ptr ( castPtr, Ptr ) import Raaz.Core.MonoidalAction import Raaz.Core.Transfer import Raaz.Core.Types -- $memorysubsystem$ -- -- Cryptographic operations often need to keep sensitive information -- in its memory space. If this memory is swapped out to the disk, -- this can be dangerous. The primary purpose of the memory subsystem -- is to provide a way to allocate and manage /secure memory/, -- i.e. memory that will not be swapped out during the execution of -- the process and will be wiped clean after use. There are there -- important parts to the memory subsystem: -- -- [The `Memory` type class:] A memory element is some type that holds -- an internal buffer inside it. -- -- [The `Alloc` type:] Memory elements need to be allocated and this -- is involves a lot of low lever pointer arithmetic. The `Alloc` -- types gives a high level interface for memory allocation. For a -- memory type `mem`, the type `Alloc mem` can be seen as the -- _allocation strategy_ for mem. For example, one of the things that -- it keeps track of the space required to create an memory element of -- type `mem`. There is a natural applicative instance for `Alloc` -- which helps build the allocation strategy for a compound memory -- type from its components in a modular fashion _without_ explicit -- size calculation or offset computation. -- -- [The `MonadMemory` class:] Instances of these classes are actions -- that use some kind of memory elements, i.e. instances of the class -- `Memory`, inside it. Any such monad can either be run using the -- combinator `securely` or the combinator `insecurely`. If one use -- the combinator `securely`, then all allocations done during the run -- is from a locked memory pool which is wiped clean before -- de-allocation. The types `MT` and `MemoryM` are two instances that -- we expose from this library. -- -- $init-extract$ -- -- Memory elements often needs to be initialised. Similarly data needs -- to be extracted out of memory. An instance declaration -- @`Initialisable` mem a@ for the memory type @mem@ indicates that it -- can be initialised with the pure value @a@. Similary, if values of -- type @b@ can be extracted out of a memory element @mem@, we can -- indicate it with an instance of @`Extractable` mem a@. -- -- There is an inherent danger in initialising and extracting pure -- values out of memory. Pure values are stored on the Haskell stack -- and hence can be swapped out. Consider a memory element @mem@ that -- stores some sensitive information, say for example the unencrypted -- private key. Now suppose that we need to extracting out the key as -- a pure value before its encryption and storage into the key file, -- it is likely that the key is swapped out to the disk as part of the -- haskell heap. -- -- The `InitialiseFromBuffer` (`ExtractableToBuffer`) class gives an -- interface for reading from (writing to) buffers directly minimising -- the chances of inadvertent exposure of sensitive information from -- the Haskell heap due to swapping. -- | A class that captures monads that use an internal memory element. -- -- Any instance of `MonadMemory` can be executed `securely` in which -- 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 } ------------- Lifting pointer actions ----------------------------- -- | A pointer action inside a monad @m@ is some function that takes a -- pointer action of type @Pointer -> m a@ and supplies it with an -- appropriate pointer. In particular, memory allocators are pointer -- actions. type PointerAction m a b = (Pointer -> m a) -> m b -- | An IO allocator can be lifted to the memory thread level as follows. liftPointerAction :: PointerAction IO a b -> PointerAction (MT mem) a b liftPointerAction allocator mtAction = execute $ \ mem -> allocator (\ ptr -> unMT (mtAction ptr) mem) -- TODO: This is a very general pattern needs more exploration. -- | Run a given memory action in the memory thread. execute :: (mem -> IO a) -> MT mem a {-# INLINE execute #-} execute = MT getMemory :: MT mem mem getMemory = execute return -- | The combinator @onSubMemory@ allows us to run a memory action on a -- sub-memory element. Given a memory element of type @mem@ and a -- sub-element of type @submem@ which can be obtained from the -- compound memory element of type @mem@ using the projection @proj@, -- then @onSubMemory proj@ lifts the a memory thread of the sub -- element to the compound element. -- onSubMemory :: (mem -> submem) -- ^ Projection from the compound element -- to sub memory element. -> MT submem a -- ^ Memory thread of the sub-element. -> MT mem a onSubMemory proj mt' = execute $ unMT mt' . proj {-# DEPRECATED liftSubMT "use onSubMemory instead" #-} -- | Alternate name for onSubMemory. liftSubMT :: (mem -> submem) -> MT submem a -> MT mem a liftSubMT = onSubMemory 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 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 (BYTES Int) mem -- | Make an allocator for a given memory type. makeAlloc :: LengthUnit l => l -> (Pointer -> mem) -> Alloc mem makeAlloc l memCreate = TwistRF (WrapArrow memCreate) $ 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 -- > -- > unsafeToPointer (ma, _) = unsafeToPointer ma -- class Memory m where -- | Returns an allocator for this memory. memoryAlloc :: Alloc m -- | Returns the pointer to the underlying buffer. unsafeToPointer :: m -> Pointer -- | A memory element that holds nothing. data VoidMemory = VoidMemory { unVoidMemory :: Pointer } instance Memory VoidMemory where memoryAlloc = makeAlloc (0 :: BYTES Int) $ VoidMemory unsafeToPointer = unVoidMemory instance ( Memory ma, Memory mb ) => Memory (ma, mb) where memoryAlloc = (,) <$> memoryAlloc <*> memoryAlloc unsafeToPointer (ma, _) = unsafeToPointer ma instance ( Memory ma , Memory mb , Memory mc ) => Memory (ma, mb, mc) where memoryAlloc = (,,) <$> memoryAlloc <*> memoryAlloc <*> memoryAlloc unsafeToPointer (ma,_,_) = unsafeToPointer ma instance ( Memory ma , Memory mb , Memory mc , Memory md ) => Memory (ma, mb, mc, md) where memoryAlloc = (,,,) <$> memoryAlloc <*> memoryAlloc <*> memoryAlloc <*> memoryAlloc unsafeToPointer (ma,_,_,_) = unsafeToPointer ma -- | Copy data from a given memory location to the other. The first -- argument is destionation and the second argument is source to match -- with the convention followed in memcpy. copyMemory :: Memory m => Dest m -- ^ Destination -> Src m -- ^ Source -> IO () copyMemory dmem smem = memcpy (unsafeToPointer <$> dmem) (unsafeToPointer <$> smem) sz where sz = twistMonoidValue $ getAlloc smem getAlloc :: Memory m => Src m -> Alloc m getAlloc _ = memoryAlloc -- | Perform an action which makes use of this memory. The memory -- 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 :: Alloc m -> (m -> IO a) -> IO a withM alctr action = allocaBuffer sz actualAction where sz = twistMonoidValue alctr getM = computeField $ twistFunctorValue alctr wipeIt cptr = memset cptr 0 sz actualAction cptr = action (getM cptr) <* wipeIt cptr -- | Similar to `withMemory` but allocates a secure memory for the -- 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 = twistMonoidValue alctr getM = computeField $ twistFunctorValue alctr ----------------------- Initialising and Extracting stuff ---------------------- -- | Memories that can be initialised with a pure value. The pure -- value resides in the Haskell heap and hence can potentially be -- swapped. Therefore, this class should be avoided if compromising -- the initialisation value can be dangerous. Consider using -- `InitialiseableFromBuffer` -- class Memory m => Initialisable m v where initialise :: v -> MT m () -- | Memories from which pure values can be extracted. Once a pure value is -- extracted, class Memory m => Extractable m v where extract :: MT m v -- | Apply the given function to the value in the cell. For a function @f :: b -> a@, -- the action @modify f@ first extracts a value of type @b@ from the -- memory element, applies @f@ to it and puts the result back into the -- memory. -- -- > modify f = do b <- extract -- > initialise $ f b -- modify :: (Initialisable m a, Extractable m b) => (b -> a) -> MT m () modify f = extract >>= initialise . f -- | A memory type that can be initialised from a pointer buffer. The initialisation performs -- a direct copy from the input buffer and hence the chances of the -- initialisation value ending up in the swap is minimised. class Memory m => InitialisableFromBuffer m where initialiser :: m -> ReadM (MT m) -- | A memory type that can extract bytes into a buffer. The extraction will perform -- a direct copy and hence the chances of the extracted value ending -- up in the swap space is minimised. class Memory m => ExtractableToBuffer m where extractor :: m -> WriteM (MT m) --------------------- Some instances of Memory -------------------- -- | A memory location to store a value of type having `Storable` -- instance. newtype MemoryCell a = MemoryCell { unMemoryCell :: Ptr a } instance Storable a => Memory (MemoryCell a) where memoryAlloc = allocator undefined where allocator :: Storable b => b -> Alloc (MemoryCell b) allocator b = makeAlloc (alignedSizeOf b) $ MemoryCell . castPtr unsafeToPointer = castPtr . unMemoryCell -- | The location where the actual storing of element happens. This -- pointer is guaranteed to be aligned to the alignment restriction of @a@ actualCellPtr :: Storable a => MemoryCell a -> Ptr a actualCellPtr = nextAlignedPtr . unMemoryCell -- | Work with the underlying pointer of the memory cell. Useful while -- working with ffi functions. withCellPointer :: Storable a => (Ptr a -> IO b) -> MT (MemoryCell a) b {-# INLINE withCellPointer #-} withCellPointer action = execute $ action . actualCellPtr -- | Get the pointer associated with the given memory cell. getCellPointer :: Storable a => MT (MemoryCell a) (Ptr a) {-# INLINE getCellPointer #-} getCellPointer = actualCellPtr <$> getMemory instance Storable a => Initialisable (MemoryCell a) a where initialise a = execute $ flip pokeAligned a . unMemoryCell {-# INLINE initialise #-} instance Storable a => Extractable (MemoryCell a) a where extract = execute $ peekAligned . unMemoryCell {-# INLINE extract #-} instance EndianStore a => InitialisableFromBuffer (MemoryCell a) where initialiser = readInto 1 . destination . actualCellPtr instance EndianStore a => ExtractableToBuffer (MemoryCell a) where extractor = writeFrom 1 . source . actualCellPtr raaz-0.1.1/Raaz/Core/MonoidalAction.hs0000644000000000000000000002040413037202101015642 0ustar0000000000000000{-# 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 infixr 5 <.> -- | An alternate symbol for <> more useful in the additive context. (<++>) :: Monoid m => m -> m -> m (<++>) = (<>) 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 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 :: (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) raaz-0.1.1/Raaz/Core/Parse/Applicative.hs0000644000000000000000000001173013037202101016257 0ustar0000000000000000-- | An applicative version of parser. This provides a restricted -- parser which has only an applicative instance. module Raaz.Core.Parse.Applicative ( Parser, parseWidth, parseError, runParser , unsafeRunParser , parse, parseStorable , parseVector, parseStorableVector , unsafeParseVector, unsafeParseStorableVector , parseByteString ) where import Data.ByteString (ByteString) import Data.Vector.Generic (Vector, generateM) import Foreign.Ptr (castPtr) import Foreign.Storable (Storable, peek, peekElemOff) import Prelude hiding ( length ) import System.IO.Unsafe (unsafePerformIO) import Raaz.Core.MonoidalAction import Raaz.Core.Types.Endian import Raaz.Core.Types.Pointer import Raaz.Core.Util.ByteString (createFrom, length, withByteString) type BytesMonoid = BYTES Int type ParseAction = FieldM IO Pointer -- | An applicative parser type for reading data from a pointer. type Parser = TwistRF ParseAction BytesMonoid makeParser :: LengthUnit l => l -> (Pointer -> IO a) -> Parser a makeParser l action = TwistRF (liftToFieldM action) $ 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 = twistMonoidValue -- | Runs a parser on a byte string. It returns `Nothing` if the byte string is smaller than -- what the parser would consume. runParser :: Parser a -> ByteString -> Maybe a runParser pr bs | length bs < parseWidth pr = Nothing | otherwise = Just $ unsafePerformIO $ withByteString bs $ unsafeRunParser pr -- | Run the parser without checking the length constraints. unsafeRunParser :: Parser a -> Pointer -> IO a 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 (sizeOf $ undefParse pa) (peek . castPtr) -- | Parse a crypto value. Endian safety is take into account -- here. This is what you would need when you parse packets from an -- 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 (sizeOf $ undefParse pa) (load . castPtr) -- | 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 * sizeOf (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 (castPtr cptr)) width = fromIntegral n * sizeOf (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 raaz-0.1.1/Raaz/Core/Primitives.hs0000644000000000000000000001001113037202101015066 0ustar0000000000000000{-| 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 CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ExistentialQuantification #-} module Raaz.Core.Primitives ( -- * Primtives and their implementations. Primitive(..), BlockAlgorithm(..), Key, Recommendation(..) , BLOCKS, blocksOf , allocBufferFor ) where import Data.Monoid import Prelude import Raaz.Core.Types -- | Implementation of block primitives work on buffers. Often for optimal -- performance, and in some case for safety, we need restrictions on -- the size and alignment of the buffer pointer. This type class -- captures such restrictions. class Describable a => BlockAlgorithm a where -- | The alignment expected for the buffer pointer. bufferStartAlignment :: a -> Alignment ----------------------- A primitive ------------------------------------ -- | 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. -- -- For use in production code, the library recommends a particular -- implementation using the `Recommendation` class. By default this is -- the implementation used when no explicit implementation is -- specified. class BlockAlgorithm (Implementation p) => Primitive p where -- | The block size. blockSize :: p -> BYTES Int -- | 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 -- | Allocate a buffer a particular implementation of a primitive prim. -- algorithm @algo@. It ensures that the memory passed is aligned -- according to the demands of the implementation. allocBufferFor :: Primitive prim => Implementation prim -> BLOCKS prim -> (Pointer -> IO b) -> IO b allocBufferFor imp l = allocaAligned (bufferStartAlignment imp) l -- | Some primitives like ciphers have an encryption/decryption key. This -- type family captures the key associated with a primitive if it has -- any. type family Key prim :: * ------------------- Type safe lengths in units of block ---------------- -- | 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 {unBLOCKS :: Int} deriving (Show, Eq, Ord, Enum, Real, Num, Integral) instance Monoid (BLOCKS p) where mempty = BLOCKS 0 mappend x y = BLOCKS $ unBLOCKS x + unBLOCKS y instance Primitive p => LengthUnit (BLOCKS p) where inBytes p@(BLOCKS x) = scale * blockSize (getPrimitiveType p) 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 :: Int -> p -> BLOCKS p blocksOf n _ = BLOCKS n raaz-0.1.1/Raaz/Core/Types.hs0000644000000000000000000000547713042177016014077 0ustar0000000000000000-- | This module exposes some core types used through out the Raaz -- library. One of the major goals of the raaz cryptographic library -- is to use the type safety of Haskell to catch some common -- bugs at compile time. -- -- __WARNING:__ If you are just a user of this library, it is unlikely -- that you will need to import this module. It is only required if -- you are a developer and want to define a new cryptographic data -- type. module Raaz.Core.Types ( -- * Overview. -- $overview$ module Raaz.Core.Types.Equality , module Raaz.Core.Types.Endian , module Raaz.Core.Types.Pointer , module Raaz.Core.Types.Aligned , module Raaz.Core.Types.Tuple , module Raaz.Core.Types.Copying , Describable(..) ) where import Raaz.Core.Types.Aligned import Raaz.Core.Types.Describe import Raaz.Core.Types.Equality import Raaz.Core.Types.Endian import Raaz.Core.Types.Pointer import Raaz.Core.Types.Tuple import Raaz.Core.Types.Copying( Src, Dest, source, destination) -- $overview$ -- -- A lot of cryptographic code is low level and involves quite a bit -- of boilerplate and are therefore fertile grounds for bugs. This -- module describes types specific to raaz that are designed to catch -- bugs in such low level code. The three principles that we follow -- in the design are: -- -- 1. Define distinct types for semantically different objects. For -- example, distinguish between buffer length/pointer offset in -- bytes versus other units (see `LengthUnit`) or make endian aware -- variants of standard word types (see `BE` and `LE`) etc. -- -- 2. Make sure that the low level functions are sensitive to these -- types. For example, the function `sizeOf` exposed here returns -- @`BYTES` `Int`@ instead of just `Int` and functions like -- `allocaBuffer` are generic enough to work with any length units. -- -- 3. Provide obvious instances for some basic type and have and -- idiom/design pattern to build such interfaces for user defined -- types. For example, we have a very specific way to build timing -- safe equality functions for arbitrary types. Most of the time, -- in our case it just amounts to handling product types. -- -- == Role of Monoids. -- -- Monoids play an important role in facilitating the top down -- approach to type safety that we mentioned above. Some types -- described here have a natural monoid semantics. For example, when -- dealing with pointer offsets and buffer sizes, we use type safe -- length units like `BYTES`. These length units are instances of -- monoids where the underlying operation is addition. On the other -- hand, when it comes to pointer alignment which is captured by the -- type `Alignment`, the monoid operation is taking the lowest common -- multiple. -- {-# ANN module "HLint: ignore Use import/export shortcut" #-} raaz-0.1.1/Raaz/Core/Util.hs0000644000000000000000000000025212750426275013703 0ustar0000000000000000{-| Some useful utility functions and combinators. -} module Raaz.Core.Util ( module Raaz.Core.Util.ByteString ) where import Raaz.Core.Util.ByteString raaz-0.1.1/Raaz/Core/Transfer.hs0000644000000000000000000003025413042177016014546 0ustar0000000000000000-- | Module to reading from and writing into buffers. {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Raaz.Core.Transfer ( -- * Transfer actions. -- $transfer$ -- ** Read action ReadM, ReadIO, bytesToRead, unsafeRead , readBytes, readInto -- ** Write action. , WriteM, WriteIO, bytesToWrite, unsafeWrite , write, writeStorable, writeVector, writeStorableVector , writeFrom, writeBytes , padWrite, prependWrite, glueWrites , writeByteString, skipWrite ) where import Control.Monad.IO.Class import Data.ByteString (ByteString) import Data.String import Data.ByteString.Internal (unsafeCreate) import Data.Monoid import qualified Data.Vector.Generic as G import Data.Word (Word8) import Foreign.Ptr (castPtr, Ptr) import Foreign.Storable ( Storable, poke ) import Raaz.Core.MonoidalAction import Raaz.Core.Types.Copying import Raaz.Core.Types.Endian import Raaz.Core.Types.Pointer import Raaz.Core.Util.ByteString as BU import Raaz.Core.Encode -- $transfer$ -- -- Low level buffer operations are problematic portions of any -- crypto-library. Buffers are usually represented by the starting -- pointer and one needs to keep track of the buffer sizes -- carefully. An operation that writes into a buffer, if it writes -- beyond the actual size of the buffer, can lead to a possible remote -- code execution. On the other hand, when reading from a buffer, if -- we read beyond the buffer it can leak private data to the attacker -- (as in the case of Heart bleed bug). This module is indented to -- give a relatively high level interface to this problem. We expose -- two types, the `ReadM` and the `WriteM` type which deals with these -- two aspects. Both these actions keep track of the number of bytes -- that they transfer. -- Complex reads and writes can be constructed using the monoid -- instance of these types. -- | This monoid captures a transfer action. newtype TransferM m = TransferM { unTransferM :: m () } instance Monad m => Monoid (TransferM m) where mempty = TransferM $ return () {-# INLINE mempty #-} mappend wa wb = TransferM $ unTransferM wa >> unTransferM wb {-# INLINE mappend #-} mconcat = TransferM . mapM_ unTransferM {-# INLINE mconcat #-} -- | A action that transfers bytes from its input pointer. Transfer -- could either be writing or reading. type TransferAction m = Pointer -> TransferM m instance LAction (BYTES Int) (TransferAction m) where offset <.> action = action . (offset<.>) {-# INLINE (<.>) #-} instance Monad m => Distributive (BYTES Int) (TransferAction m) -- | Byte transfers that keep track of the number of bytes that were -- transferred (from/into) its input buffer. type Transfer m = SemiR (TransferAction m) (BYTES Int) -- | Make an explicit transfer action given. makeTransfer :: LengthUnit u => u -> (Pointer -> m ()) -> Transfer m {-# INLINE makeTransfer #-} makeTransfer sz action = SemiR (TransferM . action) $ inBytes sz -------------------------- Monoid for writing stuff -------------------------------------- -- | An element of type `WriteM m` is an action which when executed transfers bytes -- /into/ its input buffer. The type @`WriteM` m@ forms a monoid and -- hence can be concatnated using the `<>` operator. newtype WriteM m = WriteM { unWriteM :: Transfer m } deriving Monoid -- | A write io-action. type WriteIO = WriteM IO -- | Returns the bytes that will be written when the write action is performed. bytesToWrite :: WriteM m -> BYTES Int bytesToWrite = semiRMonoid . unWriteM -- | Perform the write action without any checks of the buffer unsafeWrite :: WriteM m -> Pointer -- ^ The pointer for the buffer to be written into. -> m () unsafeWrite wr = unTransferM . semiRSpace (unWriteM wr) -- | Function that explicitly constructs a write action. makeWrite :: LengthUnit u => u -> (Pointer -> m ()) -> WriteM m makeWrite sz = WriteM . makeTransfer sz -- | The expression @`writeStorable` a@ gives a write action that -- stores a value @a@ in machine endian. The type of the value @a@ has -- to be an instance of `Storable`. This should be used when we want -- to talk with C functions and not when talking to the outside world -- (otherwise this could lead to endian confusion). To take care of -- endianness use the `write` combinator. writeStorable :: (MonadIO m, Storable a) => a -> WriteM m writeStorable a = WriteM $ makeTransfer (sizeOf a) pokeIt where pokeIt = liftIO . flip poke a . castPtr -- | The expression @`write` a@ gives a write action that stores a -- value @a@. One needs the type of the value @a@ to be an instance of -- `EndianStore`. Proper endian conversion is done irrespective of -- what the machine endianness is. The man use of this write is to -- serialize data for the consumption of the outside world. write :: (MonadIO m, EndianStore a) => a -> WriteM m write a = makeWrite (sizeOf a) $ liftIO . flip (store . castPtr) a -- | Write many elements from the given buffer writeFrom :: (MonadIO m, EndianStore a) => Int -> Src (Ptr a) -> WriteM m writeFrom n src = makeWrite (sz undefined src) $ \ ptr -> liftIO $ copyToBytes (destination ptr) src n where sz :: Storable a => a -> Src (Ptr a) -> BYTES Int sz a _ = toEnum n * sizeOf a -- | The vector version of `writeStorable`. writeStorableVector :: (Storable a, G.Vector v a, MonadIO m) => v a -> WriteM m {-# INLINE writeStorableVector #-} writeStorableVector = G.foldl' foldFunc mempty where foldFunc w a = w <> writeStorable a {- TODO: This function can be slow due to the fact that each time we use the semi-direct product, we incur a cost due to the lambda being not lifted. -} -- | The vector version of `write`. writeVector :: (EndianStore a, G.Vector v a, MonadIO m) => v a -> WriteM m {-# INLINE writeVector #-} {- TODO: improve this using the fact that the size is known -} writeVector = G.foldl' foldFunc mempty where foldFunc w a = w <> write a {- TODO: Same as in writeStorableVector -} -- | The combinator @writeBytes n b@ writes @b@ as the next @n@ -- consecutive bytes. writeBytes :: (LengthUnit n, MonadIO m) => Word8 -> n -> WriteM m writeBytes w8 n = makeWrite n memsetIt where memsetIt cptr = liftIO $ memset cptr w8 n {- -- | The write action @padWriteTo w n wr@ is wr padded with the byte @w@ so that the total length -- is n. If the total bytes written by @wr@ is greater than @n@ then this throws an error. padWriteTo :: ( LengthUnit n, MonadIO m) => Word8 -- ^ the padding byte to use -> n -- ^ the total length to pad to -> WriteM m -- ^ the write that needs padding -> WriteM m padWriteTo w8 n wrm | pl < 0 = error "padToLength: padding length smaller than total length" | otherwise = wrm <> writeBytes w8 n where pl = inBytes n - bytesToWrite wrm -} -- | The combinator @glueWrites w n hdr ftr@ is equivalent to -- @hdr <> glue <> ftr@ where the write @glue@ writes as many bytes -- @w@ so that the total length is aligned to the boundary @n@. glueWrites :: ( LengthUnit n, MonadIO m) => Word8 -- ^ The bytes to use in the glue -> n -- ^ The length boundary to align to. -> WriteM m -- ^ The header write -> WriteM m -- ^ The footer write -> WriteM m glueWrites w8 n hdr ftr = hdr <> writeBytes w8 lglue <> ftr where lhead = bytesToWrite hdr lfoot = bytesToWrite ftr lexceed = (lhead + lfoot) `rem` nBytes -- bytes exceeding the boundary. lglue = nBytes - lexceed nBytes = inBytes n -- | The write action @prependWrite w n wr@ is wr pre-pended with the byte @w@ so that the total length -- ends at a multiple of @n@. prependWrite :: ( LengthUnit n, MonadIO m) => Word8 -- ^ the byte to pre-pend with. -> n -- ^ the length to align the message to -> WriteM m -- ^ the message that needs pre-pending -> WriteM m prependWrite w8 n = glueWrites w8 n mempty -- | The write action @padWrite w n wr@ is wr padded with the byte @w@ so that the total length -- ends at a multiple of @n@. padWrite :: ( LengthUnit n, MonadIO m) => Word8 -- ^ the padding byte to use -> n -- ^ the length to align message to -> WriteM m -- ^ the message that needs padding -> WriteM m padWrite w8 n = flip (glueWrites w8 n) mempty -- | Writes a strict bytestring. writeByteString :: MonadIO m => ByteString -> WriteM m writeByteString bs = makeWrite (BU.length bs) $ liftIO . BU.unsafeCopyToPointer bs -- | A write action that just skips over the given bytes. skipWrite :: (LengthUnit u, Monad m) => u -> WriteM m skipWrite = flip makeWrite $ const $ return () instance MonadIO m => IsString (WriteM m) where fromString = writeByteString . fromString instance Encodable (WriteM IO) where {-# INLINE toByteString #-} toByteString w = unsafeCreate n $ unsafeWrite w . castPtr where BYTES n = bytesToWrite w {-# INLINE unsafeFromByteString #-} unsafeFromByteString = writeByteString {-# INLINE fromByteString #-} fromByteString = Just . writeByteString ------------------------ Read action ---------------------------- -- | The `ReadM` is the type that captures the act of reading from a buffer -- and possibly doing some action on the bytes read. Although -- inaccurate, it is helpful to think of elements of `ReadM` as action -- that on an input buffer transfers data from it to some unspecified -- source. -- -- Read actions form a monoid with the following semantics: if @r1@ -- and @r2@ are two read actions then @r1 `<>` r2@ first reads the -- data associated from @r1@ and then the read associated with the -- data @r2@. newtype ReadM m = ReadM { unReadM :: Transfer m} deriving Monoid -- | A read io-action. type ReadIO = ReadM IO -- | Function that explicitly constructs a write action. makeRead :: LengthUnit u => u -> (Pointer -> m ()) -> ReadM m makeRead sz = ReadM . makeTransfer sz -- | The expression @bytesToRead r@ gives the total number of bytes that -- would be read from the input buffer if the action @r@ is performed. bytesToRead :: ReadM m -> BYTES Int bytesToRead = semiRMonoid . unReadM -- | The action @unsafeRead r ptr@ results in reading @bytesToRead r@ -- bytes from the buffer pointed by @ptr@. This action is unsafe as it -- will not (and cannot) check if the action reads beyond what is -- legally stored at @ptr@. unsafeRead :: ReadM m -> Pointer -- ^ The pointer for the buffer to be written into. -> m () unsafeRead rd = unTransferM . semiRSpace (unReadM rd) -- | The action @readBytes sz dptr@ gives a read action, which if run on -- an input buffer, will transfers @sz@ to the destination buffer -- pointed by @dptr@. Note that it is the responsibility of the user -- to make sure that @dptr@ has enough space to receive @sz@ units of -- data if and when the read action is executed. readBytes :: ( LengthUnit sz, MonadIO m) => sz -- ^ how much to read. -> Dest Pointer -- ^ buffer to read the bytes into -> ReadM m readBytes sz dest = makeRead sz $ \ ptr -> liftIO $ memcpy dest (source ptr) sz -- | The action @readInto n dptr@ gives a read action which if run on an -- input buffer, will transfers @n@ elements of type @a@ into the -- buffer pointed by @dptr@. In particular, the read action @readInto n -- dptr@ is the same as @readBytes (fromIntegral n :: BYTES Int) dptr@ -- when the type @a@ is `Word8`. readInto :: (EndianStore a, MonadIO m) => Int -- ^ how many elements to read. -> Dest (Ptr a) -- ^ buffer to read the elements into -> ReadM m readInto n dest = makeRead (sz undefined dest) $ \ ptr -> liftIO $ copyFromBytes dest (source ptr) n where sz :: Storable a => a -> Dest (Ptr a) -> BYTES Int sz a _ = toEnum n * sizeOf a raaz-0.1.1/Raaz/Hash.hs0000644000000000000000000000620613055622555012764 0ustar0000000000000000{-| This module exposes all the cryptographic hash functions available under the raaz library. -} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} 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.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.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$ -- -- === NOTE: SHA1 is broken. -- -- SHA1 is no more available form this module, its use is highly -- depreciated. If you want to use it for transition please import -- Raaz.Hash.Sha1 specifically -- The cryptographic hashes provided by raaz give the following -- guarantees: -- -- 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" #-} raaz-0.1.1/Raaz/Hash/Internal.hs0000644000000000000000000002435313055622535014541 0ustar0000000000000000{-# 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, , compressStartAlignment :: Alignment } instance BlockAlgorithm (HashI h m) where bufferStartAlignment = compressStartAlignment -- | The constraints that a memory used by a hash implementation -- should satisfy. type HashM h m = (Initialisable m (), Extractable m h, Primitive 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 instance BlockAlgorithm (SomeHashI h) where bufferStartAlignment (SomeHashI imp) = bufferStartAlignment imp -- | Certain hashes are essentially bit-truncated versions of other -- hashes. For example, SHA224 is obtained from SHA256 by dropping the -- 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 , compressStartAlignment = compressStartAlignment } where comp ptr = onSubMemory unMtrunc . compress ptr . coerce compF ptr = onSubMemory 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' #-} -- TODO: For bytestrings (strict and lazy) we can do better. We can -- avoid copying as the bytestring exposes the underlying -- pointer. However, there is a huge cost if the underlying pointer -- does not start at the machine alignment boundary. The idea -- therefore is to process strict bytestring is multiples of blocks -- directly if the starting pointer is aligned. -- -- More details in the bug report #256. -- -- https://github.com/raaz-crypto/raaz/issues/256 -- -- | Similar to hashFile' but the user can specify the implementation -- to use. 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 imp@(HashI{..}) src = allocate $ \ ptr -> let comp = compress ptr bufSize finish bytes = compressFinal ptr bytes >> extract in processChunks comp finish src bufSize ptr where bufSize = atLeast l1Cache + 1 totalSize = bufSize + additionalPadBlocks undefined allocate = liftPointerAction $ allocBufferFor (SomeHashI imp) totalSize ----------------------- Hash memory ---------------------------------- -- | 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 unsafeToPointer = unsafeToPointer . hashCell instance Storable h => Initialisable (HashMemory h) h where initialise h = do onSubMemory hashCell $ initialise h onSubMemory messageLengthCell $ initialise (0 :: BITS Word64) instance Storable h => Extractable (HashMemory h) h where extract = onSubMemory hashCell extract -- | Extract the length of the message hashed so far. extractLength :: MT (HashMemory h) (BITS Word64) extractLength = onSubMemory messageLengthCell extract {-# INLINE extractLength #-} -- | Update the message length by a given amount. updateLength :: LengthUnit u => u -> MT (HashMemory h) () {-# INLINE updateLength #-} updateLength u = onSubMemory messageLengthCell $ modify (nBits +) where nBits :: BITS Word64 nBits = inBits u raaz-0.1.1/Raaz/Hash/Sha1.hs0000644000000000000000000000477713055622555013573 0ustar0000000000000000{-| This module exposes combinators to compute the SHA1 hash and the associated HMAC for some common types. -} module Raaz.Hash.Sha1 {-# DEPRECATED "SHA1 is broken. This module is here only for transition." #-} ( -- * The broken SHA1 cryptographic hash. -- $sha1$ 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() -- $sha1$ -- -- We already have a collision for SHA1: -- -- -- While it does not yet rule out SHA1 for some specific tasks, there -- is no reason for its continual usage. This module is present only -- to facilitate the transition to a better hash. Use it assuming no -- security guarantees. Raaz will not try to optimise the -- implementations given here and will remove this module at some -- point of time. So do not rely on this for your software. -- -- -- {-# DEPRECATED sha1, sha1File, sha1Source "SHA1 is broken. This functions are here only for transition." #-} -- | Compute the sha1 hash of an instance of `PureByteSource`. Use -- this for computing the sha1 hash of a strict or lazy byte string. sha1 :: PureByteSource src => src -> SHA1 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 broken. This functions are here only for transition." #-} -- | Compute the message authentication code using hmac-sha1. hmacSha1 :: PureByteSource src => Key (HMAC SHA1) -> src -> HMAC SHA1 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 raaz-0.1.1/Raaz/Hash/Sha1/Implementation/CPortable.hs0000644000000000000000000000143013042177016020403 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -- | The portable C-implementation of SHA1 module Raaz.Hash.Sha1.Implementation.CPortable ( implementation ) where import Foreign.Ptr ( Ptr ) 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 = shaImplementation "sha1-cportable" "Sha1 Implementation using portable C and Haskell FFI" c_sha1_compress length64Write foreign import ccall unsafe "raaz/hash/sha1/portable.h raazHashSha1PortableCompress" c_sha1_compress :: Pointer -> Int -> Ptr SHA1 -> IO () raaz-0.1.1/Raaz/Hash/Sha224.hs0000644000000000000000000000374512750426275013736 0ustar0000000000000000{-| 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 raaz-0.1.1/Raaz/Hash/Sha224/Implementation/CPortable.hs0000644000000000000000000000324713037202101020546 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} -- | The portable C-implementation of SHA224 module Raaz.Hash.Sha224.Implementation.CPortable ( implementation ) where import Control.Applicative import Prelude 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 unsafeToPointer = unsafeToPointer . unSHA224Mem instance Initialisable SHA224Memory () where initialise _ = onSubMemory unSHA224Mem $ initialise $ SHA256 $ unsafeFromList [ 0xc1059ed8 , 0x367cd507 , 0x3070dd17 , 0xf70e5939 , 0xffc00b31 , 0x68581511 , 0x64f98fa7 , 0xbefa4fa4 ] instance Extractable SHA224Memory SHA224 where extract = trunc <$> onSubMemory 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 raaz-0.1.1/Raaz/Hash/Sha256.hs0000644000000000000000000000374512750426275013743 0ustar0000000000000000{-| 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 raaz-0.1.1/Raaz/Hash/Sha256/Implementation/CPortable.hs0000644000000000000000000000147713042177016020572 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -- | The portable C-implementation of SHA1 module Raaz.Hash.Sha256.Implementation.CPortable ( implementation, cPortable ) where import Foreign.Ptr ( Ptr ) 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 = shaImplementation "sha256-cportable" "Sha256 Implementation using portable C and Haskell FFI" c_sha256_compress length64Write foreign import ccall unsafe "raaz/hash/sha256/portable.h raazHashSha256PortableCompress" c_sha256_compress :: Pointer -> Int -> Ptr SHA256 -> IO () raaz-0.1.1/Raaz/Hash/Sha384.hs0000644000000000000000000000374512750426275013745 0ustar0000000000000000{-| 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 raaz-0.1.1/Raaz/Hash/Sha384/Implementation/CPortable.hs0000644000000000000000000000311413037202101020546 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} -- | The portable C-implementation of SHA384 module Raaz.Hash.Sha384.Implementation.CPortable ( implementation ) where import Control.Applicative import Prelude 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 unsafeToPointer = unsafeToPointer . unSHA384Mem instance Initialisable SHA384Memory () where initialise _ = onSubMemory unSHA384Mem $ initialise $ SHA512 $ unsafeFromList [ 0xcbbb9d5dc1059ed8 , 0x629a292a367cd507 , 0x9159015a3070dd17 , 0x152fecd8f70e5939 , 0x67332667ffc00b31 , 0x8eb44a8768581511 , 0xdb0c2e0d64f98fa7 , 0x47b5481dbefa4fa4 ] instance Extractable SHA384Memory SHA384 where extract = trunc <$> onSubMemory 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 raaz-0.1.1/Raaz/Hash/Sha512.hs0000644000000000000000000000374512750426275013736 0ustar0000000000000000{-| 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 raaz-0.1.1/Raaz/Hash/Sha512/Implementation/CPortable.hs0000644000000000000000000000150013042177016020550 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -- | The portable C-implementation of SHA1 module Raaz.Hash.Sha512.Implementation.CPortable ( implementation, cPortable ) where import Foreign.Ptr ( Ptr ) 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 = shaImplementation "sha512-cportable" "Sha512 Implementation using portable C and Haskell FFI" c_sha512_compress length128Write foreign import ccall unsafe "raaz/hash/sha512/portable.h raazHashSha512PortableCompress" c_sha512_compress :: Pointer -> Int -> Ptr SHA512 -> IO () raaz-0.1.1/Raaz/Cipher.hs0000644000000000000000000000241713055622555013313 0ustar0000000000000000-- | 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$ StreamCipher , transform, chacha20 , Cipher , aes128cbc, aes192cbc, aes256cbc ) where import Raaz.Cipher.AES ( aes128cbc, aes192cbc, aes256cbc) import Raaz.Cipher.ChaCha20 import Raaz.Cipher.Internal (transform, Cipher, StreamCipher) -- $cipherdoc$ -- -- The raaz library exposes symmetric key encryption using instances -- of the class `Cipher`. For a cipher @c@, the type family @`Key` c@ -- gives the type of its key. As of now, we only support the safe -- usage of stream ciphers. Encryption and Decryption are the same for -- stream ciphers and we call this combinator `transform`. Block -- ciphers do not have a natural way to handle streams that are of -- size less than their block size. A future release will handle these -- issues. -- -- If you are thinking of encryption using private keys consider -- encrypted-authenticated modes. Currently we do not have support for -- this either but hopefully this will also be fixed soon. -- -- TODO: Fix the above documentation when it is done. raaz-0.1.1/Raaz/Cipher/Internal.hs0000644000000000000000000002607713037202101015054 0ustar0000000000000000{-# 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(..) -- ** Stream ciphers. -- $streamcipher$ , StreamCipher, makeCipherI , transform, transform' -- ** Unsafe encryption and decryption. -- $unsafecipher$ -- , unsafeEncrypt, unsafeDecrypt, unsafeEncrypt', unsafeDecrypt' ) where import Control.Monad.IO.Class (liftIO) import Data.ByteString.Internal as IB import Foreign.Ptr (castPtr) import System.IO.Unsafe (unsafePerformIO) 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`. They are instances of the -- class `Symmetric` and the associated type `Key` captures the all -- that is required to determine the encryption and decryption -- process. In most ciphers, this includes what is know as the -- _encryption key_ as well as the _initialisation vector_. -- -- Instances of `Cipher` is only required to provide full block -- encryption/decryption algorithms. Implementations are captured by -- two types. -- -- [`CipherI`:] Values of this type that captures implementations of a -- cipher. This type is parameterised over the memory element that is -- 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` -- -- $streamcipher$ -- -- Stream ciphers are special class of ciphers which can encrypt -- messages of any length (not necessarily multiples of block length). -- Typically, stream ciphers are obtained by xoring the data with a -- stream of prg values that the stream ciphers generate. As a -- consequence, the encryption and decryption is the same algorithm. -- one can also use the stream cipher as a pseudo-random generator. -- -- We have the class `StreamCipher` that captures valid stream ciphers. -- -- | Block cipher modes. 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 () , cipherStartAlignment :: Alignment } -- | Type constraints on the memory of a block cipher implementation. type CipherM cipher encMem decMem = ( Initialisable encMem (Key cipher) , Initialisable decMem (Key cipher) , Primitive cipher ) -- TODO: More need initialisable from buffer. -- | Some implementation of a block cipher. This type is existentially -- quantifies over the memory used in the implementation. data SomeCipherI cipher = forall encMem decMem . CipherM cipher encMem decMem => SomeCipherI (CipherI cipher encMem decMem) instance BlockAlgorithm (CipherI cipher encMem decMem) where bufferStartAlignment = cipherStartAlignment instance Describable (CipherI cipher encMem decMem) where name = cipherIName description = cipherIDescription instance Describable (SomeCipherI cipher) where name (SomeCipherI cI) = name cI description (SomeCipherI cI) = description cI instance BlockAlgorithm (SomeCipherI cipher) where bufferStartAlignment (SomeCipherI imp) = bufferStartAlignment imp -- | Class capturing ciphers. The implementation of this class should -- give an encryption and decryption algorithm for messages of length -- which is a multiple of the block size. Needless to say, the -- encryption and decryption should be inverses of each other for such -- messages. class (Primitive cipher, Implementation cipher ~ SomeCipherI cipher, Describable cipher) => Cipher cipher -- | Class that captures stream ciphers. An instance of `StreamCipher` -- should be an instance of `Cipher`, with the following additional -- constraints. -- -- 1. The encryption and decryption should be the same algorithm. -- -- 2. Encryption/decryption can be applied to a messages of length @l@ -- even if @l@ is not a multiple of block length. -- -- 3. The encryption of a prefix of a length @l@ of a message @m@ -- should be the same as the @l@ length prefix of the encryption of -- @m@. -- -- It is the duty of the implementer of the cipher to ensure that the -- above conditions are true before declaring an instance of a stream -- cipher. class Cipher cipher => StreamCipher cipher -- | Constructs a `CipherI` value out of a stream transformation function. Useful in -- building a Cipher instance of a stream cipher. makeCipherI :: String -- ^ name -> String -- ^ description -> (Pointer -> BLOCKS prim -> MT mem ()) -- ^ stream transformer -> Alignment -- ^ buffer starting alignment -> CipherI prim mem mem makeCipherI nm des trans = CipherI nm des trans trans ------------------ Unsafe cipher operations ------------------------ -- $unsafecipher$ -- -- 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 simp@(SomeCipherI imp) key bs = IB.unsafeCreate sbytes go where sz = atMost (B.length bs) `asTypeOf` blocksOf 1 c BYTES sbytes = inBytes sz go ptr = allocBufferFor simp sz $ \ buf -> insecurely $ do initialise key liftIO $ unsafeNCopyToPointer sz bs buf -- Copy the input to buffer. encryptBlocks imp buf sz liftIO $ Raaz.Core.memcpy (destination (castPtr ptr)) (source buf) sz -- | Transforms a given bytestring using a stream cipher. We use the -- transform instead of encrypt/decrypt because for stream ciphers -- these operations are same. transform' :: StreamCipher c => c -> Implementation c -> Key c -> ByteString -> ByteString transform' c simp@(SomeCipherI imp) key bs = unsafePerformIO $ IB.createAndTrim (fromEnum $ inBytes blks) action where blks = atLeast len `asTypeOf` blocksOf 1 c len = B.length bs action ptr = allocBufferFor simp blks $ \ buf -> insecurely $ do initialise key liftIO $ unsafeCopyToPointer bs buf -- copy data into the buffer encryptBlocks imp buf blks -- encrypt it liftIO $ Raaz.Core.memcpy (destination (castPtr ptr)) (source buf) len -- copy it back to the actual pointer. return $ fromIntegral len -- | Transform a given bytestring using the recommended implementation -- of a stream cipher. transform :: (StreamCipher c, Recommendation c) => c -> Key c -> ByteString -> ByteString transform c = transform' c $ recommended c -- | Encrypt using the recommended implementation. This function is -- unsafe because it only works correctly when the input `ByteString` -- is of length which is a multiple of the block length of the cipher. 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 -- | 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 simp@(SomeCipherI imp) key bs = IB.unsafeCreate sbytes go where sz = atMost (B.length bs) `asTypeOf` blocksOf 1 c BYTES sbytes = inBytes sz go ptr = allocBufferFor simp sz $ \ buf -> insecurely $ do initialise key liftIO $ unsafeNCopyToPointer sz bs buf -- Copy the input to buffer. decryptBlocks imp buf sz liftIO $ Raaz.Core.memcpy (destination (castPtr ptr)) (source buf) sz -- | Decrypt using the recommended implementation. This function is -- unsafe because it only works correctly when the input `ByteString` -- 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 raaz-0.1.1/Raaz/Cipher/AES.hs0000644000000000000000000000046612750426275013727 0ustar0000000000000000module 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" #-} raaz-0.1.1/Raaz/Cipher/AES/CBC/Implementation/CPortable.hs0000644000000000000000000001525713037202101021135 0ustar0000000000000000{-# 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 Foreign.Ptr ( Ptr ) import Prelude 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 unsafeToPointer = unsafeToPointer . m128ekey instance Initialisable M128 (KEY128, IV) where initialise (k,iv) = do onSubMemory m128ekey $ do initialise k withCellPointer $ c_transpose 11 onSubMemory m128iv $ do initialise iv withCellPointer $ 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 unsafeToPointer = unsafeToPointer . m192ekey instance Initialisable M192 (KEY192, IV) where initialise (k,iv) = do onSubMemory m192ekey $ do initialise k withCellPointer $ c_transpose 13 onSubMemory m192iv $ do initialise iv withCellPointer $ 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 unsafeToPointer = unsafeToPointer . m256ekey instance Initialisable M256 (KEY256, IV) where initialise (k,iv) = do onSubMemory m256ekey $ do initialise k withCellPointer $ c_transpose 15 onSubMemory m256iv $ do initialise iv withCellPointer $ 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 , cipherStartAlignment = wordAlignment } -- | The encryption action. cbc128Encrypt :: Pointer -> BLOCKS (AES 128 'CBC) -> MT M128 () cbc128Encrypt buf nBlocks = do eKeyPtr <- onSubMemory m128ekey getCellPointer ivPtr <- onSubMemory m128iv getCellPointer liftIO $ c_aes_cbc_e buf (fromEnum nBlocks) 10 eKeyPtr ivPtr -- | The decryption action. cbc128Decrypt :: Pointer -> BLOCKS (AES 128 'CBC) -> MT M128 () cbc128Decrypt buf nBlocks = do eKeyPtr <- onSubMemory m128ekey getCellPointer ivPtr <- onSubMemory m128iv getCellPointer 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 , cipherStartAlignment = wordAlignment } -- | The encryption action. cbc192Encrypt :: Pointer -> BLOCKS (AES 192 'CBC) -> MT M192 () cbc192Encrypt buf nBlocks = do eKeyPtr <- onSubMemory m192ekey getCellPointer ivPtr <- onSubMemory m192iv getCellPointer liftIO $ c_aes_cbc_e buf (fromEnum nBlocks) 12 eKeyPtr ivPtr -- | The decryption action. cbc192Decrypt :: Pointer -> BLOCKS (AES 192 'CBC) -> MT M192 () cbc192Decrypt buf nBlocks = do eKeyPtr <- onSubMemory m192ekey getCellPointer ivPtr <- onSubMemory m192iv getCellPointer 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 , cipherStartAlignment = wordAlignment } -- | The encryption action. cbc256Encrypt :: Pointer -> BLOCKS (AES 256 'CBC) -> MT M256 () cbc256Encrypt buf nBlocks = do eKeyPtr <- onSubMemory m256ekey getCellPointer ivPtr <- onSubMemory m256iv getCellPointer liftIO $ c_aes_cbc_e buf (fromEnum nBlocks) 14 eKeyPtr ivPtr -- | The decryption action. cbc256Decrypt :: Pointer -> BLOCKS (AES 256 'CBC) -> MT M256 () cbc256Decrypt buf nBlocks = do eKeyPtr <- onSubMemory m256ekey getCellPointer ivPtr <- onSubMemory m256iv getCellPointer 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 -> Ptr ekey -> 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 -> Ptr ekey -- extended key -> Ptr iv -- 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 -> Ptr ekey -- extened key -> Ptr iv -- iv -> IO () raaz-0.1.1/Raaz/Cipher/ChaCha20.hs0000644000000000000000000000036713007537126014562 0ustar0000000000000000module Raaz.Cipher.ChaCha20 ( ChaCha20, chacha20, KEY, IV, Counter ) where import Raaz.Cipher.ChaCha20.Internal import Raaz.Cipher.ChaCha20.Recommendation() -- | The chacha20 stream cipher. chacha20 :: ChaCha20 chacha20 = ChaCha20 raaz-0.1.1/Raaz/Cipher/ChaCha20/Implementation/CPortable.hs0000644000000000000000000000377113055622555021430 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-} module Raaz.Cipher.ChaCha20.Implementation.CPortable ( implementation, chacha20Random ) where import Control.Monad.IO.Class ( liftIO ) import Foreign.Ptr ( Ptr ) import Raaz.Core import Raaz.Cipher.Internal import Raaz.Cipher.ChaCha20.Internal implementation :: SomeCipherI ChaCha20 implementation = SomeCipherI chacha20Portable -- | Chacha20 block transformation. foreign import ccall unsafe "raaz/cipher/chacha20/cportable.h raazChaCha20Block" c_chacha20_block :: Pointer -- Message -> Int -- number of blocks -> Ptr KEY -- key -> Ptr IV -- iv -> Ptr Counter -- Counter value -> IO () -- | Encrypting/Decrypting a block of chacha20. chacha20Block :: Pointer -> BLOCKS ChaCha20 -> MT ChaCha20Mem () chacha20Block msgPtr nblocks = do keyPtr <- onSubMemory keyCell getCellPointer ivPtr <- onSubMemory ivCell getCellPointer ctrPtr <- onSubMemory counterCell getCellPointer liftIO $ c_chacha20_block msgPtr (fromEnum nblocks) keyPtr ivPtr ctrPtr -- | The chacha20 randomness generator. chacha20Random :: Pointer -> BLOCKS ChaCha20 -> MT ChaCha20Mem () chacha20Random = chacha20Block ---------------------- DANGEROUS CODE -------------------------------------- -- | The chacha20 randomness generator. We have set the alignment to -- 32 because this allows gcc to further optimise the implementation. chacha20Portable :: CipherI ChaCha20 ChaCha20Mem ChaCha20Mem chacha20Portable = makeCipherI "chacha20-cportable" "Implementation of the chacha20 stream cipher (RFC7539)" chacha20Block 32 raaz-0.1.1/Raaz/Random.hs0000644000000000000000000002270613055622555013324 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Interface for cryptographically secure random byte generators. module Raaz.Random ( -- * Cryptographically secure randomness. -- $randomness$ RandM, RT, liftMT , randomByteString -- ** Types that can be generated randomly , Random(..) -- * Low level access to randomness. , fillRandomBytes , unsafeStorableRandom , reseed ) where import Control.Applicative import Control.Monad import Control.Monad.IO.Class import Data.ByteString ( ByteString ) import Data.Int import Data.Vector.Unboxed hiding ( replicateM, create ) import Data.Word import Foreign.Ptr ( Ptr , castPtr) import Foreign.Storable ( Storable, peek ) import Prelude import Raaz.Core import Raaz.Cipher.ChaCha20.Internal(KEY, IV) import Raaz.Random.ChaCha20PRG -- $randomness$ -- -- The raaz library gives a relatively high level interface to -- randomness. The monad `RandM` captures a batch of actions that -- generate/use cryptographically secure random bytes. In particular, -- you can use the functions `random` and `randomByteString` to -- actually generate random elements. -- -- -- = Running a random action -- -- Depending on whether the random bytes generated are sensitive or -- not, you can use either of the combinators `securely` or -- `insecurely`. The combinator `securely` ensures that the seed of -- the PRG is stored in a locked memory and hence will not be swapped -- out to the disk. A use case for this is when you use the random -- bytes to generate say a long term public key. On the other hand -- locked memory is limited on most systems. So for cases where the -- secrecy of the bytes are not important, we would recommend using -- `insecurely`. -- -- > -- Generate a pair of random Word8's -- > import Raaz -- > import Data.Word -- > -- > main :: IO () -- > main = insecurely rPair >>= print -- > where rPair :: RandM (Word8, Word8) -- > rPair = (,) <$> random <$> random -- > -- -- -- > -- A version of hello world that has gone nuts. Printed in base16 -- > -- to save some terminal grief. -- > -- > main = insecurely who >>= \ w -> putStrLn $ "hello " ++ showBase16 w -- > where who :: RandM ByteString -- > who = randomByteString 10 -- > -- -- Some times you need additional memory to keep track of other -- stuff. The monad @`RT` mem@ is meant for such uses. It should be -- seen as the analogue of the monad @`MT` mem@ which in addition -- allows you to pick cryptographically secure random data. In fact, -- the combinator `liftMT` allows you to lift an `MT` action to the -- corresponding `RT` action. -- -- = Internal details -- -- Generating unpredictable stream of bytes is one task that has burnt -- the fingers of a lot of programmers. Unfortunately, getting it -- correct is something of a black art. Raaz uses a stream cipher -- (chacha20), initialised with a starting random key/iv. The starting -- seed is then drawn from the system entropy pool. -- -- TODO: For system entropy we use @\/dev\/urandom@ on a posix systems -- (no windows support yet). Even on posix systems, depending on -- underlying operating system, there are better options. The -- recommended way to generate randomness on an OpenBSD system is -- through the function `arc4random` (note that arc4random does not -- use rc4 cipher anymore). Recent Linux kernels support the -- `getrandom` system call which unfortunately is not yet -- popular. These system specific calls are better because they take -- into consideration many edge cases like for example -- @\/dev\/urandom@ not being accessible or protection from interrupts -- Eventually we will be supporting these calls. -- | A batch of actions on the memory element @mem@ that uses some -- randomness. newtype RT mem a = RT { unMT :: MT (RandomState, mem) a } deriving (Functor, Applicative, Monad, MonadIO) -- | The monad for generating cryptographically secure random data. type RandM = RT VoidMemory -- | Lift a memory action to the corresponding RT action. liftMT :: MT mem a -> RT mem a liftMT = RT . onSubMemory snd -- | Run a randomness thread. In particular, this combinator takes -- care of seeding the internal prg at the start. runRT :: RT m a -> MT (RandomState, m) a runRT action = onSubMemory fst reseedMT >> unMT action instance Memory mem => MonadMemory (RT mem) where insecurely = insecurely . runRT securely = securely . runRT -- | Reseed from the system entropy pool. There is never a need to -- explicitly seed your generator. The insecurely and securely calls -- makes sure that your generator is seed before -- starting. Furthermore, the generator also reseeds after every few -- GB of random bytes generates. Generating random data from the -- system entropy is usually an order of magnitude slower than using a -- fast stream cipher. Reseeding often can slow your program -- considerably without any additional security advantage. -- reseed :: RT mem () reseed = RT $ onSubMemory fst reseedMT -- | Fill the given input pointer with random bytes. fillRandomBytes :: LengthUnit l => l -> Pointer -> RT mem () fillRandomBytes l = RT . onSubMemory fst . fillRandomBytesMT l -- | Types that can be generated at random. It might appear that all -- storables should be an instance of this class, after all we know -- the size of the element why not write that many random bytes. In -- fact, this module provides an `unsafeStorableRandom` which does -- exactly that. However, we do not give a blanket definition for all -- storables because for certain refinements of a given type, like for -- example, Word8's modulo 10, `unsafeStorableRandom` introduces -- unacceptable skews. class Random a where random :: Memory mem => RT mem a -- | Generate a random element. The element picked is -- crypto-graphically pseudo-random. -- -- This is a helper function that has been exported to simplify the -- definition of a `Random` instance for `Storable` types. However, -- there is a reason why we do not give a blanket instance for all -- instances `Storable` and why this function is unsafe? This function -- generates a random element of type @a@ by generating @n@ random -- bytes where @n@ is the size of the elements of @a@. For instances -- that range the entire @n@ byte space this is fine. However, if the -- type is actually a refinement of such a type --- consider for -- example, @`Word8`@ modulo @10@ -- this function generates an -- unacceptable skew in the distribution. Hence this function is -- prefixed unsafe. -- unsafeStorableRandom :: (Memory mem, Storable a) => RT mem a unsafeStorableRandom = RT $ onSubMemory fst retA where retA = liftPointerAction alloc $ getIt . castPtr getIt :: Storable a => Ptr a -> MT RandomState a getIt ptr = unsafePokeManyRandom 1 ptr >> liftIO (peek ptr) getElement :: MT RandomState a -> a getElement _ = undefined algn = alignment $ getElement retA sz = sizeOf $ getElement retA alloc = allocaAligned algn sz -- | Generate a random byteString. randomByteString :: LengthUnit l => l -> RT mem ByteString randomByteString l = RT $ onSubMemory fst $ liftPointerAction (create l) $ fillRandomBytesMT l ------------------------------- Some instances of Random ------------------------ instance Random Word8 where random = unsafeStorableRandom instance Random Word16 where random = unsafeStorableRandom instance Random Word32 where random = unsafeStorableRandom instance Random Word64 where random = unsafeStorableRandom instance Random Word where random = unsafeStorableRandom instance Random Int8 where random = unsafeStorableRandom instance Random Int16 where random = unsafeStorableRandom instance Random Int32 where random = unsafeStorableRandom instance Random Int64 where random = unsafeStorableRandom instance Random Int where random = unsafeStorableRandom instance Random KEY where random = unsafeStorableRandom instance Random IV where random = unsafeStorableRandom instance Random w => Random (LE w) where random = littleEndian <$> random instance Random w => Random (BE w) where random = bigEndian <$> random instance (Dimension d, Unbox w, Random w) => Random (Tuple d w) where random = repeatM random -------------------------- Now comes the boring tuples ----------------- instance (Random a, Random b) => Random (a,b) where random = (,) <$> random <*> random instance (Random a, Random b, Random c) => Random (a,b,c) where random = (,,) <$> random <*> random <*> random instance (Random a, Random b, Random c, Random d) => Random (a,b,c,d) where random = (,,,) <$> random <*> random <*> random <*> random instance (Random a, Random b, Random c, Random d, Random e) => Random (a,b,c,d,e) where random = (,,,,) <$> random <*> random <*> random <*> random <*> random -- | The action @unsafePokeManyRandom n ptr@ pokes @n@ random elements -- at the location starting at ptr. If the underlying type does not -- saturate its entire binary size (think of say Word8 modulo 5), the -- distribution of elements can be rather skewed . Hence the prefix -- unsafe. This function is exported to simplify the definition -- `Random` instance. Do not use it unwisely. unsafePokeManyRandom :: Storable a => Int -> Ptr a -> MT RandomState () unsafePokeManyRandom n ptr = fillRandomBytesMT totalSz $ castPtr ptr where totalSz = fromIntegral n * sizeOf (getElement ptr) getElement :: Ptr a -> a getElement _ = undefined raaz-0.1.1/Raaz/Cipher/ChaCha20/Implementation/Vector128.hs0000644000000000000000000000303113037202101021214 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Raaz.Cipher.ChaCha20.Implementation.Vector128 ( implementation ) where import Control.Monad.IO.Class ( liftIO ) import Foreign.Ptr ( Ptr ) import Raaz.Core import Raaz.Cipher.Internal import Raaz.Cipher.ChaCha20.Internal implementation :: SomeCipherI ChaCha20 implementation = SomeCipherI chacha20Vector -- | Chacha20 block transformation. foreign import ccall unsafe "raazChaCha20BlockVector" c_chacha20_block :: Pointer -- Message -> Int -- number of blocks -> Ptr KEY -- key -> Ptr IV -- iv -> Ptr Counter -- Counter value -> IO () chacha20Block :: Pointer -> BLOCKS ChaCha20 -> MT ChaCha20Mem () chacha20Block msgPtr nblocks = do keyPtr <- onSubMemory keyCell getCellPointer ivPtr <- onSubMemory ivCell getCellPointer ctrPtr <- onSubMemory counterCell getCellPointer liftIO $ c_chacha20_block msgPtr (fromEnum nblocks) keyPtr ivPtr ctrPtr chacha20Vector :: CipherI ChaCha20 ChaCha20Mem ChaCha20Mem chacha20Vector = makeCipherI "chacha20-vector-128" "Implementation of the chacha20 stream cipher using the gcc's vector instructions" chacha20Block 16 raaz-0.1.1/Raaz/Cipher/ChaCha20/Implementation/Vector256.hs0000644000000000000000000000372213055622535021246 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-} module Raaz.Cipher.ChaCha20.Implementation.Vector256 ( implementation, chacha20Random ) where import Control.Monad.IO.Class ( liftIO ) import Foreign.Ptr ( Ptr ) import Raaz.Core import Raaz.Cipher.Internal import Raaz.Cipher.ChaCha20.Internal --------------------------- Setting up the implementation ---------------------------- implementation :: SomeCipherI ChaCha20 implementation = SomeCipherI chacha20Vector chacha20Vector :: CipherI ChaCha20 ChaCha20Mem ChaCha20Mem chacha20Vector = makeCipherI "chacha20-vector-256" "Implementation of the chacha20 stream cipher using the gcc's 256-bit vector instructions" chacha20Block 32 ----------------------------- The block transformation --------------------------------- -- | Chacha20 block transformation. foreign import ccall unsafe "raazChaCha20BlockVector256" c_chacha20_block :: Pointer -- Message -> Int -- number of blocks -> Ptr KEY -- key -> Ptr IV -- iv -> Ptr Counter -- Counter value -> IO () chacha20Block :: Pointer -> BLOCKS ChaCha20 -> MT ChaCha20Mem () chacha20Block msgPtr nblocks = do keyPtr <- onSubMemory keyCell getCellPointer ivPtr <- onSubMemory ivCell getCellPointer ctrPtr <- onSubMemory counterCell getCellPointer liftIO $ c_chacha20_block msgPtr (fromEnum nblocks) keyPtr ivPtr ctrPtr ----------------------------- The chacha20 stream cipher ---------------------------------- chacha20Random :: Pointer -> BLOCKS ChaCha20 -> MT ChaCha20Mem () chacha20Random = chacha20Block raaz-0.1.1/Raaz/Core/Constants.hs0000644000000000000000000000032012750426275014736 0ustar0000000000000000module 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 raaz-0.1.1/Raaz/Core/Encode/Internal.hs0000644000000000000000000001126413037202101015717 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} -- | Internal module that has the encode class and some utility functions. module Raaz.Core.Encode.Internal ( Encodable(..), Format(..) ) where import Data.Maybe import Data.ByteString (ByteString) import Data.ByteString.Internal (unsafeCreate) import Data.String import Data.Word import Foreign.Ptr import Prelude hiding (length) import System.IO.Unsafe (unsafePerformIO) 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 that can be -- encoded into a stream of bytes. By making a type say @Foo@ an -- instance of the `Encodable` class, we get for free methods to -- encode it in any of the supported formats (i.e. instances of the -- class `Format`). -- -- Minimum complete definition for this class is `toByteString` and -- `fromByteString`. Instances of `EndianStore` have default -- definitions for both these functions and hence a trivial instance -- declaration is sufficient for such types. -- -- > -- > instance Encodable Foo -- > -- 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 (fromEnum $ sizeOf w) putit where putit ptr = store (castPtr ptr) w default fromByteString :: EndianStore a => ByteString -> Maybe a fromByteString bs | sizeOf 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 {-# 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 format is a representation of binary data often in -- printable form. We distinguish between various binary formats at -- the type level and each supported format corresponds to an instance -- of the the class `Format`. The `encodeByteString` and -- `decodeFormat` are required to satisfy the laws -- -- > decodeFormat . encodeByteString = id -- -- For type safety, the formats themselves are opaque types and hence -- it is not possible to obtain the underlying binary data directly. -- We require binary formats to be instances of the class `Encodable`, -- with the combinators `toByteString` and `fromByteString` of the -- `Encodable` class performing the actual encoding and decoding. -- -- Instances of `Format` are required to be instances of `Show` and so -- that the encoded format can be easily printed. They are also -- required to be instances of `IsString` so that they can be easily -- represented in Haskell source using the @OverloadedStrings@ -- extension. However, be careful when using this due to the fact -- that invalid encodings can lead to runtime errors. -- class (IsString fmt, Show fmt, Encodable fmt) => Format fmt where -- | Encode binary data into the format. The return type gurantees -- that any binary data can indeed be encoded into a format. encodeByteString :: ByteString -> fmt -- | Decode the format to its associated binary -- representation. Notice that this function always succeeds: we -- assume that elements of the type `fmt` are valid encodings and -- hence the return type is `ByteString` instead of @`Maybe` -- ByteString@. decodeFormat :: fmt -> ByteString -- | Bytestring itself is an encoding format (namely binary format). instance Format ByteString where encodeByteString = id {-# INLINE encodeByteString #-} decodeFormat = id {-# INLINE decodeFormat #-} raaz-0.1.1/Raaz/Core/Encode/Base16.hs0000644000000000000000000000720013006426545015177 0ustar0000000000000000-- | 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 Prelude import Raaz.Core.Encode.Internal -- | The type corresponding to base-16 or hexadecimal encoding. The -- `Base16` encoding has a special place in this library: most -- cryptographic types use `Base16` encoding for their `Show` and -- `IsString` instance. The combinators `fromBase16` and `showBase16` -- are exposed mainly to make these definitions easy. -- -- The base16 encoding only produces valid hex characters. However, to -- aid easy presentation of long hexadecimal strings, a user can add -- add arbitrary amount of spaces, newlines and the character ':'. The -- decoding ignores these characters. newtype Base16 = Base16 {unBase16 :: ByteString} deriving (Eq, Monoid) -- Developers note: Internally base16 just stores the bytestring as -- 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.any (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 = unsafeFromHexP . C8.filter (not . useless) where useless c = isSpace c || c == ':' unsafeFromHexP :: ByteString -> ByteString unsafeFromHexP bs | odd (B.length bs) = error "base16 encoding is always of even size" | otherwise = fst $ B.unfoldrN len gen 0 where len = B.length bs `quot` 2 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 = unsafeFromByteString . unBase16 . fromString -- | Base16 variant of `show`. showBase16 :: Encodable a => a -> String showBase16 = show . Base16 . toByteString raaz-0.1.1/Raaz/Core/Encode/Base64.hs0000644000000000000000000001356713006426545015217 0ustar0000000000000000-- | Base 64 encoding of objects. {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Raaz.Core.Encode.Base64( Base64 ) 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, w2c) import Data.ByteString.Unsafe(unsafeIndex) import Data.Monoid import Data.Word import Raaz.Core.Encode.Internal -- | The type corresponding to the standard padded base-64 binary -- encoding. The base-64 encoding only produces valid base-64 -- characters. However, to aid easy presentation of long base-64 -- strings, a user can add add arbitrary amount of spaces and -- newlines. The decoding ignores these characters. newtype Base64 = Base64 {unBase64 :: ByteString} deriving (Eq, Monoid) -- Developers note: Internally base16 just stores the bytestring as -- is. The conversion happens when we do an encode and decode of -- actual base16. instance Encodable Base64 where toByteString = toB64 . unBase64 fromByteString bs | B.null bs = Just $ Base64 B.empty | B.length bs `rem` 4 /= 0 = Nothing | badCharacter bs' = Nothing | not (isB64OrPad pl) = Nothing | not (isB64OrPad pf) = Nothing | otherwise = Just $ Base64 $ unsafeFromB64 bs where pl = C8.last bs pf = C8.last $ C8.init bs bs' = C8.init $ C8.init bs badCharacter = C8.any (not . isB64Char) isB64Char c = isAlpha c || isDigit c || c == '+' || c == '/' isB64OrPad c = isB64Char c || c == '=' unsafeFromByteString bs | B.null bs = Base64 B.empty | otherwise = Base64 $ unsafeFromB64 bs instance Show Base64 where show = C8.unpack . toByteString instance IsString Base64 where fromString = unsafeFromByteString . fromString instance Format Base64 where encodeByteString = Base64 {-# INLINE encodeByteString #-} decodeFormat = unBase64 {-# INLINE decodeFormat #-} ------------- Base 64 encoding ------------------------- -- NOTE: The topN functions ensure that the top N bits of a word are present -- in the least N significant bits. The botN ensures that there top6 :: Word8 -> Word8; bot2 :: Word8 -> Word8 top4 :: Word8 -> Word8; bot4 :: Word8 -> Word8 top2 :: Word8 -> Word8; bot6 :: Word8 -> Word8 top6 w = w `shiftR` 2; bot2 w = w .&. 0x03 top4 w = w `shiftR` 4; bot4 w = w .&. 0x0F top2 w = w `shiftR` 6; bot6 w = w .&. 0x3F --------------- Combining bytes ----------------------------------- byte0 :: Word8 -> Word8 byte1 :: Word8 -> Word8 -> Word8 byte2 :: Word8 -> Word8 -> Word8 byte3 :: Word8 -> Word8 pad :: Word8 byte0 = b64 . top6 byte1 t p = b64 $ shiftL (bot2 p) 4 .|. top4 t byte2 t p = b64 $ shiftL (bot4 p) 2 .|. top2 t byte3 = b64 . bot6 pad = c2w '=' -- | Encoding word. b64 :: Word8 -> Word8 b64 w | 0 <= w && w <= 25 = c2w 'A' + w | 26 <= w && w <= 51 = c2w 'a' + w - 26 | 52 <= w && w <= 61 = c2w '0' + w - 52 | w == 62 = c2w '+' | w == 63 = c2w '/' | otherwise = error "oops: b64" unB64 :: Word8 -> Word8 unB64 w | c2w 'A' <= w && w <= c2w 'Z' = w - c2w 'A' | c2w 'a' <= w && w <= c2w 'z' = w - c2w 'a' + 26 | c2w '0' <= w && w <= c2w '9' = w - c2w '0' + 52 | w == c2w '+' = 62 | w == c2w '/' = 63 | otherwise = error $ "oops unB64:" ++ [w2c w] -- TODO: Since the encoding to base16 is usually used for user interaction -- we can afford to be slower here. toB64 :: ByteString -> ByteString toB64 bs = fst (B.unfoldrN (4*n) gen 0) <> padding where gen i = Just (byte i, i + 1) at blk i = unsafeIndex bs $ 3 * blk + i byte i = case r of 0 -> byte0 $ at q 0 1 -> byte1 (at q 1) $ at q 0 2 -> byte2 (at q 2) $ at q 1 3 -> byte3 $ at q 2 _ -> error "base64 bad index" where (q, r) = quotRem i 4 (n,p) = B.length bs `quotRem` 3 padding = case p of 0 -> mempty 1 -> B.pack [ byte0 $ at n 0 , byte1 0 $ at n 0 , pad, pad ] 2 -> B.pack [ byte0 $ at n 0 , byte1 (at n 1) $ at n 0 , byte2 0 $ at n 1 , pad ] _ -> error "base64 pad bad index" -- Notes: Merge is used to convert from base64 digits, which are -- words of 6-bits. merg0 :: Word8 -> Word8 -> Word8 merg1 :: Word8 -> Word8 -> Word8 merg2 :: Word8 -> Word8 -> Word8 merg0 a b = (unB64 a `shiftL` 2) .|. top4 (unB64 b) merg1 a b = (unB64 a `shiftL` 4) .|. top6 (unB64 b) merg2 a b = (unB64 a `shiftL` 6) .|. unB64 b unsafeFromB64 :: ByteString -> ByteString unsafeFromB64 = unsafeFromB64P . C8.filter (not . useless) where useless = isSpace unsafeFromB64P :: ByteString -> ByteString unsafeFromB64P bs = fst (B.unfoldrN (3*n) gen 0) <> unPad where n = B.length bs `quot` 4 - 1 gen i = Just (byte i, i + 1) at blk i = unsafeIndex bs $ 4 * blk + i byte i = case r of 0 -> merg0 (at q 0) $ at q 1 1 -> merg1 (at q 1) $ at q 2 2 -> merg2 (at q 2) $ at q 3 _ -> error "base64 bad index" where (q, r) = quotRem i 3 unPad | at n 2 == c2w '=' = B.singleton $ merg0 (at n 0) $ at n 1 | at n 3 == c2w '=' = B.pack [ merg0 (at n 0) $ at n 1 , merg1 (at n 1) $ at n 2 ] | otherwise = B.pack [ merg0 (at n 0) $ at n 1 , merg1 (at n 1) $ at n 2 , merg2 (at n 2) $ at n 3 ] raaz-0.1.1/Raaz/Core/Util/ByteString.hs0000644000000000000000000000702413055622535015775 0ustar0000000000000000{-| Some utility function for byte strings. -} {-# LANGUAGE FlexibleContexts #-} module Raaz.Core.Util.ByteString ( length, replicate , fromByteStringStorable , create, createFrom , withByteString , unsafeCopyToPointer , unsafeNCopyToPointer ) where import Prelude hiding (length, replicate) import qualified Data.ByteString as B import Data.ByteString (ByteString) import qualified Data.ByteString.Internal as BI 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 import Raaz.Core.Types.Copying -- | 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 dptr (source $ p `plusPtr` offset) (BYTES n) where (fptr, offset,n) = BI.toForeignPtr bs dptr = destination $ castPtr cptr -- | Similar to `unsafeCopyToPointer` but takes an additional input -- @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 dptr (source $ p `plusPtr` offset) n where (fptr, offset,_) = BI.toForeignPtr bs dptr = destination $ castPtr cptr -- | Works directly on the pointer associated with the -- `ByteString`. This function should only read and not modify the -- contents of the pointer. withByteString :: ByteString -> (Pointer -> IO a) -> IO a withByteString bs f = withForeignPtr fptr (f . flip plusPtr off . castPtr) where (fptr, off, _) = BI.toForeignPtr bs -- | Get the value from the bytestring using `peek`. fromByteStringStorable :: Storable k => ByteString -> k fromByteStringStorable str = unsafePerformIO $ withByteString str (peek . castPtr) -- | The action @create l act@ creates a length @l@ bytestring where -- the contents are filled using the the @act@ to fill the buffer. create :: LengthUnit l => l -> (Pointer -> IO ()) -> IO ByteString create l act = myCreate (act . castPtr) where myCreate = BI.create $ fromIntegral $ inBytes l -- | The IO action @createFrom n cptr@ creates a bytestring by copying -- @n@ bytes from the pointer @cptr@. createFrom :: LengthUnit l => l -> Pointer -> IO ByteString createFrom l cptr = create l filler where filler dptr = memcpy (destination $ castPtr dptr) (source cptr) l ---------------------- Hexadecimal encoding. ----------------------------------- raaz-0.1.1/Raaz/Core/Types/Aligned.hs0000644000000000000000000000463413055622555015443 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -- | This module gives ways to force the alignment of types. module Raaz.Core.Types.Aligned ( -- * Types to force alignment. Aligned, unAligned, aligned16Bytes, aligned32Bytes, aligned64Bytes ) where #if MIN_VERSION_base(4,7,0) import Data.Proxy #endif import GHC.TypeLits import Foreign.Ptr ( castPtr ) import Foreign.Storable ( Storable(..) ) import Prelude hiding ( length ) -- | A type @w@ forced to be aligned to the alignment boundary @alg@ newtype Aligned (align :: Nat) w = Aligned { unAligned :: w -- ^ The underlying unAligned value. } -- | Align the value to 16-byte boundary aligned16Bytes :: w -> Aligned 16 w {-# INLINE aligned16Bytes #-} -- | Align the value to 32-byte boundary aligned32Bytes :: w -> Aligned 32 w {-# INLINE aligned32Bytes #-} -- | Align the value to 64-byte boundary aligned64Bytes :: w -> Aligned 64 w {-# INLINE aligned64Bytes #-} aligned16Bytes = Aligned aligned32Bytes = Aligned aligned64Bytes = Aligned #if MIN_VERSION_base(4,7,0) -- | The constraint on the alignment o(since base 4.7.0). type AlignBoundary (alg :: Nat) = KnownNat alg alignmentBoundary :: AlignBoundary alg => Aligned alg a -> Int alignmentBoundary = aB Proxy where aB :: AlignBoundary algn => Proxy algn -> Aligned algn a -> Int aB algn _ = fromEnum $ natVal algn #else -- | The constraint on the alignment (pre base 4.7.0). type AlignBoundary (alg :: Nat) = SingI alg alignmentBoundary :: AlignBoundary algn => Aligned algn a -> Int alignmentBoundary = withSing aB where aB :: AlignBoundary algn => Sing algn -> Aligned algn a -> Int aB algn _ = fromEnum $ fromSing algn #endif instance (Storable a, AlignBoundary alg) => Storable (Aligned alg a) where sizeOf = sizeOf . unAligned alignment alg = lcm valueAlignment forceAlignment where valueAlignment = alignment $ unAligned alg forceAlignment = alignmentBoundary alg peek = fmap Aligned . peek . castPtr poke ptr = poke (castPtr ptr) . unAligned raaz-0.1.1/Raaz/Core/Types/Pointer.hs0000644000000000000000000003627713043432667015530 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CPP #-} -- | This module exposes types that builds in type safety into some of -- the low level pointer operations. The functions here are pretty low -- level and will be required only by developers of the library that -- to the core of the library. module Raaz.Core.Types.Pointer ( -- * Pointers, offsets, and alignment Pointer -- ** Type safe length units. , LengthUnit(..) , BYTES(..), BITS(..), inBits , sizeOf -- *** Some length arithmetic , bitsQuotRem, bytesQuotRem , bitsQuot, bytesQuot , atLeast, atLeastAligned, atMost -- ** Types measuring alignment , Alignment, wordAlignment , ALIGN , alignment, alignPtr, movePtr, alignedSizeOf, nextAlignedPtr, peekAligned, pokeAligned -- ** Allocation functions. , allocaAligned, allocaSecureAligned, allocaBuffer, allocaSecure, mallocBuffer -- ** Some buffer operations , memset, memmove, memcpy , hFillBuf ) where import Control.Applicative import Control.Exception ( bracket_) import Control.Monad ( void, when ) import Control.Monad.IO.Class import Data.Monoid import Data.Word import Foreign.Marshal.Alloc import Foreign.Ptr ( Ptr ) import qualified Foreign.Ptr as FP import Foreign.Storable ( Storable, peek, poke ) import qualified Foreign.Storable as FS import System.IO (hGetBuf, Handle) import Prelude -- To stop the annoying warnings of Applicatives and Monoids. import Raaz.Core.MonoidalAction import Raaz.Core.Types.Equality import Raaz.Core.Types.Copying -- $basics$ -- -- The main concepts introduced here are the following -- -- [`Pointer`:] The generic pointer type that is used through the -- library. -- -- [`LengthUnit`:] This class captures types units of length. -- -- [`Alignment`:] A dedicated type that is used to keep track of -- alignment constraints. offsets in We have the generic pointer type -- `Pointer` and distinguish between different length units at the -- type level. This helps in to avoid a lot of length conversion -- errors. -- Developers notes: I assumes that word alignment is alignment -- safe. If this is not the case one needs to fix this to avoid -- performance degradation or worse incorrect load/store. -- | 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. The smallest of length/offset that we have is bytes -- measured using the type `BYTES`. In various other circumstances, it -- would be more natural to measure these in multiples of bytes. For -- example, when allocating buffer to use encrypt using a block cipher -- it makes sense to measure the buffer size in multiples of block of -- the cipher. Explicit conversion between these length units, while -- allocating or moving pointers, involves a lot of low level scaling -- that is also error prone. To avoid these errors due to unit -- conversions, we distinguish between different length units at the -- type level. This type class capturing all such types, i.e. types -- that stand of length units. Allocation functions and pointer -- arithmetic are generalised to these length units. -- -- All instances of a `LengthUnit` are required to be instances of -- `Monoid` where the monoid operation gives these types the natural -- size/offset addition semantics: i.e. shifting a pointer by offset -- @a `mappend` b@ is same as shifting it by @a@ and then by @b@. class (Enum u, Monoid u) => LengthUnit u where -- | Express the length units in bytes. inBytes :: u -> BYTES Int -- | 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 ) -- | Type safe length unit that measures offsets in multiples of word -- length. This length unit can be used if one wants to make sure that -- all offsets are word aligned. newtype ALIGN = ALIGN { unALIGN :: Int } deriving ( Show, Eq,Ord, Enum, Integral , Real, Num, Storable ) instance Num a => Monoid (BYTES a) where mempty = 0 mappend = (+) instance Monoid ALIGN where mempty = ALIGN 0 mappend x y = ALIGN $ unALIGN x + unALIGN y instance LengthUnit ALIGN where inBytes (ALIGN x) = BYTES $ x * FS.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 = succ u where (u , r) = bytesQuotRem $ inBytes src -- | Often we want to allocate a buffer of size @l@. We also want to -- make sure that the buffer starts at an alignment boundary -- @a@. However, the standard word allocation functions might return a -- pointer that is not aligned as desired. The @atLeastAligned l a@ -- returns a length @n@ such the length @n@ is big enough to ensure -- that there is at least @l@ length of valid buffer starting at the -- next pointer aligned at boundary @a@. If the alignment required in -- @a@ then allocating @l + a - 1 should do the trick. atLeastAligned :: LengthUnit l => l -> Alignment -> ALIGN atLeastAligned l a = n + pad - 1 where n = atLeast l -- Alignment adjusted to word boundary. algn = wordAlignment <> a pad = atLeast $ BYTES $ unAlignment $ algn -- | Express length unit @src@ in terms of length unit @dest@ rounding -- downwards. atMost :: ( LengthUnit src , 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 (toEnum 1 `asTypeOf` u) (BYTES q, r) = bytes `quotRem` divisor u = toEnum q -- | Function similar to `bytesQuotRem` but returns only the quotient. bytesQuot :: LengthUnit u => BYTES Int -> u bytesQuot bytes = u where divisor = inBytes (toEnum 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 (toEnum 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 (toEnum 1 `asTypeOf` u) q = bits `quot` divisor u = toEnum $ fromEnum q -- | The most interesting monoidal action for us. instance LengthUnit u => LAction u Pointer where a <.> ptr = movePtr ptr a {-# INLINE (<.>) #-} ------------------------ Alignment -------------------------------- -- | Types to measure alignment in units of bytes. newtype Alignment = Alignment { unAlignment :: Int } deriving ( Show, Eq, Ord, Enum, Integral , Real, Num ) -- | The default alignment to use is word boundary. wordAlignment :: Alignment wordAlignment = alignment (undefined :: Align) instance Monoid Alignment where mempty = Alignment 1 mappend = lcm ---------- Type safe versions of some pointer functions ----------------- -- | Compute the size of a storable element. sizeOf :: Storable a => a -> BYTES Int sizeOf = BYTES . FS.sizeOf -- | Size of the buffer to be allocated to store an element of type -- @a@ so as to guarantee that there exist enough space to store the -- element after aligning the pointer. If the size of the element is -- @s@ and its alignment is @a@ then this quantity is essentially -- equal to @s + a - 1@. All units measured in word alignment. alignedSizeOf :: Storable a => a -> ALIGN alignedSizeOf a = atLeastAligned (sizeOf a) $ alignment a -- | Compute the alignment for a storable object. alignment :: Storable a => a -> Alignment alignment = Alignment . FS.alignment -- | Align a pointer to the appropriate alignment. alignPtr :: Ptr a -> Alignment -> Ptr a alignPtr ptr = FP.alignPtr ptr . unAlignment -- | Move the given pointer with a specific offset. movePtr :: LengthUnit l => Ptr a -> l -> Ptr a movePtr ptr l = FP.plusPtr ptr offset where BYTES offset = inBytes l -- | Compute the next aligned pointer starting from the given pointer -- location. nextAlignedPtr :: Storable a => Ptr a -> Ptr a nextAlignedPtr ptr = alignPtr ptr $ alignment $ elementOfPtr ptr where elementOfPtr :: Ptr b -> b elementOfPtr _ = undefined -- | Peek the element from the next aligned location. peekAligned :: Storable a => Ptr a -> IO a peekAligned = peek . nextAlignedPtr -- | Poke the element from the next aligned location. pokeAligned :: Storable a => Ptr a -> a -> IO () pokeAligned ptr = poke $ nextAlignedPtr ptr -- | The expression @allocaAligned a l action@ allocates a local -- buffer of length @l@ and alignment @a@ and passes it on to the IO -- action @action@. No explicit freeing of the memory is required as -- the memory is allocated locally and freed once the action -- finishes. It is better to use this function than -- @`allocaBytesAligned`@ as it does type safe scaling and alignment. allocaAligned :: LengthUnit l => Alignment -- ^ the alignment of the buffer -> l -- ^ size of the buffer -> (Pointer -> IO b) -- ^ the action to run -> IO b allocaAligned algn l = allocaBytesAligned b a where BYTES b = inBytes l Alignment a = algn -- | This function allocates a chunk of "secure" memory of a given -- size and runs the action. The memory (1) exists for the duration of -- the action (2) will not be swapped during that time and (3) will be -- 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. -- allocaSecureAligned :: LengthUnit l => Alignment -> l -> (Pointer -> IO a) -> IO a #ifdef HAVE_MLOCK foreign import ccall unsafe "sys/mman.h mlock" c_mlock :: Pointer -> BYTES Int -> IO Int foreign import ccall unsafe "sys/mman.h munlock" c_munlock :: Pointer -> BYTES Int -> IO () allocaSecureAligned a l action = allocaAligned a l actualAction where sz = inBytes l actualAction cptr = let lockIt = do c <- c_mlock cptr sz when (c /= 0) $ fail "secure memory: unable to lock memory" releaseIt = memset cptr 0 l >> c_munlock cptr sz in bracket_ lockIt releaseIt $ action cptr #else allocaSecureAligned _ _ = fail "memory locking not supported on this platform" #endif -- | A less general version of `allocaAligned` where the pointer passed -- is aligned to word boundary. allocaBuffer :: LengthUnit l => l -- ^ buffer length -> (Pointer -> IO b) -- ^ the action to run -> IO b {-# INLINE allocaBuffer #-} allocaBuffer = allocaAligned wordAlignment -- | A less general version of `allocaSecureAligned` where the pointer passed -- is aligned to word boundary allocaSecure :: LengthUnit l => l -> (Pointer -> IO b) -> IO b allocaSecure = allocaSecureAligned wordAlignment -- | Creates a memory of given size. It is better to use over -- @`mallocBytes`@ as it uses typesafe length. mallocBuffer :: LengthUnit l => 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 :: Dest Pointer -> Src Pointer -> BYTES Int -> IO Pointer -- | Copy between pointers. memcpy :: (MonadIO m, LengthUnit l) => Dest Pointer -- ^ destination -> Src Pointer -- ^ src -> l -- ^ Number of Bytes to copy -> m () memcpy dest src = liftIO . void . c_memcpy dest src . inBytes {-# SPECIALIZE memcpy :: Dest Pointer -> Src Pointer -> BYTES Int -> IO () #-} foreign import ccall unsafe "string.h memmove" c_memmove :: Dest Pointer -> Src Pointer -> BYTES Int -> IO Pointer -- | Move between pointers. memmove :: (MonadIO m, LengthUnit l) => Dest Pointer -- ^ destination -> Src Pointer -- ^ source -> l -- ^ Number of Bytes to copy -> m () memmove dest src = liftIO . void . c_memmove dest src . inBytes {-# SPECIALIZE memmove :: Dest Pointer -> Src Pointer -> BYTES Int -> IO () #-} foreign import ccall unsafe "string.h memset" c_memset :: Pointer -> Word8 -> BYTES Int -> IO Pointer -- | Sets the given number of Bytes to the specified value. memset :: (MonadIO m, LengthUnit l) => Pointer -- ^ Target -> Word8 -- ^ Value byte to set -> l -- ^ Number of bytes to set -> m () memset p w = liftIO . void . c_memset p w . inBytes {-# SPECIALIZE memset :: Pointer -> Word8 -> BYTES Int -> IO () #-} raaz-0.1.1/Raaz/Core/Types/Tuple.hs0000644000000000000000000001253413043432667015167 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} module Raaz.Core.Types.Tuple ( -- * Length encoded tuples Tuple, Dimension, dimension, initial, diagonal , repeatM -- ** 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, Ptr ) import Foreign.Storable ( Storable(..) ) import Prelude hiding ( length ) import Raaz.Core.Types.Equality import Raaz.Core.Types.Endian import Raaz.Core.Transfer import Raaz.Core.Parse.Applicative -- | Tuples that encode their length in their types. For tuples, we call -- the length its dimension. 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) -- | The constaint on the dimension of the tuple (since base 4.7.0) type Dimension (dim :: Nat) = KnownNat dim -- | This combinator returns the dimension of the tuple. dimension :: Dimension dim => Tuple dim a -> Int dimensionP :: Dimension dim => Proxy dim -> Tuple dim a -> Int dimensionP sz _ = fromEnum $ natVal sz dimension = dimensionP Proxy #else -- | The constaint on the dimension of the tuple (pre base 4.7.0) type Dimension (dim :: Nat) = SingI dim -- | This combinator returns the dimension of the tuple. dimension :: (V.Unbox a, Dimension dim) => Tuple dim a -> Int dimensionP :: (Dimension dim, V.Unbox a) => Sing dim -> Tuple dim a -> Int dimension = withSing dimensionP dimensionP sz _ = fromEnum $ fromSing sz #endif -- | Get the dimension to parser getParseDimension :: (V.Unbox a, Dimension dim) => Parser (Tuple dim a) -> Int getTupFromP :: (V.Unbox a, Dimension dim) => Parser (Tuple dim a) -> Tuple dim a getParseDimension = dimension . getTupFromP getTupFromP _ = undefined instance (V.Unbox a, Storable a, Dimension dim) => Storable (Tuple dim a) where 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 instance (V.Unbox a, EndianStore a, Dimension dim) => EndianStore (Tuple dim a) where load = unsafeRunParser tupParser . castPtr where tupParser = Tuple <$> unsafeParseVector len len = getParseDimension tupParser store ptr tup = unsafeWrite writeTup cptr where writeTup = writeVector $ unTuple tup cptr = castPtr ptr adjustEndian ptr n = adjustEndian (unTupPtr ptr) $ nos ptr undefined where nos :: Ptr (Tuple dim a) -> Tuple dim a -> Int nos _ w = dimension w * n unTupPtr :: Ptr (Tuple dim a) -> Ptr a unTupPtr = castPtr -- | Construct a tuple by repeating a monadic action. repeatM :: (Functor m, Monad m, V.Unbox a, Dimension dim) => m a -> m (Tuple dim a) repeatM action = result where result = Tuple <$> V.replicateM sz action sz = dimension $ getTup result getTup :: (Monad m, Dimension n)=> m (Tuple n a) -> Tuple n a getTup _ = undefined -- | Construct a tuple out of the list. This function is unsafe and -- will result in run time error if the list is not of the correct -- dimension. unsafeFromList :: (V.Unbox a, Dimension dim) => [a] -> Tuple dim a 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. initial :: (V.Unbox a, Dimension dim0) => Tuple dim1 a -> Tuple dim0 a initial tup = tup0 where tup0 = Tuple $ V.take (dimension tup0) $ unTuple tup -- TODO: Put a constraint that dim0 <= dim1 -- | The @diagonal a@ gives a tuple, all of whose entries is @a@. diagonal :: (V.Unbox a, Dimension dim) => a -> Tuple dim a diagonal a = tup where tup = Tuple $ V.replicate (dimension tup) a raaz-0.1.1/Raaz/Core/Types/Equality.hs0000644000000000000000000002770413042177016015671 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} -- | This module defines combinators, types and instances for defining -- timing safe equality checks. module Raaz.Core.Types.Equality ( -- * Timing safe equality checking. -- $timingSafeEquality$ Equality(..), (===) , Result ) 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 -- $timingSafeEquality$ -- -- Many cryptographic setting require comparing two secrets and such -- comparisons should be timing safe, i.e. the time taken to make the -- comparison should not depend on the actual values that are -- compared. Unfortunately, the equality comparison of may Haskell -- types like `ByteString`, provided via the class `Eq` is /not/ -- timing safe. In raaz we take special care in defining the `Eq` -- instance of all cryptographically sensitive types which make them -- timing safe . For example, if we compare two digests @dgst1 == -- dgst2@, the `Eq` instance is defined in such a way that the time -- taken is constant irrespective of the actual values. We also give a -- mechanism to build timing safe equality for more complicated types -- that user might need to define in her use cases as we now describe. -- -- The starting point of defining such timing safe equality is the -- class `Equality` which plays the role `Eq`. The member function -- `eq` playing the role of (`==`) with an important difference. The -- comparison function `eq` returns the type type `Result` instead of -- `Bool` and it is timing safe. The `Eq` instance is then defined by -- making use of the operator (`===`). Thus a user of the library can -- stick to the familiar `Eq` class and get the benefits of timing -- safe comparison -- -- == Building timing safe equality for Custom types. -- -- For basic types like `Word32`, `Word64` this module defines -- instances of `Equality`. The `Tuple` type inherits the `Equality` -- instance from its base type. As a developer, new crypto-primitives -- or protocols often need to define timing safe equality for types -- other than those exported here. This is done in two stages. -- -- 1. Define an instance of `Equality`. -- -- 2. Make use of the above instance to define `Eq` instance as follows. -- -- > data SomeSensitiveType = ... -- > -- > instance Equality SomeSensitiveType where -- > eq a b = ... -- > -- > instance Eq SomeSensitiveType where -- > (==) a b = a === b -- -- === Combining multiple comparisons using Monoid operations -- -- The `Result` type is an opaque type and does not allow inspection -- via a pattern match or conversion to `Bool`. However, while -- defining the `Equality` instance, we often need to perform an AND -- of multiple comparison (think of comparing a tuple). This is where -- the monoid instance of `Result` is useful. If @r1@ and @r2@ are the -- results of two comparisons then @r1 `mappend` r2@ essentially takes -- the AND of these results. However, unlike in the case of AND-ing in -- `Bool`, `mappend` on the `Result` type does not short-circuit. In -- fact, the whole point of using `Result` type instead of `Bool` is -- to avoid this short circuiting. -- -- To illustrate, we have the following code fragment -- -- > data Foo = Foo Word32 Word64 -- > -- > instance Equality Foo where -- > eq (Foo a b) (Foo c d) = eq a c `mapped` eq b d -- > -- > instance Eq Foo where -- > (=) = (===) -- -- == Automatic deriving of `Equality` instances. -- -- We often find ourselves wrapping existing types in new types -- keeping in line with the philosophy of distinguishing sematically -- distinct data with their types. It would be tedious to repeat the -- above process for each such type. Often, we can get away by just -- deriving these instances thereby saving a lot of boilerplate. For -- example, consider a data type that needs to keep a 128-byte -- secret. A simple deriving class would work in such cases. -- -- > -- > newtype Secret = Secret (Tuple 128 Word8) deriving (Equality, Eq) -- > -- -- The `Eq` instance here would be timing safe because it is -- essentially the `Eq` instance of tuples. The deriving `Equality` is -- not strictly required here. However, we suggest keeping it so that -- on can define timing safe equality for other types that contain a -- component of type `Secret`. -- -- === Beware: deriving clause can be dangerous -- -- The deriving clause that we defined above while convenient, hides a -- danger when not used properly. For example, consider the following -- definitions. -- -- > data Bad = Bad Bar Biz deriving Eq -- > newtype BadAgain = BadAgain (Bar, Biz) deriving (Eq, Equality) -- > -- -- The comparison for the elements of the type `Bad` would leak some -- timing information /even/ when `Bar` and `Biz` are instances of -- `Equality` and thus have timing safe equalities themselves. This is -- because the automatic derivation of `Eq` instances in the above two -- cases performs a component by component comparison and combines the -- result using @`and`@. Due to boolean short circuiting, this -- will lead to timing information being leaked. -- -- For product types, we can safely derive the `Equality` instance and use -- it to define the @Eq@ instance as follows -- -- > -- > newtype Okey2 = Okey (Foo, Bar) deriving Equality -- > -- > instance Eq Okey2 where -- > (=) = (===) -- > -- -- -- | All types that support timing safe equality are instances of this class. class Equality a where eq :: a -> a -> Result -- | 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 -- Now comes the boring instances for tuples. instance ( Equality a , Equality b ) => Equality (a , b) where eq (a1,a2) (b1,b2) = eq a1 b1 `mappend` eq a2 b2 instance ( Equality a , Equality b , Equality c ) => Equality (a , b, c) where eq (a1,a2,a3) (b1,b2,b3) = eq a1 b1 `mappend` eq a2 b2 `mappend` eq a3 b3 instance ( Equality a , Equality b , Equality c , Equality d ) => Equality (a , b, c, d) where eq (a1,a2,a3,a4) (b1,b2,b3,b4) = eq a1 b1 `mappend` eq a2 b2 `mappend` eq a3 b3 `mappend` eq a4 b4 instance ( Equality a , Equality b , Equality c , Equality d , Equality e ) => Equality (a , b, c, d, e) where eq (a1,a2,a3,a4,a5) (b1,b2,b3,b4,b5) = eq a1 b1 `mappend` eq a2 b2 `mappend` eq a3 b3 `mappend` eq a4 b4 `mappend` eq a5 b5 instance ( Equality a , Equality b , Equality c , Equality d , Equality e , Equality f ) => Equality (a , b, c, d, e, f) where eq (a1,a2,a3,a4,a5,a6) (b1,b2,b3,b4,b5,b6) = eq a1 b1 `mappend` eq a2 b2 `mappend` eq a3 b3 `mappend` eq a4 b4 `mappend` eq a5 b5 `mappend` eq a6 b6 instance ( Equality a , Equality b , Equality c , Equality d , Equality e , Equality f , Equality g ) => Equality (a , b, c, d, e, f, g) where eq (a1,a2,a3,a4,a5,a6,a7) (b1,b2,b3,b4,b5,b6,b7) = eq a1 b1 `mappend` eq a2 b2 `mappend` eq a3 b3 `mappend` eq a4 b4 `mappend` eq a5 b5 `mappend` eq a6 b6 `mappend` eq a7 b7 -- | The result of a comparison. This is an opaque type and the monoid instance essentially takes -- AND of two comparisons in a timing safe way. newtype Result = Result { unResult :: Word } instance Monoid Result where mempty = Result 0 mappend a b = Result (unResult a .|. unResult b) {-# INLINE mempty #-} {-# INLINE mappend #-} -- | Checks whether a given equality comparison is successful. isSuccessful :: Result -> Bool {-# INLINE isSuccessful #-} isSuccessful = (==0) . unResult -- | 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 raaz-0.1.1/Raaz/Core/Types/Endian.hs0000644000000000000000000004004713055624226015271 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-} -- | Endian safe types. module Raaz.Core.Types.Endian ( -- * Endianess aware types. -- $endianness$ EndianStore(..), copyFromBytes, copyToBytes -- ** Endian explicit word types. , LE, BE, littleEndian, bigEndian -- ** Helper functions for endian aware storing and loading. , storeAt, storeAtIndex , loadFrom, loadFromIndex ) where import Control.Applicative import Control.DeepSeq ( NFData) import Control.Monad ( liftM ) import Data.Bits import Data.Typeable import Data.Vector.Unboxed ( MVector(..), Vector, Unbox ) import Data.Word import Foreign.Ptr ( castPtr, Ptr ) import Foreign.Storable ( Storable, peek, poke ) import Prelude import qualified Data.Vector.Generic as GV import qualified Data.Vector.Generic.Mutable as GVM import Raaz.Core.Types.Copying import Raaz.Core.Types.Pointer import Raaz.Core.Types.Equality #include "MachDeps.h" -- $endianness$ -- -- Cryptographic primitives often consider their input as an array of -- words of a particular endianness. Endianness is only relevant when -- serialising to (or de-serialising from) their encoding to the -- outside world. Raaz strives to use types to provide an endian -- agnostic interface to all data that is relevant to the outside -- world. -- -- The starting point of an endian agnostic interface is the class -- `EndianStore`. Instances of this class support an endian agnostic -- `load` and `store`. Endian adjusted copying is also provided for -- these types through the helper functions `copyFromBytes` and -- `copyToBytes`. -- -- It is tedious to think about endianness for each new type one might -- encounter. As before, we have a top down approach to defining such -- an interface. To start with, the library exposes endian aware -- variants of `Word32` and `Word64` and functions @littleEndian@ and -- @bigEndian@ for conversions. The `Tuple` type inherits the -- endianness of its element type, i.e for example @Tuple 10 (LE -- Word32)@ when loded (or stored) will load (or store) 10 32-bit -- words assuming that the words are expressed in little endian. Other -- types are then built out of these endian aware types. For example, -- cryptographic type `SHA512` is defined as. -- -- > -- > newtype SHA512 = SHA512 (Tuple 8 (BE Word64)) -- > deriving (Equality, Eq, Storable, EndianStore) -- > -- -- | This class captures types which provides an endian agnostic way -- of loading from and storing to data buffers. Any multi-byte type -- that is meant to be serialised to the outside world should be an -- instance of this class. When defining the `load`, `store`, -- `adjustEndian` member functions, care should be taken to ensure -- proper endian conversion. -- class Storable w => EndianStore w where -- | The action @store ptr w@ stores @w@ at the location pointed by -- @ptr@. Endianness of the type @w@ is taken care of when storing. -- For example, irrespective of the endianness of the machine, -- @store ptr (0x01020304 :: BE Word32)@ will store the bytes -- @0x01@, @0x02@, @0x03@, @0x04@ respectively at locations @ptr@, -- @ptr +1@, @ptr+2@ and @ptr+3@. On the other hand @store ptr -- (0x01020304 :: LE Word32)@ would store @0x04@, @0x03@, @0x02@, -- @0x01@ at the above locations. store :: Ptr w -- ^ the location. -> w -- ^ value to store -> IO () -- | The action @load ptr@ loads the value stored at the @ptr@. Like -- store, it takes care of the endianness of the data type. For -- example, if @ptr@ points to a buffer containing the bytes @0x01@, -- @0x02@, @0x03@, @0x04@, irrespective of the endianness of the -- machine, @load ptr :: IO (BE Word32)@ will load the vale -- @0x01020304@ of type @BE Word32@ and @load ptr :: IO (LE Word32)@ -- will load @0x04030201@ of type @LE Word32@. load :: Ptr w -> IO w -- | The action @adjustEndian ptr n@ adjusts the encoding of bytes -- stored at the location @ptr@ to conform with the endianness of -- the underlying data type. For example, assume that @ptr@ points -- to a buffer containing the bytes @0x01 0x02 0x03 0x04@, and we -- are on a big endian machine, then @adjustEndian (ptr :: Ptr (LE -- Word32)) 1@ will result in @ptr@ pointing to the sequence @0x04 -- 0x03 0x02 0x01@. On the other hand if we were on a little endian -- machine, the sequence should remain the same. In particular, the -- following equalities should hold. -- -- > -- > store ptr w = poke ptr w >> adjustEndian ptr 1 -- > -- -- Similarly the value loaded by @load ptr@ should be same as the -- value returned by @adjustEndian ptr 1 >> peak ptr@, although the -- former does not change the contents stored at @ptr@ where as the -- latter might does modify the contents pointed by @ptr@ if the -- endianness of the machine and the time do not agree. -- -- The action @adjustEndian ptr n >> adjustEndian ptr n @ should be -- equivalent to @return ()@. -- adjustEndian :: Ptr w -- ^ buffer pointers, -> Int -- ^ how many w's are present, -> IO () instance EndianStore Word8 where store = poke load = peek adjustEndian _ _ = return () instance EndianStore w => EndianStore (BYTES w) where store ptr (BYTES w) = store (castPtr ptr) w load = fmap BYTES . load . castPtr adjustEndian = adjustEndian . castToPtrW where castToPtrW :: Ptr (BYTES w) -> Ptr w castToPtrW = castPtr -- | Store the given value at an offset from the crypto pointer. The -- offset is given in type safe units. storeAt :: ( EndianStore w , LengthUnit offset ) => Ptr w -- ^ the pointer -> offset -- ^ the absolute offset in type safe length units. -> w -- ^ value to store -> IO () {-# INLINE storeAt #-} storeAt ptr = store . movePtr ptr -- | Store the given value as the @n@-th element of the array -- pointed by the crypto pointer. storeAtIndex :: EndianStore w => Ptr w -- ^ the pointer to the first element of the -- array -> Int -- ^ the index of the array -> w -- ^ the value to store -> IO () {-# INLINE storeAtIndex #-} storeAtIndex cptr index w = storeAt cptr offset w where offset = toEnum index * sizeOf w -- | Load the @n@-th value of an array pointed by the crypto pointer. loadFromIndex :: EndianStore w => Ptr w -- ^ the pointer to the first element of -- the array -> Int -- ^ the index of the array -> IO w {-# INLINE loadFromIndex #-} loadFromIndex cptr index = load (shiftPtr cptr undefined) where shiftPtr :: Storable w => Ptr w -> w -> Ptr w shiftPtr ptr w = movePtr ptr (toEnum index * sizeOf w) -- | Load from a given offset. The offset is given in type safe units. loadFrom :: ( EndianStore w , LengthUnit offset ) => Ptr w -- ^ the pointer -> offset -- ^ the offset -> IO w {-# INLINE loadFrom #-} loadFrom ptr = load . movePtr ptr -- | For the type @w@, the action @copyFromBytes dest src n@ copies @n@-elements from -- @src@ to @dest@. Copy performed by this combinator accounts for the -- endianness of the data in @dest@ and is therefore /not/ a mere copy -- of @n * sizeOf(w)@ bytes. This action does not modify the @src@ -- pointer in any way. copyFromBytes :: EndianStore w => Dest (Ptr w) -> Src Pointer -> Int -- ^ How many items. -> IO () copyFromBytes dest@(Dest ptr) src n = memcpy (castPtr <$> dest) src (sz dest undefined) >> adjustEndian ptr n where sz :: Storable w => Dest (Ptr w) -> w -> BYTES Int sz _ w = sizeOf w * toEnum n -- | Similar to @copyFromBytes@ but the transfer is done in the other direction. The copy takes -- care of performing the appropriate endian encoding. copyToBytes :: EndianStore w => Dest Pointer -> Src (Ptr w) -> Int -> IO () copyToBytes dest@(Dest dptr) src n = memcpy dest (castPtr <$> src) (sz src undefined) >> adjust src (castPtr dptr) where adjust :: EndianStore w => Src (Ptr w) -> Ptr w -> IO () adjust _ ptr = adjustEndian ptr n sz :: Storable w => Src (Ptr w) -> w -> BYTES Int sz _ w = sizeOf w * toEnum n {- Developers notes: ----------------- 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 { unLE :: w } deriving ( Bounded, Enum, Read, Show , Integral, Num, Real, Eq, Equality, Ord , Bits, Storable, Typeable, NFData ) instance Functor LE where fmap f = LE . f . unLE -- | Big endian version of the word type @w@ newtype BE w = BE { unBE :: w } deriving ( Bounded, Enum, Read, Show , Integral, Num, Real, Eq, Equality, Ord , Bits, Storable, Typeable, NFData ) instance Functor BE where fmap f = BE . f . unBE -- | Convert to the little endian variant. littleEndian :: w -> LE w {-# INLINE littleEndian #-} littleEndian = LE -- | Convert to the big endian variants. bigEndian :: w -> BE w {-# INLINE bigEndian #-} bigEndian = BE ---------------- The foreign function calls ---------------------- foreign import ccall unsafe "raaz/core/endian.h raazSwap32Array" c_Swap32Array :: Ptr Word32 -> Int -> IO () foreign import ccall unsafe "raaz/core/endian.h raazSwap64Array" c_Swap64Array :: Ptr Word64 -> Int -> IO () # if !MIN_VERSION_base(4,7,0) foreign import ccall unsafe "raaz/core/endian.h raazSwap32" byteSwap32 :: Word32 -> Word32 foreign import ccall unsafe "raaz/core/endian.h raazSwap64" byteSwap64 :: Word64 -> Word64 # endif #ifdef WORDS_BIGENDIAN unLEPtr :: Ptr (LE w) -> Ptr w unLEPtr = castPtr instance EndianStore (LE Word32) where load ptr = fmap byteSwap32 <$> peek ptr store ptr = poke ptr . fmap byteSwap32 adjustEndian = c_Swap32Array . unLEPtr instance EndianStore (LE Word64) where load ptr = fmap byteSwap64 <$> peek ptr store ptr = poke ptr . fmap byteSwap64 adjustEndian = c_Swap64Array . unLEPtr instance EndianStore (BE Word32) where load = peek store = poke adjustEndian _ _ = return () instance EndianStore (BE Word64) where load = peek store = poke adjustEndian _ _ = return () # else unBEPtr :: Ptr (BE w) -> Ptr w unBEPtr = castPtr --- We are in a little endian machine. instance EndianStore (BE Word32) where load ptr = fmap byteSwap32 <$> peek ptr store ptr = poke ptr . fmap byteSwap32 adjustEndian = c_Swap32Array . unBEPtr instance EndianStore (BE Word64) where load ptr = fmap byteSwap64 <$> peek ptr store ptr = poke ptr . fmap byteSwap64 adjustEndian = c_Swap64Array . unBEPtr instance EndianStore (LE Word32) where load = peek store = poke adjustEndian _ _ = return () instance EndianStore (LE Word64) where load = peek store = poke adjustEndian _ _ = return () #endif ------------------- 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 raaz-0.1.1/Raaz/Core/Types/Describe.hs0000644000000000000000000000061012750426275015610 0ustar0000000000000000-- | 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 raaz-0.1.1/Raaz/Core/Types/Copying.hs0000644000000000000000000000335213043432667015504 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Types to avoid source destination confusion while copying. module Raaz.Core.Types.Copying ( -- * Copying. -- $copyconvention$ Src(..), Dest(..), source, destination ) where import Foreign.Storable ( Storable ) -- $copyconvention$ -- -- Consider a copy operation that involves copying data between two -- entities of the same type. If the source and target is confused -- this can lead to bugs. The types `Src` and `Dest` helps in avoiding -- this confusion. The convention that we follow is that copy function -- mark its destination and source explicitly at the type level. The -- actual constructors for the type `Src` and `Dest` are not available -- to users of the library. Instead they use the smart constructors -- `source` and `destination` when passing arguments to these -- functions. -- -- The developers of the raaz library do have access to the -- constructors. However, it is unlikely one would need it. Since both -- `Src` and `Dest` derive the underlying `Storable` instance, one can -- mark `Src` and `Dest` in calls to `FFI` functions as well. -- | The source of a copy operation. newtype Src a = Src { unSrc :: a } deriving Storable -- | smart constructor for source source :: a -> Src a source = Src instance Functor Src where fmap f = Src . f . unSrc -- | The destination of a copy operation. -- -- Note to Developers of Raaz: Since the `Dest` type inherits the -- Storable instance of the base type, one can use this type in -- foreign functions. newtype Dest a = Dest { unDest :: a } deriving Storable -- | smart constructor for destionation. destination :: a -> Dest a destination = Dest instance Functor Dest where fmap f = Dest . f . unDest raaz-0.1.1/Raaz/Hash/Internal/HMAC.hs0000644000000000000000000001751613055622535015254 0ustar0000000000000000-- |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 Data.Word import Foreign.Ptr ( castPtr ) import Foreign.Storable ( Storable(..) ) import Prelude hiding (length, replicate) import System.IO import System.IO.Unsafe (unsafePerformIO) import Raaz.Core hiding (alignment) import Raaz.Core.Parse.Applicative import Raaz.Core.Transfer import Raaz.Random 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 :: Word8) 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 -- The HMACKey is just stored as a binary data. instance (Hash h, Recommendation h) => EndianStore (HMACKey h) where store = poke load = peek adjustEndian _ _ = return () instance (Hash h, Recommendation h) => Random (HMACKey h) where random = unsafeStorableRandom instance (Hash h, Recommendation 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 type instance Key (HMAC h) = HMACKey h -- | Compute the hash of a pure byte source like, `B.ByteString`. hmac :: ( Hash h, Recommendation h, PureByteSource src ) => 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' imp@(SomeHashI hI) key src = insecurely $ do -- Hash the first block for the inner hash initialise () allocate $ \ 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 $ \ ptr -> do liftIO $ unsafeCopyToPointer outerFirstBlock ptr compress hI ptr 1 -- Finish it with hashing the hash computed above HMAC <$> completeHashing hI (toByteString innerHash) where allocate = liftPointerAction $ allocBufferFor imp $ 1 `asTypeOf` (theBlock key) innerFirstBlock = B.map (xor 0x36) $ hmacAdjustKey key outerFirstBlock = B.map (xor 0x5c) $ hmacAdjustKey key theBlock :: Key (HMAC h) -> BLOCKS h theBlock _ = toEnum 1 raaz-0.1.1/Raaz/Hash/Sha/Util.hs0000644000000000000000000001074713042177016014412 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} module Raaz.Hash.Sha.Util ( shaImplementation -- ** Writing message lengths. -- $lengthwrites$ , length64Write , length128Write , Compressor ) where import Data.Monoid ( (<>) ) import Data.Word import Foreign.Ptr ( Ptr ) import Foreign.Storable ( Storable ) import Raaz.Core import Raaz.Core.Transfer import Raaz.Hash.Internal -- | The utilities in this module can be used on primitives which -- satisfies the following constraint. type IsSha h = (Primitive h, Storable h, Memory (HashMemory h)) -- | All actions here are in the following monad type ShaMonad h = MT (HashMemory h) -- | The Writes used in this module. type ShaWrite h = WriteM (ShaMonad h) -- -- The message in the sha1 family of hashes pads the message, the last -- few bytes of which are used to store the message length. Hashes -- like sha1, sha256 etc writes the message lengths in 64-bits while -- sha512 uses lengths in 128 bits. The generic writes `length64Write` -- and `length128Write` are write actions that support this. -- | Type that captures length writes. type LengthWrite h = BITS Word64 -> ShaWrite h -- | The length encoding that uses 64-bits. length64Write :: LengthWrite h length64Write (BITS w) = write $ bigEndian w -- | The length encoding that uses 128-bits. length128Write :: LengthWrite h length128Write w = writeStorable (0 :: Word64) <> length64Write w -- | The type alias for the raw compressor function. The compressor function -- does not need to know the length of the message so far and hence -- this is not supposed to update lengths. type Compressor h = Pointer -- ^ The buffer to compress -> Int -- ^ The number of blocks to compress -> Ptr h -- ^ The cell memory containing the hash -> IO () -- | Action on a Buffer type ShaBufferAction bufSize h = Pointer -- ^ The data buffer -> bufSize -- ^ Total data present -> ShaMonad h () -- | Lifts the raw compressor to a buffer action. This function does not update -- the lengths. liftCompressor :: IsSha h => Compressor h -> ShaBufferAction (BLOCKS h) h liftCompressor comp ptr = onSubMemory hashCell . withCellPointer . comp ptr . fromEnum -- | The combinator `shaBlocks` on an input compressor @comp@ gives a buffer action -- that process blocks of data. shaBlocks :: Primitive h => ShaBufferAction (BLOCKS h) h -- ^ the compressor function -> ShaBufferAction (BLOCKS h) h shaBlocks comp ptr nblocks = comp ptr nblocks >> updateLength nblocks -- | The combinator `shaFinal` on an input compressor @comp@ gives -- buffer action for the final chunk of data. shaFinal :: (Primitive h, Storable h) => ShaBufferAction (BLOCKS h) h -- ^ the raw compressor -> LengthWrite h -- ^ the length writer -> ShaBufferAction (BYTES Int) h shaFinal comp lenW ptr msgLen = do updateLength msgLen totalBits <- extractLength let pad = shaPad undefined msgLen $ lenW totalBits blocks = atMost $ bytesToWrite pad in unsafeWrite pad ptr >> comp ptr blocks -- | Padding is message followed by a single bit 1 and a glue of zeros -- followed by the length so that the message is aligned to the block boundary. shaPad :: IsSha h => h -> BYTES Int -- Message length -> ShaWrite h -> ShaWrite h shaPad h msgLen = glueWrites 0 boundary hdr where skipMessage = skipWrite msgLen oneBit = writeStorable (0x80 :: Word8) hdr = skipMessage <> oneBit boundary = blocksOf 1 h -- | Creates an implementation for a sha hash given the compressor and -- the length writer. shaImplementation :: IsSha h => String -- ^ Name -> String -- ^ Description -> Compressor h -> LengthWrite h -> HashI h (HashMemory h) shaImplementation nam des comp lenW = HashI { hashIName = nam , hashIDescription = des , compress = shaBlocks shaComp , compressFinal = shaFinal shaComp lenW , compressStartAlignment = wordAlignment } where shaComp = liftCompressor comp {-# INLINE shaImplementation #-} raaz-0.1.1/Raaz/Hash/Sha1/Internal.hs0000644000000000000000000000323313006426545015326 0ustar0000000000000000{-# 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) 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 raaz-0.1.1/Raaz/Hash/Sha1/Recommendation.hs0000644000000000000000000000074412750426275016527 0ustar0000000000000000-- | 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 raaz-0.1.1/Raaz/Hash/Sha256/Recommendation.hs0000644000000000000000000000075612750426275016706 0ustar0000000000000000-- | 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 raaz-0.1.1/Raaz/Hash/Sha256/Internal.hs0000644000000000000000000000321213006426545015477 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# 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 raaz-0.1.1/Raaz/Hash/Sha224/Recommendation.hs0000644000000000000000000000075612750426275016701 0ustar0000000000000000-- | 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 raaz-0.1.1/Raaz/Hash/Sha224/Internal.hs0000644000000000000000000000257713006426545015507 0ustar0000000000000000{-| 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 #-} 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 raaz-0.1.1/Raaz/Hash/Sha384/Recommendation.hs0000644000000000000000000000075612750426275016710 0ustar0000000000000000-- | 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 raaz-0.1.1/Raaz/Hash/Sha384/Internal.hs0000644000000000000000000000205612750426275015513 0ustar0000000000000000{-# 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 raaz-0.1.1/Raaz/Hash/Sha512/Recommendation.hs0000644000000000000000000000075612750426275016701 0ustar0000000000000000-- | 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 raaz-0.1.1/Raaz/Hash/Sha512/Internal.hs0000644000000000000000000000316513006426545015501 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# 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 raaz-0.1.1/Raaz/Cipher/AES/Internal.hs0000644000000000000000000001300313043432667015470 0ustar0000000000000000{-# 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, Ptr ) import Foreign.Storable (Storable, poke) import GHC.TypeLits import Raaz.Core import Raaz.Random 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 where random = unsafeStorableRandom instance Random KEY192 where random = unsafeStorableRandom instance Random KEY256 where random = unsafeStorableRandom -- | Expects in base 16 instance IsString KEY128 where fromString = fromBase16 -- | 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 where random = unsafeStorableRandom -- | 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. type instance Key (AES 128 'CBC) = (KEY128,IV) instance Describable (AES 128 'CBC) where name _ = "aes-128-cbc" description _ = "The AES cipher in CBC mode with 128-bit key" instance Cipher (AES 128 'CBC) ----------------- AES 192 CBC -------------------------------- -- | 128-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. type instance Key (AES 192 'CBC) = (KEY192,IV) instance Describable (AES 192 'CBC) where name _ = "aes-192-cbc" description _ = "The AES cipher in CBC mode with 192-bit key" instance Cipher (AES 192 'CBC) ------------------- AES 256 CBC ----------------------------- -- | 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. type instance Key (AES 256 'CBC) = (KEY256,IV) instance Describable (AES 256 'CBC) where name _ = "aes-256-cbc" description _ = "The AES cipher in CBC mode with 256-bit key" instance Cipher (AES 256 'CBC) ------------------- 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 = withCellPointer $ pokeAndExpand k (c_expand 4) instance Initialisable (MemoryCell EKEY192) KEY192 where initialise k = withCellPointer $ pokeAndExpand k (c_expand 6) instance Initialisable (MemoryCell EKEY256) KEY256 where initialise k = withCellPointer $ pokeAndExpand k (c_expand 8) foreign import ccall unsafe "raaz/cipher/aes/common.h raazAESExpand" c_expand :: Int -> Ptr ekey -> IO () -- | Poke a key and expand it with the given routine. pokeAndExpand :: Storable k => k -- ^ key to poke -> (Ptr ekey -> IO ()) -- ^ expansion algorithm -> Ptr ekey -- ^ buffer pointer. -> IO () pokeAndExpand k expander ptr = poke (castPtr ptr) k >> expander ptr raaz-0.1.1/Raaz/Cipher/AES/Recommendation.hs0000644000000000000000000000147613006426545016670 0ustar0000000000000000-- | 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 raaz-0.1.1/Raaz/Cipher/ChaCha20/Internal.hs0000644000000000000000000000457713043432667016351 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} module Raaz.Cipher.ChaCha20.Internal ( ChaCha20(..), WORD, Counter(..), IV(..), KEY(..), ChaCha20Mem(..) ) where import Control.Applicative import Data.Word import Data.String import Foreign.Storable import Prelude import Raaz.Core import Raaz.Cipher.Internal -- | The chacha20 stream cipher. -- | The word type type WORD = LE Word32 -- | The IV for the chacha20 newtype IV = IV (Tuple 3 (LE Word32)) deriving (Storable, EndianStore) instance Encodable IV instance Show IV where show = showBase16 instance IsString IV where fromString = fromBase16 -- | The counter type for chacha20 newtype Counter = Counter (LE Word32) deriving (Num, Storable, EndianStore, Show, Eq, Ord) -- | The key type. newtype KEY = ChaCha20Key (Tuple 8 WORD) deriving (Storable, EndianStore) instance Encodable KEY instance Show KEY where show = showBase16 instance IsString KEY where fromString = fromBase16 data ChaCha20 = ChaCha20 instance Primitive ChaCha20 where blockSize _ = BYTES 64 type Implementation ChaCha20 = SomeCipherI ChaCha20 -- | The key for ChaCha20. type instance Key ChaCha20 = (KEY, IV, Counter) instance Describable ChaCha20 where name _ = "chacha20" description _ = "The ChaCha20 cipher" instance Cipher ChaCha20 instance StreamCipher ChaCha20 ---------- Memory for ChaCha20 implementations ------------------ -- | chacha20 memory data ChaCha20Mem = ChaCha20Mem { keyCell :: MemoryCell KEY , ivCell :: MemoryCell IV , counterCell :: MemoryCell Counter } instance Memory ChaCha20Mem where memoryAlloc = ChaCha20Mem <$> memoryAlloc <*> memoryAlloc <*> memoryAlloc unsafeToPointer = unsafeToPointer . keyCell instance Initialisable ChaCha20Mem (KEY, IV, Counter) where initialise (k,iv,ctr) = do onSubMemory keyCell $ initialise k onSubMemory ivCell $ initialise iv onSubMemory counterCell $ initialise ctr instance Initialisable ChaCha20Mem (KEY, IV) where initialise (k, iv) = initialise (k, iv, 0 :: Counter) raaz-0.1.1/Raaz/Cipher/ChaCha20/Recommendation.hs0000644000000000000000000000547613055622555017540 0ustar0000000000000000-- | This sets up the recommended implementation of chacha20 cipher. {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-} -- -- The orphan instance declaration separates the implementation and -- setting the recommended instances. Therefore, we ignore the warning. -- module Raaz.Cipher.ChaCha20.Recommendation ( chacha20Random, RandomBuf, getBufferPointer, randomBufferSize ) where import Control.Applicative import Prelude import Raaz.Core import Raaz.Cipher.ChaCha20.Internal #ifdef HAVE_VECTOR_256 import Raaz.Cipher.ChaCha20.Implementation.Vector256 #else import Raaz.Cipher.ChaCha20.Implementation.CPortable #endif ------------ Setting the recommended implementation ------------------- instance Recommendation ChaCha20 where recommended _ = implementation --------------- Some information used by Raaz/Random/ChaCha20PRG.hs ------------- -- | The chacha stream cipher is also used as the prg for generating -- random bytes. Such a prg needs to keep an auxilary buffer type so -- that one can generate random bytes not just of block size but -- smaller. This memory type is essentially for maintaining such a -- buffer. newtype RandomBuf = RandomBuf { unBuf :: Pointer } instance Memory RandomBuf where memoryAlloc = RandomBuf <$> pointerAlloc sz where sz = atLeastAligned randomBufferSize randomBufferAlignment unsafeToPointer = unBuf -- | Get the actual location where the data is to be stored. Ensures -- that the pointer is aligned to the @randomBufferAlignment@ -- restriction. getBufferPointer :: MT RandomBuf Pointer getBufferPointer = actualPtr <$> getMemory where actualPtr = flip alignPtr randomBufferAlignment . unBuf --------------------- DANGEROUS CODE -------------------------------- -- Things to take care in this module -- ================================== -- -- 1. ENSURE randomBufferSize IS THE MAXIMUM FOR ALL IMPLEMENTATIONS of -- chacha20 random stream. OTHERWISE BUFFER OVERFLOW. -- -- 2. Ensure that the alignment requirement is the maximum so that any -- implementation can use the same memory. -- | The size of the buffer in blocks of ChaCha20. While the -- implementations should handle any multiple of blocks, often -- implementations naturally handle some multiple of blocks, for -- example the Vector256 implementation handles 2-chacha blocks. Set -- this quantity to the maximum supported by all implementations. randomBufferSize :: BLOCKS ChaCha20 randomBufferSize = 4 `blocksOf` ChaCha20 -- | Implementations are also designed to work with a specific -- alignment boundary. Unaligned access can slow down the primitives -- quite a bit. Set this to the maximum of alignment supported by all -- implementations randomBufferAlignment :: Alignment randomBufferAlignment = 32 -- For 256-bit vector instructions. raaz-0.1.1/Raaz/Random/ChaCha20PRG.hs0000644000000000000000000001120013055622535015127 0ustar0000000000000000-- | The module exposes the ChaCha20 based PRG. {-# LANGUAGE FlexibleContexts #-} module Raaz.Random.ChaCha20PRG ( reseedMT, fillRandomBytesMT, RandomState(..) ) where import Control.Applicative import Control.Monad import Foreign.Ptr (Ptr, castPtr) import Prelude import Raaz.Core import Raaz.Cipher.ChaCha20.Internal import Raaz.Cipher.ChaCha20.Recommendation import Raaz.Entropy -- | The maximum value of counter before reseeding from entropy -- source. Currently set to 1024 * 1024 * 1024. Which will generate -- 64GB before reseeding. -- -- The counter is a 32-bit quantity. Which means that one can generate -- 2^32 blocks of data before the counter roles over and starts -- repeating. We have choosen a conservative 2^30 blocks here. maxCounterVal :: Counter maxCounterVal = 1024 * 1024 * 1024 -- | Memory for strong the internal memory state. data RandomState = RandomState { chacha20State :: ChaCha20Mem , auxBuffer :: RandomBuf , remainingBytes :: MemoryCell (BYTES Int) } -------------------------- Some helper functions on random state ------------------- -- | Run an action on the auxilary buffer. withAuxBuffer :: (Ptr something -> MT RandomState a) -> MT RandomState a withAuxBuffer action = onSubMemory auxBuffer getBufferPointer >>= action . castPtr -- | Get the number of bytes in the buffer. getRemainingBytes :: MT RandomState (BYTES Int) getRemainingBytes = onSubMemory remainingBytes extract -- | Set the number of remaining bytes. setRemainingBytes :: BYTES Int -> MT RandomState () setRemainingBytes = onSubMemory remainingBytes . initialise instance Memory RandomState where memoryAlloc = RandomState <$> memoryAlloc <*> memoryAlloc <*> memoryAlloc unsafeToPointer = unsafeToPointer . chacha20State -- | This fills in the random block with some new randomness newSample :: MT RandomState () newSample = do setRemainingBytes $ inBytes randomBufferSize onSubMemory chacha20State seedIfReq withAuxBuffer $ onSubMemory chacha20State . flip chacha20Random randomBufferSize -- | See the PRG from system entropy. seed :: MT ChaCha20Mem () seed = do onSubMemory counterCell $ initialise (0 :: Counter) onSubMemory keyCell getCellPointer >>= void . getEntropy keySize . castPtr onSubMemory ivCell getCellPointer >>= void . getEntropy ivSize . castPtr where keySize = sizeOf (undefined :: KEY) ivSize = sizeOf (undefined :: IV) -- | Seed if we have already generated maxCounterVal blocks of random -- bytes. seedIfReq :: MT ChaCha20Mem () seedIfReq = do c <- onSubMemory counterCell extract when (c > maxCounterVal) $ seed --------------------------- DANGEROUS CODE --------------------------------------- -- remaining bytes, this can produce a lot of nonsense. -- | Reseed the prg. reseedMT :: MT RandomState () reseedMT = onSubMemory chacha20State seed >> newSample -- NONTRIVIALITY: Picking up the newSample is important when we first -- reseed. -- | The function to generate random bytes. Fills from existing bytes -- and continues if not enough bytes are obtained. fillRandomBytesMT :: LengthUnit l => l -> Pointer -> MT RandomState () fillRandomBytesMT l = go (inBytes l) where go m ptr | m <= 0 = return () -- Nothing to do | otherwise = do mGot <- fillExistingBytes m ptr -- Fill some go (m - mGot) -- bytes yet to get. $ movePtr ptr mGot -- Shift by what is already got. -- | Fill from already existing bytes. Returns the number of bytes -- filled. Let remaining bytes be r. Then fillExistingBytes will fill -- min(r,m) bytes into the buffer, and return the number of bytes -- filled. fillExistingBytes :: BYTES Int -> Pointer -> MT RandomState (BYTES Int) fillExistingBytes m ptr = do r <- getRemainingBytes withAuxBuffer $ \ sptr -> do if r <= m then do memcpy (destination ptr) (source sptr) r -- read the entire stuff. newSample return r else let leftOver = r - m -- Bytes leftover tailPtr = movePtr sptr leftOver -- We read the last m bytes. in do memcpy (destination ptr) (source tailPtr) m setRemainingBytes leftOver return m -- The function fillExisting bytes reads from the end. See the picture -- below -- -- -- --------------------------------------------------------------------- -- | (r - m) remaining bytes | m bytes consumed | -- --------------------------------------------------------------------- -- raaz-0.1.1/entropy/arc4random/Raaz/Entropy.hs0000644000000000000000000000125713043432667017274 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} module Raaz.Entropy( getEntropy ) where import Control.Monad.IO.Class(MonadIO, liftIO) import Raaz.Core.Types -- | The getrandom system call. foreign import ccall unsafe "arc4random" c_arc4random :: Pointer -- Message -> BYTES Int -- number of bytes -> IO (BYTES Int) -- | Get random bytes from using the @getrandom@ system call on -- linux. This is only used to seed the PRG and not intended for call -- by others. getEntropy :: (MonadIO m, LengthUnit l) => l -> Pointer -> m (BYTES Int) getEntropy l ptr = liftIO $ c_arc4random ptr lenBytes >> return lenBytes where lenBytes = inBytes l raaz-0.1.1/entropy/urandom/Raaz/Entropy.hs0000644000000000000000000000070713043432667016706 0ustar0000000000000000module Raaz.Entropy( getEntropy ) where import Control.Monad.IO.Class( MonadIO, liftIO) import System.IO import Raaz.Core -- | Get random bytes from the system. Do not over use this function -- as it is meant to be used by a PRG. This function reads bytes from -- '/dev/urandom'. getEntropy :: (MonadIO m, LengthUnit l) => l -> Pointer -> m (BYTES Int) getEntropy l ptr = liftIO $ withBinaryFile "/dev/urandom" ReadMode $ \ hand -> hFillBuf hand ptr l raaz-0.1.1/cbits/raaz/core/endian.c0000644000000000000000000000525413006426545015242 0ustar0000000000000000#include #ifdef __RAAZ_REQUIRE_PORTABLE_ENDIAN__ /* We were not able to detect the optimised platform specific versions * of the low level endian functions. We now proceed to define a * portable variant so that the extern declarations is satisfied. */ /* * These are declared as macros because they will work for both * 32-bit as well as 64-bit cases. */ # define MASK(i) (0xFFULL << (8*(i))) /* mask to select the ith byte */ # define SEL(a,i) ((a) & MASK(i)) /* select the ith byte */ # define MOVL(a,i) ((a) << (8*(i))) /* shift the bytes i positions to the left */ # define MOVR(a,i) ((a) >> (8*(i))) /* shift the bytes i positions to the right */ # define SWAP(a,i,j) (MOVL(SEL(a,i),(j-i)) | MOVR(SEL(a,j), (j - i))) /* This function swaps the ith and jth bytes and sets other bytes to 0 */ uint32_t raaz_bswap32(uint32_t a){ return (SWAP(a,0,3) | SWAP(a,1,2)); } uint64_t raaz_bswap64(uint64_t a){ return (SWAP(a,0,7) | SWAP(a,1,6) | SWAP(a,2,5) | SWAP(a,3,4)); } # define TO32(x) ((uint32_t)(x)) # define TO64(x) ((uint64_t)(x)) # define B32(ptr,i) (TO32(ptr[i])) # define B64(ptr,i) (TO64(ptr[i])) /* Make a 32-bit quantity out of the 4 bytes given in MSB first order */ # define MK32(a,b,c,d) ( (a) << 24 | (b) << 16 | (c) << 8 | (d) ) /* Similar to MK32 but for 64-bit quantities */ # define MK64(a,b,c,d,e,f,g,h) \ ((a) << 56 | (b) << 48 | (c) << 40 | (d) << 32 | (e) << 24 | (f) << 16 | (g) << 8 | (h)) uint32_t raaz_tobe32(uint32_t x) { uint8_t *ptr = (uint8_t *) &x; return MK32(B32(ptr,0), B32(ptr,1), B32(ptr,2), B32(ptr,3)); } uint32_t raaz_tole32(uint32_t x) { uint8_t *ptr = (uint8_t *) &x; return MK32(B32(ptr,3), B32(ptr,2), B32(ptr,1), B32(ptr,0)); } uint64_t raaz_tobe64(uint64_t x) { uint8_t *ptr = (uint8_t *) &x; return MK64(B64(ptr,0), B64(ptr,1), B64(ptr,2), B64(ptr,3), B64(ptr,4), B64(ptr,5), B64(ptr,6), B64(ptr,7)); } uint64_t raaz_tole64(uint64_t x) { uint8_t *ptr = (uint8_t *) &x; return MK64(B64(ptr,7), B64(ptr,6), B64(ptr,5), B64(ptr,4), B64(ptr,3), B64(ptr,2), B64(ptr,1), B64(ptr,0)); } #endif /* Finally we define the functions that are called by Haskell as FFI * routines for their endian store instances. These should not be * declared static inline. */ uint32_t raazSwap32(uint32_t a){ return raaz_bswap32(a);} uint64_t raazSwap64(uint64_t a){ return raaz_bswap64(a);} void raazSwap32Array(uint32_t *ptr, int n) { for(;n > 0; ++ptr, --n){*ptr = raaz_bswap32(*ptr);} } void raazSwap64Array(uint64_t *ptr, int n) { for(;n > 0; ++ptr, --n){*ptr = raaz_bswap64(*ptr);} } raaz-0.1.1/cbits/raaz/hash/sha1/portable.c0000644000000000000000000002020513006426545016434 0ustar0000000000000000/* 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))) */ # define LOAD(i) raaz_tobe32((*mesg)[i]) w0 = LOAD(0); w1 = LOAD(1); w2 = LOAD(2); w3 = LOAD(3); w4 = LOAD(4); w5 = LOAD(5); w6 = LOAD(6); w7 = LOAD(7); w8 = LOAD(8); w9 = LOAD(9); w10 = LOAD(10); w11 = LOAD(11); w12 = LOAD(12); w13 = LOAD(13); w14 = LOAD(14); w15 = LOAD(15); #undef LOAD /* 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; } raaz-0.1.1/cbits/raaz/hash/sha256/portable.c0000644000000000000000000002272213006426545016616 0ustar0000000000000000/* 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))) */ # define LOAD(i) raaz_tobe32((*mesg)[i]) w0 = LOAD(0); w1 = LOAD(1); w2 = LOAD(2); w3 = LOAD(3); w4 = LOAD(4); w5 = LOAD(5); w6 = LOAD(6); w7 = LOAD(7); w8 = LOAD(8); w9 = LOAD(9); w10 = LOAD(10); w11 = LOAD(11); w12 = LOAD(12); w13 = LOAD(13); w14 = LOAD(14); w15 = LOAD(15); # undef LOAD /* 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; } raaz-0.1.1/cbits/raaz/hash/sha512/portable.c0000644000000000000000000002562513006426545016616 0ustar0000000000000000/* 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))) */ #define LOAD(i) raaz_tobe64((*mesg)[i]) w0 = LOAD(0); w1 = LOAD(1); w2 = LOAD(2); w3 = LOAD(3); w4 = LOAD(4); w5 = LOAD(5); w6 = LOAD(6); w7 = LOAD(7); w8 = LOAD(8); w9 = LOAD(9); w10 = LOAD(10); w11 = LOAD(11); w12 = LOAD(12); w13 = LOAD(13); w14 = LOAD(14); w15 = LOAD(15); #undef LOAD /* 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; } raaz-0.1.1/cbits/raaz/cipher/aes/common.c0000644000000000000000000001116512750426275016371 0ustar0000000000000000#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 }; raaz-0.1.1/cbits/raaz/cipher/aes/cportable.c0000644000000000000000000001544712750426275017063 0ustar0000000000000000#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; } raaz-0.1.1/cbits/raaz/cipher/chacha20/cportable.c0000644000000000000000000000604513055622555017654 0ustar0000000000000000#include "common.h" /* The main chacha20 block transform for a complete block of data. * * Maximum bytes that should be encoded is 2^32 * 64 = 256GB. The * counter repeats after that. * */ /* Warnings all macros are unprotected use with care */ # define R(x,i) ((x << i) | (x >> (32 - i))) # define QROUND(a,b,c,d) \ { \ a += b; d ^= a; d = R(d,16); \ c += d; b ^= c; b = R(b,12); \ a += b; d ^= a; d = R(d,8); \ c += d; b ^= c; b = R(b,7); \ } \ # define ROUND \ { \ QROUND(x0, x4, x8, x12); \ QROUND(x1, x5, x9, x13); \ QROUND(x2, x6, x10, x14); \ QROUND(x3, x7, x11, x15); \ QROUND(x0, x5, x10, x15); \ QROUND(x1, x6, x11, x12); \ QROUND(x2, x7, x8, x13); \ QROUND(x3, x4, x9, x14); \ } # define XOR(i,a) (*msg)[i] ^= raaz_tole32(a) # define EMIT(i,a) (*msg)[i] = a /* Some function for debugging. # define PR(i) printf("%8x ", x##i) # define PRM(i) printf("%8x ", (*msg)[i]) # define NEWLINE printf("\n") # define PRINTSTATE \ { \ PR(0); PR(1); PR(2); PR(3); NEWLINE; \ PR(4); PR(5); PR(6); PR(7); NEWLINE; \ PR(8); PR(9); PR(10); PR(11); NEWLINE; \ PR(12); PR(13); PR(14); PR(15); NEWLINE; \ } # define PRINTMESG \ { \ PRM(0); PRM(1); PRM(2); PRM(3); NEWLINE; \ PRM(4); PRM(5); PRM(6); PRM(7); NEWLINE; \ PRM(8); PRM(9); PRM(10); PRM(11); NEWLINE; \ PRM(12); PRM(13); PRM(14); PRM(15); NEWLINE; \ } */ # ifdef __GNUC__ typedef Block MyBlock __attribute__ ((aligned (32))); void raazChaCha20Block(MyBlock * msg, int nblocks, const Key key, const IV iv, Counter *ctr) # else void raazChaCha20Block(Block * msg, int nblocks, const Key key, const IV iv, Counter *ctr) #endif { register Word x0, x1, x2, x3; register Word x4, x5, x6, x7; register Word x8, x9, x10, x11; register Word x12, x13, x14, x15; register Word valCtr; /* value of the ctr */ valCtr = *ctr; while( nblocks > 0){ x0 = C0 ; x1 = C1 ; x2 = C2 ; x3 = C3 ; x4 = key[0] ; x5 = key[1] ; x6 = key[2] ; x7 = key[3] ; x8 = key[4] ; x9 = key[5] ; x10 = key[6] ; x11 = key[7] ; x12 = valCtr ; x13 = iv[0] ; x14 = iv[1] ; x15 = iv[2] ; ROUND; /* 0,1 */ ROUND; /* 2,3 */ ROUND; /* 4,5 */ ROUND; /* 6,7 */ ROUND; /* 8,9 */ ROUND; /* 10,11 */ ROUND; /* 12,13 */ ROUND; /* 14,15 */ ROUND; /* 16,17 */ ROUND; /* 18,19 */ x0 += C0 ; x1 += C1 ; x2 += C2 ; x3 += C3 ; x4 += key[0] ; x5 += key[1] ; x6 += key[2] ; x7 += key[3] ; x8 += key[4] ; x9 += key[5] ; x10 += key[6] ; x11 += key[7] ; x12 += valCtr ; x13 += iv[0] ; x14 += iv[1] ; x15 += iv[2] ; XOR(0,x0) ; XOR(1, x1) ; XOR(2, x2) ; XOR(3, x3) ; XOR(4,x4) ; XOR(5, x5) ; XOR(6, x6) ; XOR(7, x7) ; XOR(8,x8) ; XOR(9, x9) ; XOR(10, x10) ; XOR(11, x11) ; XOR(12,x12) ; XOR(13,x13); XOR(14, x14) ; XOR(15, x15) ; ++ valCtr; --nblocks; ++msg; /* move to the next block */ } *ctr = valCtr; /* increment counter */ return; } raaz-0.1.1/cbits/raaz/cipher/chacha20/vector128.c0000644000000000000000000000767313046245404017440 0ustar0000000000000000#include "common.h" # define R(x,i) ( (x << ((Vec){i,i,i,i})) | (x >> ((Vec){32 - i, 32 - i, 32 - i, 32 - i}))) # define QROUND(a,b,c,d) \ { \ a += b; d ^= a; d = R(d,16); \ c += d; b ^= c; b = R(b,12); \ a += b; d ^= a; d = R(d,8); \ c += d; b ^= c; b = R(b,7); \ } \ /* r0 = x0 x1 x2 x3 r1 = x4 x5 x6 x7 r2 = x8 x9 x10 x11 r3 = x12 x13 x14 x15 QROUND(r0, r1, r2, r3) : Handles row o d0 = x0 x1 x2 x3 d1 = x5 x6 x7 x4 d2 = x10 x11 x8 x9 d3 = x15 x12 x13 x14 */ # ifdef __clang__ # define SIG 1 , 2 , 3 , 0 # define SIG2 2 , 3 , 0 , 1 # define SIG3 3 , 0 , 1 , 2 # define ISIG SIG3 # define ISIG2 SIG2 # define ISIG3 SIG # define TODIAG \ { \ B = __builtin_shufflevector(B, B, SIG ); \ C = __builtin_shufflevector(C, C, SIG2 ); \ D = __builtin_shufflevector(D, D, SIG3 ); \ } # define TOROW \ { \ B = __builtin_shufflevector(B, B, ISIG ); \ C = __builtin_shufflevector(C, C, ISIG2 ); \ D = __builtin_shufflevector(D, D, ISIG3 ); \ } # else # define SIG ((Vec){ 1 , 2 , 3 , 0 }) # define SIG2 ((Vec){ 2 , 3 , 0 , 1 }) # define SIG3 ((Vec){ 3 , 0 , 1 , 2 }) # define ISIG ((Vec){ 3 , 0 , 1 , 2 }) # define ISIG2 ((Vec){ 2 , 3 , 0 ,1 }) # define ISIG3 ((Vec){ 1 , 2 , 3 , 0 }) # define TODIAG \ { \ B = __builtin_shuffle ( B, SIG ); \ C = __builtin_shuffle ( C, SIG2 ); \ D = __builtin_shuffle ( D, SIG3 ); \ } # define TOROW \ { \ B = __builtin_shuffle(B, ISIG ); \ C = __builtin_shuffle(C, ISIG2 ); \ D = __builtin_shuffle(D, ISIG3 ); \ } #endif # define ROUND \ { QROUND(A,B,C,D); TODIAG; QROUND(A,B,C,D); TOROW; } # define XORA(i) (*msg)[i] ^= raaz_tole32( A[i] ) # define XORB(i) (*msg)[i] ^= raaz_tole32( B[i-4] ) # define XORC(i) (*msg)[i] ^= raaz_tole32( C[i-8] ) # define XORD(i) (*msg)[i] ^= raaz_tole32( D[i-12] ) # define ChaChaConstantRow ((Vec){ C0 , C1 , C2 , C3 }) # if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ # define INP(i) (((Vec *)msg)[i]) # define WR(i,R) { MSG = INP(i); MSG ^= R; INP(i) = MSG; } # define WRITE { WR(0,A); WR(1,B); WR(2,C); WR(3,D); } # else # define XORA(i) (*msg)[i] ^= raaz_tole32( A[i] ) # define XORB(i) (*msg)[i] ^= raaz_tole32( B[i-4] ) # define XORC(i) (*msg)[i] ^= raaz_tole32( C[i-8] ) # define XORD(i) (*msg)[i] ^= raaz_tole32( D[i-12] ) # define WRITE \ { XORA(0) ; XORA(1) ; XORA(2) ; XORA(3); \ XORB(4) ; XORB(5) ; XORB(6) ; XORB(7); \ XORC(8) ; XORC(9) ; XORC(10) ; XORC(11); \ XORD(12) ; XORD(13) ; XORD(14) ; XORD(15); \ } # endif /* Byte order */ /* One should ensure that msg is aligned to 16 bytes. */ static inline void chacha20vec128(Block *msg, int nblocks, const Key key, const IV iv, Counter *ctr) { register Vec A , B, C, D; register Vec M1, M2, M3; register Vec MSG; /* TODO: Optimise with vector load (take care of alignments) */ M1 = (Vec){ key[0] , key[1] , key[2] , key[3] }; M2 = (Vec){ key[4] , key[5] , key[6] , key[7] }; M3 = (Vec){ *(ctr) , iv[0] , iv[1] , iv[2] }; *ctr += nblocks; for(; nblocks > 0; -- nblocks, ++msg) { /* Initialise the state; Except for the counter everything is the same */ A = ChaChaConstantRow; B = M1; C = M2; D = M3; ROUND; /* 0,1 */ ROUND; /* 2,3 */ ROUND; /* 4,5 */ ROUND; /* 6,7 */ ROUND; /* 8,9 */ ROUND; /* 10,11 */ ROUND; /* 12,13 */ ROUND; /* 14,15 */ ROUND; /* 16,17 */ ROUND; /* 18,19 */ A += ChaChaConstantRow; B += M1; C += M2; D += M3; /* TODO: Optimise with vector load (take care of * alignments) */ WRITE; ++M3[0]; /* increment counter */ } return; } void raazChaCha20BlockVector(Block *msg, int nblocks, const Key key, const IV iv, Counter *ctr) { chacha20vec128(msg, nblocks, key, iv, ctr); } raaz-0.1.1/cbits/raaz/cipher/chacha20/vector256.c0000644000000000000000000001164713043432667017444 0ustar0000000000000000#include "common.h" # define R(x,i) ( \ (x << (Vec2){i,i,i,i,i,i,i,i}) | \ (x >> (Vec2){32 -i, 32 - i, 32 -i, 32 -i, 32 -i, 32 - i, 32 - i , 32 - i }) \ ) /* # define R(x,i) ( (x << i) | (x >> (32 - i))) */ # define QROUND(a,b,c,d) \ { \ a += b; d ^= a; d = R(d,16); \ c += d; b ^= c; b = R(b,12); \ a += b; d ^= a; d = R(d,8); \ c += d; b ^= c; b = R(b,7); \ } \ /* r0 = x0 x1 x2 x3 r1 = x4 x5 x6 x7 r2 = x8 x9 x10 x11 r3 = x12 x13 x14 x15 QROUND(r0, r1, r2, r3) : Handles row o d0 = x0 x1 x2 x3 d1 = x5 x6 x7 x4 d2 = x10 x11 x8 x9 d3 = x15 x12 x13 x14 */ # define SIG 1 , 2 , 3 , 0 , 5 , 6 , 7 , 4 # define SIG2 2 , 3 , 0 , 1 , 6 , 7 , 4 , 5 # define SIG3 3 , 0 , 1 , 2 , 7 , 4 , 5 , 6 # define MASK_LOW 0 , 1 , 2 , 3 , 8 , 9 , 10 , 11 # define MASK_HIGH 4 , 5 , 6 , 7 , 12 , 13 , 14 , 15 # define ISIG SIG3 # define ISIG2 SIG2 # define ISIG3 SIG #ifdef __clang__ # define SIGMA(X) (__builtin_shufflevector( X, X, SIG)) # define SIGMA2(X) (__builtin_shufflevector( X, X, SIG2)) # define SIGMA3(X) (__builtin_shufflevector( X, X, SIG3)) # define ISIGMA(X) (__builtin_shufflevector( X, X, ISIG)) # define ISIGMA2(X) (__builtin_shufflevector( X, X, ISIG2)) # define ISIGMA3(X) (__builtin_shufflevector( X, X, ISIG3)) # define MERGE_LOW(X,Y) (__builtin_shufflevector(X,Y, MASK_LOW)) # define MERGE_HIGH(X,Y) (__builtin_shufflevector(X,Y, MASK_HIGH)) #else # define SIGMA(X) (__builtin_shuffle( X, (Vec2){SIG})) # define SIGMA2(X) (__builtin_shuffle( X, (Vec2){SIG2})) # define SIGMA3(X) (__builtin_shuffle( X, (Vec2){SIG3})) # define ISIGMA(X) (__builtin_shuffle( X, (Vec2){ISIG})) # define ISIGMA2(X) (__builtin_shuffle( X, (Vec2){ISIG2})) # define ISIGMA3(X) (__builtin_shuffle( X, (Vec2){ISIG3})) # define MERGE_LOW(X,Y) (__builtin_shuffle(X,Y, (Vec2){MASK_LOW} )) # define MERGE_HIGH(X,Y) (__builtin_shuffle(X,Y, (Vec2){MASK_HIGH})) #endif # define TODIAG { B = SIGMA(B) ; C = SIGMA2(C) ; D = SIGMA3(D); } # define TOROW { B = ISIGMA(B); C = ISIGMA2(C); D = ISIGMA3(D); } # define ROUND { QROUND(A,B,C,D); TODIAG; QROUND(A,B,C,D); TOROW; } # define ChaChaConstantRow (Vec2){ C0 , C1 , C2 , C3, C0 , C1 , C2 , C3} # define LOW(X) ((Vec){X[0],X[1],X[2],X[3]}) # define HIGH(X) ((Vec){X[4],X[5],X[6],X[7]}) # if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ # define ADJUST_ENDIAN(A) {} /* do nothing */ # else # define SWAP(A,i) bswap_32(A[i]) # define ADJUST_ENDIAN(A) { \ A = (Vec2){ SWAP(A,0), SWAP(A,1), SWAP(A,2), SWAP(A,3) \ SWAP(A,4), SWAP(A,5), SWAP(A,6), SWAP(A,7)};} # endif # define INP(i) (((Vec*)msg)[i]) # define INP2(i) (((Vec2*)msg)[i]) # ifdef HAVE_AVX2 # define WRITE_LOW { MSG = MERGE_LOW(A,B); INP2(0) ^= MSG; MSG = MERGE_LOW(C,D); INP2(1) ^= MSG; } # define WRITE_HIGH { MSG = MERGE_HIGH(A,B); INP2(2) ^= MSG; MSG = MERGE_HIGH(C,D); INP2(3) ^= MSG; } # else # define WRITE_LOW { INP(0) ^= LOW(A); INP(1) ^= LOW(B); INP(2) ^= LOW(C); INP(3) ^= LOW(D); } # define WRITE_HIGH { INP(4) ^= HIGH(A); INP(5) ^= HIGH(B); INP(6) ^= HIGH(C); INP(7) ^= HIGH(D); } # endif # define EMIT(X,i) ((Vec2 *)msg)[i] = X void raazChaCha20BlockVector256(Block *msg, int nblocks, const Key key, const IV iv, Counter *ctr) { register Vec2 A , B, C, D; register Vec2 M1, M2, M3; register Vec2 MSG; M1 = (Vec2){ key[0] , key[1] , key[2] , key[3], key[0] , key[1] , key[2] , key[3] }; M2 = (Vec2){ key[4] , key[5] , key[6] , key[7], key[4] , key[5] , key[6] , key[7] }; M3 = (Vec2){ *(ctr) , iv[0] , iv[1] , iv[2], *(ctr)+1 , iv[0] , iv[1] , iv[2] }; *ctr += nblocks; while(nblocks > 0) { /* Initialise the state; Except for the counter everything is the same */ A = ChaChaConstantRow; B = M1; C = M2; D = M3; ROUND; /* 0,1 */ ROUND; /* 2,3 */ ROUND; /* 4,5 */ ROUND; /* 6,7 */ ROUND; /* 8,9 */ ROUND; /* 10,11 */ ROUND; /* 12,13 */ ROUND; /* 14,15 */ ROUND; /* 16,17 */ ROUND; /* 18,19 */ A += ChaChaConstantRow; B += M1; C += M2; D += M3; /* Writing the stream */ ADJUST_ENDIAN(A); ADJUST_ENDIAN(B); ADJUST_ENDIAN(C); ADJUST_ENDIAN(D); WRITE_LOW; /* Write the lower block */ if( nblocks == 1) break; /* nblocks was odd and hence we are done */ WRITE_HIGH; /* Move by two blocks at a time. */ nblocks -= 2; msg += 2; M3 += (Vec2){2,0,0,0,2,0,0,0}; } return; } raaz-0.1.1/bin/Main.hs0000644000000000000000000000473313055622535012641 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} -- -- The main function that drives other commands. -- import Control.Monad import Data.Version (showVersion) import Data.Monoid import Raaz (version) import System.Console.GetOpt import System.Environment import System.Exit import System.IO import Command.Checksum import Command.Rand -- The commands know to raaz executable. commands :: [(String, [String] -> IO ())] commands = [ ("checksum", checksum) , ("rand" , rand ) ] ----------------- Command line parsing ------------------------------------- data Options = Options { optVersion :: Bool , optHelp :: Bool } defaultOpts :: Options defaultOpts = Options { optVersion = False, optHelp = False } options :: [OptDescr (Endo Options)] options = [ Option ['v'] ["version"] (NoArg setVersion) "print the version" , Option ['h'] ["help"] (NoArg setHelp) "print the help" ] where setVersion = Endo $ \ opt -> opt { optVersion = True } setHelp = Endo $ \ opt -> opt { optHelp = True } -- | parse options parseOpts :: [String] -> IO Options parseOpts args = case getOpt Permute options args of (o,[],[]) -> return $ appEndo (mconcat o) defaultOpts (_,_,errs) -> errorBailout errs -- The usage message for the program. usage :: [String] -> String usage errs | null errs = usageInfo header options | otherwise = "raaz: " ++ unlines errs ++ usageInfo header options where header = unlines $ [ "Usage: raaz [COMMAND] [OPTIONS]" , " raaz [OPTIONS]" , "" , "Supported Commands: " ] ++ cmds cmds = map (("\t"++) . fst) commands ---------------------- The main function and stuff ------------------------------ main :: IO () main = do args <- getArgs case args of (c:restArgs) -> maybe (noCommand args) (runCmd restArgs) $ lookup c commands _ -> errorBailout ["empty command line"] where runCmd = flip ($) noCommand = parseOpts >=> run run :: Options -> IO () run (Options{..}) = do when optVersion $ printVersion when optHelp $ printHelp where printHelp = putStrLn $ usage [] printVersion = putStrLn $ "raaz: " ++ showVersion version -- | Bail out on error errorBailout :: [String]-> IO a errorBailout errs = do hPutStrLn stderr $ usage errs exitFailure raaz-0.1.1/bin/Command/Checksum.lhs0000644000000000000000000002577313055622555015262 0ustar0000000000000000Introduction ------------ This command supports a generalised version of sha1sum/sha256sum/sha512sum programs that are available on a standard linux system. It supports generating checksum files and verifying them for all the hashes exposed by the raaz library. The purpose of writing this application is the following. 1. To give an example of of a non-trivial program written to use the raaz library. 2. To make sure that the implementations of hashes in this library are not too off in terms of performance. The command line options of this command is similar to that of sha1sum and hence can be used as a replacement. This file is a literate haskell file and hence can be compiled directly. The text is in markdown and hence you should be able to produce the documentation for We start by enabling some pragmas and importing some stuff which can be ignored. > {-# LANGUAGE GADTs #-} > {-# LANGUAGE RankNTypes #-} > {-# LANGUAGE RecordWildCards #-} > {-# LANGUAGE ConstraintKinds #-} > module Command.Checksum ( checksum ) where > > import Control.Applicative > import Control.Monad > import Data.List (intercalate) > import Data.Monoid > import Data.String > import Data.Version (showVersion) > import System.Environment > import System.Exit > import System.IO (stdin, stderr, hPutStrLn) > import System.Console.GetOpt > import Raaz hiding (Result) > import Raaz.Hash.Sha1 Verification Tokens ------------------- Programs like sha1sum is typically used to verify that the contents of a set of files have not been modified or corrupted. This program does the following: 1. In compute mode it computes a set of verification tokens which uniquely identify the contents of the file. 2. In verification mode it takes a set of tokens are verify them. Verification tokens are computed using the cryptographic hash. We allow the use of any of the hashes exposed by the raaz library. Thus for us, any hash that satisfies the constraint `TokenHash` should be usable in computing and verifying tokens. > type TokenHash h = (Hash h, Recommendation h, Show h, IsString h) > The verification token is defined below. To make it opaque, we existentially quantify over the underlying digest. > > data Token = forall h . TokenHash h > => Token { tokenFile :: FilePath > , tokenDigest :: h > } > A token can be verified easily. First we define the result type > type Result = Either FilePath FilePath > > verify :: Token -> IO Result > verify (Token{..}) = do c <- (==tokenDigest) <$> hashFile tokenFile > return $ if c then Right tokenFile else Left tokenFile Computing tokens. ----------------- To compute the verification token, we need a way to specify the algorithm. The following proxy helps us in this. > data Algorithm h = Algorithm Here `h` varies over all the hashes supported by the library. We now need an easy way to tabulate all the hash algorithm that we support. Existential types comes to the rescue once more. > data SomeAlgorithm = forall h . TokenHash h => SomeAlgorithm (Algorithm h) Here is the table of algorithms that we support currently. > algorithms :: [(String, SomeAlgorithm)] > algorithms = [ ("broken-sha1" , SomeAlgorithm (Algorithm :: Algorithm SHA1) ) > , ("sha256", SomeAlgorithm (Algorithm :: Algorithm SHA256) ) > , ("sha512", SomeAlgorithm (Algorithm :: Algorithm SHA512) ) > -- Add new algorithms here. > ] We now define the computation function. There are two variants, one for arbitrary files and the other for standard input. > -- | Compute the token using a given algorithm. > token :: TokenHash h > => Algorithm h -- ^ The hashing algorithm to use. > -> FilePath -- ^ The file to compute the token for. > -> IO Token > token algo fp = Token fp <$> hashIt algo > where hashIt :: TokenHash h => Algorithm h -> IO h > hashIt _ = hashFile fp > > tokenStdin :: TokenHash h => Algorithm h -> IO Token > tokenStdin algo = Token "-" <$> hashIt algo > where hashIt :: TokenHash h => Algorithm h -> IO h > hashIt _ = hashSource stdin > Printed form of tokens ---------------------- To inter-operate with programs like sha1sum, we follow the same printed notation. The appropriate show instances for token is the following. The format is `line := digest space mode filename`. The mode has something to do with whether it is binary or text (we always put a space for it). > instance Show Token where > show (Token{..}) = show tokenDigest ++ " " ++ tokenFile We also define the associated parsing function which has to take the the underlying algorithm as a parameter. > parse :: TokenHash h => Algorithm h -> String -> Token > parse algo str = Token { tokenFile = drop 2 rest > , tokenDigest = parseDigest algo digest > } > where parseDigest :: TokenHash h => Algorithm h -> String -> h > parseDigest _ = fromString > (digest, rest) = break (==' ') str -- break at the space. The main function. ------------------ The overall structure of the code is clear the details follow. > checksum :: [String] -> IO () > checksum = parseOpts >=> handleArgs > handleArgs :: (Options, [FilePath]) > -> IO () > handleArgs (opts@Options{..}, files) = do > when optHelp printHelp -- When the help option is given print it and exit > flip (either badAlgorithm) optAlgo $ \ algo -> do > if optCheck -- if asked to check. > then verifyMode opts algo files >>= optPrintCount > else computeMode algo files > badAlgorithm :: String -> IO () > badAlgorithm name = errorBailout ["Bad hash algorithm " ++ name] The compute mode. ----------------- There are two important modes of operation for this program, _the compute mode_ and the _verify mode_. In the compute mode, we are given an a set of files and we need to print out the verification tokes for those files. > computeMode :: SomeAlgorithm -- The algorithm to use > -> [FilePath] -- files for which tokes need to be > -- computed. > -> IO () > computeMode (SomeAlgorithm algo) files > | null files = tokenStdin algo >>= print -- No files means compute it for stdin. > | otherwise = mapM_ printToken files -- Print the token for each file. > where printToken = token algo >=> print The verification mode of the algorithm is a bit more complicated than the compute mode. Given a list of tokens let us first read them. Recall the tokens are listed, one per line with the digest followed by a space followed by the filename. > verifyMode :: Options > -> SomeAlgorithm > -> [FilePath] > -> IO Int > verifyMode (Options{..}) algo files = verifyFiles algo files >>= foldM fldr (0 :: Int) > where fldr n = either whenFailed whenOkey > where whenOkey :: FilePath -> IO Int > whenOkey = optOkey >=> const (return n) -- when okey do the okey action and keep the count > whenFailed = optFailed >=> const (return (n+1)) -- when failed do the failed action and increment This function verify the token list given in a list of files. Each file contains a list of tokens and each of these tokens have to be verified. > verifyFiles :: SomeAlgorithm > -> [FilePath] > -> IO [Result] > > verifyFiles (SomeAlgorithm algo) files > | null files = getContents >>= verifyTokenList > | otherwise = concat <$> mapM verifyFile files > where > verifyFile = readFile >=> verifyTokenList > verifyTokenList = mapM mapper . lines > mapper = verify . parse algo This function prints the help for the program. > printHelp :: IO () > printHelp = do putStrLn $ usage [] > exitSuccess Command line parsing -------------------- The options supported by the program is given by the following data type. Fields should be self explanatory. > data Options = > Options { optHelp :: Bool > , optCheck :: Bool > , optAlgo :: Either String SomeAlgorithm > , optOkey :: FilePath -> IO () -- ^ handle successful tokens > , optFailed :: FilePath -> IO () -- ^ handle failed tokens. > , optPrintCount :: Int -> IO () -- ^ print failure counts. > } The default options for the command is as follows. > defaultOpts = > Options { optHelp = False > , optCheck = False > , optAlgo = Right sha512Algorithm > , optOkey = \ fp -> putStrLn (fp ++ ": OK") > , optFailed = \ fp -> putStrLn (fp ++ ": FAILED") > , optPrintCount = printCount > } > where sha512Algorithm = SomeAlgorithm (Algorithm :: Algorithm SHA512) > printCount n = when (n > 0) $ do > putStrLn $ show n ++ " failures." > exitFailure > We use the getOpts library to parse the command lines. The options are summarised in the following list. The `Endo` monoid helps in summarising the changes to the option set. > options :: [OptDescr (Endo Options)] > options = > [ Option ['h'] ["help"] (NoArg setHelp) "print the help" > , Option ['c'] ["check"] (NoArg setCheck) "check instead of compute" > , Option ['q'] ["quiet"] (NoArg setQuiet) "print failure only" > , Option ['s'] ["status"] (NoArg setStatusOnly) > "no output only return status" > , Option ['a'] ["algo"] (ReqArg setAlgo "HASH") > $ "hash algorithm to use " ++ "[" ++ algOpts ++ "]. Default sha512" > ] > where setHelp = Endo $ \ opt -> opt { optHelp = True } > setCheck = Endo $ \ opt -> opt { optCheck = True } > setAlgo str = Endo $ \ opt -> opt { optAlgo = a } > where a = maybe (Left str) Right $ lookup str algorithms > algOpts = intercalate "|" $ map fst algorithms > setQuiet = Endo $ \ opt -> opt { optOkey = noPrint } > setStatusOnly = Endo $ \ opt -> opt { optFailed = noPrint > , optOkey = noPrint > , optPrintCount = returnStatus > } > noPrint = const $ return () > returnStatus n > | n > 0 = exitFailure > | otherwise = exitSuccess > The usage message for the program. > usage :: [String] -> String > usage errs > | null errs = usageInfo header options > | otherwise = "raaz checksum: " ++ unlines errs ++ usageInfo header options > where header ="Usage: raaz checksum [OPTIONS] FILE1 FILE2 ..." Parsing the options. > parseOpts :: [String] -> IO (Options, [FilePath]) > parseOpts args = case getOpt Permute options args of > (o,n,[]) -> return (appEndo (mconcat o) defaultOpts, n) > (_,_,errs) -> errorBailout errs Bail out with an error message. > errorBailout :: [String]-> IO a > errorBailout errs = do > hPutStrLn stderr $ usage errs > exitFailure raaz-0.1.1/bin/Command/Rand.lhs0000644000000000000000000000516713055622535014375 0ustar0000000000000000This command that spits out never ending stream of cryptographically secure bytes. Other than being a replacement to Yo-Yo Honey Singh (random > /dev/audio), it is used to test the quality of the randomnes produced. > module Command.Rand ( rand ) where > import Control.Applicative > import Control.Monad.IO.Class(liftIO) > import System.Exit > import System.IO > import Text.Read > import Prelude > import Raaz So much bytes generated in one go before writing to stdout. > bufSize :: BYTES Int > bufSize = 32 * 1024 The usage message for the program. > usage :: [String] -> String > usage errs | null errs = body > | otherwise = "raaz: " ++ unlines errs ++ body > where body = unlines $ [ "Usage: raaz random [N]" > , " raaz random [-h|--help]" > , "" > , "Generates never ending stream of cryptographically secure random bytes." > , "With the option integral argument N, stops after generating N bytes." > , " -h\t--help\tprint this help" > ] The main stuff. > rand :: [String] -> IO () > rand args = case args of > ["-h"] -> printHelp > ["--help"] -> printHelp > [n] -> maybe (badArgs n) gen $ readNBytes n > [] -> withBuffer $ insecurely . genInfiniteBytes > _ -> tooManyArgs > where readNBytes :: String -> Maybe (BYTES Int) > readNBytes x = (toEnum <$> readMaybe x) >>= onlyPositive > onlyPositive x > | x >= 0 = Just x > | otherwise = Nothing > badArgs n = errorBailout ["Bar argument " ++ n ++ " expected integer (no of bytes)"] > tooManyArgs = errorBailout ["too many args"] > gen n = withBuffer $ insecurely . genBytes n > withBuffer = allocaBuffer bufSize > printHelp :: IO () > printHelp = do putStrLn $ usage [] > exitSuccess > genInfiniteBytes :: Pointer -> RandM () > genInfiniteBytes ptr = goForEver > where goForEver = emitRand bufSize ptr >> goForEver Generate so many bytes. > genBytes :: BYTES Int -> Pointer-> RandM () > genBytes n ptr = go n > where go m | m >= bufSize = do emitRand bufSize ptr; go (m - bufSize) > | otherwise = emitRand m ptr Bail out of errors > errorBailout errs = do hPutStrLn stderr $ usage errs > exitFailure -- Emit so may random bytes. > emitRand :: BYTES Int -> Pointer-> RandM () > emitRand m ptr = do > fillRandomBytes m ptr > liftIO $ hPutBuf stdout ptr $ fromIntegral m raaz-0.1.1/spec/Spec.hs0000644000000000000000000000005412750426275013025 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} raaz-0.1.1/spec/Common.hs0000644000000000000000000000025512750426275013366 0ustar0000000000000000-- 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 raaz-0.1.1/spec/Common/Cipher.hs0000644000000000000000000000717613037202101014564 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} module Common.Cipher where import Raaz.Core.Transfer import Common.Imports import Common.Utils encryptVsDecrypt :: ( Arbitrary (Key c) , Show (Key c) , Cipher c, Recommendation c ) => c -> Spec encryptVsDecrypt c = encryptVsDecrypt' c $ recommended c encryptVsDecrypt' :: ( Arbitrary (Key c) , Show (Key c) , Cipher c ) => c -> Implementation c -> Spec encryptVsDecrypt' c imp = 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 imp k (unsafeEncrypt' c imp k bs) == bs encryptsTo :: (Cipher c, Recommendation c, Format fmt1, Format fmt2) => c -> fmt1 -> fmt2 -> Key c -> Spec crossCheck :: ( Arbitrary (Key c) , Show (Key c) , Cipher c , Recommendation c ) => c -> Implementation c -> Spec crossCheck c impl = describe mesg $ do it "encryption" $ property $ forAll genKeyStr prop_Enc it "decryption" $ property $ forAll genKeyStr prop_Dec where mesg = unwords ["cross check with ", name reco , "(recommended implementation)" ] reco = recommended c genKeyStr = (,) <$> arbitrary <*> blocks c prop_Enc (k,bs) = unsafeEncrypt' c reco k bs == unsafeEncrypt' c impl k bs prop_Dec (k,bs) = unsafeDecrypt' c reco k bs == unsafeDecrypt' c impl k bs encryptsTo c = encryptsTo' c $ recommended c encryptsTo' :: (Cipher c, Format fmt1, Format fmt2) => c -> Implementation c -> fmt1 -> fmt2 -> Key c -> Spec encryptsTo' c imp inp expected key = it msg $ result `shouldBe` (decodeFormat expected) where result = unsafeEncrypt' c imp key $ decodeFormat inp msg = unwords [ "encrypts" , shortened $ show inp , "to" , shortened $ show expected ] transformsTo :: (StreamCipher c, Recommendation c, Format fmt1, Format fmt2) => c -> fmt1 -> fmt2 -> Key c -> Spec transformsTo c = transformsTo' c $ recommended c keyStreamIs' :: (StreamCipher c, Format fmt) => c -> Implementation c -> fmt -> Key c -> Spec keyStreamIs' c impl expected key = it msg $ result `shouldBe` decodeFormat expected where result = transform' c impl key $ zeros $ 1 `blocksOf` c msg = unwords ["with key" , "key stream is" , shortened $ show expected ] zeros :: Primitive prim => BLOCKS prim -> ByteString zeros = toByteString . writeZero where writeZero :: LengthUnit u => u -> WriteIO writeZero = writeBytes 0 transformsTo' :: (StreamCipher c, Format fmt1, Format fmt2) => c -> Implementation c -> fmt1 -> fmt2 -> Key c -> Spec transformsTo' c impl inp expected key = it msg $ result `shouldBe` (decodeFormat expected) where result = transform' c impl key $ decodeFormat inp msg = unwords [ "encrypts" , shortened $ show inp , "to" , shortened $ show expected ] raaz-0.1.1/spec/Common/Hash.hs0000644000000000000000000000215012750426275014245 0ustar0000000000000000-- 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 ] raaz-0.1.1/spec/Common/Imports.hs0000644000000000000000000000150613055622555015021 0ustar0000000000000000-- Common imports. module Common.Imports( module E ) where import Control.Applicative as E import Data.ByteString as E (ByteString, pack) import Data.ByteString.Char8 () -- import IsString instance for -- byte string. import Data.String as E import Data.Monoid as E import Data.Word as E import Foreign.Storable as E (Storable, peek, poke) import Test.Hspec as E import Test.Hspec.QuickCheck as E import Test.QuickCheck as E import Test.QuickCheck.Monadic as E import Raaz.Core as E hiding ((===), Result) import Raaz.Hash as E import Raaz.Hash.Sha1 as E import Raaz.Cipher as E import Raaz.Cipher.Internal as E ( unsafeEncrypt', unsafeDecrypt', transform' ) raaz-0.1.1/spec/Common/Instances.hs0000644000000000000000000000377413006426545015321 0ustar0000000000000000{-# 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 import Raaz.Cipher.ChaCha20 as ChaCha20 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 instance Arbitrary Base64 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 instance Arbitrary ChaCha20.KEY where arbitrary = genEncodable instance Arbitrary ChaCha20.IV where arbitrary = genEncodable instance Arbitrary ChaCha20.Counter where arbitrary = le32ToCtr <$> arbitrary where le32ToCtr :: LE Word32 -> Counter le32ToCtr = fromIntegral raaz-0.1.1/spec/Common/Utils.hs0000644000000000000000000000513013037202101014436 0ustar0000000000000000{-# LANGUAGE CPP #-} module Common.Utils where import Common.Imports hiding (length, replicate) import Foreign.Ptr ( castPtr, Ptr ) 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 (sizeOf a) (runStoreLoad . castPtr) where runStoreLoad ptr = store ptr a >> load ptr allocCast :: BYTES Int -> (Ptr a -> IO c) -> IO c allocCast sz f = allocaBuffer sz $ f . castPtr storeAdjustAndPeek :: EndianStore a => a -> IO a storeAdjustAndPeek a = allocCast sz $ \ ptr -> do store ptr a adjustEndian ptr 1 peek ptr where sz = sizeOf a pokeAdjustAndLoad :: EndianStore a => a -> IO a pokeAdjustAndLoad a = allocCast sz $ \ ptr -> do poke ptr a adjustEndian ptr 1 load ptr where sz = sizeOf a basicEndianSpecs :: ( EndianStore a, Show a, Eq a, Arbitrary a) => a -> Spec basicEndianSpecs a = do prop "store followed by load returns original value" $ \ x -> storeAndThenLoad (x `asTypeOf` a) `shouldReturn` x prop "store, adjust followed by peek should return the original value" $ \ x -> storeAdjustAndPeek (x `asTypeOf` a) `shouldReturn` x prop "poke, adjust followed by load should return the original value" $ \ x -> pokeAdjustAndLoad (x `asTypeOf` a) `shouldReturn` x -- | 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 (fromEnum $ 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 :: 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 raaz-0.1.1/spec/Raaz/Cipher/AESSpec.hs0000644000000000000000000001272513006426545015470 0ustar0000000000000000{-# 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 raaz-0.1.1/spec/Raaz/Cipher/ChaCha20Spec.hs0000644000000000000000000001314213037202101016303 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE CPP #-} module Raaz.Cipher.ChaCha20Spec where import Control.Monad import Data.Monoid import Common import qualified Common.Cipher as C import Raaz.Core.Transfer import Raaz.Cipher.ChaCha20 import qualified Raaz.Cipher.ChaCha20.Implementation.CPortable as CP #ifdef HAVE_VECTOR_128 import qualified Raaz.Cipher.ChaCha20.Implementation.Vector128 as Vector128 #endif # ifdef HAVE_VECTOR_256 import qualified Raaz.Cipher.ChaCha20.Implementation.Vector256 as Vector256 # endif implementations :: [Implementation ChaCha20] implementations = [ CP.implementation # ifdef HAVE_VECTOR_128 , Vector128.implementation # endif # ifdef HAVE_VECTOR_256 , Vector256.implementation # endif ] writeZeros :: BYTES Int -> WriteIO writeZeros = writeBytes 0 zeroIV :: IV zeroIV = unsafeDecode $ toByteString $ writeZeros 12 zeroKey :: KEY zeroKey = unsafeDecode $ toByteString $ writeZeros 32 oneKey :: KEY oneKey = unsafeDecode $ toByteString $ one <> writeZeros 31 where one = writeBytes 1 (1 :: BYTES Int) zeroBlocks :: Int -> ByteString zeroBlocks = C.zeros . (toEnum :: Int -> BLOCKS ChaCha20) spec :: Spec spec = forM_ implementations $ \ imp -> do let transformsTo = C.transformsTo' chacha20 imp cipherImpName = "chacha20 (" ++ name imp ++ ")" keyStreamIs = C.keyStreamIs' chacha20 imp in do describe cipherImpName $ do C.encryptVsDecrypt' chacha20 imp C.crossCheck chacha20 imp -- Unit test from RFC7539 with ("00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f 10 11 12 13 14 15 16 17 18 19 1a 1b 1c 1d 1e 1f" , "00:00:00:00 00:00:00:4a 00:00:00:00" , 1 ) $ ("Ladies and Gentlemen of the class of '99: If I could offer you only one tip for the future, sunscreen would be it." :: ByteString) `transformsTo` ( "6e 2e 35 9a 25 68 f9 80 41 ba 07 28 dd 0d 69 81" <> "e9 7e 7a ec 1d 43 60 c2 0a 27 af cc fd 9f ae 0b" <> "f9 1b 65 c5 52 47 33 ab 8f 59 3d ab cd 62 b3 57" <> "16 39 d6 24 e6 51 52 ab 8f 53 0c 35 9f 08 61 d8" <> "07 ca 0d bf 50 0d 6a 61 56 a3 8e 08 8a 22 b6 5e" <> "52 bc 51 4d 16 cc f8 06 81 8c e9 1a b7 79 37 36" <> "5a f9 0b bf 74 a3 5b e6 b4 0b 8e ed f2 78 5e 42" <> "87 4d" :: Base16) with (zeroKey, zeroIV, 0) $ zeroBlocks 2 `transformsTo` ( "76 b8 e0 ad a0 f1 3d 90 40 5d 6a e5 53 86 bd 28" <> "bd d2 19 b8 a0 8d ed 1a a8 36 ef cc 8b 77 0d c7" <> "da 41 59 7c 51 57 48 8d 77 24 e0 3f b8 d8 4a 37" <> "6a 43 b8 f4 15 18 a1 1c c3 87 b6 69 b2 ee 65 86" <> "9f 07 e7 be 55 51 38 7a 98 ba 97 7c 73 2d 08 0d" <> "cb 0f 29 a0 48 e3 65 69 12 c6 53 3e 32 ee 7a ed" <> "29 b7 21 76 9c e6 4e 43 d5 71 33 b0 74 d8 39 d5" <> "31 ed 1f 28 51 0a fb 45 ac e1 0a 1f 4b 79 4d 6f" :: Base16) with (oneKey, zeroIV, 0) $ zeroBlocks 2 `transformsTo` ( "c5 d3 0a 7c e1 ec 11 93 78 c8 4f 48 7d 77 5a 85" <> "42 f1 3e ce 23 8a 94 55 e8 22 9e 88 8d e8 5b bd" <> "29 eb 63 d0 a1 7a 5b 99 9b 52 da 22 be 40 23 eb" <> "07 62 0a 54 f6 fa 6a d8 73 7b 71 eb 04 64 da c0" <> "10 f6 56 e6 d1 fd 55 05 3e 50 c4 87 5c 99 30 a3" <> "3f 6d 02 63 bd 14 df d6 ab 8c 70 52 1c 19 33 8b" <> "23 08 b9 5c f8 d0 bb 7d 20 2d 21 02 78 0e a3 52" <> "8f 1c b4 85 60 f7 6b 20 f3 82 b9 42 50 0f ce ac" :: Base16) with (zeroKey, zeroIV, 0) $ keyStreamIs ( "76 b8 e0 ad a0 f1 3d 90 40 5d 6a e5 53 86 bd 28" <> "bd d2 19 b8 a0 8d ed 1a a8 36 ef cc 8b 77 0d c7" <> "da 41 59 7c 51 57 48 8d 77 24 e0 3f b8 d8 4a 37" <> "6a 43 b8 f4 15 18 a1 1c c3 87 b6 69 b2 ee 65 86" :: Base16) with (zeroKey, zeroIV, 1) $ keyStreamIs ( "9f 07 e7 be 55 51 38 7a 98 ba 97 7c 73 2d 08 0d" <> "cb 0f 29 a0 48 e3 65 69 12 c6 53 3e 32 ee 7a ed" <> "29 b7 21 76 9c e6 4e 43 d5 71 33 b0 74 d8 39 d5" <> "31 ed 1f 28 51 0a fb 45 ac e1 0a 1f 4b 79 4d 6f" :: Base16) with (oneKey, zeroIV, 0) $ keyStreamIs ( "c5 d3 0a 7c e1 ec 11 93 78 c8 4f 48 7d 77 5a 85" <> "42 f1 3e ce 23 8a 94 55 e8 22 9e 88 8d e8 5b bd" <> "29 eb 63 d0 a1 7a 5b 99 9b 52 da 22 be 40 23 eb" <> "07 62 0a 54 f6 fa 6a d8 73 7b 71 eb 04 64 da c0" :: Base16) with (oneKey, zeroIV, 1) $ keyStreamIs ( "10 f6 56 e6 d1 fd 55 05 3e 50 c4 87 5c 99 30 a3" <> "3f 6d 02 63 bd 14 df d6 ab 8c 70 52 1c 19 33 8b" <> "23 08 b9 5c f8 d0 bb 7d 20 2d 21 02 78 0e a3 52" <> "8f 1c b4 85 60 f7 6b 20 f3 82 b9 42 50 0f ce ac" :: Base16) raaz-0.1.1/spec/Raaz/Core/EncodeSpec.hs0000644000000000000000000000301313006426545015721 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} module Raaz.Core.EncodeSpec where import Common import qualified Data.ByteString as B shouldBeAMultipleOf :: Int -> Int -> Bool shouldBeAMultipleOf m x = m `rem` x == 0 shouldEncodeTo :: (Format fmt, Eq fmt) => ByteString -> fmt -> Spec shouldEncodeTo bs e = it msg $ encodeByteString bs `shouldBe` e where msg = show bs ++ " should encode to " ++ show e spec :: Spec spec = do describe "Base16" $ do prop "encoded string is always of even length" $ \ (x :: Base16) -> B.length (toByteString x) `shouldBeAMultipleOf` 2 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 describe "Base64" $ do prop "encoded string is always divisible by 4" $ \ (x :: Base64) -> B.length (toByteString x) `shouldBeAMultipleOf` 4 prop "unsafeFromByteString . toByteString = id" $ \ (x :: Base16) -> unsafeFromByteString (toByteString x) `shouldBe` x describe "examples" $ do "pleasure." `shouldEncodeTo` ("cGxlYXN1cmUu" :: Base64) "leasure." `shouldEncodeTo` ("bGVhc3VyZS4=" :: Base64) "easure." `shouldEncodeTo` ("ZWFzdXJlLg==" :: Base64) "asure." `shouldEncodeTo` ("YXN1cmUu" :: Base64) "sure." `shouldEncodeTo` ("c3VyZS4=" :: Base64) raaz-0.1.1/spec/Raaz/Core/MemorySpec.hs0000644000000000000000000000053012750426275016002 0ustar0000000000000000{-# 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 raaz-0.1.1/spec/Raaz/Core/Types/WordSpec.hs0000644000000000000000000000473013006426545016552 0ustar0000000000000000{-# 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 basicEndianSpecs (undefined :: LE Word32) 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 basicEndianSpecs (undefined :: LE Word64) 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 basicEndianSpecs (undefined :: BE Word32) 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 basicEndianSpecs (undefined :: BE Word64) 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 raaz-0.1.1/spec/Raaz/Core/Util/ByteStringSpec.hs0000644000000000000000000000260513055622535017542 0ustar0000000000000000module Raaz.Core.Util.ByteStringSpec where import Common import Prelude hiding (length, take) import Data.ByteString.Internal(createAndTrim) import qualified 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) -> (==) (B.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 (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) raaz-0.1.1/spec/Raaz/RandomSpec.hs0000644000000000000000000000052013043432667015057 0ustar0000000000000000module Raaz.RandomSpec where import Common import Raaz.Random spec :: Spec spec = it "system prg should return different words on distinct calls" $ compareWords `shouldReturn` False where r64 :: RandM Word64 r64 = random compareWords = insecurely $ (==) <$> r64 <*> r64 raaz-0.1.1/spec/Raaz/Hash/Sha1Spec.hs0000644000000000000000000000404213006426545015316 0ustar0000000000000000 {-# 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 basicEndianSpecs (undefined :: SHA1) -- -- 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" raaz-0.1.1/spec/Raaz/Hash/Sha224Spec.hs0000644000000000000000000000227013006426545015466 0ustar0000000000000000 {-# 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 basicEndianSpecs (undefined :: SHA224) -- -- 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" raaz-0.1.1/spec/Raaz/Hash/Sha256Spec.hs0000644000000000000000000000445013006426545015475 0ustar0000000000000000 {-# 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 basicEndianSpecs (undefined :: SHA256) -- -- 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" raaz-0.1.1/spec/Raaz/Hash/Sha384Spec.hs0000644000000000000000000000273513006426545015503 0ustar0000000000000000 {-# 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 basicEndianSpecs (undefined :: SHA384) -- -- 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" raaz-0.1.1/spec/Raaz/Hash/Sha512Spec.hs0000644000000000000000000000612513006426545015471 0ustar0000000000000000 {-# 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 basicEndianSpecs (undefined :: SHA512) -- -- 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" raaz-0.1.1/spec/Raaz/Hash/Blake256Spec.hs0000644000000000000000000000460012750426275016002 0ustar0000000000000000 {-# 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" -} raaz-0.1.1/benchmarks/BenchPrimitives.hs0000644000000000000000000001402213055622535016405 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} -- | This module benchmarks all block function and shows the import Control.Monad import Criterion import Criterion.Types hiding (measure) import Criterion.Measurement import Data.Int import Data.List (span) import Text.PrettyPrint import System.IO import Raaz.Core import Raaz.Cipher import Raaz.Cipher.Internal import Raaz.Hash.Internal import Raaz.Random import qualified Raaz.Hash.Sha1.Implementation.CPortable as Sha1CP import qualified Raaz.Hash.Sha256.Implementation.CPortable as Sha256CP import qualified Raaz.Hash.Sha512.Implementation.CPortable as Sha512CP import qualified Raaz.Cipher.AES.CBC.Implementation.CPortable as AesCbcCP import qualified Raaz.Cipher.ChaCha20.Implementation.CPortable as ChaCha20CP # ifdef HAVE_VECTOR_128 import qualified Raaz.Cipher.ChaCha20.Implementation.Vector128 as ChaCha20V128 # endif # ifdef HAVE_VECTOR_256 import qualified Raaz.Cipher.ChaCha20.Implementation.Vector256 as ChaCha20V256 # endif -- The total data processed nBytes :: BYTES Int nBytes = 32 * 1024 -- How many times to run each benchmark nRuns :: Int64 nRuns = 10000 type Result = (String, Measured) type RaazBench = (String, Benchmarkable) allBench :: [RaazBench] allBench = [ memsetBench, randomnessBench ] ++ chacha20Benchs ++ aesBenchs ++ sha1Benchs ++ sha256Benchs ++ sha512Benchs main :: IO () main = do results <- mapM runRaazBench allBench putStrLn $ "Buffer Size = " ++ show (fromIntegral nBytes :: Int) putStrLn $ "Iterations = " ++ show nRuns putStrLn $ render $ vcat results pprMeasured :: Measured -> Doc pprMeasured (Measured{..}) = vcat [ text "time " <+> eq <+> text (secs tm) , text "cycles " <+> eq <+> double cy , text "rate " <+> eq <+> text rt <> text "bps" , text "secs/byte " <+> eq <+> text secB <> text "sec/byte" , text "cycles/byte" <+> eq <+> double cycB ] where tm = measTime / fromIntegral nRuns cy = fromIntegral measCycles / fromIntegral nRuns bytes = fromIntegral nBytes secB = humanise $ tm / bytes cycB = cy / bytes rt = humanise $ 8 * bytes / tm eq = text "=" ------------- All benchmarks --------------------------------------------- memsetBench :: RaazBench memsetBench = ("memset", Benchmarkable $ memBench . fromIntegral ) where memBench count = allocaBuffer nBytes $ \ ptr -> replicateM_ count (memset ptr 42 nBytes) sha1Benchs :: [ RaazBench ] sha1Benchs = [ hashBench Sha1CP.implementation ] sha256Benchs :: [ RaazBench ] sha256Benchs = [ hashBench Sha256CP.implementation ] sha512Benchs :: [ RaazBench ] sha512Benchs = [ hashBench Sha512CP.implementation ] aesBenchs :: [ RaazBench ] aesBenchs = [ encryptBench AesCbcCP.aes128cbcI , decryptBench AesCbcCP.aes128cbcI , encryptBench AesCbcCP.aes192cbcI , decryptBench AesCbcCP.aes192cbcI , encryptBench AesCbcCP.aes256cbcI , decryptBench AesCbcCP.aes256cbcI ] chacha20Benchs :: [ RaazBench ] chacha20Benchs = [ encryptBench ChaCha20CP.implementation # ifdef HAVE_VECTOR_256 , encryptBench ChaCha20V256.implementation # endif # ifdef HAVE_VECTOR_128 , encryptBench ChaCha20V128.implementation # endif ] --------------------------- Helper functions --------------------------------------------------------------------------- encryptBench :: Cipher c => Implementation c -> RaazBench encryptBench si@(SomeCipherI impl) = (nm , Benchmarkable $ encrBench . fromIntegral) where encrBench count = allocBufferFor si sz $ \ ptr -> insecurely $ replicateM_ count $ encryptBlocks impl ptr sz nm = name si ++ "-encrypt" sz = atLeast nBytes decryptBench :: Cipher c => Implementation c -> RaazBench decryptBench si@(SomeCipherI impl) = (nm , Benchmarkable $ decrBench . fromIntegral) where decrBench count = allocBufferFor si sz $ \ ptr -> insecurely $ replicateM_ count $ decryptBlocks impl ptr sz nm = name si ++ "-decrypt" sz = atLeast nBytes hashBench :: Hash h => Implementation h -> RaazBench hashBench hi@(SomeHashI impl) = (nm, Benchmarkable $ compressBench . fromIntegral ) where compressBench count = allocBufferFor hi sz $ \ ptr -> insecurely $ replicateM_ count $ compress impl ptr sz nm = name hi ++ "-compress" sz = atLeast nBytes randomnessBench :: RaazBench randomnessBench = ("random", Benchmarkable $ rand . fromIntegral) where rand count = allocaBuffer nBytes $ insecurely . replicateM_ count . fillIt fillIt :: Pointer -> RandM () fillIt = fillRandomBytes nBytes runRaazBench :: RaazBench -> IO Doc runRaazBench (nm, bm) = do hPutStr stderr $ "running " ++ nm ++ " ..." (memt,x) <- measure bm nRuns hPutStrLn stderr $ "done." return $ text nm $+$ nest 8 (pprMeasured memt) -------------------------- Humanise output ----------------------------------- humanise :: Double -> String humanise u | u < 1 = goL 0 u | otherwise = goU 0 u where goL e x | x > 1 || e == -3 = restrictDecimals 2 x ++ unitPrefix e | otherwise = goL (e - 1) (x * 1000) goU e x | x < 100 || e == 5 = restrictDecimals 2 x ++ unitPrefix e | otherwise = goU (e + 1) (x / 1000) restrictDecimals :: Int -> Double -> String restrictDecimals n x = u ++ take (n+1) v where (u,v) = span (/= '.') $ show x -- | @prefix n@ gives proper prefix every 10^{3n} exponent unitPrefix :: Int -> String unitPrefix ex | ex < -3 = error "exponent too small name" | ex == -3 = "n" | ex == -2 = "μ" | ex == -1 = "m" | ex == 0 = "" | ex == 1 = "K" | ex == 2 = "M" | ex == 3 = "G" | ex == 4 = "T" | ex == 5 = "P" | otherwise = error "exponent to large to name" raaz-0.1.1/benchmarks/Cipher.hs0000644000000000000000000000502713037202101014510 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-} import Control.Monad import Criterion import Criterion.Main import Criterion.Types import Foreign.Marshal.Alloc import Raaz.Core import Raaz.Cipher import Raaz.Cipher.Internal import qualified Raaz.Cipher.ChaCha20.Implementation.CPortable as CPortable # ifdef HAVE_VECTOR_128 import qualified Raaz.Cipher.ChaCha20.Implementation.Vector128 as Vector128 # endif # ifdef HAVE_VECTOR_256 import qualified Raaz.Cipher.ChaCha20.Implementation.Vector256 as Vector256 # endif -- | Buffer size used bufSize :: BYTES Int bufSize = 32 * 1024 main :: IO () main = defaultMain [ chacha20Bench, aesBench ] ----------------- Benchmarks of individual ciphers. ------------------------ aesBench :: Benchmark aesBench = bgroup "AES" [ benchCipher aes128cbc , benchCipher aes192cbc , benchCipher aes256cbc ] chacha20Bench :: Benchmark chacha20Bench = bgroup "ChaCha20" [ benchEncrypt' chacha20 CPortable.implementation # ifdef HAVE_VECTOR_128 , benchEncrypt' chacha20 Vector128.implementation # endif # ifdef HAVE_VECTOR_256 , benchEncrypt' chacha20 Vector256.implementation # endif ] ------------------ Low level functions --------------------------------------- benchCipher :: (Cipher c, Recommendation c) => c -> Benchmark benchCipher c = bgroup (name c) [benchEncrypt c, benchDecrypt c] benchEncrypt :: (Cipher c, Recommendation c) => c -> Benchmark benchEncrypt c = benchEncrypt' c $ recommended c benchDecrypt :: (Cipher c, Recommendation c) => c -> Benchmark benchDecrypt c = benchDecrypt' c $ recommended c benchEncrypt' :: Cipher c => c -> Implementation c -> Benchmark benchEncrypt' c si@(SomeCipherI imp) = bench nm $ nfIO go where go = allocBufferFor si sz $ \ ptr -> insecurely $ encryptBlocks imp ptr sz sz = atMost bufSize nm = "encrypt" ++ name si benchDecrypt' :: Cipher c => c -> Implementation c -> Benchmark benchDecrypt' c si@(SomeCipherI imp) = bench nm $ nfIO go where go = allocBufferFor si sz $ \ ptr -> insecurely $ decryptBlocks imp ptr sz sz = atMost bufSize nm = "decrypt" ++ name si {-- -- | Compare ciphers with a plain memset. benchMemSet :: Benchmark benchMemSet = bench "memset" $ nfIO go where go = allocaBuffer bufSize $ \ ptr -> memset ptr 0 bufSize --} raaz-0.1.1/benchmarks/BlazeVsWrite.hs0000644000000000000000000000343513006426545015700 0ustar0000000000000000{-# 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.Transfer 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.WriteIO) -> [a] -> ByteString raazWrite fn = E.toByteString . mconcat . map fn raaz-0.1.1/LICENSE0000644000000000000000000000276612750426275011666 0ustar0000000000000000Copyright (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. raaz-0.1.1/cbits/raaz/core/endian.h0000644000000000000000000000476213006426545015252 0ustar0000000000000000# pragma once # include /* These are the C functions that are exported for FFI calls to * Haskell. Their definitions are available in endian.c */ extern uint32_t raazSwap32 (uint32_t a); extern uint64_t raazSwap64 (uint64_t a); extern void raazSwap32Array (uint32_t *ptr, int n); extern void raazSwap64Array (uint64_t *ptr, int n); /* This header also give interface to low level byteswap and endian * conversion in a platform agnostic way to both to the Haskell FFI * functions declared above as well as to crypto primitives defined in * other c sources. The should not be used directly for FFI as they * most likely are defined static inline and included with the source. */ #ifndef __GNUC__ #define __RAAZ_REQUIRE_PORTABLE_ENDIAN__ /* We are unable to detect if the compiler is gcc or a compatible * one. So we declare all the low level functions to be extern and * expect their definitions to be in endian.c The above #define line * is used to indicate that we are in such a situation */ extern uint32_t raaz_bswap32(uint32_t x); extern uint64_t raaz_bswap64(uint64_t x); extern uint32_t raaz_tobe32(uint32_t x); extern uint64_t raaz_tobe64(uint64_t x); extern uint32_t raaz_tole32(uint32_t x); extern uint64_t raaz_tole64(uint64_t x); #else /* We are in GCC, so pick up the relevant platform specific functions * and wrap it in a static inline declaration. These */ # ifdef PLATFORM_OSX # include /* For PLATFORM OSX */ static inline uint32_t raaz_bswap32(uint32_t x){ return OSSwapInt32(x); } static inline uint64_t raaz_bswap64(uint64_t x){ return OSSwapInt64(x); } # else /* For other systems */ # include static inline uint32_t raaz_bswap32(uint32_t x){ return bswap_32(x); } static inline uint64_t raaz_bswap64(uint64_t x){ return bswap_64(x); } # endif # if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ static inline uint32_t raaz_tobe32(uint32_t x){ return raaz_bswap32(x); } static inline uint64_t raaz_tobe64(uint64_t x){ return raaz_bswap64(x); } static inline uint32_t raaz_tole32(uint32_t x){ return x; } static inline uint64_t raaz_tole64(uint64_t x){ return x; } # else static inline uint32_t raaz_tobe32(uint32_t x){ return x; } static inline uint64_t raaz_tobe64(uint64_t x){ return x; } static inline uint32_t raaz_tole32(uint32_t x){ return raaz_bswap32(x); } static inline uint64_t raaz_tole64(uint64_t x){ return raaz_bswap64(x); } # endif /* Byte order */ #endif raaz-0.1.1/cbits/raaz/cipher/aes/common.h0000644000000000000000000001036012750426275016372 0ustar0000000000000000#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 raaz-0.1.1/cbits/raaz/cipher/aes/cportable.h0000644000000000000000000000037312750426275017060 0ustar0000000000000000#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); raaz-0.1.1/cbits/raaz/cipher/chacha20/common.h0000644000000000000000000000235313037202101017151 0ustar0000000000000000#pragma once #include #include #include typedef uint32_t Word; typedef Word State[16]; typedef Word Block[16]; /* Implementation in accordance to RFC7539 * https://tools.ietf.org/html/rfc7539 * * Note that there is a difference in the rfc and the version * published by djb. In the rfc one uses 32-bit counter and 96-bit * nounce, whereas the published version of djb uses 64bit counter and * 64bit nounce. * * As a result the maximum data that should be encrypted with this * cipher (for a given key, iv pair). * * 2^32 blocks = 256 GB. * */ typedef uint32_t Counter; typedef Word IV[3]; typedef Word Key[8]; # define BLOCK_SIZE (sizeof(State)) #define C0 ((Word) 0x61707865) #define C1 ((Word) 0x3320646e) #define C2 ((Word) 0x79622d32) #define C3 ((Word) 0x6b206574) /* Vector types */ # ifdef HAVE_VECTOR_128 /* Type of 128-bit SIMD instructions */ typedef Word Vec __attribute__ ((vector_size (16))); # endif # ifdef HAVE_VECTOR_256 /* Type of 256-bit SIMD instructions */ typedef Word Vec2 __attribute__ ((vector_size (32))); # endif # ifdef HAVE_VECTOR_512 /* Type of 512-bit SIMD instructions */ typedef Word Vec4 __attribute__ ((vector_size (64))); # endif raaz-0.1.1/Setup.lhs0000755000000000000000000000011412750426275012455 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain raaz-0.1.1/raaz.cabal0000644000000000000000000002657513055624226012601 0ustar0000000000000000name: raaz version: 0.1.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.10 bug-reports: https://github.com/raaz-crypto/raaz/issues -- List of platform specific source files. extra-source-files: entropy/urandom/Raaz/Entropy.hs entropy/arc4random/Raaz/Entropy.hs source-repository head type: git location: https://github.com/raaz-crypto/raaz ------------------------- Flags ------------------------------------------------------------- flag opt-native Description: Use optimisation for the platform on which it is being built. Do not enable this when cross compiling as it can break the implementation. Also tested only with gcc. Default: False Manual: True flag opt-vectorise Description: Enable vectorisation for gcc. This is not always an optimisation and needs to be benchmarked. Also gains are fairly minimal if you do not use opt-natvive. Default: False Manual: True flag vector128 Description: Make use of vector instructions with size being 128. Do not enable this unless you have reasons to. It is better to use opt-native and opt-vectorise and let gcc have a go at the portable implementation Default: False Manual: True flag vector256 Description: Make use of gcc vector instructions with size being 256. Do not enable this unless you have reasons to. It is better to use opt-native and opt-vectorise and let gcc have a go at the portable implementation. Default: False Manual: True flag vector512 Description: Make use of gcc vector instructions with size being 512. Default: False Manual: True flag avx2 Description: Support avx2 optimisations. Warning: enable only if you are sure of support. Default: False Manual: True ----------------------------- The library ----------------------------------------------------- library default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: . 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.Types , Raaz.Core.Util , Raaz.Core.Transfer -- -- Cryptographic hashes -- , Raaz.Hash , Raaz.Hash.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 , Raaz.Cipher.AES.CBC.Implementation.CPortable , Raaz.Cipher.ChaCha20 , Raaz.Cipher.ChaCha20.Implementation.CPortable -- -- Randomness -- , Raaz.Random other-modules: Raaz.Core.Constants , Raaz.Core.Encode.Internal , Raaz.Core.Encode.Base16 , Raaz.Core.Encode.Base64 , Raaz.Core.Util.ByteString , Raaz.Core.Types.Aligned , Raaz.Core.Types.Pointer , Raaz.Core.Types.Tuple , Raaz.Core.Types.Equality , Raaz.Core.Types.Endian , Raaz.Core.Types.Describe , Raaz.Core.Types.Copying -- -- 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 -- -- Internal modules from cipher -- , Raaz.Cipher.AES.Internal , Raaz.Cipher.AES.Recommendation , Raaz.Cipher.ChaCha20.Internal , Raaz.Cipher.ChaCha20.Recommendation -- -- Internal module for randomness -- , Raaz.Random.ChaCha20PRG , Raaz.Entropy , Paths_raaz build-depends: base >= 4.6 && < 4.11 , bytestring >= 0.9 && < 0.11 , deepseq >= 1.1 && < 1.5 , mtl >= 2.1 && < 2.3 , vector >= 0.7.1 && < 0.13 if impl(ghc < 8) -- 'transformers' needed for "Control.Monad.IO.Class" only -- starting with base-4.9 we don't need 'transformers' anymore build-depends: transformers c-sources: cbits/raaz/core/endian.c -- hash implementations , cbits/raaz/hash/sha1/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 -- chacha20 , cbits/raaz/cipher/chacha20/cportable.c include-dirs: cbits includes: raaz/core/endian.h install-includes: raaz/core/endian.h , cbits/raaz/cipher/aes/common.h , cbits/raaz/cipher/aes/cportable.h , cbits/raaz/cipher/chacha20/common.h --------------------------- Options for vector instructions --------------------------------- if flag(opt-native) cc-options: -march=native if flag(opt-vectorise) cc-options: -ftree-vectorize if flag(vector128) cpp-options: -DHAVE_VECTOR_128 cc-options: -DHAVE_VECTOR_128 exposed-modules: Raaz.Cipher.ChaCha20.Implementation.Vector128 c-sources: cbits/raaz/cipher/chacha20/vector128.c if flag(vector256) cpp-options: -DHAVE_VECTOR_256 cc-options: -DHAVE_VECTOR_256 exposed-modules: Raaz.Cipher.ChaCha20.Implementation.Vector256 c-sources: cbits/raaz/cipher/chacha20/vector256.c if flag(avx2) cpp-options: -DHAVE_VECTOR_256 cc-options: -DHAVE_AVX2 -DHAVE_VECTOR_256 if !flag(opt-native) cc-options: -mavx2 if flag(vector512) cpp-options: -DHAVE_VECTOR_512 cc-options: -DHAVE_VECTOR_512 ----------------------- System specific configurations ---------------------------------- if !os(windows) cpp-options: -DHAVE_MLOCK --------------------- Entropy ---------------------------------------------- if os(openbsd) -- Entropy for openbsd using arc4random hs-source-dirs: entropy/arc4random if !os(openbsd) -- Entropy for generic posix by reading /dev/urandom hs-source-dirs: entropy/urandom if os(osx) -- Endian coversion code is different for osx. cc-options: -DPLATFORM_OSX ---------------------------- Executables ------------------------------------------------- executable raaz default-language: Haskell2010 hs-source-dirs: bin main-is: Main.hs other-modules: Command.Checksum , Command.Rand build-depends: base , raaz == 0.1.1 if impl(ghc < 8) -- 'transformers' needed for "Control.Monad.IO.Class" only -- starting with base-4.9 we don't need 'transformers' anymore build-depends: transformers ---------------------------- Test suit ----------------------------------------------------- test-Suite spec default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: spec main-is: Spec.hs if flag(vector128) cpp-options: -DHAVE_VECTOR_128 if flag(vector256) cpp-options: -DHAVE_VECTOR_256 if flag(vector512) cpp-options: -DHAVE_VECTOR_512 ghc-options: -Wall other-modules: Common , Common.Cipher , Common.Hash , Common.Imports , Common.Instances , Common.Utils , Raaz.Cipher.AESSpec , Raaz.Cipher.ChaCha20Spec , Raaz.Core.EncodeSpec , Raaz.Core.MemorySpec , Raaz.Core.Types.WordSpec , Raaz.Core.Util.ByteStringSpec , Raaz.RandomSpec , Raaz.Hash.Sha1Spec , Raaz.Hash.Sha224Spec , Raaz.Hash.Sha256Spec , Raaz.Hash.Sha384Spec , Raaz.Hash.Sha512Spec , Raaz.Hash.Blake256Spec build-depends: base , bytestring , HUnit >= 1.2 , QuickCheck >= 2.4 , hspec , transformers , raaz == 0.1.1 , vector ---------------------------------------------- Bench marks ----------------------------------------- benchmark blaze-vs-write hs-source-dirs: benchmarks default-language: Haskell2010 main-is: BlazeVsWrite.hs type: exitcode-stdio-1.0 build-depends: base , blaze-builder , bytestring , criterion >= 1.0 , raaz ---------------------------------------------- Cipher implemntation benchmarks ---------------------- benchmark bench-ciphers hs-source-dirs: benchmarks default-language: Haskell2010 if flag(vector128) cpp-options: -DHAVE_VECTOR_128 if flag(vector256) || flag(avx2) cpp-options: -DHAVE_VECTOR_256 if flag(vector512) cpp-options: -DHAVE_VECTOR_512 main-is: Cipher.hs type: exitcode-stdio-1.0 build-depends: base , blaze-builder , bytestring , criterion >= 1.0 , raaz -------------------------------- Benchmarking all primitives -------------------------------- benchmark primitives hs-source-dirs: benchmarks default-language: Haskell2010 if flag(vector128) cpp-options: -DHAVE_VECTOR_128 if flag(vector256) || flag(avx2) cpp-options: -DHAVE_VECTOR_256 if flag(vector512) cpp-options: -DHAVE_VECTOR_512 main-is: BenchPrimitives.hs type: exitcode-stdio-1.0 build-depends: base , blaze-builder , bytestring , criterion >= 1.0 , pretty , raaz raaz-0.1.1/entropy/urandom/Raaz/Entropy.hs0000644000000000000000000000070713043432667016706 0ustar0000000000000000module Raaz.Entropy( getEntropy ) where import Control.Monad.IO.Class( MonadIO, liftIO) import System.IO import Raaz.Core -- | Get random bytes from the system. Do not over use this function -- as it is meant to be used by a PRG. This function reads bytes from -- '/dev/urandom'. getEntropy :: (MonadIO m, LengthUnit l) => l -> Pointer -> m (BYTES Int) getEntropy l ptr = liftIO $ withBinaryFile "/dev/urandom" ReadMode $ \ hand -> hFillBuf hand ptr l raaz-0.1.1/entropy/arc4random/Raaz/Entropy.hs0000644000000000000000000000125713043432667017274 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} module Raaz.Entropy( getEntropy ) where import Control.Monad.IO.Class(MonadIO, liftIO) import Raaz.Core.Types -- | The getrandom system call. foreign import ccall unsafe "arc4random" c_arc4random :: Pointer -- Message -> BYTES Int -- number of bytes -> IO (BYTES Int) -- | Get random bytes from using the @getrandom@ system call on -- linux. This is only used to seed the PRG and not intended for call -- by others. getEntropy :: (MonadIO m, LengthUnit l) => l -> Pointer -> m (BYTES Int) getEntropy l ptr = liftIO $ c_arc4random ptr lenBytes >> return lenBytes where lenBytes = inBytes l