git.iko.soy/typeable/entropy
on f0044cc help sign in
typeable/entropy/System/Entropy.hs
225 lines 6.5 kB history raw
1{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-}
2{-|
3 Maintainer: Thomas.DuBuisson@gmail.com
4 Stability: beta
5 Portability: portable
7 Obtain entropy from system sources.
8 Currently, windows and *nix systems with a @/dev/urandom@ are supported.
9-}
11module System.Entropy
12 ( getEntropy
13 , CryptHandle
14 , openHandle
15 , hGetEntropy
16 , closeHandle
17 ) where
19import Control.Monad (liftM)
20import Data.ByteString as B
21import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
22import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
23import Foreign (allocaBytes)
25#if defined(isWindows)
26{- C example for windows rng - taken from a blog, can't recall which one but thank you!
27 #include <Windows.h>
28 #include <Wincrypt.h>
29 ...
30 //
31 // DISCLAIMER: Don't forget to check your error codes!!
32 // I am not checking as to make the example simple...
33 //
34 HCRYPTPROV hCryptCtx = NULL;
35 BYTE randomArray[128];
37 CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
38 CryptGenRandom(hCryptCtx, 128, randomArray);
39 CryptReleaseContext(hCryptCtx, 0);
40-}
42import Data.ByteString.Internal as BI
43import Data.Int (Int32)
44import Data.Word (Word32, Word8)
45import Foreign.C.String (CString, withCString)
46import Foreign.C.Types
47import Foreign.Ptr (Ptr, nullPtr, castPtr)
48import Foreign.Marshal.Alloc (alloca)
49import Foreign.Marshal.Utils (toBool)
50import Foreign.Storable (peek)
52#ifdef HAVE_RDRAND
53foreign import ccall unsafe "cpu_has_rdrand"
54 c_cpu_has_rdrand :: IO CInt
56foreign import ccall unsafe "get_rand_bytes"
57 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
59cpuHasRdRand :: IO Bool
60cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
61#endif
63data CryptHandle
64 = CH Word32
65#ifdef HAVE_RDRAND
66 | UseRdRand
67#endif
69-- Define the constants we need from WinCrypt.h
70msDefProv :: String
71msDefProv = "Microsoft Base Cryptographic Provider v1.0"
72provRSAFull :: Word32
73provRSAFull = fromIntegral 1
74cryptVerifyContext :: Word32
75cryptVerifyContext = fromIntegral 0xF0000000
77-- Declare the required CryptoAPI imports
78foreign import stdcall unsafe "CryptAcquireContextA"
79 c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
80foreign import stdcall unsafe "CryptGenRandom"
81 c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
82foreign import stdcall unsafe "CryptReleaseContext"
83 c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
85cryptAcquireCtx :: IO Word32
86cryptAcquireCtx =
87 alloca $ \handlePtr ->
88 withCString msDefProv $ \provName -> do
89 stat <- c_cryptAcquireCtx handlePtr nullPtr provName (fromIntegral 1) (fromIntegral cryptVerifyContext)
90 if (toBool stat)
91 then peek handlePtr
92 else fail "c_cryptAcquireCtx"
94cryptGenRandom :: Word32 -> Int -> IO B.ByteString
95cryptGenRandom h i =
96 BI.create i $ \c_buffer -> do
97 stat <- c_cryptGenRandom (fromIntegral h) (fromIntegral i) c_buffer
98 if (toBool stat)
99 then return ()
100 else fail "c_cryptGenRandom"
102cryptReleaseCtx :: Word32 -> IO ()
103cryptReleaseCtx h = do
104 stat <- c_cryptReleaseCtx h 0
105 if (toBool stat)
106 then return ()
107 else fail "c_cryptReleaseCtx"
109-- |Inefficiently get a specific number of bytes of cryptographically
110-- secure random data using the system-specific facilities.
111--
112-- This function will return zero bytes
113-- on platforms without a secure RNG!
114getEntropy :: Int -> IO B.ByteString
115getEntropy n = do
116#ifdef HAVE_RDRAND
117 b <- cpuHasRdRand
118 if b then hGetEntropy UseRdRand n
119 else do
120#endif
121 h <- cryptAcquireCtx
122 bs <- cryptGenRandom h n
123 let !bs' = bs
124 cryptReleaseCtx h
125 return bs'
127-- |Open a handle from which random data can be read
128openHandle :: IO CryptHandle
129openHandle = do
130#ifdef HAVE_RDRAND
131 b <- cpuHasRdRand
132 if b then return UseRdRand
133 else do
134#endif
135 liftM CH cryptAcquireCtx
137-- |Close the `CryptHandle`
138closeHandle (CH h) = cryptReleaseCtx h
140-- |Read from `CryptHandle`
141hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
142hGetEntropy (CH h) = cryptGenRandom h
143#ifdef HAVE_RDRAND
144hGetEntropy UseRdRand =
145 B.create n $ \ptr -> do
146 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
147 when (r /= 0)
148 (fail "RDRand failed to gather entropy")
149#endif
151#else
152{- Not windows, assuming nix with a /dev/urandom -}
153import Foreign.Ptr
155source :: FilePath
156source = "/dev/urandom"
158-- |Handle for manual resource mangement
159data CryptHandle
160 = CH Fd
161#ifdef HAVE_RDRAND
162 | UseRdRand
163#endif
165-- |Open a `CryptHandle`
166openHandle :: IO CryptHandle
167openHandle = do
168#ifdef HAVE_RDRAND
169 b <- cpuHasRdRand
170 if b then return UseRdRand
171 else do
172#endif
173 liftM CH (openFd source ReadOnly Nothing defaultFileFlags)
175-- |Close the `CryptHandle`
176closeHandle :: CryptHandle -> IO ()
177closeHandle (CH h) = closeFd h
178#ifdef HAVE_RDRAND
179closeHandle UseRdRand = return ()
180#endif
182fdReadBS :: Fd -> Int -> IO B.ByteString
183fdReadBS fd n = do
184 allocaBytes n $ \buf -> do
185 rc <- fdReadBuf fd buf (fromIntegral n)
186 case rc of
187 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF")
188 n' -> B.packCStringLen (castPtr buf, fromIntegral n')
190-- |Read random data from a `CryptHandle`
191hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
192hGetEntropy (CH h) = fdReadBS h
193#ifdef HAVE_RDRAND
194hGetEntropy UseRdRand = \n -> do
195 B.create n $ \ptr -> do
196 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
197 when (r /= 0)
198 (fail "RDRand failed to gather entropy")
199#endif
201#ifdef HAVE_RDRAND
202foreign import ccall unsafe "cpu_has_rdrand"
203 c_cpu_has_rdrand :: IO CInt
205foreign import ccall unsafe "get_rand_bytes"
206 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
208cpuHasRdRand :: IO Bool
209cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
210#endif
212-- |Inefficiently get a specific number of bytes of cryptographically
213-- secure random data using the system-specific facilities.
214--
215-- Use '/dev/urandom' on *nix and CryptAPI when on Windows. In short,
216-- this entropy is considered "cryptographically secure" but not true
217-- entropy.
218getEntropy :: Int -> IO B.ByteString
219getEntropy n = do
220 h <- openHandle
221 e <- hGetEntropy h n
222 closeHandle h
223 return e
224#endif
225{- OS Test -}