master..aee1917 · servant

changelog.d/1571−2

@@ -5,6 +5,4 @@ description: {

55UVerb endpoints are now supported by servant-auth-server and can be used under the

66Auth combinator when writing servers. It is still unsupported by

77servant-auth-client.

8−

9−This PR also brings Headers support in UVerb responses

108}

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

@@ -74,7 +74,7 @@ import Servant.API

7474 FromSourceIO (..), Header', Headers (..), HttpVersion,

7575 IsSecure, MimeRender (mimeRender),

7676 MimeUnrender (mimeUnrender), NoContent (NoContent),

77− NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, RawM,

77+ NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,

7878 ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,

7979 StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,

8080 Verb, WithNamedContext, WithResource, WithStatus (..), contentType, getHeadersHList,

@@ -674,16 +674,6 @@ instance RunClient m => HasClient m Raw where

674674

675675 hoistClientMonad _ _ f cl = \meth -> f (cl meth)

676676

677−instance RunClient m => HasClient m RawM where

678− type Client m RawM

679− = H.Method -> m Response

680−

681− clientWithRoute :: Proxy m -> Proxy RawM -> Request -> Client m RawM

682− clientWithRoute _pm Proxy req httpMethod = do

683− runRequest req { requestMethod = httpMethod }

684−

685− hoistClientMonad _ _ f cl = \meth -> f (cl meth)

686−

687677-- | If you use a 'ReqBody' in one of your endpoints in your API,

688678-- the corresponding querying function will automatically take

689679-- an additional argument of the type specified by your 'ReqBody'.

servant-server/src/Servant/Server/Internal.hs+2−32

@@ -6,7 +6,6 @@

