diff --git a/Benchmark/Crypto.hs b/Benchmark/Crypto.hs --- a/Benchmark/Crypto.hs +++ b/Benchmark/Crypto.hs @@ -26,16 +26,19 @@ ( benchmarkHash , benchmarkBlockCipher , benchmarkRNG + , benchmarkCryptoRandomGen ) where import Crypto.Classes import Crypto.Modes (ecb', unEcb') +import Crypto.Random import qualified Data.Serialize as Ser import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Serialize as Ser import Criterion import Control.Monad (liftM) +import Data.IORef -- 128KB strings ps = B.replicate (2^17) 0 @@ -64,5 +67,25 @@ in benchs -- |Benchmark an RNG by requesting 256K of random data -benchmarkRNG :: (Int -> IO L.ByteString) -> String -> Benchmark -benchmarkRNG rng name = bench name (nfIO $ liftM (map B.head . L.toChunks ) (rng (2^18))) +benchmarkRNG :: (Int -> IO B.ByteString) -> String -> Benchmark +benchmarkRNG rng name = bench name (nfIO $ liftM B.head (rng (2^18))) + +-- | Benchmark a CryptoRandomGen by storing it in a IORef, and generating +-- 256k per call. +benchmarkCryptoRandomGen :: CryptoRandomGen g => g -> String -> IO Benchmark +benchmarkCryptoRandomGen g name = do + g' <- useGenIO g + return $ bench name (nfIO $ liftM B.head (g' (2^18))) + +useGenIO :: CryptoRandomGen g => g -> IO (Int -> IO B.ByteString) +useGenIO g = do + gRef <- newIORef g + return $ \i -> do + gen <- readIORef gRef + let v = genBytes i gen + case v of + Left _ -> error "blah" + Right (b,gen') -> do + writeIORef gRef gen' + return b + diff --git a/Crypto/Modes.hs b/Crypto/Modes.hs --- a/Crypto/Modes.hs +++ b/Crypto/Modes.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ScopedTypeVariables, MonoLocalBinds #-} {-| Maintainer: Thomas.DuBuisson@gmail.com Stability: beta @@ -31,9 +30,11 @@ import qualified Data.Serialize.Put as SP import qualified Data.Serialize.Get as SG import Data.Bits (xor) +import Data.Tagged import Crypto.Classes import Crypto.Random import System.Crypto.Random (getEntropy) +import Control.Monad (liftM) -- |Initilization Vectors for BlockCipher implementations (IV k) are used -- for various modes and guarrenteed to be blockSize bits long. @@ -253,7 +254,7 @@ getIV :: (BlockCipher k, CryptoRandomGen g) => g -> Either GenError (IV k, g) getIV g = let bytes = ivBlockSizeBytes iv - gen = genBytes g bytes + gen = genBytes bytes g fromRight (Right x) = x iv = IV (fst . fromRight $ gen) in case gen of @@ -262,25 +263,36 @@ | B.length bs == bytes -> Right (iv, g') | otherwise -> Left (GenErrorOther "Generator failed to provide requested number of bytes") --- |Obtain an `IV` using the system entropy (see "System.Crypto.Random") +-- | Obtain an `IV` using the system entropy (see "System.Crypto.Random") getIVIO :: (BlockCipher k) => IO (IV k) getIVIO = do - let bytes = ivBlockSizeBytes p - p = undefined - bs <- getEntropy bytes - return (IV bs `asTypeOf` p) + let p = Proxy + getTypedIV :: BlockCipher k => Proxy k -> IO (IV k) + getTypedIV pr = liftM IV (getEntropy (proxy blockSize pr `div` 8)) + iv <- getTypedIV p + return (iv `asProxyTypeOf` ivProxy p) +ivProxy :: Proxy k -> Proxy (IV k) +ivProxy = reproxy + +deIVProxy :: Proxy (IV k) -> Proxy k +deIVProxy = reproxy + +proxyOf :: a -> Proxy a +proxyOf = const Proxy + ivBlockSizeBytes :: BlockCipher k => IV k -> Int -ivBlockSizeBytes iv = (blockSize `for` (keyForIV iv)) `div` 8 - where - keyForIV :: IV k -> k - keyForIV _ = undefined +ivBlockSizeBytes iv = + let p = deIVProxy (proxyOf iv) + in proxy blockSize p `div` 8 instance (BlockCipher k) => Serialize (IV k) where get = do - let bytes = blockSize .::. (undefined :: k) `div` 8 - iv <- SG.getByteString bytes - return (IV iv) + let p = Proxy + doGet :: BlockCipher k => Proxy k -> Get (IV k) + doGet pr = liftM IV (SG.getByteString (proxy blockSize pr `div` 8)) + iv <- doGet p + return (iv `asProxyTypeOf` ivProxy p) put (IV iv) = SP.putByteString iv -- TODO: GCM, GMAC diff --git a/Crypto/Random.hs b/Crypto/Random.hs --- a/Crypto/Random.hs +++ b/Crypto/Random.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables, MonoLocalBinds, FlexibleInstances,CPP #-} +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-| Maintainer: Thomas.DuBuisson@gmail.com Stability: beta @@ -21,7 +21,6 @@ module Crypto.Random ( CryptoRandomGen(..) - , genInteger , GenError (..) , newGenIO ) where @@ -43,13 +42,6 @@ | NotEnoughEntropy -- ^ For instantiating new generators (or reseeding) deriving (Eq, Ord, Show) -#if !MIN_VERSION_base(4,3,0) -instance Monad (Either GenError) where - return = Right - (Left x) >>= _ = Left x - (Right x) >>= f = f x -#endif - -- |A class of random bit generators that allows for the possibility of failure, -- reseeding, providing entropy at the same time as requesting bytes -- @@ -62,7 +54,7 @@ genSeedLength :: Tagged g ByteLength -- |Obtain random data using a generator - genBytes :: g -> ByteLength -> Either GenError (B.ByteString, g) + genBytes :: ByteLength -> g -> Either GenError (B.ByteString, g) -- |@genBytesWithEntropy g i entropy@ generates @i@ random bytes and use the -- additional input @entropy@ in the generation of the requested data to @@ -73,9 +65,9 @@ -- @ -- genBytesWithEntropy g bytes entropy = xor entropy (genBytes g bytes) -- @ - genBytesWithEntropy :: g -> ByteLength -> B.ByteString -> Either GenError (B.ByteString, g) - genBytesWithEntropy g len entropy = - let res = genBytes g len + genBytesWithEntropy :: ByteLength -> B.ByteString -> g -> Either GenError (B.ByteString, g) + genBytesWithEntropy len entropy g = + let res = genBytes len g in case res of Left err -> Left err Right (bs,g') -> @@ -83,54 +75,25 @@ in Right (zwp' entropy' bs, g') -- |reseed the generator - reseed :: g -> B.ByteString -> Either GenError g + reseed :: B.ByteString -> g -> Either GenError g -- |Use "System.Crypto.Random" to obtain entropy for `newGen`. newGenIO :: CryptoRandomGen g => IO g -newGenIO = do - let r = undefined - l = genSeedLength `for` r - res <- liftM newGen (getEntropy l) +newGenIO = go 0 + where + go 1000 = error "The generator instance requested by newGenIO never instantiates (1000 tries). It must be broken." + go i = do + let p = Proxy + getTypedGen :: (CryptoRandomGen g) => Proxy g -> IO (Either GenError g) + getTypedGen pr = liftM newGen (getEntropy $ proxy genSeedLength pr) + res <- getTypedGen p case res of - Left _ -> newGenIO - Right g -> return (g `asTypeOf` r) + Left _ -> go (i+1) + Right g -> return (g `asProxyTypeOf` p) -- |Obtain a tagged value for a particular instantiated type. for :: Tagged a b -> a -> b for t _ = unTagged t - --- |@genInteger g (low,high)@ will generate an integer between [low, high] inclusively, swapping the pair if high < low. --- --- This function has degraded (theoretically unbounded, probabilitically decent) performance --- the closer your range size (high - low) is to 2^n (from the top). -genInteger :: CryptoRandomGen g => g -> (Integer, Integer) -> Either GenError (Integer, g) -genInteger g (low,high) - | high < low = genInteger g (high,low) - | high == low = Right (high, g) - | otherwise = go g - where - mask = foldl' setBit 0 [0 .. fromIntegral nrBits - 1] - nrBits = base2Log range - range = high - low - nrBytes = (nrBits + 7) `div` 8 - go gen = - let offset = genBytes gen (fromIntegral nrBytes) - in case offset of - Left err -> Left err - Right (bs,g') -> - if nrBytes > fromIntegral (maxBound :: Int) - then Left RangeInvalid - else let res = low + (bs2i bs .&. mask) - in if res > high then go g' else Right (res, g') - -base2Log :: Integer -> Integer -base2Log i - | i >= setBit 0 64 = 64 + base2Log (i `shiftR` 64) - | i >= setBit 0 32 = 32 + base2Log (i `shiftR` 32) - | i >= setBit 0 16 = 16 + base2Log (i `shiftR` 16) - | i >= setBit 0 8 = 8 + base2Log (i `shiftR` 8) - | i >= setBit 0 0 = 1 + base2Log (i `shiftR` 1) - | otherwise = 0 bs2i :: B.ByteString -> Integer bs2i bs = B.foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 bs diff --git a/Test/ParseNistKATs.hs b/Test/ParseNistKATs.hs --- a/Test/ParseNistKATs.hs +++ b/Test/ParseNistKATs.hs @@ -35,7 +35,6 @@ module Test.ParseNistKATs ( parseCategories --, parseCategory, parseProperty , Properties, Record, NistTest, TypedTest, TestCategory - , -- module Text.Parsec ) where import Data.Char (isSpace) diff --git a/crypto-api.cabal b/crypto-api.cabal --- a/crypto-api.cabal +++ b/crypto-api.cabal @@ -1,5 +1,5 @@ name: crypto-api -version: 0.1.2.4 +version: 0.2 license: BSD3 license-file: LICENSE copyright: Thomas DuBuisson , Dominic Steinitz (see Data.LargeWord module) @@ -27,17 +27,18 @@ build-type: Simple cabal-version: >= 1.6 tested-with: GHC == 6.12.1 -Data-Files: - Test/KAT_AES/*.txt - , Test/KAT_SHA/*.txt - , Test/KAT_HMAC/*.txt - , Test/KAT_TWOFISH/*.TXT +data-files: + Test/KAT_AES/*.txt + , Test/KAT_SHA/*.txt + , Test/KAT_HMAC/*.txt + , Test/KAT_TWOFISH/*.TXT extra-source-files: - Test/KAT_AES/*.txt - , Test/KAT_SHA/*.txt - , Test/KAT_HMAC/*.txt - , Test/KAT_TWOFISH/*.TXT + Test/KAT_AES/*.txt + , Test/KAT_SHA/*.txt + , Test/KAT_HMAC/*.txt + , Test/KAT_TWOFISH/*.TXT + flag tests description: Include Test.Crypto module for testing hash and cipher instances default: False @@ -46,12 +47,13 @@ description: Include benchmarking tools for cryptographic operations default: False + Library Build-Depends: base == 4.*, bytestring >= 0.9 && < 0.10, cereal >= 0.2 && < 0.4, tagged == 0.1.*, - filepath >= 1.1 && < 1.2 + filepath >= 1.1 && < 1.3 ghc-options: -O2 hs-source-dirs: exposed-modules: Crypto.Classes, Crypto.Types, Crypto.HMAC, Data.LargeWord, Crypto.Modes, System.Crypto.Random, Crypto.Random, Crypto.Padding @@ -60,12 +62,11 @@ extra-libraries: advapi32 if flag(tests) exposed-modules: Test.Crypto, Test.AES, Test.SHA, Test.HMAC, Test.ParseNistKATs, Test.TwoFish - build-depends: QuickCheck >= 2.3 && < 2.4, directory >= 1.0.1.0 && < 1.1 + build-depends: QuickCheck >= 2.3 && < 2.4, directory >= 1.0.1.0 && < 1.2 other-modules: Paths_crypto_api if flag(benchmarks) exposed-modules: Benchmark.Crypto - build-depends: criterion >= 0.5 - + build-depends: criterion >= 0.5, deepseq source-repository head type: darcs location: http://code.haskell.org/crypto-api