packages feed

servant-server (empty) → 0.2.1

raw patch · 9 files changed

+759/−0 lines, 9 filesdep +QuickCheckdep +aesondep +attoparsecsetup-changed

Dependencies added: QuickCheck, aeson, attoparsec, base, bytestring, directory, either, exceptions, hspec, hspec-wai, http-types, network, network-uri, parsec, safe, servant, servant-server, split, string-conversions, system-filepath, temporary, text, transformers, wai, wai-app-static, wai-extra, warp

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Zalora South East Asia Pte Ltd++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Zalora South East Asia Pte Ltd nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/greet.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}++import Data.Aeson+import Data.Monoid+import Data.Proxy+import Data.Text+import GHC.Generics+import Network.Wai+import Network.Wai.Handler.Warp++import Servant++-- * Example++-- | A greet message data type+newtype Greet = Greet { msg :: Text }+  deriving (Generic, Show)++instance FromJSON Greet+instance ToJSON Greet++-- API specification+type TestApi =+       -- GET /hello/:name?capital={true, false}  returns a Greet as JSON+       "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet++       -- POST /greet with a Greet as JSON in the request body,+       --             returns a Greet as JSON+  :<|> "greet" :> ReqBody Greet :> Post Greet++       -- DELETE /greet/:greetid+  :<|> "greet" :> Capture "greetid" Text :> Delete++testApi :: Proxy TestApi+testApi = Proxy++-- Server-side handlers.+--+-- There's one handler per endpoint, which, just like in the type+-- that represents the API, are glued together using :<|>.+--+-- Each handler runs in the 'EitherT (Int, String) IO' monad.+server :: Server TestApi+server = helloH :<|> postGreetH :<|> deleteGreetH++  where helloH name Nothing = helloH name (Just False)+        helloH name (Just False) = return . Greet $ "Hello, " <> name+        helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name++        postGreetH greet = return greet++        deleteGreetH _ = return ()++-- Turn the server into a WAI app. 'serve' is provided by servant,+-- more precisely by the Servant.Server module.+test :: Application+test = serve testApi server++-- Run the server.+--+-- 'run' comes from Network.Wai.Handler.Warp+runTestServer :: Port -> IO ()+runTestServer port = run port test++-- Put this all to work!+main :: IO ()+main = runTestServer 8001
+ servant-server.cabal view
@@ -0,0 +1,96 @@+name:                servant-server+version:             0.2.1+synopsis:            A family of combinators for defining webservices APIs and serving them+description:+  A family of combinators for defining webservices APIs and serving them+  .+  You can learn about the basics in <http://haskell-servant.github.io/getting-started/ the getting started> guide.+  .+  <https://github.com/haskell-servant/servant-server/blob/master/example/greet.hs Here>'s a runnable example, with comments, that defines a dummy API and+  implements a webserver that serves this API, using this package.+homepage:            http://haskell-servant.github.io/+Bug-reports:         http://github.com/haskell-servant/servant-server/issues+license:             BSD3+license-file:        LICENSE+author:              Alp Mestanogullari, Sönke Hahn, Julian K. Arni+maintainer:          alpmestan@gmail.com+copyright:           2014 Zalora South East Asia Pte Ltd+category:            Web+build-type:          Simple+cabal-version:       >=1.10+tested-with:         GHC >= 7.8+source-repository head+  type: git+  location: http://github.com/haskell-servant/servant-server.git++library+  exposed-modules:+    Servant+    Servant.Server+    Servant.Utils.StaticFiles+  other-modules: Servant.Server.Internal+  build-depends:+      base >=4.7 && <5+    , aeson+    , attoparsec+    , bytestring+    , either+    , http-types+    , network-uri >= 2.6+    , safe+    , servant >= 0.2+    , split+    , string-conversions+    , system-filepath+    , text+    , transformers+    , wai+    , wai-app-static+    , warp+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall++executable greet+  main-is: greet.hs+  hs-source-dirs: example+  ghc-options: -Wall+  default-language: Haskell2010+  build-depends:+      base+    , servant+    , servant-server+    , aeson+    , warp+    , wai+    , text++test-suite spec+  type: exitcode-stdio-1.0+  ghc-options:+    -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures+  default-language: Haskell2010+  hs-source-dirs: test+  main-is: Spec.hs+  build-depends:+      base == 4.*+    , aeson+    , bytestring+    , directory+    , either+    , exceptions+    , hspec == 2.*+    , hspec-wai+    , http-types+    , network >= 2.6+    , QuickCheck+    , parsec+    , servant+    , servant-server+    , string-conversions+    , temporary+    , text+    , transformers+    , wai+    , wai-extra+    , warp
+ src/Servant.hs view
@@ -0,0 +1,24 @@+module Servant (+  -- | This module and its submodules can be used to define servant APIs. Note+  -- that these API definitions don't directly implement a server (or anything+  -- else).+  module Servant.API,+  -- | For implementing servers for servant APIs.+  module Servant.Server,+  -- | Using your types in request paths and query string parameters+  module Servant.Common.Text,+  -- | Utilities on top of the servant core+  module Servant.QQ,+  module Servant.Utils.Links,+  module Servant.Utils.StaticFiles,+  -- | Useful re-exports+  Proxy(..),+  ) where++import Data.Proxy+import Servant.API+import Servant.Common.Text+import Servant.Server+import Servant.QQ+import Servant.Utils.Links+import Servant.Utils.StaticFiles
+ src/Servant/Server.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}++-- | This module lets you implement 'Server's for defined APIs. You'll+-- most likely just need 'serve'.+module Servant.Server+  ( -- * Implementing an API+    serve++  , -- * Handlers for all standard combinators+    HasServer(..)+  ) where++import Data.Proxy+import Network.Wai+import Servant.Server.Internal++-- * Implementing Servers++-- | 'serve' allows you to implement an API and produce a wai 'Application'.+--+-- Example:+--+-- > type MyApi = "books" :> Get [Book] -- GET /books+-- >         :<|> "books" :> ReqBody Book :> Post Book -- POST /books+-- >+-- > server :: Server MyApi+-- > server = listAllBooks :<|> postBook+-- >   where listAllBooks = ...+-- >         postBook book = ...+-- >+-- > app :: Application+-- > app = serve myApi server+-- >+-- > main :: IO ()+-- > main = Network.Wai.Handler.Warp.run 8080 app+serve :: HasServer layout => Proxy layout -> Server layout -> Application+serve p server = toApplication (route p server)+
+ src/Servant/Server/Internal.hs view
@@ -0,0 +1,459 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Servant.Server.Internal where++import Control.Applicative+import Control.Monad.Trans.Either+import Data.Aeson+import Data.Maybe (catMaybes)+import Data.Monoid+import Data.Proxy+import Data.String+import Data.String.Conversions+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8)+import GHC.TypeLits+import Network.HTTP.Types hiding (Header)+import Network.Wai+import Servant.API+import Servant.Common.Text++toApplication :: RoutingApplication -> Application+toApplication ra request respond = do+  ra request (routingRespond . routeResult)+ where+  routingRespond :: Either RouteMismatch Response -> IO ResponseReceived+  routingRespond (Left NotFound) =+    respond $ responseLBS notFound404 [] "not found"+  routingRespond (Left WrongMethod) =+    respond $ responseLBS methodNotAllowed405 [] "method not allowed"+  routingRespond (Left InvalidBody) =+    respond $ responseLBS badRequest400 [] "Invalid JSON in request body"+  routingRespond (Right response) =+    respond response++-- * Route mismatch+data RouteMismatch =+    NotFound    -- ^ the usual "not found" error+  | WrongMethod -- ^ a more informative "you just got the HTTP method wrong" error+  | InvalidBody -- ^ an even more informative "your json request body wasn't valid" error+  deriving (Eq, Show)++-- | +-- @+-- > mempty = NotFound+-- >+-- > NotFound    `mappend`           x = x+-- > WrongMethod `mappend` InvalidBody = InvalidBody+-- > WrongMethod `mappend`           _ = WrongMethod+-- > InvalidBody `mappend`           _ = InvalidBody+-- @+instance Monoid RouteMismatch where+  mempty = NotFound++  NotFound    `mappend`           x = x+  WrongMethod `mappend` InvalidBody = InvalidBody+  WrongMethod `mappend`           _ = WrongMethod+  InvalidBody `mappend`           _ = InvalidBody++-- | A wrapper around @'Either' 'RouteMismatch' a@.+newtype RouteResult a =+  RR { routeResult :: Either RouteMismatch a }+  deriving (Eq, Show)++failWith :: RouteMismatch -> RouteResult a+failWith = RR . Left++succeedWith :: a -> RouteResult a+succeedWith = RR . Right++isMismatch :: RouteResult a -> Bool+isMismatch (RR (Left _)) = True+isMismatch _             = False++-- | If we get a `Right`, it has precedence over everything else.+--+-- This in particular means that if we could get several 'Right's,+-- only the first we encounter would be taken into account.+instance Monoid (RouteResult a) where+  mempty = RR $ Left mempty++  RR (Left x)  `mappend` RR (Left y)  = RR $ Left (x <> y)+  RR (Left _)  `mappend` RR (Right y) = RR $ Right y+  r            `mappend` _            = r++type RoutingApplication =+     Request -- ^ the request, the field 'pathInfo' may be modified by url routing+  -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived++class HasServer layout where+  type Server layout :: *+  route :: Proxy layout -> Server layout -> RoutingApplication++-- * Instances++-- | A server for @a ':<|>' b@ first tries to match the request again the route+--   represented by @a@ and if it fails tries @b@. You must provide a request+--   handler for each route.+--+-- > type MyApi = "books" :> Get [Book] -- GET /books+-- >         :<|> "books" :> ReqBody Book :> Post Book -- POST /books+-- >+-- > server :: Server MyApi+-- > server = listAllBooks :<|> postBook+-- >   where listAllBooks = ...+-- >         postBook book = ...+instance (HasServer a, HasServer b) => HasServer (a :<|> b) where+  type Server (a :<|> b) = Server a :<|> Server b+  route Proxy (a :<|> b) request respond =+    route pa a request $ \ mResponse ->+      if isMismatch mResponse+        then route pb b request $ \mResponse' -> respond (mResponse <> mResponse')+        else respond mResponse++    where pa = Proxy :: Proxy a+          pb = Proxy :: Proxy b++captured :: FromText a => proxy (Capture sym a) -> Text -> Maybe a+captured _ = fromText++-- | If you use 'Capture' in one of the endpoints for your API,+-- this automatically requires your server-side handler to be a function+-- that takes an argument of the type specified by the 'Capture'.+-- This lets servant worry about getting it from the URL and turning+-- it into a value of the type you specify.+--+-- You can control how it'll be converted from 'Text' to your type+-- by simply providing an instance of 'FromText' for your type.+--+-- Example:+--+-- > type MyApi = "books" :> Capture "isbn" Text :> Get Book+-- >+-- > server :: Server MyApi+-- > server = getBook+-- >   where getBook :: Text -> EitherT (Int, String) IO Book+-- >         getBook isbn = ...+instance (KnownSymbol capture, FromText a, HasServer sublayout)+      => HasServer (Capture capture a :> sublayout) where++  type Server (Capture capture a :> sublayout) =+     a -> Server sublayout++  route Proxy subserver request respond = case pathInfo request of+    (first : rest)+      -> case captured captureProxy first of+           Nothing  -> respond $ failWith NotFound+           Just v   -> route (Proxy :: Proxy sublayout) (subserver v) request{+                         pathInfo = rest+                       } respond+    _ -> respond $ failWith NotFound++    where captureProxy = Proxy :: Proxy (Capture capture a)++-- | If you have a 'Delete' endpoint in your API,+-- the handler for this endpoint is meant to delete+-- a resource.+--+-- The code of the handler will, just like+-- for 'Servant.API.Get.Get', 'Servant.API.Post.Post' and+-- 'Servant.API.Put.Put', run in @EitherT (Int, String) IO ()@.+-- The 'Int' represents the status code and the 'String' a message+-- to be returned. You can use 'Control.Monad.Trans.Either.left' to+-- painlessly error out if the conditions for a successful deletion+-- are not met.+instance HasServer Delete where+  type Server Delete = EitherT (Int, String) IO ()++  route Proxy action request respond+    | null (pathInfo request) && requestMethod request == methodDelete = do+        e <- runEitherT action+        respond $ succeedWith $ case e of+          Right () ->+            responseLBS status204 [] ""+          Left (status, message) ->+            responseLBS (mkStatus status (cs message)) [] (cs message)+    | null (pathInfo request) && requestMethod request /= methodDelete =+        respond $ failWith WrongMethod+    | otherwise = respond $ failWith NotFound++-- | When implementing the handler for a 'Get' endpoint,+-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Post.Post'+-- and 'Servant.API.Put.Put', the handler code runs in the+-- @EitherT (Int, String) IO@ monad, where the 'Int' represents+-- the status code and the 'String' a message, returned in case of+-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'+-- to quickly fail if some conditions are not met.+--+-- If successfully returning a value, we just require that its type has+-- a 'ToJSON' instance and servant takes care of encoding it for you,+-- yielding status code 200 along the way.+instance ToJSON result => HasServer (Get result) where+  type Server (Get result) = EitherT (Int, String) IO result+  route Proxy action request respond+    | null (pathInfo request) && requestMethod request == methodGet = do+        e <- runEitherT action+        respond . succeedWith $ case e of+          Right output ->+            responseLBS ok200 [("Content-Type", "application/json")] (encode output)+          Left (status, message) ->+            responseLBS (mkStatus status (cs message)) [] (cs message)+    | null (pathInfo request) && requestMethod request /= methodGet =+        respond $ failWith WrongMethod+    | otherwise = respond $ failWith NotFound++-- | If you use 'Header' in one of the endpoints for your API,+-- this automatically requires your server-side handler to be a function+-- that takes an argument of the type specified by 'Header'.+-- This lets servant worry about extracting it from the request and turning+-- it into a value of the type you specify.+--+-- All it asks is for a 'FromText' instance.+--+-- Example:+--+-- > newtype Referer = Referer Text+-- >   deriving (Eq, Show, FromText, ToText)+-- >+-- >            -- GET /view-my-referer+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get Referer+-- >+-- > server :: Server MyApi+-- > server = viewReferer+-- >   where viewReferer :: Referer -> EitherT (Int, String) IO referer+-- >         viewReferer referer = return referer+instance (KnownSymbol sym, FromText a, HasServer sublayout)+      => HasServer (Header sym a :> sublayout) where++  type Server (Header sym a :> sublayout) =+    Maybe a -> Server sublayout++  route Proxy subserver request respond = do+    let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)+    route (Proxy :: Proxy sublayout) (subserver mheader) request respond++      where str = fromString $ symbolVal (Proxy :: Proxy sym)++-- | When implementing the handler for a 'Post' endpoint,+-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'+-- and 'Servant.API.Put.Put', the handler code runs in the+-- @EitherT (Int, String) IO@ monad, where the 'Int' represents+-- the status code and the 'String' a message, returned in case of+-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'+-- to quickly fail if some conditions are not met.+--+-- If successfully returning a value, we just require that its type has+-- a 'ToJSON' instance and servant takes care of encoding it for you,+-- yielding status code 201 along the way.+instance ToJSON a => HasServer (Post a) where+  type Server (Post a) = EitherT (Int, String) IO a++  route Proxy action request respond+    | null (pathInfo request) && requestMethod request == methodPost = do+        e <- runEitherT action+        respond . succeedWith $ case e of+          Right out ->+            responseLBS status201 [("Content-Type", "application/json")] (encode out)+          Left (status, message) ->+            responseLBS (mkStatus status (cs message)) [] (cs message)+    | null (pathInfo request) && requestMethod request /= methodPost =+        respond $ failWith WrongMethod+    | otherwise = respond $ failWith NotFound++-- | When implementing the handler for a 'Put' endpoint,+-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'+-- and 'Servant.API.Post.Post', the handler code runs in the+-- @EitherT (Int, String) IO@ monad, where the 'Int' represents+-- the status code and the 'String' a message, returned in case of+-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'+-- to quickly fail if some conditions are not met.+--+-- If successfully returning a value, we just require that its type has+-- a 'ToJSON' instance and servant takes care of encoding it for you,+-- yielding status code 200 along the way.+instance ToJSON a => HasServer (Put a) where+  type Server (Put a) = EitherT (Int, String) IO a++  route Proxy action request respond+    | null (pathInfo request) && requestMethod request == methodPut = do+        e <- runEitherT action+        respond . succeedWith $ case e of+          Right out ->+            responseLBS ok200 [("Content-Type", "application/json")] (encode out)+          Left (status, message) ->+            responseLBS (mkStatus status (cs message)) [] (cs message)+    | null (pathInfo request) && requestMethod request /= methodPut =+        respond $ failWith WrongMethod++    | otherwise = respond $ failWith NotFound++-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,+-- this automatically requires your server-side handler to be a function+-- that takes an argument of type @'Maybe' 'Text'@.+--+-- This lets servant worry about looking it up in the query string+-- and turning it into a value of the type you specify, enclosed+-- in 'Maybe', because it may not be there and servant would then+-- hand you 'Nothing'.+--+-- You can control how it'll be converted from 'Text' to your type+-- by simply providing an instance of 'FromText' for your type.+--+-- Example:+--+-- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book]+-- >+-- > server :: Server MyApi+-- > server = getBooksBy+-- >   where getBooksBy :: Maybe Text -> EitherT (Int, String) IO [Book]+-- >         getBooksBy Nothing       = ...return all books...+-- >         getBooksBy (Just author) = ...return books by the given author...+instance (KnownSymbol sym, FromText a, HasServer sublayout)+      => HasServer (QueryParam sym a :> sublayout) where++  type Server (QueryParam sym a :> sublayout) =+    Maybe a -> Server sublayout++  route Proxy subserver request respond = do+    let querytext = parseQueryText $ rawQueryString request+        param =+          case lookup paramname querytext of+            Nothing       -> Nothing -- param absent from the query string+            Just Nothing  -> Nothing -- param present with no value -> Nothing+            Just (Just v) -> fromText v -- if present, we try to convert to+                                        -- the right type++    route (Proxy :: Proxy sublayout) (subserver param) request respond++    where paramname = cs $ symbolVal (Proxy :: Proxy sym)++-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,+-- this automatically requires your server-side handler to be a function+-- that takes an argument of type @['Text']@.+--+-- This lets servant worry about looking up 0 or more values in the query string+-- associated to @authors@ and turning each of them into a value of+-- the type you specify.+--+-- You can control how the individual values are converted from 'Text' to your type+-- by simply providing an instance of 'FromText' for your type.+--+-- Example:+--+-- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book]+-- >+-- > server :: Server MyApi+-- > server = getBooksBy+-- >   where getBooksBy :: [Text] -> EitherT (Int, String) IO [Book]+-- >         getBooksBy authors = ...return all books by these authors...+instance (KnownSymbol sym, FromText a, HasServer sublayout)+      => HasServer (QueryParams sym a :> sublayout) where++  type Server (QueryParams sym a :> sublayout) =+    [a] -> Server sublayout++  route Proxy subserver request respond = do+    let querytext = parseQueryText $ rawQueryString request+        -- if sym is "foo", we look for query string parameters+        -- named "foo" or "foo[]" and call fromText on the+        -- corresponding values+        parameters = filter looksLikeParam querytext+        values = catMaybes $ map (convert . snd) parameters++    route (Proxy :: Proxy sublayout) (subserver values) request respond++    where paramname = cs $ symbolVal (Proxy :: Proxy sym)+          looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")+          convert Nothing = Nothing+          convert (Just v) = fromText v++-- | If you use @'QueryFlag' "published"@ in one of the endpoints for your API,+-- this automatically requires your server-side handler to be a function+-- that takes an argument of type 'Bool'.+--+-- Example:+--+-- > type MyApi = "books" :> QueryFlag "published" :> Get [Book]+-- >+-- > server :: Server MyApi+-- > server = getBooks+-- >   where getBooks :: Bool -> EitherT (Int, String) IO [Book]+-- >         getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...+instance (KnownSymbol sym, HasServer sublayout)+      => HasServer (QueryFlag sym :> sublayout) where++  type Server (QueryFlag sym :> sublayout) =+    Bool -> Server sublayout++  route Proxy subserver request respond = do+    let querytext = parseQueryText $ rawQueryString request+        param = case lookup paramname querytext of+          Just Nothing  -> True  -- param is there, with no value+          Just (Just v) -> examine v -- param with a value+          Nothing       -> False -- param not in the query string++    route (Proxy :: Proxy sublayout) (subserver param) request respond++    where paramname = cs $ symbolVal (Proxy :: Proxy sym)+          examine v | v == "true" || v == "1" || v == "" = True+                    | otherwise = False++-- | Just pass the request to the underlying application and serve its response.+--+-- Example:+--+-- > type MyApi = "images" :> Raw+-- >+-- > server :: Server MyApi+-- > server = serveDirectory "/var/www/images"+instance HasServer Raw where+  type Server Raw = Application+  route Proxy rawApplication request respond =+    rawApplication request (respond . succeedWith)++-- | If you use 'ReqBody' in one of the endpoints for your API,+-- this automatically requires your server-side handler to be a function+-- that takes an argument of the type specified by 'ReqBody'.+-- This lets servant worry about extracting it from the request and turning+-- it into a value of the type you specify.+--+-- All it asks is for a 'FromJSON' instance.+--+-- Example:+--+-- > type MyApi = "books" :> ReqBody Book :> Post Book+-- >+-- > server :: Server MyApi+-- > server = postBook+-- >   where postBook :: Book -> EitherT (Int, String) IO Book+-- >         postBook book = ...insert into your db...+instance (FromJSON a, HasServer sublayout)+      => HasServer (ReqBody a :> sublayout) where++  type Server (ReqBody a :> sublayout) =+    a -> Server sublayout++  route Proxy subserver request respond = do+    mrqbody <- decode' <$> lazyRequestBody request+    case mrqbody of+      Nothing -> respond $ failWith InvalidBody+      Just v  -> route (Proxy :: Proxy sublayout) (subserver v) request respond++-- | Make sure the incoming request starts with @"/path"@, strip it and+-- pass the rest of the request path to @sublayout@.+instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where+  type Server (path :> sublayout) = Server sublayout+  route Proxy subserver request respond = case pathInfo request of+    (first : rest)+      | first == cs (symbolVal proxyPath)+      -> route (Proxy :: Proxy sublayout) subserver request{+           pathInfo = rest+         } respond+    _ -> respond $ failWith NotFound++    where proxyPath = Proxy :: Proxy path
+ src/Servant/Utils/StaticFiles.hs view
@@ -0,0 +1,36 @@+-- | This module defines a sever-side handler that lets you serve static files.+--+-- - 'serveDirectory' lets you serve anything that lives under a particular+--   directory on your filesystem.+module Servant.Utils.StaticFiles (+  serveDirectory,+ ) where++import Filesystem.Path.CurrentOS (decodeString)+import Network.Wai.Application.Static+import Servant.API.Raw+import Servant.Server.Internal++-- | Serve anything under the specified directory as a 'Raw' endpoint.+--+-- @+-- type MyApi = "static" :> Raw+--+-- server :: Server MyApi+-- server = serveDirectory "\/var\/www"+-- @+--+-- would capture any request to @\/static\/\<something>@ and look for+-- @\<something>@ under @\/var\/www@.+--+-- It will do its best to guess the MIME type for that file, based on the extension,+-- and send an appropriate /Content-Type/ header if possible.+--+-- If your goal is to serve HTML, CSS and Javascript files that use the rest of the API+-- as a webapp backend, you will most likely not want the static files to be hidden+-- behind a /\/static\// prefix. In that case, remember to put the 'serveDirectory'+-- handler in the last position, because /servant/ will try to match the handlers+-- in order.+serveDirectory :: FilePath -> Server Raw+serveDirectory documentRoot =+  staticApp (defaultFileServerSettings (decodeString (documentRoot ++ "/")))
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}