Extend tests and clean up
This commit is contained in:
parent
40a941e0e3
commit
da0e1ca871
3 changed files with 23 additions and 16 deletions
|
@ -78,5 +78,6 @@ test-suite spec
|
||||||
, servant >= 0.2.1
|
, servant >= 0.2.1
|
||||||
, servant-client
|
, servant-client
|
||||||
, servant-server >= 0.2.1
|
, servant-server >= 0.2.1
|
||||||
|
, text
|
||||||
, wai
|
, wai
|
||||||
, warp
|
, warp
|
||||||
|
|
|
@ -9,10 +9,6 @@ import Control.Monad
|
||||||
import Control.Monad.Catch (MonadThrow)
|
import Control.Monad.Catch (MonadThrow)
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Control.Monad.Trans.Either
|
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, filter, map, null)
|
import Data.ByteString.Lazy hiding (pack, filter, map, null)
|
||||||
import Data.String
|
import Data.String
|
||||||
import Data.String.Conversions
|
import Data.String.Conversions
|
||||||
|
|
|
@ -3,6 +3,7 @@
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# OPTIONS_GHC -fcontext-stack=25 #-}
|
{-# OPTIONS_GHC -fcontext-stack=25 #-}
|
||||||
module Servant.ClientSpec where
|
module Servant.ClientSpec where
|
||||||
|
@ -14,8 +15,9 @@ import Data.Aeson
|
||||||
import Data.ByteString.Lazy (ByteString)
|
import Data.ByteString.Lazy (ByteString)
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Foldable (forM_)
|
import Data.Foldable (forM_)
|
||||||
|
import Data.Monoid
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import Data.Typeable
|
import qualified Data.Text as T
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
import Network.HTTP.Media
|
import Network.HTTP.Media
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
|
@ -27,6 +29,7 @@ import Test.Hspec.QuickCheck
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
|
|
||||||
import Servant.API
|
import Servant.API
|
||||||
|
import Servant.API.ContentTypes
|
||||||
import Servant.Client
|
import Servant.Client
|
||||||
import Servant.Server
|
import Servant.Server
|
||||||
|
|
||||||
|
@ -41,22 +44,35 @@ data Person = Person {
|
||||||
instance ToJSON Person
|
instance ToJSON Person
|
||||||
instance FromJSON 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 = Person "Alice" 42
|
alice = Person "Alice" 42
|
||||||
|
|
||||||
type Api =
|
type Api =
|
||||||
"get" :> Get '[JSON] Person
|
"get" :> Get '[JSON] Person
|
||||||
:<|> "delete" :> Delete
|
:<|> "delete" :> Delete
|
||||||
:<|> "capture" :> Capture "name" String :> Get '[JSON] Person
|
:<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
|
||||||
:<|> "body" :> ReqBody '[JSON] Person :> Post '[JSON] Person
|
:<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
|
||||||
:<|> "param" :> QueryParam "name" String :> Get '[JSON] Person
|
:<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
|
||||||
:<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
|
:<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
|
||||||
:<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
|
:<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
|
||||||
{-
|
|
||||||
:<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person
|
:<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person
|
||||||
:<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person]
|
:<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person]
|
||||||
:<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool
|
:<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool
|
||||||
-}
|
|
||||||
:<|> "rawSuccess" :> Raw
|
:<|> "rawSuccess" :> Raw
|
||||||
:<|> "rawFailure" :> Raw
|
:<|> "rawFailure" :> Raw
|
||||||
:<|> "multiple" :>
|
:<|> "multiple" :>
|
||||||
|
@ -80,14 +96,12 @@ server = serve api (
|
||||||
Nothing -> left (400, "missing parameter"))
|
Nothing -> left (400, "missing parameter"))
|
||||||
:<|> (\ names -> return (zipWith Person names [0..]))
|
:<|> (\ names -> return (zipWith Person names [0..]))
|
||||||
:<|> return
|
:<|> return
|
||||||
{-
|
|
||||||
:<|> (\ name -> case name of
|
:<|> (\ name -> case name of
|
||||||
Just "alice" -> return alice
|
Just "alice" -> return alice
|
||||||
Just name -> left (400, name ++ " not found")
|
Just name -> left (400, name ++ " not found")
|
||||||
Nothing -> left (400, "missing parameter"))
|
Nothing -> left (400, "missing parameter"))
|
||||||
:<|> (\ names -> return (zipWith Person names [0..]))
|
:<|> (\ names -> return (zipWith Person names [0..]))
|
||||||
:<|> return
|
:<|> return
|
||||||
-}
|
|
||||||
:<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
|
:<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
|
||||||
:<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
|
:<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
|
||||||
:<|> \ a b c d -> return (a, b, c, d)
|
:<|> \ a b c d -> return (a, b, c, d)
|
||||||
|
@ -103,11 +117,9 @@ getBody :: Person -> BaseUrl -> EitherT String IO Person
|
||||||
getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
|
getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
|
||||||
getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
|
getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
|
||||||
getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
|
getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
|
||||||
{-
|
|
||||||
getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person
|
getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person
|
||||||
getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]
|
getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]
|
||||||
getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool
|
getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool
|
||||||
-}
|
|
||||||
getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
|
getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
|
||||||
getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
|
getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
|
||||||
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
|
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
|
||||||
|
@ -120,11 +132,9 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
|
||||||
:<|> getQueryParam
|
:<|> getQueryParam
|
||||||
:<|> getQueryParams
|
:<|> getQueryParams
|
||||||
:<|> getQueryFlag
|
:<|> getQueryFlag
|
||||||
{-
|
|
||||||
:<|> getMatrixParam
|
:<|> getMatrixParam
|
||||||
:<|> getMatrixParams
|
:<|> getMatrixParams
|
||||||
:<|> getMatrixFlag
|
:<|> getMatrixFlag
|
||||||
-}
|
|
||||||
:<|> getRawSuccess
|
:<|> getRawSuccess
|
||||||
:<|> getRawFailure
|
:<|> getRawFailure
|
||||||
:<|> getMultiple)
|
:<|> getMultiple)
|
||||||
|
|
Loading…
Reference in a new issue