HaskellでGitHubのGraphQL APIをGitHub Appとして認証して利用する
出来てみると何故苦戦していたのかという感じですが、色々と方法があって正しいものを選ぶことに苦労した感じがあるのでメモしておきます。
参考資料
このページはだいたい次のページの補完的なものになっています。まずこれを読むことを推奨します。
Haskell Morpheus GraphQL で GitHub API を試す
また必要がなければGraphQL APIを無理に使わないで、 github: Access to the GitHub API, v3. などのパッケージされたREST APIを使えば良いと思います。
今回私がやりたいことを素直にやるとAPIの呼び出しがどんどんネストしていって爆発してしまうので、 GraphQL APIを使うことが必要でした。
認証の違いがあるのでjwtを生成
色々と調べたのですが、基本的にGH_TOKENやPATなどを使っていることが前提になっていて、 GitHub AppとしてPrivate Keyを使って認証する方法が見つかりませんでした。
なので割と自前でjwtを生成していきました。
module Github.Auth where
import Data.Aeson
import Data.Convertible
import Import
import Network.HTTP.Req
import System.Environment (getEnv)
import Web.JWT hiding (header)
-- | GitHubのAPI、
-- `https://api.github.com/app/installations/" ++ GithubInstallationId ++ "/access_tokens`
-- の返り値を簡単に型付け。
-- `permissions`などは現状強く気をつける必要が無いので雑に辞書に入れている。
data InstallationsAccessTokens
= InstallationsAccessTokens
{ token :: Text
, expiresAt :: Text
, permissions :: Map Text Text
, repositorySelection :: Text
}
deriving (Eq, Ord, Read, Show, Generic)
-- | JSONの区切りがアンダースコアなのでHaskellらしくcamelCaseに変換。
camelToUnderscoreOptions :: Options
camelToUnderscoreOptions =
defaultOptions
{ fieldLabelModifier = camelTo2 '_'
}
instance FromJSON InstallationsAccessTokens where
parseJSON = genericParseJSON camelToUnderscoreOptions
instance ToJSON InstallationsAccessTokens where
toEncoding = genericToEncoding camelToUnderscoreOptions
-- | 環境変数のアプリインストールIDから一時的トークンを発行。
-- 発行するためにJWTを発行している。
-- アプリインストールIDはAPI経由で取得することも可能だが基本的に不変なので環境変数から取っている。
createToken :: MonadHttp m => m InstallationsAccessTokens
createToken = do
jwt <- createJwt
githubAppInstallationId <- liftIO $ convert <$> getEnv "GITHUB_APP_INSTALLATION_ID"
let url = https "api.github.com" /: "app" /: "installations" /: githubAppInstallationId /: "access_tokens"
headers =
header "Content-Type" "application/json" <>
header "User-Agent" "アプリ名を入れるのを推奨します" <>
header "Authorization" ("Bearer " <> convert jwt)
responseBody <$> req POST url NoReqBody jsonResponse headers
-- | 環境変数のアプリIDと認証鍵からJWTを生成。
createJwt :: MonadIO m => m Text
createJwt = do
githubAppId <- liftIO $ convert <$> getEnv "GITHUB_APP_ID"
githubAppPrivateKey <- liftIO (getEnv "GITHUB_APP_PRIVATE_KEY")
currentTime <- getCurrentTime
let privateKey = fromMaybe (error "GITHUB_APP_PRIVATE_KEYが正常な形式ではありません。") $
readRsaSecret (fromString githubAppPrivateKey)
encodeSigner = EncodeRSAPrivateKey privateKey
joseHeader = mempty
currentNumericDate = fromMaybe (error "現在の時刻形式が不正です。") $ numericDate $ convert currentTime
expTime = fromMaybe (error "期限切れ時刻形式が不正です。") $ numericDate $ convert currentTime + 600
jwtClaimsSet =
mempty
{ iss = stringOrURI githubAppId
, iat = Just currentNumericDate
, exp = Just expTime
}
return $ encodeSigned encodeSigner joseHeader jwtClaimsSet
token発行する部分のエンドポイントじゃないとBad credentialsになってしまったり、 POSTするべきところでGETすると404 not foundになってしまったりするので細かいところで注意が必要です。
この方法で作ったトークンを以下のように挿入するとGraphQLのクエリも実行できます。
module Github.GraphQL
( fetchWithAuth
) where
import Data.Convertible
import Data.Morpheus.Client
import Github.Auth
import Import
import Network.HTTP.Req
-- | Morpheus GraphQL Clientで通信。
fetchWithAuth :: (Fetch a, MonadIO m) => Args a -> m (Either (FetchError a) a)
fetchWithAuth = fetch resolver
-- | Morpheus GraphQL Clientの実際のHTTP通信を解決。
resolver :: MonadIO m => LByteString -> m LByteString
resolver body = runReq defaultHttpConfig $ do
tokens <- createTokens
let headers =
header "Content-Type" "application/json" <>
header "User-Agent" "アプリ名を入れるのを推奨します" <>
oAuth2Bearer (convert $ tokens ^. token)
responseBody <$> req POST (https "api.github.com" /: "graphql") (ReqBodyLbs body) lbsResponse headers
fetchWithAuthで統一的にページング処理とか出来ないかなと思って設置していますが、出来ないような気もするので別にここは包む必要ないかもしれません。
スキーマ参照してクエリを作るのがdeclareLocalTypesに変わっていたっぽいとかありますが、これで一応問題なくGraphQL APIを実行することが出来ます。
hatena-bookmark