webgear-core (empty) → 1.0.0

raw patch · 21 files changed

+2748/−0 lines, 21 filesdep +arrowsdep +basedep +bytestring

Dependencies added: arrows, base, bytestring, case-insensitive, filepath, http-api-data, http-media, http-types, jose, mime-types, network, safe-exceptions, tagged, template-haskell, text, unordered-containers, wai

Files

• CHANGELOG.md +12/−0
• LICENSE +373/−0
• README.md +7/−0
• src/WebGear/Core.hs +37/−0
• src/WebGear/Core/Handler.hs +88/−0
• src/WebGear/Core/Handler/Static.hs +61/−0
• src/WebGear/Core/Modifiers.hs +15/−0
• src/WebGear/Core/Request.hs +70/−0
• src/WebGear/Core/Response.hs +34/−0
• src/WebGear/Core/Trait.hs +181/−0
• src/WebGear/Core/Trait/Auth/Basic.hs +219/−0
• src/WebGear/Core/Trait/Auth/Common.hs +100/−0
• src/WebGear/Core/Trait/Auth/JWT.hs +244/−0
• src/WebGear/Core/Trait/Body.hs +252/−0
• src/WebGear/Core/Trait/Header.hs +219/−0
• src/WebGear/Core/Trait/Method.hs +47/−0
• src/WebGear/Core/Trait/Path.hs +216/−0
• src/WebGear/Core/Trait/QueryParam.hs +169/−0
• src/WebGear/Core/Trait/Status.hs +253/−0
• src/WebGear/Core/Traits.hs +43/−0
• webgear-core.cabal +108/−0

@@ -0,0 +1,12 @@+# Changelog for webgear-core++## [Unreleased]++## [1.0.0] - 2022-01-08++### Changed+- Extracted webgear-core from webgear-server+- New arrow based API++[Unreleased]: https://github.com/haskell-webgear/webgear/compare/v1.0.0...HEAD+[1.0.0]: https://github.com/haskell-webgear/webgear/releases/tag/v1.0.0

