Skip to content
Browse files

Attempt to work with advapi32 on Windows x64

This is hopeless. I get an internal error from ghci with GHC 7.6.1:

Loading package hashable-1.2.0.4 ... linking ...
Crash.hs: internal error: R_X86_64_PC32: High bits are set in 7fefc86ce1d for CryptReleaseContext
    (GHC version 7.6.1 for x86_64_unknown_mingw32)
  • Loading branch information...
1 parent 78a3000 commit 20a585265d8702e73291af8df841dfd95dfe6de5 @bos committed Jan 10, 2013
Showing with 80 additions and 15 deletions.
  1. +4 −13 Data/Hashable/RandomSource.hs
  2. +23 −0 Data/Hashable/RandomSource/Posix.hs
  3. +42 −0 Data/Hashable/RandomSource/Windows.hsc
  4. +11 −2 hashable.cabal
View
17 Data/Hashable/RandomSource.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+{-# LANGUAGE CPP #-}
module Data.Hashable.RandomSource
(
@@ -8,22 +8,13 @@ module Data.Hashable.RandomSource
import Data.ByteString as B
import Data.ByteString.Internal (create)
-import Foreign.C.Error (throwErrnoIfMinus1_)
-#if MIN_VERSION_base(4,5,0)
-import Foreign.C.Types (CInt(CInt))
+#ifdef _WIN32
+import Data.Hashable.RandomSource.Windows
#else
-import Foreign.C.Types (CInt)
+import Data.Hashable.RandomSource.Posix
#endif
-import Foreign.Ptr (Ptr)
getRandomBytes :: Int -> IO ByteString
getRandomBytes nbytes
| nbytes <= 0 = return B.empty
| otherwise = create nbytes $ flip (getRandomBytes_ "getRandomBytes") nbytes
-
-getRandomBytes_ :: String -> Ptr a -> Int -> IO ()
-getRandomBytes_ what ptr nbytes = do
- throwErrnoIfMinus1_ what $ c_getRandomBytes ptr (fromIntegral nbytes)
-
-foreign import ccall unsafe "hashable_getRandomBytes" c_getRandomBytes
- :: Ptr a -> CInt -> IO CInt
View
23 Data/Hashable/RandomSource/Posix.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+
+module Data.Hashable.RandomSource.Posix
+ (
+ getRandomBytes_
+ ) where
+
+import Data.ByteString as B
+import Data.ByteString.Internal (create)
+import Foreign.C.Error (throwErrnoIfMinus1_)
+#if MIN_VERSION_base(4,5,0)
+import Foreign.C.Types (CInt(CInt))
+#else
+import Foreign.C.Types (CInt)
+#endif
+import Foreign.Ptr (Ptr)
+
+getRandomBytes_ :: String -> Ptr a -> Int -> IO ()
+getRandomBytes_ what ptr nbytes = do
+ throwErrnoIfMinus1_ what $ c_getRandomBytes ptr (fromIntegral nbytes)
+
+foreign import ccall unsafe "hashable_getRandomBytes" c_getRandomBytes
+ :: Ptr a -> CInt -> IO CInt
View
42 Data/Hashable/RandomSource/Windows.hsc
@@ -0,0 +1,42 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+
+module Data.Hashable.RandomSource.Windows
+ (
+ getRandomBytes_
+ ) where
+
+#if __GLASGOW_HASKELL__ >= 704
+import Foreign.C.Types (CUIntPtr(..))
+#else
+import Foreign.C.Types (CUIntPtr)
+#endif
+import Control.Exception (bracket)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Ptr (Ptr, castPtr, nullPtr)
+import Foreign.Storable (peek)
+import System.Win32.Types (BYTE, DWORD, LPCTSTR, failIfFalse_)
+
+type HCRYPTPROV = CUIntPtr
+
+#include <windows.h>
+#include <wincrypt.h>
+
+getRandomBytes_ :: String -> Ptr a -> Int -> IO ()
+getRandomBytes_ what ptr nbytes = alloca $ \provPtr -> do
+ failIfFalse_ what $
+ c_cryptAcquireContext provPtr nullPtr nullPtr (#const PROV_RSA_FULL)
+ (#const CRYPT_VERIFYCONTEXT)
+ bracket (peek provPtr) (\p -> failIfFalse_ what $
+ c_cryptReleaseContext p 0) $ \prov ->
+ failIfFalse_ what $
+ c_cryptGenRandom prov (fromIntegral nbytes) (castPtr ptr)
+
+foreign import stdcall unsafe "wincrypt.h CryptAcquireContextW"
+ c_cryptAcquireContext :: Ptr HCRYPTPROV -> LPCTSTR -> LPCTSTR -> DWORD
+ -> DWORD -> IO Bool
+
+foreign import stdcall unsafe "wincrypt.h CryptReleaseContext"
+ c_cryptReleaseContext :: HCRYPTPROV -> DWORD -> IO Bool
+
+foreign import stdcall unsafe "wincrypt.h CryptGenRandom"
+ c_cryptGenRandom :: HCRYPTPROV -> DWORD -> Ptr BYTE -> IO Bool
View
13 hashable.cabal
@@ -52,8 +52,7 @@ Library
CPP-Options: -DGENERICS
Other-modules: Data.Hashable.Generic
- C-sources: cbits/getRandomBytes.c
- cbits/inthash.c
+ C-sources: cbits/inthash.c
cbits/siphash.c
if arch(i386)
C-sources: cbits/siphash-sse2.c
@@ -68,7 +67,12 @@ Library
if flag(fixed-salt)
Cpp-options: -DFIXED_SALT
if os(windows)
+ build-depends: Win32
extra-libraries: advapi32
+ other-modules: Data.Hashable.RandomSource.Windows
+ else
+ other-modules: Data.Hashable.RandomSource.Posix
+ c-sources: cbits/getRandomBytes.c
Test-suite tests
Type: exitcode-stdio-1.0
@@ -138,7 +142,12 @@ benchmark benchmarks
if flag(fixed-salt)
Cpp-options: -DFIXED_SALT
if os(windows)
+ build-depends: Win32
extra-libraries: advapi32
+ other-modules: Data.Hashable.RandomSource.Windows
+ else
+ other-modules: Data.Hashable.RandomSource.Posix
+ c-sources: cbits/getRandomBytes.c
source-repository head
type: git

0 comments on commit 20a5852

Please sign in to comment.
Something went wrong with that request. Please try again.