http2-client-effectful (empty) → 1.0.0
raw patch · 5 files changed
+845/−0 lines, 5 filesdep +basedep +bytestringdep +effectfulsetup-changed
Dependencies added: base, bytestring, effectful, http-types, http2, http2-client, mtl
Files
- CHANGELOG.md +12/−0
- LICENCE +287/−0
- Setup.hs +2/−0
- http2-client-effectful.cabal +60/−0
- src/Effectful/Http2Client.hs +484/−0
+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),+and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/).++## [1.0.0] - 2026-07-07++### Added++- Initial release.
+ LICENCE view
@@ -0,0 +1,287 @@+ EUROPEAN UNION PUBLIC LICENCE v. 1.2+ EUPL © the European Union 2007, 2016++This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined+below) which is provided under the terms of this Licence. Any use of the Work,+other than as authorised under this Licence is prohibited (to the extent such+use is covered by a right of the copyright holder of the Work).++The Work is provided under the terms of this Licence when the Licensor (as+defined below) has placed the following notice immediately following the+copyright notice for the Work:++ Licensed under the EUPL++or has expressed by any other means his willingness to license under the EUPL.++1. Definitions++In this Licence, the following terms have the following meaning:++- ‘The Licence’: this Licence.++- ‘The Original Work’: the work or software distributed or communicated by the+ Licensor under this Licence, available as Source Code and also as Executable+ Code as the case may be.++- ‘Derivative Works’: the works or software that could be created by the+ Licensee, based upon the Original Work or modifications thereof. This Licence+ does not define the extent of modification or dependence on the Original Work+ required in order to classify a work as a Derivative Work; this extent is+ determined by copyright law applicable in the country mentioned in Article 15.++- ‘The Work’: the Original Work or its Derivative Works.++- ‘The Source Code’: the human-readable form of the Work which is the most+ convenient for people to study and modify.++- ‘The Executable Code’: any code which has generally been compiled and which is+ meant to be interpreted by a computer as a program.++- ‘The Licensor’: the natural or legal person that distributes or communicates+ the Work under the Licence.++- ‘Contributor(s)’: any natural or legal person who modifies the Work under the+ Licence, or otherwise contributes to the creation of a Derivative Work.++- ‘The Licensee’ or ‘You’: any natural or legal person who makes any usage of+ the Work under the terms of the Licence.++- ‘Distribution’ or ‘Communication’: any act of selling, giving, lending,+ renting, distributing, communicating, transmitting, or otherwise making+ available, online or offline, copies of the Work or providing access to its+ essential functionalities at the disposal of any other natural or legal+ person.++2. Scope of the rights granted by the Licence++The Licensor hereby grants You a worldwide, royalty-free, non-exclusive,+sublicensable licence to do the following, for the duration of copyright vested+in the Original Work:++- use the Work in any circumstance and for all usage,+- reproduce the Work,+- modify the Work, and make Derivative Works based upon the Work,+- communicate to the public, including the right to make available or display+ the Work or copies thereof to the public and perform publicly, as the case may+ be, the Work,+- distribute the Work or copies thereof,+- lend and rent the Work or copies thereof,+- sublicense rights in the Work or copies thereof.++Those rights can be exercised on any media, supports and formats, whether now+known or later invented, as far as the applicable law permits so.++In the countries where moral rights apply, the Licensor waives his right to+exercise his moral right to the extent allowed by law in order to make effective+the licence of the economic rights here above listed.++The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to+any patents held by the Licensor, to the extent necessary to make use of the+rights granted on the Work under this Licence.++3. Communication of the Source Code++The Licensor may provide the Work either in its Source Code form, or as+Executable Code. If the Work is provided as Executable Code, the Licensor+provides in addition a machine-readable copy of the Source Code of the Work+along with each copy of the Work that the Licensor distributes or indicates, in+a notice following the copyright notice attached to the Work, a repository where+the Source Code is easily and freely accessible for as long as the Licensor+continues to distribute or communicate the Work.++4. Limitations on copyright++Nothing in this Licence is intended to deprive the Licensee of the benefits from+any exception or limitation to the exclusive rights of the rights owners in the+Work, of the exhaustion of those rights or of other applicable limitations+thereto.++5. Obligations of the Licensee++The grant of the rights mentioned above is subject to some restrictions and+obligations imposed on the Licensee. Those obligations are the following:++Attribution right: The Licensee shall keep intact all copyright, patent or+trademarks notices and all notices that refer to the Licence and to the+disclaimer of warranties. The Licensee must include a copy of such notices and a+copy of the Licence with every copy of the Work he/she distributes or+communicates. The Licensee must cause any Derivative Work to carry prominent+notices stating that the Work has been modified and the date of modification.++Copyleft clause: If the Licensee distributes or communicates copies of the+Original Works or Derivative Works, this Distribution or Communication will be+done under the terms of this Licence or of a later version of this Licence+unless the Original Work is expressly distributed only under this version of the+Licence — for example by communicating ‘EUPL v. 1.2 only’. The Licensee+(becoming Licensor) cannot offer or impose any additional terms or conditions on+the Work or Derivative Work that alter or restrict the terms of the Licence.++Compatibility clause: If the Licensee Distributes or Communicates Derivative+Works or copies thereof based upon both the Work and another work licensed under+a Compatible Licence, this Distribution or Communication can be done under the+terms of this Compatible Licence. For the sake of this clause, ‘Compatible+Licence’ refers to the licences listed in the appendix attached to this Licence.+Should the Licensee's obligations under the Compatible Licence conflict with+his/her obligations under this Licence, the obligations of the Compatible+Licence shall prevail.++Provision of Source Code: When distributing or communicating copies of the Work,+the Licensee will provide a machine-readable copy of the Source Code or indicate+a repository where this Source will be easily and freely available for as long+as the Licensee continues to distribute or communicate the Work.++Legal Protection: This Licence does not grant permission to use the trade names,+trademarks, service marks, or names of the Licensor, except as required for+reasonable and customary use in describing the origin of the Work and+reproducing the content of the copyright notice.++6. Chain of Authorship++The original Licensor warrants that the copyright in the Original Work granted+hereunder is owned by him/her or licensed to him/her and that he/she has the+power and authority to grant the Licence.++Each Contributor warrants that the copyright in the modifications he/she brings+to the Work are owned by him/her or licensed to him/her and that he/she has the+power and authority to grant the Licence.++Each time You accept the Licence, the original Licensor and subsequent+Contributors grant You a licence to their contributions to the Work, under the+terms of this Licence.++7. Disclaimer of Warranty++The Work is a work in progress, which is continuously improved by numerous+Contributors. It is not a finished work and may therefore contain defects or+‘bugs’ inherent to this type of development.++For the above reason, the Work is provided under the Licence on an ‘as is’ basis+and without warranties of any kind concerning the Work, including without+limitation merchantability, fitness for a particular purpose, absence of defects+or errors, accuracy, non-infringement of intellectual property rights other than+copyright as stated in Article 6 of this Licence.++This disclaimer of warranty is an essential part of the Licence and a condition+for the grant of any rights to the Work.++8. Disclaimer of Liability++Except in the cases of wilful misconduct or damages directly caused to natural+persons, the Licensor will in no event be liable for any direct or indirect,+material or moral, damages of any kind, arising out of the Licence or of the use+of the Work, including without limitation, damages for loss of goodwill, work+stoppage, computer failure or malfunction, loss of data or any commercial+damage, even if the Licensor has been advised of the possibility of such damage.+However, the Licensor will be liable under statutory product liability laws as+far such laws apply to the Work.++9. Additional agreements++While distributing the Work, You may choose to conclude an additional agreement,+defining obligations or services consistent with this Licence. However, if+accepting obligations, You may act only on your own behalf and on your sole+responsibility, not on behalf of the original Licensor or any other Contributor,+and only if You agree to indemnify, defend, and hold each Contributor harmless+for any liability incurred by, or claims asserted against such Contributor by+the fact You have accepted any warranty or additional liability.++10. Acceptance of the Licence++The provisions of this Licence can be accepted by clicking on an icon ‘I agree’+placed under the bottom of a window displaying the text of this Licence or by+affirming consent in any other similar way, in accordance with the rules of+applicable law. Clicking on that icon indicates your clear and irrevocable+acceptance of this Licence and all of its terms and conditions.++Similarly, you irrevocably accept this Licence and all of its terms and+conditions by exercising any rights granted to You by Article 2 of this Licence,+such as the use of the Work, the creation by You of a Derivative Work or the+Distribution or Communication by You of the Work or copies thereof.++11. Information to the public++In case of any Distribution or Communication of the Work by means of electronic+communication by You (for example, by offering to download the Work from a+remote location) the distribution channel or media (for example, a website) must+at least provide to the public the information requested by the applicable law+regarding the Licensor, the Licence and the way it may be accessible, concluded,+stored and reproduced by the Licensee.++12. Termination of the Licence++The Licence and the rights granted hereunder will terminate automatically upon+any breach by the Licensee of the terms of the Licence.++Such a termination will not terminate the licences of any person who has+received the Work from the Licensee under the Licence, provided such persons+remain in full compliance with the Licence.++13. Miscellaneous++Without prejudice of Article 9 above, the Licence represents the complete+agreement between the Parties as to the Work.++If any provision of the Licence is invalid or unenforceable under applicable+law, this will not affect the validity or enforceability of the Licence as a+whole. Such provision will be construed or reformed so as necessary to make it+valid and enforceable.++The European Commission may publish other linguistic versions or new versions of+this Licence or updated versions of the Appendix, so far this is required and+reasonable, without reducing the scope of the rights granted by the Licence. New+versions of the Licence will be published with a unique version number.++All linguistic versions of this Licence, approved by the European Commission,+have identical value. Parties can take advantage of the linguistic version of+their choice.++14. Jurisdiction++Without prejudice to specific agreement between parties,++- any litigation resulting from the interpretation of this License, arising+ between the European Union institutions, bodies, offices or agencies, as a+ Licensor, and any Licensee, will be subject to the jurisdiction of the Court+ of Justice of the European Union, as laid down in article 272 of the Treaty on+ the Functioning of the European Union,++- any litigation arising between other parties and resulting from the+ interpretation of this License, will be subject to the exclusive jurisdiction+ of the competent court where the Licensor resides or conducts its primary+ business.++15. Applicable Law++Without prejudice to specific agreement between parties,++- this Licence shall be governed by the law of the European Union Member State+ where the Licensor has his seat, resides or has his registered office,++- this licence shall be governed by Belgian law if the Licensor has no seat,+ residence or registered office inside a European Union Member State.++Appendix++‘Compatible Licences’ according to Article 5 EUPL are:++- GNU General Public License (GPL) v. 2, v. 3+- GNU Affero General Public License (AGPL) v. 3+- Open Software License (OSL) v. 2.1, v. 3.0+- Eclipse Public License (EPL) v. 1.0+- CeCILL v. 2.0, v. 2.1+- Mozilla Public Licence (MPL) v. 2+- GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3+- Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for+ works other than software+- European Union Public Licence (EUPL) v. 1.1, v. 1.2+- Québec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong+ Reciprocity (LiLiQ-R+).++The European Commission may update this Appendix to later versions of the above+licences without producing a new version of the EUPL, as long as they provide+the rights granted in Article 2 of this Licence and protect the covered Source+Code from exclusive appropriation.++All other changes or additions to this Appendix require the production of a new+EUPL version.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ http2-client-effectful.cabal view
@@ -0,0 +1,60 @@+cabal-version: 3.0+name: http2-client-effectful+version: 1.0.0+synopsis: Effectful bindings for the http2-client library+description:+ Adaptation of the @<https://hackage.haskell.org/package/http2-client http2-client>@ library for the @<https://hackage.haskell.org/package/effectful effectful>@ ecosystem.++homepage: https://digital-autonomy.institute+license: EUPL-1.2+license-file: LICENCE+author: IDA+maintainer: IDA+bug-reports: https://issues.digital-autonomy.institute+category: Web+build-type: Simple+extra-source-files:+ CHANGELOG.md++common common+ default-language: Haskell2010+ ghc-options:+ -Weverything+ -Wno-unsafe+ -Wno-missing-safe-haskell-mode+ -Wno-missing-export-lists+ -Wno-missing-import-lists+ -Wno-missing-kind-signatures+ -Wno-all-missed-specialisations+ -Wno-missing-role-annotations++ default-extensions:+ BlockArguments+ DataKinds+ ExplicitNamespaces+ FlexibleContexts+ ImportQualifiedPost+ NamedFieldPuns+ NoImplicitPrelude+ OverloadedStrings+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ TypeApplications+ TypeFamilies+ TypeOperators++library+ import: common+ hs-source-dirs: src+ build-depends:+ base >=4.10 && <5,+ bytestring >=0.12 && <0.13,+ effectful >=2.6 && <2.7,+ http-types >=0.12 && <0.13,+ http2 >=5.3 && <5.4,+ http2-client >=0.10 && <0.11,+ mtl >=2.3 && <2.4,++ exposed-modules:+ Effectful.Http2Client
+ src/Effectful/Http2Client.hs view
@@ -0,0 +1,484 @@+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE Trustworthy #-}++-- |+-- Module : Effectful.Http2Client+-- Copyright : (c) 2026 Institute for Digital Autonomy+-- License : EUPL-1.2+-- Maintainer : IDA+--+-- Effectful bindings for the <http://hackage.haskell.org/package/http2-client http2-client library>.+--+-- @http2-client@ exposes streams, flow control, and push promises as+-- first-class values, working in its own 'ClientIO' monad.+-- This module lifts that API into 'Eff': 'runHttp2Client' handles thread-linking+-- and client teardown, so the rest of the operations here can be used+-- directly in your effect stack.+--+-- = Example Usage+--+-- === Opening a connection and running a client+--+-- > import Effectful+-- > import Effectful.Error.Static (runErrorNoCallStack)+-- > import Effectful.Http2Client+-- >+-- > main :: IO ()+-- > main = do+-- > result <- runEff . runErrorNoCallStack @ClientError $ do+-- > conn <- newHttp2FrameConnection "http2.example.com" 443 (Just tlsClientParams)+-- > runHttp2Client conn 4096 4096 [] defaultGoAwayHandler ignoreFallbackHandler $ do+-- > -- ... open streams here, see below ...+-- > pure ()+-- > print result+--+-- === A simple GET request+--+-- > getRoot :: (Http2Client :> es, Effectful.Error.Static.Error ClientError :> es) => Eff es (Either TooMuchConcurrency StreamResult)+-- > getRoot =+-- > withHttp2Stream $ \stream ->+-- > StreamDefinition+-- > { _initStream =+-- > _headers+-- > stream+-- > [ (":method", "GET")+-- > , (":scheme", "https")+-- > , (":authority", "http2.example.com")+-- > , (":path", "/")+-- > ]+-- > id+-- > , _handleStream = \incomingFlow _outgoingFlow ->+-- > waitStream stream incomingFlow ignorePushPromises+-- > }+-- > where+-- > ignorePushPromises _streamId _pushedStream _headers' _ifc _ofc = pure ()+--+-- === Uploading a request body+--+-- > postBody :: (Http2Client :> es, Effectful.Error.Static.Error ClientError :> es) => ByteString -> Eff es (Either TooMuchConcurrency StreamResult)+-- > postBody body =+-- > withHttp2Stream $ \stream ->+-- > StreamDefinition+-- > { _initStream =+-- > _headers+-- > stream+-- > [ (":method", "POST")+-- > , (":scheme", "https")+-- > , (":authority", "http2.example.com")+-- > , (":path", "/upload")+-- > ]+-- > id+-- > , _handleStream = \incomingFlow outgoingFlow -> do+-- > connFlow <- _outgoingFlowControl+-- > upload body id connFlow stream outgoingFlow+-- > waitStream stream incomingFlow ignorePushPromises+-- > }+-- > where+-- > ignorePushPromises _streamId _pushedStream _headers' _ifc _ofc = pure ()+module Effectful.Http2Client+ ( -- * Effect+ Http2Client+ , runHttp2Client++ -- * Performing requests+ , withHttp2Stream+ , upload+ , waitStream+ , linkAsyncs+ , _incomingFlowControl+ , _outgoingFlowControl+ , newHttp2FrameConnection+ , runClientIO++ -- ** Streams+ , Http2Stream (..)+ , StreamDefinition (..)+ , StreamStarter++ -- ** Flow control+ , IncomingFlowControl (..)+ , OutgoingFlowControl (..)++ -- ** Handlers+ , GoAwayHandler+ , FallBackFrameHandler+ , PushPromiseHandler+ , defaultGoAwayHandler+ , ignoreFallbackHandler++ -- * Re-exports++ -- ** Connections+ , Http2FrameConnection+ , HostName+ , PortNumber+ , SettingsList+ , SettingsKey (..)+ , SettingsValue++ -- ** Streams+ , StreamThread+ , StreamEvent (..)+ , StreamResponse+ , StreamResult+ , TooMuchConcurrency (..)+ , RequestHeaders+ , FlagSetter+ , fromStreamResult++ -- ** Errors+ , ClientError (..)+ , RemoteSentGoAwayFrame (..)+ )+where++import Control.Monad ((<=<))+import Control.Monad.Except (ExceptT (..))+import Data.ByteString (ByteString)+import Data.ByteString qualified as ByteString+import Effectful+import Effectful.Dispatch.Static+import Effectful.Error.Static (Error, runErrorNoCallStack, throwError)+import Effectful.Exception (finally)+import Network.HTTP.Types (Header, RequestHeaders)+import Network.HTTP2.Client.Helpers (StreamResponse, StreamResult, fromStreamResult)+import Network.HTTP2.Frame+ ( ErrorCode+ , FrameFlags+ , FrameHeader+ , FramePayload+ , Priority+ , SettingsKey (..)+ , SettingsList+ , SettingsValue+ , StreamId+ , WindowSize+ , flags+ , payloadLength+ , testEndStream+ )+import "http2-client" Network.HTTP2.Client+ ( ClientError (..)+ , ClientIO+ , FlagSetter+ , HostName+ , Http2FrameConnection+ , PortNumber+ , RemoteSentGoAwayFrame (..)+ , StreamEvent (..)+ , StreamThread+ , TooMuchConcurrency (..)+ )+import "http2-client" Network.HTTP2.Client qualified as Client+import Prelude++data Http2Client :: Effect++type instance DispatchOf Http2Client = 'Static 'WithSideEffects++newtype instance StaticRep Http2Client = Http2Client Client.Http2Client++runHttp2Client+ :: forall es a+ . (IOE :> es, Error ClientError :> es)+ => Http2FrameConnection+ -> Int+ -- ^ The buffersize for the Network.HPACK encoder.+ -> Int+ -- ^ The buffersize for the Network.HPACK decoder.+ -> SettingsList+ -> GoAwayHandler+ -> FallBackFrameHandler+ -> Eff (Http2Client ': es) a+ -> Eff es a+runHttp2Client frameConn encoderBufSize decoderBufSize initSettings goAwayHandler fallbackHandler eff =+ either throwError pure =<< unsafeConcUnliftIO Ephemeral (Limited 1) \unlift ->+ Client.runClientIO do+ let unliftClientIO :: Eff es b -> ClientIO b+ unliftClientIO =+ ExceptT+ . unlift+ . runErrorNoCallStack @ClientError+ . inject+ client <-+ Client.newHttp2Client+ frameConn+ encoderBufSize+ decoderBufSize+ initSettings+ (unliftClientIO . goAwayHandler)+ (unliftClientIO . fallbackHandler)+ ExceptT . unlift . runErrorNoCallStack @ClientError . inject $+ evalStaticRep (Http2Client client) (linkAsyncs >> eff)+ `finally` (runClientIO . Client._close) client++type GoAwayHandler = forall es. (Error ClientError :> es) => RemoteSentGoAwayFrame -> Eff es ()++-- | Lifted 'Client.defaultGoAwayHandler'.+defaultGoAwayHandler :: GoAwayHandler+defaultGoAwayHandler = unsafeRunClientIO . Client.defaultGoAwayHandler++type FallBackFrameHandler =+ forall es+ . (Error ClientError :> es)+ => (FrameHeader, FramePayload)+ -> Eff es ()++-- | Lifted 'Client.ignoreFallbackHandler'.+ignoreFallbackHandler :: FallBackFrameHandler+ignoreFallbackHandler = unsafeRunClientIO . Client.ignoreFallbackHandler++unsafeRunClientIO :: (Error ClientError :> es) => ClientIO a -> Eff es a+unsafeRunClientIO action = do+ result <- unsafeEff_ $ Client.runClientIO action+ case result of+ Left err -> throwError err+ Right a -> pure a++-- | Lifted 'Client.runClientIO'.+-- Escape hatch for 'ClientIO' actions that are not lifted by this library.+runClientIO+ :: (IOE :> es, Error ClientError :> es)+ => ClientIO a+ -> Eff es a+runClientIO = either throwError pure <=< liftIO . Client.runClientIO++-- | Lifted 'Client.newHttp2FrameConnection'.+newHttp2FrameConnection+ :: (Error ClientError :> es)+ => HostName+ -> PortNumber+ -> Maybe Client.ClientParams+ -> Eff es Http2FrameConnection+newHttp2FrameConnection host port = unsafeRunClientIO . Client.newHttp2FrameConnection host port++-- | Lifted 'Client.linkAsyncs'.+linkAsyncs :: (Http2Client :> es, Error ClientError :> es) => Eff es ()+linkAsyncs = do+ Http2Client client <- getStaticRep+ unsafeRunClientIO $ Client.linkAsyncs client++-- | Lifted 'Client.IncomingFlowControl'.+data IncomingFlowControl es = IncomingFlowControl+ { _addCredit :: WindowSize -> Eff es ()+ , _consumeCredit :: WindowSize -> Eff es Int+ , _updateWindow :: Eff es Bool+ }++liftIncomingFlowControl+ :: (Error ClientError :> es)+ => Client.IncomingFlowControl+ -> IncomingFlowControl es+liftIncomingFlowControl Client.IncomingFlowControl{..} =+ IncomingFlowControl+ { _addCredit = unsafeEff_ . _addCredit+ , _consumeCredit = unsafeEff_ . _consumeCredit+ , _updateWindow = unsafeRunClientIO _updateWindow+ }++-- | Lifted 'Client.OutgoingFlowControl'.+data OutgoingFlowControl es = OutgoingFlowControl+ { _receiveCredit :: WindowSize -> Eff es ()+ , _withdrawCredit :: WindowSize -> Eff es WindowSize+ }++liftOutgoingFlowControl+ :: (Error ClientError :> es)+ => Client.OutgoingFlowControl+ -> OutgoingFlowControl es+liftOutgoingFlowControl Client.OutgoingFlowControl{..} =+ OutgoingFlowControl+ { _receiveCredit = unsafeEff_ . _receiveCredit+ , _withdrawCredit = unsafeRunClientIO . _withdrawCredit+ }++-- | Lifted 'Client.StreamDefinition'.+data StreamDefinition es a = StreamDefinition+ { _initStream :: Eff es StreamThread+ , _handleStream :: IncomingFlowControl es -> OutgoingFlowControl es -> Eff es a+ }++unliftStreamDefinition+ :: (Error ClientError :> es)+ => (forall r. Eff es r -> ClientIO r)+ -> StreamDefinition es a+ -> Client.StreamDefinition a+unliftStreamDefinition unliftClientIO StreamDefinition{..} =+ Client.StreamDefinition+ { _initStream = unliftClientIO _initStream+ , _handleStream = \i o ->+ unliftClientIO $+ _handleStream (liftIncomingFlowControl i) (liftOutgoingFlowControl o)+ }++-- | Lifted 'Client.Http2Stream'.+data Http2Stream es = Http2Stream+ { _headers+ :: [Header]+ -> (FrameFlags -> FrameFlags)+ -> Eff es StreamThread+ , _prio :: Priority -> Eff es ()+ , _rst :: ErrorCode -> Eff es ()+ , _waitEvent :: Eff es StreamEvent+ , _sendData :: (FrameFlags -> FrameFlags) -> ByteString -> Eff es ()+ , _sendDataChunk :: (FrameFlags -> FrameFlags) -> ByteString -> Eff es ()+ , _handlePushPromise :: StreamId -> [Header] -> PushPromiseHandler es -> Eff es ()+ }++liftHttp2Stream+ :: forall es+ . (Error ClientError :> es)+ => Client.Http2Client+ -> Client.Http2Stream+ -> Http2Stream es+liftHttp2Stream client stream =+ Http2Stream+ { _headers = \hdrs flagMod -> unsafeRunClientIO (Client._headers stream hdrs flagMod)+ , _prio = unsafeRunClientIO . Client._prio stream+ , _rst = unsafeRunClientIO . Client._rst stream+ , _waitEvent = unsafeRunClientIO (Client._waitEvent stream)+ , _sendData = \flagMod dat -> unsafeRunClientIO (Client.sendData client stream flagMod dat)+ , _sendDataChunk = \flagMod dat -> unsafeRunClientIO (Client._sendDataChunk stream flagMod dat)+ , _handlePushPromise = \sid hdrs handler ->+ either throwError pure+ =<< unsafeConcUnliftIO Ephemeral (Limited 1) \unlift -> Client.runClientIO do+ let unliftClientIO :: Eff es b -> ClientIO b+ unliftClientIO = ExceptT . unlift . runErrorNoCallStack @ClientError . inject+ Client._handlePushPromise+ stream+ sid+ hdrs+ (unliftPushPromiseHandler client unliftClientIO handler)+ }++-- | Handler invoked upon receiving an HTTP\/2 PUSH_PROMISE from the server,+-- lifted into 'Eff'. Mirrors @http2-client@'s 'Client.PushPromiseHandler' but with the+-- stream and flow-control objects expressed in terms of 'Eff'.+type PushPromiseHandler es =+ StreamId+ -> Http2Stream es+ -> [Header]+ -> IncomingFlowControl es+ -> OutgoingFlowControl es+ -> Eff es ()++unliftPushPromiseHandler+ :: forall es+ . (Error ClientError :> es)+ => Client.Http2Client+ -> (forall r. Eff es r -> ClientIO r)+ -> PushPromiseHandler es+ -> Client.PushPromiseHandler+unliftPushPromiseHandler client unliftClientIO ppHandler sid stream hdrs ifc ofc =+ unliftClientIO $+ ppHandler+ sid+ (liftHttp2Stream client stream)+ hdrs+ (liftIncomingFlowControl ifc)+ (liftOutgoingFlowControl ofc)++type StreamStarter es a =+ (Http2Stream es -> StreamDefinition es a)+ -> Eff es (Either TooMuchConcurrency a)++-- | Lifted 'Client.withHttp2Stream'.+withHttp2Stream+ :: forall es a+ . (Http2Client :> es, Error ClientError :> es)+ => StreamStarter es a+withHttp2Stream f = do+ Http2Client client <- getStaticRep+ either throwError pure+ =<< unsafeConcUnliftIO Ephemeral (Limited 1) \unlift -> Client.runClientIO do+ let unliftClientIO :: Eff es b -> ClientIO b+ unliftClientIO = ExceptT . unlift . runErrorNoCallStack @ClientError . inject+ Client._startStream client $ unliftStreamDefinition unliftClientIO . f . liftHttp2Stream client++-- | Lifted 'Client.upload'.+upload+ :: forall es+ . ByteString+ -> FlagSetter+ -> OutgoingFlowControl es+ -- ^ The connection-wide outgoing flow control.+ -> Http2Stream es+ -> OutgoingFlowControl es+ -- ^ The stream-wide outgoing flow control.+ -> Eff es ()+upload dat flagSetter connFlow stream streamFlow = go dat+ where+ go :: ByteString -> Eff es ()+ go d = do+ let wanted = ByteString.length d+ gotStream <- _withdrawCredit streamFlow wanted+ got <- _withdrawCredit connFlow gotStream+ _receiveCredit streamFlow $ gotStream - got+ if got == wanted+ then _sendData stream flagSetter d+ else do+ _sendData stream id $ ByteString.take got d+ go $ ByteString.drop got d++-- | Lifted 'Client.waitStream'.+waitStream+ :: forall es+ . (Http2Client :> es, Error ClientError :> es)+ => Http2Stream es+ -> IncomingFlowControl es+ -> PushPromiseHandler es+ -> Eff es StreamResult+waitStream stream streamFlow ppHandler = do+ connFlow <- _incomingFlowControl+ let+ waitDataFrames xs = do+ ev <- _waitEvent stream+ case ev of+ StreamDataEvent fh x+ | testEndStream (flags fh) ->+ pure (Right x : xs, Nothing)+ | otherwise -> do+ let size = payloadLength fh+ _ <- _consumeCredit streamFlow size+ _addCredit streamFlow size+ _ <- _updateWindow streamFlow+ _ <- _updateWindow connFlow+ waitDataFrames (Right x : xs)+ StreamPushPromiseEvent _ ppSid ppHdrs -> do+ _handlePushPromise stream ppSid ppHdrs ppHandler+ waitDataFrames xs+ StreamHeadersEvent _ hdrs ->+ pure (xs, Just hdrs)+ _ ->+ error $ "expecting StreamDataEvent but got " <> show ev+ loop = do+ ev <- _waitEvent stream+ case ev of+ StreamHeadersEvent fH hdrs+ | testEndStream (flags fH) ->+ pure (Right hdrs, [], Nothing)+ | otherwise -> do+ (dfrms, trls) <- waitDataFrames []+ pure (Right hdrs, reverse dfrms, trls)+ StreamPushPromiseEvent _ ppSid ppHdrs -> do+ _handlePushPromise stream ppSid ppHdrs ppHandler+ loop+ _ ->+ error $ "expecting StreamHeadersEvent but got " <> show ev+ loop++-- | Lifted 'Client._incomingFlowControl'.+_incomingFlowControl+ :: (Http2Client :> es, Error ClientError :> es)+ => Eff es (IncomingFlowControl es)+_incomingFlowControl = do+ Http2Client client <- getStaticRep+ pure . liftIncomingFlowControl . Client._incomingFlowControl $ client++-- | Lifted 'Client._outgoingFlowControl'.+_outgoingFlowControl+ :: (Http2Client :> es, Error ClientError :> es)+ => Eff es (OutgoingFlowControl es)+_outgoingFlowControl = do+ Http2Client client <- getStaticRep+ pure . liftOutgoingFlowControl . Client._outgoingFlowControl $ client