support windows 64 bits

Crypto/Random/Entropy/Windows.hs

@@ -20,18 +20,10 @@ import Foreign.Ptr (Ptr, nullPtr)
 import Foreign.Marshal.Alloc (alloca)
 import Foreign.Marshal.Utils (toBool)
 import Foreign.Storable (peek)
+import System.Win32.Types (getLastError)
 
 import Crypto.Random.Entropy.Source
 
--- Define the constants we need from WinCrypt.h 
-msDefProv :: String
-msDefProv = "Microsoft Base Cryptographic Provider v1.0"
-
-provRSAFull :: Word32
-provRSAFull = 1
-
-cryptVerifyContext :: Word32
-cryptVerifyContext = 0xF0000000
 
 -- | handle to windows crypto API for random generation
 data WinCryptoAPI = WinCryptoAPI
@@ -43,26 +35,52 @@ instance EntropySource WinCryptoAPI where
     entropyGather WinCryptoAPI ptr n = do
         mctx <- cryptAcquireCtx
         case mctx of
-            Nothing  -> error "cannot re-grab win crypto api"
+            Nothing  -> do
+                lastError <- getLastError
+                fail $ "cannot re-grab win crypto api: error " ++ show lastError
             Just ctx -> do
                 r <- cryptGenRandom ctx ptr n
                 cryptReleaseCtx ctx
                 return r
     entropyClose WinCryptoAPI = return ()
 
-type CryptCtx = Word32
 
--- Declare the required CryptoAPI imports 
+type DWORD = Word32
-foreign import stdcall unsafe "CryptAcquireContextA"
+type BOOL  = Int32
-   c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO CryptCtx
+type BYTE  = Word8
-foreign import stdcall unsafe "CryptGenRandom"
+
-   c_cryptGenRandom :: CryptCtx -> Word32 -> Ptr Word8 -> IO Int32
+#if defined(ARCH_X86)
-foreign import stdcall unsafe "CryptReleaseContext"
+# define WINDOWS_CCONV stdcall
-   c_cryptReleaseCtx :: CryptCtx -> Word32 -> IO Int32
+type CryptCtx = Word32
+#elif defined(ARCH_X86_64)
+# define WINDOWS_CCONV ccall
+type CryptCtx = Word64
+#else
+# error Unknown mingw32 arch
+#endif
+
+-- Declare the required CryptoAPI imports
+foreign import WINDOWS_CCONV unsafe "CryptAcquireContextA"
+   c_cryptAcquireCtx :: Ptr CryptCtx -> CString -> CString -> DWORD -> DWORD -> IO BOOL
+foreign import WINDOWS_CCONV unsafe "CryptGenRandom"
+   c_cryptGenRandom :: CryptCtx -> DWORD -> Ptr BYTE -> IO BOOL
+foreign import WINDOWS_CCONV unsafe "CryptReleaseContext"
+   c_cryptReleaseCtx :: CryptCtx -> DWORD -> IO BOOL
+
+
+-- Define the constants we need from WinCrypt.h
+msDefProv :: String
+msDefProv = "Microsoft Base Cryptographic Provider v1.0"
+
+provRSAFull :: DWORD
+provRSAFull = 1
+
+cryptVerifyContext :: DWORD
+cryptVerifyContext = 0xF0000000
 
 cryptAcquireCtx :: IO (Maybe CryptCtx)
-cryptAcquireCtx = 
+cryptAcquireCtx =
-    alloca $ \handlePtr -> 
+    alloca $ \handlePtr ->
     withCString msDefProv $ \provName -> do
         r <- toBool `fmap` c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext
         if r
@@ -79,4 +97,6 @@ cryptReleaseCtx h = do
     success <- toBool `fmap` c_cryptReleaseCtx h 0
     if success
         then return ()
-        else fail "cryptReleaseCtx"
+        else do
+            lastError <- getLastError
+            fail $ "cryptReleaseCtx: error " ++ show lastError