http-exchange-instantiations 0.1.0.0 → 0.1.1.0

raw patch · 4 files changed

+106/−6 lines, 4 filesdep +stmdep ~network-unexceptional

Dependencies added: stm

Dependency ranges changed: network-unexceptional

Files

• CHANGELOG.md +4/−0
• http-exchange-instantiations.cabal +10/−5
• src-chanimpl/SocketInterruptibleChannel.hs +49/−0
• src/Http/Exchange/Network.hs +43/−1

@@ -1,5 +1,9 @@ # Revision history for http-exchange-instantiations +## 0.1.1.0 -- 2023-08-30++* Add `exchangeInterruptible` and `exchangeTimeout`.+ ## 0.1.0.0 -- YYYY-mm-dd  * First version.

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: http-exchange-instantiations-version: 0.1.0.0+version: 0.1.1.0 synopsis: Instantiations of http-exchange -- description: license: BSD-3-Clause@@ -16,15 +16,17 @@   ghc-options: -Wall   exposed-modules:     SocketChannel+    SocketInterruptibleChannel     TlsChannel   build-depends:-    , base >=4.17.1.0 && <5-    , network-unexceptional >=0.1.1+    , base >=4.16.3.0 && <5+    , network-unexceptional >=0.1.3     , network >=3.1.4     , tls >=1.8     , error-codes >=0.1.1     , bytestring >=0.11     , byteslice >=0.2.11+    , stm >=2.5.1.0   hs-source-dirs: src-chanimpl   default-language: GHC2021 @@ -35,10 +37,11 @@     Http.Exchange.Tls   build-depends:     , base >=4.17.1.0-    , network >=3.1.4     , chanimpl     , http-exchange >=0.1.1     , http-interchange >=0.3.1+    , network >=3.1.4+    , stm >=2.5.1.0     , tls >=1.7   hs-source-dirs: src   default-language: GHC2021@@ -46,7 +49,9 @@     http-exchange (Exchange as SocketExchange)       requires (Channel as SocketChannel),     http-exchange (Exchange as TlsExchange)-      requires (Channel as TlsChannel)+      requires (Channel as TlsChannel),+    http-exchange (Exchange as SocketInterruptibleExchange)+      requires (Channel as SocketInterruptibleChannel)  executable http-insecure   ghc-options: -Wall

@@ -0,0 +1,49 @@+module SocketInterruptibleChannel+  ( M+  , SendException+  , ReceiveException+  , showsPrecSendException+  , showsPrecReceiveException+  , Resource(..)+  , send+  , receive+  ) where++import Data.Bytes (Bytes)+import Data.Bytes.Chunks (Chunks)+import Network.Socket (Socket)+import Foreign.C.Error (Errno)+import Control.Concurrent.STM (TVar)++import qualified Foreign.C.Error.Describe as Describe+import qualified Network.Unexceptional.Bytes as NB+import qualified Network.Unexceptional.Chunks as NC++type M = IO++data Resource = Resource {-# UNPACK #-} !Socket !(TVar Bool)++type ReceiveException = Errno+type SendException = Errno++showsPrecSendException :: Int -> SendException -> String -> String+showsPrecSendException = showsPrecErrno++showsPrecReceiveException :: Int -> ReceiveException -> String -> String+showsPrecReceiveException = showsPrecErrno++showsPrecErrno :: Int -> Errno -> String -> String+showsPrecErrno _ e s = Describe.string e ++ (' ' : s)++send ::+     Resource+  -> Chunks+  -> M (Either Errno ())+send (Resource a interrupt) b = do+  NC.sendInterruptible interrupt a b++receive ::+     Resource+  -> M (Either Errno Bytes)+receive (Resource a interrupt) = NB.receiveInterruptible interrupt a 12000+

@@ -1,8 +1,12 @@+{-# language LambdaCase #-}+ -- | Issue insecure HTTP requests using the 'Socket' type from the @network@ -- library. module Http.Exchange.Network   ( -- * Issue Requests     exchange+  , exchangeInterruptible+  , exchangeTimeout     -- * Example Use     -- $example     -- * Exceptions@@ -13,8 +17,12 @@  import Network.Socket (Socket) import Http.Types (Request,Bodied,Response)- import SocketExchange (Exception(..),HttpException(..))+import Control.Concurrent.STM (TVar,registerDelay)+import Data.Bifunctor (first)++import qualified SocketInterruptibleChannel as YChan+import qualified SocketInterruptibleExchange as Y import qualified SocketExchange as X  -- | Issue an HTTP request and await a response. This is does not use TLS@@ -25,6 +33,40 @@   -> Bodied Request -- ^ HTTP Request   -> IO (Either Exception (Bodied Response)) -- ^ HTTP Response or exception exchange = X.exchange++-- | Variant of exchange that abandons the attempt if the interrupt+-- variable is set to @True@. If the operation is interrupted in this+-- way, the result is @EAGAIN@ wrapped by either @Send@ or @Receive@.+-- See the implementation of 'exchangeTimeout' for an example of how to+-- use this function to timeout if the HTTP exchange does not complete+-- quickly.+exchangeInterruptible :: +     TVar Bool -- ^ Interrupt+  -> Socket -- ^ Network socket (TCP or Unix-Domain)+  -> Bodied Request -- ^ HTTP Request+  -> IO (Either Exception (Bodied Response)) -- ^ HTTP Response or exception+exchangeInterruptible !a b c =+  (fmap (first convertException) (Y.exchange (YChan.Resource b a) c))++-- | Variant of 'exchange' that abandons the exchange if it has not+-- completed in a given number of microseconds.+exchangeTimeout :: +     Int -- ^ Microseconds to wait before giving up+  -> Socket -- ^ Network socket (TCP or Unix-Domain)+  -> Bodied Request -- ^ HTTP Request+  -> IO (Either Exception (Bodied Response)) -- ^ HTTP Response or exception+exchangeTimeout !t sock req = do+  interrupt <- registerDelay t+  exchangeInterruptible interrupt sock req++-- It would be better to fix this problem by changing the structure+-- of http-exchange. The exceptions types are nominally different,+-- but they are isomorphic.+convertException :: Y.Exception -> X.Exception+convertException = \case+  Y.Http x -> X.Http x+  Y.Send x -> X.Send x+  Y.Receive x -> X.Receive x  {- $example