master..d97b97c · github-app

git.iko.soy/github-app

on d97b97c help sign in

.gitignore+1−2

since splitsnapshots

unifiedsplit

@@ -3,5 +3,4 @@

3cabal.project.local

4cabal.project.local~

5.ghc.environment.*

6−

6+*.cabal

7−.stack-work

README.md+1−25

@@ -1,25 +1 @@

1−# Authenticate as a GitHub App

1+# github-app

2−

3−This library provides functions that help with authenticating as a [GitHub App][ghapp].

4−

5−

6−## Use

7−

8−1. [Register][reg] your App with GitHub to obtain an App ID and a private key.

9−2. Using the data from the step above, create `AppAuth`.

10−3. For each installation of your app, get an `InstallationAuth` using `mkInstallationAuth`.

11−4. Use the `executeAppRequest` function to execute requests.

12− Behind the scenes, this function exchanges the installation auth token for

13− a regular access token, caches it, and renews as needed.

14−

15−See [serokell/github-ops-access][ghopsa] for a real-life example use.

16−

17−[ghapp]: https://developer.github.com/apps/

18−[reg]: https://github.com/settings/apps

19−[ghopsa]: https://github.com/serokell/github-ops-access/blob/test/webhook/Main.hs

20−

21−

22−## About Serokell

23−

