github-app-token 0.0.2.0 → 0.0.3.0

raw patch · 6 files changed

+190/−55 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−1
• README.lhs +33/−14
• README.md +33/−14
• github-app-token.cabal +13/−13
• src/GitHub/App/Token.hs +5/−0
• src/GitHub/App/Token/Generate.hs +101/−13

@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/github-app-token/compare/v0.0.2.0...main)+## [_Unreleased_](https://github.com/freckle/github-app-token/compare/v0.0.3.0...main)++## [v0.0.3.0](https://github.com/freckle/github-app-token/compare/v0.0.2.0...v0.0.3.0)++- Add `generateOwnerToken{,Scoped}`  ## [v0.0.2.0](https://github.com/freckle/github-app-token/compare/v0.0.1.2...v0.0.2.0) 

@@ -9,7 +9,7 @@  [docs]: https://docs.github.com/en/apps/creating-github-apps/authenticating-with-a-github-app/authenticating-as-a-github-app-installation -## Usage+## Getting an AccessToken  <!-- ```haskell@@ -46,7 +46,11 @@    let creds = AppCredentials {appId, privateKey}   generateInstallationToken creds installationId+``` +## Using an AccessToken++```haskell data Repo = Repo   { name :: Text   , description :: Text@@ -54,9 +58,8 @@   deriving stock (Eq, Show, Generic)   deriving anyclass FromJSON -getRepo :: String -> IO Repo-getRepo name = do-  token <- getAppToken+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)@@ -66,7 +69,7 @@   pure $ getResponseBody resp ``` -## Scoping+## Getting a Scoped AccessToken  By default, a token is created with repositories access and permissions as defined in the installation configuration. Either of these can be changed by@@ -89,8 +92,20 @@   generateInstallationTokenScoped create creds installationId ``` -## Refreshing+## Getting an AccessToken for an Owner +```haskell+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"+```++## Getting a Self-Refreshing AccessToken+ 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@@ -103,13 +118,7 @@    repos <- for names $ \name -> do     token <- getRefresh ref-    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+    getRepo token name    cancelRefresh ref   pure repos@@ -125,7 +134,17 @@   Hspec.hspec $ do     Hspec.describe "Basic usage" $ do       Hspec.it "works" $ do-        getRepo "freckle/github-app-token"+        token <- getAppToken+        getRepo token "freckle/github-app-token"+          `Hspec.shouldReturn` Repo+            { name = "github-app-token"+            , description = "Generate an installation token for a GitHub App"+            }++    Hspec.describe "By owner" $ do+      Hspec.it "works" $ do+        token <- getOwnerAppToken+        getRepo token "freckle/github-app-token"           `Hspec.shouldReturn` Repo             { name = "github-app-token"             , description = "Generate an installation token for a GitHub App"

