webby 1.1.1 → 1.2.0
raw patch · 7 files changed
+224/−31 lines, 7 filesdep +wai-extradep ~aesondep ~basedep ~bytestring
Dependencies added: wai-extra
Dependency ranges changed: aeson, base, bytestring, formatting, http-api-data, http-types, relude, text, wai, warp
Files
- ChangeLog.md +7/−0
- src/Webby/Server.hs +3/−1
- src/Webby/Types.hs +1/−0
- test/AppTests.hs +155/−0
- test/ErrorTests.hs +19/−0
- test/Spec.hs +3/−1
- webby.cabal +36/−29
ChangeLog.md view
@@ -1,5 +1,12 @@ # Change log +## v1.2.0++- Drop support for GHC < 9.0.+- Test against GHC 9.0 through 9.12.+- Relax upper bounds to next-major for `aeson` (`<3`), `formatting`+ (`<8`), `http-api-data` (`<1`), and `text` (`<3`).+ ## v1.1.1 - Ensure support for GHC 9.4
src/Webby/Server.hs view
@@ -259,7 +259,9 @@ runWebbyM wEnv $ handler `E.catches` ( shortCircuitHandler- <> fmap (\(WebbyExceptionHandler e) -> E.Handler e) (maybeToList exceptionHandlerMay)+ <> fmap+ (\(WebbyExceptionHandler e) -> E.Handler e)+ (maybeToList exceptionHandlerMay) ) webbyReply wEnv respond )
src/Webby/Types.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StrictData #-} module Webby.Types where
+ test/AppTests.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE OverloadedStrings #-}++module AppTests (appTests) where++import qualified Data.Aeson as A+import qualified Network.Wai.Test as WT+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import qualified UnliftIO.Exception as E+import Webby+import Prelude++newtype TestEnv = TestEnv ()++data Boom = Boom+ deriving stock (Show)++instance E.Exception Boom++routes :: [Route TestEnv]+routes =+ [ get "/hello" (text "hi"),+ get "/users/:id" $ do+ uid <- getCapture "id"+ text uid,+ get "/teapot" $ do+ setStatus status418+ _ <- finish+ setStatus status200,+ get "/boom" (E.throwIO Boom),+ get "/search" $ do+ mq <- param "q"+ text $ fromMaybe "missing" mq,+ get "/page" $ do+ n <- param_ "n" :: WebbyM TestEnv Int+ text $ show n,+ post "/echo-json" $ do+ v <- jsonData :: WebbyM TestEnv A.Value+ json v,+ get "/add-headers" $ do+ addHeader ("X-Foo", "a")+ addHeader ("X-Foo", "b")+ text "ok",+ get "/set-headers" $ do+ setHeader ("X-Foo", "a")+ setHeader ("X-Foo", "b")+ text "ok"+ ]++boomHandler :: Boom -> WebbyM TestEnv ()+boomHandler _ = do+ setStatus status503+ text "boom-handled"++mkApp :: IO Application+mkApp =+ mkWebbyApp (TestEnv ()) $+ setExceptionHandler boomHandler $+ setRoutes routes defaultWebbyServerConfig++mkReq :: ByteString -> Request+mkReq = WT.setPath defaultRequest++mkJsonPost :: ByteString -> LByteString -> WT.SRequest+mkJsonPost path body =+ WT.SRequest+ (WT.setPath+ (defaultRequest+ { requestMethod = methodPost,+ requestHeaders = [(hContentType, "application/json")]+ })+ path)+ body++run :: WT.Session a -> IO a+run sess = mkApp >>= WT.runSession sess++appTests :: TestTree+appTests =+ testGroup+ "App round-trip"+ [ testCase "404 on unmatched route" $+ run $ do+ r <- WT.request (mkReq "/nope")+ liftIO $ WT.simpleStatus r @?= status404,+ testCase "200 + body on basic GET" $+ run $ do+ r <- WT.request (mkReq "/hello")+ liftIO $ do+ WT.simpleStatus r @?= status200+ WT.simpleBody r @?= "hi",+ testCase "capture extraction echoes path segment" $+ run $ do+ r <- WT.request (mkReq "/users/42")+ liftIO $ do+ WT.simpleStatus r @?= status200+ WT.simpleBody r @?= "42",+ testCase "finish short-circuits and preserves earlier setStatus" $+ run $ do+ r <- WT.request (mkReq "/teapot")+ liftIO $ WT.simpleStatus r @?= status418,+ testCase "custom exceptionHandler runs on thrown exception" $+ run $ do+ r <- WT.request (mkReq "/boom")+ liftIO $ do+ WT.simpleStatus r @?= status503+ WT.simpleBody r @?= "boom-handled",+ testCase "param returns Just for present query param" $+ run $ do+ r <- WT.request (mkReq "/search?q=foo")+ liftIO $ do+ WT.simpleStatus r @?= status200+ WT.simpleBody r @?= "foo",+ testCase "param returns Nothing when missing" $+ run $ do+ r <- WT.request (mkReq "/search")+ liftIO $ do+ WT.simpleStatus r @?= status200+ WT.simpleBody r @?= "missing",+ testCase "param_ parses typed value" $+ run $ do+ r <- WT.request (mkReq "/page?n=42")+ liftIO $ do+ WT.simpleStatus r @?= status200+ WT.simpleBody r @?= "42",+ testCase "param_ returns 400 on unparseable value" $+ run $ do+ r <- WT.request (mkReq "/page?n=abc")+ liftIO $ WT.simpleStatus r @?= status400,+ testCase "jsonData round-trips a Value" $+ run $ do+ let body = "{\"x\":42}"+ r <- WT.srequest (mkJsonPost "/echo-json" body)+ liftIO $ do+ WT.simpleStatus r @?= status200+ A.decode (WT.simpleBody r) @?= (A.decode body :: Maybe A.Value),+ testCase "jsonData returns 400 on malformed body" $+ run $ do+ r <- WT.srequest (mkJsonPost "/echo-json" "not json")+ liftIO $ do+ WT.simpleStatus r @?= status400+ WT.simpleBody r @?= "Invalid JSON body",+ testCase "addHeader appends duplicate header values" $+ run $ do+ r <- WT.request (mkReq "/add-headers")+ liftIO $+ filter ((== "X-Foo") . fst) (WT.simpleHeaders r)+ @?= [("X-Foo", "a"), ("X-Foo", "b")],+ testCase "setHeader replaces an existing header value" $+ run $ do+ r <- WT.request (mkReq "/set-headers")+ liftIO $+ filter ((== "X-Foo") . fst) (WT.simpleHeaders r)+ @?= [("X-Foo", "b")]+ ]
+ test/ErrorTests.hs view
@@ -0,0 +1,19 @@+module ErrorTests (errorTests) where++import qualified UnliftIO.Exception as E+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit ((@?=))+import qualified Test.Tasty.HUnit as HUnit+import Webby.Types+import Prelude++errorTests :: TestTree+errorTests = testGroup "WebbyError displayException" [unitTests]+ where+ unitTests = HUnit.testCase "renders each constructor" $ do+ E.displayException (WebbyJSONParseError "ignored")+ @?= "Invalid JSON body"+ E.displayException (WebbyParamParseError "page" "not an integer")+ @?= "Param parse error: page not an integer"+ E.displayException (WebbyMissingCapture "userId")+ @?= "userId missing"
test/Spec.hs view
@@ -1,4 +1,6 @@+import AppTests (appTests) import qualified Data.HashMap.Strict as H+import ErrorTests (errorTests) import Network.Wai.Internal import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit ((@?=))@@ -11,7 +13,7 @@ main = defaultMain tests tests :: TestTree-tests = testGroup "Webby Tests" [matchRequestTests]+tests = testGroup "Webby Tests" [matchRequestTests, errorTests, appTests] matchRequestTests :: TestTree matchRequestTests = testGroup "matchRequest" [unitTests]
webby.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: webby-version: 1.1.1+version: 1.2.0 synopsis: A super-simple web server framework description: A super-simple, easy to use web server framework inspired by Scotty. The goals of the project are: (1) Be easy to use (2) Allow@@ -18,13 +18,13 @@ README.md extra-source-files: examples/*.hs-tested-with: GHC == 8.4.4- GHC == 8.6.5- GHC == 8.8.4- GHC == 8.10.7- GHC == 9.0.2+tested-with: GHC == 9.0.2 GHC == 9.2.7 GHC == 9.4.4+ GHC == 9.6.7+ GHC == 9.8.4+ GHC == 9.10.3+ GHC == 9.12.4 source-repository head type: git@@ -36,25 +36,23 @@ -Widentities -Wincomplete-uni-patterns -Wincomplete-record-updates+ -Wredundant-constraints+ -Wmissing-deriving-strategies+ -Werror=missing-deriving-strategies+ -Winvalid-haddock+ -fhide-source-paths -haddock- if impl(ghc >= 8.0)- ghc-options: -Wredundant-constraints- if impl(ghc >= 8.2)- ghc-options: -fhide-source-paths -- Add this when we have time. Fixing partial-fields requires major version -- bump at this time.- -- if impl(ghc >= 8.4)- -- ghc-options: -Wpartial-fields- -- -Wmissing-export-lists+ -- ghc-options: -Wpartial-fields+ -- -Wmissing-export-lists - if impl(ghc >= 8.8)- ghc-options: -Wmissing-deriving-strategies- -Werror=missing-deriving-strategies- if impl(ghc >= 8.10)- ghc-options: -Wunused-packages- if impl(ghc >= 9.0)- ghc-options: -Winvalid-haddock+ -- -Wunused-packages is intentionally NOT enabled: combined with+ -- `mixins: base hiding (Prelude)` below, GHC can't see uses of the+ -- base-<ver> package-id (imports go through the mixin alias), so it+ -- spuriously flags base as unused. Confirmed still firing on GHC 9.6.7,+ -- 9.8.4, 9.10.3, and 9.12.4 (cabal 3.14.2.0). See GHC issue #19518. if impl(ghc >= 9.2) ghc-options: -Wredundant-bang-patterns -Woperator-whitespace@@ -81,16 +79,16 @@ autogen-modules: Paths_webby build-depends:- aeson >=1.4 && <2.2- , base >=4.7 && <5+ aeson >=1.4 && <3+ , base >=4.15 && <5 , binary >=0.8 && <1 , bytestring >=0.10 && <1- , formatting >=6.3.7 && <7.2- , http-api-data >=0.4 && <0.6+ , formatting >=6.3.7 && <8+ , http-api-data >=0.4 && <1 , http-types ==0.12.*- , relude >=0.7+ , relude >=0.7 && <2 , resourcet ==1.2.*- , text >=1.2 && <2.1+ , text >=1.2 && <3 , unliftio >=0.2.13 && <0.3 , unliftio-core ==0.2.* , unordered-containers >=0.2.9 && <0.3@@ -112,14 +110,23 @@ base-settings type: exitcode-stdio-1.0 main-is: Spec.hs+ other-modules:+ AppTests+ ErrorTests+ Webby hs-source-dirs: src test ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends:- tasty+ bytestring+ , http-types+ , tasty , tasty-hunit , tasty-quickcheck+ , text+ , wai+ , wai-extra , webby Flag examples@@ -131,11 +138,11 @@ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 default-extensions: OverloadedStrings- build-depends: base >= 4.7 && < 5+ build-depends: base >= 4.15 && < 5 , http-types , relude , text- , warp+ , warp < 4 , webby , unliftio , unordered-containers