git.iko.soy/servant
on master help sign in
Allow to specify the status of streaming endpoints
commitdbbe9b73217022696b5066c0374c04a3ca670b04 authorJan van Brügge <supermanitu@gmail.com> dateSun 27 May 2018, 21:50 (8 years ago) parenta66aa8a
3 files changed+20−15
compare with master
unifiedsplit
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs+2−2 servant-server/src/Servant/Server/Internal.hs+13−10 servant/src/Servant/API/Stream.hs+5−3
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs+2−2
@@ -285,9 +285,9 @@ instance OVERLAPPING_
285285instance OVERLAPPABLE_
286286 ( RunClient m, MimeUnrender ct a, ReflectMethod method,
287287 FramingUnrender framing a, BuildFromStream a (f a)
288− ) => HasClient m (Stream method framing ct (f a)) where
288+ ) => HasClient m (Stream method status framing ct (f a)) where
289289
290− type Client m (Stream method framing ct (f a)) = m (f a)
290+ type Client m (Stream method status framing ct (f a)) = m (f a)
291291
292292 clientWithRoute _pm Proxy req = do
293293 sresp <- streamingRequest req
servant-server/src/Servant/Server/Internal.hs+13−10
@@ -283,37 +283,40 @@ instance OVERLAPPING_
283283
284284
285285instance OVERLAPPABLE_
286− ( MimeRender ctype a, ReflectMethod method,
286+ ( MimeRender ctype a, ReflectMethod method, KnownNat status,
287287 FramingRender framing ctype, ToStreamGenerator b a
288− ) => HasServer (Stream method framing ctype b) context where
288+ ) => HasServer (Stream method status framing ctype b) context where
289289
290− type ServerT (Stream method framing ctype b) m = m b
290+ type ServerT (Stream method status framing ctype b) m = m b
291291 hoistServerWithContext _ _ nt s = nt s
292292
293− route Proxy _ = streamRouter ([],) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
293+ route Proxy _ = streamRouter ([],) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
294294 where method = reflectMethod (Proxy :: Proxy method)
295+ status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
295296
296297instance OVERLAPPING_
297− ( MimeRender ctype a, ReflectMethod method,
298+ ( MimeRender ctype a, ReflectMethod method, KnownNat status,
298299 FramingRender framing ctype, ToStreamGenerator b a,
299300 GetHeaders (Headers h b)
300− ) => HasServer (Stream method framing ctype (Headers h b)) context where
301+ ) => HasServer (Stream method status framing ctype (Headers h b)) context where
301302
302− type ServerT (Stream method framing ctype (Headers h b)) m = m (Headers h b)
303+ type ServerT (Stream method status framing ctype (Headers h b)) m = m (Headers h b)
303304 hoistServerWithContext _ _ nt s = nt s
304305
305− route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
306+ route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
306307 where method = reflectMethod (Proxy :: Proxy method)
308+ status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
307309
308310
309311streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator b a) =>
310312 (c -> ([(HeaderName, B.ByteString)], b))
311313 -> Method
314+ -> Status
312315 -> Proxy framing
313316 -> Proxy ctype
314317 -> Delayed env (Handler c)
315318 -> Router env
316−streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \env request respond ->
319+streamRouter splitHeaders method status framingproxy ctypeproxy action = leafRouter $ \env request respond ->
317320 let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
318321 cmediatype = NHM.matchAccept [contentType ctypeproxy] accH
319322 accCheck = when (isNothing cmediatype) $ delayedFail err406
@@ -323,7 +326,7 @@ streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \
323326 ) env request respond $ \ output ->
324327 let (headers, fa) = splitHeaders output
325328 k = getStreamGenerator . toStreamGenerator $ fa in
326− Route $ responseStream status200 (contentHeader : headers) $ \write flush -> do
329+ Route $ responseStream status (contentHeader : headers) $ \write flush -> do
327330 write . BB.lazyByteString $ header framingproxy ctypeproxy
328331 case boundary framingproxy ctypeproxy of
329332 BoundaryStrategyBracket f ->
servant/src/Servant/API/Stream.hs+5−3
@@ -26,17 +26,19 @@ import Data.Typeable
2626 (Typeable)
2727import GHC.Generics
2828 (Generic)
29+import GHC.TypeLits
30+ (Nat)
2931import Network.HTTP.Types.Method
3032 (StdMethod (..))
3133import Text.Read
3234 (readMaybe)
3335
3436-- | A Stream endpoint for a given method emits a stream of encoded values at a given Content-Type, delimited by a framing strategy. Stream endpoints always return response code 200 on success. Type synonyms are provided for standard methods.
35−data Stream (method :: k1) (framing :: *) (contentType :: *) (a :: *)
37+data Stream (method :: k1) (status :: Nat) (framing :: *) (contentType :: *) (a :: *)
3638 deriving (Typeable, Generic)
3739
38−type StreamGet = Stream 'GET
39−type StreamPost = Stream 'POST
40+type StreamGet = Stream 'GET 200
41+type StreamPost = Stream 'POST 200
4042
4143-- | Stream endpoints may be implemented as producing a @StreamGenerator@ -- a function that itself takes two emit functions -- the first to be used on the first value the stream emits, and the second to be used on all subsequent values (to allow interspersed framing strategies such as comma separation).
4244newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()}