24−This library is maintained and funded with ❤️ by [Serokell](https://serokell.io/).

25−The names and logo for Serokell are trademark of Serokell OÜ.

github-app.cabaldeleted−74

@@ -1,74 +0,0 @@

1−cabal-version: 1.12

2−

3−-- This file has been generated from package.yaml by hpack version 0.38.1.

4−--

5−-- see: https://github.com/sol/hpack

6−

7−name: github-app

8−version: 0.0.1

9−synopsis: Authetnicate as a GitHub App

10−description: Please see the README on GitHub at <https://github.com/serokell/github-app#readme>

11−category: Network

12−homepage: https://github.com/serokell/github-app#readme

13−bug-reports: https://github.com/serokell/github-app/issues

14−author: Serokell

15−maintainer: Kirill Elagin <kirelagin@serokell.io>

16−copyright: 2018 Serokell

17−license: MPL-2.0

18−license-file: LICENSE

19−build-type: Simple

20−extra-source-files:

21− README.md

22− ChangeLog.md

23−

24−source-repository head

25− type: git

26− location: https://github.com/serokell/github-app

27−

28−library

29− exposed-modules:

30− Crypto.PubKey.RSA.Read

31− GitHub.App.Auth

32− GitHub.App.Request

33− GitHub.Data.Apps

34− GitHub.Data.Installations

35− other-modules:

36− Paths_github_app

37− hs-source-dirs:

38− src

39− default-extensions:

40− ApplicativeDo

41− DeriveDataTypeable

42− DeriveGeneric

43− FlexibleContexts

44− FlexibleInstances

45− GeneralizedNewtypeDeriving

46− LambdaCase

47− MultiParamTypeClasses

48− NamedFieldPuns

49− OverloadedStrings

50− RankNTypes

51− RecordWildCards

52− ScopedTypeVariables

53− StandaloneDeriving

54− TemplateHaskell

55− TupleSections

56− TypeApplications

57− build-depends:

58− aeson

59− , base >=4.7 && <5

60− , bytestring

61− , cryptonite

62− , github

63− , http-client

64− , http-client-tls

65− , http-types

66− , jwt >=0.8.0

67− , mtl

68− , safe-exceptions

69− , tagged

70− , text

71− , time

72− , x509

73− , x509-store

74− default-language: Haskell2010

package.yaml+2−6

@@ -15,7 +15,6 @@ extra-source-files:

16default-extensions:

17 - ApplicativeDo

18− - DeriveDataTypeable

19 - DeriveGeneric

18 - DeriveGeneric

20 - FlexibleContexts

19 - FlexibleContexts

21 - FlexibleInstances

20 - FlexibleInstances

@@ -40,16 +39,13 @@ library:

40 dependencies:

39 dependencies:

41 - aeson

40 - aeson

42 - bytestring

41 - bytestring

43− - cryptonite

42+ - crypto-pubkey-types

44 - github

43 - github

45 - http-client

44 - http-client

46 - http-client-tls

45 - http-client-tls

47 - http-types

46 - http-types

48− - jwt >= 0.8.0

47+ - jwt

49 - mtl

48 - mtl

50 - safe-exceptions

49 - safe-exceptions

51− - tagged

52 - text

50 - text

53 - time

51 - time

54− - x509

55− - x509-store

src/Crypto/PubKey/RSA/Read.hsdeleted−27

@@ -1,27 +0,0 @@

1−{- This Source Code Form is subject to the terms of the Mozilla Public

2− - License, v. 2.0. If a copy of the MPL was not distributed with this

3− - file, You can obtain one at http://mozilla.org/MPL/2.0/.

4− -}

5−

6−module Crypto.PubKey.RSA.Read

7− ( ReadRsaKeyError (..)

8− , readRsaPem

9− ) where

10−

11−import Crypto.PubKey.RSA (PrivateKey)

12−import Data.X509 (PrivKey (PrivKeyRSA))

13−import Data.ByteString (ByteString)

14−import Data.X509.Memory (readKeyFileFromMemory)

15−

16−

17−data ReadRsaKeyError

18− = SingleKeyExpected { rrkeActualKeysCount :: Int }

19− | NotRsaKey

20−

21−readRsaPem :: ByteString -> Either ReadRsaKeyError PrivateKey

22−readRsaPem bs =

23− case readKeyFileFromMemory bs of

24− [k] -> case k of

25− PrivKeyRSA rsaKey -> Right rsaKey

26− _ -> Left NotRsaKey

27− l -> Left $ SingleKeyExpected (length l)

src/GitHub/App/Auth.hs+30−37

@@ -7,48 +7,47 @@

7{-# LANGUAGE DataKinds #-}

9module GitHub.App.Auth

10− ( AppAuth (..)

11−

12− , InstallationAuth

10+ ( InstallationAuth

13 , mkInstallationAuth

11 , mkInstallationAuth

15 , obtainAccessToken

13 , obtainAccessToken

14+

15+ , AppId

16+ , InstallationId

16 ) where

17 ) where

18import Prelude hiding (exp)

19import Prelude hiding (exp)

20import Control.Concurrent (MVar, newMVar, putMVar, readMVar, takeMVar)

21import Control.Concurrent (MVar, newMVar, putMVar, readMVar, takeMVar)

21import Control.Exception.Safe (bracketOnError, catch)

22import Control.Exception.Safe (bracketOnError, catch)

22−import Control.Monad.Except (ExceptT, MonadError (throwError), runExceptT)

23+import Control.Monad.Except (MonadError (throwError), ExceptT, runExceptT)

23−import Control.Monad.Trans (lift)

24−import Crypto.PubKey.RSA (PrivateKey)

25−import Data.Aeson (FromJSON (..), withObject, (.:))

26−import qualified Data.ByteString.Lazy as LBS

27import Data.Functor (($>))

24import Data.Functor (($>))

25+import Crypto.Types.PubKey.RSA (PrivateKey)

26+import Data.Aeson (FromJSON (..), withObject, (.:))

28import Data.Maybe (fromMaybe)

27import Data.Maybe (fromMaybe)

29import Data.Semigroup ((<>))

28import Data.Semigroup ((<>))

30−import Data.Tagged

31import Data.Text (Text)

29import Data.Text (Text)

32import qualified Data.Text as T

30import qualified Data.Text as T

33import Data.Text.Encoding (encodeUtf8)

31import Data.Text.Encoding (encodeUtf8)

34import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)

32import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)

35import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)

33import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)

34+import Control.Monad.Trans (lift)

35+import Data.Word (Word64)

36import GitHub.Auth (Auth (OAuth))

37−import GitHub.Data.Apps (App)

38import GitHub.Data.Definitions (Error (HTTPError))

37import GitHub.Data.Definitions (Error (HTTPError))

39−import GitHub.Data.Id (Id, untagId)

38+import GitHub.Data.Request (StatusMap)

40−import GitHub.Data.Installations (Installation)

39+import GitHub.Request (parseResponse)

41−import GitHub.Request (StatusMap, parseResponseJSON)

