Qiita Teams that are logged in
You are not logged in to any team

Log in to Qiita Team
Community
OrganizationAdvent CalendarQiitadon (β)
Service
Qiita JobsQiita ZineQiita Blog
Help us understand the problem. What is going on with this article?

【Servant】(10) SQLite

【Servant】(1) Wai - Qiita
【Servant】(2) Servantチュートリアル - Qiita
【Servant】(3) エンドポイントを増やす - Qiita
【Servant】(4) URLパラメータをハンドラの引数とする - Qiita
【Servant】(5) JSON - Qiita
【Servant】(6) HTML - Qiita
【Servant】(7) Post Data - Qiita
【Servant】(8) Another Monad - Qiita
【Servant】(9) Handlerモナド - Qiita
【Servant】(10) SQLite - Qiita
【Servant】(11) Servant-Client - Qiita
【Servant】(12) Basic 認証 - Qiita

前回はHandlerで、IOモナドが使えることをみました。今回はIOモナドとしてDB(SQLite)を使ってみます。以下のドキュメントを利用します。

SQLite database - Servant documentation

またWindowsへのSQLiteのインストールは以下の記事を参考にさせていただきました。
SQLite 3.27.1 をインストールして使ってみる(Windows 上)

1. 全ソース

まず全ソースを掲載し、後に説明を入れます。

Sqlit.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

module Sqlite
    ( runServant
    ) where

import Control.Monad.IO.Class
import Database.SQLite.Simple
import Network.Wai.Handler.Warp
import Servant


type Message = String

type API = "message" :> ReqBody '[JSON] Message :> Post '[JSON] NoContent
      :<|> "message" :> Get '[JSON] [Message]

api :: Proxy API
api = Proxy



initDB :: FilePath -> IO ()
initDB dbfile = withConnection dbfile $ \conn ->
  execute_ conn
    "CREATE TABLE IF NOT EXISTS messages (msg text not null)"


server :: FilePath -> Server API
server dbfile = postMessage :<|> getMessages

  where postMessage :: Message -> Handler NoContent
        postMessage msg = do
          liftIO . withConnection dbfile $ \conn ->
            execute conn
                    "INSERT INTO messages VALUES (?)"
                    (Only msg)
          return NoContent

        getMessages :: Handler [Message]
        getMessages = fmap (map fromOnly) . liftIO $
         withConnection dbfile $ \conn ->
            query_ conn "SELECT msg FROM messages"

runServant :: IO ()
runServant = do
    let dbname="mydb"
    initDB dbname
    run 4000 (serve api $ server dbname)

メイン

Main.hs
module Main where

import qualified HtmlContent       as T1
import qualified PostData          as T2
import qualified CustomPostData    as T3
import qualified AnotherMonad      as T4
import qualified Sqlite            as T5

main :: IO ()
main = T5.runServant

使用するパッケージ

package.yaml
dependencies:
- base >= 4.7 && < 5
- servant
- servant-server
- aeson
- time
- wai
- warp
- http-media
- bytestring
- mtl
- sqlite-simple

2. 説明

FilePathは以下のようにStringで定義してあります。

FilePath
type FilePath = String

SQLiteへの接続はsqlite-simpleを使います。
sqlite-simple: Mid-Level SQLite client library

import Database.SQLite.Simple

sqlite-simpleは使いやすくて、simpleシリーズはpostgresql-simpleなど他のDBへの横展開もされており、使い慣れておくと便利です。

mainでサーバ起動時に以下の関数でテーブル初期化を行っています。messages は1個のtextフィールドで構成される簡単なものです。

initDB
initDB :: FilePath -> IO ()
initDB dbfile = withConnection dbfile $ \conn ->
  execute_ conn
    "CREATE TABLE IF NOT EXISTS messages (msg text not null)"

APIはPOSTとGETを用意します。

API
type API = "message" :> ReqBody '[JSON] Message :> Post '[JSON] NoContent
      :<|> "message" :> Get '[JSON] [Message]

POSTとGETに対応するHandlerは以下のようになります。それぞれテーブルへのINSERTとSELECTを実行する役割になります。NoContentはcontent-bodyのないレスポンスです。

server
server :: FilePath -> Server API
server dbfile = postMessage :<|> getMessages

  where postMessage :: Message -> Handler NoContent
        postMessage msg = do
          liftIO . withConnection dbfile $ \conn ->
            execute conn
                    "INSERT INTO messages VALUES (?)"
                    (Only msg)
          return NoContent

        getMessages :: Handler [Message]
        getMessages = fmap (map fromOnly) . liftIO $
         withConnection dbfile $ \conn ->
            query_ conn "SELECT msg FROM messages"

