eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Merge pull request #1066 from phadej/separate-streaming-client

Browse source 
Separate streaming client
This commit is contained in:
Oleg Grenrus 2018-11-09 14:50:57 +02:00 committed by GitHub
commit 97bd6f0a40
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
22 changed files with 352 additions and 130 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
doc/cookbook/basic-streaming/Streaming.lhs
View file

@ -38,7 +38,7 @@ import Text.Read
(readMaybe)
import Servant
import Servant.Client
import Servant.Client.Streaming
import qualified Servant.Types.SourceT as S
import qualified Network.Wai.Handler.Warp as Warp

24
doc/tutorial/Client.lhs
View file

@ -21,7 +21,8 @@ import Network.HTTP.Client (newManager, defaultManagerSettings)
import Servant.API
import Servant.Client
import Servant.Types.SourceT (foreach)
import Control.Monad.Codensity (Codensity)
import qualified Servant.Client.Streaming as S
```
Also, we need examples for some domain specific data types:
@ -224,6 +225,8 @@ type StreamAPI = "positionStream" :> StreamGet NewlineFraming JSON (SourceIO Pos
Note that we use the same `SourceIO` type as on the server-side
(this is different from `servant-0.14`).
However, we have to use different client, `Servant.Client.Streaming`,
which can stream (but has different API).
In any case, here's how we write a function to query our API:
@ -231,21 +234,18 @@ In any case, here's how we write a function to query our API:
streamAPI :: Proxy StreamAPI
streamAPI = Proxy
posStream :: ClientM (Codensity IO (SourceIO Position))
posStream = client streamAPI
posStream :: S.ClientM (SourceIO Position)
posStream = S.client streamAPI
```
We'll get back a `Codensity IO (SourceIO Position)`. The wrapping in
`Codensity` is generally necessary, as `Codensity` lets us `bracket` things
properly. This is best explained by an example. To consume `ClientM (Codentity
IO ...)` we can use `withClientM` helper: the underlying HTTP connection is
open only until the inner functions exits. Inside the block we can e.g just
print out all elements from a `SourceIO`, to give some idea of how to work with
them.
We'll get back a `SourceIO Position`. Instead of `runClientM`, the streaming
client provides `withClientM`: the underlying HTTP connection is open only
until the inner functions exits. Inside the block we can e.g just print out
all elements from a `SourceIO`, to give some idea of how to work with them.
``` haskell
printSourceIO :: Show a => ClientEnv -> ClientM (Codensity IO (SourceIO a)) -> IO ()
printSourceIO env c = withClientM c env $ \e -> case e of
printSourceIO :: Show a => ClientEnv -> S.ClientM (SourceIO a) -> IO ()
printSourceIO env c = S.withClientM c env $ \e -> case e of
Left err -> putStrLn $ "Error: " ++ show err
Right rs -> foreach fail print rs
```

1
doc/tutorial/tutorial.cabal
View file

@ -46,7 +46,6 @@ library
, http-client
, http-media
, http-types
, kan-extensions
, mtl
, string-conversions
, text

1
servant-client-core/servant-client-core.cabal
View file

@ -70,7 +70,6 @@ library
, http-api-data >= 0.3.8.1 && < 0.4
, http-media >= 0.7.1.2 && < 0.8
, http-types >= 0.12.1 && < 0.13
, kan-extensions >= 5.2 && < 5.3
, network-uri >= 2.6.1.0 && < 2.7
, safe >= 0.3.17 && < 0.4

2
servant-client-core/src/Servant/Client/Core.hs
View file

@ -44,6 +44,8 @@ module Servant.Client.Core
, GenResponse (..)
, RunClient(..)
, module Servant.Client.Core.Internal.BaseUrl
-- ** Streaming
, RunStreamingClient(..)
, StreamingResponse
-- * Writing HasClient instances

41
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs
View file

