git.iko.soy/typeable/entropy
on 2f047cf 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 Foreign (allocaBytes)
24#if defined(isWindows)
25{- C example for windows rng - taken from a blog, can't recall which one but thank you!
26 #include <Windows.h>
27 #include <Wincrypt.h>
28 ...
29 //
30 // DISCLAIMER: Don't forget to check your error codes!!
31 // I am not checking as to make the example simple...
32 //
33 HCRYPTPROV hCryptCtx = NULL;
34 BYTE randomArray[128];
36 CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
37 CryptGenRandom(hCryptCtx, 128, randomArray);
38 CryptReleaseContext(hCryptCtx, 0);
39-}
41import Data.ByteString.Internal as BI
42import Data.Int (Int32)
43import Data.Word (Word32, Word8)
44import Foreign.C.String (CString, withCString)
45import Foreign.C.Types
46import Foreign.Ptr (Ptr, nullPtr, castPtr)
47import Foreign.Marshal.Alloc (alloca)
48import Foreign.Marshal.Utils (toBool)
49import Foreign.Storable (peek)
51#ifdef HAVE_RDRAND
52foreign import ccall unsafe "cpu_has_rdrand"
53 c_cpu_has_rdrand :: IO CInt
55foreign import ccall unsafe "get_rand_bytes"
56 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
58cpuHasRdRand :: IO Bool
59cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
60#endif
62data CryptHandle
63 = CH Word32
64#ifdef HAVE_RDRAND
65 | UseRdRand
66#endif
68-- Define the constants we need from WinCrypt.h
69msDefProv :: String
70msDefProv = "Microsoft Base Cryptographic Provider v1.0"
71provRSAFull :: Word32
72provRSAFull = fromIntegral 1
73cryptVerifyContext :: Word32
74cryptVerifyContext = fromIntegral 0xF0000000
76-- Declare the required CryptoAPI imports
77foreign import stdcall unsafe "CryptAcquireContextA"
78 c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
79foreign import stdcall unsafe "CryptGenRandom"
80 c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
81foreign import stdcall unsafe "CryptReleaseContext"
82 c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
84cryptAcquireCtx :: IO Word32
85cryptAcquireCtx =
86 alloca $ \handlePtr ->
87 withCString msDefProv $ \provName -> do
88 stat <- c_cryptAcquireCtx handlePtr nullPtr provName (fromIntegral 1) (fromIntegral cryptVerifyContext)
89 if (toBool stat)
90 then peek handlePtr
91 else fail "c_cryptAcquireCtx"
93cryptGenRandom :: Word32 -> Int -> IO B.ByteString
94cryptGenRandom h i =
95 BI.create i $ \c_buffer -> do
96 stat <- c_cryptGenRandom (fromIntegral h) (fromIntegral i) c_buffer
97 if (toBool stat)
98 then return ()
99 else fail "c_cryptGenRandom"
101cryptReleaseCtx :: Word32 -> IO ()
102cryptReleaseCtx h = do
103 stat <- c_cryptReleaseCtx h 0
104 if (toBool stat)
105 then return ()
106 else fail "c_cryptReleaseCtx"
108-- |Inefficiently get a specific number of bytes of cryptographically
109-- secure random data using the system-specific facilities.
110--
111-- This function will return zero bytes
112-- on platforms without a secure RNG!
113getEntropy :: Int -> IO B.ByteString
114getEntropy n = do
115#ifdef HAVE_RDRAND
116 b <- cpuHasRdRand
117 if b then hGetEntropy UseRdRand n
118 else do
119#endif
120 h <- cryptAcquireCtx
121 bs <- cryptGenRandom h n
122 let !bs' = bs
123 cryptReleaseCtx h
124 return bs'
126-- |Open a handle from which random data can be read
127openHandle :: IO CryptHandle
128openHandle = do
129#ifdef HAVE_RDRAND
130 b <- cpuHasRdRand
131 if b then return UseRdRand
132 else do
133#endif
134 liftM CH cryptAcquireCtx
136-- |Close the `CryptHandle`
137closeHandle (CH h) = cryptReleaseCtx h
139-- |Read from `CryptHandle`
140hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
141hGetEntropy (CH h) = cryptGenRandom h
142#ifdef HAVE_RDRAND
143hGetEntropy UseRdRand =
144 B.create n $ \ptr -> do
145 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
146 when (r /= 0)
147 (fail "RDRand failed to gather entropy")
148#endif
150#else
151{- Not windows, assuming nix with a /dev/urandom -}
152import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
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 -}