Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- type ReadN = Int -> IO ByteString
- defaultReadN :: Socket -> IORef (Maybe ByteString) -> ReadN
- type PositionRead = FileOffset -> ByteCount -> Buffer -> IO ByteCount
- type PositionReadMaker = FilePath -> IO (PositionRead, Sentinel)
- data Sentinel
- defaultPositionReadMaker :: PositionReadMaker
- data Next = Next BytesFilled Bool (Maybe DynaNext)
- type DynaNext = Buffer -> BufferSize -> Int -> IO Next
- type BytesFilled = Int
- data StreamingChunk
- fillBuilderBodyGetNext :: Builder -> DynaNext
- fillFileBodyGetNext :: PositionRead -> FileOffset -> ByteCount -> IO () -> DynaNext
- fillStreamBodyGetNext :: IO (Maybe StreamingChunk) -> DynaNext
- type TrailersMaker = Maybe ByteString -> IO NextTrailersMaker
- defaultTrailersMaker :: TrailersMaker
- data NextTrailersMaker
- runTrailersMaker :: TrailersMaker -> Buffer -> Int -> IO NextTrailersMaker
Reading n bytes
defaultReadN :: Socket -> IORef (Maybe ByteString) -> ReadN Source #
Naive implementation for readN.
Position read
type PositionRead = FileOffset -> ByteCount -> Buffer -> IO ByteCount Source #
Position read for files.
type PositionReadMaker = FilePath -> IO (PositionRead, Sentinel) Source #
Making a position read and its closer.
defaultPositionReadMaker :: PositionReadMaker Source #
Position read based on Handle
.
Filling a buffer
type BytesFilled = Int Source #
fillFileBodyGetNext :: PositionRead -> FileOffset -> ByteCount -> IO () -> DynaNext Source #
type TrailersMaker = Maybe ByteString -> IO NextTrailersMaker Source #
Trailers maker. A chunks of the response body is passed
with Just
. The maker should update internal state
with the ByteString
and return the next trailers maker.
When response body reaches its end,
Nothing
is passed and the maker should generate
trailers. An example:
{-# LANGUAGE BangPatterns #-} import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C8 import Crypto.Hash (Context, SHA1) -- cryptonite import qualified Crypto.Hash as CH -- Strictness is important for Context. trailersMaker :: Context SHA1 -> Maybe ByteString -> IO NextTrailersMaker trailersMaker ctx Nothing = return $ Trailers [("X-SHA1", sha1)] where !sha1 = C8.pack $ show $ CH.hashFinalize ctx trailersMaker ctx (Just bs) = return $ NextTrailersMaker $ trailersMaker ctx' where !ctx' = CH.hashUpdate ctx bs
Usage example:
let h2rsp = responseFile ... maker = trailersMaker (CH.hashInit :: Context SHA1) h2rsp' = setResponseTrailersMaker h2rsp maker
defaultTrailersMaker :: TrailersMaker Source #
TrailersMake to create no trailers.
data NextTrailersMaker Source #
Either the next trailers maker or final trailers.
runTrailersMaker :: TrailersMaker -> Buffer -> Int -> IO NextTrailersMaker Source #
Running trailers-maker.
bufferIO buf siz $ \bs -> tlrmkr (Just bs)