読者です 読者をやめる 読者になる 読者になる

euphonictechnologies’s diary

Haskell超初心者の日記です。OCamlが好きです。

follow us in feedly

Haskell :: Snap + HerokuでRedisを使う - ローカルRedisに接続する

Haskell Heroku Snap Redis

前回はSnap + Herokuをデプロイしました

blog.euphonictech.com

Hello, world!を表示することが出来ました。なので今回はデータベースを使ってみます。

Redisを使ってみる

普通だとここでPostgresSQLとかMySQLのチュートリアルに入るのですが、普通だとつまらないのでRedisを使ってみます。Redisを知らない方はこちら:

ameblo.jp

簡単に言うとインメモリの超早いキーバリューストアですね。

今回の流れ

今回は次のような感じで最終的なherokuへのデプロイを目指します:

  1. RedisをMacにインストールして遊んでみる
  2. RedisをローカルのSnapウェブアプリから触ってみる
  3. Redis Cloudプラグインをheroku上でインストールしてRedis Cloudを使えるようにする
  4. Redis CloudをローカルのMacからCLIで触って動くことを確認する
  5. Redis Cloud上のRedisにローカルのSnapウェブアプリから接続する
  6. herokuにデプロイしてheroku上のSnapウェブアプリからRedis Cloud上のRedisに接続する

RedisをMacにインストールして遊んでみる

簡単ですね。

$ brew install redis

これだけです。redis-serverとredis-cliが利用可能になります。パスも通るはず。

サーバを立ち上げる

早速サーバを起動しましょう。

$ redis-server /usr/local/etc/redis.conf

で起動します。

f:id:euphonictechnologies:20150804002614p:plain

早速redis-cliで遊んでみます。まずはredis-cliを起動してredis-serverに接続させます。

よく使うコマンドは

  • keys : データベースが保存しているキーを表示
    • keys "filter pattaern"
    • ex. keys *
  • set : データをセット(同じキーの場合は上書き、新規キーの場合は追加)
    • set "key" "value"
  • get : キーを与えて値をゲット
    • get "key"
  • mget : キーを複数与えてそれぞれの値をゲット
    • mget "key1" "key2" ...
    • ex. mget "key1" "key2" "key3"

ぐらいでしょうか。

$ redis-cli -h localhost -p 6379

としてクライアントを起動します。以下遊んでみました:

localhost:6379> ping
PONG
localhost:6379> set "msg" "test message"
OK
localhost:6379> set "nissan" "automobile company"
OK
localhost:6379> set "key" "value"
OK
localhost:6379> keys *
1) "msg"
2) "nissan"
3) "key"
localhost:6379> get "msg"
"test message"
localhost:6379> get "nissan"
"automobile company"
localhost:6379> get "key"
"value"
localhost:6379> mget "msg" "key"
1) "test message"
2) "value"
localhost:6379> quit

pingはpingです。pongが帰ってきます。

RedisをローカルのSnapウェブアプリから触ってみる

というわけで早速Haskellを書いていきます。 前回のfirstsnapをたたき台にします。

最初に必要なのはRedis用のsnapletです。 snapletを入れたり外したりしてSnapにいろんな機能をくっつけてやることができます。

RedisDBのsnapletを追加する

公式のsnapletページに有るSnap: A Haskell Web Framework: Snaplet Directoryからsnaplet-redisを追加します。 …が、どうもsnaplet-redisは後述する他のパッケージのバージョンと相性が悪いらしく、ちょっとした修正が必要です。 なので、コードをコピーしてパッケージとしてではなくあたかも自分が書いたローカルモジュールとしてそのまま追加します。

f:id:euphonictechnologies:20150804220038p:plain

ここに

f:id:euphonictechnologies:20150804220048p:plain

RedisDBモジュールをコピペします。ちゃんと修正してpull request送るべきなんですが、今はこれで我慢。モジュール名にSnap.Snapletがいらないので削除してネームスペースを平らかにしておきます。

ここが重要なのですが、

instance Configured PortID where
  convert (Number r) | denominator r == 1 = Just $ PortNumber $ fromInteger $ numerator r
  convert (String s) = Just $ UnixSocket $ T.unpack s
  convert _ = Nothing

このように修正してください。具体的にはPortNumコンストラクタを使わないようにしましょう。PortNumberはIntegerを取り扱えるインスタンスを持っています。

そんでもってApplication.hsにSnapletとしてRedisDBを追加します。

...
import RedisDB              -- import the module and...

