Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Move to using entropy package. Remove optimization till GHC mem usage…

… becomes better.

Ignore-this: 1d308a1b79fc32f657ec71cc8d59b5d2

darcs-hash:20110826211159-cef97-330b5ea282b1b69045df325d1f012fd5a0cf1303.gz
  • Loading branch information...
commit f75779ad26c0c6cdaf3a5fe55b990a2075bb43de 1 parent 6beed7f
@TomMD authored
View
10 Crypto/Classes.hs
@@ -44,7 +44,7 @@ import Data.Word (Word64)
import Data.Tagged
import Crypto.Types
import Crypto.Random
-import System.Crypto.Random
+import System.Entropy
-- |The Hash class is intended as the generic interface
-- targeted by maintainers of Haskell digest implementations.
@@ -80,14 +80,18 @@ hash' msg = res
remlen = B.length msg - (B.length msg `rem` bLen)
bLen = blockLength `for` res `div` 8
--- |Obtain a lazy hash function from a digest
+-- |Obtain a lazy hash function whose result is the same type
+-- as the given digest, which is discarded. If the type is already inferred then
+-- consider using the 'hash' function instead.
hashFunc :: Hash c d => d -> (L.ByteString -> d)
hashFunc d = f
where
f = hash
a = f undefined `asTypeOf` d
--- |Obtain a strict hash function from a digest
+-- |Obtain a strict hash function whose result is the same type
+-- as the given digest, which is discarded. If the type is already inferred then
+-- consider using the 'hash'' function instead.
hashFunc' :: Hash c d => d -> (B.ByteString -> d)
hashFunc' d = f
where
View
2  Crypto/Modes.hs
@@ -45,7 +45,7 @@ import Crypto.Classes
import Crypto.Random
import Crypto.Util
import Crypto.CPoly
-import System.Crypto.Random (getEntropy)
+import System.Entropy (getEntropy)
import Control.Monad (liftM, forM_)
import Data.List (genericDrop)
import Data.Word (Word8)
View
91 Crypto/Random.hs
@@ -22,38 +22,48 @@ use case of using the system random number generator
-}
module Crypto.Random
- ( -- * Basic Interface
- CryptoRandomGen(..)
- , GenError (..)
- -- * Helper functions and expanded interface
- , splitGen
- -- * Instances
- , SystemRandom
- ) where
-
-import System.Crypto.Random
-import Crypto.Types
+ ( -- * Basic Interface
+ CryptoRandomGen(..)
+ , GenError (..)
+ -- * Helper functions and expanded interface
+ , splitGen
+ -- * Instances
+ , SystemRandom
+ ) where
+
import Control.Monad (liftM)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-import Data.Tagged
+import Crypto.Types
import Data.Bits (xor, setBit, shiftR, shiftL, (.&.))
import Data.List (foldl')
+import Data.Tagged
+import System.Entropy
import System.IO.Unsafe(unsafeInterleaveIO)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
import qualified Foreign.ForeignPtr as FP
#if MIN_VERSION_tagged(0,2,0)
import Data.Proxy
#endif
--- |many generators have these error conditions in common
+-- |Generator failures should always return the appropriate GenError.
data GenError =
GenErrorOther String -- ^ Misc
- | RequestedTooManyBytes -- ^ Requested more bytes than a single pass can generate (The maximum request is generator dependent)
- | RangeInvalid -- ^ When using @genInteger g (l,h)@ and @logBase 2 (h - l) > (maxBound :: Int)@.
- | NeedReseed -- ^ Some generators cease operation after too high a count without a reseed (ex: NIST SP 800-90)
- | NotEnoughEntropy -- ^ For instantiating new generators (or reseeding)
- | NeedsInfiniteSeed -- ^ This generator can not be instantiated or reseeded with a finite seed (ex: 'SystemRandom')
+ | RequestedTooManyBytes -- ^ Requested more bytes than a
+ -- single pass can generate (The
+ -- maximum request is generator
+ -- dependent)
+ | RangeInvalid -- ^ When using @genInteger g (l,h)@
+ -- and @logBase 2 (h - l) > (maxBound
+ -- :: Int)@.
+ | NeedReseed -- ^ Some generators cease operation
+ -- after too high a count without a
+ -- reseed (ex: NIST SP 800-90)
+ | NotEnoughEntropy -- ^ For instantiating new generators
+ -- (or reseeding)
+ | NeedsInfiniteSeed -- ^ This generator can not be
+ -- instantiated or reseeded with a
+ -- finite seed (ex: 'SystemRandom')
deriving (Eq, Ord, Show)
-- |A class of random bit generators that allows for the possibility
@@ -128,7 +138,9 @@ class CryptoRandomGen g where
newGenIO :: IO g
newGenIO = go 0
where
- go 1000 = error "The generator instance requested by newGenIO never instantiates (1000 tries). It must be broken."
+ 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)
@@ -164,17 +176,18 @@ getSystemGen = do
data SystemRandom = SysRandom L.ByteString
instance CryptoRandomGen SystemRandom where
- newGen _ = Left NeedsInfiniteSeed
- genSeedLength = Tagged maxBound
- genBytes req (SysRandom bs) =
- let reqI = fromIntegral req
- rnd = L.take reqI bs
- rest = L.drop reqI bs
- in if L.length rnd == reqI
- then Right (B.concat $ L.toChunks rnd, SysRandom rest)
- else Left $ GenErrorOther "Error obtaining enough bytes from system random for given request"
- reseed _ _ = Left NeedsInfiniteSeed
- newGenIO = getSystemGen
+ newGen _ = Left NeedsInfiniteSeed
+ genSeedLength = Tagged maxBound
+ genBytes req (SysRandom bs) =
+ let reqI = fromIntegral req
+ rnd = L.take reqI bs
+ rest = L.drop reqI bs
+ in if L.length rnd == reqI
+ then Right (B.concat $ L.toChunks rnd, SysRandom rest)
+ else Left $ GenErrorOther "Error obtaining enough bytes \
+ \from system random for given request"
+ reseed _ _ = Left NeedsInfiniteSeed
+ newGenIO = getSystemGen
-- | While the safety and wisdom of a splitting function depends on the
-- properties of the generator being split, several arguments from
@@ -182,14 +195,14 @@ instance CryptoRandomGen SystemRandom where
-- generators. (see libraries\@haskell.org discussion around Sept, Oct
-- 2010)
splitGen :: CryptoRandomGen g => g -> Either GenError (g,g)
-splitGen g = do
- let e = genBytes (genSeedLength `for` g) g
- case e of
+splitGen g =
+ let e = genBytes (genSeedLength `for` g) g
+ in case e of
+ Left e -> Left e
+ Right (ent,g') ->
+ case newGen ent of
+ Right new -> Right (g',new)
Left e -> Left e
- Right (ent,g') ->
- case newGen ent of
- Right new -> Right (g',new)
- Left e -> Left e
-- |Obtain a tagged value for a particular instantiated type.
for :: Tagged a b -> a -> b
View
148 System/Crypto/Random.hs
@@ -8,149 +8,7 @@
though testing was requested from the community - please e-mail the maintainer with test results.
-}
-module System.Crypto.Random
- ( getEntropy
- , CryptHandle
- , openHandle
- , hGetEntropy
- , closeHandle
- ) where
-
-import System.IO (openFile, hClose, IOMode(..), Handle)
-import Control.Monad (liftM)
-import Data.ByteString as B
-import Data.ByteString.Lazy as L
-import Crypto.Types
-
-#if defined(isWindows)
-{- C example for windows rng - taken from a blog, can't recall which one but thank you!
- #include <Windows.h>
- #include <Wincrypt.h>
- ...
- //
- // DISCLAIMER: Don't forget to check your error codes!!
- // I am not checking as to make the example simple...
- //
- HCRYPTPROV hCryptCtx = NULL;
- BYTE randomArray[128];
-
- CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
- CryptGenRandom(hCryptCtx, 128, randomArray);
- CryptReleaseContext(hCryptCtx, 0);
--}
-
-import Data.ByteString.Internal as B
-import Data.Int (Int32)
-import Data.Word (Word32, Word8)
-import Foreign.C.String (CString, withCString)
-import Foreign.Ptr (Ptr, nullPtr)
-import Foreign.Marshal.Alloc (alloca)
-import Foreign.Marshal.Utils (toBool)
-import Foreign.Storable (peek)
-
-newtype CryptHandle = CH Word32
-
--- Define the constants we need from WinCrypt.h
-msDefProv :: String
-msDefProv = "Microsoft Base Cryptographic Provider v1.0"
-provRSAFull :: Word32
-provRSAFull = fromIntegral 1
-cryptVerifyContext :: Word32
-cryptVerifyContext = fromIntegral 0xF0000000
-
--- Declare the required CryptoAPI imports
-foreign import stdcall unsafe "CryptAcquireContextA"
- c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
-foreign import stdcall unsafe "CryptGenRandom"
- c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
-foreign import stdcall unsafe "CryptReleaseContext"
- c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
-
-cryptAcquireCtx :: IO Word32
-cryptAcquireCtx =
- alloca $ \handlePtr ->
- withCString msDefProv $ \provName -> do
- stat <- c_cryptAcquireCtx handlePtr nullPtr provName (fromIntegral 1) (fromIntegral cryptVerifyContext)
- if (toBool stat)
- then peek handlePtr
- else fail "c_cryptAcquireCtx"
-
-cryptGenRandom :: Word32 -> Int -> IO B.ByteString
-cryptGenRandom h i =
- B.create i $ \c_buffer -> do
- stat <- c_cryptGenRandom (fromIntegral h) (fromIntegral i) c_buffer
- if (toBool stat)
- then return ()
- else fail "c_cryptGenRandom"
-
-cryptReleaseCtx :: Word32 -> IO ()
-cryptReleaseCtx h = do
- stat <- c_cryptReleaseCtx h 0
- if (toBool stat)
- then return ()
- else fail "c_cryptReleaseCtx"
-
--- |Inefficiently get a specific number of bytes of cryptographically
--- secure random data using the system-specific facilities.
---
--- This function will return zero bytes
--- on platforms without a secure RNG!
-getEntropy :: ByteLength -> IO B.ByteString
-getEntropy n = do
- h <- cryptAcquireCtx
- bs <- cryptGenRandom h n
- let !bs' = bs
- cryptReleaseCtx h
- return bs'
-
--- |Open a handle from which random data can be read
-openHandle :: IO CryptHandle
-openHandle = liftM CH cryptAcquireCtx
-
--- |Close the `CryptHandle`
-closeHandle (CH h) = cryptReleaseCtx h
-
--- |Read from `CryptHandle`
-hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
-hGetEntropy (CH h) = cryptGenRandom h
-
-#else
--- |Handle for manual resource mangement
-newtype CryptHandle = CH Handle
-
--- |Open a `CryptHandle`
-openHandle :: IO CryptHandle
-openHandle = liftM CH (openFile "/dev/urandom" ReadMode)
-
--- |Close the `CryptHandle`
-closeHandle :: CryptHandle -> IO ()
-closeHandle (CH h) = hClose h
-
--- |Read random data from a `CryptHandle`
-hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
-hGetEntropy (CH h) = B.hGet h
-
--- |Inefficiently get a specific number of bytes of cryptographically
--- secure random data using the system-specific facilities.
---
--- Use '/dev/urandom' on *nix and CryptAPI when on Windows.
-getEntropy :: ByteLength -> IO B.ByteString
-getEntropy = getEnt "/dev/urandom"
-
--- "getTrueEntropy" was a thought, but if you are so security sensitive as to
--- know you want /dev/random then you should be concerned about
--- the platform you sit on, thus writing non-portable code
--- reading /dev/random yourself is a non-issue.
---
--- getTrueEntropy :: ByteLength -> IO B.ByteString
--- getTrueEntropy = getEnt "/dev/random"
-
-getEnt :: FilePath -> ByteLength -> IO B.ByteString
-getEnt file n = do
- h <- openFile file ReadMode
- bs <- B.hGet h n
- let !bs' = bs
- hClose h
- return bs'
-#endif
+module System.Crypto.Random {-# DEPRECATED "Use the 'entropy' package module System.Entropy instead" #-}
+ (module System.Entropy) where
+import System.Entropy
View
11 crypto-api.cabal
@@ -1,5 +1,5 @@
name: crypto-api
-version: 0.6.2.1
+version: 0.6.4
license: BSD3
license-file: LICENSE
copyright: Thomas DuBuisson <thomas.dubuisson@gmail.com>, Francisco Blas Izquierdo Riera (klondike) (see AUTHORS)
@@ -53,14 +53,11 @@ Library
bytestring >= 0.9 && < 0.10,
cereal >= 0.2 && < 0.4,
tagged >= 0.1 && < 0.3,
- largeword >= 1.0.0, array
- ghc-options: -O2
+ largeword >= 1.0.0, array, entropy
+ ghc-options:
hs-source-dirs:
- exposed-modules: Crypto.Classes, Crypto.Types, Crypto.HMAC, Crypto.Modes, System.Crypto.Random, Crypto.Random, Crypto.Padding
+ exposed-modules: Crypto.Classes, Crypto.Types, Crypto.HMAC, Crypto.Modes, Crypto.Random, Crypto.Padding, System.Crypto.Random
other-modules: Crypto.Util, Crypto.CPoly
- if os(windows)
- cpp-options: -DisWindows
- 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.2, filepath
Please sign in to comment.
Something went wrong with that request. Please try again.