diff options
Diffstat (limited to 'Foundation.hs')
| -rw-r--r-- | Foundation.hs | 103 |
1 files changed, 42 insertions, 61 deletions
diff --git a/Foundation.hs b/Foundation.hs index 4ce89c8..c3c8cf0 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -1,32 +1,18 @@ -module Foundation - ( App (..) - , Route (..) - , AppMessage (..) - , resourcesApp - , Handler - , Widget - , Form - , maybeAuth - , requireAuth - , module Settings - ) where +module Foundation where import Prelude import Yesod import Yesod.Static -import Yesod.Auth -import Yesod.Auth.BrowserId -import Yesod.Auth.GoogleEmail import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) -import Yesod.Logger (Logger, logMsg, formatLogText) -import Network.HTTP.Conduit (Manager) +import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) import qualified Settings +import Settings.Development (development) import Settings.StaticFiles import Settings (widgetFile, Extra (..)) import Text.Jasmine (minifym) -import Web.ClientSession (getKey) import Text.Hamlet (hamletFile) +import Yesod.Core.Types (Logger) import qualified Data.Text import Data.Map (Map) import Hledger.JournalCSVs (JReportType(..)) @@ -47,37 +33,28 @@ instance PathPiece JReportType where -- access to the data present here. data App = App { settings :: AppConfig DefaultEnv Extra - , getLogger :: Logger , getStatic :: Static -- ^ Settings for static file serving. , httpManager :: Manager , hledgerConfig :: Map Data.Text.Text String + , appLogger :: Logger } +instance HasHttpManager App where + getHttpManager = httpManager + -- Set up i18n messages. See the message folder. mkMessage "App" "messages" "en" -- This is where we define all of the routes in our application. For a full -- explanation of the syntax, please see: --- http://www.yesodweb.com/book/handler --- --- This function does three things: +-- http://www.yesodweb.com/book/routing-and-handlers -- --- * Creates the route datatype AppRoute. Every valid URL in your --- application can be represented as a value of this type. --- * Creates the associated type: --- type instance Route App = AppRoute --- * Creates the value resourcesApp which contains information on the --- resources declared below. This is used in Handler.hs by the call to --- mkYesodDispatch --- --- What this function does *not* do is create a YesodSite instance for --- App. Creating that instance requires all of the handler functions --- for our application to be in scope. However, the handler functions --- usually require access to the AppRoute datatype. Therefore, we --- split these actions into two functions and place them in separate files. +-- Note that this is really half the story; in Application.hs, mkYesodDispatch +-- generates the rest of the code. Please see the linked documentation for an +-- explanation for this split. mkYesodData "App" $(parseRoutesFile "config/routes") -type Form x = Html -> MForm App App (FormResult x, Widget) +type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget) -- Please see the documentation for the Yesod typeclass. There are a number -- of settings which can be configured by overriding methods here. @@ -86,9 +63,9 @@ instance Yesod App where -- Store session data on the client in encrypted cookies, -- default session idle timeout is 120 minutes - makeSessionBackend _ = do - key <- getKey "config/client_session_key.aes" - return . Just $ clientSessionBackend key 120 + makeSessionBackend _ = fmap Just $ defaultClientSessionBackend + 120 -- timeout in minutes + "config/client_session_key.aes" defaultLayout widget = do master <- getYesod @@ -101,10 +78,12 @@ instance Yesod App where -- you to use normal widget features in default-layout. pc <- widgetToPageContent $ do - $(widgetFile "normalize") - addStylesheet $ StaticR css_bootstrap_css + $(combineStylesheets 'StaticR + [ css_normalize_css + , css_bootstrap_css + ]) $(widgetFile "default-layout") - hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet") + giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from -- a separate domain. Please see the staticRoot setting in Settings.hs @@ -112,41 +91,43 @@ instance Yesod App where Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s urlRenderOverride _ _ = Nothing - -- The page to be redirected to when authentication is required. - authRoute _ = Just $ AuthR LoginR - - messageLogger y loc level msg = - formatLogText (getLogger y) loc level msg >>= logMsg (getLogger y) + -- Routes not requiring authenitcation. + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of -- users receiving stale content. - addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute []) + addStaticContent = + addStaticContentExternal minifym genFileName Settings.staticDir (StaticR . flip StaticRoute []) + where + -- Generate a unique filename based on the content itself + genFileName lbs + | development = "autogen-" ++ base64md5 lbs + | otherwise = base64md5 lbs -- Place Javascript at bottom of the body tag so the rest of the page loads first jsLoader _ = BottomOfBody -instance YesodAuth App where - type AuthId App = String + -- What messages should be logged. The following includes all messages when + -- in development, and warnings and errors in production. + shouldLog _ _source level = + development || level == LevelWarn || level == LevelError - -- Where to send a user after successful login - loginDest _ = HomeR - -- Where to send a user after logout - logoutDest _ = HomeR - - getAuthId creds = return Nothing - - -- You can add other plugins like BrowserID, email or OAuth here - authPlugins _ = [authBrowserId, authGoogleEmail] - - authHttpManager = httpManager + makeLogger = return . appLogger -- This instance is required to use forms. You can modify renderMessage to -- achieve customized and internationalized form validation messages. instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage +-- | Get the 'Extra' value, used to hold data from the settings.yml file. +getExtra :: Handler Extra +getExtra = fmap (appExtra . settings) getYesod + -- Note: previous versions of the scaffolding included a deliver function to -- send emails. Unfortunately, there are too many different options for us to -- give a reasonable default. Instead, the information is available on the |