4238a58 · typeable/servant

servant-client/CHANGELOG.md+1

compare with master

unifiedsplit

@@ -2,6 +2,7 @@ HEAD

2----

3

4* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators

5+* Added support for `path` on `BaseUrl`.

5

6

60.4.1

70.4.1

7-----

8-----

servant-client/src/Servant/Common/BaseUrl.hs+12−11

@@ -15,7 +15,7 @@ import Control.Monad.Catch (Exception, MonadThrow, throwM)

15import Data.List

16import Data.Typeable

17import GHC.Generics

18−import Network.URI

18+import Network.URI hiding (path)

19import Safe

20import Text.Read

21

@@ -31,11 +31,12 @@ data BaseUrl = BaseUrl

31 { baseUrlScheme :: Scheme -- ^ URI scheme to use

32 , baseUrlHost :: String -- ^ host (eg "haskell.org")

33 , baseUrlPort :: Int -- ^ port (eg 80)

34+ , baseUrlPath :: String -- ^ path (eg "/a/b/c")

34 } deriving (Show, Eq, Ord, Generic)

35 } deriving (Show, Eq, Ord, Generic)

35

36

36showBaseUrl :: BaseUrl -> String

37showBaseUrl :: BaseUrl -> String

37−showBaseUrl (BaseUrl urlscheme host port) =

38+showBaseUrl (BaseUrl urlscheme host port path) =

38− schemeString ++ "//" ++ host ++ portString

39+ schemeString ++ "//" ++ host ++ portString ++ path

39 where

40 where

40 schemeString = case urlscheme of

41 schemeString = case urlscheme of

41 Http -> "http:"

42 Http -> "http:"

@@ -52,14 +53,14 @@ parseBaseUrl :: MonadThrow m => String -> m BaseUrl

52parseBaseUrl s = case parseURI (removeTrailingSlash s) of

53parseBaseUrl s = case parseURI (removeTrailingSlash s) of

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

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

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

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

55− Just (URI "http:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) "" "" "") ->

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

56− return (BaseUrl Http host port)

57+ return (BaseUrl Http host port path)

57− Just (URI "http:" (Just (URIAuth "" host "")) "" "" "") ->

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

58− return (BaseUrl Http host 80)

59+ return (BaseUrl Http host 80 path)

59− Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) "" "" "") ->

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

60− return (BaseUrl Https host port)

61+ return (BaseUrl Https host port path)

61− Just (URI "https:" (Just (URIAuth "" host "")) "" "" "") ->

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

62− return (BaseUrl Https host 443)

63+ return (BaseUrl Https host 443 path)

63 _ -> if "://" `isInfixOf` s

64 _ -> if "://" `isInfixOf` s

64 then throwM (InvalidBaseUrlException $ "Invalid base URL: " ++ s)

65 then throwM (InvalidBaseUrlException $ "Invalid base URL: " ++ s)

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

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

servant-client/src/Servant/Common/Req.hs+4−4

@@ -20,12 +20,12 @@ import Data.Proxy

20import Data.Text (Text)

21import Data.Text.Encoding

22import Data.Typeable

23−import Network.HTTP.Client hiding (Proxy)

23+import Network.HTTP.Client hiding (Proxy, path)

24import Network.HTTP.Client.TLS

25import Network.HTTP.Media

26import Network.HTTP.Types

27import qualified Network.HTTP.Types.Header as HTTP

28−import Network.URI

28+import Network.URI hiding (path)

29import Servant.API.ContentTypes

30import Servant.Common.BaseUrl

31import Servant.Common.Text

@@ -98,7 +98,7 @@ setRQBody :: ByteString -> MediaType -> Req -> Req

98setRQBody b t req = req { reqBody = Just (b, t) }

99

100reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request

101−reqToRequest req (BaseUrl reqScheme reqHost reqPort) =

101+reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =

102 setheaders . setAccept . setrqb . setQS <$> parseUrl url

103

104 where url = show $ nullURI { uriScheme = case reqScheme of

@@ -109,7 +109,7 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort) =

109 , uriRegName = reqHost

110 , uriPort = ":" ++ show reqPort

111 }

112− , uriPath = reqPath req

112+ , uriPath = path ++ reqPath req

113 }

114

115 setrqb r = case reqBody req of

servant-client/test/Servant/ClientSpec.hs+2−2

@@ -287,7 +287,7 @@ failSpec = withFailServer $ \ baseUrl -> do

287 :<|> _ )

288 = client api baseUrl

289 getGetWrongHost :: EitherT ServantError IO Person

290− (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872)

290+ (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "")

291

292 hspec $ do

293 context "client returns errors appropriately" $ do

@@ -347,7 +347,7 @@ withWaiDaemon mkApplication action = do

347 runSettingsSocket settings socket application)

348 `finally` notifyKilled ()

349 krakenPort <- waitForStart

350− let baseUrl = (BaseUrl Http "localhost" 80){baseUrlPort = krakenPort}

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

351 return (thread, waitForKilled, baseUrl)

352 free (thread, waitForKilled, _) = do

353 killThread thread

servant-examples/hackage/hackage.hs+1−1

@@ -57,7 +57,7 @@ hackageAPI = Proxy

57getUsers :: EitherT ServantError IO [UserSummary]

58getUser :: Username -> EitherT ServantError IO UserDetailed

59getPackages :: EitherT ServantError IO [Package]

60−getUsers :<|> getUser :<|> getPackages = client hackageAPI $ BaseUrl Http "hackage.haskell.org" 80

60+getUsers :<|> getUser :<|> getPackages = client hackageAPI $ BaseUrl Http "hackage.haskell.org" 80 ""

61

62main :: IO ()

63main = print =<< uselessNumbers

servant-examples/tutorial/T8.hs+1−1

@@ -23,7 +23,7 @@ marketing :: ClientInfo -- ^ value for the request body

23position :<|> hello :<|> marketing = client api baseUrl

24

25baseUrl :: BaseUrl

26−baseUrl = BaseUrl Http "localhost" 8081

26+baseUrl = BaseUrl Http "localhost" 8081 ""

27

28queries :: EitherT ServantError IO (Position, HelloMessage, Email)

29queries = do