66{-# LANGUAGE FlexibleContexts #-}

77{-# LANGUAGE FlexibleInstances #-}

88{-# LANGUAGE InstanceSigs #-}

9−{-# LANGUAGE LambdaCase #-}

109{-# LANGUAGE MultiParamTypeClasses #-}

1110{-# LANGUAGE OverloadedStrings #-}

1211{-# LANGUAGE PolyKinds #-}

@@ -66,7 +65,7 @@ import Network.HTTP.Types hiding

6665import Network.Socket

6766 (SockAddr)

6867import Network.Wai

69− (Application, Request, Response, ResponseReceived, httpVersion, isSecure, lazyRequestBody,

68+ (Application, Request, httpVersion, isSecure, lazyRequestBody,

7069 queryString, remoteHost, getRequestBodyChunk, requestHeaders,

7170 requestMethod, responseLBS, responseStream, vault)

7271import Prelude ()

@@ -76,7 +75,7 @@ import Servant.API

7675 CaptureAll, Description, EmptyAPI, Fragment,

7776 FramingRender (..), FramingUnrender (..), FromSourceIO (..),

7877 Header', If, IsSecure (..), NoContentVerb, QueryFlag,

79− QueryParam', QueryParams, Raw, RawM, ReflectMethod (reflectMethod),

78+ QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod),

8079 RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO,

8180 Stream, StreamBody', Summary, ToSourceIO (..), Vault, Verb,

8281 WithNamedContext, WithResource, NamedRoutes)

@@ -653,35 +652,6 @@ instance HasServer Raw context where

653652 Fail a -> respond $ Fail a

654653 FailFatal e -> respond $ FailFatal e

655654

656−-- | Just pass the request to the underlying application and serve its response.

657−--

658−-- Example:

659−--

660−-- > type MyApi = "images" :> Raw

661−-- >

662−-- > server :: Server MyApi

663−-- > server = serveDirectory "/var/www/images"

664−instance HasServer RawM context where

665− type ServerT RawM m = Request -> (Response -> IO ResponseReceived) -> m ResponseReceived

666−

667− route

668− :: Proxy RawM

669− -> Context context

670− -> Delayed env (Request -> (Response -> IO ResponseReceived) -> Handler ResponseReceived) -> Router env

671− route _ _ handleDelayed = RawRouter $ \env request respond -> runResourceT $ do

672− routeResult <- runDelayed handleDelayed env request

673− let respond' = liftIO . respond

674− liftIO $ case routeResult of

675− Route handler -> runHandler (handler request (respond . Route)) >>=

676− \case

677− Left e -> respond' $ FailFatal e

678− Right a -> pure a

679− Fail e -> respond' $ Fail e

680− FailFatal e -> respond' $ FailFatal e

681−

682− hoistServerWithContext _ _ f srvM = \req respond -> f (srvM req respond)

683−

684−

685655-- | If you use 'ReqBody' in one of the endpoints for your API,

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

687657-- that takes an argument of the type specified by 'ReqBody'.

servant-server/test/Servant/ServerSpec.hs+4−47

@@ -17,10 +17,8 @@ import Prelude.Compat

1717

1818import Control.Monad

1919 (forM_, unless, when)

20−import Control.Monad.Reader (runReaderT, ask)

2120import Control.Monad.Error.Class

2221 (MonadError (..))

23−import Control.Monad.IO.Class (MonadIO(..))

2422import Data.Aeson

2523 (FromJSON, ToJSON, decode', encode)

2624import Data.Acquire

@@ -56,19 +54,19 @@ import Servant.API

5654 Delete, EmptyAPI, Fragment, Get, HasStatus (StatusOf), Header,

5755 Headers, HttpVersion, IsSecure (..), JSON, Lenient,

5856 NoContent (..), NoContentVerb, NoFraming, OctetStream, Patch,

59− PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw, RawM,

57+ PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,

6058 RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Strict,

6159 UVerb, Union, Verb, WithStatus (..), addHeader)

6260import Servant.Server

63− (Context ((:.), EmptyContext), Handler, Server, ServerT, Tagged (..),

64− emptyServer, err401, err403, err404, hoistServer, respond, serve,

61+ (Context ((:.), EmptyContext), Handler, Server, Tagged (..),

62+ emptyServer, err401, err403, err404, respond, serve,

6563 serveWithContext)

6664import Servant.Test.ComprehensiveAPI

6765import qualified Servant.Types.SourceT as S

6866import Test.Hspec

6967 (Spec, context, describe, it, shouldBe, shouldContain)

7068import Test.Hspec.Wai

71− (get, matchHeaders, matchStatus, shouldRespondWith,

69+ (get, liftIO, matchHeaders, matchStatus, shouldRespondWith,

7270 with, (<:>))

7371import qualified Test.Hspec.Wai as THW

7472

@@ -104,7 +102,6 @@ spec = do

104102 reqBodySpec

105103 headerSpec

106104 rawSpec

107− rawMSpec

108105 alternativeSpec

109106 responseHeadersSpec

110107 uverbResponseHeadersSpec

@@ -613,46 +610,6 @@ rawSpec = do

613610

614611-- }}}

615612------------------------------------------------------------------------------

616−-- * rawMSpec {{{

617−------------------------------------------------------------------------------

618−

619−type RawMApi = "foo" :> RawM

620−

621−rawMApi :: Proxy RawMApi

622−rawMApi = Proxy

623−

624−rawMServer :: (Monad m, MonadIO m, Show a) => (Request -> m a) -> ServerT RawMApi m

625−rawMServer f req resp = liftIO . resp . responseLBS ok200 [] . cs . show =<< f req

626−

627−rawMSpec :: Spec

628−rawMSpec = do

629− describe "Servant.API.RawM" $ do

630− it "gives access to monadic context" $ do

631− flip runSession (serve rawMApi

632− (hoistServer rawMApi (flip runReaderT (42 :: Integer)) (rawMServer (const ask)))) $ do

633− response <- Network.Wai.Test.request defaultRequest{

634− pathInfo = ["foo"]

635− }

636− liftIO $ do

637− simpleBody response `shouldBe` "42"

638−

639− it "lets users throw servant errors" $ do

640− flip runSession (serve rawMApi (rawMServer (const $ throwError err404 >> pure (42 :: Integer)))) $ do

641− response <- Network.Wai.Test.request defaultRequest{

642− pathInfo = ["foo"]

643− }

644− liftIO $ do

645− statusCode (simpleStatus response) `shouldBe` 404

646−

647− it "gets the pathInfo modified" $ do

648− flip runSession (serve rawMApi (rawMServer (pure . pathInfo))) $ do

649− response <- Network.Wai.Test.request defaultRequest{

650− pathInfo = ["foo", "bar"]

651− }

652− liftIO $ do

653− simpleBody response `shouldBe` cs (show ["bar" :: String])

654−-- }}}

655−------------------------------------------------------------------------------

656613-- * alternativeSpec {{{

657614------------------------------------------------------------------------------

658615type AlternativeApi =

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

@@ -119,7 +119,7 @@ import Servant.API.NamedRoutes

119119import Servant.API.QueryParam

120120 (QueryFlag, QueryParam, QueryParam', QueryParams)

121121import Servant.API.Raw

122− (Raw, RawM)

122+ (Raw)

123123import Servant.API.RemoteHost

124124 (RemoteHost)

125125import Servant.API.ReqBody

servant/src/Servant/API/Raw.hs−3

@@ -15,6 +15,3 @@ import Data.Typeable

1515-- <https://hackage.haskell.org/package/servant-server/docs/Servant-Server-StaticFiles.html Servant.Server.StaticFiles>

1616-- to serve static files stored in a particular directory on your filesystem

1717data Raw deriving Typeable

18−

19−-- | Variant of 'Raw' that lets you access the underlying monadic context to process the request.

20−data RawM deriving Typeable

servant/src/Servant/API/UVerb.hs+3

@@ -53,6 +53,9 @@ statusOf = const (statusVal (Proxy :: Proxy (StatusOf a)))

5353instance HasStatus NoContent where

5454 type StatusOf NoContent = 204

5555

56+instance HasStatus a => HasStatus (Headers hs a) where

57+ type StatusOf (Headers hs a) = StatusOf a

58+

5659class HasStatuses (as :: [*]) where

5760 type Statuses (as :: [*]) :: [Nat]

5861 statuses :: Proxy as -> [Status]

servant/src/Servant/Links.hs+1−5

@@ -175,7 +175,7 @@ import Servant.API.NamedRoutes

175175import Servant.API.QueryParam

176176 (QueryFlag, QueryParam', QueryParams)

177177import Servant.API.Raw

178− (Raw, RawM)

178+ (Raw)

179179import Servant.API.RemoteHost

180180 (RemoteHost)

181181import Servant.API.ReqBody

@@ -589,10 +589,6 @@ instance HasLink Raw where

589589 type MkLink Raw a = a

590590 toLink toA _ = toA

591591

592−instance HasLink RawM where

593− type MkLink RawM a = a

594− toLink toA _ = toA

595−

596592instance HasLink (Stream m status fr ct a) where

597593 type MkLink (Stream m status fr ct a) r = r

598594 toLink toA _ = toA