module System.Crypto.Random
( getEntropy
, CryptHandle
, openHandle
, hGetEntropy
, closeHandle
) where
import System.IO (openFile, hClose, IOMode(..), Handle)
import Control.Monad (liftM)
import Data.ByteString as B
import Data.ByteString.Lazy as L
import Crypto.Types
#if defined(isWindows)
import Data.ByteString.Internal as B
import Data.Int (Int32)
import Data.Word (Word32, Word8)
import Foreign.C.String (CString, withCString)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (toBool)
import Foreign.Storable (peek)
newtype CryptHandle = CH Word32
msDefProv :: String
msDefProv = "Microsoft Base Cryptographic Provider v1.0"
provRSAFull :: Word32
provRSAFull = fromIntegral 1
cryptVerifyContext :: Word32
cryptVerifyContext = fromIntegral 0xF0000000
foreign import stdcall unsafe "CryptAcquireContextA"
c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
foreign import stdcall unsafe "CryptGenRandom"
c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
foreign import stdcall unsafe "CryptReleaseContext"
c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
cryptAcquireCtx :: IO Word32
cryptAcquireCtx =
alloca $ \handlePtr ->
withCString msDefProv $ \provName -> do
stat <- c_cryptAcquireCtx handlePtr nullPtr provName (fromIntegral 1) (fromIntegral cryptVerifyContext)
if (toBool stat)
then peek handlePtr
else fail "c_cryptAcquireCtx"
cryptGenRandom :: Word32 -> Int -> IO B.ByteString
cryptGenRandom h i =
B.create i $ \c_buffer -> do
stat <- c_cryptGenRandom (fromIntegral h) (fromIntegral i) c_buffer
if (toBool stat)
then return ()
else fail "c_cryptGenRandom"
cryptReleaseCtx :: Word32 -> IO ()
cryptReleaseCtx h = do
stat <- c_cryptReleaseCtx h 0
if (toBool stat)
then return ()
else fail "c_cryptReleaseCtx"
getEntropy :: ByteLength -> IO B.ByteString
getEntropy n = do
h <- cryptAcquireCtx
bs <- cryptGenRandom h n
let !bs' = bs
cryptReleaseCtx h
return bs'
openHandle :: IO CryptHandle
openHandle = liftM CH cryptAcquireCtx
closeHandle (CH h) = cryptReleaseCtx h
hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
hGetEntropy (CH h) = cryptGenRandom h
#else
newtype CryptHandle = CH Handle
openHandle :: IO CryptHandle
openHandle = liftM CH (openFile "/dev/urandom" ReadMode)
closeHandle :: CryptHandle -> IO ()
closeHandle (CH h) = hClose h
hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
hGetEntropy (CH h) = B.hGet h
getEntropy :: ByteLength -> IO B.ByteString
getEntropy = getEnt "/dev/urandom"
getEnt :: FilePath -> ByteLength -> IO B.ByteString
getEnt file n = do
h <- openFile file ReadMode
bs <- B.hGet h n
let !bs' = bs
hClose h
return bs'
#endif