├── .gitignore ├── Setup.hs ├── test └── Spec.hs ├── app └── Main.hs ├── stack.yaml.lock ├── LICENSE ├── src ├── GeneralAuthentication.hs ├── JsonOutput.hs ├── CustomOutput.hs ├── HeaderInput.hs ├── PostData.hs ├── TypedUrlParams.hs ├── ErrorHandling.hs ├── CustomPostData.hs ├── AnotherMonad.hs ├── HtmlContent.hs ├── UrlParams.hs ├── MultipartData.hs ├── BasicAuthentication.hs ├── CustomPostMultipleFormats.hs ├── SwaggerDocGeneration.hs ├── HeaderOutput.hs ├── CustomPostFormat.hs └── HelloWorld.hs ├── servant-examples.cabal ├── README.md └── stack.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified SwaggerDocGeneration as T1 4 | 5 | main :: IO () 6 | main = T1.mainFn 7 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 532177 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/20.yaml 11 | sha256: 0e14ba5603f01e8496e8984fd84b545a012ca723f51a098c6c9d3694e404dc6d 12 | original: lts-16.20 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /src/GeneralAuthentication.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | {-# LANGUAGE TypeFamilies #-} 7 | 8 | module GeneralAuthentication where 9 | 10 | import Servant ( PlainText 11 | , AuthProtect 12 | , Get 13 | , Context((:.), EmptyContext) 14 | , Proxy(..) 15 | , type (:>) -- Syntax for importing type operator 16 | , type (:<|>) 17 | , (:<|>)(..) 18 | ) 19 | import Servant.Server (Handler, Server, Application, serveWithContext) 20 | import Network.Wai.Handler.Warp (run) 21 | import Network.Wai (Request) 22 | 23 | import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData, mkAuthHandler) 24 | 25 | data User = User 26 | 27 | lookupUser :: Request -> Handler User 28 | lookupUser = undefined -- Actual authenticating function 29 | 30 | authHandler :: AuthHandler Request User 31 | authHandler = mkAuthHandler lookupUser 32 | 33 | handlerName :: User -> Handler String 34 | handlerName _ = return "sras" 35 | 36 | handlerAge :: Handler String 37 | handlerAge = return "30" 38 | 39 | type instance AuthServerData (AuthProtect "Example Auth Realm") = User 40 | 41 | type ServantType = AuthProtect "Example Auth Realm" :> "person" :> "name" :> Get '[PlainText] String 42 | :<|> "person" :> "age" :> Get '[PlainText] String 43 | 44 | server :: Server ServantType 45 | server = handlerName :<|> handlerAge 46 | 47 | app :: Application 48 | app = serveWithContext (Proxy :: Proxy ServantType) ctx server 49 | where 50 | ctx = authHandler :. EmptyContext 51 | 52 | mainFn :: IO () 53 | mainFn = run 4000 app 54 | -------------------------------------------------------------------------------- /src/JsonOutput.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module JsonOutput where 8 | 9 | import Servant ( Get 10 | , JSON 11 | , Proxy(..) 12 | , type (:>) -- Syntax for importing type operator 13 | ) 14 | import Servant.Server (Handler, Server, Application, serve) 15 | import Network.Wai.Handler.Warp (run) 16 | import Data.Aeson (object, ToJSON(..), (.=)) 17 | 18 | -- In this example we see how to output 19 | -- json encoded data from the endpoints. 20 | -- 21 | 22 | data Payload = Payload String String -- This is our json payload that we will output from the endpoint. 23 | 24 | instance ToJSON Payload where 25 | toJSON (Payload itemOne itemTwo) = object ["itemOne" .= toJSON itemOne, "itemTwo" .= toJSON itemTwo] 26 | 27 | type ServantType = "payload" :> Get '[JSON] Payload 28 | 29 | handlerPayload :: Handler Payload 30 | handlerPayload = return $ Payload "itemOne" "itemTwo" 31 | 32 | server :: Server ServantType 33 | server = handlerPayload 34 | 35 | app :: Application 36 | app = serve (Proxy :: Proxy ServantType) server 37 | 38 | mainFn :: IO () 39 | mainFn = run 4000 app 40 | 41 | -- curl -v http://127.0.0.1:4000/payload 42 | -- * Trying 127.0.0.1... 43 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 44 | -- > GET /payload HTTP/1.1 45 | -- > Host: 127.0.0.1:4000 46 | -- > User-Agent: curl/7.47.0 47 | -- > Accept: */* 48 | -- > 49 | -- < HTTP/1.1 200 OK 50 | -- < Transfer-Encoding: chunked 51 | -- < Date: Sun, 22 Jul 2018 08:57:34 GMT 52 | -- < Server: Warp/3.2.23 53 | -- < Content-Type: application/json;charset=utf-8 54 | -- < 55 | -- * Connection #0 to host 127.0.0.1 left intact 56 | -- {"itemTwo":"itemTwo","itemOne":"itemOne"} 57 | -------------------------------------------------------------------------------- /src/CustomOutput.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | 8 | module CustomOutput where 9 | 10 | import Servant ( Get 11 | , MimeRender(..) 12 | , Accept(..) 13 | , Proxy(..) 14 | , type (:>) -- Syntax for importing type operator 15 | ) 16 | import Servant.Server (Handler, Server, Application, serve) 17 | import Network.Wai.Handler.Warp (run) 18 | import qualified Data.Text.Lazy as T (pack) 19 | import qualified Data.Text.Lazy.Encoding as TE (encodeUtf8) 20 | 21 | -- In this example we see how to output 22 | -- data using a custom encoding. 23 | 24 | data ANewFormat 25 | 26 | instance Accept ANewFormat where -- Accept instance is required for output encoding as well. 27 | contentType _ = "text/a-new-format" 28 | 29 | instance MimeRender ANewFormat String where -- This is where the actual encoding happens 30 | mimeRender _ s = TE.encodeUtf8 $ T.pack ("ANewFormat:" ++ s) 31 | 32 | type ServantType = "name" :> Get '[ANewFormat] String 33 | 34 | handlerName :: Handler String 35 | handlerName = return "sras" 36 | 37 | server :: Server ServantType 38 | server = handlerName 39 | 40 | app :: Application 41 | app = serve (Proxy :: Proxy ServantType) server 42 | 43 | mainFn :: IO () 44 | mainFn = run 4000 app 45 | 46 | -- $ curl -v http://localhost:4000/name 47 | -- * Trying 127.0.0.1... 48 | -- * Connected to localhost (127.0.0.1) port 4000 (#0) 49 | -- > GET /name HTTP/1.1 50 | -- > Host: localhost:4000 51 | -- > User-Agent: curl/7.47.0 52 | -- > Accept: */* 53 | -- > 54 | -- < HTTP/1.1 200 OK 55 | -- < Transfer-Encoding: chunked 56 | -- < Date: Sun, 22 Jul 2018 07:22:10 GMT 57 | -- < Server: Warp/3.2.23 58 | -- < Content-Type: text/a-new-format 59 | -- < 60 | -- * Connection #0 to host localhost left intact 61 | -- ANewFormat:sras 62 | -------------------------------------------------------------------------------- /servant-examples.cabal: -------------------------------------------------------------------------------- 1 | name: servant-examples 2 | version: 0.1.0.0 3 | -- synopsis: 4 | -- description: 5 | homepage: https://github.com/githubuser/servant-examples#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Author name here 9 | maintainer: example@example.com 10 | copyright: 2017 Author name here 11 | category: Web 12 | build-type: Simple 13 | extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | ghc-options: -Wall 18 | hs-source-dirs: src 19 | exposed-modules: HelloWorld 20 | , HtmlContent 21 | , UrlParams 22 | , AnotherMonad 23 | , SwaggerDocGeneration 24 | build-depends: base >= 4.7 && < 5 25 | , servant 26 | , servant-server 27 | , servant-swagger 28 | , swagger2 29 | , text 30 | , wai 31 | , aeson 32 | , warp 33 | , bytestring 34 | , mtl 35 | , transformers 36 | default-language: Haskell2010 37 | 38 | executable servant-examples-exe 39 | hs-source-dirs: app 40 | main-is: Main.hs 41 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 42 | build-depends: base 43 | , servant-examples 44 | default-language: Haskell2010 45 | 46 | test-suite servant-examples-test 47 | type: exitcode-stdio-1.0 48 | hs-source-dirs: test 49 | main-is: Spec.hs 50 | build-depends: base 51 | , servant-examples 52 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 53 | default-language: Haskell2010 54 | 55 | source-repository head 56 | type: git 57 | location: https://github.com/githubuser/servant-examples 58 | -------------------------------------------------------------------------------- /src/HeaderInput.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module HeaderInput where 8 | 9 | import Servant ( Header 10 | , PlainText 11 | , Get 12 | , Proxy(..) 13 | , type (:>) -- Syntax for importing type operator 14 | ) 15 | import Servant.Server (Handler, Server, Application, serve) 16 | import Network.Wai.Handler.Warp (run) 17 | 18 | type ServantType = "name" :> Header "CustomHeader" String :> Get '[PlainText] String 19 | 20 | server :: Server ServantType 21 | server = handlerHeaderName 22 | 23 | handlerHeaderName :: Maybe String -> Handler String 24 | handlerHeaderName customHeaderValue = case customHeaderValue of 25 | Just name -> return name 26 | Nothing -> return "No header" 27 | 28 | app :: Application 29 | app = serve (Proxy :: Proxy ServantType) server 30 | 31 | mainFn :: IO () 32 | mainFn = run 4000 app 33 | 34 | -- curl -v -H "CustomHeader:Header Value" http://127.0.0.1:4000/name 35 | -- * Trying 127.0.0.1... 36 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 37 | -- > GET /name HTTP/1.1 38 | -- > Host: 127.0.0.1:4000 39 | -- > User-Agent: curl/7.47.0 40 | -- > Accept: */* 41 | -- > CustomHeader:Header Value 42 | -- > 43 | -- < HTTP/1.1 200 OK 44 | -- < Transfer-Encoding: chunked 45 | -- < Date: Sun, 22 Jul 2018 08:41:15 GMT 46 | -- < Server: Warp/3.2.23 47 | -- < Content-Type: text/plain;charset=utf-8 48 | -- < 49 | -- * Connection #0 to host 127.0.0.1 left intact 50 | -- Header Value 51 | -- 52 | -- curl -v http://127.0.0.1:4000/name 53 | -- * Trying 127.0.0.1... 54 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 55 | -- > GET /name HTTP/1.1 56 | -- > Host: 127.0.0.1:4000 57 | -- > User-Agent: curl/7.47.0 58 | -- > Accept: */* 59 | -- > 60 | -- < HTTP/1.1 200 OK 61 | -- < Transfer-Encoding: chunked 62 | -- < Date: Sun, 22 Jul 2018 08:42:40 GMT 63 | -- < Server: Warp/3.2.23 64 | -- < Content-Type: text/plain;charset=utf-8 65 | -- < 66 | -- * Connection #0 to host 127.0.0.1 left intact 67 | -- No header 68 | -------------------------------------------------------------------------------- /src/PostData.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module PostData where 8 | 9 | import Servant ( PlainText 10 | , JSON 11 | 12 | , Get 13 | , Post 14 | , ReqBody 15 | , Proxy(..) 16 | , type (:>) -- Syntax for importing type operator 17 | , type (:<|>) 18 | , (:<|>)(..) 19 | ) 20 | import Servant.Server (Handler, Server, Application, serve) 21 | import Network.Wai.Handler.Warp (run) 22 | 23 | -- In this example, we see how we can accept 24 | -- input in the request body, say a Json payload. 25 | 26 | handlerName :: String -> Handler String 27 | handlerName nameIn = return nameIn -- Just output back the input string value 28 | 29 | handlerAge :: Handler String 30 | handlerAge = return "30" 31 | 32 | -- In the code below, look at the `ReqBody '[JSON] String` part. 33 | -- This is what enables our endpoint to recieve a String encoded as JSON 34 | -- in the body of the request. 35 | -- 36 | type ServantType = "name" :> ReqBody '[JSON] String :> Post '[PlainText] String 37 | :<|> "age" :> Get '[PlainText] String 38 | 39 | server :: Server ServantType 40 | server = handlerName :<|> handlerAge 41 | 42 | app :: Application 43 | app = serve (Proxy :: Proxy ServantType) server 44 | 45 | mainFn :: IO () 46 | mainFn = run 4000 app 47 | 48 | -- Output 49 | -- curl -v -H "Content-Type:application/json" -d "\"John\"" http://127.0.0.1:4000/name 50 | -- * Trying 127.0.0.1... 51 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 52 | -- > POST /name HTTP/1.1 53 | -- > Host: 127.0.0.1:4000 54 | -- > User-Agent: curl/7.47.0 55 | -- > Accept: */* 56 | -- > Content-Type:application/json 57 | -- > Content-Length: 6 58 | -- > 59 | -- * upload completely sent off: 6 out of 6 bytes 60 | -- < HTTP/1.1 200 OK 61 | -- < Transfer-Encoding: chunked 62 | -- < Date: Tue, 10 Apr 2018 16:27:57 GMT 63 | -- < Server: Warp/3.2.13 64 | -- < Content-Type: text/plain;charset=utf-8 65 | -- < 66 | -- * Connection #0 to host 127.0.0.1 left intact 67 | -- John 68 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # servant-examples 2 | 3 | This repo hosts a bunch of modules that show how to do anything using Haskell's Servant web framework. 4 | The modules here are 5 | 6 | 1. Self contained. Each module exports a complete servant web application. You can just load the indvidual modules 7 | using GHCI and call the 'mainFn' function to start the server. 8 | 9 | 2. Consise. Each module only contain stuff that is absolutly required to show one and only one thing. 10 | 11 | 3. Each module also contains a sample output from a curl command that communicates with the server in that module 12 | that demostrates the respective behavior. 13 | 14 | This is only meant as a quick refresher on how to do anything using Servant, and not an in depth tutorial on 15 | its workings. Following is a listing of the modules and a short summary that describes each 16 | 17 | 1. HelloWorld.hs -- This is a minimal Servant server with two GET endpoints that respond in plain text. 18 | 2. HtmlContent.h -- This module shows how you can send HTML content with an "text/html" content type header. 19 | 3. JsonOutput.hs -- Shows how to output Json. 20 | 4. CustomOutput.hs -- Shows how to output data in a user defined format. 21 | 5. PostData.hs -- Shows how an endpoint can accept json content in request body. 22 | 6. CustomPostData.hs -- Shows how an endpoint can accept user defined data in a json format in request body. 23 | 7. CustomPostFormat.hs -- Shows how an endpoint can accept data in request body in a user defined format. 24 | 8. CustomPostMultipleFormats.hs -- Shows how the same endpoint can accept data in more than one format. 25 | 9. UrlParams.hs -- Shows how to accept query params in url. 26 | 10. TypedUrlParams.hs -- Shows how to accept values of custom types via url parameters. 27 | 11. AnotherMonad.hs -- Shows how to make your handlers run in a custom monad. 28 | 12. BasicAuthentication.hs -- Shows how to protect your endpoints using HTTP Basic Authentication. 29 | 13. GeneralAuthentication.hs -- Shows how to protect your endpoints using custom authentication method with authentication data derived from the wai Request. 30 | 14. ErrorHandling.hs -- Show how to throw errors from Servant handlers. 31 | 15. HeaderInput.hs -- Shows how to get values from HTTP headers in your handler functions. 32 | 16. HeaderOutput.hs -- Shows how to add HTTP headers to your response from your handlers. 33 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-16.20 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - . 40 | # Dependency packages to be pulled from upstream that are not in the resolver 41 | # (e.g., acme-missiles-0.3) 42 | extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | flags: {} 46 | 47 | # Extra package databases containing global packages 48 | extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=1.5" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor 67 | -------------------------------------------------------------------------------- /src/TypedUrlParams.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module TypedUrlParams where 8 | 9 | import Servant ( QueryParam 10 | , PlainText 11 | , FromHttpApiData(..) 12 | , Get 13 | , Proxy(..) 14 | , type (:>) -- Syntax for importing type operator 15 | , type (:<|>) 16 | , (:<|>)(..) 17 | ) 18 | import Servant.Server (Handler, Server, Application, serve) 19 | import Network.Wai.Handler.Warp (run) 20 | import Data.Text as T (unpack) 21 | 22 | -- In this example we look at how 23 | -- we can recieve parameters via 24 | -- url and have them automatically 25 | -- converted to value of a custom type. 26 | 27 | data Wrapper = Wrapper String -- This is our custom type. 28 | 29 | instance FromHttpApiData Wrapper where -- This the the instance that enables the auto conversion from Text in a url to the value of a custom type that the handler expects. 30 | parseQueryParam i = Right (Wrapper $ T.unpack i) 31 | 32 | handlerName :: Maybe Wrapper -> Handler String -- The handler. Look at the first argument, it is of the Wrapper type (our custom type). 33 | handlerName nameIn = case nameIn of 34 | Just (Wrapper name) -> return name 35 | Nothing -> return "Anonymous" 36 | 37 | handlerAge :: Handler String 38 | handlerAge = return "30" 39 | 40 | type ServantType = "name" :> QueryParam "input" Wrapper :> Get '[PlainText] String -- Look at the Wrapper type mentioned in `QueryParam "input" Wrapper`. 41 | :<|> "age" :> Get '[PlainText] String 42 | 43 | server :: Server ServantType 44 | server = handlerName :<|> handlerAge 45 | 46 | app :: Application 47 | app = serve (Proxy :: Proxy ServantType) server 48 | 49 | mainFn :: IO () 50 | mainFn = run 4000 app 51 | 52 | -- Output 53 | -- 54 | -- curl -v http://127.0.0.1:4000/name?input=John 55 | -- * Trying 127.0.0.1... 56 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 57 | -- > GET /name?input=John HTTP/1.1 58 | -- > Host: 127.0.0.1:4000 59 | -- > User-Agent: curl/7.47.0 60 | -- > Accept: */* 61 | -- > 62 | -- < HTTP/1.1 200 OK 63 | -- < Transfer-Encoding: chunked 64 | -- < Date: Tue, 10 Apr 2018 15:11:36 GMT 65 | -- < Server: Warp/3.2.13 66 | -- < Content-Type: text/plain;charset=utf-8 67 | -- < 68 | -- * Connection #0 to host 127.0.0.1 left intact 69 | -- John 70 | -------------------------------------------------------------------------------- /src/ErrorHandling.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module ErrorHandling where 8 | 9 | import Servant ( PlainText 10 | , Get 11 | , Proxy(..) 12 | , type (:>) -- Syntax for importing type operator 13 | , type (:<|>) 14 | , (:<|>)(..) 15 | ) 16 | import Servant.Server (Handler, Server, Application, serve) 17 | import Network.Wai.Handler.Warp (run) 18 | import Control.Monad.Error.Class (MonadError(throwError)) 19 | 20 | 21 | import Servant.Server.Internal.ServantErr 22 | -- ^^ This is the module from which the errors that we can throw are imported. 23 | -- For some reason this is a not really mentioned in the documentation and is marked an Internal module. 24 | -- To see all the possible types of errors we can throw or how to make our custom errors, refer the following. 25 | -- http://hackage.haskell.org/package/servant-server-0.14.1/docs/Servant-Server-Internal-ServantErr.html 26 | 27 | handlerWithError :: Handler String 28 | handlerWithError = if True -- If there was an error ? 29 | then throwError err500 -- We throw error here. Read more about it below. 30 | else return "sras" -- else return result. 31 | 32 | -- The function err500 is part of Servant and returns a value of type 'ServantErr'. 33 | -- The throwError function is not part of Servant library. 34 | -- We can use it to throw errors of type `ServantErr` in the `Handler` monad 35 | -- only because of the typeclass instance `MonadError ServantErr Handler`. 36 | -- You can see it in the documentation page. 37 | -- http://hackage.haskell.org/package/servant-server-0.14.1/docs/Servant-Server-Internal-ServantErr.html 38 | 39 | handlerAge :: Handler String 40 | handlerAge = return "30" 41 | 42 | type ServantType = "person" :> "name" :> Get '[PlainText] String 43 | :<|> "person" :> "age" :> Get '[PlainText] String 44 | 45 | 46 | server :: Server ServantType 47 | server = handlerWithError :<|> handlerAge 48 | 49 | app :: Application 50 | app = serve (Proxy :: Proxy ServantType) server 51 | 52 | mainFn :: IO () 53 | mainFn = run 4000 app 54 | -- 55 | -- curl -v http://localhost:4000/person/name 56 | -- * Trying 127.0.0.1... 57 | -- * Connected to localhost (127.0.0.1) port 4000 (#0) 58 | -- > GET /person/name HTTP/1.1 59 | -- > Host: localhost:4000 60 | -- > User-Agent: curl/7.47.0 61 | -- > Accept: */* 62 | -- > 63 | -- < HTTP/1.1 500 Internal Server Error 64 | -- < Transfer-Encoding: chunked 65 | -- < Date: Sat, 21 Jul 2018 16:59:19 GMT 66 | -- < Server: Warp/3.2.23 67 | -- < 68 | -- * Connection #0 to host localhost left intact 69 | -------------------------------------------------------------------------------- /src/CustomPostData.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module CustomPostData where 8 | 9 | import Servant ( PlainText 10 | , JSON 11 | , Get 12 | , Post 13 | , ReqBody 14 | , Proxy(..) 15 | , type (:>) -- Syntax for importing type operator 16 | , type (:<|>) 17 | , (:<|>)(..) 18 | ) 19 | import Servant.Server (Handler, Server, Application, serve) 20 | import Network.Wai.Handler.Warp (run) 21 | import Data.Aeson (FromJSON(..)) 22 | 23 | -- In this example, we see how we can recive data in the request 24 | -- body in a custom format. 25 | 26 | data NameWrapper = NameWrapper { getName :: String } -- This the type that our handler expects. 27 | 28 | -- In the code below, look at the `ReqBody '[JSON] NameWrapper` part. 29 | -- This (along with the FromJSON instance) is what enables our endpoint to recieve a value of type 30 | -- `NameWrapper` encoded as JSON, in the body of the request. 31 | -- 32 | type ServantType = "name" :> ReqBody '[JSON] NameWrapper :> Post '[PlainText] String 33 | :<|> "age" :> Get '[PlainText] String 34 | 35 | -- To make this work, NameWrapper should have an instance of FromJSON. This is becasuse the 36 | -- built in 'Accept' and 'MimeUnrender' instances for 'JSON' type expects FromJSON and ToJSON 37 | -- instances for the concerned types. 38 | -- 39 | instance FromJSON NameWrapper where 40 | parseJSON v = NameWrapper <$> (parseJSON v) 41 | 42 | handlerName :: NameWrapper -> Handler String 43 | handlerName (NameWrapper nameIn) = return nameIn -- Just output back the input string value 44 | 45 | handlerAge :: Handler String 46 | handlerAge = return "30" 47 | 48 | server :: Server ServantType 49 | server = handlerName :<|> handlerAge 50 | 51 | app :: Application 52 | app = serve (Proxy :: Proxy ServantType) server 53 | 54 | mainFn :: IO () 55 | mainFn = run 4000 app 56 | 57 | -- Output 58 | -- curl -v -H "Content-Type:application/json" -d "\"John\"" http://127.0.0.1:4000/name 59 | -- * Trying 127.0.0.1... 60 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 61 | -- > POST /name HTTP/1.1 62 | -- > Host: 127.0.0.1:4000 63 | -- > User-Agent: curl/7.47.0 64 | -- > Accept: */* 65 | -- > Content-Type:application/json 66 | -- > Content-Length: 6 67 | -- > 68 | -- * upload completely sent off: 6 out of 6 bytes 69 | -- < HTTP/1.1 200 OK 70 | -- < Transfer-Encoding: chunked 71 | -- < Date: Tue, 10 Apr 2018 16:27:57 GMT 72 | -- < Server: Warp/3.2.13 73 | -- < Content-Type: text/plain;charset=utf-8 74 | -- < 75 | -- * Connection #0 to host 127.0.0.1 left intact 76 | -- John 77 | -------------------------------------------------------------------------------- /src/AnotherMonad.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module AnotherMonad where 8 | 9 | import Servant ( PlainText 10 | , Get 11 | , ServerT 12 | , hoistServer -- Servant function to make a custom monad with with Servant. 13 | , Proxy(..) 14 | , type (:>) -- Syntax for importing type operator 15 | , type (:<|>) 16 | , (:<|>)(..) 17 | ) 18 | import Servant.Server (Handler, Application, serve) 19 | import Network.Wai.Handler.Warp (run) 20 | import Control.Monad.Reader (runReader, Reader) 21 | 22 | type MyServerType = "person" :> "name" :> Get '[PlainText] String -- The endpoint types does not have to change to accomodate a different monad 23 | :<|> "person" :> "age" :> Get '[PlainText] String 24 | 25 | handlerName :: Reader String String -- These two are our two handlers. But instead of returning a `Handler`, it returns a Reader. We will see how these handlers can be made to work with Servant. 26 | handlerName = return "sras" 27 | 28 | handlerAge :: Reader String String 29 | handlerAge = return "10" 30 | 31 | api :: Proxy MyServerType 32 | api = Proxy 33 | 34 | readerServer :: ServerT MyServerType (Reader String) -- Endpoints are combined together as before. Here the endpoint types are still our custom monad. The Reader monad. 35 | readerServer = handlerName :<|> handlerAge -- At the next step, we will convert this consolidated server, into something that Servant can handle. 36 | 37 | handlerServer :: ServerT MyServerType Handler -- This code is the important part where we convert a value of type `ServerT MyServerType (Reader String)` to a value of type `ServerT MyServerType Handler`, using the hoistServer function from Servant. 38 | handlerServer = hoistServer api readerToHandler readerServer 39 | where 40 | readerToHandler :: Reader String x -> Handler x -- This code just extracts the value from our custom monads (Reader here) and wraps it in the Handler monad. 41 | readerToHandler r = return $ runReader r "reader env" 42 | 43 | app :: Application 44 | app = serve api handlerServer 45 | 46 | mainFn :: IO () 47 | mainFn = run 4000 app 48 | 49 | -- curl -v http://localhost:4000/person/name 50 | -- * Trying 127.0.0.1... 51 | -- * Connected to localhost (127.0.0.1) port 4000 (#0) 52 | -- > GET /person/name HTTP/1.1 53 | -- > Host: localhost:4000 54 | -- > User-Agent: curl/7.47.0 55 | -- > Accept: */* 56 | -- > 57 | -- < HTTP/1.1 200 OK 58 | -- < Transfer-Encoding: chunked 59 | -- < Date: Sat, 21 Jul 2018 17:00:44 GMT 60 | -- < Server: Warp/3.2.23 61 | -- < Content-Type: text/plain;charset=utf-8 62 | -- < 63 | -- * Connection #0 to host localhost left intact 64 | -- sras 65 | -------------------------------------------------------------------------------- /src/HtmlContent.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | 8 | module HtmlContent where 9 | 10 | import Servant ( Get 11 | , Proxy(..) 12 | , type (:>) -- Syntax for importing type operator 13 | , type (:<|>) 14 | , (:<|>)(..) 15 | , Accept(..) 16 | , MimeRender(..) 17 | ) 18 | import Servant.Server (Handler, Server, Application, serve) 19 | import Network.Wai.Handler.Warp (run) 20 | import Data.ByteString.Lazy.Char8 as C (pack) 21 | 22 | -- In this example, we add an Html type and make endpoints 23 | -- with this content type return a content type header with 24 | -- "text/html" in it. 25 | 26 | data HTML -- Here is our HTML type that we will use in the type of the endpoint. 27 | -- We don't need a constructor here since we ll ever have to deal with a value of this type. 28 | 29 | instance Accept HTML where -- This instance is what makes the endpoints with this content type 30 | contentType _ = "text/html" -- return content with a content type header with "text/html" in it. 31 | 32 | instance MimeRender HTML String where -- This instance where we define how a value of type string is 33 | mimeRender _ val = C.pack val -- is encoded as an html value. Note that we are not converting 34 | -- the string to an value of type HTML, but just to a Bytestring that 35 | -- represents the HTML encoding. As I said earlier, we won't ever 36 | -- have to deal with a value of type HTML 37 | 38 | instance MimeRender HTML Int where -- Same as before. This instance defines how an Int will be converted 39 | mimeRender _ val = C.pack $ show $ val -- to a bytestring for endpoints with HTML content type. 40 | 41 | type ServantType = "name" :> Get '[HTML] String 42 | :<|> "age" :> Get '[HTML] Int 43 | 44 | handlerName :: Handler String 45 | handlerName = return "sras" 46 | 47 | handlerAge :: Handler Int 48 | handlerAge = return 30 49 | 50 | server :: Server ServantType 51 | server = handlerName :<|> handlerAge 52 | 53 | app :: Application 54 | app = serve (Proxy :: Proxy ServantType) server 55 | 56 | mainFn :: IO () 57 | mainFn = run 4000 app 58 | 59 | -- Now let us see how the app behaves 60 | -- 61 | -- 62 | -- curl -v 127.0.0.1:4000/age 63 | -- * Trying 127.0.0.1... 64 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 65 | -- > GET /age HTTP/1.1 66 | -- > Host: 127.0.0.1:4000 67 | -- > User-Agent: curl/7.47.0 68 | -- > Accept: */* 69 | -- > 70 | -- < HTTP/1.1 200 OK 71 | -- < Transfer-Encoding: chunked 72 | -- < Date: Sun, 12 Nov 2017 13:16:50 GMT 73 | -- < Server: Warp/3.2.13 74 | -- < Content-Type: text/html 75 | -- < 76 | -- * Connection #0 to host 127.0.0.1 left intact 77 | -- 30 78 | -------------------------------------------------------------------------------- /src/UrlParams.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module UrlParams where 8 | 9 | import Servant ( QueryParam 10 | , Capture 11 | , PlainText 12 | , Get 13 | , Proxy(..) 14 | , type (:>) -- Syntax for importing type operator 15 | , type (:<|>) 16 | , (:<|>)(..) 17 | ) 18 | import Servant.Server (Handler, Server, Application, serve) 19 | import Network.Wai.Handler.Warp (run) 20 | 21 | -- In this example we look at how 22 | -- we can recieve parameters via 23 | -- url. Here we create an endpoint 24 | -- that echos back the name we pass 25 | -- as a url parameter 26 | 27 | -- Right below is our handler for the route 28 | -- 29 | -- `/name?input=` 30 | -- 31 | -- The type of this route is `"name" :> QueryParam "input" String :> Get '[PlainText] String` 32 | -- The QueryParam segment declares the argument we expect in the url 33 | -- `QueryParam "input" String` means we expect a value in "input" key 34 | -- and we need expect it as a String in the handler. 35 | -- This will be passed on to our handler function as an argument. 36 | -- You can also see that it is a Maybe type in handler since 37 | -- we also need to handle cases where the route is accessed 38 | -- without the specific parameter 39 | -- 40 | -- We have another route below that is of the segmented format. 41 | -- For example /name/john. 42 | -- 43 | 44 | handlerName :: Maybe String -> Handler String 45 | handlerName nameIn = case nameIn of 46 | Just name -> return name 47 | Nothing -> return "Anonymous" 48 | 49 | handlerRequiredName :: String -> Handler String 50 | handlerRequiredName nameIn = return nameIn 51 | 52 | type ServantType = "name" :> QueryParam "input" String :> Get '[PlainText] String -- /name?input=john 53 | :<|> "name" :> Capture "input" String :> Get '[PlainText] String -- /name/John 54 | 55 | server :: Server ServantType 56 | server = handlerName :<|> handlerRequiredName 57 | 58 | app :: Application 59 | app = serve (Proxy :: Proxy ServantType) server 60 | 61 | mainFn :: IO () 62 | mainFn = run 4000 app 63 | 64 | -- Output 65 | 66 | -- curl -v 127.0.0.1:4000/name 67 | -- * Trying 127.0.0.1... 68 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 69 | -- > GET /name HTTP/1.1 70 | -- > Host: 127.0.0.1:4000 71 | -- > User-Agent: curl/7.47.0 72 | -- > Accept: */* 73 | -- > 74 | -- < HTTP/1.1 200 OK 75 | -- < Transfer-Encoding: chunked 76 | -- < Date: Sun, 12 Nov 2017 15:07:16 GMT 77 | -- < Server: Warp/3.2.13 78 | -- < Content-Type: text/plain;charset=utf-8 79 | -- < 80 | -- * Connection #0 to host 127.0.0.1 left intact 81 | -- Anonymous 82 | -- 83 | -- $ curl -v 127.0.0.1:4000/name?input=John 84 | -- * Trying 127.0.0.1... 85 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 86 | -- > GET /name?input=John HTTP/1.1 87 | -- > Host: 127.0.0.1:4000 88 | -- > User-Agent: curl/7.47.0 89 | -- > Accept: */* 90 | -- > 91 | -- < HTTP/1.1 200 OK 92 | -- < Transfer-Encoding: chunked 93 | -- < Date: Sun, 12 Nov 2017 15:07:29 GMT 94 | -- < Server: Warp/3.2.13 95 | -- < Content-Type: text/plain;charset=utf-8 96 | -- < 97 | -- * Connection #0 to host 127.0.0.1 left intact 98 | -- John 99 | -- 100 | -- curl -v 127.0.0.1:4000/name/John 101 | -- * Trying 127.0.0.1... 102 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 103 | -- > GET /requiredName/John HTTP/1.1 104 | -- > Host: 127.0.0.1:4000 105 | -- > User-Agent: curl/7.47.0 106 | -- > Accept: */* 107 | -- > 108 | -- < HTTP/1.1 200 OK 109 | -- < Transfer-Encoding: chunked 110 | -- < Date: Tue, 17 Apr 2018 12:57:07 GMT 111 | -- < Server: Warp/3.2.18.2 112 | -- < Content-Type: text/plain;charset=utf-8 113 | -- < 114 | -- * Connection #0 to host 127.0.0.1 left intact 115 | -- John 116 | -------------------------------------------------------------------------------- /src/MultipartData.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module MultipartData where 8 | 9 | import Servant ( PlainText 10 | , Post 11 | , Proxy(..) 12 | , type (:>) -- Syntax for importing type operator 13 | , type (:<|>) 14 | , (:<|>)(..) 15 | ) 16 | import Servant.Server (Handler, Server, Application, serve) 17 | import Network.Wai.Handler.Warp (run) 18 | 19 | import Servant.Multipart -- This is the module that contain the multipart handling stuff. It is part of a separate package called 'servant-multipart' 20 | 21 | uploadHandlerMem :: MultipartData Mem -> Handler String -- Handlers that accept multipart data have either 'MultipartData Mem' or 'MultipartData Tmp' as it's argument. 22 | uploadHandlerMem mData = do -- If the upload has to be stored in memory then the type should be Multipart Mem. If the files have to be stored 23 | let output = (inputs mData, files mData) -- in a tmp folder, the type needs to be 'MultipartData Tmp' 24 | return $ show output -- Then we use the 'inputs' and 'files' functions from the Servant.Multipart module to access the input fields and upload files 25 | 26 | uploadHandlerFile :: MultipartData Tmp -> Handler String -- An upload handler that stores the uploaded file in a tmp location. See the sample usage. 27 | uploadHandlerFile mData = do 28 | let output = (inputs mData, files mData) 29 | return $ show output 30 | 31 | type ServantType = "uploadToTmpFile" :> MultipartForm Tmp (MultipartData Tmp) :> Post '[PlainText] String 32 | :<|> "uploadToMem" :> MultipartForm Mem (MultipartData Mem) :> Post '[PlainText] String 33 | 34 | server :: Server ServantType 35 | server = uploadHandlerFile :<|> uploadHandlerMem 36 | 37 | app :: Application 38 | app = serve (Proxy :: Proxy ServantType) server 39 | 40 | mainFn :: IO () 41 | mainFn = run 4000 app 42 | 43 | -- $ curl -v -F name=sras -F age=35 -F upload=@/tmp/upload http://127.0.0.1/uploadToMem 44 | -- * Trying 127.0.0.1... 45 | -- * Connected to 127.0.0.1 (127.0.0.1) port 80 (#0) 46 | -- > POST /uploadToMem HTTP/1.1 47 | -- > Host: 127.0.0.1 48 | -- > User-Agent: curl/7.47.0 49 | -- > Accept: */* 50 | -- > Content-Length: 444 51 | -- > Expect: 100-continue 52 | -- > Content-Type: multipart/form-data; boundary=------------------------9d37ec5069a8d9ec 53 | -- > 54 | -- < HTTP/1.1 100 Continue 55 | -- < HTTP/1.1 200 OK 56 | -- < Server: nginx/1.10.3 (Ubuntu) 57 | -- < Date: Sun, 22 Jul 2018 13:41:37 GMT 58 | -- < Content-Type: text/plain;charset=utf-8 59 | -- < Transfer-Encoding: chunked 60 | -- < Connection: keep-alive 61 | -- < 62 | -- * Connection #0 to host 127.0.0.1 left intact 63 | -- ([Input {iName = "name", iValue = "sras"},Input {iName = "age", iValue = "35"}],[FileData {fdInputName = "upload", fdFileName = "upload", fdFileCType = "app 64 | -- lication/octet-stream", fdPayload = "This is some random\\nContent in the uploaded\\n file.\n"}]) 65 | -- 66 | -- $ curl -v -F name=sras -F age=35 -F upload=@/tmp/upload http://127.0.0.1/uploadToTmpFile 67 | -- * Trying 127.0.0.1... 68 | -- * Connected to 127.0.0.1 (127.0.0.1) port 80 (#0) 69 | -- > POST /uploadToTmpFile HTTP/1.1 70 | -- > Host: 127.0.0.1 71 | -- > User-Agent: curl/7.47.0 72 | -- > Accept: */* 73 | -- > Content-Length: 444 74 | -- > Expect: 100-continue 75 | -- > Content-Type: multipart/form-data; boundary=------------------------d20f52c9ba99c75d 76 | -- > 77 | -- < HTTP/1.1 100 Continue 78 | -- < HTTP/1.1 200 OK 79 | -- < Server: nginx/1.10.3 (Ubuntu) 80 | -- < Date: Sun, 22 Jul 2018 13:41:44 GMT 81 | -- < Content-Type: text/plain;charset=utf-8 82 | -- < Transfer-Encoding: chunked 83 | -- < Connection: keep-alive 84 | -- < 85 | -- * Connection #0 to host 127.0.0.1 left intact 86 | -- ([Input {iName = "name", iValue = "sras"},Input {iName = "age", iValue = "35"}],[FileData {fdInputName = "upload", fdFileName = "upload", fdFileCType = "app 87 | -- lication/octet-stream", fdPayload = "/tmp/servant-multipart27893-0.buf"}])sras@servant-examples : 88 | -------------------------------------------------------------------------------- /src/BasicAuthentication.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module BasicAuthentication where 8 | 9 | import Servant ( PlainText 10 | , BasicAuth 11 | , BasicAuthCheck(..) 12 | , BasicAuthData(..) 13 | , BasicAuthResult(..) 14 | , Get 15 | , Context((:.), EmptyContext) 16 | , Proxy(..) 17 | , type (:>) -- Syntax for importing type operator 18 | , type (:<|>) 19 | , (:<|>)(..) 20 | ) 21 | import Servant.Server (Handler, Server, Application, serveWithContext) 22 | import Network.Wai.Handler.Warp (run) 23 | import Control.Monad.IO.Class (liftIO) 24 | 25 | data User = User 26 | 27 | handlerName :: User -> Handler String 28 | handlerName _ = return "sras" 29 | 30 | handlerAge :: Handler String 31 | handlerAge = liftIO (return "30" :: IO String) -- Using liftIO just to show that we can do arbitrary IO in the Handler 32 | 33 | type ServantType = BasicAuth "Example Auth Realm" User :> "person" :> "name" :> Get '[PlainText] String 34 | :<|> "person" :> "age" :> Get '[PlainText] String 35 | 36 | server :: Server ServantType 37 | server = handlerName :<|> handlerAge 38 | 39 | myAuthCheck :: BasicAuthData -> IO (BasicAuthResult User) 40 | myAuthCheck (BasicAuthData u p) = return $ if u == "sras" && p == "sras_password" then Authorized User else BadPassword 41 | 42 | -- ^^ The above function is the one that actually check the username 43 | -- and password and return an value that indicate the status of authentication. Look in the 'app' function 44 | -- to see how it is used. The value returned can be one of 45 | -- 46 | -- Unauthorized 47 | -- BadPassword 48 | -- NoSuchUser 49 | -- Authorized usr 50 | -- 51 | -- Refer http://hackage.haskell.org/package/servant-server-0.14.1/docs/Servant-Server-Internal-BasicAuth.html 52 | 53 | app :: Application 54 | app = serveWithContext (Proxy :: Proxy ServantType) ctx server 55 | where 56 | ctx = (BasicAuthCheck myAuthCheck) :. EmptyContext 57 | 58 | mainFn :: IO () 59 | mainFn = run 4000 app 60 | -- 61 | -- $ curl -v http://localhost:4000/person/name 62 | -- * Trying 127.0.0.1... 63 | -- * Connected to localhost (127.0.0.1) port 4000 (#0) 64 | -- > GET /person/name HTTP/1.1 65 | -- > Host: localhost:4000 66 | -- > User-Agent: curl/7.47.0 67 | -- > Accept: */* 68 | -- > 69 | -- < HTTP/1.1 401 Unauthorized 70 | -- < Transfer-Encoding: chunked 71 | -- < Date: Sat, 21 Jul 2018 17:02:11 GMT 72 | -- < Server: Warp/3.2.23 73 | -- < WWW-Authenticate: Basic realm="Example Auth Realm" 74 | -- < 75 | -- * Connection #0 to host localhost left intact 76 | -- 77 | -- $ curl -v -u sras:password http://localhost:4000/person/name 78 | -- * Trying 127.0.0.1... 79 | -- * Connected to localhost (127.0.0.1) port 4000 (#0) 80 | -- * Server auth using Basic with user 'sras' 81 | -- > GET /person/name HTTP/1.1 82 | -- > Host: localhost:4000 83 | -- > Authorization: Basic c3JhczpwYXNzd29yZA== 84 | -- > User-Agent: curl/7.47.0 85 | -- > Accept: */* 86 | -- > 87 | -- < HTTP/1.1 401 Unauthorized 88 | -- < Transfer-Encoding: chunked 89 | -- < Date: Sat, 21 Jul 2018 17:08:20 GMT 90 | -- < Server: Warp/3.2.23 91 | -- * Authentication problem. Ignoring this. 92 | -- < WWW-Authenticate: Basic realm="Example Auth Realm" 93 | -- < 94 | -- * Connection #0 to host localhost left intact 95 | -- 96 | -- $ curl -v -u sras:sras_password http://localhost:4000/person/name 97 | -- * Trying 127.0.0.1... 98 | -- * Connected to localhost (127.0.0.1) port 4000 (#0) 99 | -- * Server auth using Basic with user 'sras' 100 | -- > GET /person/name HTTP/1.1 101 | -- > Host: localhost:4000 102 | -- > Authorization: Basic c3JhczpzcmFzX3Bhc3N3b3Jk 103 | -- > User-Agent: curl/7.47.0 104 | -- > Accept: */* 105 | -- > 106 | -- < HTTP/1.1 200 OK 107 | -- < Transfer-Encoding: chunked 108 | -- < Date: Sat, 21 Jul 2018 17:08:27 GMT 109 | -- < Server: Warp/3.2.23 110 | -- < Content-Type: text/plain;charset=utf-8 111 | -- < 112 | -- * Connection #0 to host localhost left intact 113 | -- sras 114 | -------------------------------------------------------------------------------- /src/CustomPostMultipleFormats.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE TypeOperators #-} 7 | 8 | module CustomPostMultipleFormats where 9 | 10 | import Servant ( PlainText 11 | , JSON 12 | , MimeUnrender(..) 13 | , Accept(..) 14 | , Get 15 | , Post 16 | , ReqBody 17 | , Proxy(..) 18 | , type (:>) -- Syntax for importing type operator 19 | , type (:<|>) 20 | , (:<|>)(..) 21 | ) 22 | import Servant.Server (Handler, Server, Application, serve) 23 | import Network.Wai.Handler.Warp (run) 24 | import Data.Text as T (unpack) 25 | import Data.Text.Lazy.Encoding as TE (decodeUtf8') 26 | import Data.Text.Lazy as TL (toStrict) 27 | 28 | -- In this example, we see how we can accept data 29 | -- in multiple formats, including custom ones. 30 | 31 | data ANewFormat 32 | 33 | -- In the code below, look at the `ReqBody '[ANewFormat, JSON] String` part. 34 | -- This is what enables our endpoint to recieve a value of type 35 | -- `String` encoded as ANewFormat OR as JSON, in the body of the request. 36 | -- The endpoint can accept both formats because `'[ANewFormat, JSON]` is a 37 | -- type level list with two elements. ANewFormat and JSON. 38 | -- If you were wondering, the JSON format is bundled in with Servant. 39 | -- So we don't have to do additional stuff to make it work, but not so for our ANewFormat. 40 | -- 41 | type ServantType = "name" :> ReqBody '[ANewFormat, JSON] String :> Post '[PlainText] String 42 | :<|> "age" :> Get '[PlainText] String 43 | 44 | instance Accept ANewFormat where 45 | contentType _ = "text/a-new-format" -- This instance means that servant will use the decoding specific to ANewFormat as soon as it sees this content type ("text/a-new-format") in the incoming request. 46 | 47 | instance MimeUnrender ANewFormat String where -- This instance implements the decoding of a bytestring that encodes some content in ANewFormat, into a target type (Which is String here) 48 | mimeUnrender _ bs = case TE.decodeUtf8' bs of 49 | Right x -> Right $ ("Decoded from ANewFormat - " ++ (T.unpack $ TL.toStrict x)) -- We just prefix the decoded text to differentiate it to show this was decoded using ANewFormat decoding logic. 50 | Left _ -> Left "Decoding error" 51 | 52 | handlerName :: String -> Handler String 53 | handlerName nameIn = return nameIn -- Just output back the input string value 54 | 55 | handlerAge :: Handler String 56 | handlerAge = return "30" 57 | 58 | server :: Server ServantType 59 | server = handlerName :<|> handlerAge 60 | 61 | app :: Application 62 | app = serve (Proxy :: Proxy ServantType) server 63 | 64 | mainFn :: IO () 65 | mainFn = run 4000 app 66 | 67 | -- Output 1 - See how the output differs when only the content type is changes, triggerring different decoding mechanisms. 68 | -- 69 | -- curl -v -H "Content-Type:text/a-new-format" -d "\"John\"" http://127.0.0.1:4000/name 70 | -- * Trying 127.0.0.1... 71 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 72 | -- > POST /name HTTP/1.1 73 | -- > Host: 127.0.0.1:4000 74 | -- > User-Agent: curl/7.47.0 75 | -- > Accept: */* 76 | -- > Content-Type:text/a-new-format 77 | -- > Content-Length: 6 78 | -- > 79 | -- * upload completely sent off: 6 out of 6 bytes 80 | -- < HTTP/1.1 200 OK 81 | -- < Transfer-Encoding: chunked 82 | -- < Date: Wed, 11 Apr 2018 06:40:42 GMT 83 | -- < Server: Warp/3.2.13 84 | -- < Content-Type: text/plain;charset=utf-8 85 | -- < 86 | -- * Connection #0 to host 127.0.0.1 left intact 87 | -- Decoded from ANewFormat - "John" 88 | -- 89 | -- Output 2 90 | -- 91 | -- curl -v -H "Content-Type:application/json" -d "\"John\"" http://127.0.0.1:4000/name 92 | -- * Trying 127.0.0.1... 93 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 94 | -- > POST /name HTTP/1.1 95 | -- > Host: 127.0.0.1:4000 96 | -- > User-Agent: curl/7.47.0 97 | -- > Accept: */* 98 | -- > Content-Type:application/json 99 | -- > Content-Length: 6 100 | -- > 101 | -- * upload completely sent off: 6 out of 6 bytes 102 | -- < HTTP/1.1 200 OK 103 | -- < Transfer-Encoding: chunked 104 | -- < Date: Wed, 11 Apr 2018 06:41:07 GMT 105 | -- < Server: Warp/3.2.13 106 | -- < Content-Type: text/plain;charset=utf-8 107 | -- < 108 | -- * Connection #0 to host 127.0.0.1 left intact 109 | -- John 110 | -------------------------------------------------------------------------------- /src/SwaggerDocGeneration.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | {-# LANGUAGE DeriveAnyClass #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | {-# LANGUAGE MultiParamTypeClasses #-} 8 | {-# LANGUAGE TypeOperators #-} 9 | 10 | module SwaggerDocGeneration where 11 | 12 | import Servant ( PlainText 13 | , Get 14 | , JSON 15 | , Proxy(..) 16 | , MimeRender 17 | , type (:>) -- Syntax for importing type operator 18 | , type (:<|>) 19 | , (:<|>)(..) 20 | ) 21 | import Servant.Server (Handler, Server, Application, serve) 22 | import Network.Wai.Handler.Warp (run) 23 | import GHC.Generics (Generic) 24 | 25 | import Servant.Swagger (toSwagger) 26 | import Data.Swagger (Swagger, ToSchema) 27 | 28 | -- This module show how to add an endpoint that serves the api documentation in a json format 29 | 30 | handlerPerson :: Handler Person 31 | handlerPerson = return $ Person "Sandeep" 40 32 | 33 | handlerAge :: Handler String 34 | handlerAge = return "30" 35 | 36 | data Person = Person 37 | { prName :: String 38 | , prAge :: Int 39 | } deriving (Generic, ToSchema) 40 | 41 | instance MimeRender PlainText Person where 42 | 43 | 44 | type ServantType = "person" :> "name" :> Get '[PlainText] Person 45 | :<|> "person" :> "age" :> Get '[PlainText] String 46 | 47 | server :: Server ServantType 48 | server = handlerPerson :<|> handlerAge 49 | -- 50 | -- Everything is same upto this point 51 | -- In the section below, we create an Handler to serve the api documentation. 52 | -- The return type of this handler is 'Swagger'. It is generated by toSwagger 53 | -- function from Servant.Swagger module. 54 | -- 55 | handlerDoc :: Handler Swagger 56 | handlerDoc = return $ toSwagger (Proxy :: Proxy ServantType) 57 | 58 | -- Below, we create a new Server type by appending the corresponding type of endpoint for 59 | -- the above handler to the original Server type we have defined before. 60 | 61 | type ServantTypeWithDoc = ServantType :<|> ("api" :> Get '[JSON] Swagger) 62 | 63 | -- Below, we create a new server that also includes the documentation handler so that it matches 64 | -- with the Server type we created just before. 65 | 66 | serverWithDoc :: Server ServantTypeWithDoc 67 | serverWithDoc = server :<|> handlerDoc 68 | 69 | app :: Application 70 | app = serve (Proxy :: Proxy ServantTypeWithDoc) serverWithDoc 71 | 72 | mainFn :: IO () 73 | mainFn = run 4000 app 74 | 75 | -- curl -v http://127.0.0.1/api 76 | -- * Trying 127.0.0.1... 77 | -- * Connected to 127.0.0.1 (127.0.0.1) port 80 (#0) 78 | -- > GET /api HTTP/1.1 79 | -- > Host: 127.0.0.1 80 | -- > User-Agent: curl/7.47.0 81 | -- > Accept: */* 82 | -- > 83 | -- < HTTP/1.1 200 OK 84 | -- < Server: nginx/1.10.3 (Ubuntu) 85 | -- < Date: Sun, 22 Jul 2018 16:07:05 GMT 86 | -- < Content-Type: application/json;charset=utf-8 87 | -- < Transfer-Encoding: chunked 88 | -- < Connection: keep-alive 89 | -- < 90 | -- * Connection #0 to host 127.0.0.1 left intact 91 | -- {"swagger":"2.0","info":{"version":"","title":""},"paths":{"/person/name":{"get":{"produces":["text/plain;charset=utf-8"],"responses":{"200":{"schema":{"type":"string"},"description":""}}}},"/person/age":{"get":{"produces":["text/plain;charset=utf-8"],"responses":{"200":{"schema":{"type":"string"},"description":""}}}}}}s 92 | -- 93 | -- After prettifying the json is as follows. You can see the two endpoints in there. 94 | -- { 95 | -- "swagger": "2.0", 96 | -- "info": { 97 | -- "version": "", 98 | -- "title": "" 99 | -- }, 100 | -- "paths": { 101 | -- "/person/name": { 102 | -- "get": { 103 | -- "produces": [ 104 | -- "text/plain;charset=utf-8" 105 | -- ], 106 | -- "responses": { 107 | -- "200": { 108 | -- "schema": { 109 | -- "type": "string" 110 | -- }, 111 | -- "description": "" 112 | -- } 113 | -- } 114 | -- } 115 | -- }, 116 | -- "/person/age": { 117 | -- "get": { 118 | -- "produces": [ 119 | -- "text/plain;charset=utf-8" 120 | -- ], 121 | -- "responses": { 122 | -- "200": { 123 | -- "schema": { 124 | -- "type": "string" 125 | -- }, 126 | -- "description": "" 127 | -- } 128 | -- } 129 | -- } 130 | -- } 131 | -- } 132 | -- } 133 | -------------------------------------------------------------------------------- /src/HeaderOutput.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module HeaderOutput where 8 | 9 | import Servant ( Header 10 | , PlainText 11 | , addHeader 12 | , Headers 13 | , Header 14 | , Get 15 | , Proxy(..) 16 | , type (:>) -- Syntax for importing type operator 17 | , type (:<|>) 18 | , (:<|>)(..) 19 | ) 20 | import Servant.Server (Handler, Server, Application, serve) 21 | import Network.Wai.Handler.Warp (run) 22 | 23 | -- In this example we see how we can add a header to the response. 24 | -- Look at the first endpoint type below. The types to denote the Header gets 25 | -- added around the content, which is a String here. 26 | 27 | type ServantType = "singleHeader" :> Get '[PlainText] (Headers '[Header "CustomHeader" String] String) 28 | :<|> "multipleHeaders" :> Get '[PlainText] (Headers '[Header "CustomHeader2" String, Header "CustomHeader" String] String) 29 | -- Compare this type with the type of the same endpoint with out the header in the line below 30 | -- 31 | -- type ServantType = "name" :> Get '[PlainText] String 32 | -- 33 | -- So the type `String` at the end that represents the response body, is changed to `(Headers '[Header "CustomHeader" String] String)` 34 | -- 35 | -- Now let us see how the handler and its type is changed to reflect this change 36 | 37 | handlerWithHeader :: Handler (Headers '[Header "CustomHeader" String] String) -- Again, here, instead of `Handler String` (For handler without header), we have changed `String` to (Headers '[Header "CustomHeader" String] String) 38 | handlerWithHeader = addHeader "CustomHeaderValue" <$> handlerWithoutHeader 39 | -- Note how the "addHeader" function is applied to the response content (ie String, via fmap) instead of the whole handler. It all matches up with how the types was changed. 40 | where 41 | handlerWithoutHeader :: Handler String 42 | handlerWithoutHeader = return "Response Content" 43 | 44 | -- Below is another handler that adds two Headers to the response. See how additional headers 45 | -- gets added to the Handler type, and how the addHeader function is used. 46 | -- You should be careful about the order in which is addHeader functions are called. Since 47 | -- the value of both headers are Strings. If you want to guard against this mix up, use custom types 48 | -- as Header values, instead of using Strings for all headers. 49 | 50 | handlerWithMultipleHeader :: Handler (Headers '[Header "CustomHeader2" String, Header "CustomHeader" String] String) -- Again, here, instead of `Handler String` (For handler without header), we have changed `String` to (Headers '[Header "CustomHeader" String] String) 51 | handlerWithMultipleHeader = (addHeader "CustomHeader2Value" . addHeader "CustomHeaderValue") <$> handlerWithoutHeader 52 | -- Note how the "addHeader" function is applied to the response content (via fmap) intead of the whole handler. It all matches up with how the types was changed. 53 | where 54 | handlerWithoutHeader :: Handler String 55 | handlerWithoutHeader = return "Response Content" 56 | 57 | server :: Server ServantType 58 | server = handlerWithHeader :<|> handlerWithMultipleHeader 59 | 60 | app :: Application 61 | app = serve (Proxy :: Proxy ServantType) server 62 | 63 | mainFn :: IO () 64 | mainFn = run 4000 app 65 | 66 | -- curl -v http://127.0.0.1:4000/singleHeader 67 | -- * Trying 127.0.0.1... 68 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 69 | -- > GET /singleHeader HTTP/1.1 70 | -- > Host: 127.0.0.1:4000 71 | -- > User-Agent: curl/7.47.0 72 | -- > Accept: */* 73 | -- > 74 | -- < HTTP/1.1 200 OK 75 | -- < Transfer-Encoding: chunked 76 | -- < Date: Sun, 22 Jul 2018 08:49:01 GMT 77 | -- < Server: Warp/3.2.23 78 | -- < Content-Type: text/plain;charset=utf-8 79 | -- < CustomHeader: CustomHeaderValue 80 | -- < 81 | -- * Connection #0 to host 127.0.0.1 left intact 82 | -- Response Content 83 | -- 84 | -- curl -v http://127.0.0.1:4000/multipleHeaders 85 | -- * Trying 127.0.0.1... 86 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 87 | -- > GET /multipleHeaders HTTP/1.1 88 | -- > Host: 127.0.0.1:4000 89 | -- > User-Agent: curl/7.47.0 90 | -- > Accept: */* 91 | -- > 92 | -- < HTTP/1.1 200 OK 93 | -- < Transfer-Encoding: chunked 94 | -- < Date: Sun, 22 Jul 2018 08:49:24 GMT 95 | -- < Server: Warp/3.2.23 96 | -- < Content-Type: text/plain;charset=utf-8 97 | -- < CustomHeader2: CustomHeader2Value 98 | -- < CustomHeader: CustomHeaderValue 99 | -- < 100 | -- * Connection #0 to host 127.0.0.1 left intact 101 | -- Response Content 102 | -------------------------------------------------------------------------------- /src/CustomPostFormat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE TypeOperators #-} 7 | 8 | module CustomPostFormat where 9 | 10 | import Servant ( PlainText 11 | , MimeUnrender(..) 12 | , Accept(..) 13 | , Post 14 | , ReqBody 15 | , Proxy(..) 16 | , type (:>) -- Syntax for importing type operator 17 | , type (:<|>) 18 | , (:<|>)(..) 19 | ) 20 | import Servant.Server (Handler, Server, Application, serve) 21 | import Network.Wai.Handler.Warp (run) 22 | import Data.Text as T (unpack) 23 | import Data.Text.Lazy.Encoding as TE (decodeUtf8') 24 | import Data.Text.Lazy as TL (toStrict) 25 | 26 | -- In this example, we see how we can accept data 27 | -- in any custom format. Earlier example, we were accepting 28 | -- data in JSON format, which Servant has built in support for. 29 | 30 | data ANewFormat -- This is our new format that we will be using along with JSON. We won't be needing a constructor since we won't be dealing with values of this type. 31 | -- The sole purpose of this type is to enable the Haskell type system to select the proper decoding/encoding and content type generation 32 | -- functions inside proper typeclass instances, which is why we don't need a constructor. 33 | 34 | -- In the code below, you can see the type of the two end points. 35 | -- Look at the `ReqBody '[ANewFormat] String` part, in the first one. 36 | -- This is what enables our endpoint to recieve a value of type 37 | -- `String` encoded as ANewFormat, in the body of the request. 38 | -- The MimeUnrender instance also defines how some bytestring 39 | -- encoded as ANewFormat can be decoded into a String. 40 | type ServantType = "name-in-new-format" :> ReqBody '[ANewFormat] String :> Post '[PlainText] String 41 | :<|> "name" :> ReqBody '[PlainText] String :> Post '[PlainText] String 42 | 43 | instance Accept ANewFormat where 44 | contentType _ = "text/a-new-format" -- This instance means that servant will use the decoding specific to ANewFormat as soon as it sees this content type ("text/a-new-format") in the incoming request. 45 | 46 | instance MimeUnrender ANewFormat String where -- This instance implements the decoding of a bytestring that encodes some content in ANewFormat, into a target type (Which is String here) 47 | mimeUnrender _ bs = case TE.decodeUtf8' bs of 48 | Right x -> Right $ ("Decoded from ANewFormat - " ++ (T.unpack $ TL.toStrict x)) -- We just prefix the decoded text to differentiate it to show this was decoded using ANewFormat decoding logic. 49 | Left _ -> Left "Decoding error" 50 | 51 | handlerName :: String -> Handler String 52 | handlerName nameIn = return nameIn -- Just output back the input string value 53 | 54 | server :: Server ServantType 55 | server = handlerName :<|> handlerName -- We can use same handler for both endpoints, because they only differ in input encoding. 56 | 57 | app :: Application 58 | app = serve (Proxy :: Proxy ServantType) server 59 | 60 | mainFn :: IO () 61 | mainFn = run 4000 app 62 | 63 | -- Output - See how the output differs when only the content type is changes, triggerring different decoding mechanisms. 64 | -- 65 | -- $ curl -v -H "Content-Type:text/a-new-format" -d "\"John\"" http://127.0.0.1:4000/name-in-new-format 66 | -- * Trying 127.0.0.1... 67 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 68 | -- > POST /name-in-new-format HTTP/1.1 69 | -- > Host: 127.0.0.1:4000 70 | -- > User-Agent: curl/7.47.0 71 | -- > Accept: */* 72 | -- > Content-Type:text/a-new-format 73 | -- > Content-Length: 6 74 | -- > 75 | -- * upload completely sent off: 6 out of 6 bytes 76 | -- < HTTP/1.1 200 OK 77 | -- < Transfer-Encoding: chunked 78 | -- < Date: Sun, 22 Jul 2018 07:37:15 GMT 79 | -- < Server: Warp/3.2.23 80 | -- < Content-Type: text/plain;charset=utf-8 81 | -- < 82 | -- * Connection #0 to host 127.0.0.1 left intact 83 | -- Decoded from ANewFormat - "John" 84 | -- 85 | -- $ curl -v -H "Content-Type:text/plain;charset=utf-8" -d "John" http://127.0.0.1:4000/name 86 | -- * Trying 127.0.0.1... 87 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 88 | -- > POST /name HTTP/1.1 89 | -- > Host: 127.0.0.1:4000 90 | -- > User-Agent: curl/7.47.0 91 | -- > Accept: */* 92 | -- > Content-Type:text/plain;charset=utf-8 93 | -- > Content-Length: 4 94 | -- > 95 | -- * upload completely sent off: 4 out of 4 bytes 96 | -- < HTTP/1.1 200 OK 97 | -- < Transfer-Encoding: chunked 98 | -- < Date: Sun, 22 Jul 2018 07:40:17 GMT 99 | -- < Server: Warp/3.2.23 100 | -- < Content-Type: text/plain;charset=utf-8 101 | -- < 102 | -- * Connection #0 to host 127.0.0.1 left intact 103 | -- Johns 104 | -------------------------------------------------------------------------------- /src/HelloWorld.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module HelloWorld where 8 | 9 | import Servant ( PlainText 10 | , Get 11 | , Proxy(..) 12 | , type (:>) -- Syntax for importing type operator 13 | , type (:<|>) 14 | , (:<|>)(..) 15 | ) 16 | import Servant.Server (Handler, Server, Application, serve) 17 | import Network.Wai.Handler.Warp (run) 18 | import Control.Monad.IO.Class (liftIO) 19 | 20 | -- "Hello world" of servant web application 21 | -- In this we will create a web application with 22 | -- only two routes/endpoints, which are 23 | -- 24 | -- /name, which return a hard coded name 25 | -- /age, which returns a hard coded age 26 | 27 | -- 28 | -- The two functions that are supposed to 29 | -- handle these two endpoints can be seen below. 30 | -- 31 | handlerName :: Handler String 32 | handlerName = return "sras" 33 | 34 | handlerAge :: Handler String 35 | handlerAge = liftIO (return "30" :: IO String) -- Using liftIO just to show that we can do arbitrary IO in the Handler 36 | 37 | -- The handler functions for Servant should run in a 'Handler' 38 | -- monad, which is something that is part of the Servant 39 | -- This monad is an instance of MonadIO class, so you 40 | -- can do arbitrary IO in your handlers. You can see this 41 | -- done in the 'age' handler, where we lift a value of type 42 | -- 'IO String' to a value of type 'Handler String' 43 | 44 | type ServantType = "person" :> "name" :> Get '[PlainText] String 45 | :<|> "person" :> "age" :> Get '[PlainText] String 46 | 47 | -- Now we come to the most unique feature of servant 48 | -- which is, the webapplication represented as a type. 49 | -- Each endpoint have its own type, and these types are 50 | -- joined by the :<|> type operator, which ends up being 51 | -- the type of the server that contains all the constituent 52 | -- endpoints. 53 | -- 54 | -- Let us start with a simple endpoint. Say we want this 55 | -- endpoint to be avilable at url "/person/name" using GET method. 56 | -- And say, we want this to return a plain text content to the browser. 57 | -- 58 | -- The type of this endpoint can be 59 | -- 60 | -- "person" :> "name" :> Get '[PlainText] String 61 | -- 62 | -- Note that we had to separate the path segments using the :> operator 63 | -- and it wouldn't work if we specify the path 64 | -- as "person/name" :> Get '[PlainText] String 65 | -- 66 | -- Next is the 'Get' part, which decides the HTTP Method 67 | -- by which this endpoint can be accessed. Servant provides 68 | -- the following methods 69 | -- 70 | -- GET 71 | -- POST 72 | -- HEAD 73 | -- PUT 74 | -- DELETE 75 | -- TRACE 76 | -- CONNECT 77 | -- OPTIONS 78 | -- PATCH 79 | -- 80 | -- After the Method, we have this type level list 81 | -- '[PlainText]. This configures the type of formats 82 | -- that this endpoint could return. Right now we have 83 | -- only PlainText in this list. So this endpoint can 84 | -- only output stuff in plain text format. The content 85 | -- type header will contain "text/plain". 86 | -- 87 | -- The available formats bundled with Servant are 88 | -- PlainText, FormUrlEncoded, OctetStream and JSON 89 | -- 90 | -- We will see how to add an Html type in the next example 91 | 92 | server :: Server ServantType 93 | server = handlerName :<|> handlerAge 94 | 95 | -- In the above lines, we combine the handlers 96 | -- (just like we combined the types representing 97 | -- handlers in the step before). Here too we 98 | -- can use the :<|> operator to combine handlers. 99 | -- Only here this is a regular operator, that 100 | -- operate of values, instead of types. 101 | -- 102 | app :: Application 103 | app = serve (Proxy :: Proxy ServantType) server 104 | 105 | -- Here we make a regular wai application 106 | -- from the servants representation of the 107 | -- web app. If you are not familar with the `Proxy` stuff 108 | -- It is something that is part of Data.Proxy module, and 109 | -- is something that is commonly used in fancy typelevel 110 | -- stuff. 111 | -- 112 | -- Now that we have an wai `Application`, 113 | -- we are out of the magical land of Servant and 114 | -- back to the familiar world of wai. 115 | 116 | mainFn :: IO () 117 | mainFn = run 4000 app 118 | 119 | -- Now let us see how this app behaves 120 | -- 121 | -- curl -v 127.0.0.1:4000/person/age 122 | -- * Trying 127.0.0.1... 123 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 124 | -- > GET /age HTTP/1.1 125 | -- > Host: 127.0.0.1:4000 126 | -- > User-Agent: curl/7.47.0 127 | -- > Accept: */* 128 | -- > 129 | -- < HTTP/1.1 200 OK 130 | -- < Transfer-Encoding: chunked 131 | -- < Date: Sun, 12 Nov 2017 02:59:50 GMT 132 | -- < Server: Warp/3.2.13 133 | -- < Content-Type: text/plain;charset=utf-8 134 | -- < 135 | -- * Connection #0 to host 127.0.0.1 left intact 136 | -- 30 137 | -- 138 | -- curl -v 127.0.0.1:4000/person/name 139 | -- * Trying 127.0.0.1... 140 | -- * Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0) 141 | -- > GET /name HTTP/1.1 142 | -- > Host: 127.0.0.1:4000 143 | -- > User-Agent: curl/7.47.0 144 | -- > Accept: */* 145 | -- > 146 | -- < HTTP/1.1 200 OK 147 | -- < Transfer-Encoding: chunked 148 | -- < Date: Sun, 12 Nov 2017 03:17:44 GMT 149 | -- < Server: Warp/3.2.13 150 | -- < Content-Type: text/plain;charset=utf-8 151 | -- < 152 | -- * Connection #0 to host 127.0.0.1 left intact 153 | --------------------------------------------------------------------------------