40+import Web.JWT (JWTClaimsSet (exp, iat, iss), Signer (RSAPrivateKey), encodeSigned,

41+ numericDate, stringOrURI)

42import Network.HTTP.Client as HTTP

43import qualified Network.HTTP.Client.Internal as HTTP

44import qualified Network.HTTP.Types as HTTP

45−import Web.JWT (JWTClaimsSet (exp, iat, iss), Signer (RSAPrivateKey), encodeSigned, numericDate,

45+import qualified Data.ByteString.Lazy as LBS

46− stringOrURI)

49-- | JWT expiration time. Maximum accepted by GitHub is 10 minutes

48-- | JWT expiration time. Maximum accepted by GitHub is 10 minutes

50jwtExpTime :: NominalDiffTime

49jwtExpTime :: NominalDiffTime

51−jwtExpTime = 300

50+jwtExpTime = 600

53-- | Installation access token expiration time. It is fixed by GitHub and is equal to 1 hour

52-- | Installation access token expiration time. It is fixed by GitHub and is equal to 1 hour

54instKeyExpTime :: NominalDiffTime

53instKeyExpTime :: NominalDiffTime

@@ -65,16 +64,10 @@ baseUrl :: Text

65baseUrl = "https://api.github.com"

64baseUrl = "https://api.github.com"

68−-- | Credentials of a GitHub App

69−data AppAuth = AppAuth

70− { aaAppId :: !(Id App)

71− , aaPrivateKey :: !PrivateKey

72− }

73−

74-- | Cached GitHub installation access token

67-- | Cached GitHub installation access token

75data InstallationToken = InstallationToken

68data InstallationToken = InstallationToken

76− { itToken :: !Auth

69+ { itToken :: Auth

77− , itExpirationTime :: !UTCTime

70+ , itExpirationTime :: UTCTime

78 } deriving (Show)

71 } deriving (Show)

80instance FromJSON InstallationToken where

73instance FromJSON InstallationToken where

@@ -84,7 +77,7 @@ instance FromJSON InstallationToken where

84 <*> o .: "expires_at"

77 <*> o .: "expires_at"

87−-- | Credentials required for an App to authenticate as an installation

80+-- | Credentials required for an app to authenticate as an installation

88data InstallationAuth = InstallationAuth

81data InstallationAuth = InstallationAuth

89 { iaClaimsSet :: !JWTClaimsSet -- ^ Prefilled claims set

82 { iaClaimsSet :: !JWTClaimsSet -- ^ Prefilled claims set

90 , iaAppPrivateKey :: !PrivateKey -- ^ Private key to sign token requests

83 , iaAppPrivateKey :: !PrivateKey -- ^ Private key to sign token requests

@@ -93,16 +86,20 @@ data InstallationAuth = InstallationAuth

93 }

86 }

89+type AppId = Word64

90+type InstallationId = Word64

91+

96-- | Smart constructor for 'InstallationAuth'

92-- | Smart constructor for 'InstallationAuth'

97mkInstallationAuth

93mkInstallationAuth

98− :: AppAuth

94+ :: AppId -- ^ GitHub App ID

95+ -> PrivateKey -- ^ GitHub App Private Key

99− -> Id Installation

96+ -> InstallationId -- ^ Installation ID

100 -> IO InstallationAuth

97 -> IO InstallationAuth

101−mkInstallationAuth AppAuth{aaAppId, aaPrivateKey} instId = do

98+mkInstallationAuth appId pk instId = do

102 varToken <- newMVar Nothing

99 varToken <- newMVar Nothing

103− let issuer = fromMaybe (error "impossible") . stringOrURI . T.pack . show . untagId $ aaAppId

100+ let issuer = fromMaybe (error "impossible") . stringOrURI . T.pack . show $ appId

104 claimsSet = mempty { iss = Just issuer }

101 claimsSet = mempty { iss = Just issuer }

105− pure $ InstallationAuth claimsSet aaPrivateKey (T.pack . show . untagId $ instId) varToken

102+ pure $ InstallationAuth claimsSet pk (T.pack . show $ instId) varToken

106

103

107-- | Create a request which, when executed, will obtain a new access token

104-- | Create a request which, when executed, will obtain a new access token

108createAccessTokenR :: InstallationAuth -> IO HTTP.Request

