git.iko.soy/typeable/entropy
on 3be0b77 help sign in
typeable/entropy/System/EntropyWindows.hs
141 lines 4.3 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.
8-}
10module System.EntropyWindows
11 ( CryptHandle
12 , openHandle
13 , hGetEntropy
14 , closeHandle
15 , hardwareRandom
16 ) where
18import Control.Monad (liftM, when)
19import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
20import System.Win32.Types (ULONG_PTR, errorWin)
21import Foreign (allocaBytes)
22import Data.ByteString as B
23import Data.ByteString.Internal as BI
24import Data.Int (Int32)
25import Data.Bits (xor)
26import Data.Word (Word32, Word8)
27import Foreign.C.String (CString, withCString)
28import Foreign.C.Types
29import Foreign.Ptr (Ptr, nullPtr, castPtr)
30import Foreign.Marshal.Alloc (alloca)
31import Foreign.Marshal.Utils (toBool)
32import Foreign.Storable (peek)
34{- C example for windows rng - taken from a blog, can't recall which one but thank you!
35 #include <Windows.h>
36 #include <Wincrypt.h>
37 ...
38 //
39 // DISCLAIMER: Don't forget to check your error codes!!
40 // I am not checking as to make the example simple...
41 //
42 HCRYPTPROV hCryptCtx = NULL;
43 BYTE randomArray[128];
45 CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
46 CryptGenRandom(hCryptCtx, 128, randomArray);
47 CryptReleaseContext(hCryptCtx, 0);
48-}
51#ifdef arch_i386
52-- See .cabal wrt GCC 4.8.2 asm compilation bug
53#undef HAVE_RDRAND
54#endif
56#ifdef HAVE_RDRAND
57foreign import ccall unsafe "cpu_has_rdrand"
58 c_cpu_has_rdrand :: IO CInt
60foreign import ccall unsafe "get_rand_bytes"
61 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
63cpuHasRdRand :: IO Bool
64cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
65#endif
67type HCRYPTPROV = ULONG_PTR
68data CryptHandle
69 = CH HCRYPTPROV
72-- | Get random values from the hardware RNG or return Nothing if no
73-- supported hardware RNG is available.
74--
75-- Supported hardware:
76-- * RDRAND
77-- * Patches welcome
78hardwareRandom :: Int -> IO (Maybe B.ByteString)
79#ifdef HAVE_RDRAND
80hardwareRandom n =
81 do b <- cpuHasRdRand
82 if b
83 then Just <$> BI.create n (\ptr ->
84 do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
85 when (r /= 0) (fail "RDRand failed to gather entropy"))
86 else pure Nothing
87#else
88hardwareRandom _ = pure Nothing
89#endif
91-- Define the constants we need from WinCrypt.h
92msDefProv :: String
93msDefProv = "Microsoft Base Cryptographic Provider v1.0"
94provRSAFull :: Word32
95provRSAFull = 1
96cryptVerifyContext :: Word32
97cryptVerifyContext = fromIntegral 0xF0000000
99-- Declare the required CryptoAPI imports
100foreign import stdcall unsafe "CryptAcquireContextA"
101 c_cryptAcquireCtx :: Ptr HCRYPTPROV -> CString -> CString -> Word32 -> Word32 -> IO Int32
102foreign import stdcall unsafe "CryptGenRandom"
103 c_cryptGenRandom :: HCRYPTPROV -> Word32 -> Ptr Word8 -> IO Int32
104foreign import stdcall unsafe "CryptReleaseContext"
105 c_cryptReleaseCtx :: HCRYPTPROV -> Word32 -> IO Int32
107cryptAcquireCtx :: IO HCRYPTPROV
108cryptAcquireCtx =
109 alloca $ \handlePtr ->
110 withCString msDefProv $ \provName -> do
111 stat <- c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext
112 if (toBool stat)
113 then peek handlePtr
114 else errorWin "c_cryptAcquireCtx"
116cryptGenRandom :: HCRYPTPROV -> Int -> IO B.ByteString
117cryptGenRandom h i =
118 BI.create i $ \c_buffer -> do
119 stat <- c_cryptGenRandom h (fromIntegral i) c_buffer
120 if (toBool stat)
121 then return ()
122 else errorWin "c_cryptGenRandom"
124cryptReleaseCtx :: HCRYPTPROV -> IO ()
125cryptReleaseCtx h = do
126 stat <- c_cryptReleaseCtx h 0
127 if (toBool stat)
128 then return ()
129 else errorWin "c_cryptReleaseCtx"
131-- |Open a handle from which random data can be read
132openHandle :: IO CryptHandle
133openHandle = CH `fmap` cryptAcquireCtx
135-- |Close the `CryptHandle`
136closeHandle :: CryptHandle -> IO ()
137closeHandle (CH h) = cryptReleaseCtx h
139-- |Read from `CryptHandle`
140hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
141hGetEntropy (CH h) n = cryptGenRandom h n