@@ -4,73 +4,217 @@
44 Stability: beta
55 Portability: portable
66
7− Obtain entropy from system sources or x86 RDRAND when available.
7+ Obtain entropy from system sources.
8+ Currently, windows and *nix systems with a /dev/urandom are supported.
9+-}
10+
11+module System.Entropy
12+ ( getEntropy
13+ , CryptHandle
14+ , openHandle
15+ , hGetEntropy
16+ , closeHandle
17+ ) where
818
9− Currently supporting:
19+import Control.Monad (liftM, when)
20+import Data.ByteString as B
21+import System.IO (openFile, hClose, IOMode(..), Handle, withBinaryFile)
1022
11− - Windows via CryptoAPI
12− - *nix systems via @\/dev\/urandom@
13− - Includes QNX
14− - ghcjs/browser via JavaScript crypto API.
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];
34+
35+ CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
36+ CryptGenRandom(hCryptCtx, 128, randomArray);
37+ CryptReleaseContext(hCryptCtx, 0);
1538-}
1639
17−module System.Entropy
18− ( getEntropy,
19− getHardwareEntropy,
20− CryptHandle,
21− openHandle,
22− hGetEntropy,
23− closeHandle
24− ) where
25−
26−#ifdef ghcjs_HOST_OS
27−import System.EntropyGhcjs
28−#elif defined(isWindows)
29−import System.EntropyWindows
30−#else
31−import System.EntropyNix
40+import Data.ByteString.Internal as BI
41+import Data.Int (Int32)
42+import Data.Word (Word32, Word8)
43+import Foreign.C.String (CString, withCString)
44+import Foreign.C.Types
45+import Foreign.Ptr (Ptr, nullPtr, castPtr)
46+import Foreign.Marshal.Alloc (alloca)
47+import Foreign.Marshal.Utils (toBool)
48+import Foreign.Storable (peek)
49+
50+#ifdef HAVE_RDRAND
51+foreign import ccall unsafe "cpu_has_rdrand"
52+ c_cpu_has_rdrand :: IO CInt
53+
54+foreign import ccall unsafe "get_rand_bytes"
55+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
56+
57+cpuHasRdRand :: IO Bool
58+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
3259#endif
3360
34−import qualified Data.ByteString as B
35−import Control.Exception (bracket)
61+data CryptHandle
62+ = CH Word32
63+#ifdef HAVE_RDRAND
64+ | UseRdRand
65+#endif
3666
37−-- |Get a specific number of bytes of cryptographically
38−-- secure random data using the *system-specific* sources.
39−-- (As of 0.4. Versions <0.4 mixed system and hardware sources)
40−--
41−-- The returned random value is considered cryptographically secure but not true entropy.
42−--
43−-- On some platforms this requires a file handle which can lead to resource
44−-- exhaustion in some situations.
45−getEntropy :: Int -- ^ Number of bytes
46− -> IO B.ByteString
47−getEntropy = bracket openHandle closeHandle . flip hGetEntropy
48−
49−-- |Get a specific number of bytes of cryptographically
50−-- secure random data using a supported *hardware* random bit generator.
51−--
52−-- If there is no hardware random number generator then @Nothing@ is returned.
53−-- If any call returns non-Nothing then it should never be @Nothing@ unless
54−-- there has been a hardware failure.
55−--
56−-- If trust of the CPU allows it and no context switching is important,
57−-- a bias to the hardware rng with system rng as fall back is trivial:
58−--
59−-- @
60−-- let fastRandom nr = maybe (getEntropy nr) pure =<< getHardwareEntropy nr
61−-- @
62−--
63−-- The old, @<0.4@, behavior is possible using @xor@ from 'Data.Bits':
67+-- Define the constants we need from WinCrypt.h
68+msDefProv :: String
69+msDefProv = "Microsoft Base Cryptographic Provider v1.0"
70+provRSAFull :: Word32
71+provRSAFull = fromIntegral 1
72+cryptVerifyContext :: Word32
73+cryptVerifyContext = fromIntegral 0xF0000000
74+
75+-- Declare the required CryptoAPI imports
76+foreign import stdcall unsafe "CryptAcquireContextA"
77+ c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
78+foreign import stdcall unsafe "CryptGenRandom"
79+ c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
80+foreign import stdcall unsafe "CryptReleaseContext"
81+ c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
82+
83+cryptAcquireCtx :: IO Word32
84+cryptAcquireCtx =
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"
91+
92+cryptGenRandom :: Word32 -> Int -> IO B.ByteString
93+cryptGenRandom 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"
99+
100+cryptReleaseCtx :: Word32 -> IO ()
101+cryptReleaseCtx h = do
102+ stat <- c_cryptReleaseCtx h 0
103+ if (toBool stat)
104+ then return ()
105+ else fail "c_cryptReleaseCtx"
106+
107+-- |Inefficiently get a specific number of bytes of cryptographically
108+-- secure random data using the system-specific facilities.
64109--
65−-- @
66−-- let oldRandom nr =
67−-- do hwRnd <- maybe (replicate nr 0) BS.unpack <$> getHardwareEntropy nr
68−-- sysRnd <- BS.unpack <$> getEntropy nr
69−-- pure $ BS.pack $ zipWith xor sysRnd hwRnd
70−-- @
110+-- This function will return zero bytes
111+-- on platforms without a secure RNG!
112+getEntropy :: Int -> IO B.ByteString
113+getEntropy 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'
124+
125+-- |Open a handle from which random data can be read
126+openHandle :: IO CryptHandle
127+openHandle = do
128+#ifdef HAVE_RDRAND
129+ b <- cpuHasRdRand
130+ if b then return UseRdRand
131+ else do
132+#endif
133+ liftM CH cryptAcquireCtx
134+
135+-- |Close the `CryptHandle`
136+closeHandle (CH h) = cryptReleaseCtx h
137+
138+-- |Read from `CryptHandle`
139+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
140+hGetEntropy (CH h) = cryptGenRandom h
141+#ifdef HAVE_RDRAND
142+hGetEntropy 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
148+
149+#else
150+{- Not windows, assuming nix with a /dev/urandom -}
151+import Foreign.C.Types
152+import Foreign.Ptr
153+
154+source :: FilePath
155+source = "/dev/urandom"
156+
157+-- |Handle for manual resource mangement
158+data CryptHandle
159+ = CH Handle
160+#ifdef HAVE_RDRAND
161+ | UseRdRand
162+#endif
163+
164+-- |Open a `CryptHandle`
165+openHandle :: IO CryptHandle
166+openHandle = 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)
173+
174+-- |Close the `CryptHandle`
175+closeHandle :: CryptHandle -> IO ()
176+closeHandle (CH h) = hClose h
177+#ifdef HAVE_RDRAND
178+closeHandle UseRdRand = return ()
179+#endif
180+
181+-- |Read random data from a `CryptHandle`
182+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
183+hGetEntropy (CH h) = B.hGet h
184+#ifdef HAVE_RDRAND
185+hGetEntropy 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
191+
192+#ifdef HAVE_RDRAND
193+foreign import ccall unsafe "cpu_has_rdrand"
194+ c_cpu_has_rdrand :: IO CInt
195+
196+foreign import ccall unsafe "get_rand_bytes"
197+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
198+
199+cpuHasRdRand :: IO Bool
200+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
201+#endif
202+
203+-- |Inefficiently get a specific number of bytes of cryptographically
204+-- secure random data using the system-specific facilities.
71205--
72−-- A less maliable mixing can be accomplished by replacing `xor` with a
73−-- composition of concat and cryptographic hash.
74−getHardwareEntropy :: Int -- ^ Number of bytes
75− -> IO (Maybe B.ByteString)
76−getHardwareEntropy = hardwareRandom
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.
209+getEntropy :: Int -> IO B.ByteString
210+getEntropy 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 -}
220+