diff --git a/servant-client/test/Servant/Common/BaseUrlSpec.hs b/servant-client/test/Servant/Common/BaseUrlSpec.hs index cf615f9c..43782a90 100644 --- a/servant-client/test/Servant/Common/BaseUrlSpec.hs +++ b/servant-client/test/Servant/Common/BaseUrlSpec.hs @@ -15,14 +15,17 @@ spec :: Spec spec = do describe "showBaseUrl" $ do it "shows a BaseUrl" $ do - showBaseUrl (BaseUrl Http "foo.com" 80) `shouldBe` "http://foo.com" - + showBaseUrl (BaseUrl Http "foo.com" 80 "") `shouldBe` "http://foo.com" it "shows a https BaseUrl" $ do - showBaseUrl (BaseUrl Https "foo.com" 443) `shouldBe` "https://foo.com" + showBaseUrl (BaseUrl Https "foo.com" 443 "") `shouldBe` "https://foo.com" + it "shows the path of a BaseUrl" $ do + showBaseUrl (BaseUrl Http "foo.com" 80 "api") `shouldBe` "http://foo.com/api" + it "shows the path of an https BaseUrl" $ do + showBaseUrl (BaseUrl Https "foo.com" 80 "api") `shouldBe` "https://foo.com/api" describe "httpBaseUrl" $ do it "allows to construct default http BaseUrls" $ do - BaseUrl Http "bar" 80 `shouldBe` BaseUrl Http "bar" 80 + BaseUrl Http "bar" 80 "" `shouldBe` BaseUrl Http "bar" 80 "" describe "parseBaseUrl" $ do it "is total" $ do @@ -35,15 +38,21 @@ spec = do parseBaseUrl (showBaseUrl baseUrl) === Right baseUrl - it "allows trailing slashes" $ do - parseBaseUrl "foo.com/" `shouldBe` Right (BaseUrl Http "foo.com" 80) + context "trailing slashes" $ do + it "allows trailing slashes" $ do + parseBaseUrl "foo.com/" `shouldBe` Right (BaseUrl Http "foo.com" 80 "") + it "allows trailing slashes in paths" $ do + parseBaseUrl "foo.com/api/" `shouldBe` Right (BaseUrl Http "foo.com" 80 "api") context "urls without scheme" $ do it "assumes http" $ do - parseBaseUrl "foo.com" `shouldBe` Right (BaseUrl Http "foo.com" 80) + parseBaseUrl "foo.com" `shouldBe` Right (BaseUrl Http "foo.com" 80 "") it "allows port numbers" $ do - parseBaseUrl "foo.com:8080" `shouldBe` Right (BaseUrl Http "foo.com" 8080) + parseBaseUrl "foo.com:8080" `shouldBe` Right (BaseUrl Http "foo.com" 8080 "") + + it "can parse paths" $ do + parseBaseUrl "http://foo.com/api" `shouldBe` Right (BaseUrl Http "foo.com" 80 "api") it "rejects ftp urls" $ do parseBaseUrl "ftp://foo.com" `shouldSatisfy` isLeft @@ -52,12 +61,13 @@ instance Arbitrary BaseUrl where arbitrary = BaseUrl <$> elements [Http, Https] <*> hostNameGen <*> - portGen + portGen <*> + pathGen where + letters = ['a' .. 'z'] ++ ['A' .. 'Z'] -- this does not perfectly mirror the url standard, but I hope it's good -- enough. hostNameGen = do - let letters = ['a' .. 'z'] ++ ['A' .. 'Z'] first <- elements letters middle <- listOf1 $ elements (letters ++ ['0' .. '9'] ++ ['.', '-']) last <- elements letters @@ -67,6 +77,7 @@ instance Arbitrary BaseUrl where (1, return 443) : (1, choose (1, 20000)) : [] + pathGen = listOf1 . elements $ letters isLeft :: Either a b -> Bool isLeft = either (const True) (const False)