@@ -20,6 +20,7 @@ import Foreign (allocaBytes)
20import Data.ByteString as B
20import Data.ByteString as B
21import Data.ByteString.Internal as BI
21import Data.ByteString.Internal as BI
22import Data.Int (Int32)
22import Data.Int (Int32)
23+import Data.Bits (xor)
23import Data.Word (Word32, Word8)
24import Data.Word (Word32, Word8)
24import Foreign.C.String (CString, withCString)
25import Foreign.C.String (CString, withCString)
25import Foreign.C.Types
26import Foreign.C.Types
@@ -59,7 +60,7 @@ cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
59data CryptHandle
60data CryptHandle
60 = CH Word32
61 = CH Word32
61#ifdef HAVE_RDRAND
62#ifdef HAVE_RDRAND
62− | UseRdRand
63+ | UseRdRand Word32
65-- Define the constants we need from WinCrypt.h
66-- Define the constants we need from WinCrypt.h
@@ -107,22 +108,27 @@ openHandle :: IO CryptHandle
107openHandle = do
108openHandle = do
108#ifdef HAVE_RDRAND
109#ifdef HAVE_RDRAND
109 b <- cpuHasRdRand
110 b <- cpuHasRdRand
110− if b then return UseRdRand
111+ if b then UseRdRand `fmap` cryptAcquireCtx
113− liftM CH cryptAcquireCtx
114+ CH `fmap` cryptAcquireCtx
115-- |Close the `CryptHandle`
116-- |Close the `CryptHandle`
116closeHandle :: CryptHandle -> IO ()
117closeHandle :: CryptHandle -> IO ()
118+closeHandle (CH h) = cryptReleaseCtx h
117−closeHandle (CH h) = cryptReleaseCtx h
120+closeHandle (UseRdRand h) = cryptReleaseCtx h
119-- |Read from `CryptHandle`
123-- |Read from `CryptHandle`
120hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
124hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
121hGetEntropy (CH h) n = cryptGenRandom h n
125hGetEntropy (CH h) n = cryptGenRandom h n
122#ifdef HAVE_RDRAND
126#ifdef HAVE_RDRAND
123−hGetEntropy UseRdRand n =
127+hGetEntropy (UseRdRand h) n =
124− BI.create n $ \ptr -> do
128+ do bsRDRAND <- BI.create n $ \ptr -> do
125− r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
129+ r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
126− when (r /= 0)
130+ when (r /= 0)
127− (fail "RDRand failed to gather entropy")
131+ (fail "RDRand failed to gather entropy")
132+ bsWinCrypt <- cryptGenRandom h n
133+ return $ B.pack $ B.zipWith xor bsRDRAND bsWinCrypt