packages feed

waiz (empty) → 0.0.1.0

raw patch · 10 files changed

+1268/−0 lines, 10 filesdep +basedep +bytestringdep +http-types

Dependencies added: base, bytestring, http-types, lens, network, process, text, vault, wai, waiz

Files

+ LICENCE view
@@ -0,0 +1,27 @@+Copyright (c) 2026 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ changelog view
@@ -0,0 +1,8 @@+0.0.1.0++* Initial release+* Classy optics (Get/Has/Review/As) for Request, Response, FilePart,+  RequestBodyLength+* Field lenses for Request and FilePart+* Constructor prisms for Response and RequestBodyLength+* Constructor classy optics for Response and RequestBodyLength
+ src/Network/Wai/Optics.hs view
@@ -0,0 +1,17 @@+{-# OPTIONS_GHC -Wall #-}++{- | Classy optics for the @wai@ package.++This module re-exports all optics for @wai@ data types.+-}+module Network.Wai.Optics (+  module Network.Wai.Optics.Request,+  module Network.Wai.Optics.Response,+  module Network.Wai.Optics.FilePart,+  module Network.Wai.Optics.RequestBodyLength,+) where++import Network.Wai.Optics.FilePart+import Network.Wai.Optics.Request+import Network.Wai.Optics.RequestBodyLength+import Network.Wai.Optics.Response
+ src/Network/Wai/Optics/FilePart.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-}++-- | Classy optics and field lenses for 'FilePart'.+module Network.Wai.Optics.FilePart (+  -- * Classy optics+  GetFilePart (..),+  HasFilePart (..),+  ReviewFilePart (..),+  AsFilePart (..),+) where++import Control.Category (id)+import Control.Lens (Getter, Lens', Prism', Review, lens, prism', review, set, to, unto, view)+import Data.Maybe (Maybe (..))+import Network.Wai.Internal (FilePart)+import qualified Network.Wai.Internal as Wai+import Network.Wai.Optics.Internal (+  filePartByteCountL,+  filePartFileSizeL,+  filePartOffsetL,+ )+import Prelude (Integer, const, flip, (.))++{- | Type class for values that can be viewed as a 'FilePart'.++>>> view getFilePart (Wai.FilePart 0 100 200)+FilePart {filePartOffset = 0, filePartByteCount = 100, filePartFileSize = 200}++>>> view getFilePartOffset (Wai.FilePart 10 100 200)+10++>>> view getFilePartByteCount (Wai.FilePart 0 100 200)+100++>>> view getFilePartFileSize (Wai.FilePart 0 100 200)+200+-}+class GetFilePart s where+  -- | A 'Getter' to obtain a 'FilePart'.+  getFilePart :: Getter s FilePart++  -- | A 'Getter' on the byte offset of a 'FilePart'.+  getFilePartOffset :: Getter s Integer+  getFilePartOffset = getFilePart . to Wai.filePartOffset+  {-# INLINE getFilePartOffset #-}++  -- | A 'Getter' on the byte count of a 'FilePart'.+  getFilePartByteCount :: Getter s Integer+  getFilePartByteCount = getFilePart . to Wai.filePartByteCount+  {-# INLINE getFilePartByteCount #-}++  -- | A 'Getter' on the total file size of a 'FilePart'.+  getFilePartFileSize :: Getter s Integer+  getFilePartFileSize = getFilePart . to Wai.filePartFileSize+  {-# INLINE getFilePartFileSize #-}++instance GetFilePart FilePart where+  getFilePart = id+  {-# INLINE getFilePart #-}+  getFilePartOffset = to Wai.filePartOffset+  {-# INLINE getFilePartOffset #-}+  getFilePartByteCount = to Wai.filePartByteCount+  {-# INLINE getFilePartByteCount #-}+  getFilePartFileSize = to Wai.filePartFileSize+  {-# INLINE getFilePartFileSize #-}++{- | Type class for values with a lens into a 'FilePart'.++>>> view filePart (Wai.FilePart 0 100 200)+FilePart {filePartOffset = 0, filePartByteCount = 100, filePartFileSize = 200}++>>> set filePart (Wai.FilePart 10 50 100) (Wai.FilePart 0 100 200)+FilePart {filePartOffset = 10, filePartByteCount = 50, filePartFileSize = 100}++>>> view filePartOffset (Wai.FilePart 10 100 200)+10++>>> set filePartOffset 50 (Wai.FilePart 10 100 200)+FilePart {filePartOffset = 50, filePartByteCount = 100, filePartFileSize = 200}++>>> view filePartByteCount (Wai.FilePart 0 100 200)+100++>>> set filePartByteCount 50 (Wai.FilePart 0 100 200)+FilePart {filePartOffset = 0, filePartByteCount = 50, filePartFileSize = 200}++>>> view filePartFileSize (Wai.FilePart 0 100 200)+200++>>> set filePartFileSize 500 (Wai.FilePart 0 100 200)+FilePart {filePartOffset = 0, filePartByteCount = 100, filePartFileSize = 500}+-}+class (GetFilePart s) => HasFilePart s where+  {-# MINIMAL setFilePart #-}++  -- | Replace the 'FilePart' component.+  setFilePart :: FilePart -> s -> s++  -- | A 'Lens'' into the 'FilePart' component.+  filePart :: Lens' s FilePart+  filePart = lens (view getFilePart) (flip setFilePart)+  {-# INLINE filePart #-}++  -- | Replace the byte offset of a 'FilePart'.+  setFilePartOffset :: Integer -> s -> s+  setFilePartOffset = set filePartOffset+  {-# INLINE setFilePartOffset #-}++  -- | A 'Lens'' on the byte offset of a 'FilePart'.+  filePartOffset :: Lens' s Integer+  filePartOffset = filePart . filePartOffsetL+  {-# INLINE filePartOffset #-}++  -- | Replace the byte count of a 'FilePart'.+  setFilePartByteCount :: Integer -> s -> s+  setFilePartByteCount = set filePartByteCount+  {-# INLINE setFilePartByteCount #-}++  -- | A 'Lens'' on the byte count of a 'FilePart'.+  filePartByteCount :: Lens' s Integer+  filePartByteCount = filePart . filePartByteCountL+  {-# INLINE filePartByteCount #-}++  -- | Replace the total file size of a 'FilePart'.+  setFilePartFileSize :: Integer -> s -> s+  setFilePartFileSize = set filePartFileSize+  {-# INLINE setFilePartFileSize #-}++  -- | A 'Lens'' on the total file size of a 'FilePart'.+  filePartFileSize :: Lens' s Integer+  filePartFileSize = filePart . filePartFileSizeL+  {-# INLINE filePartFileSize #-}++instance HasFilePart FilePart where+  setFilePart = const+  {-# INLINE setFilePart #-}+  filePartOffset = filePartOffsetL+  {-# INLINE filePartOffset #-}+  filePartByteCount = filePartByteCountL+  {-# INLINE filePartByteCount #-}+  filePartFileSize = filePartFileSizeL+  {-# INLINE filePartFileSize #-}++{- | Type class for values that can be constructed from a 'FilePart'.++>>> review reviewFilePart (Wai.FilePart 0 100 200) :: FilePart+FilePart {filePartOffset = 0, filePartByteCount = 100, filePartFileSize = 200}+-}+class ReviewFilePart t where+  -- | A 'Review' to construct a value from a 'FilePart'.+  reviewFilePart :: Review t FilePart++instance ReviewFilePart FilePart where+  reviewFilePart = unto id+  {-# INLINE reviewFilePart #-}++{- | Type class for values with a prism into a 'FilePart'.++>>> import Control.Lens (preview)+>>> preview _FilePart (Wai.FilePart 0 100 200)+Just (FilePart {filePartOffset = 0, filePartByteCount = 100, filePartFileSize = 200})+-}+class (ReviewFilePart t) => AsFilePart t where+  {-# MINIMAL matchFilePart #-}++  -- | Attempt to extract a 'FilePart'.+  matchFilePart :: t -> Maybe FilePart++  -- | A 'Prism'' into a 'FilePart'.+  _FilePart :: Prism' t FilePart+  _FilePart = prism' (review reviewFilePart) matchFilePart+  {-# INLINE _FilePart #-}++instance AsFilePart FilePart where+  matchFilePart = Just+  {-# INLINE matchFilePart #-}
+ src/Network/Wai/Optics/Internal.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall -Wno-deprecations #-}++module Network.Wai.Optics.Internal (+  -- * Request field lenses+  requestMethodL,+  httpVersionL,+  rawPathInfoL,+  rawQueryStringL,+  requestHeadersL,+  isSecureL,+  remoteHostL,+  pathInfoL,+  queryStringL,+  requestBodyL,+  vaultL,+  requestBodyLengthL,+  requestHeaderHostL,+  requestHeaderRangeL,+  requestHeaderRefererL,+  requestHeaderUserAgentL,++  -- * FilePart field lenses+  filePartOffsetL,+  filePartByteCountL,+  filePartFileSizeL,+) where++import Control.Lens (Lens', lens)+import Data.Bool (Bool)+import Data.ByteString (ByteString)+import Data.Maybe (Maybe)+import Data.Text (Text)+import Data.Vault.Lazy (Vault)+import Network.HTTP.Types (HttpVersion, Method, Query, RequestHeaders)+import Network.Socket (SockAddr)+import Network.Wai.Internal (+  FilePart (..),+  Request (..),+  RequestBodyLength,+ )+import Prelude (IO, Integer)++requestMethodL :: Lens' Request Method+requestMethodL = lens requestMethod (\r x -> r{requestMethod = x})+{-# INLINE requestMethodL #-}++httpVersionL :: Lens' Request HttpVersion+httpVersionL = lens httpVersion (\r x -> r{httpVersion = x})+{-# INLINE httpVersionL #-}++rawPathInfoL :: Lens' Request ByteString+rawPathInfoL = lens rawPathInfo (\r x -> r{rawPathInfo = x})+{-# INLINE rawPathInfoL #-}++rawQueryStringL :: Lens' Request ByteString+rawQueryStringL = lens rawQueryString (\r x -> r{rawQueryString = x})+{-# INLINE rawQueryStringL #-}++requestHeadersL :: Lens' Request RequestHeaders+requestHeadersL = lens requestHeaders (\r x -> r{requestHeaders = x})+{-# INLINE requestHeadersL #-}++isSecureL :: Lens' Request Bool+isSecureL = lens isSecure (\r x -> r{isSecure = x})+{-# INLINE isSecureL #-}++remoteHostL :: Lens' Request SockAddr+remoteHostL = lens remoteHost (\r x -> r{remoteHost = x})+{-# INLINE remoteHostL #-}++pathInfoL :: Lens' Request [Text]+pathInfoL = lens pathInfo (\r x -> r{pathInfo = x})+{-# INLINE pathInfoL #-}++queryStringL :: Lens' Request Query+queryStringL = lens queryString (\r x -> r{queryString = x})+{-# INLINE queryStringL #-}++requestBodyL :: Lens' Request (IO ByteString)+requestBodyL = lens requestBody (\r x -> r{requestBody = x})+{-# INLINE requestBodyL #-}++vaultL :: Lens' Request Vault+vaultL = lens vault (\r x -> r{vault = x})+{-# INLINE vaultL #-}++requestBodyLengthL :: Lens' Request RequestBodyLength+requestBodyLengthL = lens requestBodyLength (\r x -> r{requestBodyLength = x})+{-# INLINE requestBodyLengthL #-}++requestHeaderHostL :: Lens' Request (Maybe ByteString)+requestHeaderHostL = lens requestHeaderHost (\r x -> r{requestHeaderHost = x})+{-# INLINE requestHeaderHostL #-}++requestHeaderRangeL :: Lens' Request (Maybe ByteString)+requestHeaderRangeL = lens requestHeaderRange (\r x -> r{requestHeaderRange = x})+{-# INLINE requestHeaderRangeL #-}++requestHeaderRefererL :: Lens' Request (Maybe ByteString)+requestHeaderRefererL = lens requestHeaderReferer (\r x -> r{requestHeaderReferer = x})+{-# INLINE requestHeaderRefererL #-}++requestHeaderUserAgentL :: Lens' Request (Maybe ByteString)+requestHeaderUserAgentL = lens requestHeaderUserAgent (\r x -> r{requestHeaderUserAgent = x})+{-# INLINE requestHeaderUserAgentL #-}++filePartOffsetL :: Lens' FilePart Integer+filePartOffsetL = lens filePartOffset (\r x -> r{filePartOffset = x})+{-# INLINE filePartOffsetL #-}++filePartByteCountL :: Lens' FilePart Integer+filePartByteCountL = lens filePartByteCount (\r x -> r{filePartByteCount = x})+{-# INLINE filePartByteCountL #-}++filePartFileSizeL :: Lens' FilePart Integer+filePartFileSizeL = lens filePartFileSize (\r x -> r{filePartFileSize = x})+{-# INLINE filePartFileSizeL #-}
+ src/Network/Wai/Optics/Request.hs view
@@ -0,0 +1,399 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-}++-- | Classy optics and field lenses for 'Request'.+module Network.Wai.Optics.Request (+  -- * Classy optics+  GetRequest (..),+  HasRequest (..),+  ReviewRequest (..),+  AsRequest (..),+) where++import Control.Category (id)+import Control.Lens (Getter, Lens', Prism', Review, lens, prism', review, set, to, unto, view)+import Data.Bool (Bool)+import Data.ByteString (ByteString)+import Data.Maybe (Maybe (..))+import Data.Text (Text)+import Data.Vault.Lazy (Vault)+import Network.HTTP.Types (HttpVersion, Method, Query, RequestHeaders)+import Network.Socket (SockAddr)+import Network.Wai (Request)+import qualified Network.Wai as Wai+import Network.Wai.Internal (RequestBodyLength)+import Network.Wai.Optics.Internal (+  httpVersionL,+  isSecureL,+  pathInfoL,+  queryStringL,+  rawPathInfoL,+  rawQueryStringL,+  remoteHostL,+  requestBodyL,+  requestBodyLengthL,+  requestHeaderHostL,+  requestHeaderRangeL,+  requestHeaderRefererL,+  requestHeaderUserAgentL,+  requestHeadersL,+  requestMethodL,+  vaultL,+ )+import Prelude (IO, const, flip, (.))++-- | Type class for values that can be viewed as a 'Request'.+class GetRequest s where+  -- | A 'Getter' to obtain a 'Request'.+  getRequest :: Getter s Request++  -- | A 'Getter' on the HTTP request method.+  getRequestMethod :: Getter s Method+  getRequestMethod = getRequest . to Wai.requestMethod+  {-# INLINE getRequestMethod #-}++  -- | A 'Getter' on the HTTP version.+  getHttpVersion :: Getter s HttpVersion+  getHttpVersion = getRequest . to Wai.httpVersion+  {-# INLINE getHttpVersion #-}++  -- | A 'Getter' on the raw path info.+  getRawPathInfo :: Getter s ByteString+  getRawPathInfo = getRequest . to Wai.rawPathInfo+  {-# INLINE getRawPathInfo #-}++  -- | A 'Getter' on the raw query string.+  getRawQueryString :: Getter s ByteString+  getRawQueryString = getRequest . to Wai.rawQueryString+  {-# INLINE getRawQueryString #-}++  -- | A 'Getter' on the request headers.+  getRequestHeaders :: Getter s RequestHeaders+  getRequestHeaders = getRequest . to Wai.requestHeaders+  {-# INLINE getRequestHeaders #-}++  -- | A 'Getter' on whether the request was made over a secure connection.+  getIsSecure :: Getter s Bool+  getIsSecure = getRequest . to Wai.isSecure+  {-# INLINE getIsSecure #-}++  -- | A 'Getter' on the remote host address.+  getRemoteHost :: Getter s SockAddr+  getRemoteHost = getRequest . to Wai.remoteHost+  {-# INLINE getRemoteHost #-}++  -- | A 'Getter' on the parsed path segments.+  getPathInfo :: Getter s [Text]+  getPathInfo = getRequest . to Wai.pathInfo+  {-# INLINE getPathInfo #-}++  -- | A 'Getter' on the parsed query string.+  getQueryString :: Getter s Query+  getQueryString = getRequest . to Wai.queryString+  {-# INLINE getQueryString #-}++  -- | A 'Getter' on the request body action.+  getRequestBody :: Getter s (IO ByteString)+  getRequestBody = getRequest . to Wai.getRequestBodyChunk+  {-# INLINE getRequestBody #-}++  -- | A 'Getter' on the 'Vault'.+  getVault :: Getter s Vault+  getVault = getRequest . to Wai.vault+  {-# INLINE getVault #-}++  -- | A 'Getter' on the 'RequestBodyLength'.+  getRequestBodyLengthField :: Getter s RequestBodyLength+  getRequestBodyLengthField = getRequest . to Wai.requestBodyLength+  {-# INLINE getRequestBodyLengthField #-}++  -- | A 'Getter' on the @Host@ header.+  getRequestHeaderHost :: Getter s (Maybe ByteString)+  getRequestHeaderHost = getRequest . to Wai.requestHeaderHost+  {-# INLINE getRequestHeaderHost #-}++  -- | A 'Getter' on the @Range@ header.+  getRequestHeaderRange :: Getter s (Maybe ByteString)+  getRequestHeaderRange = getRequest . to Wai.requestHeaderRange+  {-# INLINE getRequestHeaderRange #-}++  -- | A 'Getter' on the @Referer@ header.+  getRequestHeaderReferer :: Getter s (Maybe ByteString)+  getRequestHeaderReferer = getRequest . to Wai.requestHeaderReferer+  {-# INLINE getRequestHeaderReferer #-}++  -- | A 'Getter' on the @User-Agent@ header.+  getRequestHeaderUserAgent :: Getter s (Maybe ByteString)+  getRequestHeaderUserAgent = getRequest . to Wai.requestHeaderUserAgent+  {-# INLINE getRequestHeaderUserAgent #-}++instance GetRequest Request where+  getRequest = id+  {-# INLINE getRequest #-}+  getRequestMethod = to Wai.requestMethod+  {-# INLINE getRequestMethod #-}+  getHttpVersion = to Wai.httpVersion+  {-# INLINE getHttpVersion #-}+  getRawPathInfo = to Wai.rawPathInfo+  {-# INLINE getRawPathInfo #-}+  getRawQueryString = to Wai.rawQueryString+  {-# INLINE getRawQueryString #-}+  getRequestHeaders = to Wai.requestHeaders+  {-# INLINE getRequestHeaders #-}+  getIsSecure = to Wai.isSecure+  {-# INLINE getIsSecure #-}+  getRemoteHost = to Wai.remoteHost+  {-# INLINE getRemoteHost #-}+  getPathInfo = to Wai.pathInfo+  {-# INLINE getPathInfo #-}+  getQueryString = to Wai.queryString+  {-# INLINE getQueryString #-}+  getRequestBody = to Wai.getRequestBodyChunk+  {-# INLINE getRequestBody #-}+  getVault = to Wai.vault+  {-# INLINE getVault #-}+  getRequestBodyLengthField = to Wai.requestBodyLength+  {-# INLINE getRequestBodyLengthField #-}+  getRequestHeaderHost = to Wai.requestHeaderHost+  {-# INLINE getRequestHeaderHost #-}+  getRequestHeaderRange = to Wai.requestHeaderRange+  {-# INLINE getRequestHeaderRange #-}+  getRequestHeaderReferer = to Wai.requestHeaderReferer+  {-# INLINE getRequestHeaderReferer #-}+  getRequestHeaderUserAgent = to Wai.requestHeaderUserAgent+  {-# INLINE getRequestHeaderUserAgent #-}++-- | Type class for values with a lens into a 'Request'.+class (GetRequest s) => HasRequest s where+  {-# MINIMAL setRequest #-}++  -- | Replace the 'Request' component.+  setRequest :: Request -> s -> s++  -- | A 'Lens'' into the 'Request' component.+  request :: Lens' s Request+  request = lens (view getRequest) (flip setRequest)+  {-# INLINE request #-}++  -- | Replace the HTTP request method.+  setRequestMethod :: Method -> s -> s+  setRequestMethod = set requestMethod+  {-# INLINE setRequestMethod #-}++  -- | A 'Lens'' on the HTTP request method.+  requestMethod :: Lens' s Method+  requestMethod = request . requestMethodL+  {-# INLINE requestMethod #-}++  -- | Replace the HTTP version.+  setHttpVersion :: HttpVersion -> s -> s+  setHttpVersion = set httpVersion+  {-# INLINE setHttpVersion #-}++  -- | A 'Lens'' on the HTTP version.+  httpVersion :: Lens' s HttpVersion+  httpVersion = request . httpVersionL+  {-# INLINE httpVersion #-}++  -- | Replace the raw path info.+  setRawPathInfo :: ByteString -> s -> s+  setRawPathInfo = set rawPathInfo+  {-# INLINE setRawPathInfo #-}++  -- | A 'Lens'' on the raw path info.+  rawPathInfo :: Lens' s ByteString+  rawPathInfo = request . rawPathInfoL+  {-# INLINE rawPathInfo #-}++  -- | Replace the raw query string.+  setRawQueryString :: ByteString -> s -> s+  setRawQueryString = set rawQueryString+  {-# INLINE setRawQueryString #-}++  -- | A 'Lens'' on the raw query string.+  rawQueryString :: Lens' s ByteString+  rawQueryString = request . rawQueryStringL+  {-# INLINE rawQueryString #-}++  -- | Replace the request headers.+  setRequestHeaders :: RequestHeaders -> s -> s+  setRequestHeaders = set requestHeaders+  {-# INLINE setRequestHeaders #-}++  -- | A 'Lens'' on the request headers.+  requestHeaders :: Lens' s RequestHeaders+  requestHeaders = request . requestHeadersL+  {-# INLINE requestHeaders #-}++  -- | Replace whether the request was made over a secure connection.+  setIsSecure :: Bool -> s -> s+  setIsSecure = set isSecure+  {-# INLINE setIsSecure #-}++  -- | A 'Lens'' on whether the request was made over a secure connection.+  isSecure :: Lens' s Bool+  isSecure = request . isSecureL+  {-# INLINE isSecure #-}++  -- | Replace the remote host address.+  setRemoteHost :: SockAddr -> s -> s+  setRemoteHost = set remoteHost+  {-# INLINE setRemoteHost #-}++  -- | A 'Lens'' on the remote host address.+  remoteHost :: Lens' s SockAddr+  remoteHost = request . remoteHostL+  {-# INLINE remoteHost #-}++  -- | Replace the parsed path segments.+  setPathInfo :: [Text] -> s -> s+  setPathInfo = set pathInfo+  {-# INLINE setPathInfo #-}++  -- | A 'Lens'' on the parsed path segments.+  pathInfo :: Lens' s [Text]+  pathInfo = request . pathInfoL+  {-# INLINE pathInfo #-}++  -- | Replace the parsed query string.+  setQueryString :: Query -> s -> s+  setQueryString = set queryString+  {-# INLINE setQueryString #-}++  -- | A 'Lens'' on the parsed query string.+  queryString :: Lens' s Query+  queryString = request . queryStringL+  {-# INLINE queryString #-}++  -- | Replace the request body action.+  setRequestBody :: IO ByteString -> s -> s+  setRequestBody = set requestBody+  {-# INLINE setRequestBody #-}++  -- | A 'Lens'' on the request body action.+  requestBody :: Lens' s (IO ByteString)+  requestBody = request . requestBodyL+  {-# INLINE requestBody #-}++  -- | Replace the 'Vault'.+  setVault :: Vault -> s -> s+  setVault = set vault+  {-# INLINE setVault #-}++  -- | A 'Lens'' on the 'Vault'.+  vault :: Lens' s Vault+  vault = request . vaultL+  {-# INLINE vault #-}++  -- | Replace the 'RequestBodyLength'.+  setRequestBodyLengthField :: RequestBodyLength -> s -> s+  setRequestBodyLengthField = set requestBodyLengthField+  {-# INLINE setRequestBodyLengthField #-}++  -- | A 'Lens'' on the 'RequestBodyLength'.+  requestBodyLengthField :: Lens' s RequestBodyLength+  requestBodyLengthField = request . requestBodyLengthL+  {-# INLINE requestBodyLengthField #-}++  -- | Replace the @Host@ header.+  setRequestHeaderHost :: Maybe ByteString -> s -> s+  setRequestHeaderHost = set requestHeaderHost+  {-# INLINE setRequestHeaderHost #-}++  -- | A 'Lens'' on the @Host@ header.+  requestHeaderHost :: Lens' s (Maybe ByteString)+  requestHeaderHost = request . requestHeaderHostL+  {-# INLINE requestHeaderHost #-}++  -- | Replace the @Range@ header.+  setRequestHeaderRange :: Maybe ByteString -> s -> s+  setRequestHeaderRange = set requestHeaderRange+  {-# INLINE setRequestHeaderRange #-}++  -- | A 'Lens'' on the @Range@ header.+  requestHeaderRange :: Lens' s (Maybe ByteString)+  requestHeaderRange = request . requestHeaderRangeL+  {-# INLINE requestHeaderRange #-}++  -- | Replace the @Referer@ header.+  setRequestHeaderReferer :: Maybe ByteString -> s -> s+  setRequestHeaderReferer = set requestHeaderReferer+  {-# INLINE setRequestHeaderReferer #-}++  -- | A 'Lens'' on the @Referer@ header.+  requestHeaderReferer :: Lens' s (Maybe ByteString)+  requestHeaderReferer = request . requestHeaderRefererL+  {-# INLINE requestHeaderReferer #-}++  -- | Replace the @User-Agent@ header.+  setRequestHeaderUserAgent :: Maybe ByteString -> s -> s+  setRequestHeaderUserAgent = set requestHeaderUserAgent+  {-# INLINE setRequestHeaderUserAgent #-}++  -- | A 'Lens'' on the @User-Agent@ header.+  requestHeaderUserAgent :: Lens' s (Maybe ByteString)+  requestHeaderUserAgent = request . requestHeaderUserAgentL+  {-# INLINE requestHeaderUserAgent #-}++instance HasRequest Request where+  setRequest = const+  {-# INLINE setRequest #-}+  requestMethod = requestMethodL+  {-# INLINE requestMethod #-}+  httpVersion = httpVersionL+  {-# INLINE httpVersion #-}+  rawPathInfo = rawPathInfoL+  {-# INLINE rawPathInfo #-}+  rawQueryString = rawQueryStringL+  {-# INLINE rawQueryString #-}+  requestHeaders = requestHeadersL+  {-# INLINE requestHeaders #-}+  isSecure = isSecureL+  {-# INLINE isSecure #-}+  remoteHost = remoteHostL+  {-# INLINE remoteHost #-}+  pathInfo = pathInfoL+  {-# INLINE pathInfo #-}+  queryString = queryStringL+  {-# INLINE queryString #-}+  requestBody = requestBodyL+  {-# INLINE requestBody #-}+  vault = vaultL+  {-# INLINE vault #-}+  requestBodyLengthField = requestBodyLengthL+  {-# INLINE requestBodyLengthField #-}+  requestHeaderHost = requestHeaderHostL+  {-# INLINE requestHeaderHost #-}+  requestHeaderRange = requestHeaderRangeL+  {-# INLINE requestHeaderRange #-}+  requestHeaderReferer = requestHeaderRefererL+  {-# INLINE requestHeaderReferer #-}+  requestHeaderUserAgent = requestHeaderUserAgentL+  {-# INLINE requestHeaderUserAgent #-}++-- | Type class for values that can be constructed from a 'Request'.+class ReviewRequest t where+  -- | A 'Review' to construct a value from a 'Request'.+  reviewRequest :: Review t Request++instance ReviewRequest Request where+  reviewRequest = unto id+  {-# INLINE reviewRequest #-}++-- | Type class for values with a prism into a 'Request'.+class (ReviewRequest t) => AsRequest t where+  {-# MINIMAL matchRequest #-}++  -- | Attempt to extract a 'Request'.+  matchRequest :: t -> Maybe Request++  -- | A 'Prism'' into a 'Request'.+  _Request :: Prism' t Request+  _Request = prism' (review reviewRequest) matchRequest+  {-# INLINE _Request #-}++instance AsRequest Request where+  matchRequest = Just+  {-# INLINE matchRequest #-}
+ src/Network/Wai/Optics/RequestBodyLength.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-}++-- | Classy optics and constructor prisms for 'RequestBodyLength'.+module Network.Wai.Optics.RequestBodyLength (+  -- * Classy optics+  GetRequestBodyLength (..),+  HasRequestBodyLength (..),+  ReviewRequestBodyLength (..),+  AsRequestBodyLength (..),++  -- * Constructor prisms++  -- ** ChunkedBody+  ReviewChunkedBody (..),+  AsChunkedBody (..),++  -- ** KnownLength+  ReviewKnownLength (..),+  AsKnownLength (..),+) where++import Control.Category (id)+import Control.Lens (Getter, Lens', Prism', Review, lens, prism', review, unto, view)+import Data.Maybe (Maybe (..))+import Data.Word (Word64)+import Network.Wai.Internal (RequestBodyLength (..))+import Prelude (const, flip)++{- $setup+>>> import Control.Lens (view, set, preview)+>>> import Network.Wai.Internal (RequestBodyLength(ChunkedBody, KnownLength))+-}++{- | Type class for values that can be viewed as a 'RequestBodyLength'.++>>> view getRequestBodyLength ChunkedBody+ChunkedBody++>>> view getRequestBodyLength (KnownLength 1024)+KnownLength 1024+-}+class GetRequestBodyLength s where+  -- | A 'Getter' to obtain a 'RequestBodyLength'.+  getRequestBodyLength :: Getter s RequestBodyLength++instance GetRequestBodyLength RequestBodyLength where+  getRequestBodyLength = id+  {-# INLINE getRequestBodyLength #-}++{- | Type class for values with a lens into a 'RequestBodyLength'.++>>> set requestBodyLengthL (KnownLength 512) ChunkedBody+KnownLength 512+-}+class (GetRequestBodyLength s) => HasRequestBodyLength s where+  {-# MINIMAL setRequestBodyLength #-}++  -- | Replace the 'RequestBodyLength' component.+  setRequestBodyLength :: RequestBodyLength -> s -> s++  -- | A 'Lens'' into the 'RequestBodyLength' component.+  requestBodyLengthL :: Lens' s RequestBodyLength+  requestBodyLengthL = lens (view getRequestBodyLength) (flip setRequestBodyLength)+  {-# INLINE requestBodyLengthL #-}++instance HasRequestBodyLength RequestBodyLength where+  setRequestBodyLength = const+  {-# INLINE setRequestBodyLength #-}++{- | Type class for values that can be constructed from a 'RequestBodyLength'.++>>> review reviewRequestBodyLength ChunkedBody :: RequestBodyLength+ChunkedBody+-}+class ReviewRequestBodyLength t where+  -- | A 'Review' to construct a value from a 'RequestBodyLength'.+  reviewRequestBodyLength :: Review t RequestBodyLength++instance ReviewRequestBodyLength RequestBodyLength where+  reviewRequestBodyLength = unto id+  {-# INLINE reviewRequestBodyLength #-}++{- | Type class for values with a prism into a 'RequestBodyLength'.++>>> preview _RequestBodyLength (KnownLength 1024)+Just (KnownLength 1024)+-}+class (ReviewRequestBodyLength t) => AsRequestBodyLength t where+  {-# MINIMAL matchRequestBodyLength #-}++  -- | Attempt to extract a 'RequestBodyLength'.+  matchRequestBodyLength :: t -> Maybe RequestBodyLength++  -- | A 'Prism'' into a 'RequestBodyLength'.+  _RequestBodyLength :: Prism' t RequestBodyLength+  _RequestBodyLength = prism' (review reviewRequestBodyLength) matchRequestBodyLength+  {-# INLINE _RequestBodyLength #-}++instance AsRequestBodyLength RequestBodyLength where+  matchRequestBodyLength = Just+  {-# INLINE matchRequestBodyLength #-}++-- ** ChunkedBody++{- | Type class for values that can be constructed as a 'ChunkedBody'.++>>> review reviewChunkedBody () :: RequestBodyLength+ChunkedBody+-}+class ReviewChunkedBody t where+  -- | A 'Review' to construct a 'ChunkedBody'.+  reviewChunkedBody :: Review t ()++instance ReviewChunkedBody RequestBodyLength where+  reviewChunkedBody = unto (\() -> ChunkedBody)+  {-# INLINE reviewChunkedBody #-}++{- | Type class for values with a prism into a 'ChunkedBody'.++>>> preview _ChunkedBody ChunkedBody+Just ()++>>> preview _ChunkedBody (KnownLength 1024)+Nothing+-}+class (ReviewChunkedBody t) => AsChunkedBody t where+  {-# MINIMAL matchChunkedBody #-}++  -- | Attempt to match a 'ChunkedBody'.+  matchChunkedBody :: t -> Maybe ()++  -- | A 'Prism'' into a 'ChunkedBody'.+  _ChunkedBody :: Prism' t ()+  _ChunkedBody = prism' (review reviewChunkedBody) matchChunkedBody+  {-# INLINE _ChunkedBody #-}++instance AsChunkedBody RequestBodyLength where+  matchChunkedBody = \case+    ChunkedBody -> Just ()+    _ -> Nothing+  {-# INLINE matchChunkedBody #-}++-- ** KnownLength++{- | Type class for values that can be constructed as a 'KnownLength'.++>>> review reviewKnownLength 1024 :: RequestBodyLength+KnownLength 1024+-}+class ReviewKnownLength t where+  -- | A 'Review' to construct a 'KnownLength'.+  reviewKnownLength :: Review t Word64++instance ReviewKnownLength RequestBodyLength where+  reviewKnownLength = unto KnownLength+  {-# INLINE reviewKnownLength #-}++{- | Type class for values with a prism into a 'KnownLength'.++>>> preview _KnownLength (KnownLength 1024)+Just 1024++>>> preview _KnownLength ChunkedBody+Nothing+-}+class (ReviewKnownLength t) => AsKnownLength t where+  {-# MINIMAL matchKnownLength #-}++  -- | Attempt to extract the length from a 'KnownLength'.+  matchKnownLength :: t -> Maybe Word64++  -- | A 'Prism'' into a 'KnownLength'.+  _KnownLength :: Prism' t Word64+  _KnownLength = prism' (review reviewKnownLength) matchKnownLength+  {-# INLINE _KnownLength #-}++instance AsKnownLength RequestBodyLength where+  matchKnownLength = \case+    KnownLength n -> Just n+    _ -> Nothing+  {-# INLINE matchKnownLength #-}
+ src/Network/Wai/Optics/Response.hs view
@@ -0,0 +1,226 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-}++-- | Classy optics and constructor prisms for 'Response'.+module Network.Wai.Optics.Response (+  -- * Classy optics+  GetResponse (..),+  HasResponse (..),+  ReviewResponse (..),+  AsResponse (..),++  -- * Constructor prisms++  -- ** ResponseFile+  ReviewResponseFile (..),+  AsResponseFile (..),++  -- ** ResponseBuilder+  ReviewResponseBuilder (..),+  AsResponseBuilder (..),++  -- ** ResponseStream+  ReviewResponseStream (..),+  AsResponseStream (..),++  -- ** ResponseRaw+  ReviewResponseRaw (..),+  AsResponseRaw (..),++  -- * Getters+  responseStatus,+  responseHeaders,+) where++import Control.Category (id)+import Control.Lens (Getter, Lens', Prism', Review, lens, prism', review, to, unto, view)+import Data.ByteString (ByteString)+import Data.ByteString.Builder (Builder)+import Data.Maybe (Maybe (..))+import Network.HTTP.Types (ResponseHeaders, Status)+import Network.Wai (Response, StreamingBody)+import qualified Network.Wai as Wai+import Network.Wai.Internal (+  FilePart,+  Response (..),+ )+import Prelude (FilePath, IO, const, flip, uncurry)++-- | Type class for values that can be viewed as a 'Response'.+class GetResponse s where+  -- | A 'Getter' to obtain a 'Response'.+  getResponse :: Getter s Response++instance GetResponse Response where+  getResponse = id+  {-# INLINE getResponse #-}++-- | Type class for values with a lens into a 'Response'.+class (GetResponse s) => HasResponse s where+  {-# MINIMAL setResponse #-}++  -- | Replace the 'Response' component.+  setResponse :: Response -> s -> s++  -- | A 'Lens'' into the 'Response' component.+  response :: Lens' s Response+  response = lens (view getResponse) (flip setResponse)+  {-# INLINE response #-}++instance HasResponse Response where+  setResponse = const+  {-# INLINE setResponse #-}++-- | Type class for values that can be constructed from a 'Response'.+class ReviewResponse t where+  -- | A 'Review' to construct a value from a 'Response'.+  reviewResponse :: Review t Response++instance ReviewResponse Response where+  reviewResponse = unto id+  {-# INLINE reviewResponse #-}++-- | Type class for values with a prism into a 'Response'.+class (ReviewResponse t) => AsResponse t where+  {-# MINIMAL matchResponse #-}++  -- | Attempt to extract a 'Response'.+  matchResponse :: t -> Maybe Response++  -- | A 'Prism'' into a 'Response'.+  _Response :: Prism' t Response+  _Response = prism' (review reviewResponse) matchResponse+  {-# INLINE _Response #-}++instance AsResponse Response where+  matchResponse = Just+  {-# INLINE matchResponse #-}++-- | A 'Getter' on the 'Status' of a 'Response'.+responseStatus :: Getter Response Status+responseStatus = to Wai.responseStatus+{-# INLINE responseStatus #-}++-- | A 'Getter' on the 'ResponseHeaders' of a 'Response'.+responseHeaders :: Getter Response ResponseHeaders+responseHeaders = to Wai.responseHeaders+{-# INLINE responseHeaders #-}++-- ** ResponseFile++-- | Type class for values that can be constructed from a @ResponseFile@.+class ReviewResponseFile t where+  -- | A 'Review' to construct a value from @ResponseFile@ components.+  reviewResponseFile :: Review t (Status, ResponseHeaders, FilePath, Maybe FilePart)++instance ReviewResponseFile Response where+  reviewResponseFile = unto (\(s, h, fp, mfp) -> ResponseFile s h fp mfp)+  {-# INLINE reviewResponseFile #-}++-- | Type class for values with a prism into a @ResponseFile@.+class (ReviewResponseFile t) => AsResponseFile t where+  {-# MINIMAL matchResponseFile #-}++  -- | Attempt to extract @ResponseFile@ components.+  matchResponseFile :: t -> Maybe (Status, ResponseHeaders, FilePath, Maybe FilePart)++  -- | A 'Prism'' into @ResponseFile@ components.+  _ResponseFile :: Prism' t (Status, ResponseHeaders, FilePath, Maybe FilePart)+  _ResponseFile = prism' (review reviewResponseFile) matchResponseFile+  {-# INLINE _ResponseFile #-}++instance AsResponseFile Response where+  matchResponseFile = \case+    ResponseFile s h fp mfp -> Just (s, h, fp, mfp)+    _ -> Nothing+  {-# INLINE matchResponseFile #-}++-- ** ResponseBuilder++-- | Type class for values that can be constructed from a @ResponseBuilder@.+class ReviewResponseBuilder t where+  -- | A 'Review' to construct a value from @ResponseBuilder@ components.+  reviewResponseBuilder :: Review t (Status, ResponseHeaders, Builder)++instance ReviewResponseBuilder Response where+  reviewResponseBuilder = unto (\(s, h, b) -> ResponseBuilder s h b)+  {-# INLINE reviewResponseBuilder #-}++-- | Type class for values with a prism into a @ResponseBuilder@.+class (ReviewResponseBuilder t) => AsResponseBuilder t where+  {-# MINIMAL matchResponseBuilder #-}++  -- | Attempt to extract @ResponseBuilder@ components.+  matchResponseBuilder :: t -> Maybe (Status, ResponseHeaders, Builder)++  -- | A 'Prism'' into @ResponseBuilder@ components.+  _ResponseBuilder :: Prism' t (Status, ResponseHeaders, Builder)+  _ResponseBuilder = prism' (review reviewResponseBuilder) matchResponseBuilder+  {-# INLINE _ResponseBuilder #-}++instance AsResponseBuilder Response where+  matchResponseBuilder = \case+    ResponseBuilder s h b -> Just (s, h, b)+    _ -> Nothing+  {-# INLINE matchResponseBuilder #-}++-- ** ResponseStream++-- | Type class for values that can be constructed from a @ResponseStream@.+class ReviewResponseStream t where+  -- | A 'Review' to construct a value from @ResponseStream@ components.+  reviewResponseStream :: Review t (Status, ResponseHeaders, StreamingBody)++instance ReviewResponseStream Response where+  reviewResponseStream = unto (\(s, h, sb) -> ResponseStream s h sb)+  {-# INLINE reviewResponseStream #-}++-- | Type class for values with a prism into a @ResponseStream@.+class (ReviewResponseStream t) => AsResponseStream t where+  {-# MINIMAL matchResponseStream #-}++  -- | Attempt to extract @ResponseStream@ components.+  matchResponseStream :: t -> Maybe (Status, ResponseHeaders, StreamingBody)++  -- | A 'Prism'' into @ResponseStream@ components.+  _ResponseStream :: Prism' t (Status, ResponseHeaders, StreamingBody)+  _ResponseStream = prism' (review reviewResponseStream) matchResponseStream+  {-# INLINE _ResponseStream #-}++instance AsResponseStream Response where+  matchResponseStream = \case+    ResponseStream s h sb -> Just (s, h, sb)+    _ -> Nothing+  {-# INLINE matchResponseStream #-}++-- ** ResponseRaw++-- | Type class for values that can be constructed from a @ResponseRaw@.+class ReviewResponseRaw t where+  -- | A 'Review' to construct a value from @ResponseRaw@ components.+  reviewResponseRaw :: Review t (IO ByteString -> (ByteString -> IO ()) -> IO (), Response)++instance ReviewResponseRaw Response where+  reviewResponseRaw = unto (uncurry ResponseRaw)+  {-# INLINE reviewResponseRaw #-}++-- | Type class for values with a prism into a @ResponseRaw@.+class (ReviewResponseRaw t) => AsResponseRaw t where+  {-# MINIMAL matchResponseRaw #-}++  -- | Attempt to extract @ResponseRaw@ components.+  matchResponseRaw :: t -> Maybe (IO ByteString -> (ByteString -> IO ()) -> IO (), Response)++  -- | A 'Prism'' into @ResponseRaw@ components.+  _ResponseRaw :: Prism' t (IO ByteString -> (ByteString -> IO ()) -> IO (), Response)+  _ResponseRaw = prism' (review reviewResponseRaw) matchResponseRaw+  {-# INLINE _ResponseRaw #-}++instance AsResponseRaw Response where+  matchResponseRaw = \case+    ResponseRaw f r -> Just (f, r)+    _ -> Nothing+  {-# INLINE matchResponseRaw #-}
+ test/doctest_tests.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS_GHC -Wall #-}++module Main where++import System.Exit (ExitCode (ExitFailure, ExitSuccess), exitFailure, exitSuccess)+import System.Process (rawSystem)++main :: IO ()+main = do+  r <-+    rawSystem+      "cabal"+      [ "exec"+      , "--"+      , "doctest"+      , "-isrc"+      , "src/Network/Wai/Optics/FilePart.hs"+      , "src/Network/Wai/Optics/RequestBodyLength.hs"+      ]+  case r of+    ExitSuccess -> exitSuccess+    ExitFailure _ -> exitFailure
+ waiz.cabal view
@@ -0,0 +1,87 @@+name:               waiz+version:            0.0.1.0+license:            BSD3+license-file:       LICENCE+author:             Tony Morris <tmorris@tmorris.net>+maintainer:         Tony Morris <tmorris@tmorris.net>+copyright:          Copyright (c) 2026 Tony Morris+synopsis:           Classy optics for the wai package+category:           Web+description:+  Classy optics (@GetXXX@, @HasXXX@, @ReviewXXX@, @AsXXX@) for all+  data types in the+  <https://hackage.haskell.org/package/wai wai> package.+  .+  For each data type in @wai@ (@Request@, @Response@, @FilePart@,+  @RequestBodyLength@), this package provides:+  .+  * Getter type class (@GetXXX@)+  * Lens type class (@HasXXX@)+  * Review type class (@ReviewXXX@)+  * Prism type class (@AsXXX@)+  .+  For record types, individual field lenses are provided.+  For sum types, constructor prisms with their own classy optics are provided.++homepage:           https://gitlab.com/tonymorris/waiz+bug-reports:        https://gitlab.com/tonymorris/waiz/-/issues+cabal-version:      >= 1.10+build-type:         Simple+extra-source-files: changelog+tested-with:        GHC == 9.6.7++source-repository   head+  type:             git+  location:         git@gitlab.com:tonymorris/waiz.git++library+  default-language:+                    Haskell2010++  build-depends:+                      base          >= 4.18   && < 5+                    , bytestring    >= 0.11   && < 1+                    , http-types    >= 0.12   && < 1+                    , lens          >= 4.20   && < 6+                    , network       >= 3.1    && < 4+                    , text          >= 2.0    && < 3+                    , vault         >= 0.3    && < 1+                    , wai           >= 3.2    && < 4++  ghc-options:+                    -Wall++  hs-source-dirs:+                    src++  exposed-modules:+                    Network.Wai.Optics+                    Network.Wai.Optics.FilePart+                    Network.Wai.Optics.Request+                    Network.Wai.Optics.RequestBodyLength+                    Network.Wai.Optics.Response++  other-modules:+                    Network.Wai.Optics.Internal++test-suite doctest+  type:+                    exitcode-stdio-1.0++  main-is:+                    doctest_tests.hs++  default-language:+                    Haskell2010++  build-depends:+                      base       >= 4.18   && < 5+                    , process    >= 1.6    && < 2+                    , waiz++  ghc-options:+                    -Wall+                    -threaded++  hs-source-dirs:+                    test