webgear-server 1.2.0 → 1.3.0

raw patch · 11 files changed

+42/−36 lines, 11 filesdep ~QuickCheckdep ~tasty-quickcheckdep ~webgear-core

Dependency ranges changed: QuickCheck, tasty-quickcheck, webgear-core

Files

• CHANGELOG.md +7/−1
• src/WebGear/Server/Trait/Auth/Basic.hs +2/−2
• src/WebGear/Server/Trait/Auth/JWT.hs +2/−2
• src/WebGear/Server/Trait/Body.hs +3/−3
• src/WebGear/Server/Trait/Cookie.hs +4/−4
• src/WebGear/Server/Trait/Header.hs +6/−6
• src/WebGear/Server/Trait/Method.hs +1/−1
• src/WebGear/Server/Trait/Path.hs +10/−10
• src/WebGear/Server/Trait/QueryParam.hs +4/−4
• src/WebGear/Server/Trait/Status.hs +1/−1
• webgear-server.cabal +2/−2

@@ -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@@ -82,7 +87,8 @@ - Automated tests - Documentation -[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

@@ -26,7 +26,7 @@  ) import WebGear.Server.Handler (ServerHandler) -instance (Monad m) => Get (ServerHandler m) (BasicAuth' Required scheme m e a) Request where+instance (Monad m) => Get (ServerHandler m) (BasicAuth' Required scheme m e a) where   {-# INLINE getTrait #-}   getTrait ::     (HasTrait (AuthorizationHeader scheme) ts) =>@@ -53,7 +53,7 @@         res <- toBasicAttribute creds         pure $ first BasicAuthAttributeError res -instance (Monad m) => Get (ServerHandler m) (BasicAuth' Optional scheme m e a) Request where+instance (Monad m) => Get (ServerHandler m) (BasicAuth' Optional scheme m e a) where   {-# INLINE getTrait #-}   getTrait ::     (HasTrait (AuthorizationHeader scheme) ts) =>

@@ -22,7 +22,7 @@ import WebGear.Core.Trait.Auth.JWT (JWTAuth' (..), JWTAuthError (..)) import WebGear.Server.Handler (ServerHandler) -instance (MonadTime m, Get (ServerHandler m) (AuthorizationHeader scheme) Request) => Get (ServerHandler m) (JWTAuth' Required scheme m e a) Request where+instance (MonadTime m, Get (ServerHandler m) (AuthorizationHeader scheme)) => Get (ServerHandler m) (JWTAuth' Required scheme m e a) where   {-# INLINE getTrait #-}   getTrait ::     (HasTrait (AuthorizationHeader scheme) ts) =>@@ -46,7 +46,7 @@         claims <- withExceptT JWTAuthTokenBadFormat $ JWT.verifyClaims jwtValidationSettings jwkSet jwt         lift (toJWTAttribute claims) >>= either (throwError . JWTAuthAttributeError) pure -instance (MonadTime m, Get (ServerHandler m) (AuthorizationHeader scheme) Request) => Get (ServerHandler m) (JWTAuth' Optional scheme m e a) Request where+instance (MonadTime m, Get (ServerHandler m) (AuthorizationHeader scheme)) => Get (ServerHandler m) (JWTAuth' Optional scheme m e a) where   {-# INLINE getTrait #-}   getTrait ::     (HasTrait (AuthorizationHeader scheme) ts) =>

@@ -16,12 +16,12 @@ import WebGear.Server.Handler (ServerHandler (..)) import WebGear.Server.MIMETypes (BodyRender (..), BodyUnrender (..)) -instance (Monad m, BodyUnrender m mt val) => Get (ServerHandler m) (Body mt val) Request where+instance (Monad m, BodyUnrender m mt val) => Get (ServerHandler m) (Body mt val) where   {-# INLINE getTrait #-}   getTrait :: Body mt val -> ServerHandler m (Request `With` ts) (Either Text val)   getTrait (Body mt) = arrM $ bodyUnrender mt . unwitness -instance (Monad m, BodyRender m mt val) => Set (ServerHandler m) (Body mt val) Response where+instance (Monad m, BodyRender m mt val) => Set (ServerHandler m) (Body mt val) where   {-# INLINE setTrait #-}   setTrait ::     Body mt val ->@@ -45,7 +45,7 @@       | n == HTTP.hContentType = (HTTP.hContentType, mtStr) : hdrs       | otherwise = (n, v) : go hdrs -instance (Monad m) => Set (ServerHandler m) UnknownContentBody Response where+instance (Monad m) => Set (ServerHandler m) UnknownContentBody where   {-# INLINE setTrait #-}   setTrait ::     UnknownContentBody ->

@@ -21,7 +21,7 @@ import WebGear.Core.Trait.Cookie (Cookie (..), CookieNotFound (..), CookieParseError (..), SetCookie (..)) import WebGear.Server.Handler (ServerHandler) -instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (Cookie Required name val) Request where+instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (Cookie Required name val) where   {-# INLINE getTrait #-}   getTrait ::     Cookie Required name val ->@@ -33,7 +33,7 @@         Just (Left e) -> Left $ Right $ CookieParseError e         Just (Right x) -> Right x -instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (Cookie Optional name val) Request where+instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (Cookie Optional name val) where   {-# INLINE getTrait #-}   getTrait ::     Cookie Optional name val ->@@ -60,7 +60,7 @@    returnA -< parseHeader <$> lookupCookie -instance (Monad m, KnownSymbol name) => Set (ServerHandler m) (SetCookie Required name) Response where+instance (Monad m, KnownSymbol name) => Set (ServerHandler m) (SetCookie Required name) where   {-# INLINE setTrait #-}   setTrait ::     SetCookie Required name ->@@ -75,7 +75,7 @@             _ -> response     returnA -< f l response' cookie -instance (Monad m, KnownSymbol name) => Set (ServerHandler m) (SetCookie Optional name) Response where+instance (Monad m, KnownSymbol name) => Set (ServerHandler m) (SetCookie Optional name) where   {-# INLINE setTrait #-}   -- If the optional value is 'Nothing', the cookie is removed from the response   setTrait ::

@@ -29,7 +29,7 @@   let headerName :: HeaderName = fromString $ symbolVal proxy   returnA -< parseHeader <$> requestHeader headerName (unwitness req) -instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (RequestHeader Required Strict name val) Request where+instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (RequestHeader Required Strict name val) where   {-# INLINE getTrait #-}   getTrait ::     RequestHeader Required Strict name val ->@@ -41,7 +41,7 @@         Just (Left e) -> Left $ Right $ HeaderParseError e         Just (Right x) -> Right x -instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (RequestHeader Optional Strict name val) Request where+instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (RequestHeader Optional Strict name val) where   {-# INLINE getTrait #-}   getTrait ::     RequestHeader Optional Strict name val ->@@ -53,7 +53,7 @@         Just (Left e) -> Left $ HeaderParseError e         Just (Right x) -> Right $ Just x -instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (RequestHeader Required Lenient name val) Request where+instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (RequestHeader Required Lenient name val) where   {-# INLINE getTrait #-}   getTrait ::     RequestHeader Required Lenient name val ->@@ -65,7 +65,7 @@         Just (Left e) -> Right $ Left e         Just (Right x) -> Right $ Right x -instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (RequestHeader Optional Lenient name val) Request where+instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (RequestHeader Optional Lenient name val) where   {-# INLINE getTrait #-}   getTrait ::     RequestHeader Optional Lenient name val ->@@ -77,7 +77,7 @@         Just (Left e) -> Right $ Just $ Left e         Just (Right x) -> Right $ Just $ Right x -instance (Monad m, KnownSymbol name, ToHttpApiData val) => Set (ServerHandler m) (ResponseHeader Required name val) Response where+instance (Monad m, KnownSymbol name, ToHttpApiData val) => Set (ServerHandler m) (ResponseHeader Required name val) where   {-# INLINE setTrait #-}   setTrait ::     ResponseHeader Required name val ->@@ -92,7 +92,7 @@             _ -> response     returnA -< f l response' val -instance (Monad m, KnownSymbol name, ToHttpApiData val) => Set (ServerHandler m) (ResponseHeader Optional name val) Response where+instance (Monad m, KnownSymbol name, ToHttpApiData val) => Set (ServerHandler m) (ResponseHeader Optional name val) where   {-# INLINE setTrait #-}   -- If the optional value is 'Nothing', the header is removed from the response   setTrait ::

@@ -10,7 +10,7 @@ import WebGear.Core.Trait.Method (Method (..), MethodMismatch (..)) import WebGear.Server.Handler (ServerHandler) -instance (Monad m) => Get (ServerHandler m) Method Request where+instance (Monad m) => Get (ServerHandler m) Method where   {-# INLINE getTrait #-}   getTrait :: Method -> ServerHandler m (Request `With` ts) (Either MethodMismatch HTTP.StdMethod)   getTrait (Method method) = proc request -> do

@@ -18,7 +18,7 @@  ) import WebGear.Server.Handler (ServerHandler (..)) -instance (Monad m) => Get (ServerHandler m) Path Request where+instance (Monad m) => Get (ServerHandler m) Path where   {-# INLINE getTrait #-}   getTrait :: Path -> ServerHandler m (Request `With` ts) (Either () ())   getTrait (Path p) = ServerHandler $ const $ do@@ -28,7 +28,7 @@       Just ps -> put (RoutePath ps) >> pure (Right ())       Nothing -> pure (Left ()) -instance (Monad m, FromHttpApiData val) => Get (ServerHandler m) (PathVar tag val) Request where+instance (Monad m, FromHttpApiData val) => Get (ServerHandler m) (PathVar tag val) where   {-# INLINE getTrait #-}   getTrait :: PathVar tag val -> ServerHandler m (Request `With` ts) (Either PathVarError val)   getTrait PathVar = ServerHandler $ const $ do@@ -40,14 +40,14 @@           Left e -> pure (Left $ PathVarParseError e)           Right val -> put (RoutePath ps) >> pure (Right val) -instance (Monad m) => Get (ServerHandler m) PathEnd Request where+instance (Monad m) => Get (ServerHandler m) PathEnd where   {-# INLINE getTrait #-}   getTrait :: PathEnd -> ServerHandler m (Request `With` ts) (Either () ())   getTrait PathEnd =-    ServerHandler-      $ const-      $ gets-        ( \case-            RoutePath [] -> Right ()-            _ -> Left ()-        )+    ServerHandler $+      const $+        gets+          ( \case+              RoutePath [] -> Right ()+              _ -> Left ()+          )

@@ -31,7 +31,7 @@       params = queryToQueryText $ queryString $ unwitness req   returnA -< parseQueryParam <$> (find ((== name) . fst) params >>= snd) -instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Required Strict name val) Request where+instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Required Strict name val) where   {-# INLINE getTrait #-}   getTrait ::     QueryParam Required Strict name val ->@@ -43,7 +43,7 @@         Just (Left e) -> Left $ Right $ ParamParseError e         Just (Right x) -> Right x -instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Optional Strict name val) Request where+instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Optional Strict name val) where   {-# INLINE getTrait #-}   getTrait ::     QueryParam Optional Strict name val ->@@ -55,7 +55,7 @@         Just (Left e) -> Left $ ParamParseError e         Just (Right x) -> Right $ Just x -instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Required Lenient name val) Request where+instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Required Lenient name val) where   {-# INLINE getTrait #-}   getTrait ::     QueryParam Required Lenient name val ->@@ -67,7 +67,7 @@         Just (Left e) -> Right $ Left e         Just (Right x) -> Right $ Right x -instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Optional Lenient name val) Request where+instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Optional Lenient name val) where   {-# INLINE getTrait #-}   getTrait ::     QueryParam Optional Lenient name val ->

@@ -10,7 +10,7 @@ import WebGear.Core.Trait.Status (Status (..)) import WebGear.Server.Handler (ServerHandler) -instance (Monad m) => Set (ServerHandler m) Status Response where+instance (Monad m) => Set (ServerHandler m) Status where   {-# INLINE setTrait #-}   setTrait ::     Status ->

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                webgear-server-version:             1.2.0+version:             1.3.0 synopsis:            Composable, type-safe library to build HTTP API servers description:     WebGear is a library to for building composable, type-safe HTTP API servers.@@ -59,7 +59,7 @@                     , http-types ==0.12.*                     , text >=1.2.0.0 && <2.2                     , wai ==3.2.*-                    , webgear-core ^>=1.2.0+                    , webgear-core ^>=1.3.0   ghc-options:        -Wall                       -Wno-unticked-promoted-constructors                       -Wcompat