github-app-token 0.0.1.2 → 0.0.2.0

raw patch · 8 files changed

+571/−31 lines, 8 filesdep +monoidal-containersdep +semigroupsdep −lensdep −lens-aesonPVP ok

version bump matches the API change (PVP)

Dependencies added: monoidal-containers, semigroups

Dependencies removed: lens, lens-aeson

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−1
• README.lhs +97/−12
• README.md +97/−12
• github-app-token.cabal +8/−3
• src/GitHub/App/Token.hs +6/−0
• src/GitHub/App/Token/Generate.hs +37/−3
• src/GitHub/App/Token/Permissions.hs +301/−0
• tests/GitHub/App/Token/PermissionsSpec.hs +20/−0

@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/github-app-token/compare/v0.0.1.2...main)+## [_Unreleased_](https://github.com/freckle/github-app-token/compare/v0.0.2.0...main)++## [v0.0.2.0](https://github.com/freckle/github-app-token/compare/v0.0.1.2...v0.0.2.0)++- Add `generateInstallationTokenScoped` and related types  ## [v0.0.1.2](https://github.com/freckle/github-app-token/compare/v0.0.1.1...v0.0.1.2) 

@@ -17,7 +17,10 @@  import Configuration.Dotenv qualified as Dotenv import Control.Monad (when)+import Data.Traversable (for)+import GitHub.App.Token.Refresh import System.Directory (doesFileExist)+import Test.Hspec qualified as Hspec import Text.Markdown.Unlit () ``` -->@@ -25,42 +28,124 @@ ```haskell import Prelude -import Control.Lens ((^?))-import Data.Aeson.Lens+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 (hAccept, hAuthorization, hUserAgent)+import Network.HTTP.Types.Header (hAuthorization, hUserAgent) import System.Environment -example :: IO ()-example = do+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}-  token <- generateInstallationToken creds installationId+  generateInstallationToken creds installationId -  req <- parseRequest "https://api.github.com/repos/freckle/github-app-token"-  resp <- httpLBS-    $ addRequestHeader hAccept "application/json"+data Repo = Repo+  { name :: Text+  , description :: Text+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass FromJSON++getRepo :: String -> IO Repo+getRepo name = do+  token <- getAppToken+  req <- parseRequest $ "https://api.github.com/repos/" <> name+  resp <- httpJSON     $ 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"+  pure $ getResponseBody resp ``` +## Scoping++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`:++```haskell+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 = ["freckle/github-app-token"]+      , permissions = contents Read+      }++  generateInstallationTokenScoped create creds installationId+```++## Refreshing++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:++```haskell+getRepos :: [String] -> IO [Repo]+getRepos names = do+  ref <- refreshing getAppToken++  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++  cancelRefresh ref+  pure repos+```+ <!-- ```haskell main :: IO () main = do   isLocal <- doesFileExist ".env"   when isLocal $ Dotenv.loadFile Dotenv.defaultConfig-  example++  Hspec.hspec $ do+    Hspec.describe "Basic usage" $ do+      Hspec.it "works" $ do+        getRepo "freckle/github-app-token"+          `Hspec.shouldReturn` Repo+            { name = "github-app-token"+            , description = "Generate an installation token for a GitHub App"+            }++    Hspec.describe "Self-refreshing tokens" $ do+      Hspec.it "works" $ do+        let+          names :: [String]+          names =+            [ "freckle/github-app-token"+            , "freckle/stack-action"+            , "freckle/stackctl"+            ]++        getRepos names `Hspec.shouldReturn`+          [ Repo {name="github-app-token", description = "Generate an installation token for a GitHub App"}+          , Repo {name="stack-action", description = "GitHub Action to build, test, and lint Stack-based Haskell projects"}+          , Repo {name="stackctl", description = "Manage CloudFormation Stacks through specifications"}+          ] ``` --> 

@@ -17,7 +17,10 @@  import Configuration.Dotenv qualified as Dotenv import Control.Monad (when)+import Data.Traversable (for)+import GitHub.App.Token.Refresh import System.Directory (doesFileExist)+import Test.Hspec qualified as Hspec import Text.Markdown.Unlit () ``` -->@@ -25,42 +28,124 @@ ```haskell import Prelude -import Control.Lens ((^?))-import Data.Aeson.Lens+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 (hAccept, hAuthorization, hUserAgent)+import Network.HTTP.Types.Header (hAuthorization, hUserAgent) import System.Environment -example :: IO ()-example = do+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}-  token <- generateInstallationToken creds installationId+  generateInstallationToken creds installationId -  req <- parseRequest "https://api.github.com/repos/freckle/github-app-token"-  resp <- httpLBS-    $ addRequestHeader hAccept "application/json"+data Repo = Repo+  { name :: Text+  , description :: Text+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass FromJSON++getRepo :: String -> IO Repo+getRepo name = do+  token <- getAppToken+  req <- parseRequest $ "https://api.github.com/repos/" <> name+  resp <- httpJSON     $ 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"+  pure $ getResponseBody resp ``` +## Scoping++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`:++```haskell+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 = ["freckle/github-app-token"]+      , permissions = contents Read+      }++  generateInstallationTokenScoped create creds installationId+```++## Refreshing++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:++```haskell+getRepos :: [String] -> IO [Repo]+getRepos names = do+  ref <- refreshing getAppToken++  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++  cancelRefresh ref+  pure repos+```+ <!-- ```haskell main :: IO () main = do   isLocal <- doesFileExist ".env"   when isLocal $ Dotenv.loadFile Dotenv.defaultConfig-  example++  Hspec.hspec $ do+    Hspec.describe "Basic usage" $ do+      Hspec.it "works" $ do+        getRepo "freckle/github-app-token"+          `Hspec.shouldReturn` Repo+            { name = "github-app-token"+            , description = "Generate an installation token for a GitHub App"+            }++    Hspec.describe "Self-refreshing tokens" $ do+      Hspec.it "works" $ do+        let+          names :: [String]+          names =+            [ "freckle/github-app-token"+            , "freckle/stack-action"+            , "freckle/stackctl"+            ]++        getRepos names `Hspec.shouldReturn`+          [ Repo {name="github-app-token", description = "Generate an installation token for a GitHub App"}+          , Repo {name="stack-action", description = "GitHub Action to build, test, and lint Stack-based Haskell projects"}+          , Repo {name="stackctl", description = "Manage CloudFormation Stacks through specifications"}+          ] ``` --> 

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            github-app-token-version:         0.0.1.2+version:         0.0.2.0 license:         MIT license-file:    LICENSE maintainer:      Freckle Education@@ -24,6 +24,7 @@         GitHub.App.Token.AppCredentials         GitHub.App.Token.Generate         GitHub.App.Token.JWT+        GitHub.App.Token.Permissions         GitHub.App.Token.Prelude         GitHub.App.Token.Refresh @@ -51,7 +52,9 @@         http-conduit >=2.3.8.1,         http-types >=0.12.3,         jwt >=0.11.0,+        monoidal-containers >=0.6.4.0,         path >=0.9.2,+        semigroups >=0.20,         text >=1.2.5.0,         time >=1.11.1.1,         unliftio >=0.2.25.0@@ -80,15 +83,15 @@         -Wno-safe -Wno-unsafe -pgmL markdown-unlit      build-depends:+        aeson >=2.0.3.0,         base >=4.16.4.0 && <5,         bytestring >=0.11.4.0,         directory >=1.3.6.2,         dotenv >=0.10.0.0,         github-app-token,+        hspec >=2.9.7,         http-conduit >=2.3.8.1,         http-types >=0.12.3,-        lens >=5.1.1,-        lens-aeson >=1.2.2,         markdown-unlit >=0.5.1,         text >=1.2.5.0 @@ -101,6 +104,7 @@     main-is:            Main.hs     hs-source-dirs:     tests     other-modules:+        GitHub.App.Token.PermissionsSpec         GitHub.App.Token.RefreshSpec         Paths_github_app_token @@ -120,6 +124,7 @@         -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N      build-depends:+        aeson >=2.0.3.0,         base >=4.16.4.0 && <5,         github-app-token,         hspec >=2.9.7,

@@ -5,7 +5,13 @@   , PrivateKey (..)   , InstallationId (..)   , AccessToken (..)++    -- * Scoped+  , CreateAccessToken (..)+  , module GitHub.App.Token.Permissions+  , generateInstallationTokenScoped   ) where  import GitHub.App.Token.AppCredentials import GitHub.App.Token.Generate+import GitHub.App.Token.Permissions