105createAccessTokenR :: InstallationAuth -> IO HTTP.Request

@@ -113,15 +110,11 @@ createAccessTokenR InstallationAuth{..} = do

113 { iat = Just $ toJsonTime currentTime

110 { iat = Just $ toJsonTime currentTime

114 , exp = Just $ toJsonTime expiryTime

111 , exp = Just $ toJsonTime expiryTime

115 }

112 }

116− jwt = encodeSigned (RSAPrivateKey iaAppPrivateKey) mempty claims

113+ jwt = encodeSigned (RSAPrivateKey iaAppPrivateKey) claims

117

114

118 req <- HTTP.parseRequest . T.unpack $ url

115 req <- HTTP.parseRequest . T.unpack $ url

119 pure req

116 pure req

120− { HTTP.requestHeaders =

121− [ ("Authorization", "Bearer " <> encodeUtf8 jwt)

117+ { HTTP.requestHeaders = [("Authorization", "Bearer " <> encodeUtf8 jwt)]

122− , ("Accept", "application/vnd.github.machine-man-preview+json")

123− , ("User-Agent", "github-app/Haskell")

124− ]

125 , HTTP.checkResponse = successOrMissing Nothing

118 , HTTP.checkResponse = successOrMissing Nothing

126 , HTTP.method = "POST"

119 , HTTP.method = "POST"

127 }

120 }

@@ -148,7 +141,7 @@ obtainAccessToken mgr ia@InstallationAuth{..} = readMVar iaToken >>= \case

148 renew :: IO (Either Error Auth)

141 renew :: IO (Either Error Auth)

149 renew = bracketOnError (takeMVar iaToken) (putMVar iaToken) $ \_ -> do

142 renew = bracketOnError (takeMVar iaToken) (putMVar iaToken) $ \_ -> do

150 req <- createAccessTokenR ia

143 req <- createAccessTokenR ia

151− result <- runExceptT $ httpLbs' req >>= parseResponseJSON

144+ result <- runExceptT $ httpLbs' req >>= parseResponse

152 case result of

145 case result of

153 Right newToken -> putMVar iaToken (Just newToken) $> Right (itToken newToken)

146 Right newToken -> putMVar iaToken (Just newToken) $> Right (itToken newToken)

154 Left err -> putMVar iaToken Nothing $> Left err

147 Left err -> putMVar iaToken Nothing $> Left err

src/GitHub/App/Request.hs+2−4

@@ -10,7 +10,6 @@ module GitHub.App.Request

10 , executeAppRequestWithMgr

11 ) where

13−import Data.Aeson (FromJSON)

14import GitHub.Data (Error (..))

13import GitHub.Data (Error (..))

15import GitHub.Data.Request (Request)

14import GitHub.Data.Request (Request)

16import GitHub.Request (executeRequestWithMgr)

15import GitHub.Request (executeRequestWithMgr)

@@ -20,7 +19,7 @@ import Network.HTTP.Client.TLS (newTlsManager)

20import GitHub.App.Auth (InstallationAuth, obtainAccessToken)

19import GitHub.App.Auth (InstallationAuth, obtainAccessToken)

23−executeAppRequest :: FromJSON a => InstallationAuth -> Request k a -> IO (Either Error a)

22+executeAppRequest :: InstallationAuth -> Request k a -> IO (Either Error a)

24executeAppRequest instAuth req = do

23executeAppRequest instAuth req = do

25 manager <- newTlsManager

24 manager <- newTlsManager

26 x <- executeAppRequestWithMgr manager instAuth req

25 x <- executeAppRequestWithMgr manager instAuth req

@@ -30,8 +29,7 @@ executeAppRequest instAuth req = do

30 pure x

29 pure x

32executeAppRequestWithMgr

31executeAppRequestWithMgr

33− :: FromJSON a

34− => Manager

32+ :: Manager

35 -> InstallationAuth

33 -> InstallationAuth

36 -> Request k a

34 -> Request k a

37 -> IO (Either Error a)

35 -> IO (Either Error a)

src/GitHub/Data/Apps.hsdeleted−31

@@ -1,31 +0,0 @@

