Reimplement Que with Servant

Still todo: add authentication. But that can wait.

In re-implementing this, I was able to figure out how to get the Go.mult working
properly as well. The problem is that a tap from a mult channel does not remove
the message from the original channel. I'm not sure if that should be a core
feature or not; for now I'm just draining the channel when it's received in the
Que HTTP handler. (Also, this would be a good place to put persistence: have a
background job read from the original channel, and write the msg to disk via
acid-state; this would obviate the need for a flush to nowhere.)

Also, streaming is working now. The problem was that Scotty closes the
connection after it sees a newline in the body, or something, so streaming over
Scotty doesn't actually work. It's fine, Servant is better anyway.

1 files changed, 14 insertions, 0 deletions

diff --git a/Biz/Log.hs b/Biz/Log.hs
index 747efed..9304cf7 100644
--- a/Biz/Log.hs
+++ b/Biz/Log.hs
@@ -13,6 +13,8 @@ module Biz.Log
     -- Operators
     (~&),
     (~?),
+    -- Wai Middleware
+    wai,
     -- | Low-level
     msg,
     br,
@@ -21,6 +23,7 @@ where
 
 import Alpha hiding (pass)
 import qualified Data.Text as Text
+import qualified Network.Wai as Wai
 import Rainbow (chunk, fore, green, magenta, red, white, yellow)
 import qualified Rainbow
 import qualified System.Environment as Env
@@ -87,3 +90,14 @@ mark label val =
 -- | Conditional mark.
 (~?) :: Show a => a -> (a -> Bool) -> Text -> a
 (~?) val test label = if test val then mark label val else val
+
+wai :: Wai.Middleware
+wai app req sendResponse =
+  app req <| \res ->
+    info
+      [ str <| Wai.requestMethod req,
+        show <| Wai.remoteHost req,
+        str <| Wai.rawPathInfo req
+      ]
+      >> br
+      >> sendResponse res