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,9 +132,10 @@ 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 | ||||||
|   when: |   when: | ||||||
|     - condition: os(darwin) && impl(ghc < 8.0) |     - condition: os(darwin) && impl(ghc < 8.0) | ||||||
|       then: |       then: | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user