From ea43025d65ae833e1e5f66daf60009983345e78b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B6nke=20Hahn?= Date: Sun, 23 Oct 2016 22:16:14 -0400 Subject: [PATCH] reorder tests --- .../Servant/Server/Utils/CustomCombinators.hs | 3 + .../Server/Utils/CustomCombinatorsSpec.hs | 139 +++++++++--------- 2 files changed, 73 insertions(+), 69 deletions(-) diff --git a/servant-server/src/Servant/Server/Utils/CustomCombinators.hs b/servant-server/src/Servant/Server/Utils/CustomCombinators.hs index 9f8b34a4..41a40afb 100644 --- a/servant-server/src/Servant/Server/Utils/CustomCombinators.hs +++ b/servant-server/src/Servant/Server/Utils/CustomCombinators.hs @@ -4,6 +4,9 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +-- fixme: document phases +-- fixme: add doctests + module Servant.Server.Utils.CustomCombinators ( CombinatorImplementation, runCI, diff --git a/servant-server/test/Servant/Server/Utils/CustomCombinatorsSpec.hs b/servant-server/test/Servant/Server/Utils/CustomCombinatorsSpec.hs index 754280fb..4e07b27c 100644 --- a/servant-server/test/Servant/Server/Utils/CustomCombinatorsSpec.hs +++ b/servant-server/test/Servant/Server/Utils/CustomCombinatorsSpec.hs @@ -53,51 +53,79 @@ responseBodyLbs response = do spec :: Spec spec = do - it "allows to write capture combinators" $ do - let server = return - app = serve (Proxy :: Proxy (StringCapture :> Get' String)) server - request = defaultRequest{ - rawPathInfo = "/foo", - pathInfo = ["foo"] - } - response <- runApp app request - responseBodyLbs response `shouldReturn` "\"foo\"" + describe "makeCaptureCombinator" $ do + it "allows to write capture combinators" $ do + let server = return + app = serve (Proxy :: Proxy (StringCapture :> Get' String)) server + request = defaultRequest{ + rawPathInfo = "/foo", + pathInfo = ["foo"] + } + response <- runApp app request + responseBodyLbs response `shouldReturn` "\"foo\"" - it "allows to write request check combinators" $ do - let server = return () - app = serve (Proxy :: Proxy (CheckFooHeader :> Get' ())) server - request = defaultRequest{ - requestHeaders = - ("Foo", "foo") : - requestHeaders defaultRequest - } - response <- runApp app request - responseBodyLbs response `shouldReturn` "[]" + it "allows to write a combinator that errors out" $ do + let server = return + app = serve (Proxy :: Proxy (StringCapture :> Get' String)) server + request = defaultRequest { + rawPathInfo = "/error", + pathInfo = ["error"] + } + response <- runApp app request + responseStatus response `shouldBe` status418 - it "allows to write an auth combinator" $ do - let server (User name) = return name - app = serve (Proxy :: Proxy (AuthCombinator :> Get' String)) server - request = defaultRequest{ - requestHeaders = - ("Auth", "secret") : - requestHeaders defaultRequest - } - response <- runApp app request - responseStatus response `shouldBe` ok200 - responseBodyLbs response `shouldReturn` "\"Alice\"" + describe "makeRequestCheckCombinator" $ do + it "allows to write request check combinators" $ do + let server = return () + app = serve (Proxy :: Proxy (CheckFooHeader :> Get' ())) server + request = defaultRequest{ + requestHeaders = + ("Foo", "foo") : + requestHeaders defaultRequest + } + response <- runApp app request + responseBodyLbs response `shouldReturn` "[]" - it "allows to write a combinator by providing a function (Request -> a)" $ do - let server = return - app = serve (Proxy :: Proxy (FooHeader :> Get' String)) server - request = defaultRequest{ - requestHeaders = - ("Foo", "foo") : - requestHeaders defaultRequest - } - response <- runApp app request - responseBodyLbs response `shouldReturn` "\"foo\"" + it "disallows to access the request body" $ do + let server = return () + app = serve (Proxy :: Proxy (InvalidRequestCheckCombinator :> Get' ())) server + request = defaultRequest + runApp app request `shouldThrow` + errorCall "ERROR: makeRequestCheckCombinator: combinator must not access the request body" - context "streaming request bodies" $ do + describe "makeAuthCombinator" $ do + it "allows to write an auth combinator" $ do + let server (User name) = return name + app = serve (Proxy :: Proxy (AuthCombinator :> Get' String)) server + request = defaultRequest{ + requestHeaders = + ("Auth", "secret") : + requestHeaders defaultRequest + } + response <- runApp app request + responseStatus response `shouldBe` ok200 + responseBodyLbs response `shouldReturn` "\"Alice\"" + + it "disallows to access the request body" $ do + let server _user = return "foo" + app = serve (Proxy :: Proxy (InvalidAuthCombinator :> Get' String)) server + request = defaultRequest + runApp app request `shouldThrow` + errorCall "ERROR: makeAuthCombinator: combinator must not access the request body" + + describe "makeCombinator" $ do + it "allows to write a combinator by providing a function (Request -> a)" $ do + let server = return + app = serve (Proxy :: Proxy (FooHeader :> Get' String)) server + request = defaultRequest{ + requestHeaders = + ("Foo", "foo") : + requestHeaders defaultRequest + } + response <- runApp app request + responseBodyLbs response `shouldReturn` "\"foo\"" + + describe "makeReqBodyCombinator" $ do let toBody :: [IO SBS.ByteString] -> IO (IO SBS.ByteString) toBody list = do mvar <- newMVar list @@ -133,39 +161,12 @@ spec = do response <- runApp app request responseBodyLbs response `shouldReturn` "\"foobar\"" - it "allows to write a combinator that errors out" $ do - let server = return - app = serve (Proxy :: Proxy (StringCapture :> Get' String)) server - request = defaultRequest { - rawPathInfo = "/error", - pathInfo = ["error"] - } - response <- runApp app request - responseStatus response `shouldBe` status418 - - it "disallows to access the request body unless in the checkBody phase" $ do - let server = return () - app = serve (Proxy :: Proxy (InvalidRequestCheckCombinator :> Get' ())) server - request = defaultRequest - runApp app request `shouldThrow` - errorCall "ERROR: makeRequestCheckCombinator: combinator must not access the request body" - - it "disallows to access the request body unless in the auth phase" $ do - let server _user = return "foo" - app = serve (Proxy :: Proxy (InvalidAuthCombinator :> Get' String)) server - request = defaultRequest - runApp app request `shouldThrow` - errorCall "ERROR: makeAuthCombinator: combinator must not access the request body" - -- fixme: reorder tests it "allows to access the context" $ do pending - it "allows to write combinators without args" $ do - pending - - it "allows to implement combinators based in terms of existing combinators" $ do + it "allows to implement combinators in terms of existing combinators" $ do pending type Get' = Get '[JSON]