imp:web: add an explicit --serve-browse flag, for consistency
This commit is contained in:
Simon Michael
parent
2f0cb50997
commit
7aae0d9595
@ -269,8 +269,8 @@ getViewData = do
|
||||
|
||||
checkServerSideUiEnabled :: Handler ()
|
||||
checkServerSideUiEnabled = do
|
||||
VD{opts=WebOpts{serve_api_}} <- getViewData
|
||||
when serve_api_ $
|
||||
VD{opts=WebOpts{server_mode_}} <- getViewData
|
||||
when (server_mode_ == ServeJson) $
|
||||
-- this one gives 500 internal server error when called from defaultLayout:
|
||||
-- permissionDenied "server-side UI is disabled due to --serve-api"
|
||||
sendResponseStatus status403 ("server-side UI is disabled due to --serve-api" :: Text)
|
||||
|
||||
@ -29,7 +29,7 @@ import Hledger.Web.Handler.UploadR
|
||||
import Hledger.Web.Handler.JournalR
|
||||
import Hledger.Web.Handler.RegisterR
|
||||
import Hledger.Web.Import
|
||||
import Hledger.Web.WebOptions (WebOpts(serve_,serve_api_), corsPolicy)
|
||||
import Hledger.Web.WebOptions (ServerMode(..), WebOpts(server_mode_), corsPolicy)
|
||||
|
||||
-- mkYesodDispatch creates our YesodDispatch instance.
|
||||
-- It complements the mkYesodData call in App.hs,
|
||||
@ -47,7 +47,7 @@ makeApplication opts' j' conf' = do
|
||||
(logWare . (corsPolicy opts')) <$> toWaiApp app
|
||||
where
|
||||
logWare | development = logStdoutDev
|
||||
| serve_ opts' || serve_api_ opts' = logStdout
|
||||
| server_mode_ opts' `elem` [Serve, ServeJson] = logStdout
|
||||
| otherwise = id
|
||||
|
||||
makeApp :: AppConfig DefaultEnv Extra -> WebOpts -> IO App
|
||||
|
||||
@ -105,8 +105,9 @@ web opts j = do
|
||||
|
||||
-- show configuration
|
||||
let
|
||||
services | serve_api_ opts = "json API"
|
||||
| otherwise = "web UI and json API"
|
||||
services
|
||||
| server_mode_ opts == ServeJson = "json API"
|
||||
| otherwise = "web UI and json API"
|
||||
prettyip ip
|
||||
| ip == "127.0.0.1" = ip ++ " (local access)"
|
||||
| ip == "0.0.0.0" = ip ++ " (all interfaces)"
|
||||
@ -121,8 +122,15 @@ web opts j = do
|
||||
Nothing -> pure ()
|
||||
|
||||
-- start server and maybe browser
|
||||
if serve_ opts || serve_api_ opts
|
||||
if server_mode_ opts == ServeBrowse
|
||||
then do
|
||||
putStrLn "This server will exit after 2m with no browser windows open (or press ctrl-c)"
|
||||
putStrLn "Opening web browser..."
|
||||
hFlush stdout
|
||||
-- exits after 2m of inactivity (hardcoded)
|
||||
Network.Wai.Handler.Launch.runHostPortFullUrl h p u app
|
||||
|
||||
else do
|
||||
putStrLn "Press ctrl-c to quit"
|
||||
hFlush stdout
|
||||
let warpsettings = setHost (fromString h) (setPort p defaultSettings)
|
||||
@ -149,10 +157,3 @@ web opts j = do
|
||||
|
||||
Nothing -> Network.Wai.Handler.Warp.runSettings warpsettings app
|
||||
|
||||
else do
|
||||
putStrLn "This server will exit after 2m with no browser windows open (or press ctrl-c)"
|
||||
putStrLn "Opening web browser..."
|
||||
hFlush stdout
|
||||
-- exits after 2m of inactivity (hardcoded)
|
||||
Network.Wai.Handler.Launch.runHostPortFullUrl h p u app
|
||||
|
||||
|
||||
@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Hledger.Web.WebOptions where
|
||||
|
||||
@ -54,13 +55,17 @@ prognameandversion =
|
||||
webflags :: [Flag RawOpts]
|
||||
webflags =
|
||||
[ flagNone
|
||||
["serve-browse"]
|
||||
(setboolopt "serve-browse")
|
||||
(serveprefix ++ "serve the web UI and JSON API, and open a browser, and exit if inactive for 2m (default)")
|
||||
, flagNone
|
||||
["serve"]
|
||||
(setboolopt "serve")
|
||||
"serve and log requests, don't browse or auto-exit"
|
||||
(serveprefix ++ "just serve the web UI and JSON API")
|
||||
, flagNone
|
||||
["serve-api"]
|
||||
(setboolopt "serve-api")
|
||||
"like --serve, but serve only the JSON web API, not the web UI"
|
||||
(serveprefix ++ "just serve the JSON API")
|
||||
, flagReq
|
||||
["allow"]
|
||||
(\s opts -> Right $ setopt "allow" s opts)
|
||||
@ -85,7 +90,7 @@ webflags =
|
||||
["socket"]
|
||||
(\s opts -> Right $ setopt "socket" s opts)
|
||||
"SOCKET"
|
||||
"listen on the given unix socket instead of an IP address and port (unix only; implies --serve)"
|
||||
"listen on the given unix socket instead of an IP address and port (only on unix)"
|
||||
, flagReq
|
||||
["base-url"]
|
||||
(\s opts -> Right $ setopt "base-url" s opts)
|
||||
@ -102,6 +107,8 @@ webflags =
|
||||
(setboolopt "test")
|
||||
"run hledger-web's tests and exit. hspec test runner args may follow a --, eg: hledger-web --test -- --help"
|
||||
]
|
||||
where
|
||||
serveprefix = ""
|
||||
|
||||
webmode :: Mode RawOpts
|
||||
webmode =
|
||||
@ -116,16 +123,17 @@ webmode =
|
||||
{ groupUnnamed = webflags
|
||||
, groupHidden = hiddenflags
|
||||
++
|
||||
[flagNone ["server"] (setboolopt "serve") "old flag, use --serve instead"
|
||||
[flagNone ["server"] (setboolopt "serve") "old flag, use --serve instead"]
|
||||
, groupNamed = mkgeneralflagsgroups1 helpflags
|
||||
}
|
||||
, modeHelpSuffix = []
|
||||
}
|
||||
|
||||
data ServerMode = ServeBrowse | Serve | ServeJson deriving (Show, Eq)
|
||||
|
||||
-- hledger-web options, used in hledger-web and above
|
||||
data WebOpts = WebOpts
|
||||
{ serve_ :: !Bool
|
||||
, serve_api_ :: !Bool
|
||||
{ server_mode_ :: !ServerMode
|
||||
, cors_ :: !(Maybe String)
|
||||
, host_ :: !String
|
||||
, port_ :: !Int
|
||||
@ -138,8 +146,7 @@ data WebOpts = WebOpts
|
||||
|
||||
defwebopts :: WebOpts
|
||||
defwebopts = WebOpts
|
||||
{ serve_ = False
|
||||
, serve_api_ = False
|
||||
{ server_mode_ = ServeBrowse
|
||||
, cors_ = Nothing
|
||||
, host_ = ""
|
||||
, port_ = def
|
||||
@ -174,10 +181,7 @@ rawOptsToWebOpts rawopts =
|
||||
Left err -> error' ("Unknown access level: " ++ err) -- PARTIAL:
|
||||
return
|
||||
defwebopts
|
||||
{ serve_ = case sock of
|
||||
Just _ -> True
|
||||
Nothing -> boolopt "serve" rawopts
|
||||
, serve_api_ = boolopt "serve-api" rawopts
|
||||
{ server_mode_ = servermodeopt rawopts
|
||||
, cors_ = maybestringopt "cors" rawopts
|
||||
, host_ = h
|
||||
, port_ = p
|
||||
@ -190,6 +194,16 @@ rawOptsToWebOpts rawopts =
|
||||
where
|
||||
stripTrailingSlash = reverse . dropWhile (== '/') . reverse -- yesod don't like it
|
||||
|
||||
servermodeopt :: RawOpts -> ServerMode
|
||||
servermodeopt =
|
||||
fromMaybe ServeBrowse . choiceopt parse
|
||||
where
|
||||
parse = \case
|
||||
"serve-browse" -> Just ServeBrowse
|
||||
"serve" -> Just Serve
|
||||
"serve-api" -> Just ServeJson
|
||||
_ -> Nothing
|
||||
|
||||
checkWebOpts :: WebOpts -> WebOpts
|
||||
checkWebOpts wopts@WebOpts{..}
|
||||
| not $ null base_url_ || "http://" `isPrefixOf` base_url_ || "https://" `isPrefixOf` base_url_ =
|
||||
|
||||
@ -50,14 +50,15 @@ Like hledger, it _inputfileswithptr_
|
||||
|
||||
hledger-web can be run in three modes:
|
||||
|
||||
- Transient mode (the default):
|
||||
your default web browser will be opened to show the app if possible,
|
||||
and the app exits automatically after two minutes of inactivity
|
||||
(no requests received and no open browser windows viewing it).
|
||||
- `--serve-browse` mode (the default):
|
||||
the app serves the web UI and JSON API,
|
||||
and opens your default web browser to show the app if possible,
|
||||
and exits automatically after two minutes of inactivity
|
||||
(with no requests received and no open browser windows viewing it).
|
||||
|
||||
- With `--serve`: the app runs without stopping, and without opening a browser.
|
||||
- `--serve`: the app just serves the web UI and JSON API.
|
||||
|
||||
- With `--serve-api`: only the JSON API is served.
|
||||
- `--serve-api`: the app just serves the JSON API.
|
||||
|
||||
In all cases hledger-web runs as a foreground process, logging requests to stdout.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user