------------------------------------------------------------------------------
data App = App
    { _heist :: Snaplet (Heist App)
    , _sess :: Snaplet SessionManager
    , _auth :: Snaplet (AuthManager App)
    , _redis :: Snaplet RedisDB                   -- Added this!
    }
...

このファイルはこれだけです。これだけでSite.hsの中で(つまり実際のページのコードから)RedisDBがアクセス可能になります。もちろん初期化コードが別途必要なので、次はSite.hsで初期化コードを追加します。

RedisDBのsnapletを初期化する

Site.hs:

...
import           RedisDB
...

app :: SnapletInit App App
app = makeSnaplet "app" "An snaplet example application." Nothing $ do
    h <- nestSnaplet "" heist $ heistInit "templates"
    s <- nestSnaplet "sess" sess $
           initCookieSessionManager "site_key.txt" "sess" (Just 3600)

    -- NOTE: We're using initJsonFileAuthManager here because it's easy and
    -- doesn't require any kind of database server to run.  In practice,
    -- you'll probably want to change this to a more robust auth backend.
    a <- nestSnaplet "auth" auth $
           initJsonFileAuthManager defAuthSettings sess "users.json"

    redisdb <- nestSnaplet "redis" redis redisDBInitConf

    addRoutes routes
    addAuthSplices h auth
    return $ App h s a redisdb

このredisdb <- ...の部分が初期化コードです。redisDBInitConfがコンフィグファイルdevel.cfgredisセクションのコンフィグを読み込んでコンフィグを作ります。それをredisに渡して初期化です。簡単ですね。

RedisDB用のコンフィグを作る

f:id:euphonictechnologies:20150804220645p:plain

プロジェクトのルートディレクトリ(firstsnap.cabalがあるのと同じ場所)にdevel.cfgというファイルを作ります。 内容はこんな感じ:

redis {
    host = "localhost"
    port = 6379
    auth = "foobared"
    max_connections = 10
    max_idle_time = 100
}

max_idle_timeが長すぎる気がしますが(単位は秒)特に気にしないことにしましょう。なんの設定か私も知りません。

hostとportはわかりますが、authとは何でしょうか。 Redisにはパスワード認証をつけることができます。authコマンドでパスワードを打ち込んでからでないと他のコマンドを実行できないように保護することができます。当然Redis Cloud上のRedisにはパスワード認証がついていますので、テスト環境たるローカルRedisにもパスワード保護をしておくほうがテストにふさわしいと言えます。authに設定を入れておくとRedisDBのsnaplet(というよりはHaskellのRedisライブラリであるhedisが)が初期化時にパスワード認証もしておいてくれます。

ローカルRedisにパスワードを設定する

redis-serverは

$ redis-server /usr/local/etc/redis.conf

と立ち上げました。なので、redis.confの中にパスワードを設定できるはずです。開いてみると

#requirepass foobared

てな感じになっているのでコメント(#)を外しましょう。好きなパスワードに変えても構いません。 redis-cliでパスワードのテストをしましょう。新しいredis-cliセッションを立ち上げて:

$ redis-cli -h localhost -p 6379
localhost:6379> ping
(error) NOAUTH Authentication required.
localhost:6379> keys *
(error) NOAUTH Authentication required.
localhost:6379> auth i_don_t_know_password_sorry
(error) ERR invalid password
localhost:6379> auth foobared
OK
localhost:6379> ping
PONG
localhost:6379> keys *
1) "msg"
2) "nissan"
3) "key"

こんな感じでパスワード認証前と後で保護されていることがわかりますね。

RedisDBに実際に接続してデータを書き込む

まずは簡単な書き込みのほうをやっつけましょう。

Site.hsで

routes = [ ("/login",    with auth handleLoginSubmit)
         , ("/logout",   with auth handleLogout)
         , ("/add_data", require auth handleAddData)       -- Added this!
         , ("",          serveDirectory "static")
         ]

と/add_dataなるラウティングを設定します。handleAddDataはHandle App App ()型です。ちなみにrequire関数は何の変哲もない

require :: SnapletLens App (AuthManager App)
           -> Handler App App ()
           -> Handler App App ()
require authe = requireUser authe handleNotLoggedIn

handleNotLoggedIn :: Handler App App ()
handleNotLoggedIn = writeBS "No User"

なる関数です。requireUserを呼び出して今のセッションがログインされていれば2つ目の引数のHandle App App ()を返します(つまり、それをsnapがあとでhttpリクエスト処理時に起動します)。ログインしてなければhandleNotLoggedInなる関数を返します。

