diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,15 @@ # ChangeLog for http-semantics +## 0.3.1 + +* Adding defaultAux and auxSendPing for client. +* Adding defaultAux for server. + +## 0.3.0 + +* Breaking change: fillFileBodyGetNext takes Sentinel instead of + IO () to close files on time. + ## 0.2.1 * Add outBodyCancel to OutBodyIface diff --git a/Network/HTTP/Semantics/Client.hs b/Network/HTTP/Semantics/Client.hs --- a/Network/HTTP/Semantics/Client.hs +++ b/Network/HTTP/Semantics/Client.hs @@ -17,7 +17,7 @@ requestBuilder, -- ** Generalized streaming interface - OutBodyIface(..), + OutBodyIface (..), requestStreamingIface, -- ** Trailers maker @@ -39,7 +39,9 @@ -- * Aux Aux, + defaultAux, auxPossibleClientStreams, + auxSendPing, -- * Types Scheme, diff --git a/Network/HTTP/Semantics/Client/Internal.hs b/Network/HTTP/Semantics/Client/Internal.hs --- a/Network/HTTP/Semantics/Client/Internal.hs +++ b/Network/HTTP/Semantics/Client/Internal.hs @@ -2,6 +2,7 @@ Request (..), Response (..), Aux (..), + defaultAux, ) where import Network.HTTP.Semantics.Types (InpObj (..), OutObj (..)) @@ -16,4 +17,13 @@ data Aux = Aux { auxPossibleClientStreams :: IO Int -- ^ How many streams can be created without blocking. + , auxSendPing :: IO () + -- ^ Sending a ping. } + +defaultAux :: Aux +defaultAux = + Aux + { auxPossibleClientStreams = return 0 + , auxSendPing = return () + } diff --git a/Network/HTTP/Semantics/FillBuf.hs b/Network/HTTP/Semantics/FillBuf.hs --- a/Network/HTTP/Semantics/FillBuf.hs +++ b/Network/HTTP/Semantics/FillBuf.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Network.HTTP.Semantics.FillBuf ( @@ -25,7 +22,7 @@ import Data.Int (Int64) import Data.Maybe import Foreign.Ptr (plusPtr) -import Network.ByteOrder +import Network.ByteOrder hiding (start) import Network.HTTP.Semantics.Client ---------------------------------------------------------------- @@ -35,7 +32,7 @@ -- In @http2@ this will be used to construct a single HTTP2 @DATA@ frame -- (see discussion of the maximum number of bytes, below). type DynaNext = - Buffer + Buffer -- ^ Write buffer -> Int -- ^ Maximum number of bytes we are allowed to write @@ -76,15 +73,14 @@ -- | Action to run prior to terminating the stream type CleanupStream = IO () -data IsEndOfStream = - -- | The stream is not yet terminated - NotEndOfStream - - -- | The stream is terminated - -- - -- In addition to indicating that the stream is terminated, we can also - -- specify an optional `Cleanup` handler to be run. - | EndOfStream (Maybe CleanupStream) +data IsEndOfStream + = -- | The stream is not yet terminated + NotEndOfStream + | -- | The stream is terminated + -- + -- In addition to indicating that the stream is terminated, we can also + -- specify an optional `Cleanup` handler to be run. + EndOfStream (Maybe CleanupStream) ---------------------------------------------------------------- @@ -94,11 +90,11 @@ return $ nextForBuilder len signal fillFileBodyGetNext - :: PositionRead -> FileOffset -> ByteCount -> IO () -> DynaNext -fillFileBodyGetNext pread start bytecount refresh buf room = do + :: PositionRead -> FileOffset -> ByteCount -> Sentinel -> DynaNext +fillFileBodyGetNext pread start bytecount sentinel buf room = do len <- pread start (mini room bytecount) buf let len' = fromIntegral len - return $ nextForFile len' pread (start + len) (bytecount - len) refresh + nextForFile len' pread (start + len) (bytecount - len) sentinel fillStreamBodyGetNext :: IO (Maybe StreamingChunk) -> DynaNext fillStreamBodyGetNext takeQ = loop 0 @@ -116,10 +112,10 @@ fillBufBuilderOne minReq writer buf0 room = do if room >= minReq then do - (len, signal) <- writer buf0 room - return $ nextForBuilder len signal + (len, signal) <- writer buf0 room + return $ nextForBuilder len signal else do - return $ Next 0 True (Just $ fillBufBuilderOne minReq writer) + return $ Next 0 True (Just $ fillBufBuilderOne minReq writer) fillBufBuilderTwo :: ByteString -> B.BufferWriter -> DynaNext fillBufBuilderTwo bs writer buf0 room @@ -202,10 +198,10 @@ let enoughRoom = maybe True (room >=) mMinReq if enoughRoom then do - writeResult <- writer buf room - ranWriter writeResult total buf room + writeResult <- writer buf room + ranWriter writeResult total buf room else do - return $ Next total True (Just $ goMore mMinReq writer 0) + return $ Next total True (Just $ goMore mMinReq writer 0) goChunk :: ByteString -> B.BufferWriter -> NextWithTotal goChunk bs writer = \total buf room -> @@ -221,19 +217,25 @@ ---------------------------------------------------------------- -fillBufFile :: PositionRead -> FileOffset -> ByteCount -> IO () -> DynaNext -fillBufFile pread start bytes refresh buf room = do +fillBufFile :: PositionRead -> FileOffset -> ByteCount -> Sentinel -> DynaNext +fillBufFile pread start bytes sentinel buf room = do len <- pread start (mini room bytes) buf - refresh + case sentinel of + Refresher refresh -> refresh + _ -> return () let len' = fromIntegral len - return $ nextForFile len' pread (start + len) (bytes - len) refresh + nextForFile len' pread (start + len) (bytes - len) sentinel nextForFile - :: BytesFilled -> PositionRead -> FileOffset -> ByteCount -> IO () -> Next -nextForFile 0 _ _ _ _ = Next 0 True Nothing -- let's flush -nextForFile len _ _ 0 _ = Next len False Nothing + :: BytesFilled -> PositionRead -> FileOffset -> ByteCount -> Sentinel -> IO Next +nextForFile 0 _ _ _ _ = return $ Next 0 True Nothing -- let's flush +nextForFile len _ _ 0 sentinel = do + case sentinel of + Closer close -> close + _ -> return () + return $ Next len False Nothing nextForFile len pread start bytes refresh = - Next len False $ Just $ fillBufFile pread start bytes refresh + return $ Next len False $ Just $ fillBufFile pread start bytes refresh {-# INLINE mini #-} mini :: Int -> Int64 -> Int64 diff --git a/Network/HTTP/Semantics/Server.hs b/Network/HTTP/Semantics/Server.hs --- a/Network/HTTP/Semantics/Server.hs +++ b/Network/HTTP/Semantics/Server.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Network.HTTP.Semantics.Server ( -- * HTTP server Server, @@ -20,6 +18,7 @@ -- * Aux Aux, + defaultAux, auxTimeHandle, auxMySockAddr, auxPeerSockAddr, @@ -34,7 +33,7 @@ responseBuilder, -- ** Generalized streaming interface - OutBodyIface(..), + OutBodyIface (..), responseStreamingIface, -- ** Accessing response @@ -66,12 +65,24 @@ import qualified Data.ByteString.UTF8 as UTF8 import Data.IORef import qualified Network.HTTP.Types as H +import Network.Socket +import qualified System.TimeManager as T import Network.HTTP.Semantics import Network.HTTP.Semantics.File import Network.HTTP.Semantics.ReadN import Network.HTTP.Semantics.Server.Internal import Network.HTTP.Semantics.Status + +---------------------------------------------------------------- + +defaultAux :: Aux +defaultAux = + Aux + { auxTimeHandle = T.emptyHandle + , auxMySockAddr = SockAddrInet 0 0 + , auxPeerSockAddr = SockAddrInet 0 0 + } ---------------------------------------------------------------- diff --git a/Network/HTTP/Semantics/Types.hs b/Network/HTTP/Semantics/Types.hs --- a/Network/HTTP/Semantics/Types.hs +++ b/Network/HTTP/Semantics/Types.hs @@ -61,7 +61,7 @@ | OutBodyFile FileSpec data OutBodyIface = OutBodyIface - { outBodyUnmask :: (forall x. IO x -> IO x) + { outBodyUnmask :: forall x. IO x -> IO x -- ^ Unmask exceptions in the thread spawned for the request body -- -- This is used in the client: we spawn the new thread for the request body diff --git a/http-semantics.cabal b/http-semantics.cabal --- a/http-semantics.cabal +++ b/http-semantics.cabal @@ -1,12 +1,12 @@ cabal-version: 3.0 name: http-semantics -version: 0.2.1 +version: 0.4.0 license: BSD-3-Clause license-file: LICENSE maintainer: Kazu Yamamoto author: Kazu Yamamoto homepage: https://github.com/kazu-yamamoto/http-semantics -synopsis: HTTP senmatics libarry +synopsis: HTTP semantics library description: Version-independent common parts of HTTP category: Network build-type: Simple @@ -46,5 +46,5 @@ http-types >=0.12 && <0.13, network, network-byte-order, - time-manager, + time-manager >= 0.2.4, utf8-string