git.iko.soy/github-app
on master help sign in
swap
8316e9e8 ahead, 0 behind
9 files changed+179−16
since splitsnapshots
unifiedsplit
.gitignore+2−1 README.md+25−1 github-app.cabal+74 package.yaml+4−1 src/Crypto/PubKey/RSA/Read.hs+27 src/GitHub/App/Auth.hs+12−8 src/GitHub/App/Request.hs+4−2 stack.yaml+5−3 stack.yaml.lock+26
.gitignore+2−1
@@ -3,4 +3,5 @@
33cabal.project.local
44cabal.project.local~
55.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+4−1
@@ -40,7 +40,7 @@ library:
4040 dependencies:
4141 - aeson
4242 - bytestring
43− - crypto-pubkey-types
43+ - cryptonite
4444 - github
4545 - http-client
4646 - http-client-tls
@@ -48,5 +48,8 @@ library:
4848 - jwt >= 0.8.0
4949 - mtl
5050 - safe-exceptions
51+ - tagged
5152 - text
5253 - time
54+ - x509
55+ - x509-store
src/Crypto/PubKey/RSA/Read.hsnew file+27
@@ -0,0 +1,27 @@
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+12−8
@@ -7,7 +7,7 @@
77{-# LANGUAGE DataKinds #-}
88
99module GitHub.App.Auth
10− ( AppAuth
10+ ( AppAuth (..)
1111
1212 , InstallationAuth
1313 , mkInstallationAuth
@@ -21,12 +21,13 @@ import Control.Concurrent (MVar, newMVar, putMVar, readMVar, takeMVar)
2121import Control.Exception.Safe (bracketOnError, catch)
2222import Control.Monad.Except (ExceptT, MonadError (throwError), runExceptT)
2323import Control.Monad.Trans (lift)
24−import Crypto.Types.PubKey.RSA (PrivateKey)
24+import Crypto.PubKey.RSA (PrivateKey)
2525import Data.Aeson (FromJSON (..), withObject, (.:))
2626import qualified Data.ByteString.Lazy as LBS
2727import Data.Functor (($>))
2828import Data.Maybe (fromMaybe)
2929import Data.Semigroup ((<>))
30+import Data.Tagged
3031import Data.Text (Text)
3132import qualified Data.Text as T
3233import Data.Text.Encoding (encodeUtf8)
@@ -37,8 +38,7 @@ import GitHub.Data.Apps (App)
3738import GitHub.Data.Definitions (Error (HTTPError))
3839import GitHub.Data.Id (Id, untagId)
3940import GitHub.Data.Installations (Installation)
40−import GitHub.Data.Request (StatusMap)
41−import GitHub.Request (parseResponse)
41+import GitHub.Request (StatusMap, parseResponseJSON)
4242import Network.HTTP.Client as HTTP
4343import qualified Network.HTTP.Client.Internal as HTTP
4444import qualified Network.HTTP.Types as HTTP
@@ -48,7 +48,7 @@ import Web.JWT (JWTClaimsSet (exp, iat, iss), Signer (RSAPrivateKey), encodeSign
4848
4949-- | JWT expiration time. Maximum accepted by GitHub is 10 minutes
5050jwtExpTime :: NominalDiffTime
51−jwtExpTime = 600
51+jwtExpTime = 300
5252
5353-- | Installation access token expiration time. It is fixed by GitHub and is equal to 1 hour
5454instKeyExpTime :: NominalDiffTime
@@ -113,11 +113,15 @@ createAccessTokenR InstallationAuth{..} = do
113113 { iat = Just $ toJsonTime currentTime
114114 , exp = Just $ toJsonTime expiryTime
115115 }
116− jwt = encodeSigned (RSAPrivateKey iaAppPrivateKey) claims
116+ jwt = encodeSigned (RSAPrivateKey iaAppPrivateKey) mempty claims
117117
118118 req <- HTTP.parseRequest . T.unpack $ url
119119 pure req
120− { HTTP.requestHeaders = [("Authorization", "Bearer " <> encodeUtf8 jwt)]
120+ { HTTP.requestHeaders =
121+ [ ("Authorization", "Bearer " <> encodeUtf8 jwt)
122+ , ("Accept", "application/vnd.github.machine-man-preview+json")
123+ , ("User-Agent", "github-app/Haskell")
124+ ]
121125 , HTTP.checkResponse = successOrMissing Nothing
122126 , HTTP.method = "POST"
123127 }
@@ -144,7 +148,7 @@ obtainAccessToken mgr ia@InstallationAuth{..} = readMVar iaToken >>= \case
144148 renew :: IO (Either Error Auth)
145149 renew = bracketOnError (takeMVar iaToken) (putMVar iaToken) $ \_ -> do
146150 req <- createAccessTokenR ia
147− result <- runExceptT $ httpLbs' req >>= parseResponse
151+ result <- runExceptT $ httpLbs' req >>= parseResponseJSON
148152 case result of
149153 Right newToken -> putMVar iaToken (Just newToken) $> Right (itToken newToken)
150154 Left err -> putMVar iaToken Nothing $> Left err
src/GitHub/App/Request.hs+4−2
@@ -10,6 +10,7 @@ module GitHub.App.Request
1010 , executeAppRequestWithMgr
1111 ) where
1212
13+import Data.Aeson (FromJSON)
1314import GitHub.Data (Error (..))
1415import GitHub.Data.Request (Request)
1516import GitHub.Request (executeRequestWithMgr)
@@ -19,7 +20,7 @@ import Network.HTTP.Client.TLS (newTlsManager)
1920import GitHub.App.Auth (InstallationAuth, obtainAccessToken)
2021
2122
22−executeAppRequest :: InstallationAuth -> Request k a -> IO (Either Error a)
23+executeAppRequest :: FromJSON a => InstallationAuth -> Request k a -> IO (Either Error a)
2324executeAppRequest instAuth req = do
2425 manager <- newTlsManager
2526 x <- executeAppRequestWithMgr manager instAuth req
@@ -29,7 +30,8 @@ executeAppRequest instAuth req = do
2930 pure x
3031
3132executeAppRequestWithMgr
32− :: Manager
33+ :: FromJSON a
34+ => Manager
3335 -> InstallationAuth
3436 -> Request k a
3537 -> IO (Either Error a)
stack.yaml+5−3
@@ -1,9 +1,11 @@
1−resolver: lts-11.5
1+resolver: lts-14.19
22
33packages:
44- .
55# Dependency packages to be pulled from upstream that are not in the resolver
66# using the same syntax as the packages field.
77# (e.g., acme-missiles-0.3)
8−extra-deps:
9− - jwt-0.8.0
8+extra-deps:
9+ - github-0.24
10+ - binary-instances-1
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