c5e0451 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

initial checkin

c5e0451Gershom9 years ago

servant-server/servant-server.cabal+1

compare with master

unifiedsplit

@@ -60,6 +60,7 @@ library

60 , containers >= 0.5 && < 0.6

61 , exceptions >= 0.8 && < 0.9

62 , http-api-data >= 0.3 && < 0.4

63+ , http-media >= 0.4 && < 0.8

63 , http-types >= 0.8 && < 0.10

64 , http-types >= 0.8 && < 0.10

64 , network-uri >= 2.6 && < 2.7

65 , network-uri >= 2.6 && < 2.7

65 , monad-control >= 1.0.0.4 && < 1.1

66 , monad-control >= 1.0.0.4 && < 1.1

servant-server/src/Servant/Server/Internal.hs+50−4

@@ -25,12 +25,15 @@ module Servant.Server.Internal

25 , module Servant.Server.Internal.ServantErr

26 ) where

28+import Control.Monad (when)

28import Control.Monad.Trans (liftIO)

29import Control.Monad.Trans (liftIO)

29import Control.Monad.Trans.Resource (runResourceT)

30import Control.Monad.Trans.Resource (runResourceT)

30import qualified Data.ByteString as B

31import qualified Data.ByteString as B

32+import qualified Data.ByteString.Builder as BB

31import qualified Data.ByteString.Char8 as BC8

33import qualified Data.ByteString.Char8 as BC8

32import qualified Data.ByteString.Lazy as BL

34import qualified Data.ByteString.Lazy as BL

33−import Data.Maybe (fromMaybe, mapMaybe)

35+import Data.Maybe (fromMaybe, mapMaybe,

36+ isNothing, maybeToList)

34import Data.Either (partitionEithers)

37import Data.Either (partitionEithers)

35import Data.String (fromString)

38import Data.String (fromString)

36import Data.String.Conversions (cs, (<>))

39import Data.String.Conversions (cs, (<>))

@@ -40,13 +43,15 @@ import Data.Typeable

40import GHC.TypeLits (KnownNat, KnownSymbol, natVal,

43import GHC.TypeLits (KnownNat, KnownSymbol, natVal,

41 symbolVal)

44 symbolVal)

42import Network.HTTP.Types hiding (Header, ResponseHeaders)

45import Network.HTTP.Types hiding (Header, ResponseHeaders)

46+import qualified Network.HTTP.Media as NHM

43import Network.Socket (SockAddr)

47import Network.Socket (SockAddr)

44import Network.Wai (Application, Request, Response,

48import Network.Wai (Application, Request, Response,

45 httpVersion, isSecure,

49 httpVersion, isSecure,

46 lazyRequestBody,

50 lazyRequestBody,

47 rawQueryString, remoteHost,

51 rawQueryString, remoteHost,

48 requestHeaders, requestMethod,

52 requestHeaders, requestMethod,

49− responseLBS, vault)

53+ responseLBS, responseStream,

54+ vault)

50import Prelude ()

55import Prelude ()

51import Prelude.Compat

56import Prelude.Compat

52import Web.HttpApiData (FromHttpApiData, parseHeader,

57import Web.HttpApiData (FromHttpApiData, parseHeader,

@@ -60,11 +65,16 @@ import Servant.API ((:<|>) (..), (:>), BasicAuth, Capt

60 QueryParam, QueryParams, Raw,

65 QueryParam, QueryParams, Raw,

61 RemoteHost, ReqBody, Vault,

66 RemoteHost, ReqBody, Vault,

62 WithNamedContext,

67 WithNamedContext,

63− Description, Summary)

68+ Description, Summary,

69+ Accept(..),

70+ Framing(..), Stream,

71+ StreamGenerator(..),

72+ BoundaryStrategy(..))

64import Servant.API.ContentTypes (AcceptHeader (..),

73import Servant.API.ContentTypes (AcceptHeader (..),

65 AllCTRender (..),

74 AllCTRender (..),

66 AllCTUnrender (..),

75 AllCTUnrender (..),

67 AllMime,

76 AllMime,

77+ MimeRender(..),

68 canHandleAcceptH)

78 canHandleAcceptH)

69import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,

79import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,

70 getResponse)

80 getResponse)

@@ -276,6 +286,42 @@ instance OVERLAPPING_

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

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

277 status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)

287 status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)

278

288

289+

290+instance ( MimeRender ctype a, ReflectMethod method, Framing framing ctype

291+ ) => HasServer (Stream method framing ctype a) context where

292+

293+ type ServerT (Stream method framing ctype a) m = m (StreamGenerator a)

294+ hoistServerWithContext _ _ nt s = nt s

295+

296+ route Proxy _ action = leafRouter $ \env request respond ->

297+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request

298+ cmediatype = NHM.matchAccept [contentType (Proxy :: Proxy ctype)] accH

299+ accCheck = when (isNothing cmediatype) $ delayedFail err406

300+ contentHeader = (hContentType, NHM.renderHeader . maybeToList $ cmediatype)

301+ in runAction (action `addMethodCheck` methodCheck method request

302+ `addAcceptCheck` accCheck

303+ ) env request respond $ \ (StreamGenerator k) ->

304+ Route $ responseStream status200 [contentHeader] $ \write flush -> do

305+ write . BB.lazyByteString . header (Proxy :: Proxy framing) $ (Proxy :: Proxy ctype)

306+ case boundary (Proxy :: Proxy framing) (Proxy :: Proxy ctype) of

307+ BoundaryStrategyBracket f ->

308+ let go x = let bs = mimeRender (Proxy :: Proxy ctype) $ x