1−{- This Source Code Form is subject to the terms of the Mozilla Public

2− - License, v. 2.0. If a copy of the MPL was not distributed with this

3− - file, You can obtain one at http://mozilla.org/MPL/2.0/.

4− -}

5−

6−{-# LANGUAGE CPP #-}

7−

8−module GitHub.Data.Apps where

9−

10−import GitHub.Data.Definitions (SimpleOwner)

11−import GitHub.Data.Id (Id)

12−import GitHub.Data.Name (Name)

13−import GitHub.Data.URL (URL)

14−import GitHub.Internal.Prelude

15−import Prelude ()

16−

17−

18−data App = App

19− { appId :: !(Id App)

20− , appOwner :: !SimpleOwner

21− , appName :: !(Name App)

22− , appDescription :: !(Maybe Text)

23− , appExternalUrl :: !URL

24− , appHtmlUrl :: !URL

25− , appCreatedAt :: !(Maybe UTCTime)

26− , appUpdatedAt :: !(Maybe UTCTime)

27− }

28− deriving (Show, Data, Typeable, Eq, Ord, Generic)

29−

30−instance NFData App where rnf = genericRnf

31−instance Binary App

src/GitHub/Data/Installations.hsdeleted−34

@@ -1,34 +0,0 @@

1−{- This Source Code Form is subject to the terms of the Mozilla Public

2− - License, v. 2.0. If a copy of the MPL was not distributed with this

3− - file, You can obtain one at http://mozilla.org/MPL/2.0/.

4− -}

5−

6−{-# LANGUAGE CPP #-}

7−

8−module GitHub.Data.Installations where

9−

10−import GitHub.Data.Apps (App)

11−import GitHub.Data.Id (Id)

12−import GitHub.Data.URL (URL)

13−import GitHub.Internal.Prelude

14−import Prelude ()

15−

16−

17−data Installation = Installation

18− { installationId :: !(Id Installation)

19−-- , installationAccount

20− , installationAccesssTokensUrl :: !URL

21− , installationRepositoriesUrl :: !URL

22− , installationHtmlUrl :: !URL

23− , installationAppId :: (Id App)

24−-- , installationTargetId

25−-- , installationTargetType

26−-- , installationPermissions

27−-- , installationEvents

28−-- , installationSingleFileName

29−-- , installationRepositorySelection

30− }

31− deriving (Show, Data, Typeable, Eq, Ord, Generic)

32−

33−instance NFData Installation where rnf = genericRnf

34−instance Binary Installation

stack.yaml+3−5

@@ -1,11 +1,9 @@

1−resolver: lts-14.19

1+resolver: lts-11.5

3packages:

4- .

5# Dependency packages to be pulled from upstream that are not in the resolver

6# using the same syntax as the packages field.

7# (e.g., acme-missiles-0.3)

8−extra-deps:

8+extra-deps:

9− - github-0.24

10− - binary-instances-1

11− # - jwt-0.8.0

9+ - jwt-0.8.0

stack.yaml.lockdeleted−26

@@ -1,26 +0,0 @@

1−# This file was autogenerated by Stack.

2−# You should not edit this file by hand.

3−# For more information, please see the documentation at:

4−# https://docs.haskellstack.org/en/stable/topics/lock_files

5−

6−packages:

7−- completed:

8− hackage: github-0.24@sha256:4bf5a06289d36f78bf347b6a4f9906f659be7335cde78386a6c95568714a730b,6955

9− pantry-tree:

10− sha256: e0f84d7a3cdd76c6bd5395c8c72d24a1dda9616f857291820b08947c8290f042

11− size: 7105

12− original:

13− hackage: github-0.24

14−- completed:

15− hackage: binary-instances-1@sha256:b17565598b8df3241f9b46fa8e3a3368ecc8e3f2eb175d7c28f319042a6f5c79,2613

16− pantry-tree:

17− sha256: 938ffc6990cac12681c657f7afa93737eecf335e6f0212d8c0b7c1ea3e0f40f4

18− size: 1035

19− original:

20− hackage: binary-instances-1

21−snapshots:

22−- completed:

23− sha256: 9f79f6494473c9b46911364b94c4b5ef19ca8d35ebf62e46697cf651f198ee19

24− size: 524155

25− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/19.yaml

26− original: lts-14.19