@@ -9,7 +9,7 @@  [docs]: https://docs.github.com/en/apps/creating-github-apps/authenticating-with-a-github-app/authenticating-as-a-github-app-installation -## Usage+## Getting an AccessToken  <!-- ```haskell@@ -46,7 +46,11 @@    let creds = AppCredentials {appId, privateKey}   generateInstallationToken creds installationId+``` +## Using an AccessToken++```haskell data Repo = Repo   { name :: Text   , description :: Text@@ -54,9 +58,8 @@   deriving stock (Eq, Show, Generic)   deriving anyclass FromJSON -getRepo :: String -> IO Repo-getRepo name = do-  token <- getAppToken+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)@@ -66,7 +69,7 @@   pure $ getResponseBody resp ``` -## Scoping+## Getting a Scoped AccessToken  By default, a token is created with repositories access and permissions as defined in the installation configuration. Either of these can be changed by@@ -89,8 +92,20 @@   generateInstallationTokenScoped create creds installationId ``` -## Refreshing+## Getting an AccessToken for an Owner +```haskell+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"+```++## Getting a Self-Refreshing AccessToken+ 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@@ -103,13 +118,7 @@    repos <- for names $ \name -> do     token <- getRefresh ref-    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+    getRepo token name    cancelRefresh ref   pure repos@@ -125,7 +134,17 @@   Hspec.hspec $ do     Hspec.describe "Basic usage" $ do       Hspec.it "works" $ do-        getRepo "freckle/github-app-token"+        token <- getAppToken+        getRepo token "freckle/github-app-token"+          `Hspec.shouldReturn` Repo+            { name = "github-app-token"+            , description = "Generate an installation token for a GitHub App"+            }++    Hspec.describe "By owner" $ do+      Hspec.it "works" $ do+        token <- getOwnerAppToken+        getRepo token "freckle/github-app-token"           `Hspec.shouldReturn` Repo             { name = "github-app-token"             , description = "Generate an installation token for a GitHub App"

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            github-app-token-version:         0.0.2.0+version:         0.0.3.0 license:         MIT license-file:    LICENSE maintainer:      Freckle Education@@ -32,10 +32,10 @@     other-modules:      Paths_github_app_token     default-language:   GHC2021     default-extensions:-        DataKinds DeriveAnyClass DerivingVia DerivingStrategies-        DuplicateRecordFields GADTs LambdaCase NoImplicitPrelude-        NoMonomorphismRestriction OverloadedRecordDot OverloadedStrings-        RecordWildCards TypeFamilies+        DataKinds DeriveAnyClass DerivingStrategies DerivingVia+        DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+        NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+        OverloadedStrings RecordWildCards TypeFamilies      ghc-options:         -fignore-optim-changes -fwrite-ide-info -Weverything@@ -69,10 +69,10 @@     other-modules:      Paths_github_app_token     default-language:   GHC2021     default-extensions:-        DataKinds DeriveAnyClass DerivingVia DerivingStrategies-        DuplicateRecordFields GADTs LambdaCase NoImplicitPrelude-        NoMonomorphismRestriction OverloadedRecordDot OverloadedStrings-        RecordWildCards TypeFamilies+        DataKinds DeriveAnyClass DerivingStrategies DerivingVia+        DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+        NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+        OverloadedStrings RecordWildCards TypeFamilies      ghc-options:         -fignore-optim-changes -fwrite-ide-info -Weverything@@ -110,10 +110,10 @@      default-language:   GHC2021     default-extensions:-        DataKinds DeriveAnyClass DerivingVia DerivingStrategies-        DuplicateRecordFields GADTs LambdaCase NoImplicitPrelude-        NoMonomorphismRestriction OverloadedRecordDot OverloadedStrings-        RecordWildCards TypeFamilies+        DataKinds DeriveAnyClass DerivingStrategies DerivingVia+        DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+        NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+        OverloadedStrings RecordWildCards TypeFamilies      ghc-options:         -fignore-optim-changes -fwrite-ide-info -Weverything

@@ -10,6 +10,11 @@   , CreateAccessToken (..)   , module GitHub.App.Token.Permissions   , generateInstallationTokenScoped++    -- * By Owner+  , Owner (..)+  , generateOwnerToken+  , generateOwnerTokenScoped   ) where  import GitHub.App.Token.AppCredentials