handleNotLoggedInはそっけなく"No User"と画面に返します。<html>...</html>もついていない殺風景な返答です。今のところはこれで我慢しましょう。ちなみにセキュリティガバガバなのでこんなものを重要な本番アプリケーションで使ってはいけません。

ではhandleAddDataを実装する・・・前に、入力ページをさっくり作ってしまいます。

f:id:euphonictechnologies:20150804222232p:plain

こんなページ。作るファイルは3つ。

  • add_data.tpl
  • _add_data.tpl
  • dataform.tpl

多分3つもいらないんだと思うんですが、new_user.tplを踏襲しました。 それぞれ中身は add_data.tpl:

<apply template="base">
    <apply template="_add_data" />
</apply>

_add_data.tpl:

<h1>Add data</h1>
    <bind tag="postAction">/add_data</bind>
    <bind tag="submitText">Add Data</bind>
<apply template="dataform"/>

dataform.tpl:

<form method="post" action="${postAction}">
  <table id="info">
    <tr>
      <td>Key:</td><td><input type="text" name="key" size="20" /></td>
    </tr>
    <tr>
      <td>Value:</td><td><input type="text" name="value" size="20" /></td>
    </tr>
    <tr>
      <td></td>
      <td><input type="submit" value="${submitText}" /></td>
    </tr>
  </table>
</form>

こんな感じです。

なんとなく雰囲気から察していただけると思います。bindは変数に値をバインドして、applyはそれを実際に使います。

これを使うhandleAddData関数をHaskellで実装しましょう。Site.hsに戻って…

...
import qualified Database.Redis as R           -- Need to import Hedis!
...
handleAddData :: Handler App App ()
handleAddData = method GET handleForm <|> method POST handleFormSubmit
    where
        handleForm = render "add_data"
        setDataWith key value = runRedisDB redis $ R.set (fromJust key) (fromJust value)
        handleFormSubmit = do
            key <- getPostParam "key"
            value <- getPostParam "value"
            setDataWith key value
            redirect "/"

これだけです。<|>はAltenativeですね。Getの場合はhandleForm、Postの場合はhandleFormSubmit関数に分岐します。

handleFormの時はさっき作った"add_data.tpl"を使うと書いてあります。renderはHeist(htmlテンプレートエンジン)の関数で、ページを生成してそれを表示します。

handleFormSubmitの時は、"key"と"value"をPostパラメータから取り出します。で、それを使ってsetコマンドを実行します。Rと言うのはHedisのことです。RedisDB snapletのrunRedisDBはHedisのrunRedisのラッパです。runRedisができるようにコネクションredisをSnapのLensから取り出して、それを渡してあげます。で、Redisアクションを実行します。上のコードではR.set (fromJust key) (fromJust value)がRedisアクションです。これはIO ()と同じでアクションなのでdoの中にいっぱい書いてやることもできます。今回は単一コマンドなので直にかけばよいです。

fromJustは手抜きです。失敗するとそのまま何もせずに抜けます。

最後にredirect "/"です。トップページに戻ります。これだけです!

読み込みを実装する前に早速動かしてみましょう。そのまえにfirstsnap.cabalファイルの編集が必要です。

firstsnap.cabalを編集する

パッケージのバージョンとか指定しておくと面倒なので、全部最新のもので依存関係も適当にやっつけさせましょう。パッケージのバージョンは必要に応じて後で固定していきましょう。ここらへんは適当に:

Name:                firstsnap
Version:             0.1
Synopsis:            Project Synopsis Here
Description:         Project Description Here
License:             AllRightsReserved
Author:              Author
Maintainer:          maintainer@example.com
Stability:           Experimental
Category:            Web
Build-type:          Simple
Cabal-version:       >=1.2

Flag development
    Description: Whether to build the server in development (interpreted) mode
    Default: False

Flag old-base
    default: False
    manual: False

Executable firstsnap
    hs-source-dirs: src
    main-is: Main.hs

    Build-depends:
        configurator,
        transformers,
        network,
        bytestring,
        heist,
        MonadCatchIO-transformers,
        mtl,
        snap,
        snap-core,
        snap-server,
        snap-loader-static,
        text,
        time,
        xmlhtml,
        base,
        lens,
        hedis

    if flag(development)
        build-depends:
            snap-loader-dynamic == 0.10.*
        cpp-options: -DDEVELOPMENT
        -- In development mode, speed is already going to suffer, so skip
        -- the fancy optimization flags.  Additionally, disable all
        -- warnings.  The hint library doesn't give an option to execute
        -- compiled code when there were also warnings, so disabling
        -- warnings allows quicker workflow.
        ghc-options: -threaded -w
    else
        if impl(ghc >= 6.12.0)
            ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
                         -fno-warn-orphans -fno-warn-unused-do-bind
        else
            ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
                         -fno-warn-orphans

