packages feed

webgear-core 1.2.0 → 1.3.0

raw patch · 14 files changed

+275/−328 lines, 14 filesdep ~network

Dependency ranges changed: network

Files

CHANGELOG.md view
@@ -2,6 +2,11 @@  ## [Unreleased] +## [1.3.0] - 2024-06-13++### Changed+- Simplify core API (breaking change) (#47)+ ## [1.2.0] - 2024-03-18  ### Added@@ -58,7 +63,8 @@ - Extracted webgear-core from webgear-server - New arrow based API -[Unreleased]: https://github.com/haskell-webgear/webgear/compare/v1.2.0...HEAD+[Unreleased]: https://github.com/haskell-webgear/webgear/compare/v1.3.0...HEAD+[1.3.0]: https://github.com/haskell-webgear/webgear/releases/tag/v1.3.0 [1.2.0]: https://github.com/haskell-webgear/webgear/releases/tag/v1.2.0 [1.1.1]: https://github.com/haskell-webgear/webgear/releases/tag/v1.1.1 [1.1.0]: https://github.com/haskell-webgear/webgear/releases/tag/v1.1.0
src/WebGear/Core/Trait.hs view
@@ -3,11 +3,12 @@ {- | 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.+ value. This trait exists only if the list is non-empty.   Traits help to associate attributes with values in a type-safe- manner.+ manner. WebGear associates traits with 'Request's and 'Response's to+ ensure certian attributes are present in them and access those with+ safety.   Traits are somewhat similar to [refinement  types](https://hackage.haskell.org/package/refined), but allow@@ -45,8 +46,8 @@ -} module WebGear.Core.Trait (   -- * Core Types-  Trait (..),-  TraitAbsence (..),+  Attribute,+  Absence,   Prerequisite,   Get (..),   Gets,@@ -72,67 +73,67 @@ import Data.Kind (Constraint, Type) import Data.Tagged (Tagged (..), untag) import GHC.TypeLits (ErrorMessage (..), TypeError)+import WebGear.Core.Request (Request)+import WebGear.Core.Response (Response) --- | 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+{- | Type of the associated attribute when the trait @t@ holds for a+   value @a@.+-}+type family 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+{- | Type that indicates that the trait does not exist on a+   request. This could be an error message, exception etc.+-}+type family Absence t :: Type  {- | Indicates the constraints a trait depends upon as a-prerequisite. This is used to assert that a trait @t@ can be-extracted from a value @a@ only if one or more other traits are-present in the trait list @ts@ associated with it.+   prerequisite. This is used to assert that a trait @t@ can be+   extracted from a request only if one or more other traits are+   present in the trait list @ts@ associated with it. -If a trait does not depend on other traits this can be set to the-empty contraint @()@.+   If a trait does not depend on other traits this can be set to the+   empty contraint @()@. -}-type family Prerequisite (t :: Type) (ts :: [Type]) (a :: Type) :: Constraint+type family Prerequisite (t :: Type) (ts :: [Type]) :: Constraint --- | Extract trait attributes from a value.-class (Arrow h, TraitAbsence t a) => Get h t a where-  -- | Attempt to witness the trait attribute from the value @a@.+-- | Extract trait attributes from a request.+class (Arrow h) => Get h t where+  -- | Attempt to witness the trait attribute from the request.   getTrait ::-    (Prerequisite t ts a) =>+    (Prerequisite t ts) =>     -- | The trait to witness     t ->     -- | Arrow that attemtps to witness the trait and can possibly     -- fail-    h (a `With` ts) (Either (Absence t a) (Attribute t a))+    h (Request `With` ts) (Either (Absence t) (Attribute t Request)) --- | Associate 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 \`With\` ts@.+-- | Associate a trait attribute on a response+class (Arrow h) => Set h (t :: Type) where+  -- | Set a trait attribute @t@ on the value @Response \`With\` ts@.   setTrait ::     -- | The trait to set     t ->-    -- | A function to generate a witnessed value. This function must-    -- be called by the `setTrait` implementation to generate a-    -- witnessed value.-    (a `With` ts -> a -> Attribute t a -> a `With` (t : ts)) ->+    -- | A function to generate a witnessed response. This function+    -- must be called by the `setTrait` implementation to generate a+    -- witnessed response.+    (Response `With` ts -> Response -> Attribute t Response -> Response `With` (t : ts)) ->     -- | An arrow that attaches a new trait attribute to a witnessed     -- value.-    h (a `With` ts, Attribute t a) (a `With` (t : ts))+    h (Response `With` ts, Attribute t Response) (Response `With` (t : ts)) -{- | @Gets h ts a@ is equivalent to @(Get h t1 a, Get h t2 a, ..., Get- h tn a)@ where @ts = [t1, t2, ..., tn]@.+{- | @Gets h ts@ is equivalent to @(Get h t1, Get h t2, ..., Get h tn)@+ 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)+type family Gets h ts :: Constraint where+  Gets h '[] = ()+  Gets h (t : ts) = (Get h t, Gets h ts) -{- | @Sets h ts a@ is equivalent to @(Set h t1 a, Set h t2 a, ..., Set- h tn a)@ where @ts = [t1, t2, ..., tn]@.+{- | @Sets h ts@ is equivalent to @(Set h t1, Set h t2, ..., Set h tn)@+   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)+type family Sets h ts :: Constraint where+  Sets h '[] = ()+  Sets h (t : ts) = (Set h t, Sets h ts)  {- | A value associated with a list of traits, referred to as a witnessed value. Typically, this is used as an infix type constructor:@@ -175,35 +176,35 @@ wminus (With (_, rv) a) = With rv a {-# INLINE wminus #-} -{- | Attempt to witness an additional trait with a witnessed value. This- can fail indicating an 'Absence' of the trait.+{- | Attempt to witness an additional trait with a witnessed+   request. This can fail indicating an 'Absence' of the trait. -} probe ::-  forall t ts h a.-  (Get h t a, Prerequisite t ts a) =>+  forall t ts h.+  (Get h t, Prerequisite t ts) =>   t ->-  h (a `With` ts) (Either (Absence t a) (a `With` (t : ts)))+  h (Request `With` ts) (Either (Absence t) (Request `With` (t : ts))) probe t = proc l -> do   res <- getTrait t -< l   arr add -< (l, res)   where-    add :: (a `With` ts, Either e (Attribute t a)) -> Either e (a `With` (t : ts))+    add :: (Request `With` ts, Either e (Attribute t Request)) -> Either e (Request `With` (t : ts))     add (_, Left e) = Left e     add (With{..}, Right attr) = Right $ With{attribute = (attr, attribute), ..} {-# INLINE probe #-} -{- | Set a trait attribute on witnessed value to produce another-   witnessed value with the additional trait attached to it.+{- | Set a trait attribute on witnessed response to produce another+   witnessed response with the additional trait attached to it. -} plant ::-  forall t ts h a.-  (Set h t a) =>+  forall t ts h.+  (Set h t) =>   t ->-  h (a `With` ts, Attribute t a) (a `With` (t : ts))+  h (Response `With` ts, Attribute t Response) (Response `With` (t : ts)) plant t = proc (l, attr) -> do   setTrait t add -< (l, attr)   where-    add :: a `With` ts -> a -> Attribute t a -> a `With` (t : ts)+    add :: Response `With` ts -> Response -> Attribute t Response -> Response `With` (t : ts)     add With{..} a' attr = With{attribute = (attr, attribute), unwitness = a'} {-# INLINE plant #-}
src/WebGear/Core/Trait/Auth/Basic.hs view
@@ -32,9 +32,14 @@  authConfig :: 'BasicAuth' IO () 'Credentials'  authConfig = 'BasicAuth'' { toBasicAttribute = pure . Right } - type ErrorTraits = [Status, RequiredRequestHeader \"Content-Type\" Text, RequiredRequestHeader \"WWW-Authenticate\" Text, Body Text]+ type ErrorTraits =+  [ Status+  , RequiredResponseHeader \"Content-Type\" Text+  , RequiredResponseHeader \"WWW-Authenticate\" Text+  , Body Text+  ] - errorHandler :: ('Handler' h IO, Sets h ErrorTraits Response)+ errorHandler :: ('Handler' h IO, Sets h ErrorTraits)               => h (Request \`With\` ts, 'BasicAuthError' e) Response  errorHandler = 'respondUnauthorized' \"Basic\" \"MyRealm\"  @@@ -42,7 +47,7 @@  we can add basic authentication to @myHandler@:   @- myHandlerWithAuth :: ('Handler' h IO, Get h ('BasicAuth' IO () 'Credentials') Request, Sets h ErrorTraits Response)+ myHandlerWithAuth :: ('Handler' h IO, Get h ('BasicAuth' IO () 'Credentials'), Sets h ErrorTraits)                    => 'RequestHandler' h ts  myHandlerWithAuth = 'basicAuth' authConfig errorHandler myHandler  @@@ -124,29 +129,23 @@   | 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+type instance Attribute (BasicAuth' Required scheme m e a) Request = a+type instance Absence (BasicAuth' Required scheme m e a) = BasicAuthError e -instance TraitAbsence (BasicAuth' Optional scheme m e a) Request where-  type Absence (BasicAuth' Optional scheme m e a) Request = Void+type instance Attribute (BasicAuth' Optional scheme m e a) Request = Either (BasicAuthError e) a+type instance Absence (BasicAuth' Optional scheme m e a) = Void  type instance-  Prerequisite (BasicAuth' x scheme m e a) ts Request =+  Prerequisite (BasicAuth' x scheme m e a) ts =     HasTrait (AuthorizationHeader scheme) ts  basicAuthMiddleware ::   ( ArrowChoice h-  , Get h (BasicAuth' x scheme m e t) Request+  , Get h (BasicAuth' x scheme m e t)   , HasTrait (AuthorizationHeader scheme) ts   ) =>   BasicAuth' x scheme m e t ->-  h (Request `With` ts, Absence (BasicAuth' x scheme m e t) Request) Response ->+  h (Request `With` ts, Absence (BasicAuth' x scheme m e t)) Response ->   Middleware h ts (BasicAuth' x scheme m e t : ts) basicAuthMiddleware authCfg errorHandler nextHandler =   proc request -> do@@ -169,7 +168,7 @@ basicAuth ::   forall m e t h ts.   ( ArrowChoice h-  , Get h (BasicAuth' Required "Basic" m e t) Request+  , Get h (BasicAuth' Required "Basic" m e t)   , HasTrait (AuthorizationHeader "Basic") ts   ) =>   -- | Authentication configuration@@ -189,7 +188,7 @@ basicAuth' ::   forall scheme m e t h ts.   ( ArrowChoice h-  , Get h (BasicAuth' Required scheme m e t) Request+  , Get h (BasicAuth' Required scheme m e t)   , HasTrait (AuthorizationHeader scheme) ts   ) =>   -- | Authentication configuration@@ -214,7 +213,7 @@ optionalBasicAuth ::   forall m e t h ts.   ( ArrowChoice h-  , Get h (BasicAuth' Optional "Basic" m e t) Request+  , Get h (BasicAuth' Optional "Basic" m e t)   , HasTrait (AuthorizationHeader "Basic") ts   ) =>   -- | Authentication configuration@@ -233,7 +232,7 @@ optionalBasicAuth' ::   forall scheme m e t h ts.   ( ArrowChoice h-  , Get h (BasicAuth' Optional scheme m e t) Request+  , Get h (BasicAuth' Optional scheme m e t)   , HasTrait (AuthorizationHeader scheme) ts   ) =>   -- | Authentication configuration
src/WebGear/Core/Trait/Auth/Common.hs view
@@ -72,7 +72,6 @@       , RequiredResponseHeader "WWW-Authenticate" Text       , Body PlainText Text       ]-      Response   ) =>   -- | The authentication scheme   CI ByteString ->
src/WebGear/Core/Trait/Auth/JWT.hs view
@@ -36,9 +36,14 @@    , toJWTAttribute = pure . Right    } - type ErrorTraits = [Status, RequiredRequestHeader \"Content-Type\" Text, RequiredRequestHeader \"WWW-Authenticate\" Text, Body Text]+ type ErrorTraits =+  [ Status+  , RequiredResponseHeader \"Content-Type\" Text+  , RequiredResponseHeader \"WWW-Authenticate\" Text+  , Body Text+  ] - errorHandler :: ('Handler' h IO, Sets h ErrorTraits Response)+ errorHandler :: ('Handler' h IO, Sets h ErrorTraits)               => h (Request \`With\` ts, 'JWTAuthError' e) Response  errorHandler = 'respondUnauthorized' \"Bearer\" \"MyRealm\"  @@@ -46,7 +51,7 @@  we can add JWT authentication to @myHandler@:   @- myHandlerWithAuth :: ('Handler' h IO, Get h ('JWTAuth' IO () 'JWT.ClaimsSet') Request, Sets h ErrorTraits Response)+ myHandlerWithAuth :: ('Handler' h IO, Get h ('JWTAuth' IO () 'JWT.ClaimsSet'), Sets h ErrorTraits)                    => 'RequestHandler' h ts  myHandlerWithAuth = 'jwtAuth' authConfig errorHandler myHandler  @@@ -116,20 +121,14 @@   | JWTAuthAttributeError e   deriving stock (Eq, Show) -instance Trait (JWTAuth' Required scheme m e a) Request where-  type Attribute (JWTAuth' Required scheme m e a) Request = a--instance TraitAbsence (JWTAuth' Required scheme m e a) Request where-  type Absence (JWTAuth' Required scheme m e a) Request = JWTAuthError e--instance Trait (JWTAuth' Optional scheme m e a) Request where-  type Attribute (JWTAuth' Optional scheme m e a) Request = Either (JWTAuthError e) a+type instance Attribute (JWTAuth' Required scheme m e a) Request = a+type instance Absence (JWTAuth' Required scheme m e a) = JWTAuthError e -instance TraitAbsence (JWTAuth' Optional scheme m e a) Request where-  type Absence (JWTAuth' Optional scheme m e a) Request = Void+type instance Attribute (JWTAuth' Optional scheme m e a) Request = Either (JWTAuthError e) a+type instance Absence (JWTAuth' Optional scheme m e a) = Void  type instance-  Prerequisite (JWTAuth' x scheme m e a) ts Request =+  Prerequisite (JWTAuth' x scheme m e a) ts =     HasTrait (AuthorizationHeader scheme) ts  {- | Middleware to add JWT authentication protection for a@@ -148,7 +147,7 @@ -} jwtAuth ::   ( ArrowChoice h-  , Get h (JWTAuth m e t) Request+  , Get h (JWTAuth m e t)   , HasTrait (AuthorizationHeader "Bearer") ts   ) =>   -- | Authentication configuration@@ -176,7 +175,7 @@ -} optionalJWTAuth ::   ( ArrowChoice h-  , Get h (JWTAuth' Optional "Bearer" m e t) Request+  , Get h (JWTAuth' Optional "Bearer" m e t)   , HasTrait (AuthorizationHeader "Bearer") ts   ) =>   -- | Authentication configuration@@ -188,11 +187,11 @@ jwtAuthMiddleware ::   forall scheme e t x h m ts.   ( ArrowChoice h-  , Get h (JWTAuth' x scheme m e t) Request+  , Get h (JWTAuth' x scheme m e t)   , HasTrait (AuthorizationHeader scheme) ts   ) =>   JWTAuth' x scheme m e t ->-  h (Request `With` ts, Absence (JWTAuth' x scheme m e t) Request) Response ->+  h (Request `With` ts, Absence (JWTAuth' x scheme m e t)) Response ->   Middleware h ts (JWTAuth' x scheme m e t : ts) jwtAuthMiddleware authCfg errorHandler nextHandler =   proc request -> do@@ -219,7 +218,7 @@ jwtAuth' ::   forall scheme e t h m ts.   ( ArrowChoice h-  , Get h (JWTAuth' Required scheme m e t) Request+  , Get h (JWTAuth' Required scheme m e t)   , HasTrait (AuthorizationHeader scheme) ts   ) =>   -- | Authentication configuration@@ -248,7 +247,7 @@ optionalJWTAuth' ::   forall scheme e t h m ts.   ( ArrowChoice h-  , Get h (JWTAuth' Optional scheme m e t) Request+  , Get h (JWTAuth' Optional scheme m e t)   , HasTrait (AuthorizationHeader scheme) ts   ) =>   -- | Authentication configuration
src/WebGear/Core/Trait/Body.hs view
@@ -1,17 +1,17 @@ {- | Traits and middlewares to handle request and response body    payloads. - The 'requestBody' middleware attempts to convert the body to a- Haskell value or invoke an error handler if that fails.+   The 'requestBody' middleware attempts to convert the body to a+   Haskell value or invoke an error handler if that fails. - The 'respondA' middleware generates a response from an HTTP status- and a response body.+   The 'respondA' middleware generates a response from an HTTP status+   and a response body. - If you need finer control over setting the body, use 'setBody' or- 'setBodyWithoutContentType'. These arrows accept a witnessed 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.+   If you need finer control over setting the body, use 'setBody' or+   'setBodyWithoutContentType'. These arrows accept a witnessed+   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@@ -36,12 +36,12 @@ import WebGear.Core.Request (Request) import WebGear.Core.Response (Response, ResponseBody) import WebGear.Core.Trait (+  Absence,+  Attribute,   Get,   Prerequisite,   Set,   Sets,-  Trait (..),-  TraitAbsence (..),   With (..),   plant,   probe,@@ -52,22 +52,16 @@ -- | Request or response body with MIME types @mimeTypes@ and type @t@. newtype Body (mimeType :: Type) (t :: Type) = Body mimeType -instance Trait (Body mt t) Request where-  type Attribute (Body mt t) Request = t--instance TraitAbsence (Body mt t) Request where-  type Absence (Body mt t) Request = Text--type instance Prerequisite (Body mt t) ts Request = ()+type instance Attribute (Body mt t) Request = t+type instance Absence (Body mt t) = Text+type instance Prerequisite (Body mt t) ts = () -instance Trait (Body mt t) Response where-  type Attribute (Body mt t) Response = t+type instance Attribute (Body mt t) Response = t  -- | Type representing responses without a statically known MIME type data UnknownContentBody = UnknownContentBody -instance Trait UnknownContentBody Response where-  type Attribute UnknownContentBody Response = ResponseBody+type instance Attribute UnknownContentBody Response = ResponseBody  {- | Middleware to extract a request body. @@ -83,7 +77,7 @@ requestBody ::   forall t mt h m ts.   ( Handler h m-  , Get h (Body mt t) Request+  , Get h (Body mt t)   ) =>   mt ->   -- | Error handler in case body cannot be retrieved@@ -110,7 +104,7 @@ -} setBody ::   forall body mt h ts.-  ( Sets h [Body mt body, RequiredResponseHeader "Content-Type" Text] Response+  ( Sets h [Body mt body, RequiredResponseHeader "Content-Type" Text]   , MIMEType mt   ) =>   mt ->@@ -132,7 +126,7 @@ -} setBodyWithoutContentType ::   forall h ts.-  (Set h UnknownContentBody Response) =>+  (Set h UnknownContentBody) =>   h (Response `With` ts, ResponseBody) (Response `With` (UnknownContentBody : ts)) setBodyWithoutContentType = plant UnknownContentBody {-# INLINE setBodyWithoutContentType #-}@@ -151,7 +145,7 @@ respondA ::   forall body mt h m.   ( Handler h m-  , Sets h [Status, Body mt body, RequiredResponseHeader "Content-Type" Text] Response+  , Sets h [Status, Body mt body, RequiredResponseHeader "Content-Type" Text]   , MIMEType mt   ) =>   -- | Response status
src/WebGear/Core/Trait/Cookie.hs view
@@ -23,12 +23,12 @@ import WebGear.Core.Request (Request) import WebGear.Core.Response (Response) import WebGear.Core.Trait (+  Absence,+  Attribute,   Get,   HasTrait,   Prerequisite,   Set,-  Trait (..),-  TraitAbsence (..),   With,   plant,   probe,@@ -46,30 +46,23 @@ -- | Trait for a cookie in HTTP requests data Cookie (e :: Existence) (name :: Symbol) (val :: Type) = Cookie -instance Trait (Cookie Required name val) Request where-  type Attribute (Cookie Required name val) Request = val-+type instance Attribute (Cookie Required name val) Request = val+type instance Absence (Cookie Required name val) = Either CookieNotFound CookieParseError type instance-  Prerequisite (Cookie e name val) ts Request =+  Prerequisite (Cookie e name val) ts =     HasTrait (RequestHeader e Strict "Cookie" Text) ts -instance TraitAbsence (Cookie Required name val) Request where-  type Absence (Cookie Required name val) Request = Either CookieNotFound CookieParseError--instance Trait (Cookie Optional name val) Request where-  type Attribute (Cookie Optional name val) Request = Maybe val--instance TraitAbsence (Cookie Optional name val) Request where-  type Absence (Cookie Optional name val) Request = CookieParseError+type instance Attribute (Cookie Optional name val) Request = Maybe val+type instance Absence (Cookie Optional name val) = CookieParseError  cookieHandler ::   forall name val e h ts.   ( ArrowChoice h-  , Get h (Cookie e name val) Request+  , Get h (Cookie e name val)   , HasTrait (RequestHeader e Strict "Cookie" Text) ts   ) =>   -- | error handler-  h (Request `With` ts, Absence (Cookie e name val) Request) Response ->+  h (Request `With` ts, Absence (Cookie e name val)) Response ->   Middleware h ts (Cookie e name val : ts) cookieHandler errorHandler nextHandler = proc request -> do   result <- probe Cookie -< request@@ -89,7 +82,7 @@ cookie ::   forall name val h ts.   ( ArrowChoice h-  , Get h (Cookie Required name val) Request+  , Get h (Cookie Required name val)   , HasTrait (RequestHeader Required Strict "Cookie" Text) ts   ) =>   -- | Error handler@@ -110,7 +103,7 @@ optionalCookie ::   forall name val h ts.   ( ArrowChoice h-  , Get h (Cookie Optional name val) Request+  , Get h (Cookie Optional name val)   , HasTrait (RequestHeader Optional Strict "Cookie" Text) ts   ) =>   -- | Error handler@@ -122,11 +115,9 @@ -- | Trait for a cookie in HTTP responses data SetCookie (e :: Existence) (name :: Symbol) = SetCookie -instance Trait (SetCookie Required name) Response where-  type Attribute (SetCookie Required name) Response = Cookie.SetCookie+type instance Attribute (SetCookie Required name) Response = Cookie.SetCookie -instance Trait (SetCookie Optional name) Response where-  type Attribute (SetCookie Optional name) Response = Maybe Cookie.SetCookie+type instance Attribute (SetCookie Optional name) Response = Maybe Cookie.SetCookie  {- | Set a cookie value in a response. @@ -136,7 +127,7 @@ -} setCookie ::   forall name h ts.-  (Set h (SetCookie Required name) Response) =>+  (Set h (SetCookie Required name)) =>   h (Response `With` ts, Cookie.SetCookie) (Response `With` (SetCookie Required name : ts)) setCookie = plant SetCookie {-# INLINE setCookie #-}@@ -153,7 +144,7 @@ -} setOptionalCookie ::   forall name h ts.-  (Set h (SetCookie Optional name) Response) =>+  (Set h (SetCookie Optional name)) =>   h (Response `With` ts, Maybe Cookie.SetCookie) (Response `With` (SetCookie Optional name : ts)) setOptionalCookie = plant SetCookie {-# INLINE setOptionalCookie #-}
src/WebGear/Core/Trait/Header.hs view
@@ -61,11 +61,11 @@ import WebGear.Core.Request (Request, requestHeader) import WebGear.Core.Response (Response) import WebGear.Core.Trait (+  Absence,+  Attribute,   Get (..),   Prerequisite,   Set,-  Trait (..),-  TraitAbsence (..),   With,   plant,   probe,@@ -80,10 +80,10 @@ 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.+{- | A trait for capturing an HTTP request header of specified @name@+ and converting it to some type @val@. The modifiers @e@ and @p@+ determine how the missing headers and parsing errors are handled. The+ header name is compared case-insensitively. -} data RequestHeader (e :: Existence) (p :: ParseStyle) (name :: Symbol) (val :: Type) = RequestHeader @@ -93,37 +93,25 @@ -- | A `RequestHeader` that is optional and parsed strictly type OptionalRequestHeader = RequestHeader Optional Strict -instance Trait (RequestHeader Required Strict name val) Request where-  type Attribute (RequestHeader Required Strict name val) Request = val--instance TraitAbsence (RequestHeader Required Strict name val) Request where-  type Absence (RequestHeader Required Strict name val) Request = Either HeaderNotFound HeaderParseError--instance Trait (RequestHeader Optional Strict name val) Request where-  type Attribute (RequestHeader Optional Strict name val) Request = Maybe val--instance TraitAbsence (RequestHeader Optional Strict name val) Request where-  type Absence (RequestHeader Optional Strict name val) Request = HeaderParseError--instance Trait (RequestHeader Required Lenient name val) Request where-  type Attribute (RequestHeader Required Lenient name val) Request = Either Text val+type instance Attribute (RequestHeader Required Strict name val) Request = val+type instance Absence (RequestHeader Required Strict name val) = Either HeaderNotFound HeaderParseError -instance TraitAbsence (RequestHeader Required Lenient name val) Request where-  type Absence (RequestHeader Required Lenient name val) Request = HeaderNotFound+type instance Attribute (RequestHeader Optional Strict name val) Request = Maybe val+type instance Absence (RequestHeader Optional Strict name val) = HeaderParseError -instance Trait (RequestHeader Optional Lenient name val) Request where-  type Attribute (RequestHeader Optional Lenient name val) Request = Maybe (Either Text val)+type instance Attribute (RequestHeader Required Lenient name val) Request = Either Text val+type instance Absence (RequestHeader Required Lenient name val) = HeaderNotFound -instance TraitAbsence (RequestHeader Optional Lenient name val) Request where-  type Absence (RequestHeader Optional Lenient name val) Request = Void+type instance Attribute (RequestHeader Optional Lenient name val) Request = Maybe (Either Text val)+type instance Absence (RequestHeader Optional Lenient name val) = Void -type instance Prerequisite (RequestHeader e p name val) ts Request = ()+type instance Prerequisite (RequestHeader e p name val) ts = ()  headerHandler ::   forall name val e p h ts.-  (Get h (RequestHeader e p name val) Request, ArrowChoice h) =>+  (Get h (RequestHeader e p name val), ArrowChoice h) =>   -- | error handler-  h (Request `With` ts, Absence (RequestHeader e p name val) Request) Response ->+  h (Request `With` ts, Absence (RequestHeader e p name val)) Response ->   Middleware h ts (RequestHeader e p name val : ts) headerHandler errorHandler nextHandler = proc request -> do   result <- probe RequestHeader -< request@@ -132,79 +120,82 @@     Right val -> nextHandler -< val {-# INLINE headerHandler #-} -{- | Extract a header value and convert it to a value of type @val@.+{- | Extract a request header value and convert it to a value of type+   @val@. - The associated trait attribute has type @val@.+   The associated trait attribute has type @val@. - Example usage:+   Example usage: - > header @"Content-Length" @Integer errorHandler okHandler+   > header @"Content-Length" @Integer errorHandler okHandler -} header ::   forall name val h ts.-  (Get h (RequestHeader Required Strict name val) Request, ArrowChoice h) =>+  (Get h (RequestHeader Required Strict name val), ArrowChoice h) =>   -- | Error handler   h (Request `With` ts, Either HeaderNotFound HeaderParseError) Response ->   Middleware h ts (RequestHeader Required Strict name val : ts) header = headerHandler {-# INLINE header #-} -{- | Extract an optional header value and convert it to a value of type- @val@.+{- | Extract an optional request 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.+   The associated trait attribute has type @Maybe val@; a @Nothing@+   value indicates that the header is missing from the request. - Example usage:+   Example usage: - > optionalHeader @"Content-Length" @Integer errorHandler okHandler+   > optionalHeader @"Content-Length" @Integer errorHandler okHandler -} optionalHeader ::   forall name val h ts.-  (Get h (RequestHeader Optional Strict name val) Request, ArrowChoice h) =>+  (Get h (RequestHeader Optional Strict name val), ArrowChoice h) =>   -- | Error handler   h (Request `With` ts, HeaderParseError) Response ->   Middleware h ts (RequestHeader Optional Strict name val : ts) optionalHeader = headerHandler {-# INLINE optionalHeader #-} -{- | Extract a header value and convert it to a value of type @val@.+{- | Extract a request 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.+   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:+   Example usage: - > lenientHeader @"Content-Length" @Integer errorHandler okHandler+   > lenientHeader @"Content-Length" @Integer errorHandler okHandler -} lenientHeader ::   forall name val h ts.-  (Get h (RequestHeader Required Lenient name val) Request, ArrowChoice h) =>+  (Get h (RequestHeader Required Lenient name val), ArrowChoice h) =>   -- | Error handler   h (Request `With` ts, HeaderNotFound) Response ->   Middleware h ts (RequestHeader Required Lenient name val : ts) lenientHeader = headerHandler {-# INLINE lenientHeader #-} -{- | Extract a header value and convert it to a value of type @val@.+{- | Extract a request 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.+   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:+   Example usage: - > optionalLenientHeader @"Content-Length" @Integer handler+   > optionalLenientHeader @"Content-Length" @Integer handler -} optionalLenientHeader ::   forall name val h ts.-  (Get h (RequestHeader Optional Lenient name val) Request, ArrowChoice h) =>+  (Get h (RequestHeader Optional Lenient name val), ArrowChoice h) =>   Middleware h ts (RequestHeader Optional Lenient name val : ts) optionalLenientHeader = headerHandler $ arr (absurd . snd) {-# INLINE optionalLenientHeader #-} -{- | A 'Trait' for setting a header in the HTTP response. It has a+{- | A trait for setting a header in the HTTP response. It has a  specified @name@ and a value of type @val@. The header name is  compared case-insensitively. The modifier @e@ determines whether the  header is mandatory or optional.@@ -217,11 +208,9 @@ -- | A `ResponseHeader` that is optional type OptionalResponseHeader = ResponseHeader Optional -instance Trait (ResponseHeader Required name val) Response where-  type Attribute (ResponseHeader Required name val) Response = val+type instance Attribute (ResponseHeader Required name val) Response = val -instance Trait (ResponseHeader Optional name val) Response where-  type Attribute (ResponseHeader Optional name val) Response = Maybe val+type instance Attribute (ResponseHeader Optional name val) Response = Maybe val  {- | Set a header value in a response. @@ -231,7 +220,7 @@ -} setHeader ::   forall name val h ts.-  (Set h (ResponseHeader Required name val) Response) =>+  (Set h (ResponseHeader Required name val)) =>   h (Response `With` ts, val) (Response `With` (ResponseHeader Required name val : ts)) setHeader = plant ResponseHeader {-# INLINE setHeader #-}@@ -248,7 +237,7 @@ -} setOptionalHeader ::   forall name val h ts.-  (Set h (ResponseHeader Optional name val) Response) =>+  (Set h (ResponseHeader Optional name val)) =>   h (Response `With` ts, Maybe val) (Response `With` (ResponseHeader Optional name val : ts)) setOptionalHeader = plant ResponseHeader {-# INLINE setOptionalHeader #-}
src/WebGear/Core/Trait/Method.hs view
@@ -10,9 +10,9 @@ import qualified Network.HTTP.Types as HTTP import WebGear.Core.Handler (Middleware, RouteMismatch, routeMismatch) import WebGear.Core.Request (Request)-import WebGear.Core.Trait (Get (..), Prerequisite, Trait (..), TraitAbsence (..), probe)+import WebGear.Core.Trait (Absence, Attribute, Get (..), Prerequisite, probe) --- | A 'Trait' for capturing the HTTP method of a request+-- | A trait for capturing the HTTP method of a request newtype Method = Method HTTP.StdMethod  -- | Failure to match method against an expected value@@ -21,13 +21,9 @@   , actualMethod :: HTTP.Method   } -instance Trait Method Request where-  type Attribute Method Request = HTTP.StdMethod--instance TraitAbsence Method Request where-  type Absence Method Request = MethodMismatch--type instance Prerequisite Method ts Request = ()+type instance Attribute Method Request = HTTP.StdMethod+type instance Absence Method = MethodMismatch+type instance Prerequisite Method ts = ()  {- | Check whether the request has a specified HTTP method. @@ -43,7 +39,7 @@  cases where both an HTTP method and a path need to be matched. -} method ::-  (Get h Method Request, ArrowChoice h, ArrowError RouteMismatch h) =>+  (Get h Method, ArrowChoice h, ArrowError RouteMismatch h) =>   HTTP.StdMethod ->   Middleware h ts (Method : ts) method m nextHandler = probe (Method m) >>> routeMismatch ||| nextHandler
src/WebGear/Core/Trait/Path.hs view
@@ -29,7 +29,7 @@ import Language.Haskell.TH.Syntax (Exp (..), Lit (..), Q, TyLit (StrTyLit), Type (..), mkName) import WebGear.Core.Handler (Middleware, RouteMismatch, routeMismatch) import WebGear.Core.Request (Request)-import WebGear.Core.Trait (Get, Prerequisite, Trait (..), TraitAbsence (..), probe)+import WebGear.Core.Trait (Absence, Attribute, Get, Prerequisite, probe) import WebGear.Core.Trait.Method (method) import Prelude hiding (drop, filter, take) @@ -38,13 +38,9 @@ -} newtype Path = Path Text -instance Trait Path Request where-  type Attribute Path Request = ()--instance TraitAbsence Path Request where-  type Absence Path Request = ()--type instance Prerequisite Path ts Request = ()+type instance Attribute Path Request = ()+type instance Absence Path = ()+type instance Prerequisite Path ts = ()  {- | A path variable that is extracted and converted to a value of  type @val@. The @tag@ is usually a type-level symbol (string) to@@ -56,24 +52,16 @@ 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--type instance Prerequisite (PathVar tag val) ts Request = ()+type instance Attribute (PathVar tag val) Request = val+type instance Absence (PathVar tag val) = PathVarError+type instance Prerequisite (PathVar tag val) ts = ()  -- | 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 = ()--type instance Prerequisite PathEnd ts Request = ()+type instance Attribute PathEnd Request = ()+type instance Absence PathEnd = ()+type instance Prerequisite PathEnd ts = ()  {- | A middleware that literally matches path @s@. @@ -87,7 +75,7 @@  > path "a/b/c" handler -} path ::-  (Get h Path Request, ArrowChoice h, ArrowError RouteMismatch h) =>+  (Get h Path, ArrowChoice h, ArrowError RouteMismatch h) =>   Text ->   Middleware h ts (Path : ts) path s nextHandler = probe (Path s) >>> routeMismatch ||| nextHandler@@ -107,14 +95,14 @@ -} pathVar ::   forall tag val h ts.-  (Get h (PathVar tag val) Request, ArrowChoice h, ArrowError RouteMismatch h) =>+  (Get h (PathVar tag val), ArrowChoice h, ArrowError RouteMismatch h) =>   Middleware h ts (PathVar tag val : ts) pathVar nextHandler = probe PathVar >>> routeMismatch ||| nextHandler {-# INLINE pathVar #-}  -- | A middleware that verifies that end of path is reached. pathEnd ::-  (Get h PathEnd Request, ArrowChoice h, ArrowError RouteMismatch h) =>+  (Get h PathEnd, ArrowChoice h, ArrowError RouteMismatch h) =>   Middleware h ts (PathEnd : ts) pathEnd nextHandler = probe PathEnd >>> routeMismatch ||| nextHandler {-# INLINE pathEnd #-}
src/WebGear/Core/Trait/QueryParam.hs view
@@ -43,7 +43,7 @@ import WebGear.Core.Modifiers (Existence (..), ParseStyle (..)) import WebGear.Core.Request (Request) import WebGear.Core.Response (Response)-import WebGear.Core.Trait (Get, Prerequisite, Trait (..), TraitAbsence (..), With, probe)+import WebGear.Core.Trait (Absence, Attribute, Get, Prerequisite, With, probe)  {- | Capture a query parameter with a specified @name@ and convert it to  a value of type @val@. The type parameter @e@ denotes whether the@@ -67,36 +67,24 @@ 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+type instance Attribute (QueryParam Required Strict name val) Request = val+type instance Absence (QueryParam Required Strict name val) = Either ParamNotFound ParamParseError -instance TraitAbsence (QueryParam Required Lenient name val) Request where-  type Absence (QueryParam Required Lenient name val) Request = ParamNotFound+type instance Attribute (QueryParam Optional Strict name val) Request = Maybe val+type instance Absence (QueryParam Optional Strict name val) = ParamParseError -instance Trait (QueryParam Optional Lenient name val) Request where-  type Attribute (QueryParam Optional Lenient name val) Request = Maybe (Either Text val)+type instance Attribute (QueryParam Required Lenient name val) Request = Either Text val+type instance Absence (QueryParam Required Lenient name val) = ParamNotFound -instance TraitAbsence (QueryParam Optional Lenient name val) Request where-  type Absence (QueryParam Optional Lenient name val) Request = Void+type instance Attribute (QueryParam Optional Lenient name val) Request = Maybe (Either Text val)+type instance Absence (QueryParam Optional Lenient name val) = Void -type instance Prerequisite (QueryParam e p name val) ts Request = ()+type instance Prerequisite (QueryParam e p name val) ts = ()  queryParamHandler ::   forall name val e p h ts.-  (Get h (QueryParam e p name val) Request, ArrowChoice h) =>-  h (Request `With` ts, Absence (QueryParam e p name val) Request) Response ->+  (Get h (QueryParam e p name val), ArrowChoice h) =>+  h (Request `With` ts, Absence (QueryParam e p name val)) Response ->   Middleware h ts (QueryParam e p name val : ts) queryParamHandler errorHandler nextHandler = proc request -> do   result <- probe QueryParam -< request@@ -116,7 +104,7 @@ -} queryParam ::   forall name val h ts.-  (Get h (QueryParam Required Strict name val) Request, ArrowChoice h) =>+  (Get h (QueryParam Required Strict name val), ArrowChoice h) =>   h (Request `With` ts, Either ParamNotFound ParamParseError) Response ->   Middleware h ts (QueryParam Required Strict name val : ts) queryParam = queryParamHandler@@ -134,7 +122,7 @@ -} optionalQueryParam ::   forall name val h ts.-  (Get h (QueryParam Optional Strict name val) Request, ArrowChoice h) =>+  (Get h (QueryParam Optional Strict name val), ArrowChoice h) =>   h (Request `With` ts, ParamParseError) Response ->   Middleware h ts (QueryParam Optional Strict name val : ts) optionalQueryParam = queryParamHandler@@ -152,7 +140,7 @@ -} lenientQueryParam ::   forall name val h ts.-  (Get h (QueryParam Required Lenient name val) Request, ArrowChoice h) =>+  (Get h (QueryParam Required Lenient name val), ArrowChoice h) =>   h (Request `With` ts, ParamNotFound) Response ->   Middleware h ts (QueryParam Required Lenient name val : ts) lenientQueryParam = queryParamHandler@@ -170,7 +158,7 @@ -} optionalLenientQueryParam ::   forall name val h ts.-  (Get h (QueryParam Optional Lenient name val) Request, ArrowChoice h) =>+  (Get h (QueryParam Optional Lenient name val), ArrowChoice h) =>   Middleware h ts (QueryParam Optional Lenient name val : ts) optionalLenientQueryParam = queryParamHandler $ arr (absurd . snd) {-# INLINE optionalLenientQueryParam #-}
src/WebGear/Core/Trait/Status.hs view
@@ -54,247 +54,246 @@  import qualified Network.HTTP.Types as HTTP import WebGear.Core.Response (Response (..), ResponseBody (ResponseBodyBuilder))-import WebGear.Core.Trait (Set, Trait (..), With, plant, wzero)+import WebGear.Core.Trait (Attribute, Set, With, plant, wzero)  -- | HTTP response status newtype Status = Status HTTP.Status -instance Trait Status Response where-  type Attribute Status Response = HTTP.Status+type instance Attribute Status Response = HTTP.Status  -- | Generate a response with the specified status-mkResponse :: (Set h Status Response) => HTTP.Status -> h () (Response `With` '[Status])+mkResponse :: (Set h Status) => HTTP.Status -> h () (Response `With` '[Status]) mkResponse status = proc () -> do   let response = wzero $ Response status [] (ResponseBodyBuilder mempty)   plant (Status status) -< (response, status) {-# INLINE mkResponse #-}  -- | Continue 100 response-continue100 :: (Set h Status Response) => h () (Response `With` '[Status])+continue100 :: (Set h Status) => h () (Response `With` '[Status]) continue100 = mkResponse HTTP.continue100 {-# INLINE continue100 #-}  -- | Switching Protocols 101 response-switchingProtocols101 :: (Set h Status Response) => h () (Response `With` '[Status])+switchingProtocols101 :: (Set h Status) => h () (Response `With` '[Status]) switchingProtocols101 = mkResponse HTTP.switchingProtocols101 {-# INLINE switchingProtocols101 #-}  -- | OK 200 response-ok200 :: (Set h Status Response) => h () (Response `With` '[Status])+ok200 :: (Set h Status) => h () (Response `With` '[Status]) ok200 = mkResponse HTTP.ok200 {-# INLINE ok200 #-}  -- | Created 201 response-created201 :: (Set h Status Response) => h () (Response `With` '[Status])+created201 :: (Set h Status) => h () (Response `With` '[Status]) created201 = mkResponse HTTP.created201 {-# INLINE created201 #-}  -- | Accepted 202 response-accepted202 :: (Set h Status Response) => h () (Response `With` '[Status])+accepted202 :: (Set h Status) => h () (Response `With` '[Status]) accepted202 = mkResponse HTTP.accepted202 {-# INLINE accepted202 #-}  -- | Non-Authoritative 203 response-nonAuthoritative203 :: (Set h Status Response) => h () (Response `With` '[Status])+nonAuthoritative203 :: (Set h Status) => h () (Response `With` '[Status]) nonAuthoritative203 = mkResponse HTTP.nonAuthoritative203 {-# INLINE nonAuthoritative203 #-}  -- | No Content 204 response-noContent204 :: (Set h Status Response) => h () (Response `With` '[Status])+noContent204 :: (Set h Status) => h () (Response `With` '[Status]) noContent204 = mkResponse HTTP.noContent204 {-# INLINE noContent204 #-}  -- | Reset Content 205 response-resetContent205 :: (Set h Status Response) => h () (Response `With` '[Status])+resetContent205 :: (Set h Status) => h () (Response `With` '[Status]) resetContent205 = mkResponse HTTP.resetContent205 {-# INLINE resetContent205 #-}  -- | Partial Content 206 response-partialContent206 :: (Set h Status Response) => h () (Response `With` '[Status])+partialContent206 :: (Set h Status) => h () (Response `With` '[Status]) partialContent206 = mkResponse HTTP.partialContent206 {-# INLINE partialContent206 #-}  -- | Multiple Choices 300 response-multipleChoices300 :: (Set h Status Response) => h () (Response `With` '[Status])+multipleChoices300 :: (Set h Status) => h () (Response `With` '[Status]) multipleChoices300 = mkResponse HTTP.multipleChoices300 {-# INLINE multipleChoices300 #-}  -- | Moved Permanently 301 response-movedPermanently301 :: (Set h Status Response) => h () (Response `With` '[Status])+movedPermanently301 :: (Set h Status) => h () (Response `With` '[Status]) movedPermanently301 = mkResponse HTTP.movedPermanently301 {-# INLINE movedPermanently301 #-}  -- | Found 302 response-found302 :: (Set h Status Response) => h () (Response `With` '[Status])+found302 :: (Set h Status) => h () (Response `With` '[Status]) found302 = mkResponse HTTP.found302 {-# INLINE found302 #-}  -- | See Other 303 response-seeOther303 :: (Set h Status Response) => h () (Response `With` '[Status])+seeOther303 :: (Set h Status) => h () (Response `With` '[Status]) seeOther303 = mkResponse HTTP.seeOther303 {-# INLINE seeOther303 #-}  -- | Not Modified 304 response-notModified304 :: (Set h Status Response) => h () (Response `With` '[Status])+notModified304 :: (Set h Status) => h () (Response `With` '[Status]) notModified304 = mkResponse HTTP.notModified304 {-# INLINE notModified304 #-}  -- | Temporary Redirect 307 response-temporaryRedirect307 :: (Set h Status Response) => h () (Response `With` '[Status])+temporaryRedirect307 :: (Set h Status) => h () (Response `With` '[Status]) temporaryRedirect307 = mkResponse HTTP.temporaryRedirect307 {-# INLINE temporaryRedirect307 #-}  -- | Permanent Redirect 308 response-permanentRedirect308 :: (Set h Status Response) => h () (Response `With` '[Status])+permanentRedirect308 :: (Set h Status) => h () (Response `With` '[Status]) permanentRedirect308 = mkResponse HTTP.permanentRedirect308 {-# INLINE permanentRedirect308 #-}  -- | Bad Request 400 response-badRequest400 :: (Set h Status Response) => h () (Response `With` '[Status])+badRequest400 :: (Set h Status) => h () (Response `With` '[Status]) badRequest400 = mkResponse HTTP.badRequest400 {-# INLINE badRequest400 #-}  -- | Unauthorized 401 response-unauthorized401 :: (Set h Status Response) => h () (Response `With` '[Status])+unauthorized401 :: (Set h Status) => h () (Response `With` '[Status]) unauthorized401 = mkResponse HTTP.unauthorized401 {-# INLINE unauthorized401 #-}  -- | Payment Required 402 response-paymentRequired402 :: (Set h Status Response) => h () (Response `With` '[Status])+paymentRequired402 :: (Set h Status) => h () (Response `With` '[Status]) paymentRequired402 = mkResponse HTTP.paymentRequired402 {-# INLINE paymentRequired402 #-}  -- | Forbidden 403 response-forbidden403 :: (Set h Status Response) => h () (Response `With` '[Status])+forbidden403 :: (Set h Status) => h () (Response `With` '[Status]) forbidden403 = mkResponse HTTP.forbidden403 {-# INLINE forbidden403 #-}  -- | Not Found 404 response-notFound404 :: (Set h Status Response) => h () (Response `With` '[Status])+notFound404 :: (Set h Status) => h () (Response `With` '[Status]) notFound404 = mkResponse HTTP.notFound404 {-# INLINE notFound404 #-}  -- | Method Not Allowed 405 response-methodNotAllowed405 :: (Set h Status Response) => h () (Response `With` '[Status])+methodNotAllowed405 :: (Set h Status) => h () (Response `With` '[Status]) methodNotAllowed405 = mkResponse HTTP.methodNotAllowed405 {-# INLINE methodNotAllowed405 #-}  -- | Not Acceptable 406 response-notAcceptable406 :: (Set h Status Response) => h () (Response `With` '[Status])+notAcceptable406 :: (Set h Status) => h () (Response `With` '[Status]) notAcceptable406 = mkResponse HTTP.notAcceptable406 {-# INLINE notAcceptable406 #-}  -- | Proxy Authentication Required 407 response-proxyAuthenticationRequired407 :: (Set h Status Response) => h () (Response `With` '[Status])+proxyAuthenticationRequired407 :: (Set h Status) => h () (Response `With` '[Status]) proxyAuthenticationRequired407 = mkResponse HTTP.proxyAuthenticationRequired407 {-# INLINE proxyAuthenticationRequired407 #-}  -- | Request Timeout 408 response-requestTimeout408 :: (Set h Status Response) => h () (Response `With` '[Status])+requestTimeout408 :: (Set h Status) => h () (Response `With` '[Status]) requestTimeout408 = mkResponse HTTP.requestTimeout408 {-# INLINE requestTimeout408 #-}  -- | Conflict 409 response-conflict409 :: (Set h Status Response) => h () (Response `With` '[Status])+conflict409 :: (Set h Status) => h () (Response `With` '[Status]) conflict409 = mkResponse HTTP.conflict409 {-# INLINE conflict409 #-}  -- | Gone 410 response-gone410 :: (Set h Status Response) => h () (Response `With` '[Status])+gone410 :: (Set h Status) => h () (Response `With` '[Status]) gone410 = mkResponse HTTP.gone410 {-# INLINE gone410 #-}  -- | Length Required 411 response-lengthRequired411 :: (Set h Status Response) => h () (Response `With` '[Status])+lengthRequired411 :: (Set h Status) => h () (Response `With` '[Status]) lengthRequired411 = mkResponse HTTP.lengthRequired411 {-# INLINE lengthRequired411 #-}  -- | Precondition Failed 412 response-preconditionFailed412 :: (Set h Status Response) => h () (Response `With` '[Status])+preconditionFailed412 :: (Set h Status) => h () (Response `With` '[Status]) preconditionFailed412 = mkResponse HTTP.preconditionFailed412 {-# INLINE preconditionFailed412 #-}  -- | Request Entity Too Large 413 response-requestEntityTooLarge413 :: (Set h Status Response) => h () (Response `With` '[Status])+requestEntityTooLarge413 :: (Set h Status) => h () (Response `With` '[Status]) requestEntityTooLarge413 = mkResponse HTTP.requestEntityTooLarge413 {-# INLINE requestEntityTooLarge413 #-}  -- | Request URI Too Long 414 response-requestURITooLong414 :: (Set h Status Response) => h () (Response `With` '[Status])+requestURITooLong414 :: (Set h Status) => h () (Response `With` '[Status]) requestURITooLong414 = mkResponse HTTP.requestURITooLong414 {-# INLINE requestURITooLong414 #-}  -- | Unsupported Media Type 415 response-unsupportedMediaType415 :: (Set h Status Response) => h () (Response `With` '[Status])+unsupportedMediaType415 :: (Set h Status) => h () (Response `With` '[Status]) unsupportedMediaType415 = mkResponse HTTP.unsupportedMediaType415 {-# INLINE unsupportedMediaType415 #-}  -- | Requested Range Not Satisfiable 416 response-requestedRangeNotSatisfiable416 :: (Set h Status Response) => h () (Response `With` '[Status])+requestedRangeNotSatisfiable416 :: (Set h Status) => h () (Response `With` '[Status]) requestedRangeNotSatisfiable416 = mkResponse HTTP.requestedRangeNotSatisfiable416 {-# INLINE requestedRangeNotSatisfiable416 #-}  -- | Expectation Failed 417 response-expectationFailed417 :: (Set h Status Response) => h () (Response `With` '[Status])+expectationFailed417 :: (Set h Status) => h () (Response `With` '[Status]) expectationFailed417 = mkResponse HTTP.expectationFailed417 {-# INLINE expectationFailed417 #-}  -- | I'm A Teapot 418 response-imATeapot418 :: (Set h Status Response) => h () (Response `With` '[Status])+imATeapot418 :: (Set h Status) => h () (Response `With` '[Status]) imATeapot418 = mkResponse HTTP.imATeapot418 {-# INLINE imATeapot418 #-}  -- | Unprocessable Entity 422 response-unprocessableEntity422 :: (Set h Status Response) => h () (Response `With` '[Status])+unprocessableEntity422 :: (Set h Status) => h () (Response `With` '[Status]) unprocessableEntity422 = mkResponse HTTP.unprocessableEntity422 {-# INLINE unprocessableEntity422 #-}  -- | Precondition Required 428 response-preconditionRequired428 :: (Set h Status Response) => h () (Response `With` '[Status])+preconditionRequired428 :: (Set h Status) => h () (Response `With` '[Status]) preconditionRequired428 = mkResponse HTTP.preconditionRequired428 {-# INLINE preconditionRequired428 #-}  -- | Too Many Requests 429 response-tooManyRequests429 :: (Set h Status Response) => h () (Response `With` '[Status])+tooManyRequests429 :: (Set h Status) => h () (Response `With` '[Status]) tooManyRequests429 = mkResponse HTTP.tooManyRequests429 {-# INLINE tooManyRequests429 #-}  -- | Request Header Fields Too Large 431 response-requestHeaderFieldsTooLarge431 :: (Set h Status Response) => h () (Response `With` '[Status])+requestHeaderFieldsTooLarge431 :: (Set h Status) => h () (Response `With` '[Status]) requestHeaderFieldsTooLarge431 = mkResponse HTTP.requestHeaderFieldsTooLarge431 {-# INLINE requestHeaderFieldsTooLarge431 #-}  -- | Internal Server Error 500 response-internalServerError500 :: (Set h Status Response) => h () (Response `With` '[Status])+internalServerError500 :: (Set h Status) => h () (Response `With` '[Status]) internalServerError500 = mkResponse HTTP.internalServerError500 {-# INLINE internalServerError500 #-}  -- | Not Implemented 501 response-notImplemented501 :: (Set h Status Response) => h () (Response `With` '[Status])+notImplemented501 :: (Set h Status) => h () (Response `With` '[Status]) notImplemented501 = mkResponse HTTP.notImplemented501 {-# INLINE notImplemented501 #-}  -- | Bad Gateway 502 response-badGateway502 :: (Set h Status Response) => h () (Response `With` '[Status])+badGateway502 :: (Set h Status) => h () (Response `With` '[Status]) badGateway502 = mkResponse HTTP.badGateway502 {-# INLINE badGateway502 #-}  -- | Service Unavailable 503 response-serviceUnavailable503 :: (Set h Status Response) => h () (Response `With` '[Status])+serviceUnavailable503 :: (Set h Status) => h () (Response `With` '[Status]) serviceUnavailable503 = mkResponse HTTP.serviceUnavailable503 {-# INLINE serviceUnavailable503 #-}  -- | Gateway Timeout 504 response-gatewayTimeout504 :: (Set h Status Response) => h () (Response `With` '[Status])+gatewayTimeout504 :: (Set h Status) => h () (Response `With` '[Status]) gatewayTimeout504 = mkResponse HTTP.gatewayTimeout504 {-# INLINE gatewayTimeout504 #-}  -- | HTTP Version Not Supported 505 response-httpVersionNotSupported505 :: (Set h Status Response) => h () (Response `With` '[Status])+httpVersionNotSupported505 :: (Set h Status) => h () (Response `With` '[Status]) httpVersionNotSupported505 = mkResponse HTTP.httpVersionNotSupported505 {-# INLINE httpVersionNotSupported505 #-}  -- | Network Authentication Required 511 response-networkAuthenticationRequired511 :: (Set h Status Response) => h () (Response `With` '[Status])+networkAuthenticationRequired511 :: (Set h Status) => h () (Response `With` '[Status]) networkAuthenticationRequired511 = mkResponse HTTP.networkAuthenticationRequired511 {-# INLINE networkAuthenticationRequired511 #-}
src/WebGear/Core/Traits.hs view
@@ -17,8 +17,6 @@ import qualified Data.Text.Lazy as LText import WebGear.Core.Handler (Handler) import WebGear.Core.MIMETypes (PlainText)-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@@ -40,13 +38,13 @@ -} type StdHandler h m =   ( Handler h m-  , Gets h [Method, Path, PathEnd] Request+  , Gets h [Method, Path, PathEnd]   , Sets       h       '[ Status        , Body PlainText String        , Body PlainText Text.Text        , Body PlainText LText.Text+       , RequiredResponseHeader "Content-Type" Text.Text        ]-      Response   )
webgear-core.cabal view
@@ -1,7 +1,7 @@ cabal-version:       2.4  name:                webgear-core-version:             1.2.0+version:             1.3.0 synopsis:            Composable, type-safe library to build HTTP APIs description:         WebGear is a library to for building composable, type-safe HTTP APIs.