b749f7f · typeable/servant

git.iko.soy/typeable/servant

added Servant.API.Raw (only with HasServer)

commitb749f7fbc608950402592b97c1215a57c3f7cceb authorSönke Hahn <soenke.hahn@zalora.com> dateMon 27 Oct 2014, 18:24 (12 years ago) parent207f398

11 files changed+87−33

compare with master

unifiedsplit

servant.cabal+1 src/Servant/API/Capture.hs+5−5 src/Servant/API/Get.hs+3−3 src/Servant/API/GetParam.hs+2−2 src/Servant/API/Post.hs+3−3 src/Servant/API/RQBody.hs+3−3 src/Servant/API/Raw.hs+17 src/Servant/API/Sub.hs+4−4 src/Servant/API/Union.hs+6−6 src/Servant/Server.hs+12−6 test/Servant/ServerSpec.hs+31−1

servant.cabal+1

@@ -23,6 +23,7 @@ library

2323 Servant.API.Get

2424 Servant.API.GetParam

2525 Servant.API.Post

26+ Servant.API.Raw

2627 Servant.API.RQBody

2728 Servant.API.Sub

2829 Servant.API.Union

src/Servant/API/Capture.hs+5−5

@@ -26,14 +26,14 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)

2626 type Server (Capture capture a :> sublayout) =

2727 a -> Server sublayout

2828

29− route Proxy subserver request = case pathInfo request of

29+ route Proxy subserver globalPathInfo request respond = case pathInfo request of

3030 (first : rest)

3131 -> case captured captureProxy first of

32− Nothing -> return Nothing

33− Just v -> route (Proxy :: Proxy sublayout) (subserver v) request{

32+ Nothing -> respond Nothing

33+ Just v -> route (Proxy :: Proxy sublayout) (subserver v) globalPathInfo request{

3434 pathInfo = rest

35− }

36− _ -> return Nothing

35+ } respond

36+ _ -> respond Nothing

3737

3838 where captureProxy = Proxy :: Proxy (Capture capture a)

3939

src/Servant/API/Get.hs+3−3

@@ -22,15 +22,15 @@ data Get a

2222

2323instance ToJSON result => HasServer (Get result) where

2424 type Server (Get result) = EitherT (Int, String) IO result

25− route Proxy action request

25+ route Proxy action _globalPathInfo request respond

2626 | null (pathInfo request) && requestMethod request == methodGet = do

2727 e <- runEitherT action

28− return $ Just $ case e of

28+ respond $ Just $ case e of

2929 Right output ->

3030 responseLBS ok200 [("Content-Type", "application/json")] (encode output)

3131 Left (status, message) ->

3232 responseLBS (mkStatus status (cs message)) [] (cs message)

33− | otherwise = return Nothing

33+ | otherwise = respond Nothing

3434

3535instance FromJSON result => HasClient (Get result) where

3636 type Client (Get result) = URI -> EitherT String IO result

src/Servant/API/GetParam.hs+2−2

@@ -25,7 +25,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

2525 type Server (GetParam sym a :> sublayout) =

2626 Maybe a -> Server sublayout

2727

28− route Proxy subserver request = do

28+ route Proxy subserver globalPathInfo request respond = do

2929 let querytext = parseQueryText $ rawQueryString request

3030 param =

3131 case lookup paramName querytext of

@@ -34,7 +34,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

3434 Just (Just v) -> fromText v -- if present, we try to convert to

3535 -- the right type

3636

37− route (Proxy :: Proxy sublayout) (subserver param) request

37+ route (Proxy :: Proxy sublayout) (subserver param) globalPathInfo request respond

3838

3939 where paramName = cs $ symbolVal (Proxy :: Proxy sym)

4040

src/Servant/API/Post.hs+3−3

@@ -22,15 +22,15 @@ data Post a

2222instance ToJSON a => HasServer (Post a) where