@ -36,20 +36,17 @@ import qualified Network.HTTP.Types as H
import Servant.API
((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData,
BuildHeadersTo (..), Capture', CaptureAll, Description,
EmptyAPI, FramingUnrender (..), FromSourceIO (..),
Header', Headers (..), HttpVersion, IsSecure,
MimeRender (mimeRender), MimeUnrender (mimeUnrender),
NoContent (NoContent), QueryFlag, QueryParam', QueryParams,
Raw, ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
StreamBody, Summary, ToHttpApiData, Vault, Verb,
WithNamedContext, contentType, getHeadersHList, getResponse,
toQueryParam, toUrlPiece)
EmptyAPI, FramingUnrender (..), FromSourceIO (..), Header',
Headers (..), HttpVersion, IsSecure, MimeRender (mimeRender),
MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
ReqBody', SBoolI, Stream, StreamBody, Summary, ToHttpApiData,
Vault, Verb, WithNamedContext, contentType, getHeadersHList,
getResponse, toQueryParam, toUrlPiece)
import Servant.API.ContentTypes
(contentTypes)
import Servant.API.Modifiers
(FoldRequired, RequiredArgument, foldRequiredArgument)
import Control.Monad.Codensity
(Codensity (..))
import qualified Servant.Types.SourceT as S
import Servant.Client.Core.Internal.Auth
@ -272,25 +269,23 @@ instance {-# OVERLAPPING #-}
hoistClientMonad _ _ f ma = f ma
instance {-# OVERLAPPABLE #-}
( RunClient m, MimeUnrender ct chunk, ReflectMethod method,
( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method,
FramingUnrender framing, FromSourceIO chunk a
) => HasClient m (Stream method status framing ct a) where
type Client m (Stream method status framing ct a) = m (Codensity IO a)
type Client m (Stream method status framing ct a) = m a
hoistClientMonad _ _ f ma = f ma
clientWithRoute _pm Proxy req = do
sresp <- streamingRequest req
{ requestAccept = fromList [contentType (Proxy :: Proxy ct)]
, requestMethod = reflectMethod (Proxy :: Proxy method)
}
return $ do
let mimeUnrender' = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'
gres <- sresp
return $ fromSourceIO $ framingUnrender' $ S.fromAction BS.null (responseBody gres)
clientWithRoute _pm Proxy req = withStreamingRequest req' $ \gres -> do
let mimeUnrender' = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'
return $ fromSourceIO $ framingUnrender' $ S.fromAction BS.null (responseBody gres)
where
req' = req
{ requestAccept = fromList [contentType (Proxy :: Proxy ct)]
, requestMethod = reflectMethod (Proxy :: Proxy method)
}
-- | If you use a 'Header' in one of your endpoints in your API,
-- the corresponding querying function will automatically take

4
servant-client-core/src/Servant/Client/Core/Internal/Request.hs
View file

@ -38,8 +38,6 @@ import Network.HTTP.Media
import Network.HTTP.Types
(Header, HeaderName, HttpVersion, Method, QueryItem, Status,
http11, methodGet)
import Control.Monad.Codensity
(Codensity (..))
import Web.HttpApiData
(ToHttpApiData, toEncodedUrlPiece, toHeader)
@ -91,7 +89,7 @@ data GenResponse a = Response
} deriving (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable)
type Response = GenResponse LBS.ByteString
type StreamingResponse = Codensity IO (GenResponse (IO BS.ByteString))
type StreamingResponse = GenResponse (IO BS.ByteString)
-- A GET request to the top-level path
defaultRequest :: Request

11
servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs
View file

@ -31,9 +31,11 @@ import Servant.Client.Core.Internal.Request
class Monad m => RunClient m where
-- | How to make a request.
runRequest :: Request -> m Response
streamingRequest :: Request -> m StreamingResponse
throwServantError :: ServantError -> m a
class RunClient m => RunStreamingClient m where
withStreamingRequest :: Request -> (StreamingResponse -> IO a) -> m a
checkContentTypeHeader :: RunClient m => Response -> m MediaType
checkContentTypeHeader response =
case lookup "Content-Type" $ toList $ responseHeaders response of
@ -56,5 +58,10 @@ decodedAs response contentType = do
instance ClientF ~ f => RunClient (Free f) where
runRequest req = liftF (RunRequest req id)
streamingRequest req = liftF (StreamingRequest req id)
throwServantError = liftF . Throw
{-
Free and streaming?
instance ClientF ~ f => RunStreamingClient (Free f) where
streamingRequest req = liftF (StreamingRequest req id)
-}

1
servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs
View file

@ -108,7 +108,6 @@ instance Exception StreamingNotSupportedException where
instance RunClient ClientM where
runRequest = performRequest
streamingRequest _ = liftIO $ throwIO StreamingNotSupportedException
throwServantError = throwError
instance ClientLike (ClientM a) (ClientM a) where

2
servant-client/servant-client.cabal
View file

@ -33,7 +33,9 @@ source-repository head
library
exposed-modules:
Servant.Client
Servant.Client.Streaming
Servant.Client.Internal.HttpClient
Servant.Client.Internal.HttpClient.Streaming
-- Bundled with GHC: Lower bound to not force re-installs
-- text and mtl are bundled starting with GHC-8.4

1
servant-client/src/Servant/Client.hs
View file

@ -7,7 +7,6 @@ module Servant.Client
( client
, ClientM
, runClientM
, withClientM
, ClientEnv(..)
, mkClientEnv
, hoistClient

29
servant-client/src/Servant/Client/Internal/HttpClient.hs
View file

@ -21,8 +21,6 @@ import Control.Monad.Base
(MonadBase (..))
import Control.Monad.Catch
(MonadCatch, MonadThrow)
import Control.Monad.Codensity
(Codensity (..))
import Control.Monad.Error.Class
(MonadError (..))
import Control.Monad.Reader
@ -134,7 +132,6 @@ instance Alt ClientM where
instance RunClient ClientM where
runRequest = performRequest
streamingRequest = performStreamingRequest
throwServantError = throwError
instance ClientLike (ClientM a) (ClientM a) where
@ -143,17 +140,6 @@ instance ClientLike (ClientM a) (ClientM a) where
runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm
withClientM
:: ClientM (Codensity IO a) -- ^ client with codensity result
-> ClientEnv -- ^ environment
-> (Either ServantError a -> IO b) -- ^ continuation
-> IO b
withClientM cm env k = do
e <- runExceptT (runReaderT (unClientM cm) env)
case e of
Left err -> k (Left err)
Right cod -> runCodensity cod (k . Right)
performRequest :: Request -> ClientM Response
performRequest req = do
ClientEnv m burl cookieJar' <- ask
@ -186,21 +172,6 @@ performRequest req = do
throwError $ FailureResponse ourResponse
return ourResponse
performStreamingRequest :: Request -> ClientM StreamingResponse
performStreamingRequest req = do
m <- asks manager
burl <- asks baseUrl
let request = requestToClientRequest burl req
return $ Codensity $
\k -> Client.withResponse request m $
\r -> do
let status = Client.responseStatus r
status_code = statusCode status
unless (status_code >= 200 && status_code < 300) $ do
b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody r)
throw $ FailureResponse $ clientResponseToResponse r { Client.responseBody = b }
k (clientResponseToResponse r)
clientResponseToResponse :: Client.Response a -> GenResponse a
clientResponseToResponse r = Response
{ responseStatusCode = Client.responseStatus r

172
servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs Normal file
View file

@ -0,0 +1,172 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Servant.Client.Internal.HttpClient.Streaming (
module Servant.Client.Internal.HttpClient.Streaming,
ClientEnv (..),
mkClientEnv,
clientResponseToResponse,
requestToClientRequest,
catchConnectionError,
) where
import Prelude ()
import Prelude.Compat
import Control.Concurrent.STM.TVar
import Control.Exception
import Control.Monad
import Control.Monad.Base
(MonadBase (..))
import Control.Monad.Codensity
(Codensity (..))
import Control.Monad.Error.Class
(MonadError (..))
import Control.Monad.Reader
import Control.Monad.STM
(atomically)
import Control.Monad.Trans.Except
import qualified Data.ByteString.Lazy as BSL
import Data.Foldable
(for_)
import Data.Functor.Alt
(Alt (..))
import Data.Proxy
(Proxy (..))
import Data.Time.Clock
(getCurrentTime)
import GHC.Generics
import Network.HTTP.Types
(statusCode)
import qualified Network.HTTP.Client as Client
import Servant.Client.Core
import Servant.Client.Internal.HttpClient
(ClientEnv (..), catchConnectionError,
clientResponseToResponse, mkClientEnv, requestToClientRequest)
-- | Generates a set of client functions for an API.
--
-- Example:
--
-- > type API = Capture "no" Int :> Get '[JSON] Int
-- > :<|> Get '[JSON] [Bool]
-- >
-- > api :: Proxy API
-- > api = Proxy
-- >
-- > getInt :: Int -> ClientM Int
-- > getBools :: ClientM [Bool]
-- > getInt :<|> getBools = client api
client :: HasClient ClientM api => Proxy api -> Client ClientM api
client api = api `clientIn` (Proxy :: Proxy ClientM)
-- | Change the monad the client functions live in, by
-- supplying a conversion function
-- (a natural transformation to be precise).
--
-- For example, assuming you have some @manager :: 'Manager'@ and
-- @baseurl :: 'BaseUrl'@ around:
--
-- > type API = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int
-- > api :: Proxy API
-- > api = Proxy
-- > getInt :: IO Int
-- > postInt :: Int -> IO Int
-- > getInt :<|> postInt = hoistClient api (flip runClientM cenv) (client api)
-- > where cenv = mkClientEnv manager baseurl
hoistClient
:: HasClient ClientM api
=> Proxy api
-> (forall a. m a -> n a)
-> Client m api
-> Client n api
hoistClient = hoistClientMonad (Proxy :: Proxy ClientM)
-- | @ClientM@ is the monad in which client functions run. Contains the
-- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.
newtype ClientM a = ClientM
{ unClientM :: ReaderT ClientEnv (ExceptT ServantError (Codensity IO)) a }
deriving ( Functor, Applicative, Monad, MonadIO, Generic
, MonadReader ClientEnv, MonadError ServantError)
instance MonadBase IO ClientM where
liftBase = ClientM . liftIO
-- | Try clients in order, last error is preserved.
instance Alt ClientM where
a <!> b = a `catchError` \_ -> b
instance RunClient ClientM where
runRequest = performRequest
throwServantError = throwError
instance RunStreamingClient ClientM where
withStreamingRequest = performWithStreamingRequest
instance ClientLike (ClientM a) (ClientM a) where
mkClient = id
withClientM :: ClientM a -> ClientEnv -> (Either ServantError a -> IO b) -> IO b
withClientM cm env k =
let Codensity f = runExceptT $ flip runReaderT env $ unClientM cm
in f k
performRequest :: Request -> ClientM Response
performRequest req = do
-- TODO: should use Client.withResponse here too
ClientEnv m burl cookieJar' <- ask
let clientRequest = requestToClientRequest burl req
request <- case cookieJar' of
Nothing -> pure clientRequest
Just cj -> liftIO $ do
now <- getCurrentTime
atomically $ do
oldCookieJar <- readTVar cj
let (newRequest, newCookieJar) =
Client.insertCookiesIntoRequest
(requestToClientRequest burl req)
oldCookieJar
now
writeTVar cj newCookieJar
pure newRequest
eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request m
case eResponse of
Left err -> throwError err
Right response -> do
for_ cookieJar' $ \cj -> liftIO $ do
now' <- getCurrentTime
atomically $ modifyTVar' cj (fst . Client.updateCookieJar response request now')
let status = Client.responseStatus response
status_code = statusCode status
ourResponse = clientResponseToResponse response
unless (status_code >= 200 && status_code < 300) $
throwError $ FailureResponse ourResponse
return ourResponse
performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
performWithStreamingRequest req k = do
m <- asks manager
burl <- asks baseUrl
let request = requestToClientRequest burl req
ClientM $ lift $ lift $ Codensity $ \k1 ->
Client.withResponse request m $ \res -> do
let status = Client.responseStatus res
status_code = statusCode status
-- we throw FailureResponse in IO :(
unless (status_code >= 200 && status_code < 300) $ do
b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody res)
throwIO $ FailureResponse $ clientResponseToResponse res { Client.responseBody = b }
x <- k (clientResponseToResponse res)
k1 x

17
servant-client/src/Servant/Client/Streaming.hs Normal file
View file

@ -0,0 +1,17 @@
-- | This module provides 'client' which can automatically generate
-- querying functions for each endpoint just from the type representing your
-- API.
--
-- This client supports streaming operations.
module Servant.Client.Streaming
( client
, ClientM
, withClientM
, ClientEnv(..)
, mkClientEnv
, hoistClient
, module Servant.Client.Core.Reexport
) where
import Servant.Client.Core.Reexport
import Servant.Client.Internal.HttpClient.Streaming

2
servant-client/test/Servant/ClientSpec.hs
View file

@ -72,7 +72,7 @@ import Servant.Server
import Servant.Server.Experimental.Auth
-- This declaration simply checks that all instances are in place.
_ = client comprehensiveAPI
_ = client comprehensiveAPIWithoutStreaming
spec :: Spec
spec = describe "Servant.Client" $ do

43
servant-client/test/Servant/StreamSpec.hs
View file

@ -28,20 +28,21 @@ import Control.Monad.Codensity
import Control.Monad.IO.Class
(MonadIO (..))
import Control.Monad.Trans.Except
import qualified Data.ByteString as BS
import qualified Data.ByteString as BS
import Data.Proxy
import qualified Data.TDigest as TD
import qualified Network.HTTP.Client as C
import qualified Data.TDigest as TD
import qualified Network.HTTP.Client as C
import Prelude ()
import Prelude.Compat
import Servant.API
((:<|>) ((:<|>)), (:>), JSON, NetstringFraming,
NewlineFraming, NoFraming, OctetStream, SourceIO, StreamGet)
import Servant.Client
import Servant.Client.Streaming
import Servant.ClientSpec
(Person (..))
import qualified Servant.ClientSpec as CS
import qualified Servant.ClientSpec as CS
import Servant.Server
import Servant.Test.ComprehensiveAPI
import Servant.Types.SourceT
import System.Entropy
(getEntropy, getHardwareEntropy)
@ -59,8 +60,12 @@ import GHC.Stats
(currentBytesUsed, getGCStats)
#endif
-- This declaration simply checks that all instances are in place.
-- Note: this is streaming client
_ = client comprehensiveAPI
spec :: Spec
spec = describe "Servant.Stream" $ do
spec = describe "Servant.Client.Streaming" $ do
streamSpec
type StreamApi =
@ -71,8 +76,8 @@ type StreamApi =
api :: Proxy StreamApi
api = Proxy
getGetNL, getGetNS :: ClientM (Codensity IO (SourceIO Person))
getGetALot :: ClientM (Codensity IO (SourceIO BS.ByteString))
getGetNL, getGetNS :: ClientM (SourceIO Person)
getGetALot :: ClientM (SourceIO BS.ByteString)
getGetNL :<|> getGetNS :<|> getGetALot = client api
alice :: Person
@ -104,28 +109,22 @@ powerOfTwo = (2 ^)
manager' :: C.Manager
manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings
runClient :: ClientM a -> BaseUrl -> IO (Either ServantError a)
runClient x baseUrl' = runClientM x (mkClientEnv manager' baseUrl')
withClient :: ClientM a -> BaseUrl -> (Either ServantError a -> IO r) -> IO r
withClient x baseUrl' = withClientM x (mkClientEnv manager' baseUrl')
testRunSourceIO :: Codensity IO (SourceIO a)
testRunSourceIO :: SourceIO a
-> IO (Either String [a])
testRunSourceIO = runExceptT . runSourceT . joinCodensitySourceT
joinCodensitySourceT :: Codensity m (SourceT m a) -> SourceT m a
joinCodensitySourceT cod =
SourceT $ \r ->
runCodensity cod $ \src ->
unSourceT src r
testRunSourceIO = runExceptT . runSourceT
streamSpec :: Spec
streamSpec = beforeAll (CS.startWaiApp server) $ afterAll CS.endWaiApp $ do
it "works with Servant.API.StreamGet.Newline" $ \(_, baseUrl) -> do
Right res <- runClient getGetNL baseUrl
testRunSourceIO res `shouldReturn` Right [alice, bob, alice]
withClient getGetNL baseUrl $ \(Right res) ->
testRunSourceIO res `shouldReturn` Right [alice, bob, alice]
it "works with Servant.API.StreamGet.Netstring" $ \(_, baseUrl) -> do
Right res <- runClient getGetNS baseUrl
testRunSourceIO res `shouldReturn` Right [alice, bob, alice]
withClient getGetNS baseUrl $ \(Right res) ->
testRunSourceIO res `shouldReturn` Right [alice, bob, alice]
{-
it "streams in constant memory" $ \(_, baseUrl) -> do

2
servant-conduit/example/Main.hs
View file

@ -27,7 +27,7 @@ import Text.Read
import Data.Conduit
import qualified Data.Conduit.Combinators as C
import Servant
import Servant.Client
import Servant.Client.Streaming
import Servant.Conduit ()
import qualified Network.Wai.Handler.Warp as Warp

36
servant-docs/golden/comprehensive.md
View file

@ -16,6 +16,42 @@
```
## GET /alternative/left
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /alternative/right
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /capture/:foo
### Captures:

2
servant-machines/example/Main.hs
View file

@ -26,7 +26,7 @@ import Text.Read
import Data.Machine
import Servant
import Servant.Client
import Servant.Client.Streaming
import Servant.Machines ()
import qualified Network.Wai.Handler.Warp as Warp

7
servant-pipes/example/Main.hs
View file

@ -19,18 +19,19 @@ import Network.Wai
(Application)
import System.Environment
(getArgs, lookupEnv)
import System.IO (IOMode (..))
import System.IO
(IOMode (..))
import Text.Read
(readMaybe)
import qualified Pipes as P
import Pipes.ByteString as PBS
import qualified Pipes.Prelude as P
import Pipes.Safe
(SafeT)
import qualified Pipes.Safe.Prelude as P
import Servant
import Pipes.ByteString as PBS
import Servant.Client
import Servant.Client.Streaming
import Servant.Pipes ()
import qualified Network.Wai.Handler.Warp as Warp

80
servant/src/Servant/Test/ComprehensiveAPI.hs
View file

@ -15,38 +15,64 @@ import Servant.Types.SourceT
type GET = Get '[JSON] NoContent
type ComprehensiveAPI =
ComprehensiveAPIWithoutRaw :<|>
"raw" :> Raw
ComprehensiveAPIWithoutStreamingOrRaw'
(EmptyEndpoint :<|> StreamingEndpoint :<|> RawEndpoint)
type RawEndpoint =
"raw" :> Raw
type StreamingEndpoint =
"streaming" :> StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int)
type EmptyEndpoint =
"empty-api" :> EmptyAPI
comprehensiveAPI :: Proxy ComprehensiveAPI
comprehensiveAPI = Proxy
type ComprehensiveAPIWithoutRaw =
GET :<|>
"get-int" :> Get '[JSON] Int :<|>
"capture" :> Capture' '[Description "example description"] "foo" Int :> GET :<|>
"header" :> Header "foo" Int :> GET :<|>
"header-lenient" :> Header' '[Required, Lenient] "bar" Int :> GET :<|>
"http-version" :> HttpVersion :> GET :<|>
"is-secure" :> IsSecure :> GET :<|>
"param" :> QueryParam "foo" Int :> GET :<|>
"param-lenient" :> QueryParam' '[Required, Lenient] "bar" Int :> GET :<|>
"params" :> QueryParams "foo" Int :> GET :<|>
"flag" :> QueryFlag "foo" :> GET :<|>
"remote-host" :> RemoteHost :> GET :<|>
"req-body" :> ReqBody '[JSON] Int :> GET :<|>
"req-body-lenient" :> ReqBody' '[Lenient] '[JSON] Int :> GET :<|>
"res-headers" :> Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>
"foo" :> GET :<|>
"vault" :> Vault :> GET :<|>
"post-no-content" :> Verb 'POST 204 '[JSON] NoContent :<|>
"post-int" :> Verb 'POST 204 '[JSON] Int :<|>
"streaming" :> StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int) :<|>
"named-context" :> WithNamedContext "foo" '[] GET :<|>
"capture-all" :> CaptureAll "foo" Int :> GET :<|>
"summary" :> Summary "foo" :> GET :<|>
"description" :> Description "foo" :> GET :<|>
"empty-api" :> EmptyAPI
ComprehensiveAPIWithoutStreamingOrRaw'
(EmptyEndpoint :<|> StreamingEndpoint)
comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw
comprehensiveAPIWithoutRaw = Proxy
type ComprehensiveAPIWithoutStreaming =
ComprehensiveAPIWithoutStreamingOrRaw'
(EmptyEndpoint :<|> RawEndpoint)
comprehensiveAPIWithoutStreaming :: Proxy ComprehensiveAPIWithoutStreaming
comprehensiveAPIWithoutStreaming = Proxy
-- | @:: API -> API@, so we have linear structure of the API.
type ComprehensiveAPIWithoutStreamingOrRaw' endpoint =
GET
:<|> "get-int" :> Get '[JSON] Int
:<|> "capture" :> Capture' '[Description "example description"] "foo" Int :> GET
:<|> "header" :> Header "foo" Int :> GET
:<|> "header-lenient" :> Header' '[Required, Lenient] "bar" Int :> GET
:<|> "http-version" :> HttpVersion :> GET
:<|> "is-secure" :> IsSecure :> GET
:<|> "param" :> QueryParam "foo" Int :> GET
:<|> "param-lenient" :> QueryParam' '[Required, Lenient] "bar" Int :> GET
:<|> "params" :> QueryParams "foo" Int :> GET
:<|> "flag" :> QueryFlag "foo" :> GET
:<|> "remote-host" :> RemoteHost :> GET
:<|> "req-body" :> ReqBody '[JSON] Int :> GET
:<|> "req-body-lenient" :> ReqBody' '[Lenient] '[JSON] Int :> GET
:<|> "res-headers" :> Get '[JSON] (Headers '[Header "foo" Int] NoContent)
:<|> "foo" :> GET
:<|> "vault" :> Vault :> GET
:<|> "post-no-content" :> Verb 'POST 204 '[JSON] NoContent
:<|> "post-int" :> Verb 'POST 204 '[JSON] Int
:<|> "named-context" :> WithNamedContext "foo" '[] GET
:<|> "capture-all" :> CaptureAll "foo" Int :> GET
:<|> "summary" :> Summary "foo" :> GET
:<|> "description" :> Description "foo" :> GET
:<|> "alternative" :> ("left" :> GET :<|> "right" :> GET)
:<|> endpoint
type ComprehensiveAPIWithoutStreamingOrRaw = ComprehensiveAPIWithoutStreamingOrRaw' EmptyEndpoint
comprehensiveAPIWithoutStreamingOrRaw :: Proxy ComprehensiveAPIWithoutStreamingOrRaw
comprehensiveAPIWithoutStreamingOrRaw = Proxy

2
servant/test/Servant/LinksSpec.hs
View file

@ -89,7 +89,7 @@ spec = describe "Servant.Links" $ do
allNames ["Seneca", "Aurelius"] `shouldBeLink` "all/Seneca/Aurelius"
it "can generate all links for ComprehensiveAPIWithoutRaw" $ do
let (firstLink :<|> _) = allLinks comprehensiveAPIWithoutRaw
let firstLink :<|> _ = allLinks comprehensiveAPIWithoutRaw
firstLink `shouldBeLink` ""
-- |