slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

imp: web: require a http[s] scheme in --base-url

Browse Source 
Previously it accepted just a hostname, and generated bad links.
This commit is contained in:
Simon Michael 2024-07-18 09:37:11 +01:00
parent c0a4983e87
commit 13a5299237
1 changed files with 6 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
hledger-web/Hledger/Web/WebOptions.hs
View File

@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.Web.WebOptions where module Hledger.Web.WebOptions where
@ -20,6 +21,7 @@ import Hledger.Cli hiding (packageversion, progname, prognameandversion)
import Hledger.Web.Settings (defhost, defport, defbaseurl) import Hledger.Web.Settings (defhost, defport, defbaseurl)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Char (toLower) import Data.Char (toLower)
import Data.List (isPrefixOf)
-- cf Hledger.Cli.Version -- cf Hledger.Cli.Version
@ -183,7 +185,10 @@ rawOptsToWebOpts rawopts =
stripTrailingSlash = reverse . dropWhile (== '/') . reverse -- yesod don't like it stripTrailingSlash = reverse . dropWhile (== '/') . reverse -- yesod don't like it
checkWebOpts :: WebOpts -> WebOpts checkWebOpts :: WebOpts -> WebOpts
checkWebOpts = id checkWebOpts wopts@WebOpts{..}
| not $ null base_url_ || "http://" `isPrefixOf` base_url_ || "https://" `isPrefixOf` base_url_ =
error' "please begin the --base-url value with http:// or https://"
| otherwise = wopts
getHledgerWebOpts :: IO WebOpts getHledgerWebOpts :: IO WebOpts
getHledgerWebOpts = do getHledgerWebOpts = do