2323 type Server (Post a) = EitherT (Int, String) IO a

2424

25− route Proxy action request

25+ route Proxy action _globalPathInfo request respond

2626 | null (pathInfo request) && requestMethod request == methodPost = do

2727 e <- runEitherT action

28− return $ Just $ case e of

28+ respond $ Just $ case e of

2929 Right out ->

3030 responseLBS status201 [("Content-Type", "application/json")] (encode out)

3131 Left (status, message) ->

3232 responseLBS (mkStatus status (cs message)) [] (cs message)

33− | otherwise = return Nothing

33+ | otherwise = respond Nothing

3434

3535instance FromJSON a => HasClient (Post a) where

3636 type Client (Post a) = URI -> EitherT String IO a

src/Servant/API/RQBody.hs+3−3

@@ -22,11 +22,11 @@ instance (FromJSON a, HasServer sublayout)

2222 type Server (RQBody a :> sublayout) =

2323 a -> Server sublayout

2424

25− route Proxy subserver request = do

25+ route Proxy subserver globalPathInfo request respond = do

2626 mrqbody <- decode' <$> lazyRequestBody request

2727 case mrqbody of

28− Nothing -> return Nothing

29− Just v -> route (Proxy :: Proxy sublayout) (subserver v) request

28+ Nothing -> respond Nothing

29+ Just v -> route (Proxy :: Proxy sublayout) (subserver v) globalPathInfo request respond

3030

3131instance (ToJSON a, HasClient sublayout)

3232 => HasClient (RQBody a :> sublayout) where

src/Servant/API/Raw.hsnew file+17

@@ -0,0 +1,17 @@