309+ (before, after) = f bs

310+ in write ( BB.lazyByteString before

311+ <> BB.lazyByteString bs

312+ <> BB.lazyByteString after)

313+ in k go go

314+ BoundaryStrategyIntersperse sep -> k

315+ (\x -> do

316+ write . BB.lazyByteString . mimeRender (Proxy :: Proxy ctype) $ x

317+ flush)

318+ (\x -> do

319+ write . (BB.lazyByteString sep <>) . BB.lazyByteString . mimeRender (Proxy :: Proxy ctype) $ x

320+ flush)

321+ write . BB.lazyByteString . terminate (Proxy :: Proxy framing) $ (Proxy :: Proxy ctype)

322+ where method = reflectMethod (Proxy :: Proxy method)

323+

324+

279-- | If you use 'Header' in one of the endpoints for your API,

325-- | If you use 'Header' in one of the endpoints for your API,

280-- this automatically requires your server-side handler to be a function

326-- this automatically requires your server-side handler to be a function

281-- that takes an argument of the type specified by 'Header'.

327-- that takes an argument of the type specified by 'Header'.

@@ -318,7 +364,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)

318 <> fromString headerName

364 <> fromString headerName

319 <> " failed: " <> e

365 <> " failed: " <> e

320 }

366 }

321− Right header -> return $ Just header

367+ Right hdr -> return $ Just hdr

322

368

323-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,

369-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,

324-- this automatically requires your server-side handler to be a function

370-- this automatically requires your server-side handler to be a function

servant/servant.cabal+1

@@ -47,6 +47,7 @@ library

47 Servant.API.IsSecure

48 Servant.API.QueryParam

49 Servant.API.Raw

50+ Servant.API.Stream

50 Servant.API.RemoteHost

51 Servant.API.RemoteHost

51 Servant.API.ReqBody

52 Servant.API.ReqBody

52 Servant.API.ResponseHeaders

53 Servant.API.ResponseHeaders

servant/src/Servant/API.hs+7−1

@@ -31,7 +31,10 @@ module Servant.API (

31 -- * Actual endpoints, distinguished by HTTP method

32 module Servant.API.Verbs,

34+ -- * Streaming endpoints, distinguished by HTTP method

35+ module Servant.API.Stream,

36+

34− -- * Authentication

37+-- * Authentication

35 module Servant.API.BasicAuth,

38 module Servant.API.BasicAuth,

37 -- * Endpoints description

40 -- * Endpoints description

@@ -80,6 +83,9 @@ import Servant.API.IsSecure (IsSecure (..))

80import Servant.API.QueryParam (QueryFlag, QueryParam,

83import Servant.API.QueryParam (QueryFlag, QueryParam,

81 QueryParams)

84 QueryParams)

82import Servant.API.Raw (Raw)

85import Servant.API.Raw (Raw)

86+import Servant.API.Stream (Stream, StreamGenerator(..),

87+ Framing(..), BoundaryStrategy(..),

88+ NewlineFraming)

83import Servant.API.RemoteHost (RemoteHost)

89import Servant.API.RemoteHost (RemoteHost)

84import Servant.API.ReqBody (ReqBody)

90import Servant.API.ReqBody (ReqBody)

85import Servant.API.ResponseHeaders (AddHeader, addHeader, noHeader,

91import Servant.API.ResponseHeaders (AddHeader, addHeader, noHeader,

servant/src/Servant/API/Stream.hsnew file+42

@@ -0,0 +1,42 @@

1+{-# LANGUAGE DeriveDataTypeable #-}

2+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE FlexibleInstances #-}

4+{-# LANGUAGE KindSignatures #-}

5+{-# LANGUAGE MultiParamTypeClasses #-}

6+{-# LANGUAGE OverloadedStrings #-}

7+{-# LANGUAGE PolyKinds #-}

8+{-# OPTIONS_HADDOCK not-home #-}

10+module Servant.API.Stream where

11+

12+import Data.ByteString.Lazy (ByteString, empty)

13+import Data.Proxy (Proxy)

14+import Data.Typeable (Typeable)

15+import GHC.Generics (Generic)

16+

17+-- | A stream endpoint for a given method emits a stream of encoded values at a given Content-Type, delimited by a framing strategy.

18+data Stream (method :: k1) (framing :: *) (contentType :: *) a

19+ deriving (Typeable, Generic)

20+

21+-- | 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).

22+data StreamGenerator a = StreamGenerator ((a -> IO ()) -> (a -> IO ()) -> IO ())

23+

24+-- | The Framing class provides the logic for each framing strategy. The strategy emits a header, followed by boundary-delimited data, and finally a termination character. For many strategies, some of these will just be empty bytestrings.

25+class Framing strategy a where

26+ header :: Proxy strategy -> Proxy a -> ByteString

27+ boundary :: Proxy strategy -> Proxy a -> BoundaryStrategy

28+ terminate :: Proxy strategy -> Proxy a -> ByteString

29+

30+-- | The bracketing strategy generates things to precede and follow the content, as with netstrings.

31+-- | The intersperse strategy inserts seperators between things, as with newline framing.

32+data BoundaryStrategy = BoundaryStrategyBracket (ByteString -> (ByteString,ByteString))

33+ | BoundaryStrategyIntersperse ByteString

34+

35+

36+-- | A simple framing strategy that has no header or termination, and inserts a newline character between each frame.

37+data NewlineFraming

38+

39+instance Framing NewlineFraming a where

40+ header _ _ = empty

41+ boundary _ _ = BoundaryStrategyIntersperse "\n"

42+ terminate _ _ = empty