1 files changed, 84 insertions, 0 deletions
diff --git a/Omni/Ava/Web.hs b/Omni/Ava/Web.hs
new file mode 100644
index 0000000..86a8280
--- /dev/null
+++ b/Omni/Ava/Web.hs
@@ -0,0 +1,84 @@
+{-# 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,
+  )
+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 Data.Text.IO as TextIO
+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
+import qualified System.Environment as Environment
+
+defaultPort :: Int
+defaultPort = 8079
+
+startWebServer :: Int -> FilePath -> IO ()
+startWebServer port dbPath = do
+  putText <| "Starting Ava web server on port " <> tshow port
+  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 = do
+  coderoot <- Environment.getEnv "CODEROOT"
+  let templatePath = coderoot <> "/Omni/Ava/Web/trace.html"
+  template <- TextIO.readFile templatePath
+  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}}" (Trace.trcInput rec)
+    <| Text.replace "{{output_json}}" (Trace.trcOutput rec)
+    <| template