git.iko.soy/typeable/entropy
on 2e52201 help sign in
typeable/entropy/System/Entropy.hs
220 lines 6.1 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 HAVE_RDRAND
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
61data CryptHandle
62 = CH Word32
63#ifdef HAVE_RDRAND
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 HAVE_RDRAND
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 HAVE_RDRAND
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 HAVE_RDRAND
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
154source :: FilePath
155source = "/dev/urandom"
157-- |Handle for manual resource mangement
158data CryptHandle
159 = CH Handle
160#ifdef HAVE_RDRAND
161 | UseRdRand
162#endif
164-- |Open a `CryptHandle`
165openHandle :: IO CryptHandle
166openHandle = do
167#ifdef HAVE_RDRAND
168 b <- cpuHasRdRand
169 if b then return UseRdRand
170 else do
171#endif
172 liftM CH (openFile source ReadMode)
174-- |Close the `CryptHandle`
175closeHandle :: CryptHandle -> IO ()
176closeHandle (CH h) = hClose h
177#ifdef HAVE_RDRAND
178closeHandle UseRdRand = return ()
179#endif
181-- |Read random data from a `CryptHandle`
182hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
183hGetEntropy (CH h) = B.hGet h
184#ifdef HAVE_RDRAND
185hGetEntropy UseRdRand = \n -> do
186 B.create n $ \ptr -> do
187 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
188 when (r /= 0)
189 (fail "RDRand failed to gather entropy")
190#endif
192#ifdef HAVE_RDRAND
193foreign import ccall unsafe "cpu_has_rdrand"
194 c_cpu_has_rdrand :: IO CInt
196foreign import ccall unsafe "get_rand_bytes"
197 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
199cpuHasRdRand :: IO Bool
200cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
201#endif
203-- |Inefficiently get a specific number of bytes of cryptographically
204-- secure random data using the system-specific facilities.
205--
206-- Use '/dev/urandom' on *nix and CryptAPI when on Windows. In short,
207-- this entropy is considered "cryptographically secure" but not true
208-- entropy.
209getEntropy :: Int -> IO B.ByteString
210getEntropy n = do
211#ifdef HAVE_RDRAND
212 b <- cpuHasRdRand
213 if b then hGetEntropy UseRdRand n
214 else do
215#endif
216{- arch_x86 -}
217 withBinaryFile source ReadMode (`B.hGet` n)
218#endif
219{- OS Test -}