Morpheus GraphQL + GitHub GraphQL API でピンされたリポジトリ情報を Hakyll から利用する

私が運営しているポータルページ https://roki.dev のトップページには Contributions というコーナーがあり、そこには私のお気に入りのプロジェクトを掲載している。この内容は元々 Dhall で定義したファイルから読み取ることで定義していたのだが、ふと GitHub アカウント上にピン留めしているリポジトリの一覧と同期するのが良いのではないかと思いついた。これを Morpheus GraphQL を使用して GitHub GraphQL API を叩き、そこから得た情報を Hakyll のサイト生成で利用することで実現したのだが、比較的新しい Morpheus GraphQL と GitHub GraphQL API の組み合わせにおける日本語での情報があまりなかったため、本エントリにおいて紹介する。
本エントリで扱う内容の対象 PR は下記のものとなる。

https://github.com/falgon/roki-web/pull/563

GraphQL クエリを組み立てる

GitHub の GraphQL API はエクスプローラーを利用することで実際にどのようなレスポンスが返却されるのか確認できる。今回は特定アカウント上にピン留めしているリポジトリの一覧が欲しいので、下記のようなクエリとなる。

{
    user(login: "github-id") {
        pinnedItems(types: REPOSITORY, first: 6) {
            nodes {
                ... on Repository {
                    url
                    name
                    description
                    stargazerCount
                    languages(orderBy: {field: SIZE, direction: DESC}, first: 1) {
                        nodes {
                            name
                            color
                        }
                    }
                }
            }
        }
    }
}

morpheus-graphql-client から利用する

上記の GraphQL クエリを Morpheus GraphQL で実行するには、morpheus-graphql-client パッケージを利用する。

依存パッケージの調整について

本エントリの執筆時においては、最新の LTS resolver が lts-22.29 であり、morpheus-graphql-client の最新バージョンが 0.27.3 で、これは aeson という json のパース/生成を行うライブラリに依存しているが、さらにそれの依存パッケージである network-uri パッケージの URI 型が FromJSON のインスタンスである必要がある。この実装は、aeson の 2.2.0.0 から含まれるが lts-22.29 ではそのバージョンが 2.1.2.1 なので extra-deps で下記のように指定してあげる必要がある。これは、将来的にバージョンの上がった LTS に含まれるはずなので、現段階における特別な問題といえる。

extra-deps:
  - aeson-2.2.3.0@sha256:ef66d29cb5b8d87a144838dfd5745bb3ac6b8fc4b142129fac84814baee13660,6351
  - attoparsec-aeson-2.2.2.0@sha256:02dc3cc4d217a364471da7ce0f47be39e5b1449e7768134e5f2926d87a21448d,1590
  - character-ps-0.1@sha256:b38ed1c07ae49e7461e44ca1d00c9ca24d1dcb008424ccd919916f92fd48d9fe,1315
  - pantry-0.10.0@sha256:8d69a11774c4c9074b73c7692eb0237c025e557d9b1d9b9e44cfa0863d7de5cf,7879
  - morpheus-graphql-0.28.1@sha256:3a9d854e6bf65213f1cf941fe2d54d9c9b798c0d454d3e66119af50a52b25cc6,17793
  - morpheus-graphql-client-0.28.1@sha256:dafa8ac98167d4b010c21eceed5ccfb4d28c331c894dfa3e52b33dec486cc781,5333
  - morpheus-graphql-app-0.28.1@sha256:f397e571a5d45e3d69e1cbaf95c602db029b8723ad23726133d2198e953b5faa,9202
  - morpheus-graphql-code-gen-0.28.1@sha256:22a8ac2225feb5c139762adaee9aa7375e3d203aa4b645f89ee9b0dca2a87daa,2761
  - morpheus-graphql-code-gen-utils-0.28.1@sha256:3f0f15bbbfc7afe68996efa92aaba6ccb25c67de9a7586607ed3b34de8a8b73a,1570
  - morpheus-graphql-subscriptions-0.28.1@sha256:4c31a6487de940cecd3732f6413325f4b87084481467402666347752e2ca30bd,1784
  - morpheus-graphql-core-0.28.1@sha256:d257c2f9a251ead16e2b1156adf0bc4eca33c10de5635562c3de5093bfaac052,14209

下記のようにして、GitHub GraphQL API のパブリックスキーマから API 仕様を読み込み declareLocalTypesInline を用いて実行したいクエリを指定することで、Template Haskell によるデータ型の生成が行われる。

{-# LANGUAGE BangPatterns, DeriveGeneric, DerivingStrategies,
             DuplicateRecordFields, OverloadedStrings, QuasiQuotes,
             TemplateHaskell, TypeFamilies #-}


import Data.Morpheus.Client (declareLocalTypesInline, raw)
import Network.URI          (URI)

declareLocalTypesInline "./tools/github/schema.docs.graphql"
    [raw|
        query GetPinnedRepos($user: String!) {
            user(login: $user) {
                pinnedItems(types: REPOSITORY, first: 6) {
                    nodes {
                        ... on Repository {
                            __typename
                            url
                            name
                            description
                            stargazerCount
                            languages(orderBy: {field: SIZE, direction: DESC}, first: 1) {
                                nodes {
                                    name
                                    color
                                }
                            }
                        }
                    }
                }
            }
        }
    |]

Template Haskell によって生成された結果は stack haddock 等でドキュメントを生成して確認^[1]したり、stack ghci 等でインタラクティブな環境でその型情報を確認したり等すると扱いやすい。

トークンの設定

roki-web では GitHub Actions を利用してサイト生成を行っているため、GitHub Actions が提供する ${{ secrets.GITHUB_TOKEN }} を利用して認証を行うと丁度よい。リポジトリの情報が読めれば良いので、下記のように権限を設定する。

jobs:
  build:
    permissions:
      repository-projects: read

下記のようにして実行部分で環境変数を設定する。

jobs:
  build:
    steps:
      # 略...
    - name: Build and validate roki.dev
      run: |
        ./site build
        ./site check --internal-links
        # 略...
        tar cvf docs.tar.xz docs
      env:
        GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}

