http-semantics 0.2.1 → 0.4.2
raw patch · 9 files changed
Files
- ChangeLog.md +28/−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/ReadN.hs +19/−4
- Network/HTTP/Semantics/Server.hs +16/−3
- Network/HTTP/Semantics/Server/Internal.hs +7/−0
- Network/HTTP/Semantics/Types.hs +12/−8
- http-semantics.cabal +5/−4
ChangeLog.md view
@@ -1,5 +1,33 @@ # ChangeLog for http-semantics +## 0.4.2++* `defaultReadNWith` is `defaultReadN` with an `STM` action beside each+ receive. When it fires the read answers with the empty string, which is+ what `ReadN` already means by end of input, so a reader blocked in it can+ be given up on without closing the socket under it or throwing into it --+ neither of which works everywhere.++## 0.4.1++* Add `auxSendInformational` to the server `Aux` for sending 1xx informational+ responses (e.g. 103 Early Hints) ahead of the final response.++## 0.4.0++* This version is idential to v0.3.1 which includes breaking changes+ and thus is deprecated.++## 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/ReadN.hs view
@@ -2,9 +2,11 @@ -- * Reading n bytes ReadN, defaultReadN,+ defaultReadNWith, ) where +import Control.Concurrent.STM import qualified Data.ByteString as B import Data.IORef import Network.Socket@@ -19,13 +21,25 @@ -- (It is probably quite rare anyway to want concurrent reads from the /same/ -- network socket.) defaultReadN :: Socket -> IORef (Maybe B.ByteString) -> ReadN-defaultReadN _ _ 0 = return B.empty-defaultReadN s ref n = do+defaultReadN s ref = defaultReadNWith s ref retry++-- | 'defaultReadN' which the caller can give up on. The 'STM' action is+-- waited for beside each receive; when it fires, the read answers with the+-- empty string, which is how 'ReadN' already says that there is nothing more.+--+-- /NOTE/: the bytes read so far are discarded, so this ends a connection+-- rather than pausing one. The caller cannot tell a give-up from the peer+-- hanging up; whoever fired the 'STM' action knows which it was.+--+-- @since 0.4.2+defaultReadNWith :: Socket -> IORef (Maybe B.ByteString) -> STM a -> ReadN+defaultReadNWith _ _ _ 0 = return B.empty+defaultReadNWith s ref giveUp n = do mbs <- readIORef ref writeIORef ref Nothing case mbs of Nothing -> do- bs <- N.recv s n+ bs <- recv1 n if B.null bs then return B.empty else@@ -40,9 +54,10 @@ return bs0 | otherwise -> loop bs where+ recv1 n' = either (const B.empty) id <$> N.recvWith s n' giveUp loop bs = do let n' = n - B.length bs- bs1 <- N.recv s n'+ bs1 <- recv1 n' if B.null bs1 then return B.empty else do
Network/HTTP/Semantics/Server.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.HTTP.Semantics.Server ( -- * HTTP server Server,@@ -20,9 +18,11 @@ -- * Aux Aux,+ defaultAux, auxTimeHandle, auxMySockAddr, auxPeerSockAddr,+ auxSendInformational, -- * Response Response,@@ -34,7 +34,7 @@ responseBuilder, -- ** Generalized streaming interface- OutBodyIface(..),+ OutBodyIface (..), responseStreamingIface, -- ** Accessing response@@ -66,12 +66,25 @@ 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+ , auxSendInformational = \_ _ -> return ()+ } ----------------------------------------------------------------
Network/HTTP/Semantics/Server/Internal.hs view
@@ -4,6 +4,7 @@ Aux (..), ) where +import qualified Network.HTTP.Types as H import Network.Socket (SockAddr) import qualified System.TimeManager as T @@ -23,4 +24,10 @@ -- ^ Local socket address copied from 'Config'. , auxPeerSockAddr :: SockAddr -- ^ Remove socket address copied from 'Config'.+ , auxSendInformational :: H.Status -> H.ResponseHeaders -> IO ()+ -- ^ Send an informational (1xx) response, e.g. 103 Early Hints, on this+ -- request's stream before the final response. May be called multiple+ -- times. A no-op in 'defaultAux'.+ --+ -- @since 0.4.1 }
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@@ -86,16 +86,20 @@ -- Using this function instead of 'outBodyPush' can be used to guarantee -- that the final HTTP2 DATA frame is marked end-of-stream; with -- 'outBodyPush' it may happen that an additional empty DATA frame is used- -- for this purpose. Additionally, after calling this function,- -- 'outBodyCancel' will be a no-op.+ -- for this purpose. , outBodyCancel :: Maybe SomeException -> IO () -- ^ Cancel the stream --- -- Sends a @RST_STREAM@ to the peer. If cancelling as the result of an- -- exception, a 'Just' should be provided which specifies the exception- -- which will be stored locally as the reason for cancelling the stream; in- -- this case, the error code sent with the @RST_STREAM@ will be- -- @INTERNAL_ERROR@ (see+ -- Cancelling a streams sends a @RST_STREAM@ to the network peer, which+ -- tells them that they should stop sending us messages. As such, it may+ -- still be necessary to call 'outBodyCancel' after 'outBodyPushFinal',+ -- which merely tells the peer that /we/ will no longer send /them/ any more+ -- messages.+ --+ -- If cancelling as the result of an exception, a 'Just' should be provided+ -- which specifies the exception, which will be stored locally as the reason+ -- for cancelling the stream; in this case, the error code sent with the+ -- @RST_STREAM@ will be @INTERNAL_ERROR@ (see -- <https://datatracker.ietf.org/doc/html/rfc7540#section-7>). If 'Nothing' -- is given, the error code will be @CANCEL@. --
http-semantics.cabal view
@@ -1,12 +1,12 @@ cabal-version: 3.0 name: http-semantics-version: 0.2.1+version: 0.4.2 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@@ -44,7 +44,8 @@ bytestring >=0.10, case-insensitive, http-types >=0.12 && <0.13,- network,+ network >=3.2.10, network-byte-order,- time-manager,+ stm,+ time-manager >= 0.2.4, utf8-string