symantic-http-test 0.0.0.20190324 → 0.0.1.20190410

raw patch · 9 files changed

+344/−6 lines, 9 filesdep ~symantic-httpdep ~symantic-http-server

Dependency ranges changed: symantic-http, symantic-http-server

Files

• Hspec/Client.hs +2/−0
• Hspec/Client/BasicAuth.hs +1/−0
• Hspec/Client/Raw.hs +57/−0
• Hspec/Server.hs +4/−0
• Hspec/Server/Error.hs +0/−1
• Hspec/Server/Raw.hs +39/−0
• Hspec/Server/Router.hs +186/−0
• Hspec/Utils.hs +49/−2
• symantic-http-test.cabal +6/−3

@@ -2,8 +2,10 @@  import Hspec.Utils import qualified Hspec.Client.BasicAuth+import qualified Hspec.Client.Raw  hspec :: IO [TestTree] hspec = do 	return . testGroup "Client" 	 <$> Hspec.Client.BasicAuth.hspec+	 <>  Hspec.Client.Raw.hspec

@@ -25,6 +25,7 @@ import Symantic.HTTP import Symantic.HTTP.Client import Symantic.HTTP.Server+import Hspec.Utils () import Hspec.Utils.Server  api =

@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-}+module Hspec.Client.Raw where++import Data.Either (Either(..))+import Data.Function (($))+import System.IO (IO)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec+import Test.Tasty.HUnit (assertFailure)+import Text.Show (Show(..))+import qualified Network.HTTP.Client as Client+import qualified Network.HTTP.Types as HTTP+import qualified Network.Wai as Wai++import Symantic.HTTP+import Symantic.HTTP.Client+import Symantic.HTTP.Server+import Hspec.Utils+import Hspec.Utils.Server++api = "success" </> raw+  <!> "failure" </> raw++srv = server api $+	route_success :!:+	route_failure+	where+	route_success _req res = res $ Wai.responseLBS HTTP.ok200 [] "rawSuccess"+	route_failure _req res = res $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure"++cli_success+ :!: cli_failure+ = client api++hspec :: IO [TestTree]+hspec = testSpecs $ describe "raw" $+	beforeAll (runTestServer srv) $+	afterAll killTestServer $ do+		it "raw on success" $ \TestServer{..} -> do+			res <- runClient env (cli_success HTTP.methodGet)+			case res of+			 Left e -> assertFailure $ show e+			 Right r -> do+				Client.responseStatus r `shouldBe` HTTP.status200+				Client.responseBody   r `shouldBe` "rawSuccess"+		it "raw should return a Left in case of failure" $ \TestServer{..} -> do+			res <- runClient env (cli_failure HTTP.methodGet)+			case res of+			 Right (_a::ClientResponse) -> do+				assertFailure "expected Left, but got Right"+			 Left (ClientError_FailureResponse r) -> do+				Client.responseStatus r `shouldBe` HTTP.status400+				Client.responseBody   r `shouldBe` "rawFailure"+			 Left e -> assertFailure $ "expected FailureResponse, but got " <> show e

@@ -2,8 +2,12 @@  import Hspec.Utils import qualified Hspec.Server.Error+import qualified Hspec.Server.Raw+import qualified Hspec.Server.Router  hspec :: IO [TestTree] hspec = do 	return . testGroup "Server" 	 <$> Hspec.Server.Error.hspec+	 <>  Hspec.Server.Raw.hspec+	 <>  Hspec.Server.Router.hspec

@@ -120,7 +120,6 @@ 				expectationFailure $ "badParam + badBody == badBody: " 				 <> show badBothRes - badContentType  = (HTTP.hContentType, "application/json") badAccept       = (HTTP.hAccept, "application/json") badMethod       = HTTP.methodGet

