I have some code that reads (infrequently) small amounts of data from /dev/urandom,  and because this is pretty infrequent,  I simply open the handle and close it every time I need some random bytes.   

The problem is that I recently discovered that,  thanks to buffering within GHC,   I was actually reading 8096 bytes when I only need 16 bytes,  and thus wasting entropy.   Moreover  calling hSetBuffering  handle NoBuffering did not change this behavior.   

I'm not sure if this behavior is a bug or a feature,  but in any case it's unacceptable for dealing with /dev/urandom.   Probably the simplest way to fix this is to write a little C helper function that will read from /dev/urandom for me,  so that I have precise control over the system calls involved.     But I'm curious if GHC can manage this use case correctly;   I've just started digging into the GHC.IO code myself.

Best,
Leon

{-# LANGUAGE BangPatterns, ViewPatterns #-}

import           Control.Applicative
import           Data.Bits
import           Data.Word(Word64)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import           Data.ByteString.Internal (c2w)
import qualified System.IO        as IO
import qualified Data.Binary.Get        as Get

showHex :: Word64 -> S.ByteString
showHex n = s
  where
    (!s,_) = S.unfoldrN 16 f n

    f n = Just (char (n `shiftR` 60), n `shiftL` 4)

    char (fromIntegral -> i)
      | i < 10    = (c2w '0' -  0) + i
      | otherwise = (c2w 'a' - 10) + i

twoRandomWord64s :: IO (Word64,Word64)
twoRandomWord64s = IO.withBinaryFile "/dev/urandom" IO.ReadMode $ \handle -> do
   IO.hSetBuffering handle IO.NoBuffering
   Get.runGet ((,) <$> Get.getWord64host <*> Get.getWord64host) <$> L.hGet handle 16

main = do
   (x,y) <- twoRandomWord64s
   S.hPutStrLn IO.stdout (S.append (showHex x) (showHex y))


{- Relevant part of strace:

open("/dev/urandom", O_RDONLY|O_NOCTTY|O_NONBLOCK) = 3
fstat(3, {st_mode=S_IFCHR|0666, st_rdev=makedev(1, 9), ...}) = 0
ioctl(3, SNDCTL_TMR_TIMEBASE or TCGETS, 0x7ffff367e528) = -1 EINVAL (Invalid argument)
ioctl(3, SNDCTL_TMR_TIMEBASE or TCGETS, 0x7ffff367e528) = -1 EINVAL (Invalid argument)
read(3, "N\304\4\367/\26c\"\3218\237f\214yKg~i\310\r\262\"\224H\340y\n\376V?\265\344"..., 8096) = 8096
close(3)                                = 0

-}