{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | Web server for Ava trace viewer.
--
-- Serves the trace viewer UI for debugging tool executions.
--
-- : out omni-ava-web
-- : dep warp
-- : dep wai
-- : dep http-types
-- : dep aeson
-- : dep text
-- : dep bytestring
-- : dep sqlite-simple
module Omni.Ava.Web
( startWebServer,
app,
defaultPort,
main,
)
where
import Alpha
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Encoding
import qualified Database.SQLite.Simple as SQL
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified Omni.Ava.Trace as Trace
main :: IO ()
main = putText "Use Omni.Ava for the main entry point"
defaultPort :: Int
defaultPort = 8079
startWebServer :: Int -> FilePath -> IO ()
startWebServer port dbPath = do
putText <| "Starting Ava web server on port " <> tshow port
SQL.withConnection dbPath Trace.initTraceDb
Warp.run port (app dbPath)
app :: FilePath -> Wai.Application
app dbPath request respond = do
case Wai.pathInfo request of
["trace", tid] -> serveTracePage dbPath tid request respond
["api", "trace", tid] -> serveTraceJson dbPath tid request respond
["health"] -> respond <| Wai.responseLBS HTTP.status200 [(HTTP.hContentType, "text/plain")] "ok"
_ -> respond <| Wai.responseLBS HTTP.status404 [(HTTP.hContentType, "text/plain")] "Not found"
serveTracePage :: FilePath -> Text -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
serveTracePage dbPath tid _req respond = do
SQL.withConnection dbPath <| \conn -> do
maybeRec <- Trace.getTrace conn tid
case maybeRec of
Nothing -> respond <| Wai.responseLBS HTTP.status404 [(HTTP.hContentType, "text/plain")] "Trace not found"
Just rec -> do
html <- renderTraceHtml rec
respond <| Wai.responseLBS HTTP.status200 [(HTTP.hContentType, "text/html; charset=utf-8")] (LBS.fromStrict <| Encoding.encodeUtf8 html)
serveTraceJson :: FilePath -> Text -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
serveTraceJson dbPath tid _req respond = do
SQL.withConnection dbPath <| \conn -> do
maybeRec <- Trace.getTrace conn tid
case maybeRec of
Nothing -> respond <| Wai.responseLBS HTTP.status404 [(HTTP.hContentType, "application/json")] "{\"error\":\"not found\"}"
Just rec -> do
let json = Aeson.encode rec
respond <| Wai.responseLBS HTTP.status200 [(HTTP.hContentType, "application/json")] json
renderTraceHtml :: Trace.TraceRecord -> IO Text
renderTraceHtml rec =
pure
<| Text.replace "{{trace_id}}" (Trace.trcId rec)
<| Text.replace "{{tool_name}}" (Trace.trcToolName rec)
<| Text.replace "{{created_at}}" (Trace.trcCreatedAt rec)
<| Text.replace "{{duration_ms}}" (tshow <| Trace.trcDurationMs rec)
<| Text.replace "{{input_json}}" (escapeHtml <| Trace.trcInput rec)
<| Text.replace "{{output_json}}" (escapeHtml <| Trace.trcOutput rec)
<| traceTemplate
-- | Escape HTML special characters
escapeHtml :: Text -> Text
escapeHtml =
Text.replace "&" "&"
<. Text.replace "<" "<"
<. Text.replace ">" ">"
<. Text.replace "\"" """
-- | Embedded trace HTML template
traceTemplate :: Text
traceTemplate =
Text.unlines
[ "",
"",
"",
" ",
" ",
" Trace: {{tool_name}}",
" ",
"",
"",
" {{tool_name}}
",
" {{created_at}} · {{duration_ms}}ms
",
"",
" ",
"",
" ",
"",
" ",
"",
" ",
"",
""
]