diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 6e2296d5c1..d663b0cd52 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -60,8 +60,7 @@ instance Yesod WebApp where excludeStatic [] = True excludeStatic (p:_) = p /= "static" - {- Sessions are overkill for a local webapp with 1 user. -} - makeSessionBackend _ = return Nothing + makeSessionBackend = webAppSessionBackend getHomeR :: Handler RepHtml getHomeR = defaultLayout $ do diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 8a1887678a..23e00ba62a 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