と潔くバージョン指定部分をごっそり抜いておきます。configurator, transformers, network, hedisあたりが新しく追加されたものです。これでビルドしてrunしましょう。

ひとまずrun

$ cabal run -- -p 8080
Preprocessing executable 'firstsnap' for firstsnap-0.1...
...
Initializing CookieSession @ /sess
Initializing JsonFileAuthManager @ /auth
Initializing redis @ /redis

Listening on http://0.0.0.0:8080/

となるはずです。上記のようにredisがsnapletとして読み込まれていることを確認して下さい。http://0.0.0.0:8080/add_dataにアクセスして確認してみましょう。確認のためにredis-cliでredis-serverに接続してmonitorコマンドを使うと便利です。ちなみに毎回authしなくても-aオプションにパスワードを渡して認証ができます。

$ redis-cli -h localhost -p 6379 -a foobared
localhost:6379> ping
PONG
localhost:6379> monitor
OK

こうしておいて、テスト入力をしてみます。

f:id:euphonictechnologies:20150804224207p:plain

こんな感じに反応してくれるはず

localhost:6379> monitor
OK
1438695701.597308 [0 127.0.0.1:54792] "AUTH" "foobared"
1438695701.597800 [0 127.0.0.1:54792] "SET" "adding_data" "data added?"

authコマンドはコードに記述していないですが、hedisが面倒を見てくれています。上に書いたsetコマンドが正しく実行されているようですね。

Ctrl-cでredis-cliを抜けて、もう一回クライアントを起動して、念の為にデータが書き込まれていることを確認します。

$ redis-cli -h localhost -p 6379 -a foobared
localhost:6379> get adding_data
"data added?"

いいね!

RedisDBに実際に接続してデータを読み込む

まだ道半ばです。今度は読み込みです。ページをわざわざ用意するのは面倒なのでプレーンテキストで応答を返してしまいましょう。

まずラウティングを追加して…

routes = [ ("/login",    with auth handleLoginSubmit)
         , ("/logout",   with auth handleLogout)
         , ("/add_data", require auth handleAddData)
         , ("/show_data", require auth handleShowData)      -- Added this!
         , ("",          serveDirectory "static")
         ]

同じですね。で、実際の関数の中身は

handleShowData :: Handler App App ()
handleShowData = method GET handleFormSubmit
    where
        -- Assuming if there's key, there's value, whatever it is.
        right = either undefined id
        handleFormSubmit = do
            (allkeys, alldata) <- runRedisDB redis $ do
                allkeys <- R.keys "*"
                alldata <- R.mget $ right allkeys
                return (right allkeys, map (fromMaybe "NULL") $ right alldata)
            writeBS $ BS.append ("Data I have:\n" :: ByteString) $ BS.pack $ show $ zip allkeys alldata

こんな感じ。目的はすべてのキーとそのそれぞれのキーに紐付いているバリューを画面に表示することです。

肝はhandleFormSubmitです。runRedisDBでRedisアクションを実行してその返り値を受取ります。 アクションの中身は

  1. keys *してキーをすべて列挙する。
  2. そのキーのリストをmgetに渡してすべての関連するバリューをゲットする。
  3. それを返す。

と素直な感じです。 Redisアクションの返り値はほとんど、例えばmgetなら

mget
:: RedisCtx m f    
=> [ByteString]    
-> m (f [Maybe ByteString])

で、mとfはそれぞれRedisCtx Redis (Either Reply)なので答えはRedis (Either Reply [Maybe ByteString])です。つまり、成功時にはRight [Maybe ByteString]、失敗時にはLeft Replyが帰ってきます。 失敗時にはずっこけることにして上のコードでは直接rightしてRightの中身を取り出しています。

というわけで、MaybeをfromMaybeで引っぺがして(失敗時にはその部分を"NULL"という文字列で置き換えて表示)、Rightはrightで引っぺがして(失敗時には例外をthrow)最終的にキーと値をタプルに入れてRedisアクションを終えます。最後はそれを単純にzipして(リストのタプルをタプルのリストに)、画面に表示するwriteBSします。

これでアプリ自体は完成です。実際に動かしてみると

$ cabal run -- -p 8080

f:id:euphonictechnologies:20150804233513p:plain

表示されました!

つづく

というわけでローカルで動くものが出来ました。これでほとんどおしまいなのですが、ちょっと私が息切れしてきたので、herokuへのデプロイとRedis Cloudへの接続は次回に譲ることにします。