http-semantics 0.2.1 → 0.4.0
raw patch · 7 files changed
Files
- ChangeLog.md +10/−0
- Network/HTTP/Semantics/Client.hs +3/−1
- Network/HTTP/Semantics/Client/Internal.hs +10/−0
- Network/HTTP/Semantics/FillBuf.hs +33/−31
- Network/HTTP/Semantics/Server.hs +14/−3
- Network/HTTP/Semantics/Types.hs +1/−1
- http-semantics.cabal +3/−3
ChangeLog.md view
@@ -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
Network/HTTP/Semantics/Client.hs view
@@ -17,7 +17,7 @@ requestBuilder, -- ** Generalized streaming interface- OutBodyIface(..),+ OutBodyIface (..), requestStreamingIface, -- ** Trailers maker@@ -39,7 +39,9 @@ -- * Aux Aux,+ defaultAux, auxPossibleClientStreams,+ auxSendPing, -- * Types Scheme,
Network/HTTP/Semantics/Client/Internal.hs view
@@ -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 ()+ }
Network/HTTP/Semantics/FillBuf.hs view
@@ -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
Network/HTTP/Semantics/Server.hs view
@@ -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+ } ----------------------------------------------------------------
Network/HTTP/Semantics/Types.hs view
@@ -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
http-semantics.cabal view
@@ -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 <kazu@iij.ad.jp> author: Kazu Yamamoto <kazu@iij.ad.jp> 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