93195ab · servant · git.iko.soy

example/greet.hs+1

compare with master

unifiedsplit

@@ -20,6 +20,7 @@ import Network.Wai.Handler.Warp

20

21import Servant.API

22import Servant.Client

23+import Servant.Client.BaseUrl

23import Servant.Docs

24import Servant.Docs

24import Servant.Server

25import Servant.Server

25

26

servant.cabal+2

@@ -15,6 +15,7 @@ library

15 exposed-modules:

16 Servant

17 Servant.Client

18+ Servant.Client.BaseUrl

18 Servant.Docs

19 Servant.Docs

19 Servant.Server

20 Servant.Server

20 Servant.API

21 Servant.API

@@ -82,6 +83,7 @@ test-suite spec

82 base == 4.*

83 base == 4.*

83 , aeson

84 , aeson

84 , bytestring

85 , bytestring

86+ , deepseq

85 , either

87 , either

86 , exceptions

88 , exceptions

87 , hspec2

89 , hspec2

src/Servant.hs+2

@@ -7,6 +7,7 @@ module Servant (

7 module Servant.Server,

8 -- | For accessing servant APIs as API clients.

9 module Servant.Client,

10+ module Servant.Client.BaseUrl,

10 -- | For generating documentation for servant APIs.

11 -- | For generating documentation for servant APIs.

11 module Servant.Docs,

12 module Servant.Docs,

12 -- | Helper module

13 -- | Helper module

@@ -15,6 +16,7 @@ module Servant (

15

16

16import Servant.API

17import Servant.API

17import Servant.Client

18import Servant.Client

19+import Servant.Client.BaseUrl

18import Servant.Docs

20import Servant.Docs

19import Servant.Server

21import Servant.Server

20import Servant.Utils.Text

22import Servant.Utils.Text

src/Servant/API/Delete.hs+1

@@ -11,6 +11,7 @@ import Data.Typeable

11import Network.HTTP.Types

12import Network.Wai

13import Servant.Client

14+import Servant.Client.BaseUrl

14import Servant.Docs

15import Servant.Docs

15import Servant.Server

16import Servant.Server

16import Servant.Utils.Client

17import Servant.Utils.Client

src/Servant/API/Get.hs+1

@@ -12,6 +12,7 @@ import Data.Typeable

12import Network.HTTP.Types

13import Network.Wai

14import Servant.Client

15+import Servant.Client.BaseUrl

15import Servant.Docs

16import Servant.Docs

16import Servant.Server

17import Servant.Server

17import Servant.Utils.Client

18import Servant.Utils.Client

src/Servant/API/Post.hs+1

@@ -12,6 +12,7 @@ import Data.Typeable

12import Network.HTTP.Types

13import Network.Wai

14import Servant.Client

15+import Servant.Client.BaseUrl

15import Servant.Docs

16import Servant.Docs

16import Servant.Server

17import Servant.Server

17import Servant.Utils.Client

18import Servant.Utils.Client

src/Servant/API/Put.hs+1

@@ -12,6 +12,7 @@ import Data.Typeable

12import Network.HTTP.Types

13import Network.Wai

14import Servant.Client

15+import Servant.Client.BaseUrl

15import Servant.Docs

16import Servant.Docs

16import Servant.Server

17import Servant.Server

17import Servant.Utils.Client

18import Servant.Utils.Client

src/Servant/Client.hs+2−15

@@ -1,6 +1,5 @@

1{-# LANGUAGE TypeFamilies #-}

2{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE DeriveGeneric #-}

4module Servant.Client where

3module Servant.Client where

5

4

6import Control.Concurrent

5import Control.Concurrent

@@ -8,26 +7,14 @@ import Control.Monad.Catch

8import Data.ByteString.Lazy

7import Data.ByteString.Lazy

9import Data.Proxy

8import Data.Proxy

10import Data.Text

9import Data.Text

11−import GHC.Generics

12import Network.HTTP.Client hiding (Proxy)

10import Network.HTTP.Client hiding (Proxy)

13import Network.HTTP.Types

11import Network.HTTP.Types

14import Network.URI

12import Network.URI

15import System.IO.Unsafe

13import System.IO.Unsafe

16

14

17−-- * Accessing APIs as a Client

15+import Servant.Client.BaseUrl

18−

19−data Scheme = Http | Https

20− deriving (Show, Eq, Ord, Generic)

21

16

22−data BaseUrl = BaseUrl {

17+-- * Accessing APIs as a Client

23− baseUrlScheme :: Scheme,

24− baseUrlHost :: String,

25− baseUrlPort :: Int

26− }

27− deriving (Show, Eq, Ord, Generic)

28−

29−httpBaseUrl :: String -> BaseUrl

30−httpBaseUrl host = BaseUrl Http host 80

31

18

32-- | 'client' allows you to produce operations to query an API from a client.

19-- | 'client' allows you to produce operations to query an API from a client.

33client :: HasClient layout => Proxy layout -> Client layout

20client :: HasClient layout => Proxy layout -> Client layout

src/Servant/Client/BaseUrl.hsnew file+51

@@ -0,0 +1,51 @@

1+{-# LANGUAGE DeriveGeneric #-}

2+{-# LANGUAGE ViewPatterns #-}

3+module Servant.Client.BaseUrl where

4+

5+import Data.List

6+import GHC.Generics

7+import Network.URI

8+import Safe

9+import Text.Read

10+

11+data Scheme = Http | Https

12+ deriving (Show, Eq, Ord, Generic)

13+

14+data BaseUrl = BaseUrl {

15+ baseUrlScheme :: Scheme,

16+ baseUrlHost :: String,

17+ baseUrlPort :: Int

18+ }

19+ deriving (Show, Eq, Ord, Generic)

20+

21+showBaseUrl :: BaseUrl -> String

22+showBaseUrl (BaseUrl scheme host port) =

23+ schemeString ++ "//" ++ host ++ portString

24+ where

25+ schemeString = case scheme of

26+ Http -> "http:"

27+ Https -> "https:"

28+ portString = case (scheme, port) of

29+ (Http, 80) -> ""

30+ (Https, 443) -> ""

31+ _ -> ":" ++ show port

32+

33+parseBaseUrl :: String -> Either String BaseUrl

34+parseBaseUrl s = case parseURI (removeTrailingSlash s) of

35+ -- This is a rather hacky implementation and should be replaced with something

36+ -- implemented in attoparsec (which is already a dependency anyhow (via aeson)).

37+ Just (URI "http:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) "" "" "") ->

38+ Right (BaseUrl Http host port)

39+ Just (URI "http:" (Just (URIAuth "" host "")) "" "" "") ->

40+ Right (BaseUrl Http host 80)

41+ Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) "" "" "") ->

42+ Right (BaseUrl Https host port)

43+ Just (URI "https:" (Just (URIAuth "" host "")) "" "" "") ->

44+ Right (BaseUrl Https host 443)

45+ _ -> if "://" `isInfixOf` s

46+ then Left ("invalid base url: " ++ s)

47+ else parseBaseUrl ("http://" ++ s)

48+ where

49+ removeTrailingSlash s = case lastMay s of

50+ Just '/' -> init s

51+ _ -> s

src/Servant/Utils/Client.hs+1

@@ -14,6 +14,7 @@ import Data.ByteString.Lazy

14import Data.String.Conversions

15import Network.HTTP.Types

16import Servant.Client

17+import Servant.Client.BaseUrl

17

18

18import qualified Network.HTTP.Client as Client

19import qualified Network.HTTP.Client as Client

19

20

test/Servant/Client/BaseUrlSpec.hsnew file+69

@@ -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)

test/Servant/ClientSpec.hs+2−1

@@ -21,6 +21,7 @@ import Test.QuickCheck

21

22import Servant.API

23import Servant.Client

24+import Servant.Client.BaseUrl

24import Servant.Server

25import Servant.Server

25

26

26import Servant.ServerSpec

27import Servant.ServerSpec

@@ -157,7 +158,7 @@ withWaiDaemon mkApplication action = do

157 runSettingsSocket settings socket application)

158 runSettingsSocket settings socket application)

158 `finally` notifyKilled ()

159 `finally` notifyKilled ()

159 krakenPort <- waitForStart

160 krakenPort <- waitForStart

160− let baseUrl = (httpBaseUrl "localhost"){baseUrlPort = krakenPort}

161+ let baseUrl = (BaseUrl Http "localhost" 80){baseUrlPort = krakenPort}

161 return (thread, waitForKilled, baseUrl)

162 return (thread, waitForKilled, baseUrl)

162 free (thread, waitForKilled, _) = do

163 free (thread, waitForKilled, _) = do

163 killThread thread

164 killThread thread