a701e8d · typeable/servant

nix/shell.nix+1−1

compare with master

unifiedsplit

@@ -1,5 +1,5 @@

1{ pkgs ? import <nixpkgs> {}

2−, compiler ? "ghc821"

2+, compiler ? "ghc822"

3, tutorial ? false

4}:

5

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

@@ -36,7 +36,8 @@ import Servant.API ((:<|>) ((:<|>)), (:>),

36 BuildFromStream (..),

37 ByteStringParser (..),

38 Capture', CaptureAll,

39+ Description, DynHeaders,

39− Description, EmptyAPI,

40+ EmptyAPI,

40 FramingUnrender (..),

41 FramingUnrender (..),

41 Header', Headers (..),

42 Header', Headers (..),

42 HttpVersion, IsSecure,

43 HttpVersion, IsSecure,

@@ -282,6 +283,36 @@ instance OVERLAPPING_

282

283

283 hoistClientMonad _ _ f ma = f ma

284 hoistClientMonad _ _ f ma = f ma

284

285

286+instance OVERLAPPING_

287+ ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)

288+ ) => HasClient m (Verb method status cts' (DynHeaders a)) where

289+ type Client m (Verb method status cts' (DynHeaders a)) = m a

290+ clientWithRoute _pm Proxy req = do

291+ response <- runRequest req

292+ { requestMethod = method

293+ , requestAccept = fromList $ toList accept

294+ }

295+ case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of

296+ Left err -> throwServantError $ DecodeFailure (pack err) response

297+ Right val -> return val

298+

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

300+ accept = contentTypes (Proxy :: Proxy ct)

301+

302+ hoistClientMonad _ _ f ma = f ma

303+

304+instance OVERLAPPING_

305+ ( RunClient m, ReflectMethod method

306+ ) => HasClient m (Verb method status cts (DynHeaders NoContent)) where

307+ type Client m (Verb method status cts (DynHeaders NoContent)) = m NoContent

308+ clientWithRoute _pm Proxy req = do

309+ response <- runRequest req { requestMethod = method }

310+ return NoContent

311+

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

313+

314+ hoistClientMonad _ _ f ma = f ma

315+

285instance OVERLAPPABLE_

316instance OVERLAPPABLE_

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

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

287 FramingUnrender framing a, BuildFromStream a (f a)

318 FramingUnrender framing a, BuildFromStream a (f a)

servant-docs/src/Servant/Docs/Internal.hs+16

@@ -858,6 +858,22 @@ instance OVERLAPPING_

858 status = fromInteger $ natVal (Proxy :: Proxy status)

859 p = Proxy :: Proxy a

860

861+instance OVERLAPPING_

862+ ( ToSample a, AllMimeRender (ct ': cts) a, KnownNat status

863+ , ReflectMethod method

864+ ) => HasDocs (Verb method status (ct ': cts) (DynHeaders a)) where

865+ docsFor Proxy (endpoint, action) DocOptions{..} =

866+ single endpoint' action'

867+

868+ where endpoint' = endpoint & method .~ method'

869+ action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

870+ & response.respTypes .~ allMime t

871+ & response.respStatus .~ status

872+ t = Proxy :: Proxy (ct ': cts)

873+ method' = reflectMethod (Proxy :: Proxy method)

874+ status = fromInteger $ natVal (Proxy :: Proxy status)

875+ p = Proxy :: Proxy a

876+

861instance (KnownSymbol sym, HasDocs api)

877instance (KnownSymbol sym, HasDocs api)

862 => HasDocs (Header' mods sym a :> api) where

878 => HasDocs (Header' mods sym a :> api) where

863 docsFor Proxy (endpoint, action) =

879 docsFor Proxy (endpoint, action) =

servant-server/src/Servant/Server/Internal.hs+14−1

@@ -44,6 +44,7 @@ import qualified Data.ByteString.Lazy as BL

44import Data.Maybe (fromMaybe, mapMaybe,

45 isNothing, maybeToList)

46import Data.Either (partitionEithers)

47+import qualified Data.Map.Strict as Map

47import Data.String (IsString (..))

48import Data.String (IsString (..))

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

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

49import Data.Tagged (Tagged(..), retag, untag)

50import Data.Tagged (Tagged(..), retag, untag)

@@ -88,7 +89,8 @@ import Servant.API.ContentTypes (AcceptHeader (..),

88 MimeRender(..),

89 MimeRender(..),

89 canHandleAcceptH)

90 canHandleAcceptH)

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

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

91− getResponse)

92+ getResponse, DynHeaders,

93+ DynResponse, withDynHeaders)

92

94

93import Servant.Server.Internal.Context

95import Servant.Server.Internal.Context

94import Servant.Server.Internal.BasicAuth

96import Servant.Server.Internal.BasicAuth

@@ -280,6 +282,17 @@ instance OVERLAPPING_

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

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

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

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

282

284

285+instance OVERLAPPING_

286+ ( AllCTRender ctypes a, ReflectMethod method, KnownNat status

287+ ) => HasServer (Verb method status ctypes (DynHeaders a)) context where

288+

289+ type ServerT (Verb method status ctypes (DynHeaders a)) m = m (DynResponse a)

290+ hoistServerWithContext _ _ nt s = nt s

291+

292+ route Proxy _ = methodRouter (\x -> (Map.toList (dynHeaders x), dynResponse x))

293+ method (Proxy :: Proxy ctypes) status

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

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

283

296

284instance OVERLAPPABLE_

297instance OVERLAPPABLE_

285 ( MimeRender ctype a, ReflectMethod method,

298 ( MimeRender ctype a, ReflectMethod method,

servant/servant.cabal+1

@@ -71,6 +71,7 @@ library

71 build-depends:

72 base >= 4.7 && < 4.11

73 , bytestring >= 0.10.4.0 && < 0.11

74+ , containers >= 0.5 && < 0.6

74 , mtl >= 2.1 && < 2.3

75 , mtl >= 2.1 && < 2.3

75 , text >= 1.2.3.0 && < 1.3

76 , text >= 1.2.3.0 && < 1.3

76

77

servant/src/Servant/API.hs+1

@@ -110,6 +110,7 @@ import Servant.API.ReqBody

110 (ReqBody, ReqBody')

111import Servant.API.ResponseHeaders

112 (AddHeader, BuildHeadersTo (buildHeadersTo),

113+ DynHeaders(..), DynResponse(..), withDynHeaders,

113 GetHeaders (getHeaders), HList (..), Headers (..),

114 GetHeaders (getHeaders), HList (..), Headers (..),

114 ResponseHeader (..), addHeader, getHeadersHList, getResponse,

115 ResponseHeader (..), addHeader, getHeadersHList, getResponse,

115 noHeader)

116 noHeader)

servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs+1

@@ -34,6 +34,7 @@ type ComprehensiveAPIWithoutRaw =

34 ReqBody '[JSON] Int :> GET :<|>

35 ReqBody' '[Lenient] '[JSON] Int :> GET :<|>

36 Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>

37+ Get '[JSON] (DynHeaders NoContent) :<|>

37 "foo" :> GET :<|>

38 "foo" :> GET :<|>

38 Vault :> GET :<|>

39 Vault :> GET :<|>

39 Verb 'POST 204 '[JSON] NoContent :<|>

40 Verb 'POST 204 '[JSON] NoContent :<|>

servant/src/Servant/API/ResponseHeaders.hs+31−3

@@ -23,7 +23,8 @@

23-- The value is added to the header specified by the type (@Location@ in the

24-- example above).

25module Servant.API.ResponseHeaders

26+ ( -- * "Static" response headers, tracked at the type-level

26− ( Headers(..)

27+ Headers(..)

27 , ResponseHeader (..)

28 , ResponseHeader (..)

28 , AddHeader

29 , AddHeader

29 , addHeader

30 , addHeader

@@ -32,11 +33,18 @@ module Servant.API.ResponseHeaders

32 , GetHeaders(getHeaders)

33 , GetHeaders(getHeaders)

33 , HeaderValMap

34 , HeaderValMap

34 , HList(..)

35 , HList(..)

36+

37+ , -- * "Dynamic" response headers

38+ DynHeaders(..)

39+ , DynResponse(..)

40+ , withDynHeaders

35 ) where

41 ) where

36

42

37import Data.ByteString.Char8 as BS

43import Data.ByteString.Char8 as BS

38 (ByteString, init, pack, unlines)

44 (ByteString, init, pack, unlines)

39import qualified Data.CaseInsensitive as CI

45import qualified Data.CaseInsensitive as CI

46+import Data.Map

47+ (Map)

40import Data.Proxy

48import Data.Proxy

41import Data.Typeable

49import Data.Typeable

42 (Typeable)

50 (Typeable)

@@ -51,8 +59,9 @@ import Prelude.Compat

51import Servant.API.Header

59import Servant.API.Header

52 (Header)

60 (Header)

53

61

62+-- | Response Header objects where each header name is tracked at the type-level.

54−-- | Response Header objects. You should never need to construct one directly.

63+-- You should never need to construct one directly. Instead, use

55−-- Instead, use 'addOptionalHeader'.

64+-- 'addOptionalHeader'.

56data Headers ls a = Headers { getResponse :: a

65data Headers ls a = Headers { getResponse :: a

57 -- ^ The underlying value of a 'Headers'

66 -- ^ The underlying value of a 'Headers'

58 , getHeadersHList :: HList ls

67 , getHeadersHList :: HList ls

@@ -166,6 +175,25 @@ addHeader = addOptionalHeader . Header

166noHeader :: AddHeader h v orig new => orig -> new

175noHeader :: AddHeader h v orig new => orig -> new

167noHeader = addOptionalHeader MissingHeader

176noHeader = addOptionalHeader MissingHeader

168

177

178+-- | Combinator to use when you want your endpoint to return a response

179+-- along with some response headers, dynamically,

180+-- by simply building a value of type 'DynResponse a', which is just a

181+-- response of type @a@ along with a map from header names to header values.

182+--

183+-- For all other interpretations than the server one, this combinator basically

184+-- has no effect and behaves just as if you were using @a@ directly.

185+data DynHeaders a

186+

187+data DynResponse a = DynResponse

188+ { dynResponse :: a

189+ , dynHeaders :: Map HTTP.HeaderName ByteString

190+ } deriving (Typeable, Eq, Show, Functor)

191+

192+-- | Build a \"response with headers\", where the headers are

193+-- provided at runtime as a 'Map' from header name to header value.

194+withDynHeaders :: a -> Map HTTP.HeaderName ByteString -> DynResponse a

195+withDynHeaders = DynResponse

196+

169-- $setup

197-- $setup

170-- >>> import Servant.API

198-- >>> import Servant.API

171-- >>> import Data.Aeson

199-- >>> import Data.Aeson