simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-12-28 12:54:07 +03:00
Code Issues 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 OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.Web.WebOptions where
@ -20,6 +21,7 @@ import Hledger.Cli hiding (packageversion, progname, prognameandversion)
import Hledger.Web.Settings (defhost, defport, defbaseurl)
import qualified Data.Text as T
import Data.Char (toLower)
import Data.List (isPrefixOf)
-- cf Hledger.Cli.Version
@ -183,7 +185,10 @@ rawOptsToWebOpts rawopts =
stripTrailingSlash = reverse . dropWhile (== '/') . reverse -- yesod don't like it
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 = do