From 95f4b192f0accbdaaa4e5c985b4e1c1a17b8aec7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 26 Jul 2012 12:41:20 -0400
Subject: on second thought, the session cookie is still useful to support
 setMessage

---
 Utility/WebApp.hs | 15 ++++++++++++++-
 1 file changed, 14 insertions(+), 1 deletion(-)

(limited to 'Utility/WebApp.hs')

diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs
index 8a1887678..23e00ba62 100644
--- a/Utility/WebApp.hs
+++ b/Utility/WebApp.hs
@@ -24,6 +24,7 @@ import Network.Socket
 import Control.Exception
 import Crypto.Random
 import Data.Digest.Pure.SHA
+import qualified Web.ClientSession as CS
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
@@ -112,7 +113,19 @@ logRequest req = do
 lookupRequestField :: CI.CI Ascii -> Wai.Request -> Ascii
 lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req
 
-{- Generates a 512 byte random token, suitable to be used for an
+{- Rather than storing a session key on disk, use a random key
+ - that will only be valid for this run of the webapp. -}
+webAppSessionBackend :: Yesod y => y -> IO (Maybe (SessionBackend y))
+webAppSessionBackend _ = do
+	g <- newGenIO :: IO SystemRandom
+	case genBytes 96 g of
+		Left e -> error $ "failed to generate random key: " ++ show e
+		Right (s, _) -> case CS.initKey s of
+			Left e -> error $ "failed to initialize key: " ++ show e
+			Right key -> return $ Just $
+				clientSessionBackend key 120
+
+{- Generates a random sha512 string, suitable to be used for an
  - authentication secret. -}
 genRandomToken :: IO String
 genRandomToken = do
-- 
cgit v1.2.3