1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE PolyKinds #-}
3{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8module Servant.Server.Internal where
10import Control.Applicative ((<$>))
11import Control.Monad.Trans.Either (EitherT, runEitherT)
12import Data.Aeson (ToJSON)
13import qualified Data.ByteString as B
14import qualified Data.ByteString.Lazy as BL
15import Data.IORef (newIORef, readIORef, writeIORef)
16import Data.List (unfoldr)
17import Data.Maybe (catMaybes, fromMaybe)
18import Data.Monoid (Monoid, mempty, mappend)
19import Data.String (fromString)
20import Data.String.Conversions (cs, (<>))
21import Data.Text.Encoding (decodeUtf8, encodeUtf8)
22import Data.Text (Text)
23import qualified Data.Text as T
25import GHC.TypeLits (KnownSymbol, symbolVal)
26import Network.HTTP.Types hiding (Header)
27import Network.Wai ( Response, Request, ResponseReceived, Application
28 , pathInfo, requestBody, strictRequestBody
29 , lazyRequestBody, requestHeaders, requestMethod,
30 rawQueryString, responseLBS)
31import Servant.API ( QueryParams, QueryParam, QueryFlag, ReqBody, Header
32 , MatrixParams, MatrixParam, MatrixFlag
33 , Capture, Get, Delete, Put, Post, Patch, Raw, (:>), (:<|>)(..))
34import Servant.API.ContentTypes ( AllCTRender(..), AcceptHeader(..)
36import Servant.Common.Text (FromText, fromText)
39data ReqBodyState = Uncalled
40 | Called !B.ByteString
43toApplication :: RoutingApplication -> Application
44toApplication ra request respond = do
45 reqBodyRef <- newIORef Uncalled
46 -- We may need to consume the requestBody more than once. In order to
47 -- maintain the illusion that 'requestBody' works as expected,
48 -- 'ReqBodyState' is introduced, and the complete body is memoized and
49 -- returned as many times as requested with empty "Done" marker chunks in
51 -- See https://github.com/haskell-servant/servant/issues/3
53 ior <- readIORef reqBodyRef
56 r <- BL.toStrict <$> strictRequestBody request
57 writeIORef reqBodyRef $ Done r
60 writeIORef reqBodyRef $ Done bs
63 writeIORef reqBodyRef $ Called bs
66 ra request{ requestBody = memoReqBody } (routingRespond . routeResult)
68 routingRespond :: Either RouteMismatch Response -> IO ResponseReceived
69 routingRespond (Left NotFound) =
70 respond $ responseLBS notFound404 [] "not found"
71 routingRespond (Left WrongMethod) =
72 respond $ responseLBS methodNotAllowed405 [] "method not allowed"
73 routingRespond (Left (InvalidBody err)) =
74 respond $ responseLBS badRequest400 [] $ fromString $ "invalid request body: " ++ err
75 routingRespond (Left UnsupportedMediaType) =
76 respond $ responseLBS unsupportedMediaType415 [] "unsupported media type"
77 routingRespond (Left (HttpError status body)) =
78 respond $ responseLBS status [] $ fromMaybe (BL.fromStrict $ statusMessage status) body
79 routingRespond (Right response) =
82-- Note that the ordering of the constructors has great significance! It
83-- determines the Ord instance and, consequently, the monoid instance.
86 NotFound -- ^ the usual "not found" error
87 | WrongMethod -- ^ a more informative "you just got the HTTP method wrong" error
88 | UnsupportedMediaType -- ^ request body has unsupported media type
89 | InvalidBody String -- ^ an even more informative "your json request body wasn't valid" error
90 | HttpError Status (Maybe BL.ByteString) -- ^ an even even more informative arbitrary HTTP response code error.
91 deriving (Eq, Ord, Show)
93instance Monoid RouteMismatch where
95 -- The following isn't great, since it picks @InvalidBody@ based on
96 -- alphabetical ordering, but any choice would be arbitrary.
98 -- "As one judge said to the other, 'Be just and if you can't be just, be
99 -- arbitrary'" -- William Burroughs
103-- | A wrapper around @'Either' 'RouteMismatch' a@.
104newtype RouteResult a =
105 RR { routeResult :: Either RouteMismatch a }
108failWith :: RouteMismatch -> RouteResult a
111succeedWith :: a -> RouteResult a
112succeedWith = RR . Right
114isMismatch :: RouteResult a -> Bool
115isMismatch (RR (Left _)) = True
118-- | Like `null . pathInfo`, but works with redundant trailing slashes.
119pathIsEmpty :: Request -> Bool
120pathIsEmpty = f . processedPathInfo
126-- | If we get a `Right`, it has precedence over everything else.
128-- This in particular means that if we could get several 'Right's,
129-- only the first we encounter would be taken into account.
130instance Monoid (RouteResult a) where
131 mempty = RR $ Left mempty
133 RR (Left x) `mappend` RR (Left y) = RR $ Left (x <> y)
134 RR (Left _) `mappend` RR (Right y) = RR $ Right y
137type RoutingApplication =
138 Request -- ^ the request, the field 'pathInfo' may be modified by url routing
139 -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived
141splitMatrixParameters :: Text -> (Text, Text)
142splitMatrixParameters = T.break (== ';')
144parsePathInfo :: Request -> [Text]
145parsePathInfo = filter (/= "") . mergePairs . map splitMatrixParameters . pathInfo
146 where mergePairs = concat . unfoldr pairToList
147 pairToList [] = Nothing
148 pairToList ((a, b):xs) = Just ([a, b], xs)
150-- | Returns a processed pathInfo from the request.
152-- In order to handle matrix parameters in the request correctly, the raw pathInfo needs to be
153-- processed, so routing works as intended. Therefor this function should be used to access
154-- the pathInfo for routing purposes.
155processedPathInfo :: Request -> [Text]
158 (x:xs) | T.head x == ';' -> xs
160 where pinfo = parsePathInfo r
162class HasServer layout where
163 type ServerT layout (m :: * -> *) :: *
164 route :: Proxy layout -> Server' layout -> RoutingApplication
166type Server' layout = ServerT layout (EitherT (Int, String) IO)
171-- | A server for @a ':<|>' b@ first tries to match the request against the route
172-- represented by @a@ and if it fails tries @b@. You must provide a request
173-- handler for each route.
175-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
176-- > :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books
178-- > server :: Server MyApi
179-- > server = listAllBooks :<|> postBook
180-- > where listAllBooks = ...
181-- > postBook book = ...
182instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
184 type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
186 route Proxy (a :<|> b) request respond =
187 route pa a request $ \ mResponse ->
188 if isMismatch mResponse
189 then route pb b request $ \mResponse' -> respond (mResponse <> mResponse')
190 else respond mResponse
192 where pa = Proxy :: Proxy a
193 pb = Proxy :: Proxy b
195captured :: FromText a => proxy (Capture sym a) -> Text -> Maybe a
198-- | If you use 'Capture' in one of the endpoints for your API,
199-- this automatically requires your server-side handler to be a function
200-- that takes an argument of the type specified by the 'Capture'.
201-- This lets servant worry about getting it from the URL and turning
202-- it into a value of the type you specify.
204-- You can control how it'll be converted from 'Text' to your type
205-- by simply providing an instance of 'FromText' for your type.
209-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
211-- > server :: Server MyApi
213-- > where getBook :: Text -> EitherT (Int, String) IO Book
214-- > getBook isbn = ...
215instance (KnownSymbol capture, FromText a, HasServer sublayout)
216 => HasServer (Capture capture a :> sublayout) where
218 type ServerT (Capture capture a :> sublayout) m =
219 a -> ServerT sublayout m
221 route Proxy subserver request respond = case processedPathInfo request of
223 -> case captured captureProxy first of
224 Nothing -> respond $ failWith NotFound
225 Just v -> route (Proxy :: Proxy sublayout) (subserver v) request{
228 _ -> respond $ failWith NotFound
230 where captureProxy = Proxy :: Proxy (Capture capture a)
233-- | If you have a 'Delete' endpoint in your API,
234-- the handler for this endpoint is meant to delete
237-- The code of the handler will, just like
238-- for 'Servant.API.Get.Get', 'Servant.API.Post.Post' and
239-- 'Servant.API.Put.Put', run in @EitherT (Int, String) IO ()@.
240-- The 'Int' represents the status code and the 'String' a message
241-- to be returned. You can use 'Control.Monad.Trans.Either.left' to
242-- painlessly error out if the conditions for a successful deletion
244instance HasServer Delete where
246 type ServerT Delete m = m ()
248 route Proxy action request respond
249 | pathIsEmpty request && requestMethod request == methodDelete = do
250 e <- runEitherT action
251 respond $ succeedWith $ case e of
253 responseLBS status204 [] ""
254 Left (status, message) ->
255 responseLBS (mkStatus status (cs message)) [] (cs message)
256 | pathIsEmpty request && requestMethod request /= methodDelete =
257 respond $ failWith WrongMethod
258 | otherwise = respond $ failWith NotFound
260-- | When implementing the handler for a 'Get' endpoint,
261-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Post.Post'
262-- and 'Servant.API.Put.Put', the handler code runs in the
263-- @EitherT (Int, String) IO@ monad, where the 'Int' represents
264-- the status code and the 'String' a message, returned in case of
265-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
266-- to quickly fail if some conditions are not met.
268-- If successfully returning a value, we use the type-level list, combined
269-- with the request's @Accept@ header, to encode the value for you
270-- (returning a status code of 200). If there was no @Accept@ header or it
271-- was @*/*@, we return encode using the first @Content-Type@ type on the
273instance ( AllCTRender ctypes a
274 ) => HasServer (Get ctypes a) where
276 type ServerT (Get ctypes a) m = m a
278 route Proxy action request respond
279 | pathIsEmpty request && requestMethod request == methodGet = do
280 e <- runEitherT action
281 respond . succeedWith $ case e of
283 let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
284 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
285 Nothing -> responseLBS (mkStatus 406 "Not Acceptable") [] ""
286 Just (contentT, body) -> responseLBS ok200 [ ("Content-Type"
288 Left (status, message) ->
289 responseLBS (mkStatus status (cs message)) [] (cs message)
290 | pathIsEmpty request && requestMethod request /= methodGet =
291 respond $ failWith WrongMethod
292 | otherwise = respond $ failWith NotFound
294-- | If you use 'Header' in one of the endpoints for your API,
295-- this automatically requires your server-side handler to be a function
296-- that takes an argument of the type specified by 'Header'.
297-- This lets servant worry about extracting it from the request and turning
298-- it into a value of the type you specify.
300-- All it asks is for a 'FromText' instance.
304-- > newtype Referer = Referer Text
305-- > deriving (Eq, Show, FromText, ToText)
307-- > -- GET /view-my-referer
308-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
310-- > server :: Server MyApi
311-- > server = viewReferer
312-- > where viewReferer :: Referer -> EitherT (Int, String) IO referer
313-- > viewReferer referer = return referer
314instance (KnownSymbol sym, FromText a, HasServer sublayout)
315 => HasServer (Header sym a :> sublayout) where
317 type ServerT (Header sym a :> sublayout) m =
318 Maybe a -> ServerT sublayout m
320 route Proxy subserver request respond = do
321 let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
322 route (Proxy :: Proxy sublayout) (subserver mheader) request respond
324 where str = fromString $ symbolVal (Proxy :: Proxy sym)
326-- | When implementing the handler for a 'Post' endpoint,
327-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
328-- and 'Servant.API.Put.Put', the handler code runs in the
329-- @EitherT (Int, String) IO@ monad, where the 'Int' represents
330-- the status code and the 'String' a message, returned in case of
331-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
332-- to quickly fail if some conditions are not met.
334-- If successfully returning a value, we use the type-level list, combined
335-- with the request's @Accept@ header, to encode the value for you
336-- (returning a status code of 201). If there was no @Accept@ header or it
337-- was @*/*@, we return encode using the first @Content-Type@ type on the
339instance ( AllCTRender ctypes a
340 ) => HasServer (Post ctypes a) where
342 type ServerT (Post ctypes a) m = m a
344 route Proxy action request respond
345 | pathIsEmpty request && requestMethod request == methodPost = do
346 e <- runEitherT action
347 respond . succeedWith $ case e of
349 let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
350 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
351 Nothing -> responseLBS (mkStatus 406 "") [] ""
352 Just (contentT, body) -> responseLBS status201 [ ("Content-Type"
354 Left (status, message) ->
355 responseLBS (mkStatus status (cs message)) [] (cs message)
356 | pathIsEmpty request && requestMethod request /= methodPost =
357 respond $ failWith WrongMethod
358 | otherwise = respond $ failWith NotFound
360-- | When implementing the handler for a 'Put' endpoint,
361-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
362-- and 'Servant.API.Post.Post', the handler code runs in the
363-- @EitherT (Int, String) IO@ monad, where the 'Int' represents
364-- the status code and the 'String' a message, returned in case of
365-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
366-- to quickly fail if some conditions are not met.
368-- If successfully returning a value, we use the type-level list, combined
369-- with the request's @Accept@ header, to encode the value for you
370-- (returning a status code of 201). If there was no @Accept@ header or it
371-- was @*/*@, we return encode using the first @Content-Type@ type on the
373instance ( AllCTRender ctypes a
374 ) => HasServer (Put ctypes a) where
376 type ServerT (Put ctypes a) m = m a
378 route Proxy action request respond
379 | pathIsEmpty request && requestMethod request == methodPut = do
380 e <- runEitherT action
381 respond . succeedWith $ case e of
383 let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
384 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
385 Nothing -> responseLBS (mkStatus 406 "") [] ""
386 Just (contentT, body) -> responseLBS status200 [ ("Content-Type"
388 Left (status, message) ->
389 responseLBS (mkStatus status (cs message)) [] (cs message)
390 | pathIsEmpty request && requestMethod request /= methodPut =
391 respond $ failWith WrongMethod
393 | otherwise = respond $ failWith NotFound
395-- | When implementing the handler for a 'Patch' endpoint,
396-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
397-- and 'Servant.API.Put.Put', the handler code runs in the
398-- @EitherT (Int, String) IO@ monad, where the 'Int' represents
399-- the status code and the 'String' a message, returned in case of
400-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
401-- to quickly fail if some conditions are not met.
403-- If successfully returning a value, we just require that its type has
404-- a 'ToJSON' instance and servant takes care of encoding it for you,
405-- yielding status code 201 along the way.
406instance ( AllCTRender ctypes a
408 , ToJSON a) => HasServer (Patch ctypes a) where
410 type ServerT (Patch ctypes a) m = m a
412 route Proxy action request respond
413 | pathIsEmpty request && requestMethod request == methodPost = do
414 e <- runEitherT action
415 respond . succeedWith $ case e of
416 Right out -> case cast out of
418 let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
419 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) out of
420 Nothing -> responseLBS (mkStatus 406 "") [] ""
421 Just (contentT, body) -> responseLBS status200 [ ("Content-Type"
423 Just () -> responseLBS status204 [] ""
424 Left (status, message) ->
425 responseLBS (mkStatus status (cs message)) [] (cs message)
426 | pathIsEmpty request && requestMethod request /= methodPost =
427 respond $ failWith WrongMethod
428 | otherwise = respond $ failWith NotFound
430-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
431-- this automatically requires your server-side handler to be a function
432-- that takes an argument of type @'Maybe' 'Text'@.
434-- This lets servant worry about looking it up in the query string
435-- and turning it into a value of the type you specify, enclosed
436-- in 'Maybe', because it may not be there and servant would then
437-- hand you 'Nothing'.
439-- You can control how it'll be converted from 'Text' to your type
440-- by simply providing an instance of 'FromText' for your type.
444-- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
446-- > server :: Server MyApi
447-- > server = getBooksBy
448-- > where getBooksBy :: Maybe Text -> EitherT (Int, String) IO [Book]
449-- > getBooksBy Nothing = ...return all books...
450-- > getBooksBy (Just author) = ...return books by the given author...
451instance (KnownSymbol sym, FromText a, HasServer sublayout)
452 => HasServer (QueryParam sym a :> sublayout) where
454 type ServerT (QueryParam sym a :> sublayout) m =
455 Maybe a -> ServerT sublayout m
457 route Proxy subserver request respond = do
458 let querytext = parseQueryText $ rawQueryString request
460 case lookup paramname querytext of
461 Nothing -> Nothing -- param absent from the query string
462 Just Nothing -> Nothing -- param present with no value -> Nothing
463 Just (Just v) -> fromText v -- if present, we try to convert to
466 route (Proxy :: Proxy sublayout) (subserver param) request respond
468 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
470-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
471-- this automatically requires your server-side handler to be a function
472-- that takes an argument of type @['Text']@.
474-- This lets servant worry about looking up 0 or more values in the query string
475-- associated to @authors@ and turning each of them into a value of
476-- the type you specify.
478-- You can control how the individual values are converted from 'Text' to your type
479-- by simply providing an instance of 'FromText' for your type.
483-- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
485-- > server :: Server MyApi
486-- > server = getBooksBy
487-- > where getBooksBy :: [Text] -> EitherT (Int, String) IO [Book]
488-- > getBooksBy authors = ...return all books by these authors...
489instance (KnownSymbol sym, FromText a, HasServer sublayout)
490 => HasServer (QueryParams sym a :> sublayout) where
492 type ServerT (QueryParams sym a :> sublayout) m =
493 [a] -> ServerT sublayout m
495 route Proxy subserver request respond = do
496 let querytext = parseQueryText $ rawQueryString request
497 -- if sym is "foo", we look for query string parameters
498 -- named "foo" or "foo[]" and call fromText on the
499 -- corresponding values
500 parameters = filter looksLikeParam querytext
501 values = catMaybes $ map (convert . snd) parameters
503 route (Proxy :: Proxy sublayout) (subserver values) request respond
505 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
506 looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
507 convert Nothing = Nothing
508 convert (Just v) = fromText v
510-- | If you use @'QueryFlag' "published"@ in one of the endpoints for your API,
511-- this automatically requires your server-side handler to be a function
512-- that takes an argument of type 'Bool'.
516-- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
518-- > server :: Server MyApi
519-- > server = getBooks
520-- > where getBooks :: Bool -> EitherT (Int, String) IO [Book]
521-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
522instance (KnownSymbol sym, HasServer sublayout)
523 => HasServer (QueryFlag sym :> sublayout) where
525 type ServerT (QueryFlag sym :> sublayout) m =
526 Bool -> ServerT sublayout m
528 route Proxy subserver request respond = do
529 let querytext = parseQueryText $ rawQueryString request
530 param = case lookup paramname querytext of
531 Just Nothing -> True -- param is there, with no value
532 Just (Just v) -> examine v -- param with a value
533 Nothing -> False -- param not in the query string
535 route (Proxy :: Proxy sublayout) (subserver param) request respond
537 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
538 examine v | v == "true" || v == "1" || v == "" = True
541parseMatrixText :: B.ByteString -> QueryText
542parseMatrixText = parseQueryText
544-- | If you use @'MatrixParam' "author" Text@ in one of the endpoints for your API,
545-- this automatically requires your server-side handler to be a function
546-- that takes an argument of type @'Maybe' 'Text'@.
548-- This lets servant worry about looking it up in the query string
549-- and turning it into a value of the type you specify, enclosed
550-- in 'Maybe', because it may not be there and servant would then
551-- hand you 'Nothing'.
553-- You can control how it'll be converted from 'Text' to your type
554-- by simply providing an instance of 'FromText' for your type.
558-- > type MyApi = "books" :> MatrixParam "author" Text :> Get [Book]
560-- > server :: Server MyApi
561-- > server = getBooksBy
562-- > where getBooksBy :: Maybe Text -> EitherT (Int, String) IO [Book]
563-- > getBooksBy Nothing = ...return all books...
564-- > getBooksBy (Just author) = ...return books by the given author...
565instance (KnownSymbol sym, FromText a, HasServer sublayout)
566 => HasServer (MatrixParam sym a :> sublayout) where
568 type ServerT (MatrixParam sym a :> sublayout) m =
569 Maybe a -> ServerT sublayout m
571 route Proxy subserver request respond = case parsePathInfo request of
573 -> do let querytext = parseMatrixText . encodeUtf8 $ T.tail first
574 param = case lookup paramname querytext of
575 Nothing -> Nothing -- param absent from the query string
576 Just Nothing -> Nothing -- param present with no value -> Nothing
577 Just (Just v) -> fromText v -- if present, we try to convert to
579 route (Proxy :: Proxy sublayout) (subserver param) request respond
580 _ -> route (Proxy :: Proxy sublayout) (subserver Nothing) request respond
582 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
584-- | If you use @'MatrixParams' "authors" Text@ in one of the endpoints for your API,
585-- this automatically requires your server-side handler to be a function
586-- that takes an argument of type @['Text']@.
588-- This lets servant worry about looking up 0 or more values in the query string
589-- associated to @authors@ and turning each of them into a value of
590-- the type you specify.
592-- You can control how the individual values are converted from 'Text' to your type
593-- by simply providing an instance of 'FromText' for your type.
597-- > type MyApi = "books" :> MatrixParams "authors" Text :> Get [Book]
599-- > server :: Server MyApi
600-- > server = getBooksBy
601-- > where getBooksBy :: [Text] -> EitherT (Int, String) IO [Book]
602-- > getBooksBy authors = ...return all books by these authors...
603instance (KnownSymbol sym, FromText a, HasServer sublayout)
604 => HasServer (MatrixParams sym a :> sublayout) where
606 type ServerT (MatrixParams sym a :> sublayout) m =
607 [a] -> ServerT sublayout m
609 route Proxy subserver request respond = case parsePathInfo request of
611 -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
612 -- if sym is "foo", we look for matrix parameters
613 -- named "foo" or "foo[]" and call fromText on the
614 -- corresponding values
615 parameters = filter looksLikeParam matrixtext
616 values = catMaybes $ map (convert . snd) parameters
617 route (Proxy :: Proxy sublayout) (subserver values) request respond
618 _ -> route (Proxy :: Proxy sublayout) (subserver []) request respond
620 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
621 looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
622 convert Nothing = Nothing
623 convert (Just v) = fromText v
625-- | If you use @'MatrixFlag' "published"@ in one of the endpoints for your API,
626-- this automatically requires your server-side handler to be a function
627-- that takes an argument of type 'Bool'.
631-- > type MyApi = "books" :> MatrixFlag "published" :> Get [Book]
633-- > server :: Server MyApi
634-- > server = getBooks
635-- > where getBooks :: Bool -> EitherT (Int, String) IO [Book]
636-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
637instance (KnownSymbol sym, HasServer sublayout)
638 => HasServer (MatrixFlag sym :> sublayout) where
640 type ServerT (MatrixFlag sym :> sublayout) m =
641 Bool -> ServerT sublayout m
643 route Proxy subserver request respond = case parsePathInfo request of
645 -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
646 param = case lookup paramname matrixtext of
647 Just Nothing -> True -- param is there, with no value
648 Just (Just v) -> examine v -- param with a value
649 Nothing -> False -- param not in the query string
651 route (Proxy :: Proxy sublayout) (subserver param) request respond
653 _ -> route (Proxy :: Proxy sublayout) (subserver False) request respond
655 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
656 examine v | v == "true" || v == "1" || v == "" = True
659-- | Just pass the request to the underlying application and serve its response.
663-- > type MyApi = "images" :> Raw
665-- > server :: Server MyApi
666-- > server = serveDirectory "/var/www/images"
667instance HasServer Raw where
669 type ServerT Raw m = Application
671 route Proxy rawApplication request respond =
672 rawApplication request (respond . succeedWith)
674-- | If you use 'ReqBody' in one of the endpoints for your API,
675-- this automatically requires your server-side handler to be a function
676-- that takes an argument of the type specified by 'ReqBody'.
677-- The @Content-Type@ header is inspected, and the list provided is used to
678-- attempt deserialization. If the request does not have a @Content-Type@
679-- header, it is treated as @application/octet-stream@.
680-- This lets servant worry about extracting it from the request and turning
681-- it into a value of the type you specify.
684-- All it asks is for a 'FromJSON' instance.
688-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
690-- > server :: Server MyApi
691-- > server = postBook
692-- > where postBook :: Book -> EitherT (Int, String) IO Book
693-- > postBook book = ...insert into your db...
694instance ( AllCTUnrender list a, HasServer sublayout
695 ) => HasServer (ReqBody list a :> sublayout) where
697 type ServerT (ReqBody list a :> sublayout) m =
698 a -> ServerT sublayout m
700 route Proxy subserver request respond = do
701 -- See HTTP RFC 2616, section 7.2.1
702 -- http://www.w3.org/Protocols/rfc2616/rfc2616-sec7.html#sec7.2.1
703 -- See also "W3C Internet Media Type registration, consistency of use"
704 -- http://www.w3.org/2001/tag/2002/0129-mime
705 let contentTypeH = fromMaybe "application/octet-stream"
706 $ lookup hContentType $ requestHeaders request
707 mrqbody <- handleCTypeH (Proxy :: Proxy list) (cs contentTypeH)
708 <$> lazyRequestBody request
710 Nothing -> respond . failWith $ UnsupportedMediaType
711 Just (Left e) -> respond . failWith $ InvalidBody e
712 Just (Right v) -> route (Proxy :: Proxy sublayout) (subserver v) request respond
714-- | Make sure the incoming request starts with @"/path"@, strip it and
715-- pass the rest of the request path to @sublayout@.
716instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
718 type ServerT (path :> sublayout) m = ServerT sublayout m
720 route Proxy subserver request respond = case processedPathInfo request of
722 | first == cs (symbolVal proxyPath)
723 -> route (Proxy :: Proxy sublayout) subserver request{
726 _ -> respond $ failWith NotFound
728 where proxyPath = Proxy :: Proxy path
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list