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

web: with --serve-api, also disable the header/sidebar HTML

Browse Source
This commit is contained in:
Simon Michael 2019-08-17 16:57:55 +01:00
parent 53b995bcd2
commit a154ea72c0
1 changed files with 12 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
hledger-web/Hledger/Web/Foundation.hs
View File

@ -26,6 +26,7 @@ import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import Network.HTTP.Conduit (Manager) import Network.HTTP.Conduit (Manager)
import Network.HTTP.Types (status403)
import Network.Wai (requestHeaders) import Network.Wai (requestHeaders)
import System.FilePath (takeFileName) import System.FilePath (takeFileName)
import Text.Blaze (Markup) import Text.Blaze (Markup)
@ -100,7 +101,14 @@ instance Yesod App where
let sessionexpirysecs = 120 let sessionexpirysecs = 120
in Just <$> defaultClientSessionBackend sessionexpirysecs ".hledger-web_client_session_key.aes" in Just <$> defaultClientSessionBackend sessionexpirysecs ".hledger-web_client_session_key.aes"
-- defaultLayout :: WidgetFor site () -> HandlerFor site Html
defaultLayout widget = do defaultLayout widget = do
-- Don't run if server-side UI is disabled.
-- This single check probably covers all the HTML-returning handlers,
-- but for now they do the check as well.
checkServerSideUiEnabled
master <- getYesod master <- getYesod
here <- fromMaybe RootR <$> getCurrentRoute here <- fromMaybe RootR <$> getCurrentRoute
VD {caps, j, m, opts, q, qopts} <- getViewData VD {caps, j, m, opts, q, qopts} <- getViewData
@ -209,7 +217,10 @@ getViewData = do
checkServerSideUiEnabled :: Handler () checkServerSideUiEnabled :: Handler ()
checkServerSideUiEnabled = do checkServerSideUiEnabled = do
VD{opts=WebOpts{serve_api_}} <- getViewData VD{opts=WebOpts{serve_api_}} <- getViewData
when serve_api_ $ permissionDenied "server-side UI is disabled due to --serve-api" when serve_api_ $
-- this one gives 500 internal server error when called from defaultLayout:
-- permissionDenied "server-side UI is disabled due to --serve-api"
sendResponseStatus status403 ("server-side UI is disabled due to --serve-api" :: Text)
-- | Find out if the sidebar should be visible. Show it, unless there is a -- | Find out if the sidebar should be visible. Show it, unless there is a
-- showsidebar cookie set to "0", or a ?sidebar=0 query parameter. -- showsidebar cookie set to "0", or a ?sidebar=0 query parameter.