packages feed

servant-client (empty) → 0.2

raw patch · 7 files changed

+653/−0 lines, 7 filesdep +QuickCheckdep +aesondep +attoparsecsetup-changed

Dependencies added: QuickCheck, aeson, attoparsec, base, bytestring, deepseq, either, exceptions, hspec, http-client, http-types, network, network-uri, safe, servant, servant-client, string-conversions, text, transformers, wai, warp

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Zalora South East Asia Pte Ltd++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ servant-client.cabal view
@@ -0,0 +1,78 @@+name:                servant-client+version:             0.2+synopsis: automatical derivation of haskell functions that let you query servant webservices+description:+  This library lets you derive automatically Haskell functions that+  let you query each endpoint of a <http://hackage.haskell.org/package/servant servant> webservice.+  .+  Example below.+  .+  > type MyApi = "books" :> Get [Book] -- GET /books+  >         :<|> "books" :> ReqBody Book :> Post Book -- POST /books+  >+  > myApi :: Proxy MyApi+  > myApi = Proxy+  >+  > getAllBooks :: BaseUrl -> EitherT String IO [Book]+  > postNewBook :: Book -> BaseUrl -> EitherT String IO Book+  > (getAllBooks :<|> postNewBook) = client myApi+license:             BSD3+license-file:        LICENSE+author:              Alp Mestanogullari, Sönke Hahn, Julian K. Arni+maintainer:          alpmestan@gmail.com+copyright:           2014 Zalora South East Asia Pte Ltd+category:            Web+build-type:          Simple+cabal-version:       >=1.10+tested-with:         GHC >= 7.8+homepage:            http://haskell-servant.github.io/+Bug-reports:         http://github.com/haskell-servant/servant-client/issues+source-repository head+  type: git+  location: http://github.com/haskell-servant/servant-client.git++library+  exposed-modules:+    Servant.Client+    Servant.Common.BaseUrl+    Servant.Common.Req+  build-depends:+      base >=4.7 && <5+    , aeson+    , attoparsec+    , bytestring+    , either+    , exceptions+    , http-client+    , http-types+    , network-uri >= 2.6+    , safe+    , servant >= 0.2+    , string-conversions+    , text+    , transformers+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall++test-suite spec+  type: exitcode-stdio-1.0+  ghc-options:+    -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures+  default-language: Haskell2010+  hs-source-dirs: test+  main-is: Spec.hs+  build-depends:+      base == 4.*+    , aeson+    , bytestring+    , deepseq+    , either+    , hspec == 2.*+    , http-types+    , network >= 2.6+    , QuickCheck+    , servant >= 0.2+    , servant-client+    , wai+    , warp
+ src/Servant/Client.hs view
@@ -0,0 +1,341 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | This module provides 'client' which can automatically generate+-- querying functions for each endpoint just from the type representing your+-- API.+module Servant.Client+  ( client+  , HasClient(..)+  , module Servant.Common.BaseUrl+  ) where++import Control.Monad.Trans.Either+import Data.Aeson+import Data.ByteString.Lazy (ByteString)+import Data.List+import Data.Proxy+import Data.String.Conversions+import Data.Text (unpack)+import GHC.TypeLits+import qualified Network.HTTP.Types as H+import Servant.API+import Servant.Common.BaseUrl+import Servant.Common.Req+import Servant.Common.Text++-- * Accessing APIs as a Client++-- | 'client' allows you to produce operations to query an API from a client.+--+-- > type MyApi = "books" :> Get [Book] -- GET /books+-- >         :<|> "books" :> ReqBody Book :> Post Book -- POST /books+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > getAllBooks :: BaseUrl -> EitherT String IO [Book]+-- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book+-- > (getAllBooks :<|> postNewBook) = client myApi+client :: HasClient layout => Proxy layout -> Client layout+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 layout where+  type Client layout :: *+  clientWithRoute :: Proxy layout -> Req -> Client layout++-- | 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 [Book] -- GET /books+-- >         :<|> "books" :> ReqBody Book :> Post Book -- POST /books+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > getAllBooks :: BaseUrl -> EitherT String IO [Book]+-- > postNewBook :: Book -> BaseUrl -> EitherT String IO 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 'ToText' instance for your type.+--+-- Example:+--+-- > type MyApi = "books" :> Capture "isbn" Text :> Get Book+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > getBook :: Text -> BaseUrl -> EitherT String IO Book+-- > getBook = client myApi+-- > -- then you can just use "getBook" to query that endpoint+instance (KnownSymbol capture, ToText a, HasClient sublayout)+      => HasClient (Capture capture a :> sublayout) where++  type Client (Capture capture a :> sublayout) =+    a -> Client sublayout++  clientWithRoute Proxy req val =+    clientWithRoute (Proxy :: Proxy sublayout) $+      appendToPath p req++    where p = unpack (toText val)++-- | If you have a 'Delete' endpoint in your API, the client+-- side querying function that is created when calling 'client'+-- will just require an argument that specifies the scheme, host+-- and port to send the request to.+instance HasClient Delete where+  type Client Delete = BaseUrl -> EitherT String IO ()++  clientWithRoute Proxy req host =+    performRequestJSON H.methodDelete req 204 host++-- | If you have a 'Get' endpoint in your API, the client+-- side querying function that is created when calling 'client'+-- will just require an argument that specifies the scheme, host+-- and port to send the request to.+instance FromJSON result => HasClient (Get result) where+  type Client (Get result) = BaseUrl -> EitherT String IO result+  clientWithRoute Proxy req host =+    performRequestJSON H.methodGet req 200 host++-- | 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 'ToText' instance.+--+-- Example:+--+-- > newtype Referer = Referer Text+-- >   deriving (Eq, Show, FromText, ToText)+-- >+-- >            -- GET /view-my-referer+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get Referer+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > viewReferer :: Maybe Referer -> BaseUrl -> EitherT String IO Book+-- > viewReferer = client myApi+-- > -- then you can just use "viewRefer" to query that endpoint+-- > -- specifying Nothing or Just "http://haskell.org/" as arguments+instance (KnownSymbol sym, ToText a, HasClient sublayout)+      => HasClient (Header sym a :> sublayout) where++  type Client (Header sym a :> sublayout) =+    Maybe a -> Client sublayout++  clientWithRoute Proxy req mval =+    clientWithRoute (Proxy :: Proxy sublayout) $+      maybe req (\value -> addHeader hname value req) mval++    where hname = symbolVal (Proxy :: Proxy sym)++-- | If you have a 'Post' endpoint in your API, the client+-- side querying function that is created when calling 'client'+-- will just require an argument that specifies the scheme, host+-- and port to send the request to.+instance FromJSON a => HasClient (Post a) where+  type Client (Post a) = BaseUrl -> EitherT String IO a++  clientWithRoute Proxy req uri =+    performRequestJSON H.methodPost req 201 uri++-- | If you have a 'Put' endpoint in your API, the client+-- side querying function that is created when calling 'client'+-- will just require an argument that specifies the scheme, host+-- and port to send the request to.+instance FromJSON a => HasClient (Put a) where+  type Client (Put a) = BaseUrl -> EitherT String IO a++  clientWithRoute Proxy req host =+    performRequestJSON H.methodPut req 200 host++-- | 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 'ToText' instance for your type.+--+-- Example:+--+-- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book]+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > getBooksBy :: Maybe Text -> BaseUrl -> EitherT String IO [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, ToText a, HasClient sublayout)+      => HasClient (QueryParam sym a :> sublayout) where++  type Client (QueryParam sym a :> sublayout) =+    Maybe a -> Client sublayout++  -- if mparam = Nothing, we don't add it to the query string+  clientWithRoute Proxy req mparam =+    clientWithRoute (Proxy :: Proxy sublayout) $+      appendToQueryString pname mparamText req++    where pname  = cs pname'+          pname' = symbolVal (Proxy :: Proxy sym)+          mparamText = fmap toText 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 'ToText' instance for your type.+--+-- Example:+--+-- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book]+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > getBooksBy :: [Text] -> BaseUrl -> EitherT String IO [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, ToText a, HasClient sublayout)+      => HasClient (QueryParams sym a :> sublayout) where++  type Client (QueryParams sym a :> sublayout) =+    [a] -> Client sublayout++  clientWithRoute Proxy req paramlist =+    clientWithRoute (Proxy :: Proxy sublayout) $+      foldl' (\ value req' -> appendToQueryString pname req' value) req paramlist'++    where pname  = cs pname'+          pname' = symbolVal (Proxy :: Proxy sym)+          paramlist' = map (Just . toText) 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 [Book]+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > getBooks :: Bool -> BaseUrl -> EitherT String IO [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 sublayout)+      => HasClient (QueryFlag sym :> sublayout) where++  type Client (QueryFlag sym :> sublayout) =+    Bool -> Client sublayout++  clientWithRoute Proxy req flag =+    clientWithRoute (Proxy :: Proxy sublayout) $+      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 status code and the response body as a 'ByteString'.+instance HasClient Raw where+  type Client Raw = H.Method -> BaseUrl -> EitherT String IO (Int, ByteString)++  clientWithRoute :: Proxy Raw -> Req -> Client Raw+  clientWithRoute Proxy req httpMethod host =+    performRequest httpMethod req (const True) host++-- | 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 Book :> Post Book+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > addBook :: Book -> BaseUrl -> EitherT String IO Book+-- > addBook = client myApi+-- > -- then you can just use "addBook" to query that endpoint+instance (ToJSON a, HasClient sublayout)+      => HasClient (ReqBody a :> sublayout) where++  type Client (ReqBody a :> sublayout) =+    a -> Client sublayout++  clientWithRoute Proxy req body =+    clientWithRoute (Proxy :: Proxy sublayout) $+      setRQBody (encode body) req++-- | Make the querying function append @path@ to the request path.+instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where+  type Client (path :> sublayout) = Client sublayout++  clientWithRoute Proxy req =+     clientWithRoute (Proxy :: Proxy sublayout) $+       appendToPath p req++    where p = symbolVal (Proxy :: Proxy path)+
+ src/Servant/Common/BaseUrl.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ViewPatterns #-}+module Servant.Common.BaseUrl where++import Data.List+import GHC.Generics+import Network.URI+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)+  } deriving (Show, Eq, Ord, Generic)++showBaseUrl :: BaseUrl -> String+showBaseUrl (BaseUrl urlscheme host port) =+  schemeString ++ "//" ++ host ++ portString+    where+      schemeString = case urlscheme of+        Http  -> "http:"+        Https -> "https:"+      portString = case (urlscheme, port) of+        (Http, 80) -> ""+        (Https, 443) -> ""+        _ -> ":" ++ show port++parseBaseUrl :: String -> Either String 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)))) "" "" "") ->+    Right (BaseUrl Http host port)+  Just (URI "http:" (Just (URIAuth "" host "")) "" "" "") ->+    Right (BaseUrl Http host 80)+  Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) "" "" "") ->+    Right (BaseUrl Https host port)+  Just (URI "https:" (Just (URIAuth "" host "")) "" "" "") ->+    Right (BaseUrl Https host 443)+  _ -> if "://" `isInfixOf` s+    then Left ("invalid base url: " ++ s)+    else parseBaseUrl ("http://" ++ s)+ where+  removeTrailingSlash str = case lastMay str of+    Just '/' -> init str+    _ -> str
+ src/Servant/Common/Req.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Servant.Common.Req where++import Control.Applicative+import Control.Concurrent+import Control.Exception+import Control.Monad+import Control.Monad.Catch (MonadThrow)+import Control.Monad.IO.Class+import Control.Monad.Trans.Either+import Data.Aeson+import Data.Aeson.Parser+import Data.Aeson.Types+import Data.Attoparsec.ByteString+import Data.ByteString.Lazy hiding (pack)+import Data.String+import Data.String.Conversions+import Data.Text+import Data.Text.Encoding+import Network.HTTP.Client+import Network.HTTP.Types+import Network.URI+import Servant.Common.BaseUrl+import Servant.Common.Text+import System.IO.Unsafe++import qualified Network.HTTP.Client as Client++data Req = Req+  { reqPath  :: String+  , qs       :: QueryText+  , reqBody  :: ByteString+  , headers  :: [(String, Text)]+  }++defReq :: Req+defReq = Req "" [] "" []++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 :: ToText a => String -> a -> Req -> Req+addHeader name val req = req { headers = headers req+                                      ++ [(name, toText val)]+                             }++setRQBody :: ByteString -> Req -> Req+setRQBody b req = req { reqBody = b }++reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request+reqToRequest req (BaseUrl reqScheme reqHost reqPort) =+    fmap (setheaders . setrqb . setQS ) $ parseUrl url++  where url = show $ nullURI { uriScheme = case reqScheme of+                                  Http  -> "http:"+                                  Https -> "https:"+                             , uriAuthority = Just $+                                 URIAuth { uriUserInfo = ""+                                         , uriRegName = reqHost+                                         , uriPort = ":" ++ show reqPort+                                         }+                             , uriPath = reqPath req+                             }++        setrqb r = r { requestBody = RequestBodyLBS (reqBody req) }+        setQS = setQueryString $ queryTextToQuery (qs req)+        setheaders r = r { requestHeaders = Prelude.map toProperHeader (headers req) }++        toProperHeader (name, val) =+          (fromString name, encodeUtf8 val) +++-- * performing requests++{-# NOINLINE __manager #-}+__manager :: MVar Manager+__manager = unsafePerformIO (newManager defaultManagerSettings >>= newMVar)++__withGlobalManager :: (Manager -> IO a) -> IO a+__withGlobalManager action = modifyMVar __manager $ \ manager -> do+  result <- action manager+  return (manager, result)+++displayHttpRequest :: Method -> String+displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"+++performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO (Int, ByteString)+performRequest reqMethod req isWantedStatus reqHost = do+  partialRequest <- liftIO $ reqToRequest req reqHost++  let request = partialRequest { Client.method = reqMethod+                               , checkStatus = \ _status _headers _cookies -> Nothing+                               }++  eResponse <- liftIO $ __withGlobalManager $ \ manager ->+    catchStatusCodeException $+    Client.httpLbs request manager+  case eResponse of+    Left status ->+      left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)++    Right response -> do+      let status = Client.responseStatus response+      unless (isWantedStatus (statusCode status)) $+        left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)+      return $ (statusCode status, Client.responseBody response)+  where+    showStatus (Status code message) =+      show code ++ " - " ++ cs message+++performRequestJSON :: FromJSON result =>+  Method -> Req -> Int -> BaseUrl -> EitherT String IO result+performRequestJSON reqMethod req wantedStatus reqHost = do+  (_status, respBody) <- performRequest reqMethod req (== wantedStatus) reqHost+  either+    (\ message -> left (displayHttpRequest reqMethod ++ " returned invalid json: " ++ message))+    return+    (decodeLenient respBody)+++catchStatusCodeException :: IO a -> IO (Either Status a)+catchStatusCodeException action =+  catch (Right <$> action) $ \e ->+    case e of+      Client.StatusCodeException status _ _ -> return $ Left status+      exc -> throwIO exc++-- | Like 'Data.Aeson.decode' but allows all JSON values instead of just+-- objects and arrays.+decodeLenient :: FromJSON a => ByteString -> Either String a+decodeLenient input = do+  v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)+  parseEither parseJSON v
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}