support windows 64 bits

This commit is contained in:
3noch 2015-05-20 09:11:33 +01:00 committed by Vincent Hanquez
parent 80b379c98d
commit 9c1d9695c5

View File

@ -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
foreign import stdcall unsafe "CryptAcquireContextA"
c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO CryptCtx
foreign import stdcall unsafe "CryptGenRandom"
c_cryptGenRandom :: CryptCtx -> Word32 -> Ptr Word8 -> IO Int32
foreign import stdcall unsafe "CryptReleaseContext"
c_cryptReleaseCtx :: CryptCtx -> Word32 -> IO Int32
type DWORD = Word32
type BOOL = Int32
type BYTE = Word8
#if defined(ARCH_X86)
# define WINDOWS_CCONV stdcall
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 =
alloca $ \handlePtr ->
cryptAcquireCtx =
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