git.iko.soy/servant
on master help sign in
Modify BaseUrl tests and add some new BaseUrl tests to check if paths are correctly used
b389179Arian van Putten
servant-client/test/Servant/Common/BaseUrlSpec.hs+21−10
compare with master
unifiedsplit
@@ -15,14 +15,17 @@ spec :: Spec
15spec = do
15spec = do
16 describe "showBaseUrl" $ do
16 describe "showBaseUrl" $ do
17 it "shows a BaseUrl" $ do
17 it "shows a BaseUrl" $ do
18− showBaseUrl (BaseUrl Http "foo.com" 80) `shouldBe` "http://foo.com"
18+ showBaseUrl (BaseUrl Http "foo.com" 80 "") `shouldBe` "http://foo.com"
19−
20 it "shows a https BaseUrl" $ do
19 it "shows a https BaseUrl" $ do
21− showBaseUrl (BaseUrl Https "foo.com" 443) `shouldBe` "https://foo.com"
20+ showBaseUrl (BaseUrl Https "foo.com" 443 "") `shouldBe` "https://foo.com"
21+ it "shows the path of a BaseUrl" $ do
22+ showBaseUrl (BaseUrl Http "foo.com" 80 "api") `shouldBe` "http://foo.com/api"
23+ it "shows the path of an https BaseUrl" $ do
24+ showBaseUrl (BaseUrl Https "foo.com" 80 "api") `shouldBe` "https://foo.com/api"
22
25
23 describe "httpBaseUrl" $ do
26 describe "httpBaseUrl" $ do
24 it "allows to construct default http BaseUrls" $ do
27 it "allows to construct default http BaseUrls" $ do
25− BaseUrl Http "bar" 80 `shouldBe` BaseUrl Http "bar" 80
28+ BaseUrl Http "bar" 80 "" `shouldBe` BaseUrl Http "bar" 80 ""
26
29
27 describe "parseBaseUrl" $ do
30 describe "parseBaseUrl" $ do
28 it "is total" $ do
31 it "is total" $ do
@@ -35,15 +38,21 @@ spec = do
35 parseBaseUrl (showBaseUrl baseUrl) ===
38 parseBaseUrl (showBaseUrl baseUrl) ===
36 Right baseUrl
39 Right baseUrl
37
40
41+ context "trailing slashes" $ do
38− it "allows trailing slashes" $ do
42+ it "allows trailing slashes" $ do
43+ parseBaseUrl "foo.com/" `shouldBe` Right (BaseUrl Http "foo.com" 80 "")
44+ it "allows trailing slashes in paths" $ do
39− parseBaseUrl "foo.com/" `shouldBe` Right (BaseUrl Http "foo.com" 80)
45+ parseBaseUrl "foo.com/api/" `shouldBe` Right (BaseUrl Http "foo.com" 80 "api")
40
46
41 context "urls without scheme" $ do
47 context "urls without scheme" $ do
42 it "assumes http" $ do
48 it "assumes http" $ do
43− parseBaseUrl "foo.com" `shouldBe` Right (BaseUrl Http "foo.com" 80)
49+ parseBaseUrl "foo.com" `shouldBe` Right (BaseUrl Http "foo.com" 80 "")
44
50
45 it "allows port numbers" $ do
51 it "allows port numbers" $ do
46− parseBaseUrl "foo.com:8080" `shouldBe` Right (BaseUrl Http "foo.com" 8080)
52+ parseBaseUrl "foo.com:8080" `shouldBe` Right (BaseUrl Http "foo.com" 8080 "")
53+
54+ it "can parse paths" $ do
55+ parseBaseUrl "http://foo.com/api" `shouldBe` Right (BaseUrl Http "foo.com" 80 "api")
47
56
48 it "rejects ftp urls" $ do
57 it "rejects ftp urls" $ do
49 parseBaseUrl "ftp://foo.com" `shouldSatisfy` isLeft
58 parseBaseUrl "ftp://foo.com" `shouldSatisfy` isLeft
@@ -52,12 +61,13 @@ instance Arbitrary BaseUrl where
52 arbitrary = BaseUrl <$>
61 arbitrary = BaseUrl <$>
53 elements [Http, Https] <*>
62 elements [Http, Https] <*>
54 hostNameGen <*>
63 hostNameGen <*>
55− portGen
64+ portGen <*>
65+ pathGen
56 where
66 where
67+ letters = ['a' .. 'z'] ++ ['A' .. 'Z']
57 -- this does not perfectly mirror the url standard, but I hope it's good
68 -- this does not perfectly mirror the url standard, but I hope it's good
58 -- enough.
69 -- enough.
59 hostNameGen = do
70 hostNameGen = do
60− let letters = ['a' .. 'z'] ++ ['A' .. 'Z']
61 first <- elements letters
71 first <- elements letters
62 middle <- listOf1 $ elements (letters ++ ['0' .. '9'] ++ ['.', '-'])
72 middle <- listOf1 $ elements (letters ++ ['0' .. '9'] ++ ['.', '-'])
63 last <- elements letters
73 last <- elements letters
@@ -67,6 +77,7 @@ instance Arbitrary BaseUrl where
67 (1, return 443) :
77 (1, return 443) :
68 (1, choose (1, 20000)) :
78 (1, choose (1, 20000)) :
69 []
79 []
80+ pathGen = listOf1 . elements $ letters
70
81
71isLeft :: Either a b -> Bool
82isLeft :: Either a b -> Bool
72isLeft = either (const True) (const False)
83isLeft = either (const True) (const False)