dbbe9b7 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Allow to specify the status of streaming endpoints

dbbe9b7Jan van Brügge8 years ago

servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs+2−2

compare with master

unifiedsplit

@@ -285,9 +285,9 @@ instance OVERLAPPING_

285instance OVERLAPPABLE_

286 ( RunClient m, MimeUnrender ct a, ReflectMethod method,

287 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

289

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)

291

292 clientWithRoute _pm Proxy req = do

293 sresp <- streamingRequest req

servant-server/src/Servant/Server/Internal.hs+13−10

@@ -283,37 +283,40 @@ instance OVERLAPPING_

283

284

285instance OVERLAPPABLE_

286− ( MimeRender ctype a, ReflectMethod method,

286+ ( MimeRender ctype a, ReflectMethod method, KnownNat status,

287 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

289

290− type ServerT (Stream method framing ctype b) m = m b

290+ type ServerT (Stream method status framing ctype b) m = m b

291 hoistServerWithContext _ _ nt s = nt s

292

293− route Proxy _ = streamRouter ([],) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype)

293+ route Proxy _ = streamRouter ([],) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)

294 where method = reflectMethod (Proxy :: Proxy method)

295+ status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)

295

296

296instance OVERLAPPING_

297instance OVERLAPPING_

297− ( MimeRender ctype a, ReflectMethod method,

298+ ( MimeRender ctype a, ReflectMethod method, KnownNat status,

298 FramingRender framing ctype, ToStreamGenerator b a,

299 FramingRender framing ctype, ToStreamGenerator b a,

299 GetHeaders (Headers h b)

300 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

301

302

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)

303 hoistServerWithContext _ _ nt s = nt s

304 hoistServerWithContext _ _ nt s = nt s

304

305

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)

306 where method = reflectMethod (Proxy :: Proxy method)

307 where method = reflectMethod (Proxy :: Proxy method)

308+ status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)

307

309

308

310

309streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator b a) =>

311streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator b a) =>

310 (c -> ([(HeaderName, B.ByteString)], b))

312 (c -> ([(HeaderName, B.ByteString)], b))

311 -> Method

313 -> Method

314+ -> Status

312 -> Proxy framing

315 -> Proxy framing

313 -> Proxy ctype

316 -> Proxy ctype

314 -> Delayed env (Handler c)

317 -> Delayed env (Handler c)

315 -> Router env

318 -> 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 ->

317 let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request

320 let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request

318 cmediatype = NHM.matchAccept [contentType ctypeproxy] accH

321 cmediatype = NHM.matchAccept [contentType ctypeproxy] accH

319 accCheck = when (isNothing cmediatype) $ delayedFail err406

322 accCheck = when (isNothing cmediatype) $ delayedFail err406

@@ -323,7 +326,7 @@ streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \

323 ) env request respond $ \ output ->

326 ) env request respond $ \ output ->

324 let (headers, fa) = splitHeaders output

327 let (headers, fa) = splitHeaders output

325 k = getStreamGenerator . toStreamGenerator $ fa in

328 k = getStreamGenerator . toStreamGenerator $ fa in

326− Route $ responseStream status200 (contentHeader : headers) $ \write flush -> do

329+ Route $ responseStream status (contentHeader : headers) $ \write flush -> do

327 write . BB.lazyByteString $ header framingproxy ctypeproxy

330 write . BB.lazyByteString $ header framingproxy ctypeproxy

328 case boundary framingproxy ctypeproxy of

331 case boundary framingproxy ctypeproxy of

329 BoundaryStrategyBracket f ->

332 BoundaryStrategyBracket f ->

servant/src/Servant/API/Stream.hs+5−3

@@ -26,17 +26,19 @@ import Data.Typeable

26 (Typeable)

27import GHC.Generics

28 (Generic)

29+import GHC.TypeLits

30+ (Nat)

29import Network.HTTP.Types.Method

31import Network.HTTP.Types.Method

30 (StdMethod (..))

32 (StdMethod (..))

31import Text.Read

33import Text.Read

32 (readMaybe)

34 (readMaybe)

34-- | 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.

36-- | 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 :: *)

36 deriving (Typeable, Generic)

38 deriving (Typeable, Generic)

38−type StreamGet = Stream 'GET

40+type StreamGet = Stream 'GET 200

39−type StreamPost = Stream 'POST

41+type StreamPost = Stream 'POST 200

41-- | 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).

43-- | 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).

42newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()}

44newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()}