git.iko.soy/typeable/request-track
on master help sign in
Make test server work. Add nginx.conf.
commita6b885adf72d0176d8e7650fe7375059a60e7179 authorNick <nick@typeable.io> dateMon 24 Jul 2023, 18:30 (3 years ago) parent1fe3a57
7 files changed+165−30
compare with master
unifiedsplit
example-server/example-server.cabal+6 example-server/src/API.hs+13 example-server/src/Client.hs+48 example-server/src/Main.hs+10−30 example-server/src/Server.hs+38 example-server/src/TLS.hs+9 nginx.conf+41
example-server/example-server.cabal+6
@@ -16,11 +16,17 @@ common warnings
1616executable example-server
1717 import: warnings
1818 main-is: Main.hs
19+ other-modules: API
20+ Client
21+ Server
22+ TLS
1923 build-depends: base >=4.16 && <5,
24+ exceptions >= 0.10,
2025 http-client,
2126 request-track,
2227 request-track-servant,
2328 servant,
29+ servant-client,
2430 servant-server,
2531 thread-local,
2632 wai,
example-server/src/API.hsnew file+13
@@ -0,0 +1,13 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+module API where
4+
5+import Data.Proxy
6+import Servant.API
7+import Web.Tracking.Servant
8+
9+type ExampleAPI = RequestTracking :> "echo" :> Get '[JSON] String
10+ :<|> RequestTracking_ :> "relay" :> Get '[JSON] String
11+
12+exampleAPI :: Proxy ExampleAPI
13+exampleAPI = Proxy
example-server/src/Client.hsnew file+48
@@ -0,0 +1,48 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Client where
3+
4+import API
5+import TLS
6+
7+import Control.Concurrent.ThreadLocal
8+import Control.Monad.Catch
9+import Network.HTTP.Client
10+import Servant.API
11+import Servant.Client
12+import Web.Tracking (incrLevel, replaceSource)
13+import Web.Tracking.Client
14+import Web.Tracking.Servant
15+
16+callRelayM :: ClientM [Char]
17+callEchoM :: Maybe ReqtrackInfo -> ClientM [Char]
18+callEchoM :<|> callRelayM = client exampleAPI
19+
20+url :: BaseUrl
21+url = BaseUrl { baseUrlScheme = Http
22+ , baseUrlHost = "localhost"
23+ , baseUrlPort = 8080
24+ , baseUrlPath = ""
25+ }
26+
27+callRelay :: IO String
28+callRelay = do mgr <- newManager defaultManagerSettings
29+ let env = mkClientEnv mgr url
30+ r <- runClientM callRelayM env
31+ either throwM return r
32+
33+modifyRequest :: ThreadLocal ReqtrackInfo -> Request -> IO Request
34+modifyRequest tls = addTrackingHeaders (fmap f <$> fetchThreadLocal tls)
35+ where f rti = replaceSource "relay"
36+ $ incrLevel rti
37+
38+callEcho_ :: IO String
39+callEcho_ = do mgr <- newManager defaultManagerSettings { managerModifyRequest = modifyRequest storage }
40+ let env = mkClientEnv mgr url
41+ s <- runClientM (callEchoM Nothing) env
42+ either throwM return s
43+
44+callEcho :: ReqtrackInfo -> IO ()
45+callEcho rti = do mgr <- newManager defaultManagerSettings
46+ let env = mkClientEnv mgr url
47+ s <- runClientM (callEchoM $ Just rti) env
48+ print s
example-server/src/Main.hs+10−30
@@ -3,39 +3,19 @@
33{-# LANGUAGE TypeFamilies #-}
44module Main where
55
6+import API
7+import Server
8+import TLS
9+
610import Control.Concurrent.ThreadLocal
7−import Control.Monad.IO.Class
8−import Data.Proxy
911import Network.Wai.Handler.Warp
10−import Servant.API
1112import Servant.Server
12−import Web.Tracking
13+import Web.Tracking hiding (addTrackingHeaders)
1314import Web.Tracking.Servant
1415
15−type instance TrackingData RequestTracking = ()
16−
17−type ExampleAPI = RequestTracking :> "echo" :> Get '[JSON] String
18− :<|> RequestTracking_ :> "relay" :> Get '[JSON] String
19−
20−echoHandler :: () -> Handler String
21−echoHandler _ = pure "PONG"
22−
23−relayHandler :: Handler String
24−relayHandler = pure "RELAY"
25−
26−rqHandler :: Maybe ReqtrackInfo -> Handler ()
27−rqHandler (Just info) = liftIO $ putStrLn (unlines [ "Request tracking headers found!"
28− , "Request Id: " <> show (requestId info)
29− , "Request Source: " <> show (requestSource info)
30− , "Request Level: " <> show (requestLevel info)
31− ])
32−rqHandler Nothing = liftIO $ putStrLn "Request tracking headers not found!"
33−
34−server :: Server ExampleAPI
35−server = echoHandler :<|> relayHandler
36−
3716main :: IO ()
38−main = do tls <- newThreadLocalWithGC 60
39− run 1337 $ trackingMiddleware (`insertThreadLocal` tls)
40− $ serveWithContext (Proxy :: Proxy ExampleAPI) ctx server
41− where ctx = mkReqtrackingHandler rqHandler :. mkReqtrackingHandler rqHandler :. EmptyContext
17+main = run 8081 $ trackingMiddleware (`insertThreadLocal` storage)
18+ $ serveWithContext exampleAPI ctx server
19+ where ctx = mkReqtrackingHandler rqHandler
20+ :. mkReqtrackingHandler rqHandler_
21+ :. EmptyContext
example-server/src/Server.hsnew file+38
@@ -0,0 +1,38 @@
1+{-# LANGUAGE TypeFamilies #-}
2+module Server where
3+
4+import API
5+import Client
6+
7+import Control.Monad.IO.Class
8+import Servant.API
9+import Servant.Server
10+import Web.Tracking.Servant
11+
12+type instance TrackingData RequestTracking = Maybe ReqtrackInfo
13+
14+echoHandler :: Maybe ReqtrackInfo -> Handler String
15+echoHandler rti = pure ("PONG, " <> show (requestId <$> rti))
16+
17+relayHandler :: Handler String
18+relayHandler = liftIO callEcho_
19+
20+rqHandler :: Maybe ReqtrackInfo -> Handler (Maybe ReqtrackInfo)
21+rqHandler (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+ ]))
26+rqHandler Nothing = liftIO (Nothing <$ putStrLn "Request tracking headers not found!")
27+
28+rqHandler_ :: Maybe ReqtrackInfo -> Handler ()
29+rqHandler_ (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+ ]))
34+rqHandler_ Nothing = liftIO (putStrLn "Request tracking headers not found!")
35+
36+
37+server :: Server ExampleAPI
38+server = echoHandler :<|> relayHandler
example-server/src/TLS.hsnew file+9
@@ -0,0 +1,9 @@
1+module TLS where
2+
3+import Control.Concurrent.ThreadLocal
4+import Web.Tracking
5+import System.IO.Unsafe (unsafePerformIO)
6+
7+storage :: ThreadLocal ReqtrackInfo
8+storage = unsafePerformIO (newThreadLocalWithGC 60)
9+{-# NOINLINE storage #-}
nginx.confnew file+41
@@ -0,0 +1,41 @@
1+daemon off;
2+
3+pid nginx.pid;
4+
5+error_log stderr error;
6+
7+
8+http {
9+ log_format logger-json escape=json '{"source": "nginx", "time": $msec, "resp_body_size": $body_bytes_sent, "host": "$http_host", "address": "$remote_addr", "request_length": $request_length, "method": "$request_method", "uri": "$request_uri", "status": $status, "user_agent": "$http_user_agent", "resp_time": $request_time, "upstream_addr": "$upstream_addr"}';
10+ access_log /dev/stdout logger-json;
11+
12+ map $http_x_request_id $req_id {
13+ default $http_x_request_id;
14+ "" $request_id;
15+ }
16+
17+ map $http_x_request_source $req_source {
18+ default $http_x_request_source;
19+ "" "web";
20+ }
21+
22+ map $http_x_request_level $req_level {
23+ default $http_x_request_level;
24+ "" "0";
25+ }
26+
27+ server {
28+ listen 8080;
29+
30+ location / {
31+ proxy_pass http://localhost:8081;
32+
33+ proxy_set_header Host $host;
34+ proxy_set_header X-REQUEST-ID $req_id;
35+ proxy_set_header X-REQUEST-SOURCE $req_source;
36+ proxy_set_header X-REQUEST-LEVEL $req_level;
37+ }
38+ }
39+}
40+
41+events {}