git.iko.soy/typeable/entropy
on c33dece help sign in
typeable/entropy/System/EntropyWindows.hs
128 lines 3.9 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.
8-}
10module System.EntropyWindows
11 ( CryptHandle
12 , openHandle
13 , hGetEntropy
14 , closeHandle
15 ) where
17import Control.Monad (liftM, when)
18import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
19import Foreign (allocaBytes)
20import Data.ByteString as B
21import Data.ByteString.Internal as BI
22import Data.Int (Int32)
23import Data.Word (Word32, Word8)
24import Foreign.C.String (CString, withCString)
25import Foreign.C.Types
26import Foreign.Ptr (Ptr, nullPtr, castPtr)
27import Foreign.Marshal.Alloc (alloca)
28import Foreign.Marshal.Utils (toBool)
29import Foreign.Storable (peek)
31{- C example for windows rng - taken from a blog, can't recall which one but thank you!
32 #include <Windows.h>
33 #include <Wincrypt.h>
34 ...
35 //
36 // DISCLAIMER: Don't forget to check your error codes!!
37 // I am not checking as to make the example simple...
38 //
39 HCRYPTPROV hCryptCtx = NULL;
40 BYTE randomArray[128];
42 CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
43 CryptGenRandom(hCryptCtx, 128, randomArray);
44 CryptReleaseContext(hCryptCtx, 0);
45-}
48#ifdef HAVE_RDRAND
49foreign import ccall unsafe "cpu_has_rdrand"
50 c_cpu_has_rdrand :: IO CInt
52foreign import ccall unsafe "get_rand_bytes"
53 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
55cpuHasRdRand :: IO Bool
56cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
57#endif
59data CryptHandle
60 = CH Word32
61#ifdef HAVE_RDRAND
62 | UseRdRand
63#endif
65-- Define the constants we need from WinCrypt.h
66msDefProv :: String
67msDefProv = "Microsoft Base Cryptographic Provider v1.0"
68provRSAFull :: Word32
69provRSAFull = 1
70cryptVerifyContext :: Word32
71cryptVerifyContext = fromIntegral 0xF0000000
73-- Declare the required CryptoAPI imports
74foreign import stdcall unsafe "CryptAcquireContextA"
75 c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
76foreign import stdcall unsafe "CryptGenRandom"
77 c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
78foreign import stdcall unsafe "CryptReleaseContext"
79 c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
81cryptAcquireCtx :: IO Word32
82cryptAcquireCtx =
83 alloca $ \handlePtr ->
84 withCString msDefProv $ \provName -> do
85 stat <- c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext
86 if (toBool stat)
87 then peek handlePtr
88 else fail "c_cryptAcquireCtx"
90cryptGenRandom :: Word32 -> Int -> IO B.ByteString
91cryptGenRandom h i =
92 BI.create i $ \c_buffer -> do
93 stat <- c_cryptGenRandom h (fromIntegral i) c_buffer
94 if (toBool stat)
95 then return ()
96 else fail "c_cryptGenRandom"
98cryptReleaseCtx :: Word32 -> IO ()
99cryptReleaseCtx h = do
100 stat <- c_cryptReleaseCtx h 0
101 if (toBool stat)
102 then return ()
103 else fail "c_cryptReleaseCtx"
105-- |Open a handle from which random data can be read
106openHandle :: IO CryptHandle
107openHandle = do
108#ifdef HAVE_RDRAND
109 b <- cpuHasRdRand
110 if b then return UseRdRand
111 else do
112#endif
113 liftM CH cryptAcquireCtx
115-- |Close the `CryptHandle`
116closeHandle :: CryptHandle -> IO ()
117closeHandle (CH h) = cryptReleaseCtx h
119-- |Read from `CryptHandle`
120hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
121hGetEntropy (CH h) n = cryptGenRandom h n
122#ifdef HAVE_RDRAND
123hGetEntropy UseRdRand n =
124 BI.create n $ \ptr -> do
125 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
126 when (r /= 0)
127 (fail "RDRand failed to gather entropy")
128#endif