git.iko.soy/typeable/entropy
on 3bda5df help sign in
typeable/entropy/System/Entropy.hs
253 lines 7.0 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 or x86 RDRAND when available.
9 Currently supporting:
11 - Windows via CryptoAPO
12 - *nix systems via @\/dev\/urandom@
13 - QNX
14 - Xen only when RDRAND is available.
15-}
17module System.Entropy
18 ( getEntropy
19 , CryptHandle
20 , openHandle
21 , hGetEntropy
22 , closeHandle
23 ) where
25#ifndef XEN
26import Control.Monad (liftM, when)
27import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
28import Foreign (allocaBytes)
29#else
30import Control.Monad (when)
31#endif
32import Data.ByteString as B
34#if defined(isWindows)
35{- C example for windows rng - taken from a blog, can't recall which one but thank you!
36 #include <Windows.h>
37 #include <Wincrypt.h>
38 ...
39 //
40 // DISCLAIMER: Don't forget to check your error codes!!
41 // I am not checking as to make the example simple...
42 //
43 HCRYPTPROV hCryptCtx = NULL;
44 BYTE randomArray[128];
46 CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
47 CryptGenRandom(hCryptCtx, 128, randomArray);
48 CryptReleaseContext(hCryptCtx, 0);
49-}
51import Data.ByteString.Internal as BI
52import Data.Int (Int32)
53import Data.Word (Word32, Word8)
54import Foreign.C.String (CString, withCString)
55import Foreign.C.Types
56import Foreign.Ptr (Ptr, nullPtr, castPtr)
57import Foreign.Marshal.Alloc (alloca)
58import Foreign.Marshal.Utils (toBool)
59import Foreign.Storable (peek)
61#ifdef HAVE_RDRAND
62foreign import ccall unsafe "cpu_has_rdrand"
63 c_cpu_has_rdrand :: IO CInt
65foreign import ccall unsafe "get_rand_bytes"
66 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
68cpuHasRdRand :: IO Bool
69cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
70#endif
72data CryptHandle
73 = CH Word32
74#ifdef HAVE_RDRAND
75 | UseRdRand
76#endif
78-- Define the constants we need from WinCrypt.h
79msDefProv :: String
80msDefProv = "Microsoft Base Cryptographic Provider v1.0"
81provRSAFull :: Word32
82provRSAFull = fromIntegral 1
83cryptVerifyContext :: Word32
84cryptVerifyContext = fromIntegral 0xF0000000
86-- Declare the required CryptoAPI imports
87foreign import stdcall unsafe "CryptAcquireContextA"
88 c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
89foreign import stdcall unsafe "CryptGenRandom"
90 c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
91foreign import stdcall unsafe "CryptReleaseContext"
92 c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
94cryptAcquireCtx :: IO Word32
95cryptAcquireCtx =
96 alloca $ \handlePtr ->
97 withCString msDefProv $ \provName -> do
98 stat <- c_cryptAcquireCtx handlePtr nullPtr provName (fromIntegral 1) (fromIntegral cryptVerifyContext)
99 if (toBool stat)
100 then peek handlePtr
101 else fail "c_cryptAcquireCtx"
103cryptGenRandom :: Word32 -> Int -> IO B.ByteString
104cryptGenRandom h i =
105 BI.create i $ \c_buffer -> do
106 stat <- c_cryptGenRandom (fromIntegral h) (fromIntegral i) c_buffer
107 if (toBool stat)
108 then return ()
109 else fail "c_cryptGenRandom"
111cryptReleaseCtx :: Word32 -> IO ()
112cryptReleaseCtx h = do
113 stat <- c_cryptReleaseCtx h 0
114 if (toBool stat)
115 then return ()
116 else fail "c_cryptReleaseCtx"
118-- |Inefficiently get a specific number of bytes of cryptographically
119-- secure random data using the system-specific facilities.
120--
121-- This function will return zero bytes
122-- on platforms without a secure RNG!
123getEntropy :: Int -> IO B.ByteString
124getEntropy n = do
125#ifdef HAVE_RDRAND
126 b <- cpuHasRdRand
127 if b then hGetEntropy UseRdRand n
128 else do
129#endif
130 h <- cryptAcquireCtx
131 bs <- cryptGenRandom h n
132 let !bs' = bs
133 cryptReleaseCtx h
134 return bs'
136-- |Open a handle from which random data can be read
137openHandle :: IO CryptHandle
138openHandle = do
139#ifdef HAVE_RDRAND
140 b <- cpuHasRdRand
141 if b then return UseRdRand
142 else do
143#endif
144 liftM CH cryptAcquireCtx
146-- |Close the `CryptHandle`
147closeHandle (CH h) = cryptReleaseCtx h
149-- |Read from `CryptHandle`
150hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
151hGetEntropy (CH h) = cryptGenRandom h
152#ifdef HAVE_RDRAND
153hGetEntropy UseRdRand =
154 B.create n $ \ptr -> do
155 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
156 when (r /= 0)
157 (fail "RDRand failed to gather entropy")
158#endif
160#else
161{- Not windows, assuming nix with a /dev/urandom -}
162import Foreign.Ptr
163import Foreign.C.Types
164import Data.ByteString.Internal as B
165#ifdef XEN
166data CryptHandle = UseRdRand -- or die trying
167#else
168import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
170source :: FilePath
171source = "/dev/urandom"
173-- |Handle for manual resource mangement
174data CryptHandle
175 = CH Fd
176#ifdef HAVE_RDRAND
177 | UseRdRand
178#endif
179#endif
181-- |Open a `CryptHandle`
182openHandle :: IO CryptHandle
183openHandle = do
184#ifdef HAVE_RDRAND
185 b <- cpuHasRdRand
186 if b then return UseRdRand
187 else do
188#endif
189#ifdef XEN
190 error "entropy: On halvm there is no entropy other than RDRAND."
191#else
192 liftM CH (openFd source ReadOnly Nothing defaultFileFlags)
193#endif
195-- |Close the `CryptHandle`
196closeHandle :: CryptHandle -> IO ()
197#ifndef XEN
198closeHandle (CH h) = closeFd h
199#endif
200#ifdef HAVE_RDRAND
201closeHandle UseRdRand = return ()
202#endif
204#ifndef XEN
205fdReadBS :: Fd -> Int -> IO B.ByteString
206fdReadBS fd n = do
207 allocaBytes n $ \buf -> do
208 rc <- fdReadBuf fd buf (fromIntegral n)
209 case rc of
210 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF")
211 n' -> B.packCStringLen (castPtr buf, fromIntegral n')
212#endif
214-- |Read random data from a `CryptHandle`
215hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
216#ifndef XEN
217hGetEntropy (CH h) = fdReadBS h
218#else
219#ifdef HAVE_RDRAND
220hGetEntropy UseRdRand = \n -> do
221 B.create n $ \ptr -> do
222 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
223 when (r /= 0)
224 (fail "RDRand failed to gather entropy")
225#endif
226#endif
227{- XEN -}
229#ifdef HAVE_RDRAND
230foreign import ccall unsafe "cpu_has_rdrand"
231 c_cpu_has_rdrand :: IO CInt
233foreign import ccall unsafe "get_rand_bytes"
234 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
236cpuHasRdRand :: IO Bool
237cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
238#endif
240-- |Inefficiently get a specific number of bytes of cryptographically
241-- secure random data using the system-specific facilities.
242--
243-- Use '/dev/urandom' on *nix and CryptAPI when on Windows. In short,
244-- this entropy is considered cryptographically secure but not true
245-- entropy.
246getEntropy :: Int -> IO B.ByteString
247getEntropy n = do
248 h <- openHandle
249 e <- hGetEntropy h n
250 closeHandle h
251 return e
252#endif
253{- OS Test -}