module Network.HTTP.Toolkit.InputStream (
InputStream(..)
, makeInputStream
, inputStreamFromHandle
, readInput
, unreadInput
, readAtLeast
) where
import Prelude hiding (read)
import Control.Monad (join, when, unless)
import Control.Exception
import System.IO (Handle)
import Data.IORef
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Network.HTTP.Toolkit.Error
data InputStream = InputStream {
_read :: IO ByteString
, _unread :: ByteString -> IO ()
}
inputStreamFromHandle :: Handle -> IO InputStream
inputStreamFromHandle h = makeInputStream (B.hGetSome h 4096)
makeInputStream :: IO ByteString -> IO InputStream
makeInputStream read = do
ref <- newIORef []
return $ InputStream {
_read = join $ atomicModifyIORef ref $ \xs -> case xs of
y : ys -> (ys, return y)
_ -> (xs, read)
, _unread = \x -> atomicModifyIORef ref $ \xs -> (x : xs, ())
}
readInput :: InputStream -> IO ByteString
readInput c = do
bs <- _read c
when (B.null bs) $ throwIO UnexpectedEndOfInput
return bs
unreadInput :: InputStream -> ByteString -> IO ()
unreadInput conn bs = unless (B.null bs) (_unread conn bs)
readAtLeast :: InputStream -> Int -> IO ByteString
readAtLeast conn n = readInput conn >>= go
where
go :: ByteString -> IO ByteString
go xs
| B.length xs < n = do
ys <- readInput conn
go (xs `B.append` ys)
| otherwise = return xs