b749f7f · servant · git.iko.soy

servant.cabal+1

compare with master

unifiedsplit

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

23 Servant.API.Get

24 Servant.API.GetParam

25 Servant.API.Post

26+ Servant.API.Raw

26 Servant.API.RQBody

27 Servant.API.RQBody

27 Servant.API.Sub

28 Servant.API.Sub

28 Servant.API.Union

29 Servant.API.Union

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

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

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

27 a -> Server sublayout

28

29− route Proxy subserver request = case pathInfo request of

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

30 (first : rest)

31 -> case captured captureProxy first of

32− Nothing -> return Nothing

32+ Nothing -> respond Nothing

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

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

34 pathInfo = rest

35− }

35+ } respond

36− _ -> return Nothing

36+ _ -> respond Nothing

37

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

39

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

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

22

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

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

25− route Proxy action request

25+ route Proxy action _globalPathInfo request respond

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

27 e <- runEitherT action

28− return $ Just $ case e of

28+ respond $ Just $ case e of

29 Right output ->

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

31 Left (status, message) ->

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

33− | otherwise = return Nothing

33+ | otherwise = respond Nothing

34

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

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

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

26 Maybe a -> Server sublayout

27

28− route Proxy subserver request = do

28+ route Proxy subserver globalPathInfo request respond = do

29 let querytext = parseQueryText $ rawQueryString request

30 param =

31 case lookup paramName querytext of

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

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

35 -- the right type

36

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

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

38

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

40

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

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

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

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

24

25− route Proxy action request

25+ route Proxy action _globalPathInfo request respond

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

27 e <- runEitherT action

28− return $ Just $ case e of

28+ respond $ Just $ case e of

29 Right out ->

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

31 Left (status, message) ->

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

33− | otherwise = return Nothing

33+ | otherwise = respond Nothing

34

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

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

22 type Server (RQBody a :> sublayout) =

23 a -> Server sublayout

24

25− route Proxy subserver request = do

25+ route Proxy subserver globalPathInfo request respond = do

26 mrqbody <- decode' <$> lazyRequestBody request

27 case mrqbody of

28− Nothing -> return Nothing

28+ Nothing -> respond Nothing

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

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

30

31instance (ToJSON a, HasClient sublayout)

32 => 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

4+

5+import Data.Proxy

6+import Network.Wai

7+import Servant.Server

8+

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

18

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

20 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

22 (first : rest)

23 | first == cs (symbolVal proxyPath)

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

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

25 pathInfo = rest

26− }

26+ } respond

27− _ -> return Nothing

27+ _ -> respond Nothing

28

29 where proxyPath = Proxy :: Proxy path

30

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

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

13

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

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

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

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

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

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

18− case m of

18+ case mResponse of

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

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

20− Just response -> return $ Just response

20+ Just response -> respond $ Just response

21

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

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

24 clientWithRoute Proxy req =

25 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 @@

3module Servant.Server where

4

5import Data.Proxy

6+import Data.Text

6import Network.HTTP.Types

7import Network.HTTP.Types

7import Network.Wai

8import Network.Wai

8

9

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

13serve p server = toApplication (route p server)

14serve p server = toApplication (route p server)

14

15

15toApplication :: RoutingApplication -> Application

16toApplication :: RoutingApplication -> Application

16−toApplication ra = \ request respond -> do

17+toApplication ra request respond = do

17− m <- ra request

18+ ra (pathInfo request) request routingRespond

18− case m of

19+ where

20+ routingRespond :: Maybe Response -> IO ResponseReceived

21+ routingRespond Nothing =

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

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

23+ routingRespond (Just response) =

20− Just response -> respond response

24+ respond response

21

25

22type RoutingApplication =

26type 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

24

30

25class HasServer layout where

31class HasServer layout where

26 type Server layout :: *

32 type Server layout :: *

test/Servant/ServerSpec.hs+31−1

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

10

11import Data.Aeson

12import Data.Proxy

13+import Data.String.Conversions

13import GHC.Generics

14import GHC.Generics

14import Network.HTTP.Types

15import Network.HTTP.Types

15import Network.Wai

16import Network.Wai

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

20import Servant.API.Get

21import Servant.API.Get

21import Servant.API.GetParam

22import Servant.API.GetParam

22import Servant.API.Post

23import Servant.API.Post

24+import Servant.API.Raw

23import Servant.API.RQBody

25import Servant.API.RQBody

24import Servant.API.Sub

26import Servant.API.Sub

25import Servant.API.Union

27import Servant.API.Union

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

60 getSpec

62 getSpec

61 getParamSpec

63 getParamSpec

62 postSpec

64 postSpec

65+ rawSpec

63 unionSpec

66 unionSpec

64

67

65

68

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

67getApi :: Proxy GetApi

70getApi :: Proxy GetApi

68getApi = Proxy

71getApi = Proxy

69

72

70−getSpec :: Spec = do

73+getSpec :: Spec

74+getSpec = do

71 describe "Servant.API.Get" $ do

75 describe "Servant.API.Get" $ do

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

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

73 it "allows to GET a Person" $ do

77 it "allows to GET a Person" $ do

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

118 }

122 }

119

123

120

124

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+

121type UnionApi =

151type UnionApi =

122 "foo" :> Get Person

152 "foo" :> Get Person

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

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