packages feed

webgear-core 1.1.1 → 1.2.0

raw patch · 14 files changed

+192/−155 lines, 14 filesdep +wai-app-staticdep −filepathdep −mime-typesdep ~basedep ~cookiedep ~template-haskell

Dependencies added: wai-app-static

Dependencies removed: filepath, mime-types

Dependency ranges changed: base, cookie, template-haskell

Files

CHANGELOG.md view
@@ -2,6 +2,15 @@  ## [Unreleased] +## [1.2.0] - 2024-03-18++### Added+- Prerequisite traits (#37)+- acceptMatch middleware (#39)++### Changed+- Support for embedding WAI applications in handlers (#36)+ ## [1.1.1] - 2024-01-01  ### Changed@@ -49,7 +58,8 @@ - Extracted webgear-core from webgear-server - New arrow based API -[Unreleased]: https://github.com/haskell-webgear/webgear/compare/v1.1.1...HEAD+[Unreleased]: https://github.com/haskell-webgear/webgear/compare/v1.2.0...HEAD+[1.2.0]: https://github.com/haskell-webgear/webgear/releases/tag/v1.2.0 [1.1.1]: https://github.com/haskell-webgear/webgear/releases/tag/v1.1.1 [1.1.0]: https://github.com/haskell-webgear/webgear/releases/tag/v1.1.0 [1.0.5]: https://github.com/haskell-webgear/webgear/releases/tag/v1.0.5
src/WebGear/Core/Handler/Static.hs view
@@ -2,65 +2,22 @@  Handlers for serving static resources -} module WebGear.Core.Handler.Static (-  serveDir,-  serveFile,+  serveStatic, ) where -import Control.Arrow ((<<<))-import qualified Data.Text as Text-import qualified Network.Mime as Mime-import System.FilePath (joinPath, takeFileName, (</>))-import WebGear.Core.Handler (Handler (..), RoutePath (..), unwitnessA, (>->))-import WebGear.Core.Request (Request (..))-import WebGear.Core.Response (Response, ResponseBody (..))-import WebGear.Core.Trait (Sets, With)-import WebGear.Core.Trait.Body (UnknownContentBody, setBodyWithoutContentType)-import WebGear.Core.Trait.Header (RequiredResponseHeader, setHeader)-import WebGear.Core.Trait.Status (Status, notFound404, ok200)+import Control.Arrow (returnA)+import Network.Wai (Request (..))+import qualified Network.Wai.Application.Static as Wai.Static+import WebGear.Core.Handler (Handler (..), RequestHandler, RoutePath (..))+import WebGear.Core.Request (toWaiRequest)+import WebGear.Core.Response (Response (ResponseCont))+import WebGear.Core.Trait (unwitness) import Prelude hiding (readFile) --- | Serve files under the specified directory.-serveDir ::-  ( Handler h m-  , Sets-      h-      [ Status-      , RequiredResponseHeader "Content-Type" Mime.MimeType-      , UnknownContentBody-      ]-      Response-  ) =>-  -- | The directory to serve-  FilePath ->-  -- | Optional index filename for the root directory. A 404 Not Found-  -- response will be returned for requests to the root path if this-  -- is set to @Nothing@.-  Maybe FilePath ->-  h (Request `With` ts) Response-serveDir root index = proc _request -> consumeRoute go -< ()-  where-    go = proc path -> do-      case (path, index) of-        (RoutePath [], Nothing) -> unwitnessA <<< notFound404 -< ()-        (RoutePath [], Just f) -> serveFile -< root </> f-        (RoutePath ps, _) -> serveFile -< root </> joinPath (Text.unpack <$> ps)---- | Serve a file specified by the input filepath.-serveFile ::-  ( Handler h m-  , Sets-      h-      [ Status-      , RequiredResponseHeader "Content-Type" Mime.MimeType-      , UnknownContentBody-      ]-      Response-  ) =>-  h FilePath Response-serveFile = proc file -> do-  let contents = ResponseBodyFile file Nothing-      contentType = Mime.defaultMimeLookup $ Text.pack $ takeFileName file-  (ok200 -< ())-    >-> (\resp -> setBodyWithoutContentType -< (resp, contents))-    >-> (\resp -> setHeader @"Content-Type" -< (resp, contentType))-    >-> (\resp -> unwitnessA -< resp)+-- | Serve static assets+serveStatic :: (Handler h m) => Wai.Static.StaticSettings -> RequestHandler h ts+serveStatic settings =+  proc request -> do+    RoutePath pathInfo <- consumeRoute returnA -< ()+    let waiRequest = toWaiRequest $ unwitness request+    returnA -< ResponseCont $ Wai.Static.staticApp settings waiRequest{pathInfo}
src/WebGear/Core/Response.hs view
@@ -5,39 +5,21 @@   -- * Basic Types   Response (..),   ResponseBody (..),-  toWaiResponse, ) where  import qualified Data.Binary.Builder as B+import Data.ByteString (ByteString) import qualified Network.HTTP.Types as HTTP import qualified Network.Wai as Wai -{- | An HTTP response sent from the server to the client.--The response contains a status, optional headers and an optional-body payload.--}-data Response = Response-  { responseStatus :: HTTP.Status-  -- ^ Response status code-  , responseHeaders :: HTTP.ResponseHeaders-  -- ^ Response headers-  , responseBody :: ResponseBody-  -- ^ The response body-  }+-- | An HTTP response sent from the server to the client.+data Response+  = Response HTTP.Status HTTP.ResponseHeaders ResponseBody+  | ResponseRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) Wai.Response+  | ResponseCont ((Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived) +-- | HTTP response body data ResponseBody   = ResponseBodyFile FilePath (Maybe Wai.FilePart)   | ResponseBodyBuilder B.Builder   | ResponseBodyStream Wai.StreamingBody---- | Generate a WAI response-toWaiResponse :: Response -> Wai.Response-toWaiResponse Response{..} =-  case responseBody of-    ResponseBodyFile fpath fpart ->-      Wai.responseFile responseStatus responseHeaders fpath fpart-    ResponseBodyBuilder builder ->-      Wai.responseBuilder responseStatus responseHeaders builder-    ResponseBodyStream stream ->-      Wai.responseStream responseStatus responseHeaders stream
src/WebGear/Core/Trait.hs view
@@ -47,6 +47,7 @@   -- * Core Types   Trait (..),   TraitAbsence (..),+  Prerequisite,   Get (..),   Gets,   Set (..),@@ -84,10 +85,21 @@   -- value. This could be an error message, exception etc.   type Absence t a :: Type +{- | Indicates the constraints a trait depends upon as a+prerequisite. This is used to assert that a trait @t@ can be+extracted from a value @a@ only if one or more other traits are+present in the trait list @ts@ associated with it.++If a trait does not depend on other traits this can be set to the+empty contraint @()@.+-}+type family Prerequisite (t :: Type) (ts :: [Type]) (a :: Type) :: Constraint+ -- | Extract trait attributes from a value. class (Arrow h, TraitAbsence t a) => Get h t a where   -- | Attempt to witness the trait attribute from the value @a@.   getTrait ::+    (Prerequisite t ts a) =>     -- | The trait to witness     t ->     -- | Arrow that attemtps to witness the trait and can possibly@@ -168,7 +180,7 @@ -} probe ::   forall t ts h a.-  (Get h t a) =>+  (Get h t a, Prerequisite t ts a) =>   t ->   h (a `With` ts) (Either (Absence t a) (a `With` (t : ts))) probe t = proc l -> do
src/WebGear/Core/Trait/Auth/Basic.hs view
@@ -136,8 +136,15 @@ instance TraitAbsence (BasicAuth' Optional scheme m e a) Request where   type Absence (BasicAuth' Optional scheme m e a) Request = Void +type instance+  Prerequisite (BasicAuth' x scheme m e a) ts Request =+    HasTrait (AuthorizationHeader scheme) ts+ basicAuthMiddleware ::-  (Get h (BasicAuth' x scheme m e t) Request, ArrowChoice h) =>+  ( ArrowChoice h+  , Get h (BasicAuth' x scheme m e t) Request+  , HasTrait (AuthorizationHeader scheme) ts+  ) =>   BasicAuth' x scheme m e t ->   h (Request `With` ts, Absence (BasicAuth' x scheme m e t) Request) Response ->   Middleware h ts (BasicAuth' x scheme m e t : ts)@@ -161,7 +168,10 @@ -} basicAuth ::   forall m e t h ts.-  (Get h (BasicAuth' Required "Basic" m e t) Request, ArrowChoice h) =>+  ( ArrowChoice h+  , Get h (BasicAuth' Required "Basic" m e t) Request+  , HasTrait (AuthorizationHeader "Basic") ts+  ) =>   -- | Authentication configuration   BasicAuth m e t ->   -- | Error handler@@ -178,7 +188,10 @@ -} basicAuth' ::   forall scheme m e t h ts.-  (Get h (BasicAuth' Required scheme m e t) Request, ArrowChoice h) =>+  ( ArrowChoice h+  , Get h (BasicAuth' Required scheme m e t) Request+  , HasTrait (AuthorizationHeader scheme) ts+  ) =>   -- | Authentication configuration   BasicAuth' Required scheme m e t ->   -- | Error handler@@ -200,7 +213,10 @@ -} optionalBasicAuth ::   forall m e t h ts.-  (Get h (BasicAuth' Optional "Basic" m e t) Request, ArrowChoice h) =>+  ( ArrowChoice h+  , Get h (BasicAuth' Optional "Basic" m e t) Request+  , HasTrait (AuthorizationHeader "Basic") ts+  ) =>   -- | Authentication configuration   BasicAuth' Optional "Basic" m e t ->   Middleware h ts (BasicAuth' Optional "Basic" m e t : ts)@@ -216,7 +232,10 @@ -} optionalBasicAuth' ::   forall scheme m e t h ts.-  (Get h (BasicAuth' Optional scheme m e t) Request, ArrowChoice h) =>+  ( ArrowChoice h+  , Get h (BasicAuth' Optional scheme m e t) Request+  , HasTrait (AuthorizationHeader scheme) ts+  ) =>   -- | Authentication configuration   BasicAuth' Optional scheme m e t ->   Middleware h ts (BasicAuth' Optional scheme m e t : ts)
src/WebGear/Core/Trait/Auth/Common.hs view
@@ -3,13 +3,11 @@ -} module WebGear.Core.Trait.Auth.Common (   AuthorizationHeader,-  getAuthorizationHeaderTrait,   Realm (..),   AuthToken (..),   respondUnauthorized, ) where -import Control.Arrow (returnA) import Data.ByteString (ByteString, drop) import Data.ByteString.Char8 (break) import Data.CaseInsensitive (CI, mk, original)@@ -17,15 +15,13 @@ import Data.String (IsString (..)) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8, encodeUtf8)-import Data.Void (absurd) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Web.HttpApiData (FromHttpApiData (..)) import WebGear.Core.Handler (Handler, unwitnessA, (>->)) import WebGear.Core.MIMETypes (PlainText (..)) import WebGear.Core.Modifiers (Existence (..), ParseStyle (..))-import WebGear.Core.Request (Request) import WebGear.Core.Response (Response)-import WebGear.Core.Trait (Get (..), Sets, With)+import WebGear.Core.Trait (Sets) import WebGear.Core.Trait.Body (Body, setBody) import WebGear.Core.Trait.Header (RequestHeader (..), RequiredResponseHeader, setHeader) import WebGear.Core.Trait.Status (Status, unauthorized401)@@ -34,20 +30,6 @@ -- | Trait for \"Authorization\" header type AuthorizationHeader scheme = RequestHeader Optional Lenient "Authorization" (AuthToken scheme) -{- | Extract the \"Authorization\" header from a request by specifying-   an authentication scheme.--  The header is split into the scheme and token parts and returned.--}-getAuthorizationHeaderTrait ::-  forall scheme h ts.-  (Get h (AuthorizationHeader scheme) Request) =>-  h (Request `With` ts) (Maybe (Either Text (AuthToken scheme)))-getAuthorizationHeaderTrait = proc request -> do-  result <- getTrait (RequestHeader :: RequestHeader Optional Lenient "Authorization" (AuthToken scheme)) -< request-  returnA -< either absurd id result-{-# INLINE getAuthorizationHeaderTrait #-}- -- | The protection space for authentication newtype Realm = Realm ByteString   deriving newtype (Eq, Ord, Show, Read, IsString)@@ -61,9 +43,12 @@   }  instance (KnownSymbol scheme) => FromHttpApiData (AuthToken scheme) where+  {-# INLINE parseUrlPiece #-}+  parseUrlPiece :: Text -> Either Text (AuthToken scheme)   parseUrlPiece = parseHeader . encodeUtf8    {-# INLINE parseHeader #-}+  parseHeader :: ByteString -> Either Text (AuthToken scheme)   parseHeader hdr =     case break (== ' ') hdr of       (scm, tok) ->
src/WebGear/Core/Trait/Auth/JWT.hs view
@@ -128,6 +128,10 @@ instance TraitAbsence (JWTAuth' Optional scheme m e a) Request where   type Absence (JWTAuth' Optional scheme m e a) Request = Void +type instance+  Prerequisite (JWTAuth' x scheme m e a) ts Request =+    HasTrait (AuthorizationHeader scheme) ts+ {- | Middleware to add JWT authentication protection for a  handler. Expects the JWT to be available via a standard bearer  authorization header in the format:@@ -143,8 +147,9 @@  retrieved successfully. -} jwtAuth ::-  ( Get h (JWTAuth m e t) Request-  , ArrowChoice h+  ( ArrowChoice h+  , Get h (JWTAuth m e t) Request+  , HasTrait (AuthorizationHeader "Bearer") ts   ) =>   -- | Authentication configuration   JWTAuth m e t ->@@ -170,8 +175,9 @@  authentication error appropriately. -} optionalJWTAuth ::-  ( Get h (JWTAuth' Optional "Bearer" m e t) Request-  , ArrowChoice h+  ( ArrowChoice h+  , Get h (JWTAuth' Optional "Bearer" m e t) Request+  , HasTrait (AuthorizationHeader "Bearer") ts   ) =>   -- | Authentication configuration   JWTAuth' Optional "Bearer" m e t ->@@ -180,13 +186,14 @@ {-# INLINE optionalJWTAuth #-}  jwtAuthMiddleware ::-  forall s e t x h m ts.-  ( Get h (JWTAuth' x s m e t) Request-  , ArrowChoice h+  forall scheme e t x h m ts.+  ( ArrowChoice h+  , Get h (JWTAuth' x scheme m e t) Request+  , HasTrait (AuthorizationHeader scheme) ts   ) =>-  JWTAuth' x s m e t ->-  h (Request `With` ts, Absence (JWTAuth' x s m e t) Request) Response ->-  Middleware h ts (JWTAuth' x s m e t : ts)+  JWTAuth' x scheme m e t ->+  h (Request `With` ts, Absence (JWTAuth' x scheme m e t) Request) Response ->+  Middleware h ts (JWTAuth' x scheme m e t : ts) jwtAuthMiddleware authCfg errorHandler nextHandler =   proc request -> do     result <- probe authCfg -< request@@ -210,15 +217,16 @@  retrieved successfully. -} jwtAuth' ::-  forall s e t h m ts.-  ( Get h (JWTAuth' Required s m e t) Request-  , ArrowChoice h+  forall scheme e t h m ts.+  ( ArrowChoice h+  , Get h (JWTAuth' Required scheme m e t) Request+  , HasTrait (AuthorizationHeader scheme) ts   ) =>   -- | Authentication configuration-  JWTAuth' Required s m e t ->+  JWTAuth' Required scheme m e t ->   -- | Error handler   h (Request `With` ts, JWTAuthError e) Response ->-  Middleware h ts (JWTAuth' Required s m e t : ts)+  Middleware h ts (JWTAuth' Required scheme m e t : ts) jwtAuth' = jwtAuthMiddleware {-# INLINE jwtAuth' #-} @@ -238,12 +246,13 @@  authentication error appropriately. -} optionalJWTAuth' ::-  forall s e t h m ts.-  ( Get h (JWTAuth' Optional s m e t) Request-  , ArrowChoice h+  forall scheme e t h m ts.+  ( ArrowChoice h+  , Get h (JWTAuth' Optional scheme m e t) Request+  , HasTrait (AuthorizationHeader scheme) ts   ) =>   -- | Authentication configuration-  JWTAuth' Optional s m e t ->-  Middleware h ts (JWTAuth' Optional s m e t : ts)+  JWTAuth' Optional scheme m e t ->+  Middleware h ts (JWTAuth' Optional scheme m e t : ts) optionalJWTAuth' cfg = jwtAuthMiddleware cfg $ arr (absurd . snd) {-# INLINE optionalJWTAuth' #-}
src/WebGear/Core/Trait/Body.hs view
@@ -37,6 +37,7 @@ import WebGear.Core.Response (Response, ResponseBody) import WebGear.Core.Trait (   Get,+  Prerequisite,   Set,   Sets,   Trait (..),@@ -57,6 +58,8 @@ instance TraitAbsence (Body mt t) Request where   type Absence (Body mt t) Request = Text +type instance Prerequisite (Body mt t) ts Request = ()+ instance Trait (Body mt t) Response where   type Attribute (Body mt t) Response = t @@ -74,7 +77,7 @@  Usage:  @- requestBody \@'Text' 'PlainText' errorHandler nextHandler+ requestBody \@'Text' 'WebGear.Core.MIMETypes.PlainText' errorHandler nextHandler @ -} requestBody ::@@ -102,7 +105,7 @@  @  let body :: SomeJSONType = ...- response' <- setBody 'JSON' -< (response, body)+ response' <- setBody 'WebGear.Core.MIMETypes.JSON' -< (response, body) @ -} setBody ::@@ -142,7 +145,7 @@  @  let body :: SomeJSONType = ...- respondA 'HTTP.ok200' 'JSON' -< body+ respondA 'HTTP.ok200' 'WebGear.Core.MIMETypes.JSON' -< body @ -} respondA ::
src/WebGear/Core/Trait/Cookie.hs view
@@ -19,10 +19,21 @@ import GHC.TypeLits (Symbol) import qualified Web.Cookie as Cookie import WebGear.Core.Handler (Middleware)-import WebGear.Core.Modifiers (Existence (..))+import WebGear.Core.Modifiers (Existence (..), ParseStyle (..)) import WebGear.Core.Request (Request) import WebGear.Core.Response (Response)-import WebGear.Core.Trait (Get, Set, Trait (..), TraitAbsence (..), With, plant, probe)+import WebGear.Core.Trait (+  Get,+  HasTrait,+  Prerequisite,+  Set,+  Trait (..),+  TraitAbsence (..),+  With,+  plant,+  probe,+ )+import WebGear.Core.Trait.Header (RequestHeader)  -- | Indicates a missing cookie data CookieNotFound = CookieNotFound@@ -38,6 +49,10 @@ instance Trait (Cookie Required name val) Request where   type Attribute (Cookie Required name val) Request = val +type instance+  Prerequisite (Cookie e name val) ts Request =+    HasTrait (RequestHeader e Strict "Cookie" Text) ts+ instance TraitAbsence (Cookie Required name val) Request where   type Absence (Cookie Required name val) Request = Either CookieNotFound CookieParseError @@ -49,7 +64,10 @@  cookieHandler ::   forall name val e h ts.-  (Get h (Cookie e name val) Request, ArrowChoice h) =>+  ( ArrowChoice h+  , Get h (Cookie e name val) Request+  , HasTrait (RequestHeader e Strict "Cookie" Text) ts+  ) =>   -- | error handler   h (Request `With` ts, Absence (Cookie e name val) Request) Response ->   Middleware h ts (Cookie e name val : ts)@@ -70,7 +88,10 @@ -} cookie ::   forall name val h ts.-  (Get h (Cookie Required name val) Request, ArrowChoice h) =>+  ( ArrowChoice h+  , Get h (Cookie Required name val) Request+  , HasTrait (RequestHeader Required Strict "Cookie" Text) ts+  ) =>   -- | Error handler   h (Request `With` ts, Either CookieNotFound CookieParseError) Response ->   Middleware h ts (Cookie Required name val : ts)@@ -88,7 +109,10 @@ -} optionalCookie ::   forall name val h ts.-  (Get h (Cookie Optional name val) Request, ArrowChoice h) =>+  ( ArrowChoice h+  , Get h (Cookie Optional name val) Request+  , HasTrait (RequestHeader Optional Strict "Cookie" Text) ts+  ) =>   -- | Error handler   h (Request `With` ts, CookieParseError) Response ->   Middleware h ts (Cookie Optional name val : ts)
src/WebGear/Core/Trait/Header.hs view
@@ -43,25 +43,33 @@   optionalLenientHeader,   setHeader,   setOptionalHeader,+  acceptMatch, ) where  import Control.Arrow (ArrowChoice, arr)+import Control.Arrow.Operations (ArrowError) import Data.Kind (Type)+import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Void (Void, absurd) import GHC.TypeLits (Symbol)-import WebGear.Core.Handler (Middleware)+import qualified Network.HTTP.Media as HTTP+import qualified Network.HTTP.Types as HTTP+import WebGear.Core.Handler (Middleware, RouteMismatch, routeMismatch)+import WebGear.Core.MIMETypes (MIMEType (..)) import WebGear.Core.Modifiers (Existence (..), ParseStyle (..))-import WebGear.Core.Request (Request)+import WebGear.Core.Request (Request, requestHeader) import WebGear.Core.Response (Response) import WebGear.Core.Trait (   Get (..),+  Prerequisite,   Set,   Trait (..),   TraitAbsence (..),   With,   plant,   probe,+  unwitness,  )  -- | Indicates a missing header@@ -79,10 +87,10 @@ -} data RequestHeader (e :: Existence) (p :: ParseStyle) (name :: Symbol) (val :: Type) = RequestHeader --- | A `Header` that is required in the request and parsed strictly+-- | A `RequestHeader` that is required and parsed strictly type RequiredRequestHeader = RequestHeader Required Strict --- | A `Header` that is optional in the request and parsed strictly+-- | A `RequestHeader` that is optional and parsed strictly type OptionalRequestHeader = RequestHeader Optional Strict  instance Trait (RequestHeader Required Strict name val) Request where@@ -109,6 +117,8 @@ instance TraitAbsence (RequestHeader Optional Lenient name val) Request where   type Absence (RequestHeader Optional Lenient name val) Request = Void +type instance Prerequisite (RequestHeader e p name val) ts Request = ()+ headerHandler ::   forall name val e p h ts.   (Get h (RequestHeader e p name val) Request, ArrowChoice h) =>@@ -195,16 +205,16 @@ {-# INLINE optionalLenientHeader #-}  {- | A 'Trait' for setting a header in the HTTP response. It has a- specified @name@ and a value of type @val@ which can be converted to- a 'ByteString'. The header name is compared case-insensitively. The- modifier @e@ determines whether the header is mandatory or optional.+ specified @name@ and a value of type @val@. The header name is+ compared case-insensitively. The modifier @e@ determines whether the+ header is mandatory or optional. -} data ResponseHeader (e :: Existence) (name :: Symbol) (val :: Type) = ResponseHeader --- | A `Header` that is required in the response+-- | A `ResponseHeader` that is required type RequiredResponseHeader = ResponseHeader Required --- | A `Header` that is optional in the response+-- | A `ResponseHeader` that is optional type OptionalResponseHeader = ResponseHeader Optional  instance Trait (ResponseHeader Required name val) Response where@@ -242,3 +252,20 @@   h (Response `With` ts, Maybe val) (Response `With` (ResponseHeader Optional name val : ts)) setOptionalHeader = plant ResponseHeader {-# INLINE setOptionalHeader #-}++{- | Match the Accept header of the incoming request with the specified mediatype. Another handler will be tried+ if the match fails.++ Example usage:++ @+   acceptMatch 'WebGear.Core.MIMETypes.JSON' handler+ @+-}+acceptMatch :: (ArrowChoice h, ArrowError RouteMismatch h, MIMEType mt) => mt -> Middleware h ts ts+acceptMatch mt nextHandler =+  proc request -> do+    let acceptHeader = fromMaybe "*/*" $ requestHeader HTTP.hAccept $ unwitness request+    case HTTP.matchAccept [mimeType mt] acceptHeader of+      Just _ -> nextHandler -< request+      Nothing -> routeMismatch -< ()
src/WebGear/Core/Trait/Method.hs view
@@ -10,7 +10,7 @@ import qualified Network.HTTP.Types as HTTP import WebGear.Core.Handler (Middleware, RouteMismatch, routeMismatch) import WebGear.Core.Request (Request)-import WebGear.Core.Trait (Get (..), Trait (..), TraitAbsence (..), probe)+import WebGear.Core.Trait (Get (..), Prerequisite, Trait (..), TraitAbsence (..), probe)  -- | A 'Trait' for capturing the HTTP method of a request newtype Method = Method HTTP.StdMethod@@ -26,6 +26,8 @@  instance TraitAbsence Method Request where   type Absence Method Request = MethodMismatch++type instance Prerequisite Method ts Request = ()  {- | Check whether the request has a specified HTTP method.
src/WebGear/Core/Trait/Path.hs view
@@ -29,7 +29,7 @@ import Language.Haskell.TH.Syntax (Exp (..), Lit (..), Q, TyLit (StrTyLit), Type (..), mkName) import WebGear.Core.Handler (Middleware, RouteMismatch, routeMismatch) import WebGear.Core.Request (Request)-import WebGear.Core.Trait (Get, Trait (..), TraitAbsence (..), probe)+import WebGear.Core.Trait (Get, Prerequisite, Trait (..), TraitAbsence (..), probe) import WebGear.Core.Trait.Method (method) import Prelude hiding (drop, filter, take) @@ -44,6 +44,8 @@ instance TraitAbsence Path Request where   type Absence Path Request = () +type instance Prerequisite Path ts Request = ()+ {- | A path variable that is extracted and converted to a value of  type @val@. The @tag@ is usually a type-level symbol (string) to  uniquely identify this variable.@@ -60,6 +62,8 @@ instance TraitAbsence (PathVar tag val) Request where   type Absence (PathVar tag val) Request = PathVarError +type instance Prerequisite (PathVar tag val) ts Request = ()+ -- | Trait to indicate that no more path components are present in the request data PathEnd = PathEnd @@ -68,6 +72,8 @@  instance TraitAbsence PathEnd Request where   type Absence PathEnd Request = ()++type instance Prerequisite PathEnd ts Request = ()  {- | A middleware that literally matches path @s@.
src/WebGear/Core/Trait/QueryParam.hs view
@@ -43,7 +43,7 @@ import WebGear.Core.Modifiers (Existence (..), ParseStyle (..)) import WebGear.Core.Request (Request) import WebGear.Core.Response (Response)-import WebGear.Core.Trait (Get, Trait (..), TraitAbsence (..), With, probe)+import WebGear.Core.Trait (Get, Prerequisite, Trait (..), TraitAbsence (..), With, probe)  {- | Capture a query parameter with a specified @name@ and convert it to  a value of type @val@. The type parameter @e@ denotes whether the@@ -90,6 +90,8 @@  instance TraitAbsence (QueryParam Optional Lenient name val) Request where   type Absence (QueryParam Optional Lenient name val) Request = Void++type instance Prerequisite (QueryParam e p name val) ts Request = ()  queryParamHandler ::   forall name val e p h ts.
webgear-core.cabal view
@@ -1,7 +1,7 @@ cabal-version:       2.4  name:                webgear-core-version:             1.1.1+version:             1.2.0 synopsis:            Composable, type-safe library to build HTTP APIs description:         WebGear is a library to for building composable, type-safe HTTP APIs.@@ -53,20 +53,20 @@                       TypeApplications                       TypeFamilies                       TypeOperators-  build-depends:      base >=4.13.0.0 && <4.19+  build-depends:      base >=4.13.0.0 && <4.20                     , binary >= 0.8.0.0 && <0.9                     , bytestring >=0.10.10.1 && <0.13                     , case-insensitive ==1.2.*-                    , cookie >=0.4.5 && <0.5-                    , filepath >=1.4.2.1 && <1.6+                    , cookie >=0.4.5 && <0.6                     , http-api-data >=0.4.2 && <0.7                     , http-media ==0.8.*                     , http-types ==0.12.*                     , network ==3.1.*                     , tagged ==0.8.*-                    , template-haskell >=2.15.0.0 && <2.21+                    , template-haskell >=2.15.0.0 && <2.22                     , text >=1.2.0.0 && <2.2                     , wai ==3.2.*+                    , wai-app-static ==3.1.*                     , wai-extra ==3.1.*   ghc-options:        -Wall                       -Wno-unticked-promoted-constructors@@ -108,4 +108,3 @@   hs-source-dirs:     src   build-depends:      arrows ==0.4.*                     , jose >=0.8.3.1 && <0.12-                    , mime-types ==0.1.*