静的サイトジェネレータからは $GITHUB_TOKEN 環境変数からトークンを読むようにする。

リクエストを送信する

上記で生成したデータ型を用いてリクエストを送信する。morpheus-graphql-client パッケージに用意されている fetch 関数の第一引数は (ByteString -> m ByteString) となっており、これは ByteString のクエリ文字列をボディとして設定し HTTP リクエストを投げ、そのレスポンスを ByteString で返すことが想定されている。ここでは jsonRes' としてプログラム名を束縛した上で実際にリクエストを行う関数を指定している。

reqGitHubPinnedRepo :: BU.ByteString -> IO [Project]
reqGitHubPinnedRepo token = do
    jsonRes' <- jsonRes <$> getProgNameV
    fetch jsonRes' (GetPinnedReposArgs "github-id")
        >>= either (const loadProjects) (runMaybeT . gitHubResp >=> maybe loadProjects pure)
    where
        jsonRes progName b = runReq defaultHttpConfig $ responseBody
            <$> req POST (https "api.github.com" /: "graphql") (ReqBodyLbs b) lbsResponse (headers progName)
        headers progName = mconcat [
            header "Content-Type" "application/json"
          , header "User-Agent" $ fromString $ mconcat [ progName, " (", os, "; ", arch, ")" ]
          , oAuth2Bearer token
          ]

上記リンクのドキュメントを見れば分かるように、生成された型は何重にも Maybe にラップされいるので MaybeT の文脈内で hoistMaybe を使用し、Nothing であったときの挙動を一元化するようにして欲しいデータを整備していくようにすると視認性がよくなるかもしれない。

gitHubResp :: GetPinnedRepos -> MaybeT IO [Project]
gitHubResp (GetPinnedRepos gpr) = do
    GetPinnedReposUserPinnedItems ns <- pinnedItems <$> hoistMaybe gpr
    mapM (hoistMaybe >=> unwrap) =<< hoistMaybe ns
    where
        unwrap (GetPinnedReposUserPinnedItemsNodesVariantRepository x) =
            let GetPinnedReposUserPinnedItemsNodesRepository _ projLink' projName' summary' _ langs = x in do
                GetPinnedReposUserPinnedItemsNodesLanguages langs' <- hoistMaybe langs
                lang' <- TL.unpack . fst
                    <$> (hoistMaybe . L.uncons =<< mapM (hoistMaybe >=> unwrap') =<< hoistMaybe langs')
                pure $ Project {
                    projName = TL.unpack projName'
                  , lang = lang'
                  , summary = maybe mempty TL.unpack $ summary'
                  , projLink = show projLink'
                  }
        unwrap GetPinnedReposUserPinnedItemsNodes = mzero
        unwrap' (GetPinnedReposUserPinnedItemsNodesLanguagesNodes l _) = pure l

Hakyll から利用してサイトに埋め込む

上記を使って Hakyll で静的サイトを生成する過程でピンされたリポジトリの情報を埋め込む。全体としては下記のようなフローで埋め込みを行う。

といっても、本質的には上記 reqGitHubPinnedRepo を preprocess で呼び出せばよいだけだ。

renderProjectsList :: IO String
renderProjectsList = do
    ps <- maybe loadProjects (reqGitHubPinnedRepo . BU.fromString) =<< lookupEnv "GITHUB_TOKEN"
    return $ TL.unpack $ renderText $
        dl_ $ forM_ ps $ \p -> do
            dt_ [class_ "title is-4"] $ do
                a_ [href_ $ fromString $ projLink p] $ fromString $ projName p
                span_ [class_ "ml-2 tag is-success is-light"] $ fromString $ lang p
            dd_ [class_ "mb-6"] $ fromString $ summary p

rules :: [BlogConfig m] -> PageConfReader Rules ()
rules bcs = do
    faIcons <- asks pcFaIcons
    projs <- lift $ preprocess renderProjectsList
    conts <- lift $ preprocess renderContributionsTable
    let baseCtx = mconcatMap (uncurry constField) [
            ("title", siteName)
          , ("projs", projs)
          , ("contable", conts)
          ]
    lift $ match indexPath $ do
        route $ gsubRoute (contentsRoot </> "pages/") (const mempty)
        compile $ do
            topCtx <- mappend baseCtx <$> mconcatMapM (runReaderT mkBlogCtx) bcs
            getResourceBody
                >>= applyAsTemplate topCtx
                >>= loadAndApplyTemplate rootTemplate topCtx
                >>= modifyExternalLinkAttr
                >>= relativizeUrls
                >>= FA.render faIcons
    where
        indexPath = fromGlob $ joinPath [contentsRoot, "pages", "index.html"]
        rootTemplate = fromFilePath $ joinPath [contentsRoot, "templates", "site", "default.html"]

ここでは、得られたデータを lucid パッケージによって HTML 化してコンテキストとして渡すことで表示させている。

参考

1. https://matsubara0507.github.io/posts/2021-12-09-use-morpheus-graphql-for-github.html
2. https://github.com/morpheusgraphql/morpheus-graphql/blob/main/morpheus-graphql-client/README.md
3. https://morpheusgraphql.com/
4. https://hackage.haskell.org/package/morpheus-graphql-client

脚注

1. 手元で確認する際には --no-haddock-deps を指定することで依存パッケージに関する haddock の生成をスキップさせ、高速化を図るのが良い