@@ -17,6 +17,7 @@ module System.EntropyWindows
18import Control.Monad (liftM, when)
18import Control.Monad (liftM, when)
19import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
19import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
20+import System.Win32.Types (ULONG_PTR, errorWin)
20import Foreign (allocaBytes)
21import Foreign (allocaBytes)
21import Data.ByteString as B
22import Data.ByteString as B
22import Data.ByteString.Internal as BI
23import Data.ByteString.Internal as BI
@@ -63,8 +64,9 @@ cpuHasRdRand :: IO Bool
63cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
64cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
67+type HCRYPTPROV = ULONG_PTR
66data CryptHandle
68data CryptHandle
67− = CH Word32
69+ = CH HCRYPTPROV
70-- | Get random values from the hardward RNG or return Nothing if no
72-- | Get random values from the hardward RNG or return Nothing if no
@@ -86,7 +88,7 @@ hardwareRandom n =
86hardwareRandom _ = pure Nothing
88hardwareRandom _ = pure Nothing
89−-- Define the constants we need from WinCrypt.h
91+-- Define the constants we need from WinCrypt.h
90msDefProv :: String
92msDefProv :: String
91msDefProv = "Microsoft Base Cryptographic Provider v1.0"
93msDefProv = "Microsoft Base Cryptographic Provider v1.0"
92provRSAFull :: Word32
94provRSAFull :: Word32
@@ -94,37 +96,37 @@ provRSAFull = 1
94cryptVerifyContext :: Word32
96cryptVerifyContext :: Word32
95cryptVerifyContext = fromIntegral 0xF0000000
97cryptVerifyContext = fromIntegral 0xF0000000
97−-- Declare the required CryptoAPI imports
99+-- Declare the required CryptoAPI imports
98foreign import stdcall unsafe "CryptAcquireContextA"
100foreign import stdcall unsafe "CryptAcquireContextA"
99− c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
101+ c_cryptAcquireCtx :: Ptr HCRYPTPROV -> CString -> CString -> Word32 -> Word32 -> IO Int32
100foreign import stdcall unsafe "CryptGenRandom"
102foreign import stdcall unsafe "CryptGenRandom"
101− c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
103+ c_cryptGenRandom :: HCRYPTPROV -> Word32 -> Ptr Word8 -> IO Int32
102foreign import stdcall unsafe "CryptReleaseContext"
104foreign import stdcall unsafe "CryptReleaseContext"
103− c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
105+ c_cryptReleaseCtx :: HCRYPTPROV -> Word32 -> IO Int32
105−cryptAcquireCtx :: IO Word32
107+cryptAcquireCtx :: IO HCRYPTPROV
106cryptAcquireCtx =
108cryptAcquireCtx =
107− alloca $ \handlePtr ->
109+ alloca $ \handlePtr ->
108 withCString msDefProv $ \provName -> do
110 withCString msDefProv $ \provName -> do
109 stat <- c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext
111 stat <- c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext
110 if (toBool stat)
112 if (toBool stat)
111 then peek handlePtr
113 then peek handlePtr
112− else fail "c_cryptAcquireCtx"
114+ else errorWin "c_cryptAcquireCtx"
114−cryptGenRandom :: Word32 -> Int -> IO B.ByteString
116+cryptGenRandom :: HCRYPTPROV -> Int -> IO B.ByteString
115−cryptGenRandom h i =
117+cryptGenRandom h i =
116 BI.create i $ \c_buffer -> do
118 BI.create i $ \c_buffer -> do
117 stat <- c_cryptGenRandom h (fromIntegral i) c_buffer
119 stat <- c_cryptGenRandom h (fromIntegral i) c_buffer
118 if (toBool stat)
120 if (toBool stat)
119 then return ()
121 then return ()
120− else fail "c_cryptGenRandom"
122+ else errorWin "c_cryptGenRandom"
122−cryptReleaseCtx :: Word32 -> IO ()
124+cryptReleaseCtx :: HCRYPTPROV -> IO ()
123cryptReleaseCtx h = do
125cryptReleaseCtx h = do
124 stat <- c_cryptReleaseCtx h 0
126 stat <- c_cryptReleaseCtx h 0
125 if (toBool stat)
127 if (toBool stat)
126 then return ()
128 then return ()
127− else fail "c_cryptReleaseCtx"
129+ else errorWin "c_cryptReleaseCtx"
129-- |Open a handle from which random data can be read
131-- |Open a handle from which random data can be read
130openHandle :: IO CryptHandle
132openHandle :: IO CryptHandle