diff options
Diffstat (limited to 'Foundation.hs')
| -rw-r--r-- | Foundation.hs | 48 |
1 files changed, 22 insertions, 26 deletions
diff --git a/Foundation.hs b/Foundation.hs index 171d414..c58c9ec 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -11,13 +11,12 @@ import Yesod.Form.Jquery (YesodJquery(..)) import Network.HTTP.Conduit (Manager) import qualified Settings import Settings.Development (development) -import qualified Database.Persist.Store -import Database.Persist.GenericSql -import Settings (widgetFile, Extra (..)) +import qualified Database.Persist +import Database.Persist.Sql (SqlPersistT) import Settings.StaticFiles +import Settings (widgetFile, Extra (..)) import Model import Text.Jasmine (minifym) -import Web.ClientSession (getKey) import Text.Hamlet (hamletFile) import System.Log.FastLogger (Logger) @@ -28,9 +27,9 @@ import System.Log.FastLogger (Logger) data App = App { settings :: AppConfig DefaultEnv Extra , getStatic :: Static -- ^ Settings for static file serving. - , connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool. + , connPool :: Database.Persist.PersistConfigPool Settings.PersistConf -- ^ Database connection pool. , httpManager :: Manager - , persistConfig :: Settings.PersistConfig + , persistConfig :: Settings.PersistConf , appLogger :: Logger } @@ -58,7 +57,7 @@ mkMessage "App" "messages" "en" -- split these actions into two functions and place them in separate files. 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. @@ -67,11 +66,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" - let timeout = 120 * 60 -- 120 minutes - (getCachedDate, _closeDateCache) <- clientSessionDateCacher timeout - return . Just $ clientSessionBackend2 key getCachedDate + makeSessionBackend _ = fmap Just $ defaultClientSessionBackend + (120 * 60) -- 120 minutes + "config/client_session_key.aes" defaultLayout widget = do master <- getYesod @@ -84,10 +81,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 @@ -118,7 +117,7 @@ instance Yesod App where shouldLog _ _source level = development || level == LevelWarn || level == LevelError - getLogger = return . appLogger + makeLogger = return . appLogger isAuthorized (UserR u) True = isUser u isAuthorized (UserR u) False = isUserOrAdmin u @@ -130,21 +129,21 @@ instance Yesod App where isAuthorized (VacationR u) False = isUserOrAdmin u isAuthorized _ _ = return Authorized -isUser :: UserId -> GHandler s App AuthResult +isUser :: UserId -> Handler AuthResult isUser t = do ma <- maybeAuth return $ case ma of Nothing -> AuthenticationRequired Just (Entity u _) -> if t == u then Authorized else Unauthorized "That ain't your page." -isUserOrAdmin :: UserId -> GHandler s App AuthResult +isUserOrAdmin :: UserId -> Handler AuthResult isUserOrAdmin t = do ma <- maybeAuth return $ case ma of 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 :: Handler AuthResult isAdmin = do ma <- maybeAuth return $ case ma of @@ -153,13 +152,10 @@ isAdmin = do -- How to run database actions. instance YesodPersist App where - type YesodPersistBackend App = SqlPersist - runDB f = do - master <- getYesod - Database.Persist.Store.runPool - (persistConfig master) - f - (connPool master) + type YesodPersistBackend App = SqlPersistT + runDB = defaultRunDB persistConfig connPool +instance YesodPersistRunner App where + getDBRunner = defaultGetDBRunner connPool instance YesodAuth App where type AuthId App = UserId |