7f66b68...master · github-app

.gitignore+2−1

since splitsnapshots

unifiedsplit

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

3cabal.project.local

4cabal.project.local~

5.ghc.environment.*

6−*.cabal

6+

7+.stack-work

README.md+25−1

@@ -1 +1,25 @@

1−# github-app

1+# Authenticate as a 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.cabalnew file+74

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

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+1

@@ -48,6 +48,7 @@ library:

48 - jwt >= 0.8.0

49 - mtl

50 - safe-exceptions

51+ - tagged

51 - text

52 - text

52 - time

53 - time

53 - x509

54 - x509

src/GitHub/App/Auth.hs+6−5

@@ -27,6 +27,7 @@ import qualified Data.ByteString.Lazy as LBS

27import Data.Functor (($>))

28import Data.Maybe (fromMaybe)

29import Data.Semigroup ((<>))

30+import Data.Tagged

30import Data.Text (Text)

31import Data.Text (Text)

31import qualified Data.Text as T

32import qualified Data.Text as T

32import Data.Text.Encoding (encodeUtf8)

33import Data.Text.Encoding (encodeUtf8)

@@ -37,8 +38,7 @@ import GitHub.Data.Apps (App)

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

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

38import GitHub.Data.Id (Id, untagId)

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

39import GitHub.Data.Installations (Installation)

40import GitHub.Data.Installations (Installation)

40−import GitHub.Data.Request (StatusMap)

41+import GitHub.Request (StatusMap, parseResponseJSON)

41−import GitHub.Request (parseResponse)

42import Network.HTTP.Client as HTTP

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

44import qualified Network.HTTP.Types as HTTP

@@ -48,7 +48,7 @@ import Web.JWT (JWTClaimsSet (exp, iat, iss), Signer (RSAPrivateKey), encodeSign

48

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

50jwtExpTime :: NominalDiffTime

51−jwtExpTime = 600

51+jwtExpTime = 300

52

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

54instKeyExpTime :: NominalDiffTime

@@ -113,12 +113,13 @@ createAccessTokenR InstallationAuth{..} = do

113 { iat = Just $ toJsonTime currentTime

114 , exp = Just $ toJsonTime expiryTime

115 }

116− jwt = encodeSigned (RSAPrivateKey iaAppPrivateKey) claims

116+ jwt = encodeSigned (RSAPrivateKey iaAppPrivateKey) mempty claims

117

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

119 pure req

120 { HTTP.requestHeaders =

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

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

122 , ("User-Agent", "github-app/Haskell")

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

123 ]

124 ]

124 , HTTP.checkResponse = successOrMissing Nothing

125 , HTTP.checkResponse = successOrMissing Nothing

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

147 renew :: IO (Either Error Auth)

148 renew :: IO (Either Error Auth)

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

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

149 req <- createAccessTokenR ia

150 req <- createAccessTokenR ia

150− result <- runExceptT $ httpLbs' req >>= parseResponse

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

151 case result of

152 case result of

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

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

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

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

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

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

10 , executeAppRequestWithMgr

11 ) where

12

13+import Data.Aeson (FromJSON)

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

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

14import GitHub.Data.Request (Request)

15import GitHub.Data.Request (Request)

15import GitHub.Request (executeRequestWithMgr)

16import GitHub.Request (executeRequestWithMgr)

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

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

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

20

21

22

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

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

23executeAppRequest instAuth req = do

24executeAppRequest instAuth req = do

24 manager <- newTlsManager

25 manager <- newTlsManager

25 x <- executeAppRequestWithMgr manager instAuth req

26 x <- executeAppRequestWithMgr manager instAuth req

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

29 pure x

30 pure x

30

31

31executeAppRequestWithMgr

32executeAppRequestWithMgr

33+ :: FromJSON a

32− :: Manager

34+ => Manager

33 -> InstallationAuth

35 -> InstallationAuth

34 -> Request k a

36 -> Request k a

35 -> IO (Either Error a)

37 -> IO (Either Error a)

stack.yaml+5−3

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

1−resolver: lts-11.5

1+resolver: lts-14.19

2

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

9− - jwt-0.8.0

11+ # - jwt-0.8.0

stack.yaml.locknew file+26

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

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