@@ -3,6 +3,11 @@   , AccessToken (..)   , generateInstallationToken +    -- * Scoping 'AccessToken's+  , CreateAccessToken (..)+  , module GitHub.App.Token.Permissions+  , generateInstallationTokenScoped+     -- * Errors   , InvalidPrivateKey (..)   , InvalidDate (..)@@ -13,16 +18,19 @@  import GitHub.App.Token.Prelude -import Data.Aeson (FromJSON, eitherDecode)+import Data.Aeson (FromJSON, ToJSON, eitherDecode) import Data.ByteString.Lazy qualified as BSL+import Data.Semigroup.Generic import GitHub.App.Token.AppCredentials import GitHub.App.Token.JWT+import GitHub.App.Token.Permissions import Network.HTTP.Simple   ( addRequestHeader   , getResponseBody   , getResponseStatus   , httpLBS   , parseRequest+  , setRequestBodyJSON   ) import Network.HTTP.Types.Header (hAccept, hAuthorization, hUserAgent) import Network.HTTP.Types.Status (Status, statusIsSuccessful)@@ -52,12 +60,34 @@   deriving stock (Show)   deriving anyclass (Exception) +-- | Generate a token for all repositories and the installation's permissions+--+-- See 'generateInstallationTokenScoped' for changing either of these. generateInstallationToken   :: MonadIO m   => AppCredentials   -> InstallationId   -> m AccessToken-generateInstallationToken creds installationId = do+generateInstallationToken = generateInstallationTokenScoped 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]+  -- ^ List of @{owner}/{name}@ values+  , repository_ids :: [Int]+  , permissions :: Permissions+  }+  deriving stock (Eq, Generic)+  deriving anyclass (ToJSON)+  deriving (Semigroup, Monoid) via GenericSemigroupMonoid CreateAccessToken++generateInstallationTokenScoped+  :: MonadIO m+  => CreateAccessToken+  -> AppCredentials+  -> InstallationId+  -> m AccessToken+generateInstallationTokenScoped create creds installationId = do   jwt <- signJWT expiration issuer creds.privateKey    req <-@@ -67,13 +97,17 @@       <> show installationId.unwrap       <> "/access_tokens" +  -- Avoid encoding to "{}", which causes a 500+  let setBody = if create == mempty then id else setRequestBodyJSON create+   -- 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+      $ addRequestHeader "X-GitHub-Api-Version" "2022-11-28"+      $ setBody req    let     status = getResponseStatus resp

