on second thought, the session cookie is still useful to support setMessage
This commit is contained in:
parent
3c117685eb
commit
95f4b192f0
2 changed files with 15 additions and 3 deletions
|
@ -60,8 +60,7 @@ instance Yesod WebApp where
|
||||||
excludeStatic [] = True
|
excludeStatic [] = True
|
||||||
excludeStatic (p:_) = p /= "static"
|
excludeStatic (p:_) = p /= "static"
|
||||||
|
|
||||||
{- Sessions are overkill for a local webapp with 1 user. -}
|
makeSessionBackend = webAppSessionBackend
|
||||||
makeSessionBackend _ = return Nothing
|
|
||||||
|
|
||||||
getHomeR :: Handler RepHtml
|
getHomeR :: Handler RepHtml
|
||||||
getHomeR = defaultLayout $ do
|
getHomeR = defaultLayout $ do
|
||||||
|
|
|
@ -24,6 +24,7 @@ import Network.Socket
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Crypto.Random
|
import Crypto.Random
|
||||||
import Data.Digest.Pure.SHA
|
import Data.Digest.Pure.SHA
|
||||||
|
import qualified Web.ClientSession as CS
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as TE
|
import qualified Data.Text.Encoding as TE
|
||||||
|
@ -112,7 +113,19 @@ logRequest req = do
|
||||||
lookupRequestField :: CI.CI Ascii -> Wai.Request -> Ascii
|
lookupRequestField :: CI.CI Ascii -> Wai.Request -> Ascii
|
||||||
lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req
|
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. -}
|
- authentication secret. -}
|
||||||
genRandomToken :: IO String
|
genRandomToken :: IO String
|
||||||
genRandomToken = do
|
genRandomToken = do
|
||||||
|
|
Loading…
Reference in a new issue