@@ -0,0 +1,39 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS -Wno-missing-signatures #-}+module Hspec.Server.Raw where++import Data.Int (Int)+import Data.String (String, IsString(..))+import System.IO (IO)+import Text.Show (Show(..))+import qualified Control.Monad.Classes as MC+import qualified Network.HTTP.Types as HTTP+import qualified Network.Wai as Wai+import qualified Network.Wai.Test as Wai+import qualified Network.Wai.Test+import Data.Function (const)++import Symantic.HTTP+import Symantic.HTTP.Server+import Hspec.Utils++api = "foo" </> raw++rawApplication :: Show a => (Wai.Request -> a) -> Wai.Application+rawApplication f req res =+	res $ Wai.responseLBS HTTP.ok200 [] (fromString $ show $ f req)++hspec = testSpecs $ describe "Raw" $ do+	it "runs applications" $ do+		(`Wai.runSession` server api (rawApplication (const (42 :: Int)))) $ do+			res <- Network.Wai.Test.request Wai.defaultRequest+			 { Wai.pathInfo = ["foo"] }+			MC.exec @IO $ do+				Wai.simpleBody res `shouldBe` "42"+	it "gets the pathInfo modified" $ do+		(`Wai.runSession` server api (rawApplication Wai.pathInfo)) $ do+			res <- Network.Wai.Test.request Wai.defaultRequest+			 { Wai.pathInfo = ["foo", "bar"] }+			MC.exec @IO $ do+				Wai.simpleBody res `shouldBe` fromString (show ["bar" :: String])

