diff --git a/Crypto/Random.hs b/Crypto/Random.hs --- a/Crypto/Random.hs +++ b/Crypto/Random.hs @@ -9,6 +9,7 @@ -- random generator. -- {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE DeriveDataTypeable #-} module Crypto.Random ( -- * Entropy @@ -28,6 +29,7 @@ import Crypto.Random.Entropy import Crypto.Random.Generator import Data.ByteString (ByteString) +import Data.Typeable (Typeable) import qualified Data.ByteString.Internal as B (unsafeCreate) -- | System entropy generator. @@ -39,6 +41,7 @@ -- use for testing and debugging purpose, but otherwise for real world use case -- should be fine. data SystemRNG = SystemRNG EntropyPool + deriving Typeable instance CPRG SystemRNG where cprgCreate entPool = SystemRNG entPool diff --git a/Crypto/Random/Entropy.hs b/Crypto/Random/Entropy.hs --- a/Crypto/Random/Entropy.hs +++ b/Crypto/Random/Entropy.hs @@ -7,6 +7,7 @@ -- {-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE DeriveDataTypeable #-} module Crypto.Random.Entropy ( EntropyPool , createEntropyPool @@ -21,6 +22,7 @@ import System.IO.Unsafe (unsafePerformIO) import Data.Maybe (catMaybes) import Data.SecureMem +import Data.Typeable (Typeable) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B @@ -80,6 +82,7 @@ -- | Pool of Entropy. contains a self mutating pool of entropy, -- that is always guarantee to contains data. data EntropyPool = EntropyPool [EntropyBackend] (MVar Int) SecureMem + deriving Typeable -- size of entropy pool by default defaultPoolSize :: Int @@ -87,7 +90,7 @@ -- | Create a new entropy pool of a specific size -- --- While you can create as many entropy pool as you want, the pool can be shared between multiples RNGs. +-- You can create as many entropy pools as you want, and a given pool can be shared between multiples RNGs. createEntropyPoolWith :: Int -> [EntropyBackend] -> IO EntropyPool createEntropyPoolWith poolSize backends = do when (null backends) $ fail "cannot get any source of entropy on this system" diff --git a/Crypto/Random/Entropy/Windows.hs b/Crypto/Random/Entropy/Windows.hs --- a/Crypto/Random/Entropy/Windows.hs +++ b/Crypto/Random/Entropy/Windows.hs @@ -8,31 +8,23 @@ -- code originally from the entropy package and thus is: -- Copyright (c) Thomas DuBuisson. -- -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CPP, ForeignFunctionInterface #-} module Crypto.Random.Entropy.Windows ( WinCryptoAPI ) where import Data.Int (Int32) -import Data.Word (Word32, Word8) +import Data.Word (Word8, Word32, Word64) 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) +import System.Win32.Types (getLastError) import Crypto.Random.Entropy.Source --- Define the constants we need from WinCrypt.h -msDefProv :: String -msDefProv = "Microsoft Base Cryptographic Provider v1.0" -provRSAFull :: Word32 -provRSAFull = 1 - -cryptVerifyContext :: Word32 -cryptVerifyContext = 0xF0000000 - -- | handle to windows crypto API for random generation data WinCryptoAPI = WinCryptoAPI @@ -43,26 +35,52 @@ entropyGather WinCryptoAPI ptr n = do mctx <- cryptAcquireCtx case mctx of - Nothing -> error "cannot re-grab win crypto api" + Nothing -> do + lastError <- getLastError + fail $ "cannot re-grab win crypto api: error " ++ show lastError Just ctx -> do r <- cryptGenRandom ctx ptr n cryptReleaseCtx ctx return r entropyClose WinCryptoAPI = return () + +type DWORD = Word32 +type BOOL = Int32 +type BYTE = Word8 + +#if defined(ARCH_X86) +# define WINDOWS_CCONV stdcall type CryptCtx = Word32 +#elif defined(ARCH_X86_64) +# define WINDOWS_CCONV ccall +type CryptCtx = Word64 +#else +# error Unknown mingw32 arch +#endif --- Declare the required CryptoAPI imports -foreign import stdcall unsafe "CryptAcquireContextA" - c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO CryptCtx -foreign import stdcall unsafe "CryptGenRandom" - c_cryptGenRandom :: CryptCtx -> Word32 -> Ptr Word8 -> IO Int32 -foreign import stdcall unsafe "CryptReleaseContext" - c_cryptReleaseCtx :: CryptCtx -> Word32 -> IO Int32 +-- Declare the required CryptoAPI imports +foreign import WINDOWS_CCONV unsafe "CryptAcquireContextA" + c_cryptAcquireCtx :: Ptr CryptCtx -> CString -> CString -> DWORD -> DWORD -> IO BOOL +foreign import WINDOWS_CCONV unsafe "CryptGenRandom" + c_cryptGenRandom :: CryptCtx -> DWORD -> Ptr BYTE -> IO BOOL +foreign import WINDOWS_CCONV unsafe "CryptReleaseContext" + c_cryptReleaseCtx :: CryptCtx -> DWORD -> IO BOOL + +-- Define the constants we need from WinCrypt.h +msDefProv :: String +msDefProv = "Microsoft Base Cryptographic Provider v1.0" + +provRSAFull :: DWORD +provRSAFull = 1 + +cryptVerifyContext :: DWORD +cryptVerifyContext = 0xF0000000 + cryptAcquireCtx :: IO (Maybe CryptCtx) -cryptAcquireCtx = - alloca $ \handlePtr -> +cryptAcquireCtx = + alloca $ \handlePtr -> withCString msDefProv $ \provName -> do r <- toBool `fmap` c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext if r @@ -79,4 +97,6 @@ success <- toBool `fmap` c_cryptReleaseCtx h 0 if success then return () - else fail "cryptReleaseCtx" + else do + lastError <- getLastError + fail $ "cryptReleaseCtx: error " ++ show lastError diff --git a/Crypto/Random/Test.hs b/Crypto/Random/Test.hs --- a/Crypto/Random/Test.hs +++ b/Crypto/Random/Test.hs @@ -7,6 +7,8 @@ -- -- Provide way to test usual simple statisticals test for randomness -- +{-# LANGUAGE GADTs #-} + module Crypto.Random.Test ( RandomTestState , RandomTestResult(..) @@ -50,6 +52,7 @@ let (b1,b2) = L.splitAt monteN bs mapM_ (addVec 1 . fromIntegral) $ L.unpack b1 loop b2 + addVec :: Word64 -> Int -> IO () addVec a i = M.read buckets i >>= \d -> M.write buckets i $! d+a -- | Finalize random test state into some result diff --git a/crypto-random.cabal b/crypto-random.cabal --- a/crypto-random.cabal +++ b/crypto-random.cabal @@ -1,5 +1,5 @@ Name: crypto-random -Version: 0.0.7 +Version: 0.0.9 Description: Simple cryptographic random related types License: BSD3 License-file: LICENSE @@ -32,7 +32,12 @@ else Build-Depends: unix Other-modules: Crypto.Random.Entropy.Unix - + + if arch(i386) + cpp-options: -DARCH_X86 + if arch(x86_64) + cpp-options: -DARCH_X86_64 + if arch(x86_64) cpp-options: -DSUPPORT_RDRAND Other-modules: Crypto.Random.Entropy.RDRand