From c420b8d8ea08f5dfb699e6babe2e2a994add45b5 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Sun, 1 Jul 2018 08:15:23 +0000
Subject: [PATCH] Make the cookie encryption key and timeout configurable in
 settings file

---
 clone-deps.sh                |  1 +
 config/settings-default.yaml |  9 +++++++++
 src/Vervis/Foundation.hs     | 12 +++++++-----
 src/Vervis/Settings.hs       | 10 ++++++++++
 stack.yaml                   |  1 +
 vervis.cabal                 |  1 +
 6 files changed, 29 insertions(+), 5 deletions(-)

diff --git a/clone-deps.sh b/clone-deps.sh
index fa446ad..2a327fe 100644
--- a/clone-deps.sh
+++ b/clone-deps.sh
@@ -11,4 +11,5 @@ darcs clone $VERVIS/darcs-rev
 darcs clone $VERVIS/ssh
 darcs clone $VERVIS/persistent-migration
 darcs clone $VERVIS/persistent-email-address
+darcs clone $VERVIS/time-interval-aeson
 darcs clone $VERVIS/yesod-mail-send --to-hash 2800294a41daf57cd420710bc79c8c9b06c0d3dd
diff --git a/config/settings-default.yaml b/config/settings-default.yaml
index 1fcd463..70acc69 100644
--- a/config/settings-default.yaml
+++ b/config/settings-default.yaml
@@ -24,6 +24,15 @@ ip-from-header: "_env:IP_FROM_HEADER:false"
 # Uncomment to set an explicit approot
 #approot:        "_env:APPROOT:http://localhost:3000"
 
+# Encryption key file for encrypting the session cookie sent to clients
+client-session-key:     config/client_session_key.aes
+
+# How much time after the last request it takes for the session cookie to
+# expire
+client-session-timeout:
+  amount:               2
+  unit:                 hours
+
 ###############################################################################
 # Development
 ###############################################################################
diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index ddd3cbf..85063a6 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -19,8 +19,8 @@ import Prelude (init, last)
 
 import Control.Monad.Logger (logWarn)
 import Control.Monad.Trans.Maybe
-import Data.Time.Interval (fromTimeUnit)
-import Data.Time.Units (Day)
+import Data.Time.Interval (fromTimeUnit, toTimeUnit)
+import Data.Time.Units (Minute, Day)
 import Database.Persist.Sql (ConnectionPool, runSqlPool)
 import Graphics.SVGFonts.ReadFont (PreparedFont)
 import Text.Shakespeare.Text (textFile)
@@ -96,10 +96,12 @@ instance Yesod App where
 
     -- Store session data on the client in encrypted cookies,
     -- default session idle timeout is 120 minutes
-    makeSessionBackend _ =
+    makeSessionBackend app =
         -- sslOnlySessions $
-        Just <$>
-        defaultClientSessionBackend 120 "config/client_session_key.aes"
+        let s = appSettings app
+            t = fromIntegral (toTimeUnit $ appClientSessionTimeout s :: Minute)
+            k = appClientSessionKeyFile s
+        in  Just <$> defaultClientSessionBackend t k
 
     -- Yesod Middleware allows you to run code before and after each handler function.
     -- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks.
diff --git a/src/Vervis/Settings.hs b/src/Vervis/Settings.hs
index 8d21d85..f360f57 100644
--- a/src/Vervis/Settings.hs
+++ b/src/Vervis/Settings.hs
@@ -31,6 +31,8 @@ import Control.Exception           (throw)
 import Data.Aeson                  (Result (..), fromJSON, withObject, (.!=),
                                     (.:?))
 import Data.FileEmbed              (embedFile)
+import Data.Time.Interval (TimeInterval)
+import Data.Time.Interval.Aeson (interval)
 import Data.Yaml                   (decodeEither')
 import Database.Persist.Postgresql (PostgresConf)
 import Language.Haskell.TH.Syntax  (Exp, Name, Q)
@@ -59,6 +61,11 @@ data AppSettings = AppSettings
       -- behind a reverse proxy.
     , appIpFromHeader           :: Bool
 
+      -- | Path of session cookie encryption key file
+    , appClientSessionKeyFile   :: FilePath
+      -- | Idle timeout for session cookie expiration
+    , appClientSessionTimeout   :: TimeInterval
+
       -- | Use detailed request logging system
     , appDetailedRequestLogging :: Bool
       -- | Should all log messages be displayed?
@@ -106,6 +113,9 @@ instance FromJSON AppSettings where
         appPort                   <- o .: "http-port"
         appIpFromHeader           <- o .: "ip-from-header"
 
+        appClientSessionKeyFile   <- o .: "client-session-key"
+        appClientSessionTimeout   <- interval <$> o .: "client-session-timeout"
+
         appDetailedRequestLogging <- o .:? "detailed-logging" .!= defaultDev
         appShouldLogAll           <- o .:? "should-log-all"   .!= defaultDev
         appReloadTemplates        <- o .:? "reload-templates" .!= defaultDev
diff --git a/stack.yaml b/stack.yaml
index 49bfd05..7784a87 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -16,6 +16,7 @@ packages:
   - '../hit-network'
   - '../persistent-migration'
   - '../persistent-email-address'
+  - '../time-interval-aeson'
 # - '../yesod-auth-account'
   - location:
      git: https://dev.angeley.es/s/fr33domlover/r/yesod-auth-account
diff --git a/vervis.cabal b/vervis.cabal
index e1181c5..7bc4441 100644
--- a/vervis.cabal
+++ b/vervis.cabal
@@ -302,6 +302,7 @@ library
                      , text
                      , time
                      , time-interval
+                     , time-interval-aeson
                      , time-units
                      , transformers
                        -- probably should be replaced with lenses once I learn