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

Cleanup BaseUrl tests

Browse source
This commit is contained in:
Julian K. Arni 2015-10-07 18:01:47 +02:00
parent 59d8824888
commit 47f4cec53b
1 changed files with 11 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -13,6 +13,7 @@ import Servant.Common.BaseUrl
spec :: Spec spec :: Spec
spec = do spec = do
let parse = parseBaseUrl :: String -> Maybe BaseUrl
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"
@ -30,33 +31,31 @@ spec = do
describe "parseBaseUrl" $ do describe "parseBaseUrl" $ do
it "is total" $ do it "is total" $ do
property $ \ string -> property $ \ string ->
deepseq (fmap show (parseBaseUrl string :: Maybe BaseUrl)) True deepseq (fmap show (parse string )) True
it "is the inverse of showBaseUrl" $ do it "is the inverse of showBaseUrl" $ do
property $ \ baseUrl -> property $ \ baseUrl ->
counterexample (showBaseUrl baseUrl) $ counterexample (showBaseUrl baseUrl) $ parse (showBaseUrl baseUrl) === Just baseUrl
(parseBaseUrl (showBaseUrl baseUrl) :: Maybe BaseUrl) ===
Just baseUrl
context "trailing slashes" $ do context "trailing slashes" $ do
it "allows trailing slashes" $ do it "allows trailing slashes" $ do
(parseBaseUrl "foo.com/" :: Maybe BaseUrl)`shouldBe` Just (BaseUrl Http "foo.com" 80 "") parse "foo.com/" `shouldBe` Just (BaseUrl Http "foo.com" 80 "")
it "allows trailing slashes in paths" $ do it "allows trailing slashes in paths" $ do
(parseBaseUrl "foo.com/api/" :: Maybe BaseUrl) `shouldBe` Just (BaseUrl Http "foo.com" 80 "api") parse "foo.com/api/" `shouldBe` Just (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" :: Maybe BaseUrl) `shouldBe` Just (BaseUrl Http "foo.com" 80 "") parse "foo.com" `shouldBe` Just (BaseUrl Http "foo.com" 80 "")
it "allows port numbers" $ do it "allows port numbers" $ do
(parseBaseUrl "foo.com:8080" :: Maybe BaseUrl) `shouldBe` Just (BaseUrl Http "foo.com" 8080 "") parse "foo.com:8080" `shouldBe` Just (BaseUrl Http "foo.com" 8080 "")
it "can parse paths" $ do it "can parse paths" $ do
(parseBaseUrl "http://foo.com/api" :: Maybe BaseUrl) `shouldBe` Just (BaseUrl Http "foo.com" 80 "api") parse "http://foo.com/api" `shouldBe` Just (BaseUrl Http "foo.com" 80 "api")
it "rejects ftp urls" $ do it "rejects ftp urls" $ do
(parseBaseUrl "ftp://foo.com" :: Maybe BaseUrl) `shouldBe` Nothing (parse "ftp://foo.com") `shouldBe` Nothing
instance Arbitrary BaseUrl where instance Arbitrary BaseUrl where
arbitrary = BaseUrl <$> arbitrary = BaseUrl <$>
@ -71,8 +70,8 @@ instance Arbitrary BaseUrl where
hostNameGen = do hostNameGen = do
first <- elements letters first <- elements letters
middle <- listOf1 $ elements (letters ++ ['0' .. '9'] ++ ['.', '-']) middle <- listOf1 $ elements (letters ++ ['0' .. '9'] ++ ['.', '-'])
last <- elements letters last' <- elements letters
return (first : middle ++ [last]) return (first : middle ++ [last'])
portGen = frequency $ portGen = frequency $
(1, return 80) : (1, return 80) :
(1, return 443) : (1, return 443) :