diff options
Diffstat (limited to 'Foundation.hs')
| -rw-r--r-- | Foundation.hs | 66 |
1 files changed, 43 insertions, 23 deletions
diff --git a/Foundation.hs b/Foundation.hs index 194fe14..15034a1 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -1,16 +1,4 @@ -module Foundation - ( App (..) - , Route (..) - , AppMessage (..) - , resourcesApp - , Handler - , Widget - , Form - , maybeAuth - , requireAuth - , module Settings - , module Model - ) where +module Foundation where import Prelude import Yesod @@ -19,18 +7,19 @@ import Yesod.Auth import Auth.Proxied (authProxied) import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) -import Yesod.Form.Jquery (YesodJquery) -import Yesod.Logger (Logger, logMsg, formatLogText) +import Yesod.Form.Jquery (YesodJquery(..)) import Network.HTTP.Conduit (Manager) import qualified Settings +import Settings.Development (development) import qualified Database.Persist.Store -import Settings.StaticFiles import Database.Persist.GenericSql import Settings (widgetFile, Extra (..)) +import Settings.StaticFiles import Model import Text.Jasmine (minifym) import Web.ClientSession (getKey) import Text.Hamlet (hamletFile) +import System.Log.FastLogger (Logger) -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -38,11 +27,11 @@ import Text.Hamlet (hamletFile) -- access to the data present here. data App = App { settings :: AppConfig DefaultEnv Extra - , getLogger :: Logger , getStatic :: Static -- ^ Settings for static file serving. , connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool. , httpManager :: Manager , persistConfig :: Settings.PersistConfig + , appLogger :: Logger } -- Set up i18n messages. See the message folder. @@ -80,7 +69,9 @@ instance Yesod App where -- default session idle timeout is 120 minutes makeSessionBackend _ = do key <- getKey "config/client_session_key.aes" - return . Just $ clientSessionBackend key 120 + let timeout = 120 * 60 -- 120 minutes + (getCachedDate, _closeDateCache) <- clientSessionDateCacher timeout + return . Just $ clientSessionBackend2 key getCachedDate defaultLayout widget = do master <- getYesod @@ -107,20 +98,34 @@ instance Yesod App where -- 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) - -- 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 + -- 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 + + getLogger = return . appLogger + isAuthorized (UserR u) True = isUser u isAuthorized (UserR u) False = isUserOrAdmin u + isAuthorized (CategoryR _) True = isAdmin + isAuthorized (CategoryR _) False = return Authorized + isAuthorized (EmploymentR e) True = isAdmin + isAuthorized (EmploymentR _) False = return Authorized isAuthorized _ _ = return Authorized isUser :: UserId -> GHandler s App AuthResult @@ -137,6 +142,13 @@ isUserOrAdmin t = do Nothing -> AuthenticationRequired Just (Entity u v) -> if t == u || userIsAdmin v then Authorized else Unauthorized "You must be an admin" +isAdmin :: GHandler s App AuthResult +isAdmin = do + ma <- maybeAuth + return $ case ma of + Nothing -> AuthenticationRequired + Just (Entity u v) -> if userIsAdmin v then Authorized else Unauthorized "You must be an admin" + -- How to run database actions. instance YesodPersist App where type YesodPersistBackend App = SqlPersist @@ -171,6 +183,10 @@ instance YesodAuth App where 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 @@ -178,4 +194,8 @@ instance RenderMessage App FormMessage where -- -- https://github.com/yesodweb/yesod/wiki/Sending-email -instance YesodJquery App -- FIXME: go static +instance YesodJquery App where + urlJqueryJs _ = Left (StaticR js_jquery_js) + urlJqueryUiJs _ = Left (StaticR jquery_ui_jquery_ui_js) + urlJqueryUiCss _ = Left (StaticR cupertino_jquery_ui_css) + urlJqueryUiDateTimePicker _ = Left (StaticR js_jquery_ui_datetimepicker_js) |