From 4efd0242da31310bc5fc7b6d9640ac38d7cbe27f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alejandro=20Garc=C3=ADa=20Montoro?= Date: Mon, 7 Oct 2019 11:29:06 +0200 Subject: [PATCH] web: Modify the --cors option to require a specific origin - Modified the cors option to require a String - Moved the logic to build the cors policy to WebOptions.hs - Specify the --cors "*" example in the cors option help - Added utf8-string dependency to convert a String into a ByteString --- hledger-web/Hledger/Web/Application.hs | 7 ++---- hledger-web/Hledger/Web/WebOptions.hs | 34 +++++++++++++++++++++----- hledger-web/hledger-web.cabal | 3 ++- hledger-web/package.yaml | 1 + 4 files changed, 33 insertions(+), 12 deletions(-) diff --git a/hledger-web/Hledger/Web/Application.hs b/hledger-web/Hledger/Web/Application.hs index 5ac984226..50fecbdb6 100644 --- a/hledger-web/Hledger/Web/Application.hs +++ b/hledger-web/Hledger/Web/Application.hs @@ -10,7 +10,6 @@ module Hledger.Web.Application import Data.IORef (newIORef, writeIORef) import Network.Wai.Middleware.RequestLogger (logStdoutDev, logStdout) -import Network.Wai.Middleware.Cors import Network.HTTP.Client (defaultManagerSettings) import Network.HTTP.Conduit (newManager) import Yesod.Default.Config @@ -24,7 +23,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_,cors_)) +import Hledger.Web.WebOptions (WebOpts(serve_,serve_api_), corsPolicy) -- This line actually creates our YesodDispatch instance. It is the second half -- of the call to mkYesodData which occurs in Foundation.hs. Please see the @@ -39,13 +38,11 @@ makeApplication :: WebOpts -> Journal -> AppConfig DefaultEnv Extra -> IO Applic makeApplication opts' j' conf' = do foundation <- makeFoundation conf' opts' writeIORef (appJournal foundation) j' - (logWare . corsWare) <$> toWaiApp foundation + (logWare . (corsPolicy opts')) <$> toWaiApp foundation where logWare | development = logStdoutDev | serve_ opts' || serve_api_ opts' = logStdout | otherwise = id - corsWare | cors_ opts' = simpleCors - | otherwise = id makeFoundation :: AppConfig DefaultEnv Extra -> WebOpts -> IO App makeFoundation conf opts' = do diff --git a/hledger-web/Hledger/Web/WebOptions.hs b/hledger-web/Hledger/Web/WebOptions.hs index 51feb9f42..9b172e6e8 100644 --- a/hledger-web/Hledger/Web/WebOptions.hs +++ b/hledger-web/Hledger/Web/WebOptions.hs @@ -4,6 +4,7 @@ module Hledger.Web.WebOptions where import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BC +import Data.ByteString.UTF8 (fromString) import Data.CaseInsensitive (CI, mk) import Control.Monad (join) import Data.Default (Default(def)) @@ -11,6 +12,8 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Text (Text) import System.Environment (getArgs) +import Network.Wai as WAI +import Network.Wai.Middleware.Cors import Hledger.Cli hiding (progname, version) import Hledger.Web.Settings (defhost, defport, defbaseurl) @@ -35,10 +38,11 @@ webflags = ["serve-api"] (setboolopt "serve-api") "like --serve, but serve only the JSON web API, without the server-side web UI" - , flagNone + , flagReq ["cors"] - (setboolopt "cors") - ("allow cross-origin requests, setting the Access-Control-Allow-Origin HTTP header to *") + (\s opts -> Right $ setopt "cors" s opts) + "ORIGIN" + ("allow cross-origin requests from the specified origin; setting ORIGIN to \"*\" allows requests from any origin") , flagReq ["host"] (\s opts -> Right $ setopt "host" s opts) @@ -98,7 +102,7 @@ webmode = data WebOpts = WebOpts { serve_ :: Bool , serve_api_ :: Bool - , cors_ :: Bool + , cors_ :: Maybe String , host_ :: String , port_ :: Int , base_url_ :: String @@ -109,7 +113,7 @@ data WebOpts = WebOpts } deriving (Show) defwebopts :: WebOpts -defwebopts = WebOpts def def def def def def def [CapView, CapAdd] Nothing def +defwebopts = WebOpts def def Nothing def def def def [CapView, CapAdd] Nothing def instance Default WebOpts where def = defwebopts @@ -131,7 +135,7 @@ rawOptsToWebOpts rawopts = defwebopts { serve_ = boolopt "serve" rawopts , serve_api_ = boolopt "serve-api" rawopts - , cors_ = boolopt "cors" rawopts + , cors_ = maybestringopt "cors" rawopts , host_ = h , port_ = p , base_url_ = b @@ -172,3 +176,21 @@ capabilityFromBS "view" = Right CapView capabilityFromBS "add" = Right CapAdd capabilityFromBS "manage" = Right CapManage capabilityFromBS x = Left x + +simplePolicyWithOrigin :: Origin -> CorsResourcePolicy +simplePolicyWithOrigin origin = + simpleCorsResourcePolicy { corsOrigins = Just ([origin], False) } + + +corsPolicyFromString :: String -> WAI.Middleware +corsPolicyFromString origin = + let + policy = case origin of + "*" -> simpleCorsResourcePolicy + url -> simplePolicyWithOrigin $ fromString url + in + cors (const $ Just policy) + +corsPolicy :: WebOpts -> (Application -> Application) +corsPolicy opts = + maybe id corsPolicyFromString $ cors_ opts diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index f58d1b555..7db401ca4 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: bb22226fe2d7562c91dc7dabb7767a786db0ea4441bb79b9016c414c0d5edf59 +-- hash: 4595326c17d463479b0d80c19012ffd367ef2cedbbdee610e8792fd88d4e4c4c name: hledger-web version: 1.15.99 @@ -183,6 +183,7 @@ library , text >=1.2 , time >=1.5 , transformers + , utf8-string , wai , wai-cors , wai-extra diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml index d4e59e476..79ea09fbc 100644 --- a/hledger-web/package.yaml +++ b/hledger-web/package.yaml @@ -129,6 +129,7 @@ library: - text >=1.2 - time >=1.5 - transformers + - utf8-string - wai - wai-extra - wai-handler-launch >=1.3