@@ -4,73 +4,222 @@
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)
20+import Data.ByteString as B
21+import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
22+import Foreign (allocaBytes)
1023
11− - Windows via CryptoAPI
12− - *nix systems via @\/dev\/urandom@
13− - Includes QNX
14− - ghcjs/browser via JavaScript crypto API.
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];
35+
36+ CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
37+ CryptGenRandom(hCryptCtx, 128, randomArray);
38+ CryptReleaseContext(hCryptCtx, 0);
1539-}
1640
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
41+import Data.ByteString.Internal as BI
42+import Data.Int (Int32)
43+import Data.Word (Word32, Word8)
44+import Foreign.C.String (CString, withCString)
45+import Foreign.C.Types
46+import Foreign.Ptr (Ptr, nullPtr, castPtr)
47+import Foreign.Marshal.Alloc (alloca)
48+import Foreign.Marshal.Utils (toBool)
49+import Foreign.Storable (peek)
50+
51+#ifdef HAVE_RDRAND
52+foreign import ccall unsafe "cpu_has_rdrand"
53+ c_cpu_has_rdrand :: IO CInt
54+
55+foreign import ccall unsafe "get_rand_bytes"
56+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
57+
58+cpuHasRdRand :: IO Bool
59+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
3260#endif
3361
34−import qualified Data.ByteString as B
35−import Control.Exception (bracket)
62+data CryptHandle
63+ = CH Word32
64+#ifdef HAVE_RDRAND
65+ | UseRdRand
66+#endif
3667
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':
68+-- Define the constants we need from WinCrypt.h
69+msDefProv :: String
70+msDefProv = "Microsoft Base Cryptographic Provider v1.0"
71+provRSAFull :: Word32
72+provRSAFull = fromIntegral 1
73+cryptVerifyContext :: Word32
74+cryptVerifyContext = fromIntegral 0xF0000000
75+
76+-- Declare the required CryptoAPI imports
77+foreign import stdcall unsafe "CryptAcquireContextA"
78+ c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
79+foreign import stdcall unsafe "CryptGenRandom"
80+ c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
81+foreign import stdcall unsafe "CryptReleaseContext"
82+ c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
83+
84+cryptAcquireCtx :: IO Word32
85+cryptAcquireCtx =
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"
92+
93+cryptGenRandom :: Word32 -> Int -> IO B.ByteString
94+cryptGenRandom 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"
100+
101+cryptReleaseCtx :: Word32 -> IO ()
102+cryptReleaseCtx h = do
103+ stat <- c_cryptReleaseCtx h 0
104+ if (toBool stat)
105+ then return ()
106+ else fail "c_cryptReleaseCtx"
107+
108+-- |Inefficiently get a specific number of bytes of cryptographically
109+-- secure random data using the system-specific facilities.
64110--
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−-- @
111+-- This function will return zero bytes
112+-- on platforms without a secure RNG!
113+getEntropy :: Int -> IO B.ByteString
114+getEntropy 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'
125+
126+-- |Open a handle from which random data can be read
127+openHandle :: IO CryptHandle
128+openHandle = do
129+#ifdef HAVE_RDRAND
130+ b <- cpuHasRdRand
131+ if b then return UseRdRand
132+ else do
133+#endif
134+ liftM CH cryptAcquireCtx
135+
136+-- |Close the `CryptHandle`
137+closeHandle (CH h) = cryptReleaseCtx h
138+
139+-- |Read from `CryptHandle`
140+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
141+hGetEntropy (CH h) = cryptGenRandom h
142+#ifdef HAVE_RDRAND
143+hGetEntropy 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
149+
150+#else
151+{- Not windows, assuming nix with a /dev/urandom -}
152+import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
153+import Foreign.Ptr
154+
155+source :: FilePath
156+source = "/dev/urandom"
157+
158+-- |Handle for manual resource mangement
159+data CryptHandle
160+ = CH Fd
161+#ifdef HAVE_RDRAND
162+ | UseRdRand
163+#endif
164+
165+-- |Open a `CryptHandle`
166+openHandle :: IO CryptHandle
167+openHandle = 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)
174+
175+-- |Close the `CryptHandle`
176+closeHandle :: CryptHandle -> IO ()
177+closeHandle (CH h) = closeFd h
178+#ifdef HAVE_RDRAND
179+closeHandle UseRdRand = return ()
180+#endif
181+
182+fdReadBS :: Fd -> Int -> IO B.ByteString
183+fdReadBS 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')
189+
190+-- |Read random data from a `CryptHandle`
191+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
192+hGetEntropy (CH h) = fdReadBS h
193+#ifdef HAVE_RDRAND
194+hGetEntropy 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
200+
201+#ifdef HAVE_RDRAND
202+foreign import ccall unsafe "cpu_has_rdrand"
203+ c_cpu_has_rdrand :: IO CInt
204+
205+foreign import ccall unsafe "get_rand_bytes"
206+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
207+
208+cpuHasRdRand :: IO Bool
209+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
210+#endif
211+
212+-- |Inefficiently get a specific number of bytes of cryptographically
213+-- secure random data using the system-specific facilities.
71214--
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
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.
218+getEntropy :: Int -> IO B.ByteString
219+getEntropy n = do
220+ h <- openHandle
221+ e <- hGetEntropy h n
222+ closeHandle h
223+ return e
224+#endif
225+{- OS Test -}