@@ -3,10 +3,15 @@   , AccessToken (..)   , generateInstallationToken +    -- * Finding installations by owner+  , Owner (..)+  , generateOwnerToken+     -- * Scoping 'AccessToken's   , CreateAccessToken (..)   , module GitHub.App.Token.Permissions   , generateInstallationTokenScoped+  , generateOwnerTokenScoped      -- * Errors   , InvalidPrivateKey (..)@@ -14,6 +19,8 @@   , InvalidIssuer (..)   , AccessTokenHttpError (..)   , AccessTokenJsonDecodeError (..)+  , GetInstallationHttpError (..)+  , GetInstallationJsonDecodeError (..)   ) where  import GitHub.App.Token.Prelude@@ -25,19 +32,24 @@ import GitHub.App.Token.JWT import GitHub.App.Token.Permissions import Network.HTTP.Simple-  ( addRequestHeader+  ( Request+  , addRequestHeader   , getResponseBody   , getResponseStatus   , httpLBS   , parseRequest   , setRequestBodyJSON+  , setRequestMethod   ) import Network.HTTP.Types.Header (hAccept, hAuthorization, hUserAgent) import Network.HTTP.Types.Status (Status, statusIsSuccessful) +{-# ANN module ("HLint: ignore Redundant id" :: String) #-}+ newtype InstallationId = InstallationId   { unwrap :: Int   }+  deriving newtype (FromJSON)  data AccessToken = AccessToken   { token :: Text@@ -70,6 +82,15 @@   -> m AccessToken generateInstallationToken = generateInstallationTokenScoped mempty +data Owner = Org Text | User Text++generateOwnerToken+  :: MonadIO m+  => AppCredentials+  -> Owner+  -> m AccessToken+generateOwnerToken = generateOwnerTokenScoped mempty+ -- | <https://docs.github.com/en/rest/apps/apps?apiVersion=2022-11-28#create-an-installation-access-token-for-an-app> data CreateAccessToken = CreateAccessToken   { repositories :: [Text]@@ -88,36 +109,103 @@   -> InstallationId   -> m AccessToken generateInstallationTokenScoped create creds installationId = do-  jwt <- signJWT expiration issuer creds.privateKey-   req <--    liftIO-      $ parseRequest-      $ "POST https://api.github.com/app/installations/"+    githubRequest+      $ "/app/installations/"       <> show installationId.unwrap       <> "/access_tokens"    -- Avoid encoding to "{}", which causes a 500   let setBody = if create == mempty then id else setRequestBodyJSON create +  appHttpJSON AccessTokenHttpError AccessTokenJsonDecodeError creds+    $ setRequestMethod "POST"+    $ setBody req++generateOwnerTokenScoped+  :: MonadIO m+  => CreateAccessToken+  -> AppCredentials+  -> Owner+  -> m AccessToken+generateOwnerTokenScoped create creds owner = do+  -- If a repositories scope is given, use the first one (along with owner) to+  -- get the installation. Otherwise use the org or user endpoint. This matches+  -- how actions/create-github-app-token works:+  --+  -- https://github.com/actions/create-github-app-token/blob/5d869da34e18e7287c1daad50e0b8ea0f506ce69/lib/main.js#L113-L166+  --+  installation <- getInstallation creds $ case (create.repositories, owner) of+    (repo : _, Org org) -> "/repos/" <> org <> "/" <> repo+    (repo : _, User username) -> "/repos/" <> username <> "/" <> repo+    ([], Org org) -> "/orgs/" <> org+    ([], User username) -> "/users/" <> username++  generateInstallationTokenScoped create creds installation.id++newtype Installation = Installation+  { id :: InstallationId+  }+  deriving stock (Generic)+  deriving anyclass (FromJSON)++data GetInstallationHttpError = GetInstallationHttpError+  { status :: Status+  , body :: BSL.ByteString+  }+  deriving stock (Show)+  deriving anyclass (Exception)++data GetInstallationJsonDecodeError = GetInstallationJsonDecodeError+  { body :: BSL.ByteString+  , message :: String+  }+  deriving stock (Show)+  deriving anyclass (Exception)++getInstallation :: MonadIO m => AppCredentials -> Text -> m Installation+getInstallation creds prefix = do+  req <- githubRequest $ unpack $ prefix <> "/installation"+  appHttpJSON GetInstallationHttpError GetInstallationJsonDecodeError creds req++githubRequest :: MonadIO m => String -> m Request+githubRequest =+  liftIO+    . parseRequest+    . ("https://api.github.com" <>)+    . ensureLeadingSlash++ensureLeadingSlash :: String -> String+ensureLeadingSlash = \case+  x@('/' : _) -> x+  x -> '/' : x++appHttpJSON+  :: (MonadIO m, FromJSON a, Exception e1, Exception e2)+  => (Status -> BSL.ByteString -> e1)+  -- ^ Error for non-200+  -> (BSL.ByteString -> String -> e2)+  -- ^ Error for unexpected JSON+  -> AppCredentials+  -> Request+  -> m a+appHttpJSON onErrStatus onErrDecode creds req = do+  jwt <- signJWT expiration issuer creds.privateKey+   -- 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"-      $ setBody req+      $ 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+  unless (statusIsSuccessful status) $ throwIO $ onErrStatus status body+  either (throwIO . onErrDecode body) pure $ eitherDecode body  where   -- We're going to use it right away and only once, so 5m should be more than   -- enough