Generate an installation access token for a GitHub App
import Prelude
import Data.Aeson (FromJSON)
import Data.ByteString.Char8 qualified as BS8
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import GHC.Generics (Generic)
import GitHub.App.Token
import Network.HTTP.Simple
import Network.HTTP.Types.Header (hAuthorization, hUserAgent)
import System.Environment
getAppToken :: IO AccessToken
getAppToken = do
appId <- AppId . read <$> getEnv "GITHUB_APP_ID"
privateKey <- PrivateKey . BS8.pack <$> getEnv "GITHUB_PRIVATE_KEY"
installationId <- InstallationId . read <$> getEnv "GITHUB_INSTALLATION_ID"
let creds = AppCredentials {appId, privateKey}
generateInstallationToken creds installationId
data Repo = Repo
{ name :: Text
, description :: Text
}
deriving stock (Eq, Show, Generic)
deriving anyclass FromJSON
getRepo :: AccessToken -> String -> IO Repo
getRepo token name = do
req <- parseRequest $ "https://api.github.com/repos/" <> name
resp <- httpJSON
$ addRequestHeader hAuthorization ("Bearer " <> encodeUtf8 token.token)
$ addRequestHeader hUserAgent "github-app-token/example"
$ req
pure $ getResponseBody resp
By default, a token is created with repositories access and permissions as
defined in the installation configuration. Either of these can be changed by
using generateInstallationTokenScoped
:
getScopedAppToken :: IO AccessToken
getScopedAppToken = do
appId <- AppId . read <$> getEnv "GITHUB_APP_ID"
privateKey <- PrivateKey . BS8.pack <$> getEnv "GITHUB_PRIVATE_KEY"
installationId <- InstallationId . read <$> getEnv "GITHUB_INSTALLATION_ID"
let
creds = AppCredentials {appId, privateKey}
create = mempty
{ repositories = ["github-app-token"]
, permissions = contents Read
}
generateInstallationTokenScoped create creds installationId
getOwnerAppToken :: IO AccessToken
getOwnerAppToken = do
appId <- AppId . read <$> getEnv "GITHUB_APP_ID"
privateKey <- PrivateKey . BS8.pack <$> getEnv "GITHUB_PRIVATE_KEY"
let creds = AppCredentials {appId, privateKey}
generateOwnerToken creds $ Org "freckle"
Installation tokens are good for one hour, after which point using them will
respond with 401 Unauthorized
. To avoid this, you can use the
GitHub.App.Token.Refresh
module to maintain a background thread that refreshes
the token as necessary:
getRepos :: [String] -> IO [Repo]
getRepos names = do
ref <- refreshing getAppToken
repos <- for names $ \name -> do
token <- getRefresh ref
getRepo token name
cancelRefresh ref
pure repos