git.iko.soy/typeable/entropy
on b8a00ee help sign in
typeable/entropy/System/Entropy.hs
221 lines 6.2 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, when)
20import Data.ByteString as B
21import System.IO (openFile, hClose, IOMode(..), Handle, withBinaryFile)
23#if defined(isWindows)
24{- C example for windows rng - taken from a blog, can't recall which one but thank you!
25 #include <Windows.h>
26 #include <Wincrypt.h>
27 ...
28 //
29 // DISCLAIMER: Don't forget to check your error codes!!
30 // I am not checking as to make the example simple...
31 //
32 HCRYPTPROV hCryptCtx = NULL;
33 BYTE randomArray[128];
35 CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
36 CryptGenRandom(hCryptCtx, 128, randomArray);
37 CryptReleaseContext(hCryptCtx, 0);
38-}
40import Data.ByteString.Internal as BI
41import Data.Int (Int32)
42import Data.Word (Word32, Word8)
43import Foreign.C.String (CString, withCString)
44import Foreign.C.Types
45import Foreign.Ptr (Ptr, nullPtr, castPtr)
46import Foreign.Marshal.Alloc (alloca)
47import Foreign.Marshal.Utils (toBool)
48import Foreign.Storable (peek)
50#ifdef arch_x86_64
51foreign import ccall unsafe "cpu_has_rdrand"
52 c_cpu_has_rdrand :: IO CInt
54foreign import ccall unsafe "get_rand_bytes"
55 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
57cpuHasRdRand :: IO Bool
58cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
59#endif
61newtype CryptHandle
62 = CH Word32
63#ifdef arch_x86_64
64 | UseRdRand
65#endif
67-- Define the constants we need from WinCrypt.h
68msDefProv :: String
69msDefProv = "Microsoft Base Cryptographic Provider v1.0"
70provRSAFull :: Word32
71provRSAFull = fromIntegral 1
72cryptVerifyContext :: Word32
73cryptVerifyContext = fromIntegral 0xF0000000
75-- Declare the required CryptoAPI imports
76foreign import stdcall unsafe "CryptAcquireContextA"
77 c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
78foreign import stdcall unsafe "CryptGenRandom"
79 c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
80foreign import stdcall unsafe "CryptReleaseContext"
81 c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
83cryptAcquireCtx :: IO Word32
84cryptAcquireCtx =
85 alloca $ \handlePtr ->
86 withCString msDefProv $ \provName -> do
87 stat <- c_cryptAcquireCtx handlePtr nullPtr provName (fromIntegral 1) (fromIntegral cryptVerifyContext)
88 if (toBool stat)
89 then peek handlePtr
90 else fail "c_cryptAcquireCtx"
92cryptGenRandom :: Word32 -> Int -> IO B.ByteString
93cryptGenRandom h i =
94 BI.create i $ \c_buffer -> do
95 stat <- c_cryptGenRandom (fromIntegral h) (fromIntegral i) c_buffer
96 if (toBool stat)
97 then return ()
98 else fail "c_cryptGenRandom"
100cryptReleaseCtx :: Word32 -> IO ()
101cryptReleaseCtx h = do
102 stat <- c_cryptReleaseCtx h 0
103 if (toBool stat)
104 then return ()
105 else fail "c_cryptReleaseCtx"
107-- |Inefficiently get a specific number of bytes of cryptographically
108-- secure random data using the system-specific facilities.
109--
110-- This function will return zero bytes
111-- on platforms without a secure RNG!
112getEntropy :: Int -> IO B.ByteString
113getEntropy n = do
114#ifdef arch_x86_64
115 b <- cpuHasRdRand
116 if b then hGetEntropy UseRdRand n
117 else do
118#endif
119 h <- cryptAcquireCtx
120 bs <- cryptGenRandom h n
121 let !bs' = bs
122 cryptReleaseCtx h
123 return bs'
125-- |Open a handle from which random data can be read
126openHandle :: IO CryptHandle
127openHandle = do
128#ifdef arch_x86_64
129 b <- cpuHasRdRand
130 if b then return UseRdRand
131 else do
132#endif
133 liftM CH cryptAcquireCtx
135-- |Close the `CryptHandle`
136closeHandle (CH h) = cryptReleaseCtx h
138-- |Read from `CryptHandle`
139hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
140hGetEntropy (CH h) = cryptGenRandom h
141#ifdef arch_x86_64
142hGetEntropy UseRdRand =
143 B.create n $ \ptr -> do
144 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
145 when (r /= 0)
146 (fail "RDRand failed to gather entropy")
147#endif
149#else
150{- Not windows, assuming nix with a /dev/urandom -}
151import Foreign.C.Types
152import Foreign.Ptr
153import Data.ByteString.Internal as B
155source :: FilePath
156source = "/dev/urandom"
158-- |Handle for manual resource mangement
159data CryptHandle
160 = CH Handle
161#ifdef arch_x86_64
162 | UseRdRand
163#endif
165-- |Open a `CryptHandle`
166openHandle :: IO CryptHandle
167openHandle = do
168#ifdef arch_x86_64
169 b <- cpuHasRdRand
170 if b then return UseRdRand
171 else do
172#endif
173 liftM CH (openFile source ReadMode)
175-- |Close the `CryptHandle`
176closeHandle :: CryptHandle -> IO ()
177closeHandle (CH h) = hClose h
178#ifdef arch_x86_64
179closeHandle UseRdRand = return ()
180#endif
182-- |Read random data from a `CryptHandle`
183hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
184hGetEntropy (CH h) = B.hGet h
185#ifdef arch_x86_64
186hGetEntropy UseRdRand = \n -> do
187 B.create n $ \ptr -> do
188 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
189 when (r /= 0)
190 (fail "RDRand failed to gather entropy")
191#endif
193#ifdef arch_x86_64
194foreign import ccall unsafe "cpu_has_rdrand"
195 c_cpu_has_rdrand :: IO CInt
197foreign import ccall unsafe "get_rand_bytes"
198 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
200cpuHasRdRand :: IO Bool
201cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
202#endif
204-- |Inefficiently get a specific number of bytes of cryptographically
205-- secure random data using the system-specific facilities.
206--
207-- Use '/dev/urandom' on *nix and CryptAPI when on Windows. In short,
208-- this entropy is considered "cryptographically secure" but not true
209-- entropy.
210getEntropy :: Int -> IO B.ByteString
211getEntropy n = do
212#if arch_x86_64
213 b <- cpuHasRdRand
214 if b then hGetEntropy UseRdRand n
215 else do
216#endif
217{- arch_x86 -}
218 withBinaryFile source ReadMode (`B.hGet` n)
219#endif
220{- OS Test -}