我将Yesod与serversession-backend-redis集成在一起并尝试运行，这里做个备忘录

2 年 ago

雅, 悟

2 minutes

为了学习，我尝试了使用Haskell的Web框架Yesod和用于支持会话管理的服务器库serversession进行组合运行。

这次我们使用了stack的模板yesodweb/simple，在这个项目中命名为redissession。

stack new redissession yesodweb/simple

这次我想在Session存储中使用Redis，所以我使用了一个叫做serversession的库。（虽然这个库好像很久没有维护了，但是这次我只是为了看看在Haskell中实现会话操作的例子，所以我不会介意继续使用它。）

首先，在package.yaml文件中添加serversession包的信息。
由于前端使用Yesod，后端使用Redis，因此还需要添加serversession-frontend-yesod和serversession-backend-redis。
另外，由于serversession-backend-redis依赖于hedis包，所以也需要添加它。

dependencies:
(中略)
- serversession == 1.0.1
- serversession-frontend-yesod == 1.0
- serversession-backend-redis == 1.0.3
- hedis < 0.11

由于 serversession-frontend-yesod 和 serversession-backend-redis 不包含在本次使用的 Stackage 的 lts-16.20 解析器中，所以它们也将被添加到 stack.yaml 文件中。
此外，由于包之间的版本依赖关系不匹配，导致出现错误，因此设置 “allow-newer: true” 来忽略版本依赖关系不匹配的问题。
由于本次的目的是先尝试运行，所以这样就可以了。

extra-deps:
- serversession-frontend-yesod-1.0
- serversession-backend-redis-1.0.3

allow-newer: true

import ...(略)

-- 以下を追記
import Web.ServerSession.Backend.Redis (RedisStorage(..))
import Web.ServerSession.Frontend.Yesod (simpleBackend, setCookieName, setSecureCookies)
import qualified Database.Redis as Redis

(中略)

data App = App 
    { appSettings    :: AppSettings
    , appStatic      :: Static -- ^ Settings for static file serving.
    , appHttpManager :: Manager
    , appLogger      :: Logger
    , appConn        :: Redis.Connection --追加
    }

instance Yesod App where

(中略)

  makeSessionBackend :: App -> IO (Maybe SessionBackend)
  makeSessionBackend = simpleBackend opts . createStorage
    where createStorage appl = RedisStorage (appConn appl) idleTimeoutSec absoluteTimeoutSec
          idleTimeoutSec     = Just $ 60*10
          absoluteTimeoutSec = Just $ 60*30
          opts               = setCookieName "REDISSESSION_ID"
                             . setSecureCookies False

import qualified Database.Redis as Redis

makeFoundation :: AppSettings -> IO App 
makeFoundation appSettings = do
    -- Some basic initializations: HTTP connection manager, logger, and static
    -- subsite.
    appHttpManager <- getGlobalManager
    appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
    appStatic <-
        (if appMutableStatic appSettings then staticDevel else static)
        (appStaticDir appSettings)
    appConn <- Redis.connect Redis.defaultConnectInfo  -- ここを追記                                                                                                                                                                                       

    -- Return the foundation
    return App {..}

 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE QuasiQuotes #-} --追加

import Web.ServerSession.Frontend.Yesod (forceInvalidate, ForceInvalidate(..))
import Import
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
import Text.Julius (RawJS (..))

import Web.ServerSession.Frontend.Yesod (forceInvalidate, ForceInvalidate(..))

getHomeR :: Handler Html
getHomeR = do
    sess <- getSession
    forceInvalidate CurrentSessionId -- これを呼ぶとセッションIDが再採番される
    defaultLayout
        [whamlet|
            <form method=post>
                <input type=text name=key>
                <input type=text name=val>
                <input type=submit>
            <h1>#{show sess}
        |]  

postHomeR :: Handler ()
postHomeR = do
    (key, mval) <- runInputPost $ (,) <$> ireq textField "key" <*> iopt textField "val"
    case mval of
        Nothing -> deleteSession key 
        Just val -> setSession key val 
    liftIO $ print (key, mval)
    redirect HomeR