diff options
Diffstat (limited to 'Run/Que/Website.hs')
-rw-r--r-- | Run/Que/Website.hs | 65 |
1 files changed, 38 insertions, 27 deletions
diff --git a/Run/Que/Website.hs b/Run/Que/Website.hs index 5e2f4d6..23e3740 100644 --- a/Run/Que/Website.hs +++ b/Run/Que/Website.hs @@ -35,26 +35,33 @@ main :: IO () main = do (src, ns) <- Environment.getArgs >>= \case [src] -> return (src, "_") -- default to _ ns which is special - [src, ns] -> return (src, ns) + [src, ns] -> return (src, Text.pack ns) _ -> Exit.die "usage: que-website <srcdir> [namespace]" + mKey <- getKey ns + putText $ "serving " <> Text.pack src <> " at " <> ns + run mKey ns $ Sources { index = src </> "index.md" + , client = src </> "client.py" + , quescripts = src </> "quescripts.md" + , style = src </> "style.css" + , apidocs = src </> "apidocs.md" + , tutorial = src </> "tutorial.md" + } + +getKey :: Namespace -> IO (Maybe Key) +getKey ns = do home <- Directory.getHomeDirectory - conf <- Text.readFile <| home </> ".config" </> "que.conf" - let (Auth _ key) = - either needConf identity - <| Config.parseIniFile conf - <| auth - <| Text.pack ns - putStrLn $ "serving " ++ src ++ " at " ++ ns - run key (Text.pack ns) $ Sources { index = src </> "index.md" - , client = src </> "client.py" - , quescripts = src </> "quescripts.md" - , style = src </> "style.css" - , apidocs = src </> "apidocs.md" - , tutorial = src </> "tutorial.md" - } + let file = home </> ".config" </> "que.conf" + exists <- (Directory.doesFileExist file) + unless exists <| panic <| "not found: " <> Text.pack file + conf <- Text.readFile file + print (home </> ".config" </> "que.conf") + auth ns + |> Config.parseIniFile conf + |> either errorParsingConf identity + |> return -needConf :: error -needConf = panic "you need a ~/.config/que.conf" +errorParsingConf :: error +errorParsingConf = panic "could not parse ~/.config/que.conf" data Sources = Sources { index :: FilePath @@ -68,14 +75,11 @@ data Sources = Sources type Namespace = Text type Key = Text -data Auth = Auth Namespace Key - -auth :: Text -> Config.IniParser Auth -auth ns = Config.section ns $ do - key <- Config.field "key" - return <| Auth ns key +auth :: Namespace -> Config.IniParser (Maybe Key) +auth "pub" = pure Nothing +auth ns = Config.sectionMb ns <| Config.field "key" -run :: Key -> Text -> Sources -> IO () +run :: Maybe Key -> Text -> Sources -> IO () run key ns Sources {..} = Async.runConcurrently actions >> return () where actions = traverse @@ -103,9 +107,16 @@ run key ns Sources {..} = Async.runConcurrently actions >> return () ] [] --- TODO: recover from 502 errors -serve :: Key -> Namespace -> Text -> ByteString -> IO () -serve key ns path content = runReq defaultHttpConfig $ do +serve :: Maybe Key -> Namespace -> Text -> ByteString -> IO () +serve Nothing "pub" path content = runReq defaultHttpConfig $ do + _ <- req POST + (http "que.run" /: "pub" /: path) + (ReqBodyBs content) + ignoreResponse + mempty + liftIO $ return () +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 _ <- req POST |