servant-client-0.8.1/include/0000755000000000000000000000000012714342726014277 5ustar0000000000000000servant-client-0.8.1/src/0000755000000000000000000000000012515174707013444 5ustar0000000000000000servant-client-0.8.1/src/Servant/0000755000000000000000000000000012756604512015065 5ustar0000000000000000servant-client-0.8.1/src/Servant/Client/0000755000000000000000000000000012756604512016303 5ustar0000000000000000servant-client-0.8.1/src/Servant/Client/Experimental/0000755000000000000000000000000012756604512020740 5ustar0000000000000000servant-client-0.8.1/src/Servant/Common/0000755000000000000000000000000012756604512016315 5ustar0000000000000000servant-client-0.8.1/test/0000755000000000000000000000000012715327705013634 5ustar0000000000000000servant-client-0.8.1/test/Servant/0000755000000000000000000000000012762321747015260 5ustar0000000000000000servant-client-0.8.1/test/Servant/Common/0000755000000000000000000000000012714342726016505 5ustar0000000000000000servant-client-0.8.1/src/Servant/Client.hs0000644000000000000000000004157612756604512016654 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} #include "overlapping-compat.h" -- | This module provides 'client' which can automatically generate -- querying functions for each endpoint just from the type representing your -- API. module Servant.Client ( AuthClientData , AuthenticateReq(..) , client , HasClient(..) , ClientM , mkAuthenticateReq , ServantError(..) , module Servant.Common.BaseUrl ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Data.ByteString.Lazy (ByteString) import Data.List import Data.Proxy import Data.String.Conversions import Data.Text (unpack) import GHC.TypeLits import Network.HTTP.Client (Manager, Response) import Network.HTTP.Media import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types.Header as HTTP import Servant.API import Servant.Client.Experimental.Auth import Servant.Common.BaseUrl import Servant.Common.BasicAuth import Servant.Common.Req -- * Accessing APIs as a Client -- | 'client' allows you to produce operations to query an API from a client. -- -- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books -- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books -- > -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > -- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book] -- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book -- > (getAllBooks :<|> postNewBook) = client myApi client :: HasClient api => Proxy api -> Client api client p = clientWithRoute p defReq -- | This class lets us define how each API combinator -- influences the creation of an HTTP request. It's mostly -- an internal class, you can just use 'client'. class HasClient api where type Client api :: * clientWithRoute :: Proxy api -> Req -> Client api -- | A client querying function for @a ':<|>' b@ will actually hand you -- one function for querying @a@ and another one for querying @b@, -- stitching them together with ':<|>', which really is just like a pair. -- -- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books -- > :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books -- > -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > -- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book] -- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book -- > (getAllBooks :<|> postNewBook) = client myApi instance (HasClient a, HasClient b) => HasClient (a :<|> b) where type Client (a :<|> b) = Client a :<|> Client b clientWithRoute Proxy req = clientWithRoute (Proxy :: Proxy a) req :<|> clientWithRoute (Proxy :: Proxy b) req -- | If you use a 'Capture' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional argument of the type specified by your 'Capture'. -- That function will take care of inserting a textual representation -- of this value at the right place in the request path. -- -- You can control how values for this type are turned into -- text by specifying a 'ToHttpApiData' instance for your type. -- -- Example: -- -- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book -- > -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > -- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book -- > getBook = client myApi -- > -- then you can just use "getBook" to query that endpoint instance (KnownSymbol capture, ToHttpApiData a, HasClient api) => HasClient (Capture capture a :> api) where type Client (Capture capture a :> api) = a -> Client api clientWithRoute Proxy req val = clientWithRoute (Proxy :: Proxy api) (appendToPath p req) where p = unpack (toUrlPiece val) -- | If you use a 'CaptureAll' in one of your endpoints in your API, -- the corresponding querying function will automatically take an -- additional argument of a list of the type specified by your -- 'CaptureAll'. That function will take care of inserting a textual -- representation of this value at the right place in the request -- path. -- -- You can control how these values are turned into text by specifying -- a 'ToHttpApiData' instance of your type. -- -- Example: -- -- > type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile -- > -- > myApi :: Proxy -- > myApi = Proxy -- -- > getSourceFile :: [Text] -> Manager -> BaseUrl -> ClientM SourceFile -- > getSourceFile = client myApi -- > -- then you can use "getSourceFile" to query that endpoint instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout) => HasClient (CaptureAll capture a :> sublayout) where type Client (CaptureAll capture a :> sublayout) = [a] -> Client sublayout clientWithRoute Proxy req vals = clientWithRoute (Proxy :: Proxy sublayout) (foldl' (flip appendToPath) req ps) where ps = map (unpack . toUrlPiece) vals instance OVERLAPPABLE_ -- Note [Non-Empty Content Types] (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts) ) => HasClient (Verb method status cts' a) where type Client (Verb method status cts' a) = Manager -> BaseUrl -> ClientM a clientWithRoute Proxy req manager baseurl = snd <$> performRequestCT (Proxy :: Proxy ct) method req manager baseurl where method = reflectMethod (Proxy :: Proxy method) instance OVERLAPPING_ (ReflectMethod method) => HasClient (Verb method status cts NoContent) where type Client (Verb method status cts NoContent) = Manager -> BaseUrl -> ClientM NoContent clientWithRoute Proxy req manager baseurl = performRequestNoBody method req manager baseurl >> return NoContent where method = reflectMethod (Proxy :: Proxy method) instance OVERLAPPING_ -- Note [Non-Empty Content Types] ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts) ) => HasClient (Verb method status cts' (Headers ls a)) where type Client (Verb method status cts' (Headers ls a)) = Manager -> BaseUrl -> ClientM (Headers ls a) clientWithRoute Proxy req manager baseurl = do let method = reflectMethod (Proxy :: Proxy method) (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req manager baseurl return $ Headers { getResponse = resp , getHeadersHList = buildHeadersTo hdrs } instance OVERLAPPING_ ( BuildHeadersTo ls, ReflectMethod method ) => HasClient (Verb method status cts (Headers ls NoContent)) where type Client (Verb method status cts (Headers ls NoContent)) = Manager -> BaseUrl -> ClientM (Headers ls NoContent) clientWithRoute Proxy req manager baseurl = do let method = reflectMethod (Proxy :: Proxy method) hdrs <- performRequestNoBody method req manager baseurl return $ Headers { getResponse = NoContent , getHeadersHList = buildHeadersTo hdrs } -- | If you use a 'Header' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional argument of the type specified by your 'Header', -- wrapped in Maybe. -- -- That function will take care of encoding this argument as Text -- in the request headers. -- -- All you need is for your type to have a 'ToHttpApiData' instance. -- -- Example: -- -- > newtype Referer = Referer { referrer :: Text } -- > deriving (Eq, Show, Generic, ToHttpApiData) -- > -- > -- GET /view-my-referer -- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer -- > -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > -- > viewReferer :: Maybe Referer -> Manager -> BaseUrl -> ClientM Book -- > viewReferer = client myApi -- > -- then you can just use "viewRefer" to query that endpoint -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments instance (KnownSymbol sym, ToHttpApiData a, HasClient api) => HasClient (Header sym a :> api) where type Client (Header sym a :> api) = Maybe a -> Client api clientWithRoute Proxy req mval = clientWithRoute (Proxy :: Proxy api) (maybe req (\value -> Servant.Common.Req.addHeader hname value req) mval ) where hname = symbolVal (Proxy :: Proxy sym) -- | Using a 'HttpVersion' combinator in your API doesn't affect the client -- functions. instance HasClient api => HasClient (HttpVersion :> api) where type Client (HttpVersion :> api) = Client api clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy api) -- | If you use a 'QueryParam' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional argument of the type specified by your 'QueryParam', -- enclosed in Maybe. -- -- If you give Nothing, nothing will be added to the query string. -- -- If you give a non-'Nothing' value, this function will take care -- of inserting a textual representation of this value in the query string. -- -- You can control how values for your type are turned into -- text by specifying a 'ToHttpApiData' instance for your type. -- -- Example: -- -- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book] -- > -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > -- > getBooksBy :: Maybe Text -> Manager -> BaseUrl -> ClientM [Book] -- > getBooksBy = client myApi -- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- 'getBooksBy Nothing' for all books -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov instance (KnownSymbol sym, ToHttpApiData a, HasClient api) => HasClient (QueryParam sym a :> api) where type Client (QueryParam sym a :> api) = Maybe a -> Client api -- if mparam = Nothing, we don't add it to the query string clientWithRoute Proxy req mparam = clientWithRoute (Proxy :: Proxy api) (maybe req (flip (appendToQueryString pname) req . Just) mparamText ) where pname = cs pname' pname' = symbolVal (Proxy :: Proxy sym) mparamText = fmap toQueryParam mparam -- | If you use a 'QueryParams' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional argument, a list of values of the type specified -- by your 'QueryParams'. -- -- If you give an empty list, nothing will be added to the query string. -- -- Otherwise, this function will take care -- of inserting a textual representation of your values in the query string, -- under the same query string parameter name. -- -- You can control how values for your type are turned into -- text by specifying a 'ToHttpApiData' instance for your type. -- -- Example: -- -- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book] -- > -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > -- > getBooksBy :: [Text] -> Manager -> BaseUrl -> ClientM [Book] -- > getBooksBy = client myApi -- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- 'getBooksBy []' for all books -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]' -- > -- to get all books by Asimov and Heinlein instance (KnownSymbol sym, ToHttpApiData a, HasClient api) => HasClient (QueryParams sym a :> api) where type Client (QueryParams sym a :> api) = [a] -> Client api clientWithRoute Proxy req paramlist = clientWithRoute (Proxy :: Proxy api) (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just)) req paramlist' ) where pname = cs pname' pname' = symbolVal (Proxy :: Proxy sym) paramlist' = map (Just . toQueryParam) paramlist -- | If you use a 'QueryFlag' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional 'Bool' argument. -- -- If you give 'False', nothing will be added to the query string. -- -- Otherwise, this function will insert a value-less query string -- parameter under the name associated to your 'QueryFlag'. -- -- Example: -- -- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book] -- > -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > -- > getBooks :: Bool -> Manager -> BaseUrl -> ClientM [Book] -- > getBooks = client myApi -- > -- then you can just use "getBooks" to query that endpoint. -- > -- 'getBooksBy False' for all books -- > -- 'getBooksBy True' to only get _already published_ books instance (KnownSymbol sym, HasClient api) => HasClient (QueryFlag sym :> api) where type Client (QueryFlag sym :> api) = Bool -> Client api clientWithRoute Proxy req flag = clientWithRoute (Proxy :: Proxy api) (if flag then appendToQueryString paramname Nothing req else req ) where paramname = cs $ symbolVal (Proxy :: Proxy sym) -- | Pick a 'Method' and specify where the server you want to query is. You get -- back the full `Response`. instance HasClient Raw where type Client Raw = H.Method -> Manager -> BaseUrl -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) clientWithRoute :: Proxy Raw -> Req -> Client Raw clientWithRoute Proxy req httpMethod = do performRequest httpMethod req -- | If you use a 'ReqBody' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional argument of the type specified by your 'ReqBody'. -- That function will take care of encoding this argument as JSON and -- of using it as the request body. -- -- All you need is for your type to have a 'ToJSON' instance. -- -- Example: -- -- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- > -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > -- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book -- > addBook = client myApi -- > -- then you can just use "addBook" to query that endpoint instance (MimeRender ct a, HasClient api) => HasClient (ReqBody (ct ': cts) a :> api) where type Client (ReqBody (ct ': cts) a :> api) = a -> Client api clientWithRoute Proxy req body = clientWithRoute (Proxy :: Proxy api) (let ctProxy = Proxy :: Proxy ct in setRQBody (mimeRender ctProxy body) (contentType ctProxy) req ) -- | Make the querying function append @path@ to the request path. instance (KnownSymbol path, HasClient api) => HasClient (path :> api) where type Client (path :> api) = Client api clientWithRoute Proxy req = clientWithRoute (Proxy :: Proxy api) (appendToPath p req) where p = symbolVal (Proxy :: Proxy path) instance HasClient api => HasClient (Vault :> api) where type Client (Vault :> api) = Client api clientWithRoute Proxy req = clientWithRoute (Proxy :: Proxy api) req instance HasClient api => HasClient (RemoteHost :> api) where type Client (RemoteHost :> api) = Client api clientWithRoute Proxy req = clientWithRoute (Proxy :: Proxy api) req instance HasClient api => HasClient (IsSecure :> api) where type Client (IsSecure :> api) = Client api clientWithRoute Proxy req = clientWithRoute (Proxy :: Proxy api) req instance HasClient subapi => HasClient (WithNamedContext name context subapi) where type Client (WithNamedContext name context subapi) = Client subapi clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi) instance ( HasClient api ) => HasClient (AuthProtect tag :> api) where type Client (AuthProtect tag :> api) = AuthenticateReq (AuthProtect tag) -> Client api clientWithRoute Proxy req (AuthenticateReq (val,func)) = clientWithRoute (Proxy :: Proxy api) (func val req) -- * Basic Authentication instance HasClient api => HasClient (BasicAuth realm usr :> api) where type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api clientWithRoute Proxy req val = clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) {- Note [Non-Empty Content Types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Rather than have instance (..., cts' ~ (ct ': cts)) => ... cts' ... It may seem to make more sense to have: instance (...) => ... (ct ': cts) ... But this means that if another instance exists that does *not* require non-empty lists, but is otherwise more specific, no instance will be overall more specific. This in turn generally means adding yet another instance (one for empty and one for non-empty lists). -} servant-client-0.8.1/src/Servant/Client/Experimental/Auth.hs0000644000000000000000000000234212756604512022176 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeFamilies #-} -- | Authentication for clients module Servant.Client.Experimental.Auth ( AuthenticateReq(AuthenticateReq, unAuthReq) , AuthClientData , mkAuthenticateReq ) where import Servant.Common.Req (Req) -- | For a resource protected by authentication (e.g. AuthProtect), we need -- to provide the client with some data used to add authentication data -- to a request -- -- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE type family AuthClientData a :: * -- | For better type inference and to avoid usage of a data family, we newtype -- wrap the combination of some 'AuthClientData' and a function to add authentication -- data to a request -- -- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE newtype AuthenticateReq a = AuthenticateReq { unAuthReq :: (AuthClientData a, AuthClientData a -> Req -> Req) } -- | Handy helper to avoid wrapping datatypes in tuples everywhere. -- -- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE mkAuthenticateReq :: AuthClientData a -> (AuthClientData a -> Req -> Req) -> AuthenticateReq a mkAuthenticateReq val func = AuthenticateReq (val, func) servant-client-0.8.1/src/Servant/Common/BaseUrl.hs0000644000000000000000000000533312714342726020212 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ViewPatterns #-} module Servant.Common.BaseUrl ( -- * types BaseUrl (..) , InvalidBaseUrlException , Scheme (..) -- * functions , parseBaseUrl , showBaseUrl ) where import Control.Monad.Catch (Exception, MonadThrow, throwM) import Data.List import Data.Typeable import GHC.Generics import Network.URI hiding (path) import Safe import Text.Read -- | URI scheme to use data Scheme = Http -- ^ http:// | Https -- ^ https:// deriving (Show, Eq, Ord, Generic) -- | Simple data type to represent the target of HTTP requests -- for servant's automatically-generated clients. data BaseUrl = BaseUrl { baseUrlScheme :: Scheme -- ^ URI scheme to use , baseUrlHost :: String -- ^ host (eg "haskell.org") , baseUrlPort :: Int -- ^ port (eg 80) , baseUrlPath :: String -- ^ path (eg "/a/b/c") } deriving (Show, Ord, Generic) instance Eq BaseUrl where BaseUrl a b c path == BaseUrl a' b' c' path' = a == a' && b == b' && c == c' && s path == s path' where s ('/':x) = x s x = x showBaseUrl :: BaseUrl -> String showBaseUrl (BaseUrl urlscheme host port path) = schemeString ++ "//" ++ host ++ (portString path) where a b = if "/" `isPrefixOf` b || null b then a ++ b else a ++ '/':b schemeString = case urlscheme of Http -> "http:" Https -> "https:" portString = case (urlscheme, port) of (Http, 80) -> "" (Https, 443) -> "" _ -> ":" ++ show port data InvalidBaseUrlException = InvalidBaseUrlException String deriving (Show, Typeable) instance Exception InvalidBaseUrlException parseBaseUrl :: MonadThrow m => String -> m BaseUrl parseBaseUrl s = case parseURI (removeTrailingSlash s) of -- This is a rather hacky implementation and should be replaced with something -- implemented in attoparsec (which is already a dependency anyhow (via aeson)). Just (URI "http:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) path "" "") -> return (BaseUrl Http host port path) Just (URI "http:" (Just (URIAuth "" host "")) path "" "") -> return (BaseUrl Http host 80 path) Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) path "" "") -> return (BaseUrl Https host port path) Just (URI "https:" (Just (URIAuth "" host "")) path "" "") -> return (BaseUrl Https host 443 path) _ -> if "://" `isInfixOf` s then throwM (InvalidBaseUrlException $ "Invalid base URL: " ++ s) else parseBaseUrl ("http://" ++ s) where removeTrailingSlash str = case lastMay str of Just '/' -> init str _ -> str servant-client-0.8.1/src/Servant/Common/BasicAuth.hs0000644000000000000000000000125112756604512020513 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeFamilies #-} -- | Basic Authentication for clients module Servant.Common.BasicAuth ( basicAuthReq ) where import Data.ByteString.Base64 (encode) import Data.Monoid ((<>)) import Data.Text.Encoding (decodeUtf8) import Servant.Common.Req (addHeader, Req) import Servant.API.BasicAuth (BasicAuthData(BasicAuthData)) -- | Authenticate a request using Basic Authentication basicAuthReq :: BasicAuthData -> Req -> Req basicAuthReq (BasicAuthData user pass) req = let authText = decodeUtf8 ("Basic " <> encode (user <> ":" <> pass)) in addHeader "Authorization" authText req servant-client-0.8.1/src/Servant/Common/Req.hs0000644000000000000000000001663512756604512017413 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Servant.Common.Req where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Control.Exception import Control.Monad import Control.Monad.Catch (MonadThrow) import Control.Monad.IO.Class import Control.Monad.Trans.Except import Data.ByteString.Lazy hiding (pack, filter, map, null, elem) import Data.String import Data.String.Conversions import Data.Proxy import Data.Text (Text) import Data.Text.Encoding import Data.Typeable import Network.HTTP.Client hiding (Proxy, path) import Network.HTTP.Media import Network.HTTP.Types import qualified Network.HTTP.Types.Header as HTTP import Network.URI hiding (path) import Servant.API.ContentTypes import Servant.Common.BaseUrl import qualified Network.HTTP.Client as Client import Web.HttpApiData data ServantError = FailureResponse { responseStatus :: Status , responseContentType :: MediaType , responseBody :: ByteString } | DecodeFailure { decodeError :: String , responseContentType :: MediaType , responseBody :: ByteString } | UnsupportedContentType { responseContentType :: MediaType , responseBody :: ByteString } | InvalidContentTypeHeader { responseContentTypeHeader :: ByteString , responseBody :: ByteString } | ConnectionError { connectionError :: SomeException } deriving (Show, Typeable) instance Eq ServantError where FailureResponse a b c == FailureResponse x y z = (a, b, c) == (x, y, z) DecodeFailure a b c == DecodeFailure x y z = (a, b, c) == (x, y, z) UnsupportedContentType a b == UnsupportedContentType x y = (a, b) == (x, y) InvalidContentTypeHeader a b == InvalidContentTypeHeader x y = (a, b) == (x, y) ConnectionError a == ConnectionError x = show a == show x _ == _ = False instance Exception ServantError data Req = Req { reqPath :: String , qs :: QueryText , reqBody :: Maybe (ByteString, MediaType) , reqAccept :: [MediaType] , headers :: [(String, Text)] } defReq :: Req defReq = Req "" [] Nothing [] [] appendToPath :: String -> Req -> Req appendToPath p req = req { reqPath = reqPath req ++ "/" ++ p } appendToQueryString :: Text -- ^ param name -> Maybe Text -- ^ param value -> Req -> Req appendToQueryString pname pvalue req = req { qs = qs req ++ [(pname, pvalue)] } addHeader :: ToHttpApiData a => String -> a -> Req -> Req addHeader name val req = req { headers = headers req ++ [(name, decodeUtf8 (toHeader val))] } setRQBody :: ByteString -> MediaType -> Req -> Req setRQBody b t req = req { reqBody = Just (b, t) } reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request reqToRequest req (BaseUrl reqScheme reqHost reqPort path) = setheaders . setAccept . setrqb . setQS <$> parseRequest url where url = show $ nullURI { uriScheme = case reqScheme of Http -> "http:" Https -> "https:" , uriAuthority = Just $ URIAuth { uriUserInfo = "" , uriRegName = reqHost , uriPort = ":" ++ show reqPort } , uriPath = path ++ reqPath req } setrqb r = case reqBody req of Nothing -> r Just (b,t) -> r { requestBody = RequestBodyLBS b , requestHeaders = requestHeaders r ++ [(hContentType, cs . show $ t)] } setQS = setQueryString $ queryTextToQuery (qs req) setheaders r = r { requestHeaders = requestHeaders r <> fmap toProperHeader (headers req) } setAccept r = r { requestHeaders = filter ((/= "Accept") . fst) (requestHeaders r) <> [("Accept", renderHeader $ reqAccept req) | not . null . reqAccept $ req] } toProperHeader (name, val) = (fromString name, encodeUtf8 val) #if !MIN_VERSION_http_client(0,4,30) -- 'parseRequest' is introduced in http-client-0.4.30 -- it differs from 'parseUrl', by not throwing exceptions on non-2xx http statuses -- -- See for implementations: -- http://hackage.haskell.org/package/http-client-0.4.30/docs/src/Network-HTTP-Client-Request.html#parseRequest -- http://hackage.haskell.org/package/http-client-0.5.0/docs/src/Network-HTTP-Client-Request.html#parseRequest parseRequest :: MonadThrow m => String -> m Request parseRequest url = liftM disableStatusCheck (parseUrl url) where disableStatusCheck req = req { checkStatus = \ _status _headers _cookies -> Nothing } #endif -- * performing requests displayHttpRequest :: Method -> String displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request" type ClientM = ExceptT ServantError IO performRequest :: Method -> Req -> Manager -> BaseUrl -> ClientM ( Int, ByteString, MediaType , [HTTP.Header], Response ByteString) performRequest reqMethod req manager reqHost = do partialRequest <- liftIO $ reqToRequest req reqHost let request = partialRequest { Client.method = reqMethod } eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager case eResponse of Left err -> throwE . ConnectionError $ SomeException err Right response -> do let status = Client.responseStatus response body = Client.responseBody response hdrs = Client.responseHeaders response status_code = statusCode status ct <- case lookup "Content-Type" $ Client.responseHeaders response of Nothing -> pure $ "application"//"octet-stream" Just t -> case parseAccept t of Nothing -> throwE $ InvalidContentTypeHeader (cs t) body Just t' -> pure t' unless (status_code >= 200 && status_code < 300) $ throwE $ FailureResponse status ct body return (status_code, body, ct, hdrs, response) performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req -> Manager -> BaseUrl -> ClientM ([HTTP.Header], result) performRequestCT ct reqMethod req manager reqHost = do let acceptCT = contentType ct (_status, respBody, respCT, hdrs, _response) <- performRequest reqMethod (req { reqAccept = [acceptCT] }) manager reqHost unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody case mimeUnrender ct respBody of Left err -> throwE $ DecodeFailure err respCT respBody Right val -> return (hdrs, val) performRequestNoBody :: Method -> Req -> Manager -> BaseUrl -> ClientM [HTTP.Header] performRequestNoBody reqMethod req manager reqHost = do (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost return hdrs catchConnectionError :: IO a -> IO (Either ServantError a) catchConnectionError action = catch (Right <$> action) $ \e -> pure . Left . ConnectionError $ SomeException (e :: HttpException) servant-client-0.8.1/test/Spec.hs0000644000000000000000000000005412714342726015060 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} servant-client-0.8.1/test/Servant/ClientSpec.hs0000644000000000000000000004271012762321747017651 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -freduction-depth=100 #-} #else {-# OPTIONS_GHC -fcontext-stack=100 #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} #include "overlapping-compat.h" module Servant.ClientSpec where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Arrow (left) import Control.Concurrent (forkIO, killThread, ThreadId) import Control.Exception (bracket) import Control.Monad.Trans.Except (throwE, runExceptT) import Data.Aeson import qualified Data.ByteString.Lazy as BS import Data.Char (chr, isPrint) import Data.Foldable (forM_) import Data.Monoid hiding (getLast) import Data.Proxy import qualified Data.Text as T import GHC.Generics (Generic) import qualified Network.HTTP.Client as C import Network.HTTP.Media import qualified Network.HTTP.Types as HTTP import Network.Socket import Network.Wai (Request, requestHeaders, responseLBS) import Network.Wai.Handler.Warp import System.IO.Unsafe (unsafePerformIO) import Test.Hspec import Test.Hspec.QuickCheck import Test.HUnit import Test.QuickCheck import Servant.API import Servant.API.Internal.Test.ComprehensiveAPI import Servant.Client import Servant.Server import Servant.Server.Experimental.Auth import qualified Servant.Common.Req as SCR -- This declaration simply checks that all instances are in place. _ = client comprehensiveAPI spec :: Spec spec = describe "Servant.Client" $ do sucessSpec failSpec wrappedApiSpec basicAuthSpec genAuthSpec -- * test data types data Person = Person { name :: String, age :: Integer } deriving (Eq, Show, Generic) instance ToJSON Person instance FromJSON Person instance ToFormUrlEncoded Person where toFormUrlEncoded Person{..} = [("name", T.pack name), ("age", T.pack (show age))] lookupEither :: (Show a, Eq a) => a -> [(a,b)] -> Either String b lookupEither x xs = do maybe (Left $ "could not find key " <> show x) return $ lookup x xs instance FromFormUrlEncoded Person where fromFormUrlEncoded xs = do n <- lookupEither "name" xs a <- lookupEither "age" xs return $ Person (T.unpack n) (read $ T.unpack a) alice :: Person alice = Person "Alice" 42 type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String] type Api = "get" :> Get '[JSON] Person :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person] :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person] :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool :<|> "rawSuccess" :> Raw :<|> "rawFailure" :> Raw :<|> "multiple" :> Capture "first" String :> QueryParam "second" Int :> QueryFlag "third" :> ReqBody '[JSON] [(String, [Rational])] :> Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])]) :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool) :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent api :: Proxy Api api = Proxy getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person getCaptureAll :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person] getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person] getQueryFlag :: Bool -> C.Manager -> BaseUrl -> SCR.ClientM Bool getRawSuccess :: HTTP.Method -> C.Manager -> BaseUrl -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString) getRawFailure :: HTTP.Method -> C.Manager -> BaseUrl -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString) getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> C.Manager -> BaseUrl -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])]) getRespHeaders :: C.Manager -> BaseUrl -> SCR.ClientM (Headers TestHeaders Bool) getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent getGet :<|> getDeleteEmpty :<|> getCapture :<|> getCaptureAll :<|> getBody :<|> getQueryParam :<|> getQueryParams :<|> getQueryFlag :<|> getRawSuccess :<|> getRawFailure :<|> getMultiple :<|> getRespHeaders :<|> getDeleteContentType = client api server :: Application server = serve api ( return alice :<|> return NoContent :<|> (\ name -> return $ Person name 0) :<|> (\ names -> return (zipWith Person names [0..])) :<|> return :<|> (\ name -> case name of Just "alice" -> return alice Just n -> throwE $ ServantErr 400 (n ++ " not found") "" [] Nothing -> throwE $ ServantErr 400 "missing parameter" "" []) :<|> (\ names -> return (zipWith Person names [0..])) :<|> return :<|> (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess") :<|> (\ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure") :<|> (\ a b c d -> return (a, b, c, d)) :<|> (return $ addHeader 1729 $ addHeader "eg2" True) :<|> return NoContent ) type FailApi = "get" :> Raw :<|> "capture" :> Capture "name" String :> Raw :<|> "body" :> Raw failApi :: Proxy FailApi failApi = Proxy failServer :: Application failServer = serve failApi ( (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "") :<|> (\ _capture _request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "") :<|> (\_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "") ) -- * basic auth stuff type BasicAuthAPI = BasicAuth "foo-realm" () :> "private" :> "basic" :> Get '[JSON] Person basicAuthAPI :: Proxy BasicAuthAPI basicAuthAPI = Proxy basicAuthHandler :: BasicAuthCheck () basicAuthHandler = let check (BasicAuthData username password) = if username == "servant" && password == "server" then return (Authorized ()) else return Unauthorized in BasicAuthCheck check basicServerContext :: Context '[ BasicAuthCheck () ] basicServerContext = basicAuthHandler :. EmptyContext basicAuthServer :: Application basicAuthServer = serveWithContext basicAuthAPI basicServerContext (const (return alice)) -- * general auth stuff type GenAuthAPI = AuthProtect "auth-tag" :> "private" :> "auth" :> Get '[JSON] Person genAuthAPI :: Proxy GenAuthAPI genAuthAPI = Proxy type instance AuthServerData (AuthProtect "auth-tag") = () type instance AuthClientData (AuthProtect "auth-tag") = () genAuthHandler :: AuthHandler Request () genAuthHandler = let handler req = case lookup "AuthHeader" (requestHeaders req) of Nothing -> throwE (err401 { errBody = "Missing auth header" }) Just _ -> return () in mkAuthHandler handler genAuthServerContext :: Context '[ AuthHandler Request () ] genAuthServerContext = genAuthHandler :. EmptyContext genAuthServer :: Application genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const (return alice)) {-# NOINLINE manager #-} manager :: C.Manager manager = unsafePerformIO $ C.newManager C.defaultManagerSettings sucessSpec :: Spec sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do it "Servant.API.Get" $ \(_, baseUrl) -> do (left show <$> runExceptT (getGet manager baseUrl)) `shouldReturn` Right alice describe "Servant.API.Delete" $ do it "allows empty content type" $ \(_, baseUrl) -> do (left show <$> runExceptT (getDeleteEmpty manager baseUrl)) `shouldReturn` Right NoContent it "allows content type" $ \(_, baseUrl) -> do (left show <$> runExceptT (getDeleteContentType manager baseUrl)) `shouldReturn` Right NoContent it "Servant.API.Capture" $ \(_, baseUrl) -> do (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0) it "Servant.API.CaptureAll" $ \(_, baseUrl) -> do let expected = [(Person "Paula" 0), (Person "Peta" 1)] (left show <$> runExceptT (getCaptureAll ["Paula", "Peta"] manager baseUrl)) `shouldReturn` Right expected it "Servant.API.ReqBody" $ \(_, baseUrl) -> do let p = Person "Clara" 42 (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p it "Servant.API.QueryParam" $ \(_, baseUrl) -> do left show <$> runExceptT (getQueryParam (Just "alice") manager baseUrl) `shouldReturn` Right alice Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob") manager baseUrl) responseStatus `shouldBe` HTTP.Status 400 "bob not found" it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do (left show <$> runExceptT (getQueryParams [] manager baseUrl)) `shouldReturn` Right [] (left show <$> runExceptT (getQueryParams ["alice", "bob"] manager baseUrl)) `shouldReturn` Right [Person "alice" 0, Person "bob" 1] context "Servant.API.QueryParam.QueryFlag" $ forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do (left show <$> runExceptT (getQueryFlag flag manager baseUrl)) `shouldReturn` Right flag it "Servant.API.Raw on success" $ \(_, baseUrl) -> do res <- runExceptT (getRawSuccess HTTP.methodGet manager baseUrl) case res of Left e -> assertFailure $ show e Right (code, body, ct, _, response) -> do (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream") C.responseBody response `shouldBe` body C.responseStatus response `shouldBe` HTTP.ok200 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do res <- runExceptT (getRawFailure HTTP.methodGet manager baseUrl) case res of Right _ -> assertFailure "expected Left, but got Right" Left e -> do Servant.Client.responseStatus e `shouldBe` HTTP.status400 Servant.Client.responseBody e `shouldBe` "rawFailure" it "Returns headers appropriately" $ \(_, baseUrl) -> do res <- runExceptT (getRespHeaders manager baseUrl) case res of Left e -> assertFailure $ show e Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")] modifyMaxSuccess (const 20) $ do it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) -> property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body -> ioProperty $ do result <- left show <$> runExceptT (getMultiple cap num flag body manager baseUrl) return $ result === Right (cap, num, flag, body) wrappedApiSpec :: Spec wrappedApiSpec = describe "error status codes" $ do let serveW api = serve api $ throwE $ ServantErr 500 "error message" "" [] context "are correctly handled by the client" $ let test :: (WrappedApi, String) -> Spec test (WrappedApi api, desc) = it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do let getResponse :: C.Manager -> BaseUrl -> SCR.ClientM () getResponse = client api Left FailureResponse{..} <- runExceptT (getResponse manager baseUrl) responseStatus `shouldBe` (HTTP.Status 500 "error message") in mapM_ test $ (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") : (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") : (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") : (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") : [] failSpec :: Spec failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do context "client returns errors appropriately" $ do it "reports FailureResponse" $ \(_, baseUrl) -> do let (_ :<|> getDeleteEmpty :<|> _) = client api Left res <- runExceptT (getDeleteEmpty manager baseUrl) case res of FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return () _ -> fail $ "expected 404 response, but got " <> show res it "reports DecodeFailure" $ \(_, baseUrl) -> do let (_ :<|> _ :<|> getCapture :<|> _) = client api Left res <- runExceptT (getCapture "foo" manager baseUrl) case res of DecodeFailure _ ("application/json") _ -> return () _ -> fail $ "expected DecodeFailure, but got " <> show res it "reports ConnectionError" $ \_ -> do let (getGetWrongHost :<|> _) = client api Left res <- runExceptT (getGetWrongHost manager (BaseUrl Http "127.0.0.1" 19872 "")) case res of ConnectionError _ -> return () _ -> fail $ "expected ConnectionError, but got " <> show res it "reports UnsupportedContentType" $ \(_, baseUrl) -> do let (getGet :<|> _ ) = client api Left res <- runExceptT (getGet manager baseUrl) case res of UnsupportedContentType ("application/octet-stream") _ -> return () _ -> fail $ "expected UnsupportedContentType, but got " <> show res it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api Left res <- runExceptT (getBody alice manager baseUrl) case res of InvalidContentTypeHeader "fooooo" _ -> return () _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res data WrappedApi where WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a, HasClient api, Client api ~ (C.Manager -> BaseUrl -> SCR.ClientM ())) => Proxy api -> WrappedApi basicAuthSpec :: Spec basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ do context "Authentication works when requests are properly authenticated" $ do it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do let getBasic = client basicAuthAPI let basicAuthData = BasicAuthData "servant" "server" (left show <$> runExceptT (getBasic basicAuthData manager baseUrl)) `shouldReturn` Right alice context "Authentication is rejected when requests are not authenticated properly" $ do it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do let getBasic = client basicAuthAPI let basicAuthData = BasicAuthData "not" "password" Left FailureResponse{..} <- runExceptT (getBasic basicAuthData manager baseUrl) responseStatus `shouldBe` HTTP.Status 403 "Forbidden" genAuthSpec :: Spec genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do context "Authentication works when requests are properly authenticated" $ do it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do let getProtected = client genAuthAPI let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req) (left show <$> runExceptT (getProtected authRequest manager baseUrl)) `shouldReturn` Right alice context "Authentication is rejected when requests are not authenticated properly" $ do it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do let getProtected = client genAuthAPI let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req) Left FailureResponse{..} <- runExceptT (getProtected authRequest manager baseUrl) responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized") -- * utils startWaiApp :: Application -> IO (ThreadId, BaseUrl) startWaiApp app = do (port, socket) <- openTestSocket let settings = setPort port $ defaultSettings thread <- forkIO $ runSettingsSocket settings socket app return (thread, BaseUrl Http "localhost" port "") endWaiApp :: (ThreadId, BaseUrl) -> IO () endWaiApp (thread, _) = killThread thread openTestSocket :: IO (Port, Socket) openTestSocket = do s <- socket AF_INET Stream defaultProtocol localhost <- inet_addr "127.0.0.1" bind s (SockAddrInet aNY_PORT localhost) listen s 1 port <- socketPort s return (fromIntegral port, s) pathGen :: Gen (NonEmptyList Char) pathGen = fmap NonEmpty path where path = listOf1 $ elements $ filter (not . (`elem` ("?%[]/#;" :: String))) $ filter isPrint $ map chr [0..127] servant-client-0.8.1/test/Servant/Common/BaseUrlSpec.hs0000644000000000000000000000556012714342726021217 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Servant.Common.BaseUrlSpec where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Control.DeepSeq import Test.Hspec import Test.QuickCheck import Servant.Common.BaseUrl spec :: Spec spec = do let parse = parseBaseUrl :: String -> Maybe BaseUrl 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" it "shows the path of a BaseUrl" $ do showBaseUrl (BaseUrl Http "foo.com" 80 "api") `shouldBe` "http://foo.com/api" it "shows the path of an https BaseUrl" $ do showBaseUrl (BaseUrl Https "foo.com" 443 "api") `shouldBe` "https://foo.com/api" it "handles leading slashes in path" $ do showBaseUrl (BaseUrl Https "foo.com" 443 "/api") `shouldBe` "https://foo.com/api" 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 (parse string )) True it "is the inverse of showBaseUrl" $ do property $ \ baseUrl -> counterexample (showBaseUrl baseUrl) $ parse (showBaseUrl baseUrl) === Just baseUrl context "trailing slashes" $ do it "allows trailing slashes" $ do parse "foo.com/" `shouldBe` Just (BaseUrl Http "foo.com" 80 "") it "allows trailing slashes in paths" $ do parse "foo.com/api/" `shouldBe` Just (BaseUrl Http "foo.com" 80 "api") context "urls without scheme" $ do it "assumes http" $ do parse "foo.com" `shouldBe` Just (BaseUrl Http "foo.com" 80 "") it "allows port numbers" $ do parse "foo.com:8080" `shouldBe` Just (BaseUrl Http "foo.com" 8080 "") it "can parse paths" $ do parse "http://foo.com/api" `shouldBe` Just (BaseUrl Http "foo.com" 80 "api") it "rejects ftp urls" $ do parse "ftp://foo.com" `shouldBe` Nothing instance Arbitrary BaseUrl where arbitrary = BaseUrl <$> elements [Http, Https] <*> hostNameGen <*> portGen <*> pathGen where letters = ['a' .. 'z'] ++ ['A' .. 'Z'] -- this does not perfectly mirror the url standard, but I hope it's good -- enough. hostNameGen = do 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)) : [] pathGen = listOf1 . elements $ letters isLeft :: Either a b -> Bool isLeft = either (const True) (const False) servant-client-0.8.1/LICENSE0000644000000000000000000000306112756604512013661 0ustar0000000000000000Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, Servant Contributors All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Zalora South East Asia Pte Ltd nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. servant-client-0.8.1/Setup.hs0000644000000000000000000000007012714342726014305 0ustar0000000000000000import Distribution.Simple main = defaultMain servant-client-0.8.1/servant-client.cabal0000644000000000000000000000564112762322067016603 0ustar0000000000000000name: servant-client version: 0.8.1 synopsis: automatical derivation of querying functions for servant webservices description: This library lets you derive automatically Haskell functions that let you query each endpoint of a webservice. . See . . license: BSD3 license-file: LICENSE author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors category: Web build-type: Simple cabal-version: >=1.10 tested-with: GHC >= 7.8 homepage: http://haskell-servant.readthedocs.org/ Bug-reports: http://github.com/haskell-servant/servant/issues extra-source-files: include/*.h CHANGELOG.md README.md source-repository head type: git location: http://github.com/haskell-servant/servant.git library exposed-modules: Servant.Client Servant.Client.Experimental.Auth Servant.Common.BaseUrl Servant.Common.BasicAuth Servant.Common.Req build-depends: base >= 4.7 && < 4.10 , aeson >= 0.7 && < 1.1 , attoparsec >= 0.12 && < 0.14 , base64-bytestring >= 1.0.0.1 && < 1.1 , bytestring >= 0.10 && < 0.11 , exceptions >= 0.8 && < 0.9 , http-api-data >= 0.1 && < 0.3 , http-client >= 0.4.18.1 && < 0.6 , http-client-tls >= 0.2.2 && < 0.4 , http-media >= 0.6.2 && < 0.7 , http-types >= 0.8.6 && < 0.10 , network-uri >= 2.6 && < 2.7 , safe >= 0.3.9 && < 0.4 , servant == 0.8.* , string-conversions >= 0.3 && < 0.5 , text >= 1.2 && < 1.3 , transformers >= 0.3 && < 0.6 , transformers-compat >= 0.4 && < 0.6 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall if impl(ghc >= 8.0) ghc-options: -Wno-redundant-constraints include-dirs: include test-suite spec type: exitcode-stdio-1.0 ghc-options: -Wall default-language: Haskell2010 hs-source-dirs: test main-is: Spec.hs other-modules: Servant.ClientSpec , Servant.Common.BaseUrlSpec build-depends: base == 4.* , transformers , transformers-compat , aeson , bytestring , deepseq , hspec == 2.* , http-client , http-media , http-types , HUnit , network >= 2.6 , QuickCheck >= 2.7 , servant == 0.8.* , servant-client , servant-server == 0.8.* , text , wai , warp servant-client-0.8.1/include/overlapping-compat.h0000644000000000000000000000032212714342726020254 0ustar0000000000000000#if __GLASGOW_HASKELL__ >= 710 #define OVERLAPPABLE_ {-# OVERLAPPABLE #-} #define OVERLAPPING_ {-# OVERLAPPING #-} #else {-# LANGUAGE OverlappingInstances #-} #define OVERLAPPABLE_ #define OVERLAPPING_ #endif servant-client-0.8.1/CHANGELOG.md0000644000000000000000000000266612756604512014477 0ustar00000000000000000.7.1 ----- * Support GHC 8.0 * `ServantError` has an `Eq` instance now. 0.6 --- * `client` no longer takes `BaseUrl` and `Manager` arguments. Instead, each function returned by `client` requires these two arguments. 0.5 --- * Use the `text` package instead of `String`. * Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators * Added support for `path` on `BaseUrl`. * `client` now takes an explicit `Manager` argument. * Use `http-api-data` instead of `Servant.Common.Text` * Client functions now consider any 2xx successful. * Remove matrix params. * Added support for Basic authentication * Add generalized authentication support via the `AuthClientData` type family and `AuthenticateReq` data type 0.4.1 ----- * The `HasClient` instance for `Delete cts ()` now does not care at all about content types provided. 0.4 --- * `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body * Support content-type aware combinators and `Accept`/`Content-type` headers * Added a lot of tests * Support multiple concurrent threads * Use `ServantError` to report Errors instead of `String` * Make the clients for `Raw` endpoints return the whole `Response` value (to be able to access response headers for example) * Support for PATCH * Make () instances expect No Content status code, and not try to decode body. * Add support for response headers 0.2.2 ----- * Add TLS support * Add matrix parameter support servant-client-0.8.1/README.md0000644000000000000000000000124512756604512014135 0ustar0000000000000000# servant-client ![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) This library lets you automatically derive Haskell functions that let you query each endpoint of a *servant* webservice. ## Example ``` haskell type MyApi = "books" :> Get '[JSON] [Book] -- GET /books :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books myApi :: Proxy MyApi myApi = Proxy getAllBooks :: Manager -> BaseUrl -> ExceptT String IO [Book] postNewBook :: Book -> Manager -> BaseUrl -> ExceptT String IO Book -- 'client' allows you to produce operations to query an API from a client. (getAllBooks :<|> postNewBook) = client myApi ```