値ConstructorのOnlyは以下のように定義されます。使われ方はIdentity型に等しいですが、意味するところは1-tuple型の表現です。(Haskellには1-tupleが存在しないことを思い出してください。)

Only
newtype Only a = Only { fromOnly :: a }

sqlite-simpleでは「Haskell Data <--> sqlite table」の変換に、ToRowFromRowクラスを用います。それぞれのインスタンスになるためには、toRow関数とfromRow関数の提供が要求されます。

getMessagesを見ます。以下の定義により、(Only a)がFromRow のインスタンスとなり、queryで得られたrowのfieldから (Only a)型のdataが得られます。最終的にはfromOnlyで値ConstructorのOnlyを除き、a型の値のみを取り出し提案す。

Only
instance (FromField a) => FromRow (Only a) where
    fromRow = Only <$> field

postMessage をみます。(Only a)はToRowのインスタンスでもあります。値として(Only msg)をinsertしています。

3. 実行結果

まずPOSTで「Hello」というmessageを挿入します。

$ curl -v -H "Content-Type:application/json" -d "\"Hello\"" http://127.0.0.1:4000/message
*   Trying 127.0.0.1:4000...
* TCP_NODELAY set
  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
                                 Dload  Upload   Total   Spent    Left  Speed
  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0* Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0)
> POST /message HTTP/1.1
> Host: 127.0.0.1:4000
> User-Agent: curl/7.67.0
> Accept: */*
> Content-Type:application/json
> Content-Length: 7
>
} [7 bytes data]
* upload completely sent off: 7 out of 7 bytes
* Mark bundle as not supporting multiuse
< HTTP/1.1 200 OK
< Transfer-Encoding: chunked
< Date: Sun, 01 Mar 2020 00:19:43 GMT
< Server: Warp/3.3.5
< Content-Type: application/json;charset=utf-8
<

次にPOSTで「World」というmessageを挿入します。

$ curl -v -H "Content-Type:application/json" -d "\"World\"" http://127.0.0.1:4000/message
*   Trying 127.0.0.1:4000...
* TCP_NODELAY set
  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
                                 Dload  Upload   Total   Spent    Left  Speed
  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0* Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0)
> POST /message HTTP/1.1
> Host: 127.0.0.1:4000
> User-Agent: curl/7.67.0
> Accept: */*
> Content-Type:application/json
> Content-Length: 7
>
} [7 bytes data]
* upload completely sent off: 7 out of 7 bytes
* Mark bundle as not supporting multiuse
< HTTP/1.1 200 OK
< Transfer-Encoding: chunked
< Date: Sun, 01 Mar 2020 00:20:54 GMT
< Server: Warp/3.3.5
< Content-Type: application/json;charset=utf-8
<
{ [5 bytes data]
100     7    0     0  100     7      0     61 --:--:-- --:--:-- --:--:--    61

現在のSQLite DBの中身を確認します。

$ sqlite3 mydb
SQLite version 3.31.1 2020-01-27 19:55:54
Enter ".help" for usage hints.
sqlite> .tables
messages
sqlite> select * from messages;
Hello
World

ちゃんと「Hello」と「World」が入っていますので、OKです。

最後にGETでDBにアクセスしてみます。

$ curl -v http://127.0.0.1:4000/message                                         *   Trying 127.0.0.1:4000...
* TCP_NODELAY set
  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
                                 Dload  Upload   Total   Spent    Left  Speed
  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0* Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0)
> GET /message HTTP/1.1
> Host: 127.0.0.1:4000
> User-Agent: curl/7.67.0
> Accept: */*
>
* Mark bundle as not supporting multiuse
< HTTP/1.1 200 OK
< Transfer-Encoding: chunked
< Date: Sun, 01 Mar 2020 00:21:29 GMT
< Server: Warp/3.3.5
< Content-Type: application/json;charset=utf-8
<
{ [30 bytes data]
100    17    0    17    0     0   8500      0 --:--:-- --:--:-- --:--:-- 17000
["Hello","World"]   ### 取り出した値

ちゃんと["Hello","World"]と表示されました。

今回は以上です

sand
Haskell、Elm、Elixir、Phoenixなどが好きな言語です。 確率統計を勉強中。
Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away