summaryrefslogtreecommitdiff
path: root/Run/Que/Website.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Run/Que/Website.hs')
-rw-r--r--Run/Que/Website.hs65
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