diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..f7c2a3f --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,47 @@ +name: CI + +on: + pull_request: + push: + branches: main + +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + +jobs: + generate: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - id: generate + uses: freckle/stack-action/generate-matrix@v5 + outputs: + stack-yamls: ${{ steps.generate.outputs.stack-yamls }} + + test: + runs-on: ubuntu-latest + needs: generate + + strategy: + matrix: + stack-yaml: ${{ fromJSON(needs.generate.outputs.stack-yamls) }} + fail-fast: false + + steps: + - uses: actions/checkout@v4 + - uses: freckle/stack-action@v5 + env: + STACK_YAML: ${{ matrix.stack-yaml }} + GITHUB_APP_ID: ${{ vars.FRECKLE_AUTOMATION_APP_ID }} + GITHUB_PRIVATE_KEY: ${{ secrets.FRECKLE_AUTOMATION_PRIVATE_KEY }} + GITHUB_INSTALLATION_ID: ${{ vars.FRECKLE_AUTOMATION_INSTALLATION_ID }} + + lint: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - uses: haskell-actions/hlint-setup@v2 + - uses: haskell-actions/hlint-run@v2 + with: + fail-on: warning diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5f4d542 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +.env* +!.env.example +.stack-work diff --git a/.restyled.yaml b/.restyled.yaml new file mode 100644 index 0000000..9e208ea --- /dev/null +++ b/.restyled.yaml @@ -0,0 +1,4 @@ +restylers: + - "fourmolu" + - "!stylish-haskell" + - "*" diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..3ad2fbd --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,15 @@ +indentation: 2 +column-limit: 80 +function-arrows: leading +comma-style: leading # default +import-export-style: leading +indent-wheres: false # default +record-brace-space: true +newlines-between-decls: 1 # default +haddock-style: single-line +let-style: mixed +in-style: left-align +single-constraint-parens: never +unicode: never # default +respectful: true # default +fixities: [] # default diff --git a/github-app-token/.env.example b/github-app-token/.env.example new file mode 100644 index 0000000..a478b1a --- /dev/null +++ b/github-app-token/.env.example @@ -0,0 +1,9 @@ +# shellcheck disable=SC2034 +# vim: ft=sh +GITHUB_APP_ID= +GITHUB_PRIVATE_KEY=" +-----BEGIN RSA PRIVATE KEY----- +... +-----END RSA PRIVATE KEY----- +" +GITHUB_INSTALLATION_ID= diff --git a/github-app-token/CHANGELOG.md b/github-app-token/CHANGELOG.md new file mode 100644 index 0000000..4640904 --- /dev/null +++ b/github-app-token/CHANGELOG.md @@ -0,0 +1 @@ +# TODO diff --git a/github-app-token/README.lhs b/github-app-token/README.lhs new file mode 100644 index 0000000..4356b95 --- /dev/null +++ b/github-app-token/README.lhs @@ -0,0 +1,60 @@ +# GitHub App Token + +[Generate an installation access token for a GitHub App][docs] + +[docs]: https://docs.github.com/en/apps/creating-github-apps/authenticating-with-a-github-app/authenticating-as-a-github-app-installation + +## Usage + + + +```haskell +import Prelude + +import Control.Lens ((^?)) +import Data.Aeson.Lens +import Data.ByteString.Char8 qualified as BS8 +import Data.Text.Encoding (encodeUtf8) +import GitHub.App.Token +import Network.HTTP.Simple +import Network.HTTP.Types.Header (hAccept, hAuthorization, hUserAgent) +import System.Environment + +example :: IO () +example = 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} + token <- generateInstallationToken creds installationId + + req <- parseRequest "https://api.github.com/repos/freckle/github-app-token" + resp <- httpLBS + $ addRequestHeader hAccept "application/json" + $ addRequestHeader hAuthorization ("Bearer " <> encodeUtf8 token.token) + $ addRequestHeader hUserAgent "github-app-token/example" + $ req + + print $ getResponseBody resp ^? key "description" . _String + -- => Just "Generate an installation token for a GitHub App" +``` + + diff --git a/github-app-token/README.md b/github-app-token/README.md new file mode 120000 index 0000000..5e04f79 --- /dev/null +++ b/github-app-token/README.md @@ -0,0 +1 @@ +./README.lhs \ No newline at end of file diff --git a/github-app-token/github-app-token.cabal b/github-app-token/github-app-token.cabal new file mode 100644 index 0000000..3d941f7 --- /dev/null +++ b/github-app-token/github-app-token.cabal @@ -0,0 +1,99 @@ +cabal-version: 1.18 + +-- This file has been generated from package.yaml by hpack version 0.37.0. +-- +-- see: https://github.com/sol/hpack + +name: github-app-token +version: 0.0.0.0 +synopsis: Generate an installation access token for a GitHub App +description: Please see README.md +category: HTTP +homepage: https://github.com/freckle/github-app-token#readme +bug-reports: https://github.com/freckle/github-app-token/issues +maintainer: Freckle Education +build-type: Simple +extra-doc-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/freckle/github-app-token + +library + exposed-modules: + GitHub.App.Token + GitHub.App.Token.AppCredentials + GitHub.App.Token.Generate + GitHub.App.Token.JWT + GitHub.App.Token.Prelude + other-modules: + Paths_github_app_token + hs-source-dirs: + src + default-extensions: + DataKinds + DeriveAnyClass + DerivingVia + DerivingStrategies + DuplicateRecordFields + GADTs + LambdaCase + NoImplicitPrelude + NoMonomorphismRestriction + OverloadedRecordDot + OverloadedStrings + RecordWildCards + TypeFamilies + ghc-options: -fignore-optim-changes -fwrite-ide-info -Weverything -Wno-all-missed-specialisations -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missing-kind-signatures -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe + build-depends: + aeson + , base <5 + , bytestring + , http-conduit + , http-types + , jwt + , path + , text + , time + , unliftio + default-language: GHC2021 + if impl(ghc >= 9.8) + ghc-options: -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures + +test-suite readme + type: exitcode-stdio-1.0 + main-is: README.lhs + other-modules: + Paths_github_app_token + default-extensions: + DataKinds + DeriveAnyClass + DerivingVia + DerivingStrategies + DuplicateRecordFields + GADTs + LambdaCase + NoImplicitPrelude + NoMonomorphismRestriction + OverloadedRecordDot + OverloadedStrings + RecordWildCards + TypeFamilies + ghc-options: -fignore-optim-changes -fwrite-ide-info -Weverything -Wno-all-missed-specialisations -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missing-kind-signatures -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe -pgmL markdown-unlit + build-depends: + base <5 + , bytestring + , directory + , dotenv + , github-app-token + , http-conduit + , http-types + , lens + , lens-aeson + , markdown-unlit + , text + default-language: GHC2021 + if impl(ghc >= 9.8) + ghc-options: -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures diff --git a/github-app-token/package.yaml b/github-app-token/package.yaml new file mode 100644 index 0000000..6a3a44e --- /dev/null +++ b/github-app-token/package.yaml @@ -0,0 +1,87 @@ +name: github-app-token +version: 0.0.0.0 +maintainer: Freckle Education +category: HTTP +github: freckle/github-app-token +synopsis: Generate an installation access token for a GitHub App +description: Please see README.md + +extra-doc-files: + - README.md + - CHANGELOG.md + +language: GHC2021 + +ghc-options: + - -fignore-optim-changes + - -fwrite-ide-info + - -Weverything + - -Wno-all-missed-specialisations + - -Wno-missing-exported-signatures # re-enables missing-signatures + - -Wno-missing-import-lists + - -Wno-missing-kind-signatures + - -Wno-missing-local-signatures + - -Wno-missing-safe-haskell-mode + - -Wno-monomorphism-restriction + - -Wno-prepositive-qualified-module + - -Wno-safe + - -Wno-unsafe + +when: + - condition: "impl(ghc >= 9.8)" + ghc-options: + - -Wno-missing-role-annotations + - -Wno-missing-poly-kind-signatures + +dependencies: + - base < 5 + +default-extensions: + - DataKinds + - DeriveAnyClass + - DerivingVia + - DerivingStrategies + - DuplicateRecordFields + - GADTs + - LambdaCase + - NoImplicitPrelude + - NoMonomorphismRestriction + - OverloadedRecordDot + - OverloadedStrings + - RecordWildCards + - TypeFamilies + +library: + source-dirs: src + dependencies: + - aeson + - bytestring + - http-conduit + - jwt + - text + - time + - http-types + - path + - unliftio + +tests: + # spec: + # main: Main.hs + # source-dirs: tests + # ghc-options: -threaded -rtsopts "-with-rtsopts=-N" + # dependencies: + # - github-app-token + readme: + main: README.lhs + ghc-options: -pgmL markdown-unlit + dependencies: + - bytestring + - directory + - dotenv + - github-app-token + - http-conduit + - http-types + - lens + - lens-aeson + - markdown-unlit + - text diff --git a/github-app-token/src/GitHub/App/Token.hs b/github-app-token/src/GitHub/App/Token.hs new file mode 100644 index 0000000..889e257 --- /dev/null +++ b/github-app-token/src/GitHub/App/Token.hs @@ -0,0 +1,11 @@ +module GitHub.App.Token + ( generateInstallationToken + , AppCredentials (..) + , AppId (..) + , PrivateKey (..) + , InstallationId (..) + , AccessToken (..) + ) where + +import GitHub.App.Token.AppCredentials +import GitHub.App.Token.Generate diff --git a/github-app-token/src/GitHub/App/Token/AppCredentials.hs b/github-app-token/src/GitHub/App/Token/AppCredentials.hs new file mode 100644 index 0000000..10a3244 --- /dev/null +++ b/github-app-token/src/GitHub/App/Token/AppCredentials.hs @@ -0,0 +1,17 @@ +module GitHub.App.Token.AppCredentials + ( AppCredentials (..) + , AppId (..) + , PrivateKey (..) + ) where + +import GitHub.App.Token.JWT (PrivateKey (..)) +import GitHub.App.Token.Prelude + +data AppCredentials = AppCredentials + { appId :: AppId + , privateKey :: PrivateKey + } + +newtype AppId = AppId + { unwrap :: Int + } diff --git a/github-app-token/src/GitHub/App/Token/Generate.hs b/github-app-token/src/GitHub/App/Token/Generate.hs new file mode 100644 index 0000000..143dcbe --- /dev/null +++ b/github-app-token/src/GitHub/App/Token/Generate.hs @@ -0,0 +1,91 @@ +module GitHub.App.Token.Generate + ( InstallationId (..) + , AccessToken (..) + , generateInstallationToken + + -- * Errors + , InvalidPrivateKey (..) + , InvalidDate (..) + , InvalidIssuer (..) + , AccessTokenHttpError (..) + , AccessTokenJsonDecodeError (..) + ) where + +import GitHub.App.Token.Prelude + +import Data.Aeson (FromJSON, eitherDecode) +import Data.ByteString.Lazy qualified as BSL +import GitHub.App.Token.AppCredentials +import GitHub.App.Token.JWT +import Network.HTTP.Simple + ( addRequestHeader + , getResponseBody + , getResponseStatus + , httpLBS + , parseRequest + ) +import Network.HTTP.Types.Header (hAccept, hAuthorization, hUserAgent) +import Network.HTTP.Types.Status (Status, statusIsSuccessful) + +newtype InstallationId = InstallationId + { unwrap :: Int + } + +data AccessToken = AccessToken + { token :: Text + , expires_at :: UTCTime + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON) + +data AccessTokenHttpError = AccessTokenHttpError + { status :: Status + , body :: BSL.ByteString + } + deriving stock (Show) + deriving anyclass (Exception) + +data AccessTokenJsonDecodeError = AccessTokenJsonDecodeError + { body :: BSL.ByteString + , message :: String + } + deriving stock (Show) + deriving anyclass (Exception) + +generateInstallationToken + :: MonadIO m + => AppCredentials + -> InstallationId + -> m AccessToken +generateInstallationToken creds installationId = do + jwt <- signJWT expiration issuer creds.privateKey + + req <- + liftIO + $ parseRequest + $ "POST https://api.github.com/app/installations/" + <> show installationId.unwrap + <> "/access_tokens" + + -- parse the response body ourselves, to improve error messages + resp <- + httpLBS + $ addRequestHeader hAccept "application/vnd.github+json" + $ addRequestHeader hAuthorization ("Bearer " <> jwt) + $ addRequestHeader hUserAgent "github-app-token" + $ addRequestHeader "X-GitHub-Api-Version" "2022-11-28" req + + let + status = getResponseStatus resp + body = getResponseBody resp + + unless (statusIsSuccessful status) + $ throwIO + $ AccessTokenHttpError {status, body} + + either (throwIO . AccessTokenJsonDecodeError body) pure $ eitherDecode body + where + -- We're going to use it right away and only once, so 5m should be more than + -- enough + expiration = ExpirationTime $ 5 * 60 + issuer = Issuer $ pack $ show creds.appId.unwrap diff --git a/github-app-token/src/GitHub/App/Token/JWT.hs b/github-app-token/src/GitHub/App/Token/JWT.hs new file mode 100644 index 0000000..5b97ef0 --- /dev/null +++ b/github-app-token/src/GitHub/App/Token/JWT.hs @@ -0,0 +1,91 @@ +module GitHub.App.Token.JWT + ( signJWT + , ExpirationTime (..) + , Issuer (..) + + -- * Private RSA Key data + , PrivateKey (..) + + -- * Errors + , InvalidPrivateKey (..) + , InvalidDate (..) + , InvalidIssuer (..) + ) where + +import GitHub.App.Token.Prelude + +import Data.Text.Encoding (encodeUtf8) +import Data.Time (NominalDiffTime, addUTCTime, getCurrentTime) +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) +import Web.JWT qualified as JWT + +newtype ExpirationTime = ExpirationTime + { unwrap :: NominalDiffTime + } + +newtype Issuer = Issuer + { unwrap :: Text + } + deriving stock (Show) + +newtype PrivateKey = PrivateKey + { unwrap :: ByteString + } + deriving stock (Show) + +newtype InvalidPrivateKey = InvalidPrivateKey PrivateKey + deriving stock (Show) + deriving anyclass (Exception) + +data InvalidDate = InvalidDate + { field :: String + , date :: UTCTime + } + deriving stock (Show) + deriving anyclass (Exception) + +newtype InvalidIssuer = InvalidIssuer Issuer + deriving stock (Show) + deriving anyclass (Exception) + +signJWT + :: MonadIO m + => ExpirationTime + -> Issuer + -> PrivateKey + -> m ByteString +signJWT expirationTime issuer privateKey = liftIO $ do + now <- getCurrentTime + let expiration = addUTCTime expirationTime.unwrap now + + signer <- + maybe + (throwIO $ InvalidPrivateKey privateKey) + (pure . JWT.EncodeRSAPrivateKey) + $ JWT.readRsaSecret privateKey.unwrap + + iat <- + maybe (throwIO $ InvalidDate "iat" now) pure + $ numericDate now + + exp <- + maybe (throwIO $ InvalidDate "exp" expiration) pure + $ numericDate expiration + + iss <- + maybe (throwIO $ InvalidIssuer issuer) pure + $ JWT.stringOrURI issuer.unwrap + + pure + $ encodeUtf8 + $ JWT.encodeSigned + signer + mempty {JWT.alg = Just JWT.RS256} + mempty + { JWT.iat = Just iat + , JWT.exp = Just exp + , JWT.iss = Just iss + } + +numericDate :: UTCTime -> Maybe JWT.NumericDate +numericDate = JWT.numericDate . utcTimeToPOSIXSeconds diff --git a/github-app-token/src/GitHub/App/Token/Prelude.hs b/github-app-token/src/GitHub/App/Token/Prelude.hs new file mode 100644 index 0000000..9caef3c --- /dev/null +++ b/github-app-token/src/GitHub/App/Token/Prelude.hs @@ -0,0 +1,14 @@ +module GitHub.App.Token.Prelude + ( module X + ) where + +import Prelude as X hiding (exp) + +import Control.Monad as X (unless, when) +import Control.Monad.IO.Class as X (MonadIO (..)) +import Data.ByteString as X (ByteString) +import Data.Text as X (Text, pack, unpack) +import Data.Time as X (UTCTime) +import GHC.Generics as X (Generic) +import Path as X (Abs, Dir, File, Path, Rel, toFilePath) +import UnliftIO.Exception as X (Exception, throwIO) diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..4c7ab5b --- /dev/null +++ b/stack.yaml @@ -0,0 +1,4 @@ +resolver: lts-22.34 +packages: + - github-app-token + # - github-app-token-cli diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..401a580 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: edbd50d7e7c85c13ad5f5835ae2db92fab1e9cf05ecf85340e2622ec0a303df1 + size: 720020 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/34.yaml + original: lts-22.34