servant-proto-lens-0.1.0.3: test/TestServer.hs

{-# LANGUAGE DataKinds #-} -- for string types and type lists
{-# LANGUAGE TypeOperators #-} -- for api appenders in types
module TestServer where

import Control.Lens ((^.))
import Servant ((:>)(..), (:<|>)(..))
import qualified Control.Concurrent.MVar as M
import qualified Network.Wai.Handler.Warp as W
import qualified Proto.Google.Protobuf.Duration as D
import qualified Proto.Google.Protobuf.Duration_Fields as D
import qualified Servant as S

import qualified Servant.API.ContentTypes.Proto as P

-- A test server which returns protobuf from one endpoint, and receives
-- protobuf in two others.

type GetDur = "dur" :> S.Get '[P.Proto] D.Duration
type ExSec = "dur" :> "sec" :> S.ReqBody '[P.Proto] D.Duration :> S.Post '[S.JSON] Int
type ExNSec = "dur" :> "nsec" :> S.ReqBody '[P.Proto] D.Duration :> S.Post '[S.JSON] Int

type API = GetDur :<|> ExSec :<|> ExNSec

server :: D.Duration -> S.Server API
server expect = getDur expect :<|> exSec :<|> exNSec

api :: S.Proxy API
api = S.Proxy

app :: D.Duration -> S.Application
app expect = S.serve api $ server expect

run :: W.Port -> M.MVar () -> D.Duration -> IO ()
run port ready expect = W.runSettings settings $ app expect
    where
        settings
            = W.setPort port
            . W.setBeforeMainLoop (M.putMVar ready ())
            $ W.defaultSettings

-- handlers

getDur :: D.Duration -> S.Handler D.Duration
getDur expect = return expect

exSec :: D.Duration -> S.Handler Int
exSec dur = return . fromIntegral $ dur ^. D.seconds

exNSec :: D.Duration -> S.Handler Int
exNSec dur = return . fromIntegral $ dur ^. D.nanos