@@ -0,0 +1,69 @@
1+{-# OPTIONS_GHC -fno-warn-orphans #-}
2+module Servant.Client.BaseUrlSpec where
3+
4+import Control.Applicative
5+import Control.DeepSeq
6+import Test.Hspec
7+import Test.QuickCheck
8+
9+import Servant.Client.BaseUrl
10+
11+spec :: Spec
12+spec = do
13+ describe "showBaseUrl" $ do
14+ it "shows a BaseUrl" $ do
15+ showBaseUrl (BaseUrl Http "foo.com" 80) `shouldBe` "http://foo.com"
16+
17+ it "shows a https BaseUrl" $ do
18+ showBaseUrl (BaseUrl Https "foo.com" 443) `shouldBe` "https://foo.com"
19+
20+ describe "httpBaseUrl" $ do
21+ it "allows to construct default http BaseUrls" $ do
22+ BaseUrl Http "bar" 80 `shouldBe` BaseUrl Http "bar" 80
23+
24+ describe "parseBaseUrl" $ do
25+ it "is total" $ do
26+ property $ \ string ->
27+ deepseq (fmap show (parseBaseUrl string)) True
28+
29+ it "is the inverse of showBaseUrl" $ do
30+ property $ \ baseUrl ->
31+ counterexample (showBaseUrl baseUrl) $
32+ parseBaseUrl (showBaseUrl baseUrl) ===
33+ Right baseUrl
34+
35+ it "allows trailing slashes" $ do
36+ parseBaseUrl "foo.com/" `shouldBe` Right (BaseUrl Http "foo.com" 80)
37+
38+ context "urls without scheme" $ do
39+ it "assumes http" $ do
40+ parseBaseUrl "foo.com" `shouldBe` Right (BaseUrl Http "foo.com" 80)
41+
42+ it "allows port numbers" $ do
43+ parseBaseUrl "foo.com:8080" `shouldBe` Right (BaseUrl Http "foo.com" 8080)
44+
45+ it "rejects ftp urls" $ do
46+ parseBaseUrl "ftp://foo.com" `shouldSatisfy` isLeft
47+
48+instance Arbitrary BaseUrl where
49+ arbitrary = BaseUrl <$>
50+ elements [Http, Https] <*>
51+ hostNameGen <*>
52+ portGen
53+ where
54+ -- this does not perfectly mirror the url standard, but I hope it's good
55+ -- enough.
56+ hostNameGen = do
57+ let letters = ['a' .. 'z'] ++ ['A' .. 'Z']
58+ first <- elements letters
59+ middle <- listOf1 $ elements (letters ++ ['0' .. '9'] ++ ['.', '-'])
60+ last <- elements letters
61+ return (first : middle ++ [last])
62+ portGen = frequency $
63+ (1, return 80) :
64+ (1, return 443) :
65+ (1, choose (1, 20000)) :
66+ []
67+
68+isLeft :: Either a b -> Bool
69+isLeft = either (const True) (const False)