example-server/src/Server.hs · typeable/request-track

git.iko.soy/typeable/request-track

on master help sign in

38 lines 1.7 kB history raw

1{-# LANGUAGE TypeFamilies #-}

2module Server where

4import API

5import Client

7import Control.Monad.IO.Class

8import Servant.API

9import Servant.Server

10import Web.Tracking.Servant

12type instance TrackingData RequestTracking = Maybe ReqtrackInfo

14echoHandler :: Maybe ReqtrackInfo -> Handler String

15echoHandler rti = pure ("PONG, " <> show (requestId <$> rti))

17relayHandler :: Handler String

18relayHandler = liftIO callEcho_

20rqHandler :: Maybe ReqtrackInfo -> Handler (Maybe ReqtrackInfo)

21rqHandler (Just info) = liftIO (Just info <$ putStrLn (unlines [ "Request tracking headers found!"

22 , "Request Id: " <> show (requestId info)

23 , "Request Source: " <> show (requestSource info)

24 , "Request Level: " <> show (requestLevel info)

25 ]))

26rqHandler Nothing = liftIO (Nothing <$ putStrLn "Request tracking headers not found!")

28rqHandler_ :: Maybe ReqtrackInfo -> Handler ()

29rqHandler_ (Just info) = liftIO (putStrLn (unlines [ "Request tracking headers found!"

30 , "Request Id: " <> show (requestId info)

31 , "Request Source: " <> show (requestSource info)

32 , "Request Level: " <> show (requestLevel info)

33 ]))

34rqHandler_ Nothing = liftIO (putStrLn "Request tracking headers not found!")

37server :: Server ExampleAPI

38server = echoHandler :<|> relayHandler