Haskell の GraphQL ライブラリ Morpheus を使ってみた


Haskell で GraphQL の API を構築できるライブラリ [Morpheus GraphQL](https://morpheusgraphql.com/) を使ってみました。
[README の Getting Started](https://github.com/morpheusgraphql/morpheus-graphql#getting-started) を参考に、プロジェクト作成から GraphiQL でクエリを投げて動作確認するところまで行いました。

最終的に出来上がったコードは以下のリポジトリにまとめてあります。

https://github.com/wataru86/morpheus-sample

# プロジェクト作成

READMEに従い、Stackを使って開発をしていきます。
`stack new` コマンドでプロジェクトを作成します。

```
$ stack new morpheus-sample
```

# 使用するパッケージとバージョンの指定

`package.yaml` ファイルの `dependencies` に `morpheus-graphql` を追加します。

```yaml:package.yaml
dependencies:
  - base >= 4.7 && < 5
  - morpheus-graphql
```

さらに、`stack.yaml` ファイルを以下のように変更します。

```yaml:stack.yaml
resolver: lts-16.2
packages:
  - .
extra-deps:
  - morpheus-graphql-0.17.0
  - morpheus-graphql-app-0.17.0
  - morpheus-graphql-core-0.17.0
```

ここで一旦ビルドします。`stack build` でビルドしてみましょう。

```
$ stack build
...
Registering library for morpheus-sample-0.1.0.0..
Completed 27 action(s). 
```

よさそうです。

# スキーマの定義

スキーマの定義方法は２つあります。
GraphQLの記法で定義を書いたファイルを読み込む方法と、Haskellの型として定義する方法です。
せっかくHaskellで書いているので、今回は型で定義してみました。

```haskell:Main.hs
data Query m = Query
  { user :: UserArgs -> m User
  } deriving (Generic, GQLType)

data User = User
  { name :: Text
  , email :: Text
  } deriving (Generic, GQLType)

data UserArgs = UserArgs
  { name :: Text
  } deriving (Generic, GQLType)
```

ユーザーは名前(`name`)とメールアドレス(`email`)を持ち、名前で検索できる、という感じです。

# データベースもどきの準備

データベースを用意する代わりに、ユーザーのリストと検索用の関数を作りました。

```haskell:Main.hs
userDB :: [User]
userDB = 
  [ User "Thoru" "thoru@maidragon.com"
  , User "Kanna" "kanna@maidragon.com"
  , User "Fafnir" "fafnir@maidragon.com"
  , User "Lucoa" "lucoa@maidragon.com"
  , User "Elma" "elma@maidragon.com"
  , User "Ilulu" "ilulu@maidragon.com"
  ]

findUserByName :: Text -> Maybe User
findUserByName name = find (\(User name' _) -> name == name') userDB
```

次はこれを元にリゾルバを作成していきます。

# リゾルバの実装

ユーザーのリゾルバ `resolveUser` を実装をします。
`resolveUser` の型 `UserArgs -> ResolverQ e IO User` はスキーマで定義した `user :: UserArgs -> m User` に対応しています。

```haskell:Main.hs
resolveUser :: UserArgs -> ResolverQ e IO User
resolveUser (UserArgs name) = maybe (fail "User not found.") return $ findUserByName name
```

そして、以下のように `rootResolver` を作成し、それを `interpreter` に渡すことで、`gqlApi` が完成しました。
（今回、Mutation と Subscription は実装しないので、`Undefined` を指定しています。）

```haskell:Main.hs
rootResolver :: RootResolver IO () Query Undefined Undefined
rootResolver =
  RootResolver
    { queryResolver = Query {user = resolveUser}
    , mutationResolver = Undefined
    , subscriptionResolver = Undefined
    }

gqlApi :: ByteString -> IO ByteString
gqlApi = interpreter rootResolver
```

`gqlApi` にクエリを渡すと、リゾルバを通して適切なデータが返ってきます。

# サーバーの実装

Morpheus の [README](https://github.com/morpheusgraphql/morpheus-graphql#readme) では `scotty` でサーバーを実装していますが、今回は `wai` と `warp` を使ってサーバーを実装してみました。リクエストのBodyを `gqlApi` に渡し、実行結果を返すようにしています。

```haskell:Main.hs
app :: Application
app request respond = do
  body <- getRequestBodyChunk request
  respond . responseLBS status200 [("Content-Type", "text/plain")] <=< gqlApi $ B.fromStrict body

main :: IO ()
main = do
  putStrLn $ "http://localhost:3000/"
  run 3000 app
```

これで完成です！

# 動作確認

`stack exec` でサーバーを起動します。

```
$ stack exec morpheus-sample-exe
http://localhost:3000/
```

GraphiQLでクエリを投げてみます。

![graphiql.PNG](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/325392/b9a8080a-087b-8d9d-0da9-eb2a965b6b35.png)

正しくデータが取得できました。

# おまけ

上記コードと言語拡張やインポート等を含めた完成版のファイルを以下に掲載します。

```haskell:Main.hs
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveAnyClass #-}

module Main where

import Control.Monad
import Data.Morpheus
import Data.Morpheus.Types
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B
import Data.Text (Text)
import qualified Data.Text as T
import Data.List
import GHC.Generics
import Network.Wai
import Network.HTTP.Types (status200)
import Network.Wai.Handler.Warp (run)

data Query m = Query
  { user :: UserArgs -> m User
  } deriving (Generic, GQLType)

data User = User
  { name :: Text
  , email :: Text
  } deriving (Generic, GQLType)

data UserArgs = UserArgs
  { name :: Text
  } deriving (Generic, GQLType)

userDB :: [User]
userDB = 
  [ User "Thoru" "thoru@maidragon.com"
  , User "Kanna" "kanna@maidragon.com"
  , User "Fafnir" "fafnir@maidragon.com"
  , User "Lucoa" "lucoa@maidragon.com"
  , User "Elma" "elma@maidragon.com"
  , User "Ilulu" "ilulu@maidragon.com"
  ]

findUserByName :: Text -> Maybe User
findUserByName name = find (\(User name' _) -> name == name') userDB

resolveUser :: UserArgs -> ResolverQ e IO User
resolveUser (UserArgs name) = maybe (fail "User not found.") return $ findUserByName name

rootResolver :: RootResolver IO () Query Undefined Undefined
rootResolver =
  RootResolver
    { queryResolver = Query {user = resolveUser}
    , mutationResolver = Undefined
    , subscriptionResolver = Undefined
    }

gqlApi :: ByteString -> IO ByteString
gqlApi = interpreter rootResolver

app :: Application
app request respond = do
  body <- getRequestBodyChunk request
  respond . responseLBS status200 [("Content-Type", "text/plain")] <=< gqlApi $ B.fromStrict body

main :: IO ()
main = do
  putStrLn $ "http://localhost:3000/"
  run 3000 app
```