eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Modify BaseUrl tests and add some new BaseUrl tests to check if paths are correctly used

Browse source
This commit is contained in:
Arian van Putten 2015-10-05 09:40:53 +02:00
parent 8cf4acf2fc
commit b389179590
1 changed files with 21 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
servant-client/test/Servant/Common/BaseUrlSpec.hs
View file

@ -15,14 +15,17 @@ spec :: Spec
spec = do spec = do
describe "showBaseUrl" $ do describe "showBaseUrl" $ do
it "shows a BaseUrl" $ 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 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 describe "httpBaseUrl" $ do
it "allows to construct default http BaseUrls" $ 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 describe "parseBaseUrl" $ do
it "is total" $ do it "is total" $ do
@ -35,15 +38,21 @@ spec = do
parseBaseUrl (showBaseUrl baseUrl) === parseBaseUrl (showBaseUrl baseUrl) ===
Right baseUrl Right baseUrl
context "trailing slashes" $ do
it "allows trailing slashes" $ do it "allows trailing slashes" $ do
parseBaseUrl "foo.com/" `shouldBe` Right (BaseUrl Http "foo.com" 80) 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 context "urls without scheme" $ do
it "assumes http" $ 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 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 it "rejects ftp urls" $ do
parseBaseUrl "ftp://foo.com" `shouldSatisfy` isLeft parseBaseUrl "ftp://foo.com" `shouldSatisfy` isLeft
@ -52,12 +61,13 @@ instance Arbitrary BaseUrl where
arbitrary = BaseUrl <$> arbitrary = BaseUrl <$>
elements [Http, Https] <*> elements [Http, Https] <*>
hostNameGen <*> hostNameGen <*>
portGen portGen <*>
pathGen
where where
letters = ['a' .. 'z'] ++ ['A' .. 'Z']
-- this does not perfectly mirror the url standard, but I hope it's good -- this does not perfectly mirror the url standard, but I hope it's good
-- enough. -- enough.
hostNameGen = do hostNameGen = do
let letters = ['a' .. 'z'] ++ ['A' .. 'Z']
first <- elements letters first <- elements letters
middle <- listOf1 $ elements (letters ++ ['0' .. '9'] ++ ['.', '-']) middle <- listOf1 $ elements (letters ++ ['0' .. '9'] ++ ['.', '-'])
last <- elements letters last <- elements letters
@ -67,6 +77,7 @@ instance Arbitrary BaseUrl where
(1, return 443) : (1, return 443) :
(1, choose (1, 20000)) : (1, choose (1, 20000)) :
[] []
pathGen = listOf1 . elements $ letters
isLeft :: Either a b -> Bool isLeft :: Either a b -> Bool
isLeft = either (const True) (const False) isLeft = either (const True) (const False)