crypto-random-0.0.9/0000755000000000000000000000000012502300330012470 5ustar0000000000000000crypto-random-0.0.9/crypto-random.cabal0000644000000000000000000000303612502300330016254 0ustar0000000000000000Name: crypto-random Version: 0.0.9 Description: Simple cryptographic random related types License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: Vincent Hanquez Synopsis: Simple cryptographic random related types Category: Cryptography Build-Type: Simple Homepage: http://github.com/vincenthz/hs-crypto-random Cabal-Version: >=1.6 Library Build-depends: base >= 4 && < 5 , bytestring , securemem , vector Exposed-modules: Crypto.Random , Crypto.Random.Test , Crypto.Random.API Other-modules: Crypto.Random.Generator , Crypto.Random.Entropy , Crypto.Random.Entropy.Source ghc-options: -Wall if os(windows) cpp-options: -DWINDOWS Build-Depends: Win32 Other-modules: Crypto.Random.Entropy.Windows extra-libraries: advapi32 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 c-sources: cbits/rdrand.c source-repository head type: git location: git://github.com/vincenthz/hs-crypto-random subdir: types crypto-random-0.0.9/LICENSE0000644000000000000000000000272412502300330013502 0ustar0000000000000000Copyright (c) 2013 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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. crypto-random-0.0.9/Setup.hs0000644000000000000000000000005612502300330014125 0ustar0000000000000000import Distribution.Simple main = defaultMain crypto-random-0.0.9/cbits/0000755000000000000000000000000012502300330013574 5ustar0000000000000000crypto-random-0.0.9/cbits/rdrand.c0000644000000000000000000000627112502300330015220 0ustar0000000000000000/* * Copyright (C) Thomas DuBuisson * Copyright (C) 2013 Vincent Hanquez * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. 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. * 3. Neither the name of the author nor the names of his contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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. */ #include #include #include #include int crypto_random_cpu_has_rdrand() { uint32_t ax,bx,cx,dx,func=1; __asm__ volatile ("cpuid": "=a" (ax), "=b" (bx), "=c" (cx), "=d" (dx) : "a" (func)); return (cx & 0x40000000); } /* sadly many people are still using an old binutils, * leading to report that instruction is not recognized. */ #if 0 /* Returns 1 on success */ static inline int crypto_random_rdrand64_step(uint64_t *buffer) { unsigned char err; asm volatile ("rdrand %0; setc %1" : "=r" (*buffer), "=qm" (err)); return (int) err; } #endif /* inline encoding of 'rdrand %rax' to cover old binutils * - no inputs * - 'cc' to the clobber list as we modify condition code. * - output of rdrand in rax and have a 8 bit error condition */ #define inline_rdrand_rax(val, err) \ asm(".byte 0x48,0x0f,0xc7,0xf0; setc %1" \ : "=a" (val), "=q" (err) \ : \ : "cc") /* Returns the number of bytes succesfully generated */ int crypto_random_get_rand_bytes(uint8_t *buffer, size_t len) { uint64_t tmp; int aligned = (unsigned long) buffer % 8; int orig_len = len; int to_alignment = 8 - aligned; uint8_t ok; if (aligned != 0) { inline_rdrand_rax(tmp, ok); if (!ok) return 0; memcpy(buffer, (uint8_t *) &tmp, to_alignment); buffer += to_alignment; len -= to_alignment; } for (; len >= 8; buffer += 8, len -= 8) { inline_rdrand_rax(tmp, ok); if (!ok) return (orig_len - len); *((uint64_t *) buffer) = tmp; } if (len > 0) { inline_rdrand_rax(tmp, ok); if (!ok) return (orig_len - len); memcpy(buffer, (uint8_t *) &tmp, len); } return orig_len; } crypto-random-0.0.9/Crypto/0000755000000000000000000000000012502300330013750 5ustar0000000000000000crypto-random-0.0.9/Crypto/Random.hs0000644000000000000000000000374512502300330015535 0ustar0000000000000000-- | -- Module : Crypto.Random -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- -- Provide a safe abstraction for cryptographic pseudo -- random generator. -- {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE DeriveDataTypeable #-} module Crypto.Random ( -- * Entropy EntropyPool , createEntropyPool , grabEntropy , grabEntropyIO -- * Random generation , CPRG(..) , withRandomBytes -- * System generator , SystemRNG -- * Testing and mocking , createTestEntropyPool ) where 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. -- -- This generator doesn't use the entropy reseed level, as the only bytes -- generated are comping from the entropy pool already. -- -- This generator doesn't create reproducible output, and might be difficult to -- 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 cprgSetReseedThreshold _ r = r cprgFork r@(SystemRNG entPool) = (r, cprgCreate entPool) cprgGenerate n g@(SystemRNG entPool) = (B.unsafeCreate n (grabEntropyPtr n entPool), g) -- we don't need to do anything different when generating withEntropy, as the generated -- bytes are already stricly entropy bytes. cprgGenerateWithEntropy n g = cprgGenerate n g -- | generate @len random bytes and mapped the bytes to the function @f. -- -- This is equivalent to use Control.Arrow 'first' with 'cprgGenerate' withRandomBytes :: CPRG g => g -> Int -> (ByteString -> a) -> (a, g) withRandomBytes rng len f = (f bs, rng') where (bs, rng') = cprgGenerate len rng crypto-random-0.0.9/Crypto/Random/0000755000000000000000000000000012502300330015170 5ustar0000000000000000crypto-random-0.0.9/Crypto/Random/API.hs0000644000000000000000000000377512502300330016151 0ustar0000000000000000-- | -- Module : Crypto.Random.API -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- -- Deprecated interface for compatibility of crypto-random-api user -- with crypto-random -- module Crypto.Random.API ( CPRG(..) , cprgGenBytes , genRandomBytes , genRandomBytes' , withRandomBytes ) where import Data.ByteString (ByteString) import Crypto.Random -- | Generate bytes using the CPRG and the number specified. -- -- For user of the API, it's recommended to use genRandomBytes -- instead of this method directly. the CPRG need to be able -- to supply at minimum 2^20 bytes at a time. cprgGenBytes :: CPRG g => Int -> g -> (ByteString, g) cprgGenBytes n cprg = cprgGenerate n cprg -- | Generate bytes using the cprg in parameter. -- -- If the number of bytes requested is really high, -- it's preferable to use 'genRandomBytes' for better memory efficiency. {-# DEPRECATED genRandomBytes "use cprgGenerate from Crypto.Random instead" #-} genRandomBytes :: CPRG g => Int -- ^ number of bytes to return -> g -- ^ CPRG to use -> (ByteString, g) genRandomBytes n cprg = cprgGenerate n cprg -- | Generate bytes using the cprg in parameter. -- -- This is not tail recursive and an excessive len (>= 2^29) parameter would -- result in stack overflow. genRandomBytes' :: CPRG g => Int -- ^ number of bytes to return -> g -- ^ CPRG to use -> ([ByteString], g) genRandomBytes' len rng | len < 0 = error "genBytes: cannot request negative amount of bytes." | otherwise = loop rng len where loop g n | n == 0 = ([], g) | otherwise = let itBytes = min (2^(20:: Int)) n (bs, g') = cprgGenBytes itBytes g (l, g'') = genRandomBytes' (n-itBytes) g' in (bs:l, g'') crypto-random-0.0.9/Crypto/Random/Entropy.hs0000644000000000000000000001365412502300330017175 0ustar0000000000000000-- | -- Module : Crypto.Random.Entropy -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- {-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE DeriveDataTypeable #-} module Crypto.Random.Entropy ( EntropyPool , createEntropyPool , createTestEntropyPool , grabEntropyPtr , grabEntropy , grabEntropyIO ) where import Control.Monad (when) import Control.Concurrent.MVar 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 import Data.Word (Word8) import Foreign.Marshal.Utils (copyBytes) import Foreign.Ptr (plusPtr, Ptr) import Foreign.ForeignPtr (withForeignPtr) import Crypto.Random.Entropy.Source #ifdef SUPPORT_RDRAND import Crypto.Random.Entropy.RDRand #endif #ifdef WINDOWS import Crypto.Random.Entropy.Windows #else import Crypto.Random.Entropy.Unix #endif supportedBackends :: [IO (Maybe EntropyBackend)] supportedBackends = [ #ifdef SUPPORT_RDRAND openBackend (undefined :: RDRand), #endif #ifdef WINDOWS openBackend (undefined :: WinCryptoAPI) #else openBackend (undefined :: DevRandom), openBackend (undefined :: DevURandom) #endif ] data EntropyBackend = forall b . EntropySource b => EntropyBackend b newtype TestEntropySource = TestEntropySource ByteString instance EntropySource TestEntropySource where entropyOpen = return Nothing entropyGather (TestEntropySource bs) dst n | len == 1 = B.memset dst (B.index bs 0) (fromIntegral n) >> return n | otherwise = do withForeignPtr fptr $ \ptr -> loop dst (ptr `plusPtr` o) n return n where (B.PS fptr o len) = bs loop d s i | i == 0 = return () | i <= len = B.memcpy d s (fromIntegral i) | otherwise = B.memcpy d s (fromIntegral len) >> loop (d `plusPtr` len) s (i-len) entropyClose _ = return () openBackend :: EntropySource b => b -> IO (Maybe EntropyBackend) openBackend b = fmap EntropyBackend `fmap` callOpen b where callOpen :: EntropySource b => b -> IO (Maybe b) callOpen _ = entropyOpen gatherBackend :: EntropyBackend -> Ptr Word8 -> Int -> IO Int gatherBackend (EntropyBackend backend) ptr n = entropyGather backend ptr n -- | 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 defaultPoolSize = 4096 -- | Create a new entropy pool of a specific size -- -- 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" sm <- allocateSecureMem poolSize m <- newMVar 0 withSecureMemPtr sm $ replenish poolSize backends return $ EntropyPool backends m sm -- | Create a new entropy pool with a default size. -- -- While you can create as many entropy pool as you want, the pool can be shared between multiples RNGs. createEntropyPool :: IO EntropyPool createEntropyPool = do backends <- catMaybes `fmap` sequence supportedBackends createEntropyPoolWith defaultPoolSize backends -- | Create a dummy entropy pool that is deterministic, and -- dependant on the input bytestring only. -- -- This is stricly reserved for testing purpose when a deterministic seed need -- to be generated with deterministic RNGs. -- -- Do not use in production code. createTestEntropyPool :: ByteString -> EntropyPool createTestEntropyPool bs | B.null bs = error "cannot create entropy pool from an empty bytestring" | otherwise = unsafePerformIO $ createEntropyPoolWith defaultPoolSize [EntropyBackend $ TestEntropySource bs] -- | Put a chunk of the entropy pool into a buffer grabEntropyPtr :: Int -> EntropyPool -> Ptr Word8 -> IO () grabEntropyPtr n (EntropyPool backends posM sm) outPtr = withSecureMemPtr sm $ \entropyPoolPtr -> modifyMVar_ posM $ \pos -> copyLoop outPtr entropyPoolPtr pos n where poolSize = secureMemGetSize sm copyLoop d s pos left | left == 0 = return pos | otherwise = do wrappedPos <- if pos == poolSize then replenish poolSize backends s >> return 0 else return pos let m = min (poolSize - wrappedPos) left copyBytes d (s `plusPtr` wrappedPos) m copyLoop (d `plusPtr` m) s (wrappedPos + m) (left - m) -- | Grab a chunk of entropy from the entropy pool. grabEntropyIO :: Int -> EntropyPool -> IO SecureMem grabEntropyIO n pool = do out <- allocateSecureMem n withSecureMemPtr out $ grabEntropyPtr n pool return $ out -- | Grab a chunk of entropy from the entropy pool. -- -- Great care need to be taken here when using the output, -- as this use unsafePerformIO to actually get entropy. -- -- Use grabEntropyIO if unsure. {-# NOINLINE grabEntropy #-} grabEntropy :: Int -> EntropyPool -> SecureMem grabEntropy n pool = unsafePerformIO $ grabEntropyIO n pool replenish :: Int -> [EntropyBackend] -> Ptr Word8 -> IO () replenish poolSize backends ptr = loop 0 backends ptr poolSize where loop :: Int -> [EntropyBackend] -> Ptr Word8 -> Int -> IO () loop retry [] p n | n == 0 = return () | retry == 3 = error "cannot fully replenish" | otherwise = loop (retry+1) backends p n loop _ (_:_) _ 0 = return () loop retry (b:bs) p n = do r <- gatherBackend b p n loop retry bs (p `plusPtr` r) (n - r) crypto-random-0.0.9/Crypto/Random/Generator.hs0000644000000000000000000000366512502300330017464 0ustar0000000000000000-- | -- Module : Crypto.Random.Generator -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- module Crypto.Random.Generator ( CPRG(..) ) where import Data.ByteString (ByteString) import Crypto.Random.Entropy (EntropyPool) -- | Cryptographic Pseudo Random Generator class CPRG gen where -- | Create a new CPRG using an object of the CryptoGenerator class -- and with an explicit reference to an EntropyPool. cprgCreate :: EntropyPool -> gen -- | Give the ability to set a threshold of byte generated that after -- being exceeded will result in a reseed with some stateful entropy -- after a call to 'cprgGenerate' -- -- If this threshold is exceeded during the set operation, the -- rng should be reseeded here. -- -- If this value is set to 0, no reseeding will be done and the -- output will be completely predicable. This is not a recommended -- level except for debugging and testing purpose. cprgSetReseedThreshold :: Int -> gen -> gen -- | Fork a CPRG into a new independent CPRG. -- -- As entropy is mixed to generate safely a new generator, -- 2 calls with the same CPRG will not produce the same output. cprgFork :: gen -> (gen, gen) -- | Generate a number of bytes using the CPRG. -- -- Given one CPRG, the generated bytes will always be the same. -- -- However the returned CPRG might have been reseeded with entropy bits, -- so 2 calls with the same CPRG will not necessarily result in the same next CPRG. cprgGenerate :: Int -> gen -> (ByteString, gen) -- | Similar to cprgGenerate except that the random data is mixed with pure entropy, -- so the result is not reproducible after use, but it provides more guarantee, -- theorically speaking, in term of the randomness generated. cprgGenerateWithEntropy :: Int -> gen -> (ByteString, gen) crypto-random-0.0.9/Crypto/Random/Test.hs0000644000000000000000000000625412502300330016452 0ustar0000000000000000-- | -- Module : Crypto.Random.Test -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- -- Provide way to test usual simple statisticals test for randomness -- {-# LANGUAGE GADTs #-} module Crypto.Random.Test ( RandomTestState , RandomTestResult(..) , randomTestInitialize , randomTestAppend , randomTestFinalize ) where import Data.Word import Data.Int (Int64) import qualified Data.ByteString.Lazy as L import Control.Applicative import Data.List (foldl') import qualified Data.Vector.Mutable as M import qualified Data.Vector as V -- | Randomness various result relative to random bytes data RandomTestResult = RandomTestResult { res_totalChars :: Word64 -- ^ Total number of characters , res_entropy :: Double -- ^ Entropy per byte , res_chi_square :: Double -- ^ Chi Square , res_mean :: Double -- ^ Arithmetic Mean , res_compressionPercent :: Double -- ^ Theorical Compression percent , res_probs :: [Double] -- ^ Probability of every bucket } deriving (Show,Eq) -- | Mutable random test State newtype RandomTestState = RandomTestState (M.IOVector Word64) -- | Initialize new state to run tests randomTestInitialize :: IO RandomTestState randomTestInitialize = RandomTestState <$> M.replicate 256 0 -- | Append random data to the test state randomTestAppend :: RandomTestState -> L.ByteString -> IO () randomTestAppend (RandomTestState buckets) = loop where loop bs | L.null bs = return () | otherwise = do 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 randomTestFinalize :: RandomTestState -> IO RandomTestResult randomTestFinalize (RandomTestState buckets) = (calculate . V.toList) `fmap` V.freeze buckets monteN :: Int64 monteN = 6 calculate :: [Word64] -> RandomTestResult calculate buckets = RandomTestResult { res_totalChars = totalChars , res_entropy = entropy , res_chi_square = chisq , res_mean = fromIntegral datasum / fromIntegral totalChars , res_compressionPercent = 100.0 * (8 - entropy) / 8.0 , res_probs = probs } where totalChars = sum buckets probs = map (\v -> fromIntegral v / fromIntegral totalChars :: Double) buckets entropy = foldl' accEnt 0.0 probs cexp = fromIntegral totalChars / 256.0 :: Double (datasum, chisq) = foldl' accMeanChi (0, 0.0) [0..255] --chip' = abs (sqrt (2.0 * chisq) - sqrt (2.0 * 255.0 - 1.0)) accEnt ent pr | pr > 0.0 = ent + (pr * xlog (1 / pr)) | otherwise = ent xlog v = logBase 10 v * (log 10 / log 2) accMeanChi :: (Word64, Double) -> Int -> (Word64, Double) accMeanChi (dataSum, chiSq) i = let ccount = buckets !! i a = fromIntegral ccount - cexp in (dataSum + fromIntegral i * ccount, chiSq + (a * a / cexp)) crypto-random-0.0.9/Crypto/Random/Entropy/0000755000000000000000000000000012502300330016630 5ustar0000000000000000crypto-random-0.0.9/Crypto/Random/Entropy/RDRand.hs0000644000000000000000000000207612502300330020303 0ustar0000000000000000-- | -- Module : Crypto.Random.Entropy.RDRand -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- {-# LANGUAGE ForeignFunctionInterface #-} module Crypto.Random.Entropy.RDRand ( RDRand ) where import Foreign.Ptr import Foreign.C.Types import Data.Word (Word8) import Crypto.Random.Entropy.Source foreign import ccall unsafe "crypto_random_cpu_has_rdrand" c_cpu_has_rdrand :: IO CInt foreign import ccall unsafe "crypto_random_get_rand_bytes" c_get_rand_bytes :: Ptr Word8 -> CInt -> IO CInt -- | fake handle to Intel RDRand entropy cpu instruction data RDRand = RDRand instance EntropySource RDRand where entropyOpen = rdrandGrab entropyGather _ = rdrandGetBytes entropyClose _ = return () rdrandGrab :: IO (Maybe RDRand) rdrandGrab = supported `fmap` c_cpu_has_rdrand where supported 0 = Nothing supported _ = Just RDRand rdrandGetBytes :: Ptr Word8 -> Int -> IO Int rdrandGetBytes ptr sz = fromIntegral `fmap` c_get_rand_bytes ptr (fromIntegral sz) crypto-random-0.0.9/Crypto/Random/Entropy/Source.hs0000644000000000000000000000127612502300330020432 0ustar0000000000000000-- | -- Module : Crypto.Random.Entropy.Source -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- module Crypto.Random.Entropy.Source where import Foreign.Ptr import Data.Word (Word8) -- | A handle to an entropy maker, either a system capability -- or a hardware generator. class EntropySource a where -- | try to open an handle for this source entropyOpen :: IO (Maybe a) -- | try to gather a number of entropy bytes into a buffer. -- return the number of actual bytes gathered entropyGather :: a -> Ptr Word8 -> Int -> IO Int -- | Close an open handle entropyClose :: a -> IO () crypto-random-0.0.9/Crypto/Random/Entropy/Unix.hs0000644000000000000000000000403312502300330020107 0ustar0000000000000000-- | -- Module : Crypto.Random.Entropy.Unix -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- {-# LANGUAGE ScopedTypeVariables #-} module Crypto.Random.Entropy.Unix ( DevRandom , DevURandom ) where import Foreign.Ptr import Data.Word (Word8) import Crypto.Random.Entropy.Source import Control.Exception as E import System.Posix.Types (Fd) import System.Posix.IO type H = Fd type DeviceName = String -- | Entropy device /dev/random on unix system newtype DevRandom = DevRandom DeviceName -- | Entropy device /dev/urandom on unix system newtype DevURandom = DevURandom DeviceName instance EntropySource DevRandom where entropyOpen = fmap DevRandom `fmap` testOpen "/dev/random" entropyGather (DevRandom name) ptr n = withDev name $ \h -> gatherDevEntropy h ptr n entropyClose (DevRandom _) = return () instance EntropySource DevURandom where entropyOpen = fmap DevURandom `fmap` testOpen "/dev/urandom" entropyGather (DevURandom name) ptr n = withDev name $ \h -> gatherDevEntropy h ptr n entropyClose (DevURandom _) = return () testOpen :: DeviceName -> IO (Maybe DeviceName) testOpen filepath = do d <- openDev filepath case d of Nothing -> return Nothing Just h -> closeDev h >> return (Just filepath) openDev :: String -> IO (Maybe H) openDev filepath = (Just `fmap` openFd filepath ReadOnly Nothing fileFlags) `E.catch` \(_ :: IOException) -> return Nothing where fileFlags = defaultFileFlags { nonBlock = True } withDev :: String -> (H -> IO a) -> IO a withDev filepath f = openDev filepath >>= \h -> case h of Nothing -> error ("device " ++ filepath ++ " cannot be grabbed") Just fd -> f fd >>= \r -> (closeDev fd >> return r) closeDev :: H -> IO () closeDev h = closeFd h gatherDevEntropy :: H -> Ptr Word8 -> Int -> IO Int gatherDevEntropy h ptr sz = (fromIntegral `fmap` fdReadBuf h ptr (fromIntegral sz)) `E.catch` \(_ :: IOException) -> return 0 crypto-random-0.0.9/Crypto/Random/Entropy/Windows.hs0000644000000000000000000000605612502300330020625 0ustar0000000000000000-- | -- Module : Crypto.Random.Entropy.Windows -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- -- code originally from the entropy package and thus is: -- Copyright (c) Thomas DuBuisson. -- {-# LANGUAGE CPP, ForeignFunctionInterface #-} module Crypto.Random.Entropy.Windows ( WinCryptoAPI ) where import Data.Int (Int32) 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 -- | handle to windows crypto API for random generation data WinCryptoAPI = WinCryptoAPI instance EntropySource WinCryptoAPI where entropyOpen = do mctx <- cryptAcquireCtx maybe (return Nothing) (\ctx -> cryptReleaseCtx ctx >> return (Just WinCryptoAPI)) mctx entropyGather WinCryptoAPI ptr n = do mctx <- cryptAcquireCtx case mctx of 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 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 -> withCString msDefProv $ \provName -> do r <- toBool `fmap` c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext if r then Just `fmap` peek handlePtr else return Nothing cryptGenRandom :: CryptCtx -> Ptr Word8 -> Int -> IO Int cryptGenRandom h buf n = do success <- toBool `fmap` c_cryptGenRandom h (fromIntegral n) buf return $ if success then n else 0 cryptReleaseCtx :: CryptCtx -> IO () cryptReleaseCtx h = do success <- toBool `fmap` c_cryptReleaseCtx h 0 if success then return () else do lastError <- getLastError fail $ "cryptReleaseCtx: error " ++ show lastError