wai-effectful (empty) → 1.0.0

raw patch · 6 files changed

+824/−0 lines, 6 filesdep +basedep +bytestringdep +effectfulsetup-changed

Dependencies added: base, bytestring, effectful, hspec-effectful, http-types, network, text, vault, wai, wai-effectful

Files

• CHANGELOG.md +12/−0
• LICENCE +287/−0
• Setup.hs +2/−0
• src/Effectful/Wai.hs +367/−0
• test/Main.hs +81/−0
• wai-effectful.cabal +75/−0

@@ -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/).++## [Unreleased]++### Added++- Initial release.

@@ -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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,367 @@+{-# LANGUAGE Trustworthy #-}+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Effectful.Wai+-- Copyright   : (c) 2026 Institute for Digital Autonomy+-- License     : EUPL-1.2+-- Maintainer  : IDA+--+-- Effectful bindings for the <http://hackage.haskell.org/package/wai wai library>.+--+-- = Example usage+--+-- Here is an 'Application' that serves requests using an arbitrary effect stack;+-- in this case it uses the 'State' effect to count the number of requests.+--+-- Run it using <http://hackage.haskell.org/package/warp-effectful warp-efectful>.+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > import Effectful+-- > import Effectful.State.Static.Local (State, evalState, modify)+-- > import Effectful.Wai (Application, responseLBS)+-- > import Effectful.Wai.Handler.Warp qualified as Warp+-- > import Network.HTTP.Types (status200)+-- >+-- > app :: (State Int :> es) => Application es+-- > app _ respond = do+-- >     modify @Int succ+-- >     respond $+-- >         responseLBS+-- >             status200+-- >             [("Content-Type", "text/plain")]+-- >             "Hello, Web!"+-- >+-- > main :: IO ()+-- > main = runEff . evalState @Int 0 . Warp.run 8080 $ app+module Effectful.Wai+    ( -- * Types+      Application+    , Middleware+    , ResponseReceived++      -- * Request+    , Request+    , defaultRequest+    , RequestBodyLength (..)++      -- ** Request accessors+    , requestMethod+    , httpVersion+    , rawPathInfo+    , rawQueryString+    , requestHeaders+    , isSecure+    , remoteHost+    , pathInfo+    , queryString+    , getRequestBodyChunk+    , requestBody+    , vault+    , requestBodyLength+    , requestHeaderHost+    , requestHeaderRange+    , requestHeaderReferer+    , requestHeaderUserAgent+      -- $streamingRequestBodies+    , strictRequestBody+    , consumeRequestBodyStrict+    , lazyRequestBody+    , consumeRequestBodyLazy++      -- ** Request modifiers+    , setRequestBodyChunks+    , mapRequestHeaders++      -- * Response+    , Response+    , StreamingBody+    , FilePart (..)++      -- ** Response composers+    , responseFile+    , responseBuilder+    , responseLBS+    , responseStream+    , responseRaw++      -- ** Response accessors+    , responseStatus+    , responseHeaders++      -- ** Response modifiers+    , responseToStream+    , mapResponseHeaders+    , mapResponseStatus++      -- * Middleware composition+    , ifRequest+    , modifyRequest+    , modifyResponse++      -- * Lifting and unlifting+    , liftApplication+    , unliftApplication+    , liftMiddleware+    , unliftMiddleware+    , liftRequest+    , unliftRequest+    , unliftRequestNoBody+    , liftResponse+    , unliftResponse+    , liftStream+    , liftStreamingBody+    , unliftStreamingBody+    )+where++import Data.ByteString (ByteString)+import Data.ByteString.Builder (Builder, lazyByteString)+import Data.ByteString.Lazy (LazyByteString)+import Data.Text (Text)+import Data.Vault.Lazy (Vault)+import Effectful+import Network.HTTP.Types (HttpVersion, Method, Query, RequestHeaders, ResponseHeaders, Status)+import Network.Socket (SockAddr)+import Network.Wai (FilePart (..), RequestBodyLength (..), ResponseReceived)+import Network.Wai qualified as Wai+import Network.Wai.Internal qualified as Wai+import Prelude++-- | Lifted 'Wai.Application'.+type Application es =+    Request es+    -> (Response es -> Eff es ResponseReceived)+    -> Eff es ResponseReceived++liftApplication :: (IOE :> es) => Wai.Application -> Application es+liftApplication app req respondEff =+    withSeqEffToIO \unlift ->+        app (unliftRequest unlift req) (unlift . respondEff . liftResponse)++unliftApplication+    :: (IOE :> es)+    => (forall r. Eff es r -> IO r)+    -> Application es+    -> Wai.Application+unliftApplication unlift app waiReq waiRespond =+    unlift . app (liftRequest waiReq) $ liftIO . waiRespond . unliftResponse unlift++-- | Lifted 'Wai.Middleware'.+type Middleware es = Application es -> Application es++liftMiddleware :: (IOE :> es) => Wai.Middleware -> Middleware es+liftMiddleware middleware app req resp =+    withSeqEffToIO \unlift ->+        unlift $ (liftApplication . middleware . unliftApplication unlift $ app) req resp++unliftMiddleware :: (IOE :> es) => (forall r. Eff es r -> IO r) -> Middleware es -> Wai.Middleware+unliftMiddleware unlift middleware = unliftApplication unlift . middleware . liftApplication++-- | Lifted 'Wai.Request'.+data Request es = Request+    { requestMethod :: Method+    , httpVersion :: HttpVersion+    , rawPathInfo :: ByteString+    , rawQueryString :: ByteString+    , requestHeaders :: RequestHeaders+    , isSecure :: Bool+    , remoteHost :: Network.Socket.SockAddr+    , pathInfo :: [Text]+    , queryString :: Query+    , requestBody :: Eff es ByteString+    , vault :: Vault+    , requestBodyLength :: RequestBodyLength+    , requestHeaderHost :: Maybe ByteString+    , requestHeaderRange :: Maybe ByteString+    , requestHeaderReferer :: Maybe ByteString+    , requestHeaderUserAgent :: Maybe ByteString+    }++liftRequest :: (IOE :> es) => Wai.Request -> Request es+liftRequest Wai.Request{..} =+    Request+        { requestBody = liftIO requestBody+        , ..+        }++unliftRequest :: (forall r. Eff es r -> IO r) -> Request es -> Wai.Request+unliftRequest unlift Request{..} =+    Wai.Request+        { Wai.requestBody = unlift requestBody+        , ..+        }++unliftRequestNoBody :: Request es -> Wai.Request+unliftRequestNoBody Request{..} =+    Wai.Request+        { requestBody = pure mempty+        , ..+        }++-- | Lifted 'Wai.defaultRequest'.+defaultRequest :: (IOE :> es) => Request es+defaultRequest = liftRequest Wai.defaultRequest++-- | Lifted 'Wai.getRequestBodyChunk'.+getRequestBodyChunk :: Request es -> Eff es ByteString+getRequestBodyChunk = requestBody++-- | Lifted 'Wai.strictRequestBody'.+strictRequestBody :: (IOE :> es) => Request es -> Eff es LazyByteString+strictRequestBody = withSeqEffToIO . (Wai.strictRequestBody .) . flip unliftRequest++-- | Lifted 'Wai.consumeRequestBodyStrict'.+consumeRequestBodyStrict :: (IOE :> es) => Request es -> Eff es LazyByteString+consumeRequestBodyStrict = strictRequestBody++-- | Lifted 'Wai.lazyRequestBody'.+lazyRequestBody :: (IOE :> es) => Request es -> Eff es LazyByteString+lazyRequestBody = withSeqEffToIO . (Wai.lazyRequestBody .) . flip unliftRequest++-- | Lifted 'Wai.consumeRequestBodyLazy'.+consumeRequestBodyLazy :: (IOE :> es) => Request es -> Eff es LazyByteString+consumeRequestBodyLazy = lazyRequestBody++-- | Lifted 'Wai.setRequestBodyChunks'.+setRequestBodyChunks :: Eff es ByteString -> Request es -> Request es+setRequestBodyChunks body req = req{requestBody = body}++-- | Lifted 'Wai.mapRequestHeaders'.+mapRequestHeaders+    :: (RequestHeaders -> RequestHeaders)+    -> Request es+    -> Request es+mapRequestHeaders f req = req{requestHeaders = f (requestHeaders req)}++-- | Lifted 'Wai.Response'.+data Response es+    = ResponseFile Status ResponseHeaders FilePath (Maybe FilePart)+    | ResponseBuilder Status ResponseHeaders Builder+    | ResponseStream Status ResponseHeaders (StreamingBody es)+    | ResponseRaw (Eff es ByteString -> (ByteString -> Eff es ()) -> Eff es ()) (Response es)++liftResponse :: (IOE :> es) => Wai.Response -> Response es+liftResponse res = ResponseStream status headers streamingBody+  where+    (status, headers, withStream) = Wai.responseToStream res+    streamingBody send flush = liftStream withStream \body -> body send flush++unliftResponse :: (IOE :> es) => (forall r. Eff es r -> IO r) -> Response es -> Wai.Response+unliftResponse unlift res =+    Wai.responseStream status headers $+        unliftStreamingBody unlift \send flush ->+            withStream \body -> body send flush+  where+    (status, headers, withStream) = responseToStream res++-- | Lifted 'Wai.StreamingBody'.+type StreamingBody es = (Builder -> Eff es ()) -> Eff es () -> Eff es ()++liftStreamingBody :: (IOE :> es) => Wai.StreamingBody -> StreamingBody es+liftStreamingBody body send flush = withRunInIO \unlift -> body (unlift . send) (unlift flush)++unliftStreamingBody+    :: (IOE :> es)+    => (forall r. Eff es r -> IO r)+    -> StreamingBody es+    -> Wai.StreamingBody+unliftStreamingBody unlift body send flush = unlift $ body (liftIO . send) (liftIO flush)++-- | Lifted 'Wai.responseFile'.+responseFile+    :: Status+    -> ResponseHeaders+    -> FilePath+    -> Maybe FilePart+    -> Response es+responseFile = ResponseFile++-- | Lifted 'Wai.responseBuilder'.+responseBuilder :: Status -> ResponseHeaders -> Builder -> Response es+responseBuilder = ResponseBuilder++-- | Lifted 'Wai.responseLBS'.+responseLBS :: Status -> ResponseHeaders -> LazyByteString -> Response es+responseLBS s h = ResponseBuilder s h . lazyByteString++-- | Lifted 'Wai.responseStream'.+responseStream+    :: Status+    -> ResponseHeaders+    -> StreamingBody es+    -> Response es+responseStream = ResponseStream++-- | Lifted 'Wai.responseRaw'.+responseRaw+    :: (Eff es ByteString -> (ByteString -> Eff es ()) -> Eff es ())+    -> Response es+    -> Response es+responseRaw = ResponseRaw++-- | Lifted 'Wai.responseStatus'.+responseStatus :: Response es -> Status+responseStatus (ResponseFile s _ _ _) = s+responseStatus (ResponseBuilder s _ _) = s+responseStatus (ResponseStream s _ _) = s+responseStatus (ResponseRaw _ res) = responseStatus res++-- | Lifted 'Wai.responseHeaders'.+responseHeaders :: Response es -> ResponseHeaders+responseHeaders (ResponseFile _ hs _ _) = hs+responseHeaders (ResponseBuilder _ hs _) = hs+responseHeaders (ResponseStream _ hs _) = hs+responseHeaders (ResponseRaw _ res) = responseHeaders res++-- | Lifted 'Wai.responseToStream'.+responseToStream+    :: (IOE :> es)+    => Response es+    -> (Status, ResponseHeaders, (StreamingBody es -> Eff es a) -> Eff es a)+responseToStream (ResponseStream s h b) = (s, h, ($ b))+responseToStream (ResponseFile s h fp part) = (s, h, liftStream stream)+  where+    (_s, _h, stream) = Wai.responseToStream $ Wai.ResponseFile s h fp part+responseToStream (ResponseBuilder s h b) = (s, h, liftStream stream)+  where+    (_s, _h, stream) = Wai.responseToStream $ Wai.ResponseBuilder s h b+responseToStream (ResponseRaw _ res) = responseToStream res++liftStream+    :: (IOE :> es)+    => ((Wai.StreamingBody -> IO a) -> IO a)+    -> (StreamingBody es -> Eff es a)+    -> Eff es a+liftStream f k = withRunInIO \unlift -> f $ unlift . k . liftStreamingBody++-- | Lifted 'Wai.mapResponseHeaders'.+mapResponseHeaders+    :: (ResponseHeaders -> ResponseHeaders)+    -> Response es+    -> Response es+mapResponseHeaders f (ResponseFile s h b1 b2) = ResponseFile s (f h) b1 b2+mapResponseHeaders f (ResponseBuilder s h b) = ResponseBuilder s (f h) b+mapResponseHeaders f (ResponseStream s h b) = ResponseStream s (f h) b+mapResponseHeaders _ r@(ResponseRaw _ _) = r++-- | Lifted 'Wai.mapResponseStatus'.+mapResponseStatus :: (Status -> Status) -> Response es -> Response es+mapResponseStatus f (ResponseFile s h b1 b2) = ResponseFile (f s) h b1 b2+mapResponseStatus f (ResponseBuilder s h b) = ResponseBuilder (f s) h b+mapResponseStatus f (ResponseStream s h b) = ResponseStream (f s) h b+mapResponseStatus _ r@(ResponseRaw _ _) = r++-- | Lifted 'Wai.modifyRequest'.+modifyRequest :: (Request es -> Request es) -> Middleware es+modifyRequest f app = app . f++-- | Lifted 'Wai.modifyResponse'.+modifyResponse :: (Response es -> Response es) -> Middleware es+modifyResponse f app req respond = app req $ respond . f++-- | Lifted 'Wai.ifRequest'.+ifRequest :: (Request es -> Bool) -> Middleware es -> Middleware es+ifRequest rpred middle app req+    | rpred req = middle app req+    | otherwise = app req

@@ -0,0 +1,81 @@+{-# OPTIONS_GHC -Wno-missing-local-signatures #-}+{-# OPTIONS_GHC -Wno-monomorphism-restriction #-}++module Main where++import Data.ByteString qualified as ByteString+import Data.ByteString.Builder (toLazyByteString, word8)+import Data.ByteString.Lazy qualified as LazyByteString+import Data.Foldable (for_)+import Data.List qualified as List+import Data.Tuple qualified as Tuple+import Data.Word (Word8)+import Effectful+import Effectful.FileSystem (runFileSystem)+import Effectful.FileSystem.IO.ByteString (readFile)+import Effectful.Hspec+import Effectful.Prim.IORef+import Effectful.Wai+import Prelude hiding (readFile)++main :: IO ()+main = runEff . runPrim . runFileSystem . runHspec . describe "Wai" $ do+    describe "responseToStream" do+        let getBody res = do+                let (_, _, f) = responseToStream res+                f \streamingBody -> do+                    builderRef <- newIORef mempty+                    let add b = atomicModifyIORef builderRef \builder -> (builder <> b, ())+                        flush = pure ()+                    streamingBody add flush+                    LazyByteString.toStrict . toLazyByteString <$> readIORef builderRef+        prop "responseLBS" \bytes -> do+            body <- getBody . responseLBS undefined undefined . LazyByteString.pack $ bytes+            body `shouldBe` ByteString.pack bytes+        prop "responseBuilder" \bytes -> do+            body <- getBody . responseBuilder undefined undefined . foldMap word8 $ bytes+            body `shouldBe` ByteString.pack bytes+        prop "responseStream" \chunks -> do+            body <- getBody $ responseStream undefined undefined \sendChunk _ ->+                for_ chunks $ sendChunk . foldMap word8+            body `shouldBe` ByteString.concat (map ByteString.pack chunks)+        it "responseFile total" do+            let fp = "LICENCE"+            body <- getBody $ responseFile undefined undefined fp Nothing+            expected <- readFile fp+            body `shouldBe` expected+        prop "responseFile partial" \offset' count' -> do+            let fp = "LICENCE"+            totalBS <- readFile fp+            let total = ByteString.length totalBS+                offset = abs offset' `mod` total+                count = abs count' `mod` (total - offset)+            body <-+                getBody . responseFile undefined undefined fp . Just $+                    FilePart+                        { filePartOffset = fromIntegral offset+                        , filePartByteCount = fromIntegral count+                        , filePartFileSize = fromIntegral total+                        }+            let expected = ByteString.take count $ ByteString.drop offset totalBS+            body `shouldBe` expected+    describe "lazyRequestBody" do+        prop "works" \chunks -> do+            req <- mkRequestFromChunks chunks+            body <- lazyRequestBody req+            body `shouldBe` LazyByteString.fromChunks (ByteString.pack <$> chunks)+        it "is lazy" do+            let req = setRequestBodyChunks (error "requestBody") defaultRequest+            _ <- lazyRequestBody req+            return ()+    describe "strictRequestBody" do+        prop "works" $ \chunks -> do+            req <- mkRequestFromChunks chunks+            body <- strictRequestBody req+            body `shouldBe` LazyByteString.fromChunks (map ByteString.pack chunks)++mkRequestFromChunks :: (IOE :> es, Prim :> es) => [[Word8]] -> Eff es (Request es)+mkRequestFromChunks chunks = do+    ref <- newIORef . map ByteString.pack . filter (not . null) $ chunks+    pure . flip setRequestBodyChunks defaultRequest . atomicModifyIORef ref $+        maybe mempty Tuple.swap . List.uncons

@@ -0,0 +1,75 @@+cabal-version: 3.0+name: wai-effectful+version: 1.0.0+synopsis: Effectful bindings for the wai library+description:+  Adaptation of the @<https://hackage.haskell.org/package/wai wai>@ 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: Network+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+    ImpredicativeTypes+    LambdaCase+    NamedFieldPuns+    NoImplicitPrelude+    OverloadedStrings+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    TypeApplications+    TypeFamilies+    TypeOperators+    ViewPatterns++  build-depends:+    base >=4.10 && <5,+    bytestring >=0.12 && <0.13,+    effectful >=2.6 && <2.7,++library+  import: common+  hs-source-dirs: src+  build-depends:+    http-types >=0.12 && <0.13,+    network >=3.2 && <3.3,+    text >=2.1 && <2.2,+    vault >=0.3 && <0.4,+    wai >=3.2.4 && <3.3,++  exposed-modules:+    Effectful.Wai++test-suite test+  import: common+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  build-depends:+    hspec-effectful >=1.1.1 && <1.2,+    wai-effectful,