@@ -0,0 +1,301 @@+-- | Type-safe implementation for requesting 'AccessToken' permissions+--+-- <https://docs.github.com/en/rest/apps/apps?apiVersion=2022-11-28#create-an-installation-access-token-for-an-app>+--+-- Usage:+--+-- 1. Use a constructor function for a specific permission, each of which only+--    accepts appropriate values (e.g. you can't ask for @admin@ on a permission+--    that only allows @read@ or @write@).+-- 2. Combine these using 'Permissions' 'Semigroup' instance.+--+-- For example:+--+-- @+-- let permissions = 'actions' 'Read' <> 'checks' 'Write'+--+-- 'generateInstallationTokenScoped' mempty {permissions} creds installationId+-- @+--+-- Supplying the same permission more than once will take the higher:+--+-- @+-- 'checks' 'Read' <> 'checks' 'Write' == 'checks' 'Write'+-- @+module GitHub.App.Token.Permissions+  ( Permissions+  , Read (..)+  , Write (..)+  , Admin (..)+  , actions+  , administration+  , checks+  , codespaces+  , contents+  , dependabot_secrets+  , deployments+  , environments+  , issues+  , metadata+  , packages+  , pages+  , pull_requests+  , repository_custom_properties+  , repository_hooks+  , repository_projects+  , secret_scanning_alerts+  , secrets+  , security_events+  , single_file+  , statuses+  , vulnerability_alerts+  , workflows+  , members+  , organization_administration+  , organization_custom_roles+  , organization_custom_org_roles+  , organization_custom_properties+  , organization_copilot_seat_management+  , organization_announcement_banners+  , organization_events+  , organization_hooks+  , organization_personal_access_tokens+  , organization_personal_access_token_requests+  , organization_plan+  , organization_projects+  , organization_packages+  , organization_secrets+  , organization_self_hosted_runners+  , organization_user_blocking+  , team_discussions+  , email_addresses+  , followers+  , git_ssh_keys+  , gpg_keys+  , interaction_limits+  , profile+  , starring+  ) where++import GitHub.App.Token.Prelude hiding (Read)++import Data.Aeson (ToJSON (..))+import Data.Map.Monoidal.Strict (MonoidalMap)+import Data.Map.Monoidal.Strict qualified as MonoidalMap+import Data.Semigroup (Max (..))++{-# ANN module ("HLint: ignore Use camelCase" :: String) #-}++newtype Permissions = Permissions+  { _unwrap :: MonoidalMap Text Permission+  }+  deriving stock (Eq, Show)+  deriving newtype (Semigroup, Monoid, ToJSON)++data Permission+  = PermissionRead+  | PermissionWrite+  | PermissionAdmin+  deriving stock (Eq, Ord, Show)+  deriving (Semigroup) via (Max Permission)++instance ToJSON Permission where+  toJSON =+    toJSON @Text . \case+      PermissionRead -> "read"+      PermissionWrite -> "write"+      PermissionAdmin -> "admin"++class AsReadWrite a where+  toReadWritePermission :: a -> Permission++class AsReadWriteAdmin a where+  toReadWriteAdminPermission :: a -> Permission++data Read = Read++instance AsReadWrite Read where+  toReadWritePermission _ = PermissionRead++instance AsReadWriteAdmin Read where+  toReadWriteAdminPermission _ = PermissionRead++data Write = Write++instance AsReadWrite Write where+  toReadWritePermission _ = PermissionWrite++instance AsReadWriteAdmin Write where+  toReadWriteAdminPermission _ = PermissionWrite++data Admin = Admin++instance AsReadWriteAdmin Admin where+  toReadWriteAdminPermission _ = PermissionAdmin++actions :: AsReadWrite a => a -> Permissions+actions = mkReadWrite "actions"++administration :: AsReadWrite a => a -> Permissions+administration = mkReadWrite "administration"++checks :: AsReadWrite a => a -> Permissions+checks = mkReadWrite "checks"++codespaces :: AsReadWrite a => a -> Permissions+codespaces = mkReadWrite "codespaces"++contents :: AsReadWrite a => a -> Permissions+contents = mkReadWrite "contents"++dependabot_secrets :: AsReadWrite a => a -> Permissions+dependabot_secrets = mkReadWrite "dependabot_secrets"++deployments :: AsReadWrite a => a -> Permissions+deployments = mkReadWrite "deployments"++environments :: AsReadWrite a => a -> Permissions+environments = mkReadWrite "environments"++issues :: AsReadWrite a => a -> Permissions+issues = mkReadWrite "issues"++metadata :: AsReadWrite a => a -> Permissions+metadata = mkReadWrite "metadata"++packages :: AsReadWrite a => a -> Permissions+packages = mkReadWrite "packages"++pages :: AsReadWrite a => a -> Permissions+pages = mkReadWrite "pages"++pull_requests :: AsReadWrite a => a -> Permissions+pull_requests = mkReadWrite "pull_requests"++repository_custom_properties :: AsReadWrite a => a -> Permissions+repository_custom_properties = mkReadWrite "repository_custom_properties"++repository_hooks :: AsReadWrite a => a -> Permissions+repository_hooks = mkReadWrite "repository_hooks"++repository_projects :: AsReadWriteAdmin a => a -> Permissions+repository_projects = mkReadWriteAdmin "repository_projects"++secret_scanning_alerts :: AsReadWrite p => p -> Permissions+secret_scanning_alerts = mkReadWrite "secret_scanning_alerts"++secrets :: AsReadWrite p => p -> Permissions+secrets = mkReadWrite "secrets"++security_events :: AsReadWrite p => p -> Permissions+security_events = mkReadWrite "security_events"++single_file :: AsReadWrite p => p -> Permissions+single_file = mkReadWrite "single_file"++statuses :: AsReadWrite p => p -> Permissions+statuses = mkReadWrite "statuses"++vulnerability_alerts :: AsReadWrite p => p -> Permissions+vulnerability_alerts = mkReadWrite "vulnerability_alerts"++-- | Only supported permission is 'Write'+workflows :: Permissions+workflows = mkWrite "workflows"++members :: AsReadWrite p => p -> Permissions+members = mkReadWrite "members"++organization_administration :: AsReadWrite p => p -> Permissions+organization_administration = mkReadWrite "organization_administration"++organization_custom_roles :: AsReadWrite p => p -> Permissions+organization_custom_roles = mkReadWrite "organization_custom_roles"++organization_custom_org_roles :: AsReadWrite p => p -> Permissions+organization_custom_org_roles = mkReadWrite "organization_custom_org_roles"++organization_custom_properties :: AsReadWriteAdmin p => p -> Permissions+organization_custom_properties = mkReadWriteAdmin "organization_custom_properties"++-- | Only supported permission is 'Write'+organization_copilot_seat_management :: Permissions+organization_copilot_seat_management = mkWrite "organization_copilot_seat_management"++organization_announcement_banners :: AsReadWrite p => p -> Permissions+organization_announcement_banners = mkReadWrite "organization_announcement_banners"++-- | Only supported permission is 'Read'+organization_events :: Permissions+organization_events = mkRead "organization_events"++organization_hooks :: AsReadWrite p => p -> Permissions+organization_hooks = mkReadWrite "organization_hooks"++organization_personal_access_tokens :: AsReadWrite p => p -> Permissions+organization_personal_access_tokens = mkReadWrite "organization_personal_access_tokens"++organization_personal_access_token_requests :: AsReadWrite p => p -> Permissions+organization_personal_access_token_requests = mkReadWrite "organization_personal_access_token_requests"++-- | Only supported permission is 'Read'+organization_plan :: Permissions+organization_plan = mkRead "organization_plan"++organization_projects :: AsReadWriteAdmin p => p -> Permissions+organization_projects = mkReadWriteAdmin "organization_projects"++organization_packages :: AsReadWrite p => p -> Permissions+organization_packages = mkReadWrite "organization_packages"++organization_secrets :: AsReadWrite p => p -> Permissions+organization_secrets = mkReadWrite "organization_secrets"++organization_self_hosted_runners :: AsReadWrite p => p -> Permissions+organization_self_hosted_runners = mkReadWrite "organization_self_hosted_runners"++organization_user_blocking :: AsReadWrite p => p -> Permissions+organization_user_blocking = mkReadWrite "organization_user_blocking"++team_discussions :: AsReadWrite p => p -> Permissions+team_discussions = mkReadWrite "team_discussions"++email_addresses :: AsReadWrite p => p -> Permissions+email_addresses = mkReadWrite "email_addresses"++followers :: AsReadWrite p => p -> Permissions+followers = mkReadWrite "followers"++git_ssh_keys :: AsReadWrite p => p -> Permissions+git_ssh_keys = mkReadWrite "git_ssh_keys"++gpg_keys :: AsReadWrite p => p -> Permissions+gpg_keys = mkReadWrite "gpg_keys"++interaction_limits :: AsReadWrite p => p -> Permissions+interaction_limits = mkReadWrite "interaction_limits"++-- | Only supported permission is 'Write'+profile :: Permissions+profile = mkWrite "profile"++starring :: AsReadWrite p => p -> Permissions+starring = mkReadWrite "starring"++mkRead :: Text -> Permissions+mkRead name = Permissions $ MonoidalMap.singleton name PermissionRead++mkWrite :: Text -> Permissions+mkWrite name = Permissions $ MonoidalMap.singleton name PermissionWrite++mkReadWrite :: AsReadWrite p => Text -> p -> Permissions+mkReadWrite name =+  Permissions+    . MonoidalMap.singleton name+    . toReadWritePermission++mkReadWriteAdmin :: AsReadWriteAdmin p => Text -> p -> Permissions+mkReadWriteAdmin name =+  Permissions+    . MonoidalMap.singleton name+    . toReadWriteAdminPermission

@@ -0,0 +1,20 @@+module GitHub.App.Token.PermissionsSpec+  ( spec+  ) where++import GitHub.App.Token.Prelude++import Data.Aeson+import GitHub.App.Token.Permissions+import Test.Hspec++spec :: Spec+spec = do+  describe "Semigroup" $ do+    it "resolves duplicates by taking higher permission" $ do+      checks Read <> checks Write `shouldBe` checks Write++  describe "ToJSON" $ do+    it "encodes correctly" $ do+      encode (checks Read <> actions Write)+        `shouldBe` "{\"actions\":\"write\",\"checks\":\"read\"}"