From 66d858170e1c057e45c304986bc4bae4c90a0acd Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Mon, 1 Jun 2015 14:36:15 -0300 Subject: [PATCH] Add serversession code to Yesod+Persistent example. Example doesn't showcase yesod-auth integration, though. --- README.md | 13 +- .../Application.hs | 10 ++ .../Foundation.hs | 19 ++- .../Handler/Home.hs | 128 +++++++++++++----- .../Model.hs | 2 +- .../config/routes | 5 +- ...rversession-example-yesod-persistent.cabal | 9 +- .../templates/default-layout.hamlet | 2 +- .../templates/homepage.hamlet | 94 ++++++++----- .../templates/homepage.julius | 2 +- .../templates/homepage.lucius | 19 ++- 11 files changed, 224 insertions(+), 79 deletions(-) diff --git a/README.md b/README.md index 8506e44..66a5c50 100644 --- a/README.md +++ b/README.md @@ -56,6 +56,11 @@ above, please send us a pull request! The `serversession` package should work for any session that may be represented as a mapping of keys to values. +Examples: + + * Using Yesod frontend + Persistent backend: + [GitHub link](https://github.com/yesodweb/serversession/tree/master/examples/serversession-example-yesod-persistent/). + ## Security notes @@ -72,7 +77,13 @@ optimization). The session ID can be invalidated in order to prevent [session fixation attacks](http://www.acrossecurity.com/papers/session_fixation.pdf), either automatically (see below) or manually (via -`forceInvalidate`). +`forceInvalidate`). On a session fixation attack, the attacker +convinces the victim to use the same session ID as his and asks +the victim to log in. If the session is not invalidated upon +login, the attacker will now be in possession of a session ID +that is logged in as the victim. If the session is invalidated, +the victim receives a new session ID that the attacker doesn't +have any knowledge of. We support both idle timeouts and absolute timeouts. Idle timeouts invalidate the session if a given amount of time has diff --git a/examples/serversession-example-yesod-persistent/Application.hs b/examples/serversession-example-yesod-persistent/Application.hs index f0294a6..905de21 100644 --- a/examples/serversession-example-yesod-persistent/Application.hs +++ b/examples/serversession-example-yesod-persistent/Application.hs @@ -28,6 +28,10 @@ import Network.Wai.Middleware.RequestLogger (Destination (Logger), import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr) +import qualified Data.Proxy as P +import qualified Web.ServerSession.Core as SS +import qualified Web.ServerSession.Backend.Persistent as SS + -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! import Handler.Common @@ -38,6 +42,12 @@ import Handler.Home -- comments there for more details. mkYesodDispatch "App" resourcesApp + +-- Create migration function using both our entities and +-- serversession-backend-persistent ones. +mkMigrate "migrateAll" (SS.serverSessionDefs (P.Proxy :: P.Proxy SS.SessionMap) ++ entityDefs) + + -- | This function allocates resources (such as a database connection pool), -- performs initialization and return a foundation datatype value. This is also -- the place to put your migrate statements to have automatic database diff --git a/examples/serversession-example-yesod-persistent/Foundation.hs b/examples/serversession-example-yesod-persistent/Foundation.hs index f9ff583..1f77fe9 100644 --- a/examples/serversession-example-yesod-persistent/Foundation.hs +++ b/examples/serversession-example-yesod-persistent/Foundation.hs @@ -4,11 +4,14 @@ import Import.NoFoundation import Database.Persist.Sql (ConnectionPool, runSqlPool) import Text.Hamlet (hamletFile) import Text.Jasmine (minifym) +import Web.ServerSession.Backend.Persistent +import Web.ServerSession.Frontend.Yesod import Yesod.Auth.BrowserId (authBrowserId) import Yesod.Default.Util (addStaticContentExternal) import Yesod.Core.Types (Logger) import qualified Yesod.Core.Unsafe as Unsafe + -- | The foundation datatype for your application. This can be a good place to -- keep settings and values requiring initialization before your application -- starts running, such as database connections. Every handler will have @@ -36,6 +39,10 @@ mkYesodData "App" $(parseRoutesFile "config/routes") -- | A convenient synonym for creating forms. type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget) +-- | Cookie name used for the sessions of this example app. +sessionCookieName :: Text +sessionCookieName = "SESSION" + -- Please see the documentation for the Yesod typeclass. There are a number -- of settings which can be configured by overriding methods here. instance Yesod App where @@ -43,11 +50,13 @@ instance Yesod App where -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot approot = ApprootMaster $ appRoot . appSettings - -- Store session data on the client in encrypted cookies, - -- default session idle timeout is 120 minutes - makeSessionBackend _ = Just <$> defaultClientSessionBackend - 120 -- timeout in minutes - "config/client_session_key.aes" + -- Store session data using server-side sessions. Change the + -- timeouts to small values as this is just an example (so + -- that you can wait for the idle timeout, for example). + makeSessionBackend = simpleBackend opts . SqlStorage . appConnPool + where opts = setIdleTimeout (Just $ 5 * 60) -- 5 minutes + . setAbsoluteTimeout (Just $ 20 * 60) -- 20 minutes + . setCookieName sessionCookieName defaultLayout widget = do master <- getYesod diff --git a/examples/serversession-example-yesod-persistent/Handler/Home.hs b/examples/serversession-example-yesod-persistent/Handler/Home.hs index 86e3039..6222753 100644 --- a/examples/serversession-example-yesod-persistent/Handler/Home.hs +++ b/examples/serversession-example-yesod-persistent/Handler/Home.hs @@ -1,40 +1,106 @@ +-- | On this serversession example, we simply provide some ways +-- users may interact with the session. module Handler.Home where import Import -import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, - withSmallInput) +import Yesod.Form.Bootstrap3 --- This is a handler function for the GET request method on the HomeR --- resource pattern. All of your resource patterns are defined in --- config/routes --- --- The majority of the code you will write in Yesod lives in these handler --- functions. You can spread them across multiple files if you are so --- inclined, or create a single monolithic file. +import qualified Data.Map as M +import qualified Web.ServerSession.Frontend.Yesod as SS + + +-- | Homepage. getHomeR :: Handler Html getHomeR = do - (formWidget, formEnctype) <- generateFormPost sampleForm - let submission = Nothing :: Maybe (FileInfo, Text) - handlerName = "getHomeR" :: Text - defaultLayout $ do - aDomId <- newIdent - setTitle "Welcome To Yesod!" - $(widgetFile "homepage") + (forceFormWidget, forceFormEnctype) <- generateFormPost forceForm + (sessionAddFormWidget, sessionAddFormEnctype) <- generateFormPost sessionAddForm + msid <- getSessionId + vars <- M.toAscList <$> getSession + defaultLayout $ do + setTitle "Server-side session example" + $(widgetFile "homepage") -postHomeR :: Handler Html -postHomeR = do - ((result, formWidget), formEnctype) <- runFormPost sampleForm - let handlerName = "postHomeR" :: Text - submission = case result of - FormSuccess res -> Just res - _ -> Nothing - defaultLayout $ do - aDomId <- newIdent - setTitle "Welcome To Yesod!" - $(widgetFile "homepage") +-- | Invalidate the session as requested via 'forceForm'. +postForceR :: Handler () +postForceR = + processForm "Force form" forceForm $ \force -> do + msid <- getSessionId + SS.forceInvalidate force + return $ concat + [ "Forced session invalidation using " + , show force + , " [old session ID was " + , show msid + , "]." ] -sampleForm :: Form (FileInfo, Text) -sampleForm = renderBootstrap3 BootstrapBasicForm $ (,) - <$> fileAFormReq "Choose a file" - <*> areq textField (withSmallInput "What's on the file?") Nothing + +-- | Add (or modify) a session variable. +postSessionAddR :: Handler () +postSessionAddR = + processForm "Add session form" sessionAddForm $ \(key, val) -> do + setSession key val + return $ concat + [ "Set session key " + , show key + , " to value " + , show val + , "." ] + + +-- | Delete a session variable. +postSessionDeleteR :: Text -> Handler () +postSessionDeleteR key = do + deleteSession key + setMessage $ toHtml $ "Deleted session key " ++ show key ++ "." + redirect HomeR + + +---------------------------------------------------------------------- + + +-- | Helper function for form processing handlers. +processForm :: String -> Form a -> (a -> Handler String) -> Handler () +processForm formName form act = do + ((result, _), _) <- runFormPost form + (>>= setMessage . toHtml) $ + case result of + FormSuccess ret -> act ret + FormFailure errs -> return $ formName ++ " has errors: " ++ show errs ++ "." + FormMissing -> return $ formName ++ " is missing." + redirect HomeR + + +-- | Form for session invalidation. +forceForm :: Form SS.ForceInvalidate +forceForm = + identifyForm "forceForm" $ + renderBootstrap3 horizontal $ + areq (selectField optionsEnum) "Kind of invalidation" (Just SS.DoNotForceInvalidate) + <* submit "Force session invalidation!" + + +-- | Form for adding or modifying session variables. +sessionAddForm :: Form (Text, Text) +sessionAddForm = + identifyForm "sessionAddForm" $ + renderBootstrap3 horizontal $ + (,) + <$> areq textField "Session key" Nothing + <*> areq textField "Session value" Nothing + <* submit "Add/modify session variable" + + +-- | Our definition of horizontal form. +horizontal :: BootstrapFormLayout +horizontal = BootstrapHorizontalForm (ColSm 0) (ColSm 4) (ColSm 0) (ColSm 6) + + +-- | Our definition of submit button. +submit :: MonadHandler m => Text -> AForm m () +submit t = bootstrapSubmit (BootstrapSubmit t "btn-primary" []) + + +-- | Retrieve the session ID from the cookie. +getSessionId :: Handler (Maybe Text) +getSessionId = lookupCookie sessionCookieName diff --git a/examples/serversession-example-yesod-persistent/Model.hs b/examples/serversession-example-yesod-persistent/Model.hs index 353bafb..cbe20c4 100644 --- a/examples/serversession-example-yesod-persistent/Model.hs +++ b/examples/serversession-example-yesod-persistent/Model.hs @@ -7,5 +7,5 @@ import Database.Persist.Quasi -- You can find more information on persistent and how to declare entities -- at: -- http://www.yesodweb.com/book/persistent/ -share [mkPersist sqlSettings, mkMigrate "migrateAll"] +share [mkPersist sqlSettings, mkSave "entityDefs"] $(persistFileWith lowerCaseSettings "config/models") diff --git a/examples/serversession-example-yesod-persistent/config/routes b/examples/serversession-example-yesod-persistent/config/routes index 6d3614f..e4b6bbc 100644 --- a/examples/serversession-example-yesod-persistent/config/routes +++ b/examples/serversession-example-yesod-persistent/config/routes @@ -4,4 +4,7 @@ /favicon.ico FaviconR GET /robots.txt RobotsR GET -/ HomeR GET POST +/ HomeR GET +/force ForceR POST +/sessionAdd SessionAddR POST +/sessionDelete/#Text SessionDeleteR POST diff --git a/examples/serversession-example-yesod-persistent/serversession-example-yesod-persistent.cabal b/examples/serversession-example-yesod-persistent/serversession-example-yesod-persistent.cabal index 20d76ff..a638060 100644 --- a/examples/serversession-example-yesod-persistent/serversession-example-yesod-persistent.cabal +++ b/examples/serversession-example-yesod-persistent/serversession-example-yesod-persistent.cabal @@ -27,7 +27,7 @@ library cpp-options: -DDEVELOPMENT ghc-options: -Wall -fwarn-tabs -O0 else - ghc-options: -Wall -fwarn-tabs -O2 + ghc-options: -Wall -fwarn-tabs -O extensions: TemplateHaskell QuasiQuotes @@ -82,6 +82,11 @@ library , vector , time + , tagged + , serversession == 1.0.* + , serversession-frontend-yesod == 1.0.* + , serversession-backend-persistent == 1.0.* + executable serversession-example-yesod-persistent if flag(library-only) Buildable: False @@ -90,7 +95,7 @@ executable serversession-example-yesod-persistent hs-source-dirs: app build-depends: base, serversession-example-yesod-persistent - ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N + ghc-options: -threaded -O -rtsopts -with-rtsopts=-N test-suite test type: exitcode-stdio-1.0 diff --git a/examples/serversession-example-yesod-persistent/templates/default-layout.hamlet b/examples/serversession-example-yesod-persistent/templates/default-layout.hamlet index 3701e3c..7d14565 100644 --- a/examples/serversession-example-yesod-persistent/templates/default-layout.hamlet +++ b/examples/serversession-example-yesod-persistent/templates/default-layout.hamlet @@ -1,3 +1,3 @@ $maybe msg <- mmsg -
#{msg} +
#{msg} ^{widget} diff --git a/examples/serversession-example-yesod-persistent/templates/homepage.hamlet b/examples/serversession-example-yesod-persistent/templates/homepage.hamlet index 08a45ab..d24b8d9 100644 --- a/examples/serversession-example-yesod-persistent/templates/homepage.hamlet +++ b/examples/serversession-example-yesod-persistent/templates/homepage.hamlet @@ -1,41 +1,69 @@ -

Welcome to Yesod! +

+ Server-side session example -
    -
  1. Now that you have a working project you should use the # - \Yesod book to learn more. # - You can also use this scaffolded site to explore some basic concepts. +

    + This example site demonstrates using # + serversession # + with Yesod and Persistent. -

  2. This page was generated by the #{handlerName} handler in # - \Handler/Home.hs. +
    +

    + Current session properties -
  3. The #{handlerName} handler is set to generate your site's home screen in Routes file # - config/routes +
    +
    Session ID +
    #{maybe "-- no session --" id msid} -
  4. The HTML you are seeing now is actually composed by a number of widgets, # - most of them are brought together by the defaultLayout function which # - is defined in the Foundation.hs module, and used by #{handlerName}. # - All the files for templates and wigdets are in templates. +
    Session variables +
    + $if null vars + -- no session variables -- + $else + + + + + $forall (key, val) <- vars + +
    Key + Value +
    #{show key} + #{show val} + +
    +