@@ -0,0 +1,186 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS -Wno-missing-signatures #-}+{-# OPTIONS -Wno-orphans #-}+module Hspec.Server.Router where++import Control.Monad (unless)+import Data.Bool+import Data.Char (Char)+import Data.Eq (Eq(..))+import Data.Int (Int)+import Data.String (String)+import System.IO (IO, putStrLn)+import Text.Show (Show(..))+import qualified Control.Monad.Classes as MC+import qualified Data.List as List+import qualified Data.Map.Strict as Map+import qualified Network.Wai.Handler.Warp as Warp+import qualified Test.Hspec as Hspec++import Symantic.HTTP+import Symantic.HTTP.Server+import Hspec.Utils++hspec = testSpecs $ describe "Router" $ do+	it "distributes endpoints through static paths" $ do+		inp_Endpoint `shouldRouteAs` exp_Endpoint+	it "distributes nested routes through static paths" $ do+		inp_Static `shouldRouteAs` exp_Static+	it "properly reorders permuted static paths" $ do+		inp_Permute `shouldRouteAs` exp_Permute+	it "properly reorders permuted static paths in the presence of raw in end" $ do+		inp_PermuteRawEnd `shouldRouteAs` exp_PermuteRawEnd+	it "properly reorders permuted static paths in the presence of raw in beginning" $ do+		inp_PermuteRawBegin `shouldRouteAs` exp_PermuteRawBegin+	it "properly reorders permuted static paths in the presence of raw in middle" $ do+		inp_PermuteRawMiddle `shouldRouteAs` exp_PermuteRawMiddle+	{- NOTE: this is semantically incorrect.+	it "distributes nested routes through dynamic paths" $ do+		inp_Dynamic `shouldRouteAs` exp_Dynamic+	-}+	it "properly handles mixing static paths at different levels" $ do+		inp_Level `shouldRouteAs` exp_Level++-- * Utils++routerEq ::+ forall repr a b c d. repr ~ Server =>+ Router repr a b -> Router repr c d -> Bool+routerEq x0 y0 =+	{-+	let r = go+		 (Dbg.trace ("eq: x: " <> show x0) x0)+		 (Dbg.trace ("eq: y: " <> show y0) y0) in+	Dbg.trace ("eq: r: " <> show r) r+	-}+	go x0 y0+	where+	go :: Router repr a b -> Router repr c d -> Bool+	go (Router_Seg x) (Router_Seg y) = x == y+	go (Router_Cat xa xb) (Router_Cat ya yb) = routerEq xa ya && routerEq xb yb+	go (Router_Alt xl xr) (Router_Alt yl yr) = routerEq xl yl && routerEq xr yr+	go (Router_Cap xn) (Router_Cap yn) = xn == yn+	go (Router_Map xs) (Router_Map ys) =+		let xl = Map.toList xs in+		let yl = Map.toList ys in+		(List.length xl == List.length yl &&) $+		List.and $+			(\((kx, x),(ky, y)) -> kx==ky && routerEq x y) <$>+			List.zip xl yl+	go (Router_Caps xs) (Router_Caps ys) = goCaps xs ys+		where+		goCaps :: Captures (Router repr) xs b -> Captures (Router repr) ys d -> Bool+		goCaps (Captures0 _xa xn xr) (Captures0 _ya yn yr) = xn == yn && routerEq xr yr+		goCaps (Captures2 xx xy) (Captures2 yx yy) = goCaps xx yx && goCaps xy yy+		goCaps _ _ = False -- FIXME: may wrongly return False if captures are not in the same order+	go (Router_Union _u x) y = routerEq x y+	go x (Router_Union _u y) = routerEq x y+	go Router_Any{} Router_Any{} = True+	go _x _y = False++shouldRouteAs :: Router Server a b -> Router Server c d -> Hspec.Expectation+shouldRouteAs inp exp =+	let inpR = router inp in+	let expR = router exp in+	unless (inpR`routerEq`expR) $+		Hspec.expectationFailure $ "expected:\n" <> show expR <> "\nbut got:\n" <> show inpR++-- * APIs++end = get @String @'[PlainText]++inp_Endpoint = "a" </> end <!> "a" </> end+exp_Endpoint = "a" </> (end <!> end)++inp_Static = "a" </> "b" </> end <!> "a" </> "c" </> end+exp_Static = "a" </> ("b" </> end <!> "c" </> end)++{-+inp_Dynamic =+     "a" </> capture @Int  "foo" <.> "b" </> end+ <!> "a" </> capture @Bool "bar" <.> "c" </> end+ <!> "a" </> capture @Char "baz" <.> "d" </> end+exp_Dynamic =+ "a" </> captures (Captures2 (Captures2 (Captures0 (Proxy @(Int -> Res)) "foo")+                                        (Captures0 (Proxy @(Bool -> Res)) "bar"))+                             (Captures0 (Proxy @(Char -> Res)) "baz"))+     <.> ("b" </> end <!> "c" </> end <!> "d" </> end)+type Res = ResponseArgs (Router Server) String '[PlainText]+-}++inp_Permute =+     "a" </> "b" </> "c" </> end+ <!> "b" </> "a" </> "c" </> end+ <!> "a" </> "c" </> "b" </> end+ <!> "c" </> "a" </> "b" </> end+ <!> "b" </> "c" </> "a" </> end+ <!> "c" </> "b" </> "a" </> end+ <!> "a" </> "a" </> "b" </> end+ <!> "a" </> "a" </> "c" </> end+exp_Permute =+     "a" </> ("b" </> "c" </> end+          <!> "c" </> "b" </> end+          <!> "a" </> "b" </> end)+ <!> "b" </> ("a" </> "c" </> end+          <!> "c" </> "a" </> end)+ <!> "c" </> ("a" </> "b" </> end+          <!> "b" </> "a" </> end)+ <!> "a" </> "a" </> "c" </> end++inp_PermuteRawEnd =+     "a" </> "b" </> "c" </> end+ <!> "b" </> "a" </> "c" </> end+ <!> "a" </> "c" </> "b" </> end+ <!> "c" </> "a" </> "b" </> end+ <!> "b" </> "c" </> "a" </> end+ <!> "c" </> "b" </> "a" </> end+ <!> "a" </> "a" </> "b" </> end+ <!> "a" </> "a" </> "c" </> end+ <!> raw+exp_PermuteRawEnd = exp_Permute <!> raw++inp_PermuteRawBegin =+     raw+ <!> "a" </> "b" </> "c" </> end+ <!> "b" </> "a" </> "c" </> end+ <!> "a" </> "c" </> "b" </> end+ <!> "c" </> "a" </> "b" </> end+ <!> "b" </> "c" </> "a" </> end+ <!> "c" </> "b" </> "a" </> end+ <!> "a" </> "a" </> "b" </> end+ <!> "a" </> "a" </> "c" </> end+exp_PermuteRawBegin = raw <!> exp_Permute++inp_PermuteRawMiddle =+     "a" </> "b" </> "c" </> end+ <!> "b" </> "a" </> "c" </> end+ <!> "a" </> "c" </> "b" </> end+ <!> raw+ <!> "c" </> "a" </> "b" </> end+ <!> "b" </> "c" </> "a" </> end+ <!> "c" </> "b" </> "a" </> end+exp_PermuteRawMiddle =+     "a" </> ("b" </> "c" </> end <!>+              "c" </> "b" </> end)+ <!> "b" </> "a" </> "c" </> end+ <!> raw+ <!> "b" </> "c" </> "a" </> end+ <!> "c" </> ("a" </> "b" </> end <!>+              "b" </> "a" </> end)++inp_Level1 =+     "a" </> "b" </> end+ <!> "a" </> end+inp_Level2 =+     "b" </> end+ <!> "a" </> "c" </> end+ <!> end+inp_Level =+ inp_Level1 <!>+ inp_Level2+exp_Level =+     "a" </> ("b" </> end <!> "c" </> end <!> end)+ <!> "b" </> end+ <!> end

