web: Allow CORS to be enabled in hledger-web
Add a --cors option to the CLI to enable simple cross-origin requests
This commit is contained in:
parent
f1420cc770
commit
e96dfe832f
@ -10,6 +10,7 @@ module Hledger.Web.Application
|
|||||||
|
|
||||||
import Data.IORef (newIORef, writeIORef)
|
import Data.IORef (newIORef, writeIORef)
|
||||||
import Network.Wai.Middleware.RequestLogger (logStdoutDev, logStdout)
|
import Network.Wai.Middleware.RequestLogger (logStdoutDev, logStdout)
|
||||||
|
import Network.Wai.Middleware.Cors
|
||||||
import Network.HTTP.Client (defaultManagerSettings)
|
import Network.HTTP.Client (defaultManagerSettings)
|
||||||
import Network.HTTP.Conduit (newManager)
|
import Network.HTTP.Conduit (newManager)
|
||||||
import Yesod.Default.Config
|
import Yesod.Default.Config
|
||||||
@ -23,7 +24,7 @@ import Hledger.Web.Handler.UploadR
|
|||||||
import Hledger.Web.Handler.JournalR
|
import Hledger.Web.Handler.JournalR
|
||||||
import Hledger.Web.Handler.RegisterR
|
import Hledger.Web.Handler.RegisterR
|
||||||
import Hledger.Web.Import
|
import Hledger.Web.Import
|
||||||
import Hledger.Web.WebOptions (WebOpts(serve_,serve_api_))
|
import Hledger.Web.WebOptions (WebOpts(serve_,serve_api_,cors_))
|
||||||
|
|
||||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
-- 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
|
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
||||||
@ -38,11 +39,13 @@ makeApplication :: WebOpts -> Journal -> AppConfig DefaultEnv Extra -> IO Applic
|
|||||||
makeApplication opts' j' conf' = do
|
makeApplication opts' j' conf' = do
|
||||||
foundation <- makeFoundation conf' opts'
|
foundation <- makeFoundation conf' opts'
|
||||||
writeIORef (appJournal foundation) j'
|
writeIORef (appJournal foundation) j'
|
||||||
logWare <$> toWaiApp foundation
|
(logWare . corsWare) <$> toWaiApp foundation
|
||||||
where
|
where
|
||||||
logWare | development = logStdoutDev
|
logWare | development = logStdoutDev
|
||||||
| serve_ opts' || serve_api_ opts' = logStdout
|
| serve_ opts' || serve_api_ opts' = logStdout
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
|
corsWare | cors_ opts' = simpleCors
|
||||||
|
| otherwise = id
|
||||||
|
|
||||||
makeFoundation :: AppConfig DefaultEnv Extra -> WebOpts -> IO App
|
makeFoundation :: AppConfig DefaultEnv Extra -> WebOpts -> IO App
|
||||||
makeFoundation conf opts' = do
|
makeFoundation conf opts' = do
|
||||||
|
|||||||
@ -35,6 +35,10 @@ webflags =
|
|||||||
["serve-api"]
|
["serve-api"]
|
||||||
(setboolopt "serve-api")
|
(setboolopt "serve-api")
|
||||||
"like --serve, but serve only the JSON web API, without the server-side web UI"
|
"like --serve, but serve only the JSON web API, without the server-side web UI"
|
||||||
|
, flagNone
|
||||||
|
["cors"]
|
||||||
|
(setboolopt "cors")
|
||||||
|
("allow cross-origin requests, setting the Access-Control-Allow-Origin HTTP header to *")
|
||||||
, flagReq
|
, flagReq
|
||||||
["host"]
|
["host"]
|
||||||
(\s opts -> Right $ setopt "host" s opts)
|
(\s opts -> Right $ setopt "host" s opts)
|
||||||
@ -94,6 +98,7 @@ webmode =
|
|||||||
data WebOpts = WebOpts
|
data WebOpts = WebOpts
|
||||||
{ serve_ :: Bool
|
{ serve_ :: Bool
|
||||||
, serve_api_ :: Bool
|
, serve_api_ :: Bool
|
||||||
|
, cors_ :: Bool
|
||||||
, host_ :: String
|
, host_ :: String
|
||||||
, port_ :: Int
|
, port_ :: Int
|
||||||
, base_url_ :: String
|
, base_url_ :: String
|
||||||
@ -104,7 +109,7 @@ data WebOpts = WebOpts
|
|||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
defwebopts :: WebOpts
|
defwebopts :: WebOpts
|
||||||
defwebopts = WebOpts def def def def def def [CapView, CapAdd] Nothing def
|
defwebopts = WebOpts def def def def def def def [CapView, CapAdd] Nothing def
|
||||||
|
|
||||||
instance Default WebOpts where def = defwebopts
|
instance Default WebOpts where def = defwebopts
|
||||||
|
|
||||||
@ -126,6 +131,7 @@ rawOptsToWebOpts rawopts =
|
|||||||
defwebopts
|
defwebopts
|
||||||
{ serve_ = boolopt "serve" rawopts
|
{ serve_ = boolopt "serve" rawopts
|
||||||
, serve_api_ = boolopt "serve-api" rawopts
|
, serve_api_ = boolopt "serve-api" rawopts
|
||||||
|
, cors_ = boolopt "cors" rawopts
|
||||||
, host_ = h
|
, host_ = h
|
||||||
, port_ = p
|
, port_ = p
|
||||||
, base_url_ = b
|
, base_url_ = b
|
||||||
|
|||||||
@ -4,7 +4,7 @@ cabal-version: 1.12
|
|||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: 2039eae28649153b671940fd3813fa48b76193a9948b1bd466a7ef86575af9cd
|
-- hash: bb22226fe2d7562c91dc7dabb7767a786db0ea4441bb79b9016c414c0d5edf59
|
||||||
|
|
||||||
name: hledger-web
|
name: hledger-web
|
||||||
version: 1.15.99
|
version: 1.15.99
|
||||||
@ -184,6 +184,7 @@ library
|
|||||||
, time >=1.5
|
, time >=1.5
|
||||||
, transformers
|
, transformers
|
||||||
, wai
|
, wai
|
||||||
|
, wai-cors
|
||||||
, wai-extra
|
, wai-extra
|
||||||
, wai-handler-launch >=1.3
|
, wai-handler-launch >=1.3
|
||||||
, warp
|
, warp
|
||||||
|
|||||||
@ -132,6 +132,7 @@ library:
|
|||||||
- wai
|
- wai
|
||||||
- wai-extra
|
- wai-extra
|
||||||
- wai-handler-launch >=1.3
|
- wai-handler-launch >=1.3
|
||||||
|
- wai-cors
|
||||||
- warp
|
- warp
|
||||||
- yaml
|
- yaml
|
||||||
# on mac Sierra or greater, ghc 7 will fail to build yesod; don't try
|
# on mac Sierra or greater, ghc 7 will fail to build yesod; don't try
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user