1+{-# LANGUAGE TypeFamilies #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+module Servant.API.Raw where

5+import Data.Proxy

6+import Network.Wai

7+import Servant.Server

9+-- | Endpoint for plugging in your own Wai 'Application's.

10+-- The given Application will get the original request received by the server

11+-- (i.e. with unmodified 'pathInfo', etc.)

12+data Raw

13+

14+instance HasServer Raw where

15+ type Server Raw = Application

16+ route Proxy rawApplication globalPathInfo request respond =

17+ rawApplication request{pathInfo = globalPathInfo} (respond . Just)

src/Servant/API/Sub.hs+4−4

@@ -18,13 +18,13 @@ infixr 9 :>

1818

1919instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where

2020 type Server (path :> sublayout) = Server sublayout

21− route Proxy subserver request = case pathInfo request of

21+ route Proxy subserver globalPathInfo request respond = case pathInfo request of

2222 (first : rest)

2323 | first == cs (symbolVal proxyPath)

24− -> route (Proxy :: Proxy sublayout) subserver request{

24+ -> route (Proxy :: Proxy sublayout) subserver globalPathInfo request{

2525 pathInfo = rest

26− }

27− _ -> return Nothing

26+ } respond

27+ _ -> respond Nothing

2828

2929 where proxyPath = Proxy :: Proxy path

3030

src/Servant/API/Union.hs+6−6

@@ -13,14 +13,14 @@ infixr 8 :<|>

1313

1414instance (HasServer a, HasServer b) => HasServer (a :<|> b) where

1515 type Server (a :<|> b) = Server a :<|> Server b

16− route Proxy (a :<|> b) request = do

17− m <- route (Proxy :: Proxy a) a request

18− case m of

19− Nothing -> route (Proxy :: Proxy b) b request

20− Just response -> return $ Just response

16+ route Proxy (a :<|> b) globalPathInfo request respond = do

17+ route (Proxy :: Proxy a) a globalPathInfo request $ \ mResponse ->

18+ case mResponse of

19+ Nothing -> route (Proxy :: Proxy b) b globalPathInfo request respond

20+ Just response -> respond $ Just response

2121

2222instance (HasClient a, HasClient b) => HasClient (a :<|> b) where

2323 type Client (a :<|> b) = Client a :<|> Client b

2424 clientWithRoute Proxy req =

2525 clientWithRoute (Proxy :: Proxy a) req :<|>

26− clientWithRoute (Proxy :: Proxy b) req

26+ clientWithRoute (Proxy :: Proxy b) req

src/Servant/Server.hs+12−6

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

33module Servant.Server where

55import Data.Proxy

6+import Data.Text

67import Network.HTTP.Types

78import Network.Wai

@@ -13,14 +14,19 @@ serve :: HasServer layout => Proxy layout -> Server layout -> Application

1314serve p server = toApplication (route p server)

1415

1516toApplication :: RoutingApplication -> Application

16−toApplication ra = \ request respond -> do

17− m <- ra request

18− case m of

19− Nothing -> respond $ responseLBS notFound404 [] "not found"

20− Just response -> respond response

17+toApplication ra request respond = do

18+ ra (pathInfo request) request routingRespond

19+ where

20+ routingRespond :: Maybe Response -> IO ResponseReceived

21+ routingRespond Nothing =

22+ respond $ responseLBS notFound404 [] "not found"

23+ routingRespond (Just response) =

24+ respond response

2125

2226type RoutingApplication =

23− Request -> IO (Maybe Response)

27+ [Text] -- ^ the unmodified 'pathInfo'

28+ -> Request -- ^ the request, the field 'pathInfo' may be modified by url routing

29+ -> (Maybe Response -> IO ResponseReceived) -> IO ResponseReceived

2430

2531class HasServer layout where

2632 type Server layout :: *

test/Servant/ServerSpec.hs+31−1

@@ -10,6 +10,7 @@ module Servant.ServerSpec where

1010

1111import Data.Aeson

1212import Data.Proxy

13+import Data.String.Conversions

1314import GHC.Generics

1415import Network.HTTP.Types

1516import Network.Wai

@@ -20,6 +21,7 @@ import Test.Hspec.Wai

2021import Servant.API.Get

2122import Servant.API.GetParam

2223import Servant.API.Post

24+import Servant.API.Raw

2325import Servant.API.RQBody

2426import Servant.API.Sub

2527import Servant.API.Union

@@ -60,6 +62,7 @@ spec = do

6062 getSpec

6163 getParamSpec

6264 postSpec

65+ rawSpec

6366 unionSpec

6467

6568

@@ -67,7 +70,8 @@ type GetApi = Get Person

6770getApi :: Proxy GetApi

6871getApi = Proxy

6972

70−getSpec :: Spec = do

73+getSpec :: Spec

74+getSpec = do

7175 describe "Servant.API.Get" $ do

7276 with (return (serve getApi (return alice))) $ do

7377 it "allows to GET a Person" $ do

@@ -118,6 +122,32 @@ postSpec = do

118122 }

119123

120124

125+type RawApi = "foo" :> Raw

126+rawApi :: Proxy RawApi

127+rawApi = Proxy

128+rawApplication :: Show a => (Request -> a) -> Application

129+rawApplication f request respond = respond $ responseLBS ok200 [] (cs $ show $ f request)

130+

131+rawSpec :: Spec

132+rawSpec = do

133+ describe "Servant.API.Raw" $ do

134+ it "runs applications" $ do

135+ (flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do

136+ response <- Network.Wai.Test.request defaultRequest{

137+ pathInfo = ["foo"]

138+ }

139+ liftIO $ do

140+ simpleBody response `shouldBe` "42"

141+

142+ it "gets the pathInfo unmodified" $ do

143+ (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do

144+ response <- Network.Wai.Test.request defaultRequest{

145+ pathInfo = ["foo"]

146+ }

147+ liftIO $ do

148+ simpleBody response `shouldBe` cs (show ["foo" :: String])

149+

150+

121151type UnionApi =

122152 "foo" :> Get Person

123153 :<|> "bar" :> Get Animal