05379ed7e3
We use NoContent to signify an empty response nowadays. This commit replaces all occurences of () with NoContent so that all packages use the new semantics.
73 lines
2.0 KiB
Haskell
73 lines
2.0 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE PolyKinds #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
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 '[JSON] Greet
|
|
|
|
-- POST /greet with a Greet as JSON in the request body,
|
|
-- returns a Greet as JSON
|
|
:<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
|
|
|
|
-- DELETE /greet/:greetid
|
|
:<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent
|
|
|
|
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 'Handler' 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 NoContent
|
|
|
|
-- 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
|