【Servant】(10) SQLite

[【Servant】(1) Wai - Qiita](https://qiita.com/sand/items/16a6ef431a8376e7cbaa)
[【Servant】(2) Servantチュートリアル - Qiita](https://qiita.com/sand/items/fea7c294dd7835692ff7)
[【Servant】(3) エンドポイントを増やす - Qiita](https://qiita.com/sand/items/3af359b1830453d1d0ed)
[【Servant】(4) URLパラメータをハンドラの引数とする - Qiita](https://qiita.com/sand/items/d1c0bfb84487a1dfa9bb)
[【Servant】(5) JSON - Qiita](https://qiita.com/sand/items/fd2ea8acdc56998d5c5e)
[【Servant】(6) HTML - Qiita](https://qiita.com/sand/items/0e9f3c80b5103b966be4)
[【Servant】(7) Post Data - Qiita](https://qiita.com/sand/items/d21aed7c24521e20f1cb)
[【Servant】(8) Another Monad - Qiita](https://qiita.com/sand/items/9c8fa50815b00daead24)
[【Servant】(9) Handlerモナド - Qiita](https://qiita.com/sand/items/ae649f14f1b598d636c3)
[【Servant】(10) SQLite - Qiita](https://qiita.com/sand/items/091b0ea981152ad7d744)
[【Servant】(11) Servant-Client - Qiita](https://qiita.com/sand/items/a0e7758da7274a119849)
[【Servant】(12) Basic 認証 - Qiita](https://qiita.com/sand/items/dba678cef365fbd23ae3)




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

[SQLite database - Servant documentation](https://docs.servant.dev/en/stable/cookbook/db-sqlite-simple/DBConnection.html)


またWindowsへのSQLiteのインストールは以下の記事を参考にさせていただきました。
[SQLite 3.27.1 をインストールして使ってみる（Windows 上）](https://www.kkaneko.jp/tools/sqlite3/sqlite3.html)



# 1. 全ソース

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


```haskell: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)
```


メイン

```haskell: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
```

使用するパッケージ

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



# 2. 説明

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

```haskell:FilePath 
type FilePath = String
```


SQLiteへの接続は**sqlite-simple**を使います。
[sqlite-simple: Mid-Level SQLite client library](https://hackage.haskell.org/package/sqlite-simple)

```haskell:
import Database.SQLite.Simple
```


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



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

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

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

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

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


```haskell: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が存在しないことを思い出してください。）

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


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

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

```haskell: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"]と表示されました。


今回は以上です