git.iko.soy/typeable/entropy
on main help sign in
Reduce CPP by making platform-specific modules.

Also, set halvm flag to default false. The behavior is inverse to what I thought I was told - flags with no default are True and not False.

commit17469e6ddc128f970521e6a16730d6794b6d2f98 authorThomas M. DuBuisson <tommd@galois.com> dateThu 29 May 2014, 10:03 (12 years ago) parenta8b0d89
4 files changed+251−216
System/Entropy.hs+8−215 System/EntropyNix.hs+111 System/EntropyWindows.hs+127 entropy.cabal+5−1
System/Entropy.hs+8−215
@@ -15,223 +15,18 @@
1515-}
1616
1717module System.Entropy
18− ( getEntropy
19− , CryptHandle
20− , openHandle
21− , hGetEntropy
22− , closeHandle
23− ) where
24−
25−import Control.Monad (liftM, when)
26−import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
27−import Foreign (allocaBytes)
28−import Data.ByteString as B
29−
18+ ( getEntropy,
3019#if defined(isWindows)
31−{- C example for windows rng - taken from a blog, can't recall which one but thank you!
32− #include <Windows.h>
33− #include <Wincrypt.h>
34− ...
35− //
36− // DISCLAIMER: Don't forget to check your error codes!!
37− // I am not checking as to make the example simple...
38− //
39− HCRYPTPROV hCryptCtx = NULL;
40− BYTE randomArray[128];
41−
42− CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
43− CryptGenRandom(hCryptCtx, 128, randomArray);
44− CryptReleaseContext(hCryptCtx, 0);
45−-}
46−
47−import Data.ByteString.Internal as BI
48−import Data.Int (Int32)
49−import Data.Word (Word32, Word8)
50−import Foreign.C.String (CString, withCString)
51−import Foreign.C.Types
52−import Foreign.Ptr (Ptr, nullPtr, castPtr)
53−import Foreign.Marshal.Alloc (alloca)
54−import Foreign.Marshal.Utils (toBool)
55−import Foreign.Storable (peek)
56−
57−#ifdef HAVE_RDRAND
58−foreign import ccall unsafe "cpu_has_rdrand"
59− c_cpu_has_rdrand :: IO CInt
60−
61−foreign import ccall unsafe "get_rand_bytes"
62− c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
63−
64−cpuHasRdRand :: IO Bool
65−cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
66−#endif
67−
68−data CryptHandle
69− = CH Word32
70−#ifdef HAVE_RDRAND
71− | UseRdRand
72−#endif
73−
74−-- Define the constants we need from WinCrypt.h
75−msDefProv :: String
76−msDefProv = "Microsoft Base Cryptographic Provider v1.0"
77−provRSAFull :: Word32
78−provRSAFull = fromIntegral 1
79−cryptVerifyContext :: Word32
80−cryptVerifyContext = fromIntegral 0xF0000000
81−
82−-- Declare the required CryptoAPI imports
83−foreign import stdcall unsafe "CryptAcquireContextA"
84− c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
85−foreign import stdcall unsafe "CryptGenRandom"
86− c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
87−foreign import stdcall unsafe "CryptReleaseContext"
88− c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
89−
90−cryptAcquireCtx :: IO Word32
91−cryptAcquireCtx =
92− alloca $ \handlePtr ->
93− withCString msDefProv $ \provName -> do
94− stat <- c_cryptAcquireCtx handlePtr nullPtr provName (fromIntegral 1) (fromIntegral cryptVerifyContext)
95− if (toBool stat)
96− then peek handlePtr
97− else fail "c_cryptAcquireCtx"
98−
99−cryptGenRandom :: Word32 -> Int -> IO B.ByteString
100−cryptGenRandom h i =
101− BI.create i $ \c_buffer -> do
102− stat <- c_cryptGenRandom (fromIntegral h) (fromIntegral i) c_buffer
103− if (toBool stat)
104− then return ()
105− else fail "c_cryptGenRandom"
106−
107−cryptReleaseCtx :: Word32 -> IO ()
108−cryptReleaseCtx h = do
109− stat <- c_cryptReleaseCtx h 0
110− if (toBool stat)
111− then return ()
112− else fail "c_cryptReleaseCtx"
113−
114−-- |Inefficiently get a specific number of bytes of cryptographically
115−-- secure random data using the system-specific facilities.
116−--
117−-- This function will return zero bytes
118−-- on platforms without a secure RNG!
119−getEntropy :: Int -> IO B.ByteString
120−getEntropy n = do
121−#ifdef HAVE_RDRAND
122− b <- cpuHasRdRand
123− if b then hGetEntropy UseRdRand n
124− else do
125−#endif
126− h <- cryptAcquireCtx
127− bs <- cryptGenRandom h n
128− let !bs' = bs
129− cryptReleaseCtx h
130− return bs'
131−
132−-- |Open a handle from which random data can be read
133−openHandle :: IO CryptHandle
134−openHandle = do
135−#ifdef HAVE_RDRAND
136− b <- cpuHasRdRand
137− if b then return UseRdRand
138− else do
139−#endif
140− liftM CH cryptAcquireCtx
141−
142−-- |Close the `CryptHandle`
143−closeHandle (CH h) = cryptReleaseCtx h
144−
145−-- |Read from `CryptHandle`
146−hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
147−hGetEntropy (CH h) n = cryptGenRandom h n
148−#ifdef HAVE_RDRAND
149−hGetEntropy UseRdRand n =
150− B.create n $ \ptr -> do
151− r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
152− when (r /= 0)
153− (fail "RDRand failed to gather entropy")
154−#endif
155−
156−#else
157−{- Not windows, assuming nix with a /dev/urandom -}
158−import Foreign.Ptr
159−import Foreign.C.Types
160−import Data.ByteString.Internal as B
161−#ifdef XEN
162−data CryptHandle = UseRdRand -- or die trying
163−#else
164−import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
165−
166−source :: FilePath
167−source = "/dev/urandom"
168−
169−-- |Handle for manual resource mangement
170−data CryptHandle
171− = CH Fd
172−#ifdef HAVE_RDRAND
173− | UseRdRand
174−#endif
175−#endif
176−
177−-- |Open a `CryptHandle`
178−openHandle :: IO CryptHandle
179−openHandle = do
180−#ifdef HAVE_RDRAND
181− b <- cpuHasRdRand
182− if b then return UseRdRand
183− else do
184−#endif
185−#ifdef XEN
186− error "entropy: On halvm there is no entropy other than RDRAND."
187−#else
188− liftM CH (openFd source ReadOnly Nothing defaultFileFlags)
189−#endif
190−
191−-- |Close the `CryptHandle`
192−closeHandle :: CryptHandle -> IO ()
193−#ifndef XEN
194−closeHandle (CH h) = closeFd h
195−#endif
196−#ifdef HAVE_RDRAND
197−closeHandle UseRdRand = return ()
198−#endif
199−
200−#ifndef XEN
201−fdReadBS :: Fd -> Int -> IO B.ByteString
202−fdReadBS fd n = do
203− allocaBytes n $ \buf -> do
204− rc <- fdReadBuf fd buf (fromIntegral n)
205− case rc of
206− 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF")
207− n' -> B.packCStringLen (castPtr buf, fromIntegral n')
208−#endif
209−
210−-- |Read random data from a `CryptHandle`
211−hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
212−#ifndef XEN
213−hGetEntropy (CH h) = fdReadBS h
20+ module System.EntropyWindows
21+ ) where
22+import System.EntropyWindows
21423#else
215−#ifdef HAVE_RDRAND
216−hGetEntropy UseRdRand = \n -> do
217− B.create n $ \ptr -> do
218− r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
219− when (r /= 0)
220− (fail "RDRand failed to gather entropy")
221−#endif
24+ module System.EntropyNix
25+ ) where
26+import System.EntropyNix
22227#endif
223−{- XEN -}
224−
225−#ifdef HAVE_RDRAND
226−foreign import ccall unsafe "cpu_has_rdrand"
227− c_cpu_has_rdrand :: IO CInt
22828
229−foreign import ccall unsafe "get_rand_bytes"
230− c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
231−
232−cpuHasRdRand :: IO Bool
233−cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
234−#endif
29+import qualified Data.ByteString as B
23530
23631-- |Inefficiently get a specific number of bytes of cryptographically
23732-- secure random data using the system-specific facilities.
@@ -245,5 +40,3 @@ getEntropy n = do
24540 e <- hGetEntropy h n
24641 closeHandle h
24742 return e
248−#endif
249−{- OS Test -}
System/EntropyNix.hsnew file+111
@@ -0,0 +1,111 @@
1+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-}
2+{-|
3+ Maintainer: Thomas.DuBuisson@gmail.com
4+ Stability: beta
5+ Portability: portable
6+
7+ Obtain entropy from system sources or x86 RDRAND when available.
8+
9+-}
10+
11+module System.EntropyNix
12+ ( CryptHandle
13+ , openHandle
14+ , hGetEntropy
15+ , closeHandle
16+ ) where
17+
18+import Control.Monad (liftM, when)
19+import Data.ByteString as B
20+import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
21+
22+import Foreign (allocaBytes)
23+import Foreign.Ptr
24+import Foreign.C.Types
25+import Data.ByteString.Internal as B
26+
27+#ifdef XEN
28+data CryptHandle = UseRdRand -- or die trying
29+#else
30+
31+import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
32+
33+source :: FilePath
34+source = "/dev/urandom"
35+
36+-- |Handle for manual resource mangement
37+data CryptHandle
38+ = CH Fd
39+#ifdef HAVE_RDRAND
40+ | UseRdRand
41+#endif
42+#endif
43+
44+-- |Open a `CryptHandle`
45+openHandle :: IO CryptHandle
46+openHandle = do
47+#ifdef HAVE_RDRAND
48+ b <- cpuHasRdRand
49+ if b then return UseRdRand
50+ else nonRDRandHandle
51+#else
52+ nonRDRandHandle
53+#endif
54+ where
55+#ifdef XEN
56+ nonRDRandHandle :: IO CryptHandle
57+ nonRDRandHandle = error "entropy: On halvm there is no entropy other than RDRAND."
58+#else
59+ nonRDRandHandle :: IO CryptHandle
60+ nonRDRandHandle = liftM CH (openFd source ReadOnly Nothing defaultFileFlags)
61+#endif
62+
63+-- |Close the `CryptHandle`
64+closeHandle :: CryptHandle -> IO ()
65+#ifndef XEN
66+closeHandle (CH h) = closeFd h
67+#endif
68+#ifdef HAVE_RDRAND
69+closeHandle UseRdRand = return ()
70+#endif
71+
72+-- |Read random data from a `CryptHandle`
73+#ifdef XEN
74+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
75+hGetEntropy UseRdRand = \n -> do
76+ B.create n $ \ptr -> do
77+ r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
78+ when (r /= 0)
79+ (fail "RDRand failed to gather entropy")
80+#else
81+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
82+hGetEntropy (CH h) = fdReadBS h
83+#ifdef HAVE_RDRAND
84+hGetEntropy UseRdRand = \n -> do
85+ B.create n $ \ptr -> do
86+ r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
87+ when (r /= 0)
88+ (fail "RDRand failed to gather entropy")
89+#endif
90+
91+fdReadBS :: Fd -> Int -> IO B.ByteString
92+fdReadBS fd n = do
93+ allocaBytes n $ \buf -> do
94+ rc <- fdReadBuf fd buf (fromIntegral n)
95+ case rc of
96+ 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF")
97+ n' -> B.packCStringLen (castPtr buf, fromIntegral n')
98+#endif
99+
100+
101+#ifdef HAVE_RDRAND
102+foreign import ccall unsafe "cpu_has_rdrand"
103+ c_cpu_has_rdrand :: IO CInt
104+
105+foreign import ccall unsafe "get_rand_bytes"
106+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
107+
108+cpuHasRdRand :: IO Bool
109+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
110+#endif
111+
System/EntropyWindows.hsnew file+127
@@ -0,0 +1,127 @@
1+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-}
2+{-|
3+ Maintainer: Thomas.DuBuisson@gmail.com
4+ Stability: beta
5+ Portability: portable
6+
7+ Obtain entropy from system sources or x86 RDRAND when available.
8+-}
9+
10+module System.EntropyWindows
11+ ( CryptHandle
12+ , openHandle
13+ , hGetEntropy
14+ , closeHandle
15+ ) where
16+
17+import Control.Monad (liftM, when)
18+import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
19+import Foreign (allocaBytes)
20+import Data.ByteString as B
21+import Data.ByteString.Internal as BI
22+import Data.Int (Int32)
23+import Data.Word (Word32, Word8)
24+import Foreign.C.String (CString, withCString)
25+import Foreign.C.Types
26+import Foreign.Ptr (Ptr, nullPtr, castPtr)
27+import Foreign.Marshal.Alloc (alloca)
28+import Foreign.Marshal.Utils (toBool)
29+import Foreign.Storable (peek)
30+
31+{- C example for windows rng - taken from a blog, can't recall which one but thank you!
32+ #include <Windows.h>
33+ #include <Wincrypt.h>
34+ ...
35+ //
36+ // DISCLAIMER: Don't forget to check your error codes!!
37+ // I am not checking as to make the example simple...
38+ //
39+ HCRYPTPROV hCryptCtx = NULL;
40+ BYTE randomArray[128];
41+
42+ CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
43+ CryptGenRandom(hCryptCtx, 128, randomArray);
44+ CryptReleaseContext(hCryptCtx, 0);
45+-}
46+
47+
48+#ifdef HAVE_RDRAND
49+foreign import ccall unsafe "cpu_has_rdrand"
50+ c_cpu_has_rdrand :: IO CInt
51+
52+foreign import ccall unsafe "get_rand_bytes"
53+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
54+
55+cpuHasRdRand :: IO Bool
56+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
57+#endif
58+
59+data CryptHandle
60+ = CH Word32
61+#ifdef HAVE_RDRAND
62+ | UseRdRand
63+#endif
64+
65+-- Define the constants we need from WinCrypt.h
66+msDefProv :: String
67+msDefProv = "Microsoft Base Cryptographic Provider v1.0"
68+provRSAFull :: Word32
69+provRSAFull = fromIntegral 1
70+cryptVerifyContext :: Word32
71+cryptVerifyContext = fromIntegral 0xF0000000
72+
73+-- Declare the required CryptoAPI imports
74+foreign import stdcall unsafe "CryptAcquireContextA"
75+ c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
76+foreign import stdcall unsafe "CryptGenRandom"
77+ c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
78+foreign import stdcall unsafe "CryptReleaseContext"
79+ c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
80+
81+cryptAcquireCtx :: IO Word32
82+cryptAcquireCtx =
83+ alloca $ \handlePtr ->
84+ withCString msDefProv $ \provName -> do
85+ stat <- c_cryptAcquireCtx handlePtr nullPtr provName (fromIntegral 1) (fromIntegral cryptVerifyContext)
86+ if (toBool stat)
87+ then peek handlePtr
88+ else fail "c_cryptAcquireCtx"
89+
90+cryptGenRandom :: Word32 -> Int -> IO B.ByteString
91+cryptGenRandom h i =
92+ BI.create i $ \c_buffer -> do
93+ stat <- c_cryptGenRandom (fromIntegral h) (fromIntegral i) c_buffer
94+ if (toBool stat)
95+ then return ()
96+ else fail "c_cryptGenRandom"
97+
98+cryptReleaseCtx :: Word32 -> IO ()
99+cryptReleaseCtx h = do
100+ stat <- c_cryptReleaseCtx h 0
101+ if (toBool stat)
102+ then return ()
103+ else fail "c_cryptReleaseCtx"
104+
105+-- |Open a handle from which random data can be read
106+openHandle :: IO CryptHandle
107+openHandle = do
108+#ifdef HAVE_RDRAND
109+ b <- cpuHasRdRand
110+ if b then return UseRdRand
111+ else do
112+#endif
113+ liftM CH cryptAcquireCtx
114+
115+-- |Close the `CryptHandle`
116+closeHandle (CH h) = cryptReleaseCtx h
117+
118+-- |Read from `CryptHandle`
119+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
120+hGetEntropy (CH h) n = cryptGenRandom h n
121+#ifdef HAVE_RDRAND
122+hGetEntropy UseRdRand n =
123+ BI.create n $ \ptr -> do
124+ r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
125+ when (r /= 0)
126+ (fail "RDRand failed to gather entropy")
127+#endif
entropy.cabal+5−1
@@ -28,10 +28,14 @@ extra-source-files: ./cbits/rdrand.c, ./cbits/rdrand.h, README.md
2828-- runs GHC to determine if the compiler supports RDRAND before proceeding.
2929flag halvm
3030 description: Build for the HaLVM
31−
31+ default: False
3232library
3333 ghc-options: -Wall -O2
3434 exposed-modules: System.Entropy
35+ if os(windows)
36+ other-modules: System.EntropyWindows
37+ else
38+ other-modules: System.EntropyNix
3539 other-extensions: CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables
3640 build-depends: base == 4.*, bytestring
3741 default-language: Haskell2010