From 9b1df01fd2cf3ecf41fc68b94051db665821c774 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Wed, 4 Aug 2021 11:09:35 -0400 Subject: 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. --- Biz/Que/Site.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'Biz/Que/Site.hs') diff --git a/Biz/Que/Site.hs b/Biz/Que/Site.hs index 06b86c8..e027717 100644 --- a/Biz/Que/Site.hs +++ b/Biz/Que/Site.hs @@ -20,12 +20,9 @@ import qualified Control.Concurrent.Async as Async import qualified Data.ByteString.Char8 as BS import qualified Data.Ini.Config as Config import qualified Data.Text as Text -import Data.Text.Encoding (encodeUtf8) import qualified Data.Text.IO as Text import Network.HTTP.Req import qualified System.Directory as Directory -import System.Environment as Environment -import qualified System.Exit as Exit import System.FilePath (()) import qualified System.Process as Process @@ -138,7 +135,8 @@ serve Nothing p _ _ = panic <| "no auth key provided for ns: " <> p serve (Just key) ns path content = runReq defaultHttpConfig <| do let options = - header "Authorization" (encodeUtf8 key) <> responseTimeout maxBound + header "Content-type" "text/html;charset=utf-8" + -- header "Authorization" (encodeUtf8 key) <> responseTimeout maxBound _ <- req POST -- cgit v1.2.3