@@ -1,4 +1,7 @@
11{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE PartialTypeSignatures #-}
3+{-# LANGUAGE TypeOperators #-}
4+{-# LANGUAGE DataKinds #-}
25module OddJobs.Cli where
36
47import Options.Applicative as Opts
@@ -13,7 +16,13 @@ import System.Environment (getProgName)
1316import OddJobs.Types (Seconds(..), delaySeconds)
1417import qualified System.Posix.Signals as Sig
1518import qualified UnliftIO.Async as Async
16−
19+import qualified OddJobs.Endpoints as UI
20+import Servant.Server as Servant
21+import Servant.API
22+import Data.Proxy
23+import Data.Text.Encoding (decodeUtf8)
24+import Network.Wai.Handler.Warp as Warp
25+import Debug.Trace
1726
1827-- * Introduction
1928--
@@ -95,15 +104,16 @@ defaultStartCommand :: StartArgs
95104 -- ^ the same callback-within-callback function described in
96105 -- 'defaultMain'
97106 -> IO ()
98−defaultStartCommand StartArgs{..} startFn = do
107+defaultStartCommand args@StartArgs{..} startFn = do
99108 progName <- getProgName
100109 case startDaemonize of
101110 False -> do
102− startFn startJobRunner
111+ startFn coreStartupFn
103112 True -> do
104113 (Dir.doesPathExist startPidFile) >>= \case
105114 True -> do
106− putStrLn $ "PID file already exists. Please check if " <> progName <> " is still running in the background." <>
115+ putStrLn $
116+ "PID file already exists. Please check if " <> progName <> " is still running in the background." <>
107117 " If not, you can safely delete this file and start " <> progName <> " again: " <> startPidFile
108118 Exit.exitWith (Exit.ExitFailure 1)
109119 False -> do
@@ -111,7 +121,32 @@ defaultStartCommand StartArgs{..} startFn = do
111121 pid <- getProcessID
112122 writeFile startPidFile (show pid)
113123 putStrLn $ "Started " <> progName <> " in background with PID=" <> show pid <> ". PID written to " <> startPidFile
114− startFn $ \jm -> startJobRunner jm{cfgPidFile = Just startPidFile}
124+ startFn $ \cfg -> coreStartupFn cfg{cfgPidFile = Just startPidFile}
125+ where
126+ coreStartupFn cfg = do
127+ Async.withAsync (defaultWebUi args cfg) $ \_ -> do
128+ startJobRunner cfg
129+
130+
131+defaultWebUi :: StartArgs
132+ -> Config
133+ -> IO ()
134+defaultWebUi StartArgs{..} cfg@Config{..} = do
135+ env <- UI.mkEnv cfg ("/" <>)
136+ case startWebUiAuth of
137+ Nothing -> pure ()
138+ Just AuthNone ->
139+ let app = UI.server cfg env Prelude.id
140+ in Warp.run startWebUiPort $
141+ Servant.serve (Proxy :: Proxy UI.FinalAPI) app
142+ Just (AuthBasic u p) ->
143+ let api = Proxy :: Proxy (BasicAuth "OddJobs Admin UI" OddJobsUser :> UI.FinalAPI)
144+ ctx = defaultBasicAuth (u, p) :. EmptyContext
145+ -- Now the app will receive an extra argument for OddJobsUser,
146+ -- which we aren't really interested in.
147+ app _ = UI.server cfg env Prelude.id
148+ in Warp.run startWebUiPort $
149+ Servant.serveWithContext api ctx app
115150
116151{-| Used by 'defaultMain' if 'Stop' command is issued via the CLI. Sends a
117152@SIGINT@ signal to the process indicated by 'shutPidFile'. Waits for a maximum
@@ -191,8 +226,10 @@ commandParser = hsubparser
191226-- | @start@ command is parsed into this data-structure by 'startParser'
192227data StartArgs = StartArgs
193228 {
194− -- | Switch to enable/disable the web UI (the web UI is still WIP)
195− startWebUiEnable :: !Bool
229+ -- | Switch to enable/disable the web UI
230+ startWebUiAuth :: !(Maybe WebUiAuth)
231+ -- | Port on which the web UI will run.
232+ , startWebUiPort :: !Int
196233 -- | You'll need to pass the @--daemonize@ switch to fork the job-runner as
197234 -- a background daemon, else it will keep running as a foreground process.
198235 , startDaemonize :: !Bool
@@ -202,14 +239,39 @@ data StartArgs = StartArgs
202239
203240startParser :: Parser Command
204241startParser = fmap Start $ StartArgs
205− <$> switch ( long "web-ui-enable" <>
206− help "Please look at other web-ui-* options to configure the Web UI"
207− )
242+ <$> webUiAuthParser
243+ <*> option auto ( long "web-ui-port" <>
244+ metavar "PORT" <>
245+ value 7777 <>
246+ showDefault <>
247+ help "The port on which the Web UI listens. Please note, to actually enable the Web UI you need to pick one of the available auth schemes"
248+ )
208249 <*> switch ( long "daemonize" <>
209250 help "Fork the job-runner as a background daemon. If omitted, the job-runner remains in the foreground."
210251 )
211252 <*> pidFileParser
212253
254+data WebUiAuth
255+ = AuthNone
256+ | AuthBasic !Text !Text
257+ deriving (Eq, Show)
258+
259+webUiAuthParser :: Parser (Maybe WebUiAuth)
260+webUiAuthParser = basicAuthParser <|> noAuthParser <|> (pure Nothing)
261+ where
262+ basicAuthParser = fmap Just $ AuthBasic
263+ <$> strOption ( long "web-ui-basic-auth-user" <>
264+ metavar "USER" <>
265+ help "Username for basic auth"
266+ )
267+ <*> strOption ( long "web-ui-basic-auth-password" <>
268+ metavar "PASS" <>
269+ help "Password for basic auth"
270+ )
271+ noAuthParser = flag' (Just AuthNone)
272+ ( long "web-ui-no-auth" <>
273+ help "Start the web UI with any authentication. NOT RECOMMENDED."
274+ )
213275
214276-- ** Stop command
215277
@@ -274,3 +336,16 @@ defaultDaemonOptions = DaemonOptions
274336 }
275337
276338
339+-- ** Auth implementations for the default Web UI
340+
341+-- *** Basic Auth
342+
343+data OddJobsUser = OddJobsUser !Text !Text deriving (Eq, Show)
344+
345+defaultBasicAuth :: (Text, Text) -> BasicAuthCheck OddJobsUser
346+defaultBasicAuth (user, pass) = BasicAuthCheck $ \b ->
347+ let u = decodeUtf8 (basicAuthUsername b)
348+ p = decodeUtf8 (basicAuthPassword b)
349+ in if u==user && p==pass
350+ then pure (Authorized $ OddJobsUser u p)
351+ else pure BadPassword