servant/test/Servant/Client/BaseUrlSpec.hs

70 lines
2 KiB
Haskell
Raw Normal View History

2014-11-07 04:09:54 +01:00
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Client.BaseUrlSpec where
import Control.Applicative
import Control.DeepSeq
import Test.Hspec
import Test.QuickCheck
import Servant.Client.BaseUrl
spec :: Spec
spec = do
describe "showBaseUrl" $ do
it "shows a BaseUrl" $ do
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"
describe "httpBaseUrl" $ do
it "allows to construct default http BaseUrls" $ do
BaseUrl Http "bar" 80 `shouldBe` BaseUrl Http "bar" 80
describe "parseBaseUrl" $ do
it "is total" $ do
property $ \ string ->
deepseq (fmap show (parseBaseUrl string)) True
it "is the inverse of showBaseUrl" $ do
property $ \ baseUrl ->
counterexample (showBaseUrl baseUrl) $
parseBaseUrl (showBaseUrl baseUrl) ===
Right baseUrl
it "allows trailing slashes" $ do
parseBaseUrl "foo.com/" `shouldBe` Right (BaseUrl Http "foo.com" 80)
context "urls without scheme" $ do
it "assumes http" $ do
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)
it "rejects ftp urls" $ do
parseBaseUrl "ftp://foo.com" `shouldSatisfy` isLeft
instance Arbitrary BaseUrl where
arbitrary = BaseUrl <$>
elements [Http, Https] <*>
hostNameGen <*>
portGen
where
-- 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
return (first : middle ++ [last])
portGen = frequency $
(1, return 80) :
(1, return 443) :
(1, choose (1, 20000)) :
[]
isLeft :: Either a b -> Bool
isLeft = either (const True) (const False)