[Haskell-cafe] Re: DevRandom

[Yitzchak Gale]

It's short, so I'll post it here.
Any comments?

Thanks,
-Yitz

module DevRandom where

import System.IO
import System.IO.Error
import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.Ptr

data BlockingMode = Blocking | NonBlocking
  deriving (Eq, Show)

-- Read data from the system random device.
-- Return Nothing if there is currently not
-- enough entropy in the system random device.
devRandom :: Storable a => IO (Maybe a)
devRandom = readDev "/dev/random" NonBlocking

-- Read data from the system random device.
-- If necessary, wait until there is
-- enough entropy in the system random device.
devRandomWait :: Storable a => IO a
devRandomWait = readDev dev Blocking >>= maybe (devRandomError dev) return
  where
    dev = "/dev/random"

-- Read data from the system random device.
-- If there is currently not enough entropy
-- in the system random device, use a lower
-- quality source of randomness instead.
devURandom :: Storable a => IO a
devURandom = readDev dev NonBlocking >>= maybe (devRandomError dev) return
  where
    dev = "/dev/urandom"

readDev :: Storable a => FilePath -> BlockingMode -> IO (Maybe a)
readDev dev mode = do
    h <- openFile dev ReadMode
    hSetBuffering h NoBuffering
    alloca $ getMaybe h undefined
  where
    getMaybe :: Storable a => Handle -> a -> Ptr a -> IO (Maybe a)
    getMaybe h undef ptr = do
      let size = sizeOf undef
      n <- case mode of
             Blocking    -> hGetBuf            h ptr size
             NonBlocking -> hGetBufNonBlocking h ptr size
      if n < size
        then return Nothing
        else peek ptr >>= return . Just

devRandomError :: FilePath -> IO a
devRandomError p = ioError $ mkIOError illegalOperationErrorType
  "Unable to read from the system random device" Nothing (Just p)