diff options
Diffstat (limited to 'Que/Server.hs')
| -rw-r--r-- | Que/Server.hs | 35 |
1 files changed, 13 insertions, 22 deletions
diff --git a/Que/Server.hs b/Que/Server.hs index 4cb0b32..9217ee8 100644 --- a/Que/Server.hs +++ b/Que/Server.hs @@ -25,13 +25,7 @@ module Que.Server ) where -import Alpha hiding - ( Text, - get, - gets, - modify, - poll, - ) +import Alpha hiding (gets, modify, poll) import qualified Control.Concurrent.Go as Go import qualified Control.Concurrent.STM as STM import qualified Control.Exception as Exception @@ -41,11 +35,8 @@ import qualified Data.ByteString.Lazy as BSL import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HashMap import qualified Data.Text.Encoding as Encoding -import Data.Text.Lazy - ( Text, - fromStrict, - ) -import qualified Data.Text.Lazy.IO as Text +import qualified Data.Text.Lazy as Text.Lazy +import qualified Data.Text.Lazy.IO as Text.Lazy.IO import qualified Network.HTTP.Types.Status as Http import qualified Network.Wai as Wai import qualified Network.Wai.Handler.Warp as Warp @@ -105,7 +96,7 @@ instance Envy.DefConfig Config where instance Envy.FromEnv Config -routes :: Scotty.ScottyT Text App () +routes :: Scotty.ScottyT Text.Lazy.Text App () routes = do Scotty.middleware logStdout let quepath = "^\\/([[:alnum:]_-]+)\\/([[:alnum:]._/-]*)$" @@ -117,7 +108,7 @@ routes = do -- GET /_/dash Scotty.get (Scotty.literal "/_/dash") <| do authkey <- fromMaybe "" </ Scotty.header "Authorization" - adminkey <- liftIO <| lchomp </ Text.readFile "/run/keys/que-admin" + adminkey <- liftIO <| lchomp </ Text.Lazy.IO.readFile "/run/keys/que-admin" if authkey == adminkey then do d <- app <| gets ques @@ -141,7 +132,7 @@ routes = do q <- app <| que ns qp poll <- Scotty.param "poll" !: (pure . const False) if poll - then Scotty.stream $ streamQue q + then Scotty.stream <| streamQue q else do r <- liftIO <| Go.read q Scotty.html <| fromStrict <| Encoding.decodeUtf8 r @@ -150,7 +141,7 @@ routes = do -- Put a value on a que. Returns immediately. Scotty.post (Scotty.regex quepath) <| do authkey <- fromMaybe "" </ Scotty.header "Authorization" - adminkey <- liftIO <| lchomp </ Text.readFile "/run/keys/que-admin" + adminkey <- liftIO <| lchomp </ Text.Lazy.IO.readFile "/run/keys/que-admin" (ns, qp) <- extract -- Only allow my IP or localhost to publish to '_' namespace when ("_" == ns && authkey /= adminkey) @@ -167,7 +158,7 @@ routes = do -- | Given `guardNs ns whitelist`, if `ns` is not in the `whitelist` -- list, return a 405 error. -guardNs :: Text -> [Text] -> Scotty.ActionT Text App () +guardNs :: Text.Lazy.Text -> [Text.Lazy.Text] -> Scotty.ActionT Text.Lazy.Text App () guardNs ns whitelist = when (not <| ns `elem` whitelist) <| do Scotty.status Http.methodNotAllowed405 Scotty.text @@ -179,10 +170,10 @@ guardNs ns whitelist = when (not <| ns `elem` whitelist) <| do -- | recover from a scotty-thrown exception. (!:) :: -- | action that might throw - Scotty.ActionT Text App a -> + Scotty.ActionT Text.Lazy.Text App a -> -- | a function providing a default response instead - (Text -> Scotty.ActionT Text App a) -> - Scotty.ActionT Text App a + (Text.Lazy.Text -> Scotty.ActionT Text.Lazy.Text App a) -> + Scotty.ActionT Text.Lazy.Text App a (!:) = Scotty.rescue -- | Forever write the data from 'Que' to 'Wai.StreamingBody'. @@ -212,7 +203,7 @@ insertQue ns qp q as = as {ques = newQues} newQues = HashMap.insert ns newQbase (ques as) newQbase = HashMap.insert qp q <| grab ns <| ques as -extract :: Scotty.ActionT Text App (Namespace, Quepath) +extract :: Scotty.ActionT Text.Lazy.Text App (Namespace, Quepath) extract = do ns <- Scotty.param "1" path <- Scotty.param "2" @@ -232,7 +223,7 @@ modify :: (AppState -> AppState) -> App () modify f = ask >>= liftIO . atomically . flip STM.modifyTVar' f -- | housing for a set of que paths -type Namespace = Text +type Namespace = Text.Lazy.Text -- | a que is just a channel of bytes type Que = Go.Channel Message |