@@ -1,7 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-} module Hspec.Utils  ( module Test.Hspec  , module Test.Tasty  , module Test.Tasty.Hspec+ , module Hspec.Utils  , ($), (.)  , Functor(..), (<$>)  , Applicative(..)@@ -10,12 +13,56 @@  , IO  ) where +import Data.Bool+import Data.Eq (Eq(..))+import Data.Maybe (Maybe(..))+import Data.Ord (Ord(..))+import Data.Semigroup (Semigroup(..)) import Control.Applicative (Applicative(..)) import Control.Monad (Monad(..), (=<<))-import Data.Function (($), (.))+import Data.Function (($), (.), id) import Data.Functor (Functor(..), (<$>))-import Data.Semigroup (Semigroup(..)) import System.IO (IO) import Test.Hspec import Test.Tasty import Test.Tasty.Hspec+import Text.Show (Show(..), showString, showParen, ShowS)+import qualified Data.Map.Strict as Map+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Test.Hspec.Wai as Wai++import Symantic.HTTP+import Symantic.HTTP.Server++instance (repr ~ Server) => Show (Router repr a b) where+	showsPrec p = \case+	 Router_Any{} -> showString "X"+	 Router_Map ms -> showParen (p>=10) $ showString "map [" . go (Map.toList ms) . showString "]"+		where+		go :: forall h k. [(PathSegment, Router repr h k)] -> ShowS+		go [] = id+		go ((n, r):xs) =+			(showParen True $ showString (show n<>", ") . showsPrec 0 r) .+			case xs of+			 [] -> id+			 _ -> showString ", " . go xs+	 Router_Seg s -> showsPrec 10 s+	 Router_Cat x y -> showParen (p>=4) $ showsPrec 4 x . showString " <.> " . showsPrec 4 y+	 Router_Alt x y -> showParen (p>=3) $ showsPrec 3 x . showString " <!> " . showsPrec 3 y+	 Router_Cap n -> showString (":"<>n)+	 Router_Union _u x -> showsPrec p x+	 Router_Caps cs -> showParen (p>=10) $ showString "cap [" . go cs . showString "]"+		where+		go :: Captures (Router repr) cs k -> ShowS+		go (Captures0 _a n r) = showParen True $ showString (":"<>n<>", ") . showsPrec 0 r+		go (Captures2 x y) = go x . showString ", " . go y++mkBody :: Wai.Body -> Wai.MatchBody+mkBody b = Wai.MatchBody $ \_ b' ->+	if b == b'+	then Nothing+	else Just $ TL.unpack $+	 "expecting: "<>TL.decodeUtf8 b<>+	 " but got: "<>TL.decodeUtf8 b'<>"\n"+

@@ -2,7 +2,7 @@ -- PVP:  +-+------- breaking API changes --       | | +----- non-breaking API additions --       | | | +--- code changes with no API change-version: 0.0.0.20190324+version: 0.0.1.20190410 category: Protocol synopsis: Test symantic-http and its companion libraries description:@@ -41,9 +41,12 @@     Hspec     Hspec.Client     Hspec.Client.BasicAuth+    Hspec.Client.Raw     Hspec.Pipes     Hspec.Server     Hspec.Server.Error+    Hspec.Server.Raw+    Hspec.Server.Router     Hspec.Utils     Hspec.Utils.Server     -- HUnit@@ -71,9 +74,9 @@     -fno-warn-tabs     -fhide-source-paths   build-depends:-      symantic-http >= 0.0+      symantic-http >= 0.1.1     , symantic-http-client >= 0.0-    , symantic-http-server >= 0.0+    , symantic-http-server >= 0.1.1     , symantic-http-pipes >= 0.0     , base >= 4.10 && < 5     , base64-bytestring >= 1.0.0.1