【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. 全ソース
まず全ソースを掲載し、後に説明を入れます。
{-# 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)
メイン
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
使用するパッケージ
dependencies:
- base >= 4.7 && < 5
- servant
- servant-server
- aeson
- time
- wai
- warp
- http-media
- bytestring
- mtl
- sqlite-simple
2. 説明
FilePathは以下のようにStringで定義してあります。
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 :: FilePath -> IO ()
initDB dbfile = withConnection dbfile $ \conn ->
execute_ conn
"CREATE TABLE IF NOT EXISTS messages (msg text not null)"
APIはPOSTとGETを用意します。
type API = "message" :> ReqBody '[JSON] Message :> Post '[JSON] NoContent
:<|> "message" :> Get '[JSON] [Message]
POSTとGETに対応するHandlerは以下のようになります。それぞれテーブルへのINSERTとSELECTを実行する役割になります。NoContentはcontent-bodyのないレスポンスです。
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が存在しないことを思い出してください。）
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型の値のみを取り出し提案す。
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"]と表示されました。
今回は以上です