Add mods to StreamBody
This commit is contained in:
parent
bbf196717f
commit
3001ed7990
9 changed files with 35 additions and 32 deletions
|
@ -40,7 +40,7 @@ import Servant.API
|
||||||
Headers (..), HttpVersion, IsSecure, MimeRender (mimeRender),
|
Headers (..), HttpVersion, IsSecure, MimeRender (mimeRender),
|
||||||
MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
|
MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
|
||||||
QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
|
QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
|
||||||
ReqBody', SBoolI, Stream, StreamBody, Summary, ToHttpApiData,
|
ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData,
|
||||||
Vault, Verb, WithNamedContext, contentType, getHeadersHList,
|
Vault, Verb, WithNamedContext, contentType, getHeadersHList,
|
||||||
getResponse, toQueryParam, toUrlPiece)
|
getResponse, toQueryParam, toUrlPiece)
|
||||||
import Servant.API.ContentTypes
|
import Servant.API.ContentTypes
|
||||||
|
@ -539,10 +539,10 @@ instance (MimeRender ct a, HasClient m api)
|
||||||
|
|
||||||
instance
|
instance
|
||||||
( HasClient m api
|
( HasClient m api
|
||||||
) => HasClient m (StreamBody framing ctype a :> api)
|
) => HasClient m (StreamBody' mods framing ctype a :> api)
|
||||||
where
|
where
|
||||||
|
|
||||||
type Client m (StreamBody framing ctype a :> api) = a -> Client m api
|
type Client m (StreamBody' mods framing ctype a :> api) = a -> Client m api
|
||||||
|
|
||||||
hoistClientMonad pm _ f cl = \a ->
|
hoistClientMonad pm _ f cl = \a ->
|
||||||
hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
|
hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
|
||||||
|
|
|
@ -980,7 +980,7 @@ instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
|
||||||
p = Proxy :: Proxy a
|
p = Proxy :: Proxy a
|
||||||
|
|
||||||
-- | TODO: this instance is incomplete.
|
-- | TODO: this instance is incomplete.
|
||||||
instance (HasDocs api, Accept ctype) => HasDocs (StreamBody framing ctype a :> api) where
|
instance (HasDocs api, Accept ctype) => HasDocs (StreamBody' mods framing ctype a :> api) where
|
||||||
docsFor Proxy (endpoint, action) opts =
|
docsFor Proxy (endpoint, action) opts =
|
||||||
docsFor subApiP (endpoint, action') opts
|
docsFor subApiP (endpoint, action') opts
|
||||||
where
|
where
|
||||||
|
|
|
@ -328,9 +328,9 @@ instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype api
|
||||||
|
|
||||||
instance
|
instance
|
||||||
( HasForeign lang ftype api
|
( HasForeign lang ftype api
|
||||||
) => HasForeign lang ftype (StreamBody framing ctype a :> api)
|
) => HasForeign lang ftype (StreamBody' mods framing ctype a :> api)
|
||||||
where
|
where
|
||||||
type Foreign ftype (StreamBody framing ctype a :> api) = Foreign ftype api
|
type Foreign ftype (StreamBody' mods framing ctype a :> api) = Foreign ftype api
|
||||||
|
|
||||||
foreignFor _lang Proxy Proxy _req = error "HasForeign @StreamBody"
|
foreignFor _lang Proxy Proxy _req = error "HasForeign @StreamBody"
|
||||||
|
|
||||||
|
|
|
@ -71,7 +71,7 @@ import Servant.API
|
||||||
FramingUnrender (..), FromSourceIO (..), Header', If,
|
FramingUnrender (..), FromSourceIO (..), Header', If,
|
||||||
IsSecure (..), QueryFlag, QueryParam', QueryParams, Raw,
|
IsSecure (..), QueryFlag, QueryParam', QueryParams, Raw,
|
||||||
ReflectMethod (reflectMethod), RemoteHost, ReqBody',
|
ReflectMethod (reflectMethod), RemoteHost, ReqBody',
|
||||||
SBool (..), SBoolI (..), SourceIO, Stream, StreamBody,
|
SBool (..), SBoolI (..), SourceIO, Stream, StreamBody',
|
||||||
Summary, ToSourceIO (..), Vault, Verb, WithNamedContext)
|
Summary, ToSourceIO (..), Vault, Verb, WithNamedContext)
|
||||||
import Servant.API.ContentTypes
|
import Servant.API.ContentTypes
|
||||||
(AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),
|
(AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),
|
||||||
|
@ -610,9 +610,9 @@ instance ( AllCTUnrender list a, HasServer api context, SBoolI (FoldLenient mods
|
||||||
instance
|
instance
|
||||||
( FramingUnrender framing, FromSourceIO chunk a, MimeUnrender ctype chunk
|
( FramingUnrender framing, FromSourceIO chunk a, MimeUnrender ctype chunk
|
||||||
, HasServer api context
|
, HasServer api context
|
||||||
) => HasServer (StreamBody framing ctype a :> api) context
|
) => HasServer (StreamBody' mods framing ctype a :> api) context
|
||||||
where
|
where
|
||||||
type ServerT (StreamBody framing ctype a :> api) m = a -> ServerT api m
|
type ServerT (StreamBody' mods framing ctype a :> api) m = a -> ServerT api m
|
||||||
|
|
||||||
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
|
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
|
||||||
|
|
||||||
|
|
|
@ -12,24 +12,26 @@
|
||||||
|
|
||||||
module Servant.ServerSpec where
|
module Servant.ServerSpec where
|
||||||
|
|
||||||
|
import Prelude ()
|
||||||
|
import Prelude.Compat
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
(forM_, unless, when)
|
(forM_, unless, when)
|
||||||
import Control.Monad.Error.Class
|
import Control.Monad.Error.Class
|
||||||
(MonadError (..))
|
(MonadError (..))
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
(FromJSON, ToJSON, decode', encode)
|
(FromJSON, ToJSON, decode', encode)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Base64 as Base64
|
import qualified Data.ByteString.Base64 as Base64
|
||||||
import Data.Char
|
import Data.Char
|
||||||
(toUpper)
|
(toUpper)
|
||||||
import Data.Monoid
|
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
(Proxy (Proxy))
|
(Proxy (Proxy))
|
||||||
import Data.String
|
import Data.String
|
||||||
(fromString)
|
(fromString)
|
||||||
import Data.String.Conversions
|
import Data.String.Conversions
|
||||||
(cs)
|
(cs)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
(Generic)
|
(Generic)
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
|
@ -42,25 +44,25 @@ import Network.Wai
|
||||||
import Network.Wai.Test
|
import Network.Wai.Test
|
||||||
(defaultRequest, request, runSession, simpleBody,
|
(defaultRequest, request, runSession, simpleBody,
|
||||||
simpleHeaders, simpleStatus)
|
simpleHeaders, simpleStatus)
|
||||||
import qualified Servant.Types.SourceT as S
|
|
||||||
import Servant.API
|
import Servant.API
|
||||||
((:<|>) (..), (:>), AuthProtect, BasicAuth,
|
((:<|>) (..), (:>), AuthProtect, BasicAuth,
|
||||||
BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,
|
BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,
|
||||||
EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
|
EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
|
||||||
JSON, NoContent (..), NoFraming, OctetStream, Patch,
|
JSON, NoContent (..), NoFraming, OctetStream, Patch,
|
||||||
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
|
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
|
||||||
RemoteHost, ReqBody, StdMethod (..), Stream,
|
RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb,
|
||||||
SourceIO, Verb, addHeader)
|
addHeader)
|
||||||
import Servant.Test.ComprehensiveAPI
|
|
||||||
import Servant.Server
|
import Servant.Server
|
||||||
(Context ((:.), EmptyContext), Handler, Server, Tagged (..),
|
(Context ((:.), EmptyContext), Handler, Server, Tagged (..),
|
||||||
emptyServer, err401, err403, err404, serve, serveWithContext)
|
emptyServer, err401, err403, err404, serve, serveWithContext)
|
||||||
|
import Servant.Test.ComprehensiveAPI
|
||||||
|
import qualified Servant.Types.SourceT as S
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
(Spec, context, describe, it, shouldBe, shouldContain)
|
(Spec, context, describe, it, shouldBe, shouldContain)
|
||||||
import Test.Hspec.Wai
|
import Test.Hspec.Wai
|
||||||
(get, liftIO, matchHeaders, matchStatus, shouldRespondWith,
|
(get, liftIO, matchHeaders, matchStatus, shouldRespondWith,
|
||||||
with, (<:>))
|
with, (<:>))
|
||||||
import qualified Test.Hspec.Wai as THW
|
import qualified Test.Hspec.Wai as THW
|
||||||
|
|
||||||
import Servant.Server.Experimental.Auth
|
import Servant.Server.Experimental.Auth
|
||||||
(AuthHandler, AuthServerData, mkAuthHandler)
|
(AuthHandler, AuthServerData, mkAuthHandler)
|
||||||
|
|
|
@ -110,14 +110,14 @@ import Servant.API.ReqBody
|
||||||
(ReqBody, ReqBody')
|
(ReqBody, ReqBody')
|
||||||
import Servant.API.ResponseHeaders
|
import Servant.API.ResponseHeaders
|
||||||
(AddHeader, BuildHeadersTo (buildHeadersTo),
|
(AddHeader, BuildHeadersTo (buildHeadersTo),
|
||||||
GetHeaders (getHeaders), HList (..), Headers (..),
|
GetHeaders (getHeaders), HList (..), HasResponseHeader,
|
||||||
ResponseHeader (..), addHeader, getHeadersHList, getResponse,
|
Headers (..), ResponseHeader (..), addHeader, getHeadersHList,
|
||||||
noHeader, HasResponseHeader, lookupResponseHeader)
|
getResponse, lookupResponseHeader, noHeader)
|
||||||
import Servant.API.Stream
|
import Servant.API.Stream
|
||||||
(FramingRender (..), FramingUnrender (..),
|
(FramingRender (..), FramingUnrender (..), FromSourceIO (..),
|
||||||
FromSourceIO (..), NetstringFraming, NewlineFraming,
|
NetstringFraming, NewlineFraming, NoFraming, SourceIO, Stream,
|
||||||
NoFraming, SourceIO, Stream, StreamBody, SourceIO,
|
StreamBody, StreamBody', StreamGet, StreamPost,
|
||||||
StreamGet, StreamPost, ToSourceIO (..))
|
ToSourceIO (..))
|
||||||
import Servant.API.Sub
|
import Servant.API.Sub
|
||||||
((:>))
|
((:>))
|
||||||
import Servant.API.Vault
|
import Servant.API.Vault
|
||||||
|
|
|
@ -17,6 +17,7 @@ module Servant.API.Stream (
|
||||||
StreamGet,
|
StreamGet,
|
||||||
StreamPost,
|
StreamPost,
|
||||||
StreamBody,
|
StreamBody,
|
||||||
|
StreamBody',
|
||||||
-- * Source
|
-- * Source
|
||||||
--
|
--
|
||||||
-- | 'SourceIO' are equivalent to some *source* in streaming libraries.
|
-- | 'SourceIO' are equivalent to some *source* in streaming libraries.
|
||||||
|
@ -71,9 +72,9 @@ type StreamGet = Stream 'GET 200
|
||||||
type StreamPost = Stream 'POST 200
|
type StreamPost = Stream 'POST 200
|
||||||
|
|
||||||
-- | A stream request body.
|
-- | A stream request body.
|
||||||
--
|
type StreamBody = StreamBody' '[]
|
||||||
-- TODO: add mods
|
|
||||||
data StreamBody (framing :: *) (contentType :: *) (a :: *)
|
data StreamBody' (mods :: [*]) (framing :: *) (contentType :: *) (a :: *)
|
||||||
deriving (Typeable, Generic)
|
deriving (Typeable, Generic)
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
|
@ -170,7 +170,7 @@ import Servant.API.RemoteHost
|
||||||
import Servant.API.ReqBody
|
import Servant.API.ReqBody
|
||||||
(ReqBody')
|
(ReqBody')
|
||||||
import Servant.API.Stream
|
import Servant.API.Stream
|
||||||
(Stream, StreamBody)
|
(Stream, StreamBody')
|
||||||
import Servant.API.Sub
|
import Servant.API.Sub
|
||||||
(type (:>))
|
(type (:>))
|
||||||
import Servant.API.TypeLevel
|
import Servant.API.TypeLevel
|
||||||
|
@ -482,8 +482,8 @@ instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
|
||||||
type MkLink (ReqBody' mods ct a :> sub) r = MkLink sub r
|
type MkLink (ReqBody' mods ct a :> sub) r = MkLink sub r
|
||||||
toLink toA _ = toLink toA (Proxy :: Proxy sub)
|
toLink toA _ = toLink toA (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance HasLink sub => HasLink (StreamBody framing ct a :> sub) where
|
instance HasLink sub => HasLink (StreamBody' mods framing ct a :> sub) where
|
||||||
type MkLink (StreamBody framing ct a :> sub) r = MkLink sub r
|
type MkLink (StreamBody' mods framing ct a :> sub) r = MkLink sub r
|
||||||
toLink toA _ = toLink toA (Proxy :: Proxy sub)
|
toLink toA _ = toLink toA (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance (ToHttpApiData v, HasLink sub)
|
instance (ToHttpApiData v, HasLink sub)
|
||||||
|
|
|
@ -22,7 +22,7 @@ type RawEndpoint =
|
||||||
"raw" :> Raw
|
"raw" :> Raw
|
||||||
|
|
||||||
type StreamingEndpoint =
|
type StreamingEndpoint =
|
||||||
"streaming" :> StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int)
|
"streaming" :> StreamBody' '[Description "netstring"] NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int)
|
||||||
|
|
||||||
type EmptyEndpoint =
|
type EmptyEndpoint =
|
||||||
"empty-api" :> EmptyAPI
|
"empty-api" :> EmptyAPI
|
||||||
|
|
Loading…
Reference in a new issue