@@ -0,0 +1,373 @@+Mozilla Public License Version 2.0+==================================++1. Definitions+--------------++1.1. "Contributor"+    means each individual or legal entity that creates, contributes to+    the creation of, or owns Covered Software.++1.2. "Contributor Version"+    means the combination of the Contributions of others (if any) used+    by a Contributor and that particular Contributor's Contribution.++1.3. "Contribution"+    means Covered Software of a particular Contributor.++1.4. "Covered Software"+    means Source Code Form to which the initial Contributor has attached+    the notice in Exhibit A, the Executable Form of such Source Code+    Form, and Modifications of such Source Code Form, in each case+    including portions thereof.++1.5. "Incompatible With Secondary Licenses"+    means++    (a) that the initial Contributor has attached the notice described+        in Exhibit B to the Covered Software; or++    (b) that the Covered Software was made available under the terms of+        version 1.1 or earlier of the License, but not also under the+        terms of a Secondary License.++1.6. "Executable Form"+    means any form of the work other than Source Code Form.++1.7. "Larger Work"+    means a work that combines Covered Software with other material, in+    a separate file or files, that is not Covered Software.++1.8. "License"+    means this document.++1.9. "Licensable"+    means having the right to grant, to the maximum extent possible,+    whether at the time of the initial grant or subsequently, any and+    all of the rights conveyed by this License.++1.10. "Modifications"+    means any of the following:++    (a) any file in Source Code Form that results from an addition to,+        deletion from, or modification of the contents of Covered+        Software; or++    (b) any new file in Source Code Form that contains any Covered+        Software.++1.11. "Patent Claims" of a Contributor+    means any patent claim(s), including without limitation, method,+    process, and apparatus claims, in any patent Licensable by such+    Contributor that would be infringed, but for the grant of the+    License, by the making, using, selling, offering for sale, having+    made, import, or transfer of either its Contributions or its+    Contributor Version.++1.12. "Secondary License"+    means either the GNU General Public License, Version 2.0, the GNU+    Lesser General Public License, Version 2.1, the GNU Affero General+    Public License, Version 3.0, or any later versions of those+    licenses.++1.13. "Source Code Form"+    means the form of the work preferred for making modifications.++1.14. "You" (or "Your")+    means an individual or a legal entity exercising rights under this+    License. For legal entities, "You" includes any entity that+    controls, is controlled by, or is under common control with You. For+    purposes of this definition, "control" means (a) the power, direct+    or indirect, to cause the direction or management of such entity,+    whether by contract or otherwise, or (b) ownership of more than+    fifty percent (50%) of the outstanding shares or beneficial+    ownership of such entity.++2. License Grants and Conditions+--------------------------------++2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free,+non-exclusive license:++(a) under intellectual property rights (other than patent or trademark)+    Licensable by such Contributor to use, reproduce, make available,+    modify, display, perform, distribute, and otherwise exploit its+    Contributions, either on an unmodified basis, with Modifications, or+    as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer+    for sale, have made, import, and otherwise transfer either its+    Contributions or its Contributor Version.++2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution+become effective for each Contribution on the date the Contributor first+distributes such Contribution.++2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under+this License. No additional rights or licenses will be implied from the+distribution or licensing of Covered Software under this License.+Notwithstanding Section 2.1(b) above, no patent license is granted by a+Contributor:++(a) for any code that a Contributor has removed from Covered Software;+    or++(b) for infringements caused by: (i) Your and any other third party's+    modifications of Covered Software, or (ii) the combination of its+    Contributions with other software (except as part of its Contributor+    Version); or++(c) under Patent Claims infringed by Covered Software in the absence of+    its Contributions.++This License does not grant any rights in the trademarks, service marks,+or logos of any Contributor (except as may be necessary to comply with+the notice requirements in Section 3.4).++2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to+distribute the Covered Software under a subsequent version of this+License (see Section 10.2) or under the terms of a Secondary License (if+permitted under the terms of Section 3.3).++2.5. Representation++Each Contributor represents that the Contributor believes its+Contributions are its original creation(s) or it has sufficient rights+to grant the rights to its Contributions conveyed by this License.++2.6. Fair Use++This License is not intended to limit any rights You have under+applicable copyright doctrines of fair use, fair dealing, or other+equivalents.++2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted+in Section 2.1.++3. Responsibilities+-------------------++3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any+Modifications that You create or to which You contribute, must be under+the terms of this License. You must inform recipients that the Source+Code Form of the Covered Software is governed by the terms of this+License, and how they can obtain a copy of this License. You may not+attempt to alter or restrict the recipients' rights in the Source Code+Form.++3.2. Distribution of Executable Form++If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code+    Form, as described in Section 3.1, and You must inform recipients of+    the Executable Form how they can obtain a copy of such Source Code+    Form by reasonable means in a timely manner, at a charge no more+    than the cost of distribution to the recipient; and++(b) You may distribute such Executable Form under the terms of this+    License, or sublicense it under different terms, provided that the+    license for the Executable Form does not attempt to limit or alter+    the recipients' rights in the Source Code Form under this License.++3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice,+provided that You also comply with the requirements of this License for+the Covered Software. If the Larger Work is a combination of Covered+Software with a work governed by one or more Secondary Licenses, and the+Covered Software is not Incompatible With Secondary Licenses, this+License permits You to additionally distribute such Covered Software+under the terms of such Secondary License(s), so that the recipient of+the Larger Work may, at their option, further distribute the Covered+Software under the terms of either this License or such Secondary+License(s).++3.4. Notices++You may not remove or alter the substance of any license notices+(including copyright notices, patent notices, disclaimers of warranty,+or limitations of liability) contained within the Source Code Form of+the Covered Software, except that You may alter any license notices to+the extent required to remedy known factual inaccuracies.++3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support,+indemnity or liability obligations to one or more recipients of Covered+Software. However, You may do so only on Your own behalf, and not on+behalf of any Contributor. You must make it absolutely clear that any+such warranty, support, indemnity, or liability obligation is offered by+You alone, and You hereby agree to indemnify every Contributor for any+liability incurred by such Contributor as a result of warranty, support,+indemnity or liability terms You offer. You may include additional+disclaimers of warranty and limitations of liability specific to any+jurisdiction.++4. Inability to Comply Due to Statute or Regulation+---------------------------------------------------++If it is impossible for You to comply with any of the terms of this+License with respect to some or all of the Covered Software due to+statute, judicial order, or regulation then You must: (a) comply with+the terms of this License to the maximum extent possible; and (b)+describe the limitations and the code they affect. Such description must+be placed in a text file included with all distributions of the Covered+Software under this License. Except to the extent prohibited by statute+or regulation, such description must be sufficiently detailed for a+recipient of ordinary skill to be able to understand it.++5. Termination+--------------++5.1. The rights granted under this License will terminate automatically+if You fail to comply with any of its terms. However, if You become+compliant, then the rights granted under this License from a particular+Contributor are reinstated (a) provisionally, unless and until such+Contributor explicitly and finally terminates Your grants, and (b) on an+ongoing basis, if such Contributor fails to notify You of the+non-compliance by some reasonable means prior to 60 days after You have+come back into compliance. Moreover, Your grants from a particular+Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the+first time You have received notice of non-compliance with this License+from such Contributor, and You become compliant prior to 30 days after+Your receipt of the notice.++5.2. If You initiate litigation against any entity by asserting a patent+infringement claim (excluding declaratory judgment actions,+counter-claims, and cross-claims) alleging that a Contributor Version+directly or indirectly infringes any patent, then the rights granted to+You by any and all Contributors for the Covered Software under Section+2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all+end user license agreements (excluding distributors and resellers) which+have been validly granted by You or Your distributors under this License+prior to termination shall survive termination.++************************************************************************+*                                                                      *+*  6. Disclaimer of Warranty                                           *+*  -------------------------                                           *+*                                                                      *+*  Covered Software is provided under this License on an "as is"       *+*  basis, without warranty of any kind, either expressed, implied, or  *+*  statutory, including, without limitation, warranties that the       *+*  Covered Software is free of defects, merchantable, fit for a        *+*  particular purpose or non-infringing. The entire risk as to the     *+*  quality and performance of the Covered Software is with You.        *+*  Should any Covered Software prove defective in any respect, You     *+*  (not any Contributor) assume the cost of any necessary servicing,   *+*  repair, or correction. This disclaimer of warranty constitutes an   *+*  essential part of this License. No use of any Covered Software is   *+*  authorized under this License except under this disclaimer.         *+*                                                                      *+************************************************************************++************************************************************************+*                                                                      *+*  7. Limitation of Liability                                          *+*  --------------------------                                          *+*                                                                      *+*  Under no circumstances and under no legal theory, whether tort      *+*  (including negligence), contract, or otherwise, shall any           *+*  Contributor, or anyone who distributes Covered Software as          *+*  permitted above, be liable to You for any direct, indirect,         *+*  special, incidental, or consequential damages of any character      *+*  including, without limitation, damages for lost profits, loss of    *+*  goodwill, work stoppage, computer failure or malfunction, or any    *+*  and all other commercial damages or losses, even if such party      *+*  shall have been informed of the possibility of such damages. This   *+*  limitation of liability shall not apply to liability for death or   *+*  personal injury resulting from such party's negligence to the       *+*  extent applicable law prohibits such limitation. Some               *+*  jurisdictions do not allow the exclusion or limitation of           *+*  incidental or consequential damages, so this exclusion and          *+*  limitation may not apply to You.                                    *+*                                                                      *+************************************************************************++8. Litigation+-------------++Any litigation relating to this License may be brought only in the+courts of a jurisdiction where the defendant maintains its principal+place of business and such litigation shall be governed by laws of that+jurisdiction, without reference to its conflict-of-law provisions.+Nothing in this Section shall prevent a party's ability to bring+cross-claims or counter-claims.++9. Miscellaneous+----------------++This License represents the complete agreement concerning the subject+matter hereof. If any provision of this License is held to be+unenforceable, such provision shall be reformed only to the extent+necessary to make it enforceable. Any law or regulation which provides+that the language of a contract shall be construed against the drafter+shall not be used to construe this License against a Contributor.++10. Versions of the License+---------------------------++10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section+10.3, no one other than the license steward has the right to modify or+publish new versions of this License. Each version will be given a+distinguishing version number.++10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version+of the License under which You originally received the Covered Software,+or under the terms of any subsequent version published by the license+steward.++10.3. Modified Versions++If you create software not governed by this License, and you want to+create a new license for such software, you may create and use a+modified version of this License if you rename the license and remove+any references to the name of the license steward (except to note that+such modified license differs from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary+Licenses++If You choose to distribute Source Code Form that is Incompatible With+Secondary Licenses under the terms of this version of the License, the+notice described in Exhibit B of this License must be attached.++Exhibit A - Source Code Form License Notice+-------------------------------------------++  This Source Code Form is subject to the terms of the Mozilla Public+  License, v. 2.0. If a copy of the MPL was not distributed with this+  file, You can obtain one at http://mozilla.org/MPL/2.0/.++If it is not possible or desirable to put the notice in a particular+file, then You may include the notice in a location (such as a LICENSE+file in a relevant directory) where a recipient would be likely to look+for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice+---------------------------------------------------------++  This Source Code Form is "Incompatible With Secondary Licenses", as+  defined by the Mozilla Public License, v. 2.0.

@@ -0,0 +1,7 @@+# WebGear - Core HTTP APIs++[![Hackage](https://img.shields.io/hackage/v/webgear-core)](https://hackage.haskell.org/package/webgear-core)++WebGear is a Haskell library for building composable, type-safe HTTP API servers.++This package defines the core components of WebGear used to define APIs.

@@ -0,0 +1,37 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++{- | WebGear is a library to build composable, type-safe HTTP APIs.++ The modules below have haddock documentation that can be used as+ reference material. If you are completely new to WebGear, a good+ starting point is the [WebGear User+ Guide](https://haskell-webgear.github.io/user_guide/1.0.0/index.html). Example+ programs built using WebGear are available under+ <https://github.com/haskell-webgear/>.++ Importing "WebGear.Core" is a quick way to get everything needed to+ build WebGear API specifications.+-}+module WebGear.Core (+  module Control.Arrow,+  module Data.Text,+  module WebGear.Core.Trait,+  module WebGear.Core.Request,+  module WebGear.Core.Response,+  module WebGear.Core.Modifiers,+  module WebGear.Core.Handler,+  module WebGear.Core.Handler.Static,+  module WebGear.Core.Traits,+) where++import Control.Arrow+import Data.Text+import qualified Network.Wai as Wai++import WebGear.Core.Handler+import WebGear.Core.Handler.Static+import WebGear.Core.Modifiers+import WebGear.Core.Request+import WebGear.Core.Response+import WebGear.Core.Trait+import WebGear.Core.Traits

@@ -0,0 +1,88 @@+{- |+ WebGear handlers+-}+module WebGear.Core.Handler (+  Handler (..),+  RoutePath (..),+  RouteMismatch (..),+  Description (..),+  Summary (..),+  RequestHandler,+  Middleware,+  routeMismatch,+  unlinkA,+) where++import Control.Arrow (ArrowChoice, ArrowPlus, arr)+import Control.Arrow.Operations (ArrowError (..))+import Data.String (IsString)+import Data.Text (Text)+import GHC.Exts (IsList (..))+import WebGear.Core.Request (Request)+import WebGear.Core.Response (Response (..))+import WebGear.Core.Trait (Linked (unlink))++-- | Parts of the request path used by the routing machinery+newtype RoutePath = RoutePath [Text]+  deriving newtype (Show, Eq)++instance IsList RoutePath where+  type Item RoutePath = Text+  fromList = RoutePath+  toList (RoutePath ps) = ps++{- | A handler is an arrow with a monadic context.++ Handlers have the following capabilities:++ * Lift a monadic action into a handler arrow.+ * Implement `ArrowChoice` typeclass so that conditionals can be used in arrow code.+ * Implement `ArrowPlus` for routing requests to specific handlers.+ * Provide contextual documentation elements - description and summary+-}+class (ArrowChoice h, ArrowPlus h, ArrowError RouteMismatch h, Monad m) => Handler h m | h -> m where+  -- | Lift a monadic function to a handler arrow+  arrM :: (a -> m b) -> h a b++  -- | Consume all remaining path components with an arrow+  consumeRoute :: h RoutePath a -> h () a++  -- | Set a description of a part of an API+  setDescription :: Description -> h a a++  -- | Set a summary of a part of an API+  setSummary :: Summary -> h a a++-- | A handler arrow from a linked request to response.+type RequestHandler h req = h (Linked req Request) Response++-- | A middleware enhances a `RequestHandler` and produces another handler.+type Middleware h reqOut reqIn = RequestHandler h reqIn -> RequestHandler h reqOut++-- | Description associated with part of an API+newtype Description = Description {getDescription :: Text}+  deriving stock (Eq, Ord, Show, Read)+  deriving newtype (IsString)++-- | A summary associated with part of an API+newtype Summary = Summary {getSummary :: Text}+  deriving stock (Eq, Ord, Show, Read)+  deriving newtype (IsString)++-- | Indicates that a handler cannot process this route+data RouteMismatch = RouteMismatch+  deriving stock (Show, Eq, Ord)++instance Semigroup RouteMismatch where+  RouteMismatch <> RouteMismatch = RouteMismatch++instance Monoid RouteMismatch where+  mempty = RouteMismatch++-- | Indicates that the request does not match the current handler.+routeMismatch :: ArrowError RouteMismatch h => h a b+routeMismatch = proc _a -> raise -< RouteMismatch++-- | Lifts `unlink` into a handler arrow.+unlinkA :: Handler h m => h (Linked ts Response) Response+unlinkA = arr unlink

@@ -0,0 +1,61 @@+{- |+ Handlers for serving static resources+-}+module WebGear.Core.Handler.Static (+  serveDir,+  serveFile,+) where++import Control.Arrow ((<<<))+import Control.Exception.Safe (catchIO)+import Control.Monad.IO.Class (MonadIO (..))+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Text as Text+import qualified Network.Mime as Mime+import System.FilePath (joinPath, takeFileName, (</>))+import WebGear.Core.Handler (Handler (..), RoutePath (..), unlinkA)+import WebGear.Core.Request (Request (..))+import WebGear.Core.Response (Response)+import WebGear.Core.Trait (Linked (..), Sets)+import WebGear.Core.Trait.Body (Body, setBodyWithoutContentType)+import WebGear.Core.Trait.Header (RequiredHeader, setHeader)+import WebGear.Core.Trait.Status (Status, notFound404, ok200)+import Prelude hiding (readFile)++-- | Serve files under the specified directory.+serveDir ::+  ( MonadIO m+  , Handler h m+  , Sets h [Status, RequiredHeader "Content-Type" Mime.MimeType, Body LBS.ByteString] 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 (Linked req Request) Response+serveDir root index = proc _request -> consumeRoute go -< ()+  where+    go = proc path -> do+      case (path, index) of+        (RoutePath [], Nothing) -> unlinkA <<< notFound404 -< ()+        (RoutePath [], Just f) -> serveFile -< root </> f+        (RoutePath ps, _) -> serveFile -< root </> joinPath (Text.unpack <$> ps)++-- | Serve a file specified by the input filepath.+serveFile ::+  ( MonadIO m+  , Handler h m+  , Sets h [Status, RequiredHeader "Content-Type" Mime.MimeType, Body LBS.ByteString] Response+  ) =>+  h FilePath Response+serveFile = proc file -> do+  maybeContents <- readFile -< file+  case maybeContents of+    Nothing -> unlinkA <<< notFound404 -< ()+    Just contents -> do+      let contentType = Mime.defaultMimeLookup $ Text.pack $ takeFileName file+      unlinkA <<< setHeader @"Content-Type" (setBodyWithoutContentType ok200) -< (contentType, (contents, ()))+  where+    readFile = arrM $ \f -> liftIO $ (Just <$> LBS.readFile f) `catchIO` const (pure Nothing)

@@ -0,0 +1,15 @@+-- | Various modifiers used by traits+module WebGear.Core.Modifiers (+  Existence (..),+  ParseStyle (..),+) where++{- | Modifier used to indicate whether a trait is required or+ optional.+-}+data Existence = Required | Optional++{- | Modifier used to indicate whether a trait is parsed strictly or+ leniently.+-}+data ParseStyle = Strict | Lenient

@@ -0,0 +1,70 @@+{- |+ Requests processed by handlers.+-}+module WebGear.Core.Request (+  -- * WebGear Request+  Request (..),+  remoteHost,+  httpVersion,+  isSecure,+  requestMethod,+  pathInfo,+  queryString,+  requestHeader,+  requestHeaders,+  requestBodyLength,+  getRequestBodyChunk,+) where++import Data.ByteString (ByteString)+import Data.List (find)+import Data.Text (Text)+import qualified Network.HTTP.Types as HTTP+import Network.Socket (SockAddr)+import qualified Network.Wai as Wai++-- | A request processed by a handler+newtype Request = Request+  { -- | underlying WAI request+    waiRequest :: Wai.Request+  }++-- | Get the value of a request header+requestHeader :: HTTP.HeaderName -> Request -> Maybe ByteString+requestHeader h r = snd <$> find ((== h) . fst) (requestHeaders r)++-- | See 'Wai.getRequestBodyChunk'+getRequestBodyChunk :: Request -> IO ByteString+getRequestBodyChunk = Wai.getRequestBodyChunk . waiRequest++-- | See 'Wai.httpVersion'+httpVersion :: Request -> HTTP.HttpVersion+httpVersion = Wai.httpVersion . waiRequest++-- | See 'Wai.isSecure'+isSecure :: Request -> Bool+isSecure = Wai.isSecure . waiRequest++-- | See 'Wai.pathInfo'+pathInfo :: Request -> [Text]+pathInfo = Wai.pathInfo . waiRequest++-- | See 'Wai.queryString'+queryString :: Request -> HTTP.Query+queryString = Wai.queryString . waiRequest++-- | See 'Wai.remoteHost'+remoteHost :: Request -> SockAddr+remoteHost = Wai.remoteHost . waiRequest++-- | See 'Wai.requestBodyLength'+requestBodyLength :: Request -> Wai.RequestBodyLength+requestBodyLength = Wai.requestBodyLength . waiRequest++-- | See 'Wai.requestHeaders'+requestHeaders :: Request -> HTTP.RequestHeaders+requestHeaders = Wai.requestHeaders . waiRequest++-- | See 'Wai.requestMethod'+requestMethod :: Request -> HTTP.Method+requestMethod = Wai.requestMethod . waiRequest

@@ -0,0 +1,34 @@+{- |+ Responses from handlers.+-}+module WebGear.Core.Response (+  -- * Basic Types+  Response (..),+  toWaiResponse,+) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LBS+import qualified Data.HashMap.Strict as HM+import Data.Maybe (fromMaybe)+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+  { -- | Response status code+    responseStatus :: HTTP.Status+  , -- | Response headers+    responseHeaders :: HM.HashMap HTTP.HeaderName ByteString+  , -- | Optional response body+    responseBody :: Maybe LBS.ByteString+  }+  deriving stock (Eq, Ord, Show)++-- | Generate a WAI response+toWaiResponse :: Response -> Wai.Response+toWaiResponse Response{..} =+  Wai.responseLBS responseStatus (HM.toList responseHeaders) (fromMaybe "" responseBody)

@@ -0,0 +1,181 @@+ {-# LANGUAGE UndecidableInstances #-}++{- | Traits are optional attributes associated with a value. For+ example, a list containing totally ordered values might have a+ @Maximum@ trait where the associated attribute is the maximum+ value. This trait exists only if the list is non-empty. The `Trait`+ typeclass provides an interface to extract such trait attributes.++ Traits help to link attributes with values in a type-safe manner.++ Traits are somewhat similar to [refinement+ types](https://hackage.haskell.org/package/refined), but allow+ arbitrary attributes to be associated with a value instead of only+ a predicate.+-}+module WebGear.Core.Trait (+  -- * Core Types+  Trait (..),+  TraitAbsence (..),+  Get (..),+  Gets,+  Linked,+  Set (..),+  Sets,++  -- * Linking values with attributes+  linkzero,+  linkminus,+  unlink,+  probe,+  plant,++  -- * Retrive trait attributes from linked values+  HasTrait (..),+  HaveTraits,+  pick,+  MissingTrait,+) where++import Control.Arrow (Arrow (..))+import Data.Kind (Constraint, Type)+import Data.Tagged (Tagged (..), untag)+import GHC.TypeLits (ErrorMessage (..), TypeError)++-- | A trait is an attribute @t@ associated with a value @a@.+class Trait (t :: Type) a where+  -- | Type of the associated attribute when the trait holds for a+  -- value+  type Attribute t a :: Type++-- | A trait @t@ that can be retrieved from @a@ but could be absent.+class Trait t a => TraitAbsence t a where+  -- | Type that indicates that the trait does not exist for a+  -- value. This could be an error message, exception etc.+  type Absence t a :: Type++-- | Extract trait attributes from a value.+class (Arrow h, TraitAbsence t a) => Get h t a where+  -- | Attempt to deduce the trait attribute from the value @a@.+  getTrait ::+    -- | The trait to extract+    t ->+    -- | Arrow that extracts the trait and can possibly fail+    h (Linked ts a) (Either (Absence t a) (Attribute t a))++-- | Set a trait attribute on a value+class (Arrow h, Trait t a) => Set h (t :: Type) a where+  -- | Set a trait attribute @t@ on the value @a@.+  setTrait ::+    -- | The trait to set+    t ->+    -- | A function to generate a linked value. This function must be+    -- called by the `setTrait` implementation to generate a linked+    -- value.+    (Linked ts a -> a -> Attribute t a -> Linked (t : ts) a) ->+    -- | An arrow that attches a new trait attribute to a value linked+    -- with other traits+    h (Linked ts a, Attribute t a) (Linked (t : ts) a)++-- | @Gets h ts a@ is equivalent to @(Get h t1 a, Get h t2 a, ..., Get+-- h tn a)@ where @ts = [t1, t2, ..., tn]@.+type family Gets h ts a :: Constraint where+  Gets h '[] a = ()+  Gets h (t : ts) a = (Get h t a, Gets h ts a)++-- | @Sets h ts a@ is equivalent to @(Set h t1 a, Set h t2 a, ..., Set+-- h tn a)@ where @ts = [t1, t2, ..., tn]@.+type family Sets h ts a :: Constraint where+  Sets h '[] a = ()+  Sets h (t : ts) a = (Set h t a, Sets h ts a)++-- | A value linked with a type-level list of traits.+data Linked (ts :: [Type]) a = Linked+  { linkAttribute :: !(LinkedAttributes ts a)+  , -- | Retrive the value from a linked value+    unlink :: !a+  }++type family LinkedAttributes (ts :: [Type]) (a :: Type) where+  LinkedAttributes '[] a = ()+  LinkedAttributes (t : ts) a = (Attribute t a, LinkedAttributes ts a)++-- | Wrap a value with an empty list of traits.+linkzero :: a -> Linked '[] a+linkzero = Linked ()++-- | Forget the head trait+linkminus :: Linked (t : ts) a -> Linked ts a+linkminus (Linked (_, rv) a) = Linked rv a++{- | Attempt to link an additional trait with an already linked+ value. This can fail indicating an 'Absence' of the trait.+-}+probe ::+  forall t ts h a.+  Get h t a =>+  t ->+  h (Linked ts a) (Either (Absence t a) (Linked (t : ts) a))+probe t = proc l -> do+  res <- getTrait t -< l+  arr link -< (l, res)+  where+    link :: (Linked ts a, Either e (Attribute t a)) -> Either e (Linked (t : ts) a)+    link (_, Left e) = Left e+    link (Linked{..}, Right attr) = Right $ Linked{linkAttribute = (attr, linkAttribute), ..}++-- | Set a trait attribute on linked value to produce another linked+-- value+plant :: forall t ts h a. Set h t a => t -> h (Linked ts a, Attribute t a) (Linked (t : ts) a)+plant t = proc (l, attr) -> do+  setTrait t link -< (l, attr)+  where+    link :: Linked ts a -> a -> Attribute t a -> Linked (t : ts) a+    link Linked{..} a' attr = Linked{linkAttribute = (attr, linkAttribute), unlink = a'}++{- | Constraint that proves that the trait @t@ is present in the list+ of traits @ts@.+-}+class HasTrait t ts where+  -- | Get the attribute associated with @t@ from a linked value. See also: 'pick'.+  from :: Linked ts a -> Tagged t (Attribute t a)++instance HasTrait t (t : ts) where+  from :: Linked (t : ts) a -> Tagged t (Attribute t a)+  from (Linked (lv, _) _) = Tagged lv++instance {-# OVERLAPPABLE #-} HasTrait t ts => HasTrait t (t' : ts) where+  from :: Linked (t' : ts) a -> Tagged t (Attribute t a)+  from l = from $ linkminus l++{- | Retrieve a trait.++ @pick@ is used along with `from` to retrieve an attribute from a+ linked value:++ > pick @t $ from val+-}+pick :: Tagged t a -> a+pick = untag++-- For better type errors+instance TypeError (MissingTrait t) => HasTrait t '[] where+  from = undefined++-- | Type error for nicer UX of missing traits+type MissingTrait t =+  Text "The request doesn't have the trait ‘" :<>: ShowType t :<>: Text "’."+    :$$: Text ""+    :$$: Text "Did you use a wrong trait type?"+    :$$: Text "For e.g., ‘QueryParam \"foo\" Int’ instead of ‘QueryParam \"foo\" String’?"+    :$$: Text ""+    :$$: Text "Or did you forget to apply an appropriate middleware?"+    :$$: Text "For e.g. The trait ‘JSONBody t’ can be used with ‘jsonRequestBody @t’ middleware."+    :$$: Text ""++{- | Constraint that proves that all the traits in the list @ts@ are+ also present in the list @qs@.+-}+type family HaveTraits ts qs :: Constraint where+  HaveTraits '[] qs = ()+  HaveTraits (t : ts) qs = (HasTrait t qs, HaveTraits ts qs)

@@ -0,0 +1,219 @@+{-# LANGUAGE DuplicateRecordFields #-}++{- | HTTP basic authentication support.++ Middlewares defined in this module add basic authentication support+ to handlers. In most cases, you just need to use `BasicAuth` trait+ and `basicAuth` middleware. The table below describes when to use+ other traits and middlewares.++ +----------+-------------+-------------------------+----------------------++ | Type     | Auth Scheme | Trait                   | Middleware           |+ +----------+-------------+-------------------------+----------------------++ | Required | Basic       | 'BasicAuth'             | 'basicAuth'          |+ +----------+-------------+-------------------------+----------------------++ | Optional | Basic       | 'BasicAuth'' 'Optional' | 'optionalBasicAuth'  |+ +----------+-------------+-------------------------+----------------------++ | Required | Any scheme  | 'BasicAuth'' 'Required' | 'basicAuth''         |+ +----------+-------------+-------------------------+----------------------++ | Optional | Any scheme  | 'BasicAuth'' 'Optional' | 'optionalBasicAuth'' |+ +----------+-------------+-------------------------+----------------------+++ For example, given this handler:++ @+ myHandler :: ('Handler' h IO, 'HasTrait' ('BasicAuth' IO () 'Credentials') req) => 'RequestHandler' h req+ myHandler = ....+ @++ and the following definitions:++ @+ authConfig :: 'BasicAuth' IO () 'Credentials'+ authConfig = 'BasicAuth'' { toBasicAttribute = pure . Right }++ type ErrorTraits = [Status, RequiredHeader \"Content-Type\" Text, RequiredHeader \"WWW-Authenticate\" Text, Body Text]++ errorHandler :: ('Handler' h IO, Sets h ErrorTraits Response)+              => h (Linked req Request, 'BasicAuthError' e) Response+ errorHandler = 'respondUnauthorized' \"Basic\" \"MyRealm\"+ @++ we can add basic authentication to @myHandler@:++ @+ myHandlerWithAuth :: ('Handler' h IO, Get h ('BasicAuth' IO () 'Credentials') Request, Sets h ErrorTraits Response)+                   => 'RequestHandler' h req+ myHandlerWithAuth = 'basicAuth' authConfig errorHandler myHandler+ @++ The middlewares defined below take a 'BasicAuth'' parameter which is+ a newtype wrapper over a function of type @'Credentials' -> m (Either+ e a)@. This is used to convert the user supplied credentials to a+ value of type @a@ or fail with an error of type @e@. The next handler+ is invoked after this conversion and can access @a@ as a trait+ attribute.++ Middlewares marked as 'Required' take an additional error handling+ arrow as a parameter. This arrow is used when an error is encountered+ in authentication. This arrow receives the original request and a+ 'BasicAuthError' as inputs and must produce a response as the output.++ Middlewares marked as 'Optional' do not have this additional error+ handling arrow. Instead, the trait attribute is of type @Either+ ('BasicAuthError' e) a@. The next handler will get the errors in this+ trait attribute and must handle it.+-}+module WebGear.Core.Trait.Auth.Basic (+  BasicAuth' (..),+  BasicAuth,+  Realm (..),+  Username (..),+  Password (..),+  Credentials (..),+  BasicAuthError (..),+  basicAuth,+  basicAuth',+  optionalBasicAuth,+  optionalBasicAuth',+) where++import Control.Arrow (ArrowChoice, arr)+import Data.ByteString (ByteString)+import Data.String (IsString)+import Data.Void (Void, absurd)+import GHC.TypeLits (Symbol)+import WebGear.Core.Handler+import WebGear.Core.Modifiers (Existence (..))+import WebGear.Core.Request (Request)+import WebGear.Core.Response (Response)+import WebGear.Core.Trait+import WebGear.Core.Trait.Auth.Common++-- | Trait for HTTP basic authentication: https://tools.ietf.org/html/rfc7617+newtype BasicAuth' (x :: Existence) (scheme :: Symbol) m e a = BasicAuth'+  { -- | Convert the credentials to the trait attribute or an error+    toBasicAttribute :: Credentials -> m (Either e a)+  }++-- | Trait for HTTP basic authentication with the "Basic" scheme.+type BasicAuth = BasicAuth' Required "Basic"++{- | Username for basic authentication. Valid usernames cannot contain+ \':\' characters.+-}+newtype Username = Username ByteString+  deriving newtype (Eq, Ord, Show, Read, IsString)++-- | Password for basic authentication.+newtype Password = Password ByteString+  deriving newtype (Eq, Ord, Show, Read, IsString)++-- | Basic authentication credentials retrieved from an HTTP request+data Credentials = Credentials+  { credentialsUsername :: !Username+  , credentialsPassword :: !Password+  }+  deriving stock (Eq, Ord, Show, Read)++-- | Error retrieving basic authentication credentials+data BasicAuthError e+  = BasicAuthHeaderMissing+  | BasicAuthSchemeMismatch+  | BasicAuthCredsBadFormat+  | BasicAuthAttributeError e+  deriving stock (Eq, Show, Read)++instance Trait (BasicAuth' Required scheme m e a) Request where+  type Attribute (BasicAuth' Required scheme m e a) Request = a++instance TraitAbsence (BasicAuth' Required scheme m e a) Request where+  type Absence (BasicAuth' Required scheme m e a) Request = BasicAuthError e++instance Trait (BasicAuth' Optional scheme m e a) Request where+  type Attribute (BasicAuth' Optional scheme m e a) Request = Either (BasicAuthError e) a++instance TraitAbsence (BasicAuth' Optional scheme m e a) Request where+  type Absence (BasicAuth' Optional scheme m e a) Request = Void++basicAuthMiddleware ::+  (Get h (BasicAuth' x scheme m e t) Request, ArrowChoice h) =>+  BasicAuth' x scheme m e t ->+  h (Linked req Request, Absence (BasicAuth' x scheme m e t) Request) Response ->+  Middleware h req (BasicAuth' x scheme m e t : req)+basicAuthMiddleware authCfg errorHandler nextHandler =+  proc request -> do+    result <- probe authCfg -< request+    case result of+      Left err -> errorHandler -< (request, err)+      Right val -> nextHandler -< val++{- | Middleware to add basic authentication protection for a handler.++ Example usage:++ > basicAuth cfg errorHandler nextHandler++ The @errorHandler@ is invoked if the credentials are invalid or+ missing. The @nextHandler@ is invoked if the credentials were+ retrieved successfully.+-}+basicAuth ::+  forall m e t h req.+  (Get h (BasicAuth' Required "Basic" m e t) Request, ArrowChoice h) =>+  -- | Authentication configuration+  BasicAuth m e t ->+  -- | Error handler+  h (Linked req Request, BasicAuthError e) Response ->+  Middleware h req (BasicAuth m e t : req)+basicAuth = basicAuth'++{- | Similar to `basicAuth` but supports a custom authentication scheme.++ Example usage:++ > basicAuth' @"scheme" cfg errorHandler nextHandler+-}+basicAuth' ::+  forall scheme m e t h req.+  (Get h (BasicAuth' Required scheme m e t) Request, ArrowChoice h) =>+  -- | Authentication configuration+  BasicAuth' Required scheme m e t ->+  -- | Error handler+  h (Linked req Request, BasicAuthError e) Response ->+  Middleware h req (BasicAuth' Required scheme m e t : req)+basicAuth' = basicAuthMiddleware++{- | Middleware to add optional basic authentication protection for a handler.++ Example usage:++ > optionalBasicAuth cfg nextHandler++ This middleware will not fail if credentials are invalid or+ missing. Instead the trait attribute is of type @'Either'+ ('BasicAuthError' e) t@ so that the handler can process the+ authentication error appropriately.+-}+optionalBasicAuth ::+  forall m e t h req.+  (Get h (BasicAuth' Optional "Basic" m e t) Request, ArrowChoice h) =>+  -- | Authentication configuration+  BasicAuth' Optional "Basic" m e t ->+  Middleware h req (BasicAuth' Optional "Basic" m e t : req)+optionalBasicAuth = optionalBasicAuth'++{- | Similar to `optionalBasicAuth` but supports a custom authentication+   scheme.++ Example usage:++ > optionalBasicAuth' @"scheme" cfg nextHandler+-}+optionalBasicAuth' ::+  forall scheme m e t h req.+  (Get h (BasicAuth' Optional scheme m e t) Request, ArrowChoice h) =>+  -- | Authentication configuration+  BasicAuth' Optional scheme m e t ->+  Middleware h req (BasicAuth' Optional scheme m e t : req)+optionalBasicAuth' cfg = basicAuthMiddleware cfg $ arr (absurd . snd)

@@ -0,0 +1,100 @@+{- |+ Common types and functions related to authorization.+-}+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)+import Data.Proxy (Proxy (..))+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 qualified Network.HTTP.Types as HTTP+import Web.HttpApiData (FromHttpApiData (..))+import WebGear.Core.Handler (Handler, unlinkA)+import WebGear.Core.Modifiers (Existence (..), ParseStyle (..))+import WebGear.Core.Request (Request)+import WebGear.Core.Response (Response)+import WebGear.Core.Trait (Get (..), Linked, Sets)+import WebGear.Core.Trait.Body (Body, respondA)+import WebGear.Core.Trait.Header (Header (..), RequiredHeader, setHeader)+import WebGear.Core.Trait.Status (Status)+import Prelude hiding (break, drop)++-- | Trait for \"Authorization\" header+type AuthorizationHeader scheme = Header 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 (Linked ts Request) (Maybe (Either Text (AuthToken scheme)))+getAuthorizationHeaderTrait = proc request -> do+  result <- getTrait (Header :: Header Optional Lenient "Authorization" (AuthToken scheme)) -< request+  returnA -< either absurd id result++-- | The protection space for authentication+newtype Realm = Realm ByteString+  deriving newtype (Eq, Ord, Show, Read, IsString)++-- | The components of Authorization request header+data AuthToken (scheme :: Symbol) = AuthToken+  { -- | Authentication scheme+    authScheme :: CI ByteString+  , -- | Authentication token+    authToken :: ByteString+  }++instance KnownSymbol scheme => FromHttpApiData (AuthToken scheme) where+  parseUrlPiece = parseHeader . encodeUtf8++  parseHeader hdr =+    case break (== ' ') hdr of+      (scm, tok) ->+        let actualScheme = mk scm+            expectedScheme = fromString $ symbolVal $ Proxy @scheme+         in if actualScheme == expectedScheme+              then Right (AuthToken actualScheme (drop 1 tok))+              else Left "scheme mismatch"++{- | Create a \"401 Unauthorized\" response.++ The response will have a plain text body and an appropriate+ \"WWW-Authenticate\" header.+-}+respondUnauthorized ::+  ( Handler h m+  , Sets+      h+      [ Status+      , RequiredHeader "Content-Type" Text+      , RequiredHeader "WWW-Authenticate" Text+      , Body Text+      ]+      Response+  ) =>+  -- | The authentication scheme+  CI ByteString ->+  -- | The authentication realm+  Realm ->+  h a Response+respondUnauthorized scheme (Realm realm) = proc _ -> do+  let headerVal = decodeUtf8 $ original scheme <> " realm=\"" <> realm <> "\""+  unlinkA+    <<< setHeader @"WWW-Authenticate" (respondA HTTP.unauthorized401 "text/plain")+    -<+      (headerVal, "Unauthorized" :: Text)

@@ -0,0 +1,244 @@+{-# LANGUAGE DuplicateRecordFields #-}++{- | JWT authentication support.++ Middlewares defined in this module add JWT authentication support to+ handlers. In most cases, you just need to use `JWTAuth` trait and+ `jwtAuth` middleware. The table below describes when to use other+ traits and middlewares.++ +----------+-------------+-----------------------+--------------------++ | Type     | Auth Scheme | Trait                 | Middleware         |+ +----------+-------------+-----------------------+--------------------++ | Required | Bearer      | 'JWTAuth'             | 'jwtAuth'          |+ +----------+-------------+-----------------------+--------------------++ | Optional | Bearer      | 'JWTAuth'' 'Optional' | 'optionalJWTAuth'  |+ +----------+-------------+-----------------------+--------------------++ | Required | Any scheme  | 'JWTAuth'' 'Required' | 'jwtAuth''         |+ +----------+-------------+-----------------------+--------------------++ | Optional | Any scheme  | 'JWTAuth'' 'Optional' | 'optionalJWTAuth'' |+ +----------+-------------+-----------------------+--------------------+++ For example, given this handler:++ @+ myHandler :: ('Handler' h IO, 'HasTrait' ('JWTAuth' IO () 'JWT.ClaimsSet') req) => 'RequestHandler' h req+ myHandler = ....+ @++ and the following definitions:++ @+ authConfig :: 'JWTAuth' IO () 'JWT.ClaimsSet'+ authConfig = 'JWTAuth''+   { jwtValidationSettings = 'JWT.defaultJWTValidationSettings' (const True)+   , jwkSet = ....+   , toJWTAttribute = pure . Right+   }++ type ErrorTraits = [Status, RequiredHeader \"Content-Type\" Text, RequiredHeader \"WWW-Authenticate\" Text, Body Text]++ errorHandler :: ('Handler' h IO, Sets h ErrorTraits Response)+              => h (Linked req Request, 'JWTAuthError' e) Response+ errorHandler = 'respondUnauthorized' \"Bearer\" \"MyRealm\"+ @++ we can add JWT authentication to @myHandler@:++ @+ myHandlerWithAuth :: ('Handler' h IO, Get h ('JWTAuth' IO () 'JWT.ClaimsSet') Request, Sets h ErrorTraits Response)+                   => 'RequestHandler' h req+ myHandlerWithAuth = 'jwtAuth' authConfig errorHandler myHandler+ @++ The middlewares defined below take a 'JWTAuth'' parameter which has+ settings for validating a JWT. It also contains a function of type+ @'JWT.ClaimsSet' -> m (Either e a)@. This is used to convert the set+ of claims in the JWT to a value of type @a@ or fail with an error of+ type @e@. In this case @a@ is the type of the trait attribute and the+ next handler is invoked after this conversion.++ Middlewares marked as 'Required' take an additional error handling+ arrow as a parameter. This arrow is used when an error is encountered+ in authentication. This arrow receives the original request and a+ 'JWTAuthError' as inputs and must produce a response as the output.++ Middlewares marked as 'Optional' do not have this additional error+ handling arrow. Instead, the trait attribute is of type @Either+ ('JWTAuthError' e) a@. The next handler will get the errors in this+ trait attribute and must handle it.+-}+module WebGear.Core.Trait.Auth.JWT (+  JWTAuth' (..),+  JWTAuth,+  Realm (..),+  JWTAuthError (..),+  jwtAuth,+  optionalJWTAuth,+  jwtAuth',+  optionalJWTAuth',+) where++import Control.Arrow (ArrowChoice, arr)+import qualified Crypto.JWT as JWT+import Data.Void (Void, absurd)+import GHC.TypeLits (Symbol)+import WebGear.Core.Handler+import WebGear.Core.Modifiers (Existence (..))+import WebGear.Core.Request (Request)+import WebGear.Core.Response (Response)+import WebGear.Core.Trait+import WebGear.Core.Trait.Auth.Common++{- | Trait for JWT authentication with a bearer token:+ https://tools.ietf.org/html/rfc6750++ This trait supports a custom scheme instead of the standard+ \"Bearer\" scheme.+-}+data JWTAuth' (x :: Existence) (scheme :: Symbol) m e a = JWTAuth'+  { -- | Settings to validate the JWT+    jwtValidationSettings :: JWT.JWTValidationSettings+  , -- | JWK to validate the JWT+    jwkSet :: JWT.JWKSet+  , -- | Convert the claims set to the trait attribute or an error+    toJWTAttribute :: JWT.ClaimsSet -> m (Either e a)+  }++-- | Trait for JWT authentication with the \"Bearer\" scheme+type JWTAuth = JWTAuth' Required "Bearer"++-- | Error extracting a JWT from a request+data JWTAuthError e+  = JWTAuthHeaderMissing+  | JWTAuthSchemeMismatch+  | JWTAuthTokenBadFormat JWT.JWTError+  | JWTAuthAttributeError e+  deriving stock (Eq, Show)++instance WebGear.Core.Trait.Trait (JWTAuth' Required scheme m e a) Request where+  type Attribute (JWTAuth' Required scheme m e a) Request = a++instance WebGear.Core.Trait.TraitAbsence (JWTAuth' Required scheme m e a) Request where+  type Absence (JWTAuth' Required scheme m e a) Request = JWTAuthError e++instance WebGear.Core.Trait.Trait (JWTAuth' Optional scheme m e a) Request where+  type Attribute (JWTAuth' Optional scheme m e a) Request = Either (JWTAuthError e) a++instance WebGear.Core.Trait.TraitAbsence (JWTAuth' Optional scheme m e a) Request where+  type Absence (JWTAuth' Optional scheme m e a) Request = Void++{- | Middleware to add JWT authentication protection for a+ handler. Expects the JWT to be available via a standard bearer+ authorization header in the format:++ > Authorization: Bearer <jwt>++ Example usage:++ > jwtAuth cfg errorHandler nextHandler++ The @errorHandler@ is invoked if the credentials are invalid or+ missing. The @nextHandler@ is invoked if the credentials were+ retrieved successfully.+-}+jwtAuth ::+  ( WebGear.Core.Trait.Get h (JWTAuth m e t) Request+  , ArrowChoice h+  ) =>+  -- | Authentication configuration+  JWTAuth m e t ->+  -- | Error handler+  h (WebGear.Core.Trait.Linked req Request, JWTAuthError e) Response ->+  Middleware h req (JWTAuth m e t : req)+jwtAuth = jwtAuth' @"Bearer"++{- | Middleware to add optional JWT authentication protection for a+ handler. Expects the JWT to be available via a standard bearer+ authorization header in the format:++ > Authorization: Bearer <jwt>++ Example usage:++ > optionalJWTAuth cfg handler++ This middleware will not fail if authorization credentials are+ invalid or missing. Instead the trait attribute is of type @'Either'+ ('JWTAuthError' e) t@ so that the handler can process the+ authentication error appropriately.+-}+optionalJWTAuth ::+  ( WebGear.Core.Trait.Get h (JWTAuth' Optional "Bearer" m e t) Request+  , ArrowChoice h+  ) =>+  -- | Authentication configuration+  JWTAuth' Optional "Bearer" m e t ->+  Middleware h req (JWTAuth' Optional "Bearer" m e t : req)+optionalJWTAuth = optionalJWTAuth' @"Bearer"++jwtAuthMiddleware ::+  forall s e t x h m req.+  ( WebGear.Core.Trait.Get h (JWTAuth' x s m e t) Request+  , ArrowChoice h+  ) =>+  JWTAuth' x s m e t ->+  h (WebGear.Core.Trait.Linked req Request, WebGear.Core.Trait.Absence (JWTAuth' x s m e t) Request) Response ->+  Middleware h req (JWTAuth' x s m e t : req)+jwtAuthMiddleware authCfg errorHandler nextHandler =+  proc request -> do+    result <- WebGear.Core.Trait.probe authCfg -< request+    case result of+      Left err -> errorHandler -< (request, err)+      Right val -> nextHandler -< val++{- | Middleware to add JWT authentication protection for a+ handler. Expects the JWT to be available via an authorization header+ in the format:++ > Authorization: <scheme> <jwt>++ Example usage:++ > jwtAuth' @"<scheme>" cfg errorHandler nextHandler++ The @errorHandler@ is invoked if the credentials are invalid or+ missing. The @nextHandler@ is invoked if the credentials were+ retrieved successfully.+-}+jwtAuth' ::+  forall s e t h m req.+  ( WebGear.Core.Trait.Get h (JWTAuth' Required s m e t) Request+  , ArrowChoice h+  ) =>+  -- | Authentication configuration+  JWTAuth' Required s m e t ->+  -- | Error handler+  h (WebGear.Core.Trait.Linked req Request, JWTAuthError e) Response ->+  Middleware h req (JWTAuth' Required s m e t : req)+jwtAuth' = jwtAuthMiddleware++{- | Middleware to add JWT authentication protection for a+ handler. Expects the JWT to be available via an authorization header+ in the format:++ > Authorization: <scheme> <jwt>++ Example usage:++ > optionalJWTAuth' @"<scheme>" cfg nextHandler++ This middleware will not fail if authorization credentials are+ invalid or missing. Instead the trait attribute is of type @'Either'+ ('JWTAuthError' e) t@ so that the handler can process the+ authentication error appropriately.+-}+optionalJWTAuth' ::+  forall s e t h m req.+  ( WebGear.Core.Trait.Get h (JWTAuth' Optional s m e t) Request+  , ArrowChoice h+  ) =>+  -- | Authentication configuration+  JWTAuth' Optional s m e t ->+  Middleware h req (JWTAuth' Optional s m e t : req)+optionalJWTAuth' cfg = jwtAuthMiddleware cfg $ arr (absurd . snd)

@@ -0,0 +1,252 @@+{- | Traits and middlewares to handle request and response body+   payloads.++ There are a number of ways to extract a body from a request:++ The 'requestBody' middleware attempts to convert the body to a+ Haskell value or invoke an error handler if that fails.++ The 'jsonRequestBody' middleware attempts to convert a JSON+ formatted body to a Haskell value or invoke an error handler if that+ fails. It uses the standard "application/json" media type.++ The 'jsonRequestBody'' middleware is similar but supports custom+ media types.++ Similarly, there are a number of ways to set a response body:++ The easiest option is to use one of 'respondA', 'respondJsonA', or+ 'respondJsonA'' middlewares. These middlewares generate a response+ from an HTTP status and a response body.++ If you need finer control over setting the body, use one of+ 'setBody', 'setBodyWithoutContentType', 'setJSONBody',+ 'setJSONBodyWithoutContentType', or 'setJSONBody''. These arrows+ accept a linked response and a body and sets the body in the+ response. You can generate an input response object using functions+ from "WebGear.Core.Trait.Status" module.+-}+module WebGear.Core.Trait.Body (+  -- * Traits+  Body (..),+  JSONBody (..),++  -- * Middlewares+  requestBody,+  jsonRequestBody',+  jsonRequestBody,+  respondA,+  respondJsonA,+  respondJsonA',+  setBody,+  setBodyWithoutContentType,+  setJSONBody,+  setJSONBodyWithoutContentType,+  setJSONBody',+) where++import Control.Arrow (ArrowChoice)+import Data.Kind (Type)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8)+import qualified Network.HTTP.Media as HTTP+import qualified Network.HTTP.Types as HTTP+import WebGear.Core.Handler (Middleware)+import WebGear.Core.Request (Request)+import WebGear.Core.Response (Response)+import WebGear.Core.Trait (Get, Linked, Set, Sets, Trait (..), TraitAbsence (..), plant, probe)+import WebGear.Core.Trait.Header (Header (..), RequiredHeader)+import WebGear.Core.Trait.Status (Status, mkResponse)++-- | Request or response body with a type @t@.+newtype Body (t :: Type) = Body (Maybe HTTP.MediaType)++instance Trait (Body t) Request where+  type Attribute (Body t) Request = t++instance TraitAbsence (Body t) Request where+  type Absence (Body t) Request = Text++instance Trait (Body t) Response where+  type Attribute (Body t) Response = t++-- | A 'Trait' for converting a JSON formatted body into a value.+newtype JSONBody (t :: Type) = JSONBody (Maybe HTTP.MediaType)++instance Trait (JSONBody t) Request where+  type Attribute (JSONBody t) Request = t++instance TraitAbsence (JSONBody t) Request where+  type Absence (JSONBody t) Request = Text++instance Trait (JSONBody t) Response where+  type Attribute (JSONBody t) Response = t++{- | Middleware to extract a request body.++ The @nextHandler@ is invoked after successfully extracting the body+ and the @errorHandler@ is invoked when there is an error.++ Usage:++ > requestBody @t (Just "text/plain") errorHandler nextHandler+-}+requestBody ::+  forall t h req.+  (Get h (Body t) Request, ArrowChoice h) =>+  -- | Optional media type of the body+  Maybe HTTP.MediaType ->+  -- | Error handler in case body cannot be retrieved+  h (Linked req Request, Text) Response ->+  Middleware h req (Body t : req)+requestBody mediaType errorHandler nextHandler = proc request -> do+  result <- probe (Body mediaType) -< request+  case result of+    Left err -> errorHandler -< (request, err)+    Right t -> nextHandler -< t++{- | Parse the request body as JSON and convert it to a value of type+   @t@.++ The @nextHandler@ is invoked when the body is parsed successfully and+ the @errorHandler@ is invoked when there is a parsing failure.++ Usage:++ > jsonRequestBody @t errorHandler nextHandler+-}+jsonRequestBody' ::+  forall t h req.+  (Get h (JSONBody t) Request, ArrowChoice h) =>+  -- | Optional media type of the body+  Maybe HTTP.MediaType ->+  -- | Error handler in case body cannot be retrieved+  h (Linked req Request, Text) Response ->+  Middleware h req (JSONBody t : req)+jsonRequestBody' mediaType errorHandler nextHandler = proc request -> do+  result <- probe (JSONBody mediaType) -< request+  case result of+    Left err -> errorHandler -< (request, err)+    Right t -> nextHandler -< t++-- | Same as 'jsonRequestBody'' but with a media type @application/json@.+jsonRequestBody ::+  forall t h req.+  (Get h (JSONBody t) Request, ArrowChoice h) =>+  -- | error handler+  h (Linked req Request, Text) Response ->+  Middleware h req (JSONBody t : req)+jsonRequestBody = jsonRequestBody' (Just "application/json")++{- | Set the response body along with a media type.++  The media type value is used to set the "Content-Type" header in the response.+-}+setBody ::+  forall body a h ts.+  Sets h [Body body, RequiredHeader "Content-Type" Text] Response =>+  -- | The media type of the response body+  HTTP.MediaType ->+  h a (Linked ts Response) ->+  h (body, a) (Linked (RequiredHeader "Content-Type" Text : Body body : ts) Response)+setBody mediaType prevHandler = proc (body, a) -> do+  r <- prevHandler -< a+  r' <- plant (Body (Just mediaType)) -< (r, body)+  let mt = decodeUtf8 $ HTTP.renderHeader mediaType+  plant Header -< (r', mt)++-- | Set the response body without specifying any media type.+setBodyWithoutContentType ::+  forall body a h ts.+  Set h (Body body) Response =>+  h a (Linked ts Response) ->+  h (body, a) (Linked (Body body : ts) Response)+setBodyWithoutContentType prevHandler = proc (body, a) -> do+  r <- prevHandler -< a+  plant (Body Nothing) -< (r, body)++{- | Set the response body to a JSON value along with a media type.++  The media type value is used to set the "Content-Type" header in the response.+-}+setJSONBody' ::+  forall body a h ts.+  Sets h [JSONBody body, RequiredHeader "Content-Type" Text] Response =>+  -- | The media type of the response body+  HTTP.MediaType ->+  h a (Linked ts Response) ->+  h (body, a) (Linked (RequiredHeader "Content-Type" Text : JSONBody body : ts) Response)+setJSONBody' mediaType prevHandler = proc (body, a) -> do+  r <- prevHandler -< a+  r' <- plant (JSONBody (Just mediaType)) -< (r, body)+  let mt = decodeUtf8 $ HTTP.renderHeader mediaType+  plant Header -< (r', mt)++{- | Set the response body to a JSON value.++  The "Content-Type" header will be set to "application/json".+-}+setJSONBody ::+  forall body a h ts.+  Sets h [JSONBody body, RequiredHeader "Content-Type" Text] Response =>+  h a (Linked ts Response) ->+  h (body, a) (Linked (RequiredHeader "Content-Type" Text : JSONBody body : ts) Response)+setJSONBody = setJSONBody' "application/json"++{- | Set the response body to a JSON value without specifying any+ media type.+-}+setJSONBodyWithoutContentType ::+  forall body a h ts.+  Set h (JSONBody body) Response =>+  h a (Linked ts Response) ->+  h (body, a) (Linked (JSONBody body : ts) Response)+setJSONBodyWithoutContentType prevHandler = proc (body, a) -> do+  r <- prevHandler -< a+  plant (JSONBody Nothing) -< (r, body)++{- | A convenience arrow to generate a response specifying a status and body.++ The "Content-Type" header will be set to the specified media type+ value.+-}+respondA ::+  forall body h.+  Sets h [Status, Body body, RequiredHeader "Content-Type" Text] Response =>+  -- | Response status+  HTTP.Status ->+  -- | Media type of the response body+  HTTP.MediaType ->+  h body (Linked [RequiredHeader "Content-Type" Text, Body body, Status] Response)+respondA status mediaType = proc body ->+  setBody mediaType (mkResponse status) -< (body, ())++{- | A convenience arrow to generate a response specifying a status and+   JSON body.++ The "Content-Type" header will be set to "application/json".+-}+respondJsonA ::+  forall body h.+  Sets h [Status, JSONBody body, RequiredHeader "Content-Type" Text] Response =>+  -- | Response status+  HTTP.Status ->+  h body (Linked [RequiredHeader "Content-Type" Text, JSONBody body, Status] Response)+respondJsonA status = respondJsonA' status "application/json"++{- | A convenience arrow to generate a response specifying a status and+   JSON body.++ The "Content-Type" header will be set to the specified media type+ value.+-}+respondJsonA' ::+  forall body h.+  Sets h [Status, JSONBody body, RequiredHeader "Content-Type" Text] Response =>+  -- | Response status+  HTTP.Status ->+  -- | Media type of the response body+  HTTP.MediaType ->+  h body (Linked [RequiredHeader "Content-Type" Text, JSONBody body, Status] Response)+respondJsonA' status mediaType = proc body ->+  setJSONBody' mediaType (mkResponse status) -< (body, ())

@@ -0,0 +1,219 @@+{- | Traits and middlewares to handle request and response headers.++ There are a number of ways to extract a header value from a request:++ The `header` middleware can extract a header value trait and invoke+ another handler. An error handler is invoked if the header is missing+ or the parsing fails.++ The `optionalHeader` middleware is similar but will not invoke the+ error handling in case the header is missing. Instead, the trait+ value will be set to `Nothing` in that case.++ The `lenientHeader` middleware requires the header to be present. But+ the trait attribute will be set to 'Left' @msg@ if an error occurs+ while parsing it to a Haskell value. Here @msg@ will indicate the+ error in parsing.++ Finally, we have `optionalLenientHeader` which combines the behaviors+ of `optionalHeader` and `lenientHeader`. In this case, the header+ extraction never fails. Missing headers and parse errors are+ indicated in the trait attribute passed to next handler.++ A response header can be set using `setHeader` or `setOptionalHeader`+ arrows. They accept a linked response and a header value and sets the+ header in the response. You can generate an input response object+ using functions from "WebGear.Core.Trait.Status" module.+-}+module WebGear.Core.Trait.Header (+  -- * Traits+  Header (..),+  HeaderNotFound (..),+  HeaderParseError (..),+  RequiredHeader,+  OptionalHeader,++  -- * Middlewares+  header,+  optionalHeader,+  lenientHeader,+  optionalLenientHeader,+  setHeader,+  setOptionalHeader,+) where++import Control.Arrow (ArrowChoice, arr)+import Data.Kind (Type)+import Data.Text (Text)+import Data.Void (Void, absurd)+import GHC.TypeLits (Symbol)+import WebGear.Core.Handler (Middleware)+import WebGear.Core.Modifiers (Existence (..), ParseStyle (..))+import WebGear.Core.Request (Request)+import WebGear.Core.Response (Response)+import WebGear.Core.Trait (Get (..), Linked, Set, Trait (..), TraitAbsence (..), plant, probe)++-- | Indicates a missing header+data HeaderNotFound = HeaderNotFound+  deriving stock (Read, Show, Eq)++-- | Error in converting a header+newtype HeaderParseError = HeaderParseError Text+  deriving stock (Read, Show, Eq)++{- | A 'Trait' for capturing an HTTP header of specified @name@ and+ converting it to some type @val@. The modifiers @e@ and @p@ determine+ how missing headers and parsing errors are handled. The header name+ is compared case-insensitively.+-}+data Header (e :: Existence) (p :: ParseStyle) (name :: Symbol) (val :: Type) = Header++-- | A `Header` that is required and parsed strictly+type RequiredHeader = Header Required Strict++-- | A `Header` that is optional and parsed strictly+type OptionalHeader = Header Optional Strict++instance Trait (Header Required Strict name val) Request where+  type Attribute (Header Required Strict name val) Request = val++instance TraitAbsence (Header Required Strict name val) Request where+  type Absence (Header Required Strict name val) Request = Either HeaderNotFound HeaderParseError++instance Trait (Header Optional Strict name val) Request where+  type Attribute (Header Optional Strict name val) Request = Maybe val++instance TraitAbsence (Header Optional Strict name val) Request where+  type Absence (Header Optional Strict name val) Request = HeaderParseError++instance Trait (Header Required Lenient name val) Request where+  type Attribute (Header Required Lenient name val) Request = Either Text val++instance TraitAbsence (Header Required Lenient name val) Request where+  type Absence (Header Required Lenient name val) Request = HeaderNotFound++instance Trait (Header Optional Lenient name val) Request where+  type Attribute (Header Optional Lenient name val) Request = Maybe (Either Text val)++instance TraitAbsence (Header Optional Lenient name val) Request where+  type Absence (Header Optional Lenient name val) Request = Void++headerHandler ::+  forall name val e p h req.+  (Get h (Header e p name val) Request, ArrowChoice h) =>+  -- | error handler+  h (Linked req Request, Absence (Header e p name val) Request) Response ->+  Middleware h req (Header e p name val : req)+headerHandler errorHandler nextHandler = proc request -> do+  result <- probe Header -< request+  case result of+    Left err -> errorHandler -< (request, err)+    Right val -> nextHandler -< val++{- | Extract a header value and convert it to a value of type @val@.++ The associated trait attribute has type @val@.++ Example usage:++ > header @"Content-Length" @Integer errorHandler okHandler+-}+header ::+  forall name val h req.+  (Get h (Header Required Strict name val) Request, ArrowChoice h) =>+  -- | Error handler+  h (Linked req Request, Either HeaderNotFound HeaderParseError) Response ->+  Middleware h req (Header Required Strict name val : req)+header = headerHandler++{- | Extract an optional header value and convert it to a value of type+ @val@.++ The associated trait attribute has type @Maybe val@; a @Nothing@+ value indicates that the header is missing from the request.++ Example usage:++ > optionalHeader @"Content-Length" @Integer errorHandler okHandler+-}+optionalHeader ::+  forall name val h req.+  (Get h (Header Optional Strict name val) Request, ArrowChoice h) =>+  -- | Error handler+  h (Linked req Request, HeaderParseError) Response ->+  Middleware h req (Header Optional Strict name val : req)+optionalHeader = headerHandler++{- | Extract a header value and convert it to a value of type @val@.++ The associated trait attribute has type @Either Text val@. The+ parsing is done leniently and any errors are reported in the trait+ attribute.++ Example usage:++ > lenientHeader @"Content-Length" @Integer errorHandler okHandler+-}+lenientHeader ::+  forall name val h req.+  (Get h (Header Required Lenient name val) Request, ArrowChoice h) =>+  -- | Error handler+  h (Linked req Request, HeaderNotFound) Response ->+  Middleware h req (Header Required Lenient name val : req)+lenientHeader = headerHandler++{- | Extract a header value and convert it to a value of type @val@.++ The associated trait attribute has type @Maybe (Either Text+ val)@. The parsing is done leniently. Any parsing errors and+ missing header are reported in the trait attribute.++ Example usage:++ > optionalLenientHeader @"Content-Length" @Integer handler+-}+optionalLenientHeader ::+  forall name val h req.+  (Get h (Header Optional Lenient name val) Request, ArrowChoice h) =>+  Middleware h req (Header Optional Lenient name val : req)+optionalLenientHeader = headerHandler $ arr (absurd . snd)++instance Trait (Header Required Strict name val) Response where+  type Attribute (Header Required Strict name val) Response = val++instance Trait (Header Optional Strict name val) Response where+  type Attribute (Header Optional Strict name val) Response = Maybe val++{- | Set a header value in a response.++ Example usage:++ > response' <- setHeader @"Content-Length" -< (response, 42)+-}+setHeader ::+  forall name val a h res.+  Set h (Header Required Strict name val) Response =>+  h a (Linked res Response) ->+  h (val, a) (Linked (Header Required Strict name val : res) Response)+setHeader prevHandler = proc (val, a) -> do+  r <- prevHandler -< a+  plant Header -< (r, val)++{- | Set an optional header value in a response.++ Setting the header to 'Nothing' will remove it from the response if+ it was previously set. The header will be considered as optional in+ all relevant places (such as documentation).++ Example usage:++ > response' <- setOptionalHeader @"Content-Length" -< (response, Just 42)+-}+setOptionalHeader ::+  forall name val a h res.+  Set h (Header Optional Strict name val) Response =>+  h a (Linked res Response) ->+  h (Maybe val, a) (Linked (Header Optional Strict name val : res) Response)+setOptionalHeader prevHandler = proc (val, a) -> do+  r <- prevHandler -< a+  plant Header -< (r, val)

@@ -0,0 +1,47 @@+-- | Traits and middlewares to handle HTTP methods.+module WebGear.Core.Trait.Method (+  Method (..),+  MethodMismatch (..),+  method,+) where++import Control.Arrow (ArrowChoice (..), (>>>))+import Control.Arrow.Operations (ArrowError)+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)++-- | A 'Trait' for capturing the HTTP method of a request+newtype Method = Method HTTP.StdMethod++-- | Failure to match method against an expected value+data MethodMismatch = MethodMismatch+  { expectedMethod :: HTTP.Method+  , actualMethod :: HTTP.Method+  }++instance Trait Method Request where+  type Attribute Method Request = HTTP.StdMethod++instance TraitAbsence Method Request where+  type Absence Method Request = MethodMismatch++{- | Check whether the request has a specified HTTP method.++ Example usage:++ > method @GET handler++ If the request does not have the specified method, another handler+ will be tried.++ It is also idiomatic to use the template haskell quasiquoter+ 'WebGear.Core.Trait.Path.match' or 'WebGear.Core.Trait.Path.route' in+ cases where both an HTTP method and a path need to be matched.+-}+method ::+  (Get h Method Request, ArrowChoice h, ArrowError RouteMismatch h) =>+  HTTP.StdMethod ->+  Middleware h req (Method : req)+method m nextHandler = probe (Method m) >>> routeMismatch ||| nextHandler

@@ -0,0 +1,216 @@+{- | Middlewares related to request paths.++ All the middlewares below attempt to match components of the request+ path. In case of a mismatch, they abandon the current handler and+ tries the next handler.+-}+module WebGear.Core.Trait.Path (+  Path (..),+  PathVar (..),+  PathVarError (..),+  PathEnd (..),+  path,+  pathVar,+  pathEnd,+  match,+  route,+) where++import Control.Arrow (ArrowChoice (..), (>>>))+import Control.Arrow.Operations (ArrowError)+import Data.Function ((&))+import Data.Kind (Type)+import qualified Data.List as List+import Data.List.NonEmpty (NonEmpty (..), filter, toList)+import Data.Text (Text)+import GHC.TypeLits (Symbol)+import Language.Haskell.TH (appE, conE)+import Language.Haskell.TH.Quote (QuasiQuoter (..))+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.Method (method)+import Prelude hiding (drop, filter, take)++{- | A path component which is literally matched against the request+ but discarded after that.+-}+newtype Path = Path Text++instance Trait Path Request where+  type Attribute Path Request = ()++instance TraitAbsence Path Request where+  type Absence Path 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.+-}+data PathVar (tag :: Symbol) (val :: Data.Kind.Type) = PathVar++-- | Failure to extract a 'PathVar'+data PathVarError = PathVarNotFound | PathVarParseError Text+  deriving stock (Eq, Show, Read)++instance Trait (PathVar tag val) Request where+  type Attribute (PathVar tag val) Request = val++instance TraitAbsence (PathVar tag val) Request where+  type Absence (PathVar tag val) Request = PathVarError++-- | Trait to indicate that no more path components are present in the request+data PathEnd = PathEnd++instance Trait PathEnd Request where+  type Attribute PathEnd Request = ()++instance TraitAbsence PathEnd Request where+  type Absence PathEnd Request = ()++{- | A middleware that literally matches path @s@.++ The symbol @s@ could contain one or more parts separated by a+ forward slash character. The route will be rejected if there is no+ match.++ For example, the following code could be used to match the URL path+ \"a\/b\/c\" and then invoke @handler@:++ > path "a/b/c" handler+-}+path ::+  (Get h Path Request, ArrowChoice h, ArrowError RouteMismatch h) =>+  Text ->+  Middleware h req (Path : req)+path s nextHandler = probe (Path s) >>> routeMismatch ||| nextHandler++{- | A middleware that captures a path variable from a single path+ component.++ The value captured is converted to a value of type @val@. The route+ will be rejected if the value is not found or cannot be converted.++ For example, the following code could be used to read a path+ component as 'Int' tagged with the symbol \"objId\", and then+ invoke @handler@:++ > pathVar @"objId" @Int handler+-}+pathVar ::+  forall tag val h req.+  (Get h (PathVar tag val) Request, ArrowChoice h, ArrowError RouteMismatch h) =>+  Middleware h req (PathVar tag val : req)+pathVar nextHandler = probe PathVar >>> routeMismatch ||| nextHandler++-- | A middleware that verifies that end of path is reached.+pathEnd ::+  (Get h PathEnd Request, ArrowChoice h, ArrowError RouteMismatch h) =>+  Middleware h req (PathEnd : req)+pathEnd nextHandler = probe PathEnd >>> routeMismatch ||| nextHandler++{- | Produces middleware(s) to match an optional HTTP method and some+ path components.++ This middleware matches a prefix of path components, the remaining+ components can be matched by subsequent uses of 'match'.++ This quasiquoter can be used in several ways:++ +---------------------------------------+---------------------------------------------------------------------------------++ | QuasiQuoter                           | Equivalent Middleware                                                           |+ +=======================================+=================================================================================++ | @[match| \/a\/b\/c |]@                | @'path' \"\/a\/b\/c\"@                                                          |+ +---------------------------------------+---------------------------------------------------------------------------------++ | @[match| \/a\/b\/objId:Int\/d |]@     | @'path' \"\/a\/b\" . 'pathVar' \@\"objId\" \@Int . 'path' \"d\"@                |+ +---------------------------------------+---------------------------------------------------------------------------------++ | @[match| GET \/a\/b\/c |]@            | @'method' GET . 'path' \"\/a\/b\/c\"@                                           |+ +---------------------------------------+---------------------------------------------------------------------------------++ | @[match| GET \/a\/b\/objId:Int\/d |]@ | @'method' GET . 'path' \"\/a\/b\" . 'pathVar' \@\"objId\" \@Int . 'path' \"d\"@ |+ +---------------------------------------+---------------------------------------------------------------------------------++-}+match :: QuasiQuoter+match =+  QuasiQuoter+    { quoteExp = toMatchExp+    , quotePat = const $ fail "match cannot be used in a pattern"+    , quoteType = const $ fail "match cannot be used in a type"+    , quoteDec = const $ fail "match cannot be used in a declaration"+    }++{- | Produces middleware(s) to match an optional HTTP method and the+ entire request path.++ This middleware is intended to be used in cases where the entire+ path needs to be matched. Use 'match' middleware to match only an+ initial portion of the path.++ This quasiquoter can be used in several ways:++ +---------------------------------------+----------------------------------------------------------------------------------------------++ | QuasiQuoter                           | Equivalent Middleware                                                                        |+ +=======================================+==============================================================================================++ | @[route| \/a\/b\/c |]@                | @'path' \"\/a\/b\/c\" . 'pathEnd'@                                                           |+ +---------------------------------------+----------------------------------------------------------------------------------------------++ | @[route| \/a\/b\/objId:Int\/d |]@     | @'path' \"\/a\/b\" . 'pathVar' \@\"objId\" \@Int . 'path' \"d\" . 'pathEnd'@                 |+ +---------------------------------------+----------------------------------------------------------------------------------------------++ | @[route| GET \/a\/b\/c |]@            | @'method' GET . 'path' \"\/a\/b\/c\" . 'pathEnd'@                                            |+ +---------------------------------------+----------------------------------------------------------------------------------------------++ | @[route| GET \/a\/b\/objId:Int\/d |]@ | @'method' GET . 'path' \"\/a\/b\" . 'pathVar' \@\"objId\" \@Int . 'path' \"d\" . 'pathEnd')@ |+ +---------------------------------------+----------------------------------------------------------------------------------------------++-}+route :: QuasiQuoter+route =+  QuasiQuoter+    { quoteExp = toRouteExp+    , quotePat = const $ fail "route cannot be used in a pattern"+    , quoteType = const $ fail "route cannot be used in a type"+    , quoteDec = const $ fail "route cannot be used in a declaration"+    }++toRouteExp :: String -> Q Exp+toRouteExp s = do+  e <- toMatchExp s+  pure $ compose e (VarE 'pathEnd)++toMatchExp :: String -> Q Exp+toMatchExp s = case List.words s of+  [m, p] -> toMethodAndPathExps m p+  [p] -> do+    pathExps <- toPathExps p+    pure $ List.foldr1 compose pathExps+  _ -> fail "Expected an HTTP method and a path or just a path"+  where+    toMethodAndPathExps :: String -> String -> Q Exp+    toMethodAndPathExps m p = do+      methodExp <- [|method|] `appE` conE (mkName m)+      pathExps <- toPathExps p+      pure $ List.foldr1 compose $ methodExp :| pathExps++    toPathExps :: String -> Q [Exp]+    toPathExps p =+      splitOn '/' p+        & filter (/= "")+        & fmap (splitOn ':')+        & List.foldr joinPath []+        & mapM toPathExp++    joinPath :: NonEmpty String -> [NonEmpty String] -> [NonEmpty String]+    joinPath p [] = [p]+    joinPath (p :| []) ((p' :| []) : xs) = ((p <> "/" <> p') :| []) : xs+    joinPath y (x : xs) = y : x : xs++    toPathExp :: NonEmpty String -> Q Exp+    toPathExp (p :| []) = pure $ AppE (VarE 'path) (LitE $ StringL p)+    toPathExp (v :| [t]) = pure $ AppTypeE (AppTypeE (VarE 'pathVar) (LitT $ StrTyLit v)) (ConT $ mkName t)+    toPathExp xs = fail $ "Invalid path component: " <> List.intercalate ":" (toList xs)++compose :: Exp -> Exp -> Exp+compose l = UInfixE l (VarE $ mkName ".")++splitOn :: Eq a => a -> [a] -> NonEmpty [a]+splitOn sep = foldr f ([] :| [])+  where+    f x acc | x == sep = [] :| toList acc+    f x (y :| ys) = (x : y) :| ys

@@ -0,0 +1,169 @@+{- | Traits and middleware to handle request query parameters.++ The `queryParam` middleware can extract a query parameter value trait+ and invoke another handler. An error handler is invoked if the parameter+ is missing or the parsing fails.++ The `optionalQueryParam` middleware is similar but will not invoke+ the error handling in case the prameter is missing. Instead, the+ trait value will be set to `Nothing` in that case.++ The `lenientQueryParam` middleware requires the parameter to be+ present. But the trait attribute will be set to 'Left' @msg@ if an+ error occurs while parsing it to a Haskell value. Here @msg@ will+ indicate the error in parsing.++ Finally, we have `optionalLenientQueryParam` which combines the+ behaviors of `optionalQueryParam` and `lenientQueryParam`. In this+ case, the parameter extraction never fails. Missing parameters and+ parse errors are indicated in the trait attribute passed to next+ handler.+-}+module WebGear.Core.Trait.QueryParam (+  -- * Traits+  QueryParam (..),+  RequiredQueryParam,+  OptionalQueryParam,+  ParamNotFound (..),+  ParamParseError (..),++  -- * Middlewares+  queryParam,+  optionalQueryParam,+  lenientQueryParam,+  optionalLenientQueryParam,+) where++import Control.Arrow (ArrowChoice, arr)+import Data.Kind (Type)+import Data.Text (Text)+import Data.Void (Void, absurd)+import GHC.TypeLits (Symbol)+import WebGear.Core.Handler (Middleware)+import WebGear.Core.Modifiers (Existence (..), ParseStyle (..))+import WebGear.Core.Request (Request)+import WebGear.Core.Response (Response)+import WebGear.Core.Trait (Get, Linked, Trait (..), TraitAbsence (..), 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+ query parameter is required to be present. The parse style parameter+ @p@ determines whether the conversion is applied strictly or+ leniently.+-}+data QueryParam (e :: Existence) (p :: ParseStyle) (name :: Symbol) (val :: Type) = QueryParam++-- | `QueryParam` that is required and parsed strictly+type RequiredQueryParam = QueryParam Required Strict++-- | `QueryParam` that is optional and parsed strictly+type OptionalQueryParam = QueryParam Optional Strict++-- | Indicates a missing query parameter+data ParamNotFound = ParamNotFound+  deriving stock (Read, Show, Eq)++-- | Error in converting a query parameter+newtype ParamParseError = ParamParseError Text+  deriving stock (Read, Show, Eq)++instance Trait (QueryParam Required Strict name val) Request where+  type Attribute (QueryParam Required Strict name val) Request = val++instance TraitAbsence (QueryParam Required Strict name val) Request where+  type Absence (QueryParam Required Strict name val) Request = Either ParamNotFound ParamParseError++instance Trait (QueryParam Optional Strict name val) Request where+  type Attribute (QueryParam Optional Strict name val) Request = Maybe val++instance TraitAbsence (QueryParam Optional Strict name val) Request where+  type Absence (QueryParam Optional Strict name val) Request = ParamParseError++instance Trait (QueryParam Required Lenient name val) Request where+  type Attribute (QueryParam Required Lenient name val) Request = Either Text val++instance TraitAbsence (QueryParam Required Lenient name val) Request where+  type Absence (QueryParam Required Lenient name val) Request = ParamNotFound++instance Trait (QueryParam Optional Lenient name val) Request where+  type Attribute (QueryParam Optional Lenient name val) Request = Maybe (Either Text val)++instance TraitAbsence (QueryParam Optional Lenient name val) Request where+  type Absence (QueryParam Optional Lenient name val) Request = Void++queryParamHandler ::+  forall name val e p h req.+  (Get h (QueryParam e p name val) Request, ArrowChoice h) =>+  h (Linked req Request, Absence (QueryParam e p name val) Request) Response ->+  Middleware h req (QueryParam e p name val : req)+queryParamHandler errorHandler nextHandler = proc request -> do+  result <- probe QueryParam -< request+  case result of+    Left err -> errorHandler -< (request, err)+    Right val -> nextHandler -< val++{- | Extract a query parameter and convert it to a value of type+ @val@.++ The associated trait attribute has type @val@.++ Example usage:++ > queryParam @"limit" @Integer errorHandler okHandler+-}+queryParam ::+  forall name val h req.+  (Get h (QueryParam Required Strict name val) Request, ArrowChoice h) =>+  h (Linked req Request, Either ParamNotFound ParamParseError) Response ->+  Middleware h req (QueryParam Required Strict name val : req)+queryParam = queryParamHandler++{- | Extract an optional query parameter and convert it to a value of+ type @val@.++ The associated trait attribute has type @Maybe val@; a @Nothing@+ value indicates that the parameter is missing from the request.++ Example usage:++ > optionalQueryParam @"limit" @Integer errorHandler okHandler+-}+optionalQueryParam ::+  forall name val h req.+  (Get h (QueryParam Optional Strict name val) Request, ArrowChoice h) =>+  h (Linked req Request, ParamParseError) Response ->+  Middleware h req (QueryParam Optional Strict name val : req)+optionalQueryParam = queryParamHandler++{- | Extract a query parameter and convert it to a value of type @val@.++ The associated trait attribute has type @Either Text val@. The+ parsing is done leniently and any errors are reported in the trait+ attribute.++ Example usage:++ > lenientQueryParam @"limit" @Integer errorHandler okHandler+-}+lenientQueryParam ::+  forall name val h req.+  (Get h (QueryParam Required Lenient name val) Request, ArrowChoice h) =>+  h (Linked req Request, ParamNotFound) Response ->+  Middleware h req (QueryParam Required Lenient name val : req)+lenientQueryParam = queryParamHandler++{- | Extract a query parameter and convert it to a value of type @val@.++ Example usage:++ > optionalLenientQueryParam @"Content-Length" @Integer handler++ The associated trait attribute has type @Maybe (Either Text+ val)@. The parsing is done leniently. Any parsing errors and+ missing query parameters are reported in the trait attribute.+-}+optionalLenientQueryParam ::+  forall name val h req.+  (Get h (QueryParam Optional Lenient name val) Request, ArrowChoice h) =>+  Middleware h req (QueryParam Optional Lenient name val : req)+optionalLenientQueryParam = queryParamHandler $ arr (absurd . snd)

@@ -0,0 +1,253 @@+-- | Generate responses based on their HTTP status+module WebGear.Core.Trait.Status (+  Status (..),++  -- * Create responses+  mkResponse,+  continue100,+  switchingProtocols101,+  ok200,+  created201,+  accepted202,+  nonAuthoritative203,+  noContent204,+  resetContent205,+  partialContent206,+  multipleChoices300,+  movedPermanently301,+  found302,+  seeOther303,+  notModified304,+  temporaryRedirect307,+  permanentRedirect308,+  badRequest400,+  unauthorized401,+  paymentRequired402,+  forbidden403,+  notFound404,+  methodNotAllowed405,+  notAcceptable406,+  proxyAuthenticationRequired407,+  requestTimeout408,+  conflict409,+  gone410,+  lengthRequired411,+  preconditionFailed412,+  requestEntityTooLarge413,+  requestURITooLong414,+  unsupportedMediaType415,+  requestedRangeNotSatisfiable416,+  expectationFailed417,+  imATeapot418,+  unprocessableEntity422,+  preconditionRequired428,+  tooManyRequests429,+  requestHeaderFieldsTooLarge431,+  internalServerError500,+  notImplemented501,+  badGateway502,+  serviceUnavailable503,+  gatewayTimeout504,+  httpVersionNotSupported505,+  networkAuthenticationRequired511,+) where++import qualified Network.HTTP.Types as HTTP+import WebGear.Core.Response (Response (..))+import WebGear.Core.Trait (Linked, Set, Trait (..), linkzero, plant)++-- | HTTP response status+newtype Status = Status HTTP.Status++instance Trait Status Response where+  type Attribute Status Response = HTTP.Status++-- | Generate a response with the specified status+mkResponse :: Set h Status Response => HTTP.Status -> h () (Linked '[Status] Response)+mkResponse status = proc () -> do+  let response = linkzero $ Response status [] Nothing+  plant (Status status) -< (response, status)++-- | Continue 100 response+continue100 :: Set h Status Response => h () (Linked '[Status] Response)+continue100 = mkResponse HTTP.continue100++-- | Switching Protocols 101 response+switchingProtocols101 :: Set h Status Response => h () (Linked '[Status] Response)+switchingProtocols101 = mkResponse HTTP.switchingProtocols101++-- | OK 200 response+ok200 :: Set h Status Response => h () (Linked '[Status] Response)+ok200 = mkResponse HTTP.ok200++-- | Created 201 response+created201 :: Set h Status Response => h () (Linked '[Status] Response)+created201 = mkResponse HTTP.created201++-- | Accepted 202 response+accepted202 :: Set h Status Response => h () (Linked '[Status] Response)+accepted202 = mkResponse HTTP.accepted202++-- | Non-Authoritative 203 response+nonAuthoritative203 :: Set h Status Response => h () (Linked '[Status] Response)+nonAuthoritative203 = mkResponse HTTP.nonAuthoritative203++-- | No Content 204 response+noContent204 :: Set h Status Response => h () (Linked '[Status] Response)+noContent204 = mkResponse HTTP.noContent204++-- | Reset Content 205 response+resetContent205 :: Set h Status Response => h () (Linked '[Status] Response)+resetContent205 = mkResponse HTTP.resetContent205++-- | Partial Content 206 response+partialContent206 :: Set h Status Response => h () (Linked '[Status] Response)+partialContent206 = mkResponse HTTP.partialContent206++-- | Multiple Choices 300 response+multipleChoices300 :: Set h Status Response => h () (Linked '[Status] Response)+multipleChoices300 = mkResponse HTTP.multipleChoices300++-- | Moved Permanently 301 response+movedPermanently301 :: Set h Status Response => h () (Linked '[Status] Response)+movedPermanently301 = mkResponse HTTP.movedPermanently301++-- | Found 302 response+found302 :: Set h Status Response => h () (Linked '[Status] Response)+found302 = mkResponse HTTP.found302++-- | See Other 303 response+seeOther303 :: Set h Status Response => h () (Linked '[Status] Response)+seeOther303 = mkResponse HTTP.seeOther303++-- | Not Modified 304 response+notModified304 :: Set h Status Response => h () (Linked '[Status] Response)+notModified304 = mkResponse HTTP.notModified304++-- | Temporary Redirect 307 response+temporaryRedirect307 :: Set h Status Response => h () (Linked '[Status] Response)+temporaryRedirect307 = mkResponse HTTP.temporaryRedirect307++-- | Permanent Redirect 308 response+permanentRedirect308 :: Set h Status Response => h () (Linked '[Status] Response)+permanentRedirect308 = mkResponse HTTP.permanentRedirect308++-- | Bad Request 400 response+badRequest400 :: Set h Status Response => h () (Linked '[Status] Response)+badRequest400 = mkResponse HTTP.badRequest400++-- | Unauthorized 401 response+unauthorized401 :: Set h Status Response => h () (Linked '[Status] Response)+unauthorized401 = mkResponse HTTP.unauthorized401++-- | Payment Required 402 response+paymentRequired402 :: Set h Status Response => h () (Linked '[Status] Response)+paymentRequired402 = mkResponse HTTP.paymentRequired402++-- | Forbidden 403 response+forbidden403 :: Set h Status Response => h () (Linked '[Status] Response)+forbidden403 = mkResponse HTTP.forbidden403++-- | Not Found 404 response+notFound404 :: Set h Status Response => h () (Linked '[Status] Response)+notFound404 = mkResponse HTTP.notFound404++-- | Method Not Allowed 405 response+methodNotAllowed405 :: Set h Status Response => h () (Linked '[Status] Response)+methodNotAllowed405 = mkResponse HTTP.methodNotAllowed405++-- | Not Acceptable 406 response+notAcceptable406 :: Set h Status Response => h () (Linked '[Status] Response)+notAcceptable406 = mkResponse HTTP.notAcceptable406++-- | Proxy Authentication Required 407 response+proxyAuthenticationRequired407 :: Set h Status Response => h () (Linked '[Status] Response)+proxyAuthenticationRequired407 = mkResponse HTTP.proxyAuthenticationRequired407++-- | Request Timeout 408 response+requestTimeout408 :: Set h Status Response => h () (Linked '[Status] Response)+requestTimeout408 = mkResponse HTTP.requestTimeout408++-- | Conflict 409 response+conflict409 :: Set h Status Response => h () (Linked '[Status] Response)+conflict409 = mkResponse HTTP.conflict409++-- | Gone 410 response+gone410 :: Set h Status Response => h () (Linked '[Status] Response)+gone410 = mkResponse HTTP.gone410++-- | Length Required 411 response+lengthRequired411 :: Set h Status Response => h () (Linked '[Status] Response)+lengthRequired411 = mkResponse HTTP.lengthRequired411++-- | Precondition Failed 412 response+preconditionFailed412 :: Set h Status Response => h () (Linked '[Status] Response)+preconditionFailed412 = mkResponse HTTP.preconditionFailed412++-- | Request Entity Too Large 413 response+requestEntityTooLarge413 :: Set h Status Response => h () (Linked '[Status] Response)+requestEntityTooLarge413 = mkResponse HTTP.requestEntityTooLarge413++-- | Request URI Too Long 414 response+requestURITooLong414 :: Set h Status Response => h () (Linked '[Status] Response)+requestURITooLong414 = mkResponse HTTP.requestURITooLong414++-- | Unsupported Media Type 415 response+unsupportedMediaType415 :: Set h Status Response => h () (Linked '[Status] Response)+unsupportedMediaType415 = mkResponse HTTP.unsupportedMediaType415++-- | Requested Range Not Satisfiable 416 response+requestedRangeNotSatisfiable416 :: Set h Status Response => h () (Linked '[Status] Response)+requestedRangeNotSatisfiable416 = mkResponse HTTP.requestedRangeNotSatisfiable416++-- | Expectation Failed 417 response+expectationFailed417 :: Set h Status Response => h () (Linked '[Status] Response)+expectationFailed417 = mkResponse HTTP.expectationFailed417++-- | I'm A Teapot 418 response+imATeapot418 :: Set h Status Response => h () (Linked '[Status] Response)+imATeapot418 = mkResponse HTTP.imATeapot418++-- | Unprocessable Entity 422 response+unprocessableEntity422 :: Set h Status Response => h () (Linked '[Status] Response)+unprocessableEntity422 = mkResponse HTTP.unprocessableEntity422++-- | Precondition Required 428 response+preconditionRequired428 :: Set h Status Response => h () (Linked '[Status] Response)+preconditionRequired428 = mkResponse HTTP.preconditionRequired428++-- | Too Many Requests 429 response+tooManyRequests429 :: Set h Status Response => h () (Linked '[Status] Response)+tooManyRequests429 = mkResponse HTTP.tooManyRequests429++-- | Request Header Fields Too Large 431 response+requestHeaderFieldsTooLarge431 :: Set h Status Response => h () (Linked '[Status] Response)+requestHeaderFieldsTooLarge431 = mkResponse HTTP.requestHeaderFieldsTooLarge431++-- | Internal Server Error 500 response+internalServerError500 :: Set h Status Response => h () (Linked '[Status] Response)+internalServerError500 = mkResponse HTTP.internalServerError500++-- | Not Implemented 501 response+notImplemented501 :: Set h Status Response => h () (Linked '[Status] Response)+notImplemented501 = mkResponse HTTP.notImplemented501++-- | Bad Gateway 502 response+badGateway502 :: Set h Status Response => h () (Linked '[Status] Response)+badGateway502 = mkResponse HTTP.badGateway502++-- | Service Unavailable 503 response+serviceUnavailable503 :: Set h Status Response => h () (Linked '[Status] Response)+serviceUnavailable503 = mkResponse HTTP.serviceUnavailable503++-- | Gateway Timeout 504 response+gatewayTimeout504 :: Set h Status Response => h () (Linked '[Status] Response)+gatewayTimeout504 = mkResponse HTTP.gatewayTimeout504++-- | HTTP Version Not Supported 505 response+httpVersionNotSupported505 :: Set h Status Response => h () (Linked '[Status] Response)+httpVersionNotSupported505 = mkResponse HTTP.httpVersionNotSupported505++-- | Network Authentication Required 511 response+networkAuthenticationRequired511 :: Set h Status Response => h () (Linked '[Status] Response)+networkAuthenticationRequired511 = mkResponse HTTP.networkAuthenticationRequired511

@@ -0,0 +1,43 @@+-- | All the traits supported by WebGear.+module WebGear.Core.Traits (+  module WebGear.Core.Trait.Auth.Basic,+  module WebGear.Core.Trait.Auth.JWT,+  module WebGear.Core.Trait.Auth.Common,+  module WebGear.Core.Trait.Body,+  module WebGear.Core.Trait.Header,+  module WebGear.Core.Trait.Method,+  module WebGear.Core.Trait.Path,+  module WebGear.Core.Trait.QueryParam,+  module WebGear.Core.Trait.Status,+  StdHandler,+) where++import WebGear.Core.Handler (Handler)+import WebGear.Core.Request (Request)+import WebGear.Core.Response (Response)+import WebGear.Core.Trait (Gets, Sets)+import WebGear.Core.Trait.Auth.Basic+import WebGear.Core.Trait.Auth.Common+import WebGear.Core.Trait.Auth.JWT+import WebGear.Core.Trait.Body+import WebGear.Core.Trait.Header+import WebGear.Core.Trait.Method+import WebGear.Core.Trait.Path+import WebGear.Core.Trait.QueryParam+import WebGear.Core.Trait.Status++{- | Constraints that include all common traits.++ The type variables are:++ * @h@ - The handler arrow+ * @m@ - The underlying monad of the handler+ * @req@ - List of traits the handler `Gets` from the request+ * @res@ - List of traits the handler `Sets` on the response+-}+type StdHandler h m req res =+  ( Handler h m+  , Gets h [Method, Path, PathEnd] Request+  , Gets h req Request+  , Sets h (Status : res) Response+  )

@@ -0,0 +1,108 @@+cabal-version:       2.4++name:                webgear-core+version:             1.0.0+synopsis:            Composable, type-safe library to build HTTP APIs+description:+        WebGear is a library to for building composable, type-safe HTTP APIs.+        See the documentation of WebGear.Core module to get started.+homepage:            https://github.com/haskell-webgear/webgear-core#readme+bug-reports:         https://github.com/haskell-webgear/webgear-core/issues+author:              Raghu Kaippully+maintainer:          rkaippully@gmail.com+copyright:           2020-2021 Raghu Kaippully+license:             MPL-2.0+license-file:        LICENSE+category:            Web+build-type:          Simple+extra-source-files:  README.md+                     CHANGELOG.md+++source-repository head+  type:      git+  location:  https://github.com/haskell-webgear/webgear-core+++common webgear-common+  default-language:   Haskell2010+  default-extensions: Arrows+                      ConstraintKinds+                      DataKinds+                      DeriveFunctor+                      DeriveGeneric+                      DerivingStrategies+                      DerivingVia+                      FlexibleContexts+                      FlexibleInstances+                      FunctionalDependencies+                      GeneralizedNewtypeDeriving+                      InstanceSigs+                      KindSignatures+                      LambdaCase+                      MultiParamTypeClasses+                      NamedFieldPuns+                      OverloadedStrings+                      OverloadedLists+                      PolyKinds+                      RankNTypes+                      RecordWildCards+                      ScopedTypeVariables+                      StandaloneDeriving+                      TemplateHaskellQuotes+                      TypeApplications+                      TypeFamilies+                      TypeOperators+  build-depends:      base >=4.13.0.0 && <4.17+                    , bytestring >=0.10.10.1 && <0.12+                    , case-insensitive ==1.2.*+                    , filepath ==1.4.*+                    , http-api-data ==0.4.*+                    , http-media ==0.8.*+                    , http-types ==0.12.*+                    , network ==3.1.*+                    , safe-exceptions ==0.1.*+                    , tagged ==0.8.*+                    , template-haskell >=2.15.0.0 && <2.19+                    , text ==1.2.*+                    , unordered-containers ==0.2.*+                    , wai ==3.2.*+  ghc-options:        -Wall+                      -Wno-unticked-promoted-constructors+                      -Wcompat+                      -Widentities+                      -Wincomplete-record-updates+                      -Wincomplete-uni-patterns+                      -Wmissing-fields+                      -Wmissing-home-modules+                      -Wmissing-deriving-strategies+                      -Wpartial-fields+                      -Wredundant-constraints+                      -fshow-warning-groups++  if impl(ghc >= 8.10)+    ghc-options:      -Wunused-packages++library+  import:             webgear-common+  exposed-modules:    WebGear.Core+                    , WebGear.Core.Modifiers+                    , WebGear.Core.Trait+                    , WebGear.Core.Request+                    , WebGear.Core.Response+                    , WebGear.Core.Handler+                    , WebGear.Core.Traits+                    , WebGear.Core.Trait.Auth.Basic+                    , WebGear.Core.Trait.Auth.JWT+                    , WebGear.Core.Trait.Auth.Common+                    , WebGear.Core.Trait.Body+                    , WebGear.Core.Trait.Header+                    , WebGear.Core.Trait.Method+                    , WebGear.Core.Trait.Path+                    , WebGear.Core.Trait.QueryParam+                    , WebGear.Core.Trait.Status+                    , WebGear.Core.Handler.Static+  hs-source-dirs:     src+  build-depends:      arrows ==0.4.*+                    , jose >=0.8.3.1 && <0.10+                    , mime-types ==0.1.*