on master help sign in
15 files changed+897−22
since splitsnapshots
unifiedsplit
.gitignore+7−22 ChangeLog.md+3 LICENSE+373 README.md+25 Setup.hs+2 github-app.cabal+74 package.yaml+55 src/Crypto/PubKey/RSA/Read.hs+27 src/GitHub/App/Auth.hs+187 src/GitHub/App/Request.hs+40 src/GitHub/Data/Apps.hs+31 src/GitHub/Data/Installations.hs+34 stack.yaml+11 stack.yaml.lock+26 test/Spec.hs+2
.gitignore+7−22
@@ -1,22 +1,7 @@
1−dist
2−dist-*
3−cabal-dev
4−*.o
5−*.hi
6−*.chi
7−*.chs.h
8−*.dyn_o
9−*.dyn_hi
10−.hpc
11−.hsenv
12−.cabal-sandbox/
13−cabal.sandbox.config
14−*.prof
15−*.aux
16−*.hp
17−*.eventlog
18−.stack-work/
19−cabal.project.local
20−cabal.project.local~
21−.HTF/
22−.ghc.environment.*
1+/dist/
2+/dist-newstyle/
3+cabal.project.local
4+cabal.project.local~
5+.ghc.environment.*
6+
7+.stack-work
ChangeLog.mdnew file+3
@@ -0,0 +1,3 @@
1+# Changelog for github-app
2+
3+## Unreleased changes
LICENSEnew file+373
@@ -0,0 +1,373 @@
1+Mozilla Public License Version 2.0
2+==================================
3+
4+1. Definitions
5+--------------
6+
7+1.1. "Contributor"
8+ means each individual or legal entity that creates, contributes to
9+ the creation of, or owns Covered Software.
10+
11+1.2. "Contributor Version"
12+ means the combination of the Contributions of others (if any) used
13+ by a Contributor and that particular Contributor's Contribution.
14+
15+1.3. "Contribution"
16+ means Covered Software of a particular Contributor.
17+
18+1.4. "Covered Software"
19+ means Source Code Form to which the initial Contributor has attached
20+ the notice in Exhibit A, the Executable Form of such Source Code
21+ Form, and Modifications of such Source Code Form, in each case
22+ including portions thereof.
23+
24+1.5. "Incompatible With Secondary Licenses"
25+ means
26+
27+ (a) that the initial Contributor has attached the notice described
28+ in Exhibit B to the Covered Software; or
29+
30+ (b) that the Covered Software was made available under the terms of
31+ version 1.1 or earlier of the License, but not also under the
32+ terms of a Secondary License.
33+
34+1.6. "Executable Form"
35+ means any form of the work other than Source Code Form.
36+
37+1.7. "Larger Work"
38+ means a work that combines Covered Software with other material, in
39+ a separate file or files, that is not Covered Software.
40+
41+1.8. "License"
42+ means this document.
43+
44+1.9. "Licensable"
45+ means having the right to grant, to the maximum extent possible,
46+ whether at the time of the initial grant or subsequently, any and
47+ all of the rights conveyed by this License.
48+
49+1.10. "Modifications"
50+ means any of the following:
51+
52+ (a) any file in Source Code Form that results from an addition to,
53+ deletion from, or modification of the contents of Covered
54+ Software; or
55+
56+ (b) any new file in Source Code Form that contains any Covered
57+ Software.
58+
59+1.11. "Patent Claims" of a Contributor
60+ means any patent claim(s), including without limitation, method,
61+ process, and apparatus claims, in any patent Licensable by such
62+ Contributor that would be infringed, but for the grant of the
63+ License, by the making, using, selling, offering for sale, having
64+ made, import, or transfer of either its Contributions or its
65+ Contributor Version.
66+
67+1.12. "Secondary License"
68+ means either the GNU General Public License, Version 2.0, the GNU
69+ Lesser General Public License, Version 2.1, the GNU Affero General
70+ Public License, Version 3.0, or any later versions of those
71+ licenses.
72+
73+1.13. "Source Code Form"
74+ means the form of the work preferred for making modifications.
75+
76+1.14. "You" (or "Your")
77+ means an individual or a legal entity exercising rights under this
78+ License. For legal entities, "You" includes any entity that
79+ controls, is controlled by, or is under common control with You. For
80+ purposes of this definition, "control" means (a) the power, direct
81+ or indirect, to cause the direction or management of such entity,
82+ whether by contract or otherwise, or (b) ownership of more than
83+ fifty percent (50%) of the outstanding shares or beneficial
84+ ownership of such entity.
85+
86+2. License Grants and Conditions
87+--------------------------------
88+
89+2.1. Grants
90+
91+Each Contributor hereby grants You a world-wide, royalty-free,
92+non-exclusive license:
93+
94+(a) under intellectual property rights (other than patent or trademark)
95+ Licensable by such Contributor to use, reproduce, make available,
96+ modify, display, perform, distribute, and otherwise exploit its
97+ Contributions, either on an unmodified basis, with Modifications, or
98+ as part of a Larger Work; and
99+
100+(b) under Patent Claims of such Contributor to make, use, sell, offer
101+ for sale, have made, import, and otherwise transfer either its
102+ Contributions or its Contributor Version.
103+
104+2.2. Effective Date
105+
106+The licenses granted in Section 2.1 with respect to any Contribution
107+become effective for each Contribution on the date the Contributor first
108+distributes such Contribution.
109+
110+2.3. Limitations on Grant Scope
111+
112+The licenses granted in this Section 2 are the only rights granted under
113+this License. No additional rights or licenses will be implied from the
114+distribution or licensing of Covered Software under this License.
115+Notwithstanding Section 2.1(b) above, no patent license is granted by a
116+Contributor:
117+
118+(a) for any code that a Contributor has removed from Covered Software;
119+ or
120+
121+(b) for infringements caused by: (i) Your and any other third party's
122+ modifications of Covered Software, or (ii) the combination of its
123+ Contributions with other software (except as part of its Contributor
124+ Version); or
125+
126+(c) under Patent Claims infringed by Covered Software in the absence of
127+ its Contributions.
128+
129+This License does not grant any rights in the trademarks, service marks,
130+or logos of any Contributor (except as may be necessary to comply with
131+the notice requirements in Section 3.4).
132+
133+2.4. Subsequent Licenses
134+
135+No Contributor makes additional grants as a result of Your choice to
136+distribute the Covered Software under a subsequent version of this
137+License (see Section 10.2) or under the terms of a Secondary License (if
138+permitted under the terms of Section 3.3).
139+
140+2.5. Representation
141+
142+Each Contributor represents that the Contributor believes its
143+Contributions are its original creation(s) or it has sufficient rights
144+to grant the rights to its Contributions conveyed by this License.
145+
146+2.6. Fair Use
147+
148+This License is not intended to limit any rights You have under
149+applicable copyright doctrines of fair use, fair dealing, or other
150+equivalents.
151+
152+2.7. Conditions
153+
154+Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted
155+in Section 2.1.
156+
157+3. Responsibilities
158+-------------------
159+
160+3.1. Distribution of Source Form
161+
162+All distribution of Covered Software in Source Code Form, including any
163+Modifications that You create or to which You contribute, must be under
164+the terms of this License. You must inform recipients that the Source
165+Code Form of the Covered Software is governed by the terms of this
166+License, and how they can obtain a copy of this License. You may not
167+attempt to alter or restrict the recipients' rights in the Source Code
168+Form.
169+
170+3.2. Distribution of Executable Form
171+
172+If You distribute Covered Software in Executable Form then:
173+
174+(a) such Covered Software must also be made available in Source Code
175+ Form, as described in Section 3.1, and You must inform recipients of
176+ the Executable Form how they can obtain a copy of such Source Code
177+ Form by reasonable means in a timely manner, at a charge no more
178+ than the cost of distribution to the recipient; and
179+
180+(b) You may distribute such Executable Form under the terms of this
181+ License, or sublicense it under different terms, provided that the
182+ license for the Executable Form does not attempt to limit or alter
183+ the recipients' rights in the Source Code Form under this License.
184+
185+3.3. Distribution of a Larger Work
186+
187+You may create and distribute a Larger Work under terms of Your choice,
188+provided that You also comply with the requirements of this License for
189+the Covered Software. If the Larger Work is a combination of Covered
190+Software with a work governed by one or more Secondary Licenses, and the
191+Covered Software is not Incompatible With Secondary Licenses, this
192+License permits You to additionally distribute such Covered Software
193+under the terms of such Secondary License(s), so that the recipient of
194+the Larger Work may, at their option, further distribute the Covered
195+Software under the terms of either this License or such Secondary
196+License(s).
197+
198+3.4. Notices
199+
200+You may not remove or alter the substance of any license notices
201+(including copyright notices, patent notices, disclaimers of warranty,
202+or limitations of liability) contained within the Source Code Form of
203+the Covered Software, except that You may alter any license notices to
204+the extent required to remedy known factual inaccuracies.
205+
206+3.5. Application of Additional Terms
207+
208+You may choose to offer, and to charge a fee for, warranty, support,
209+indemnity or liability obligations to one or more recipients of Covered
210+Software. However, You may do so only on Your own behalf, and not on
211+behalf of any Contributor. You must make it absolutely clear that any
212+such warranty, support, indemnity, or liability obligation is offered by
213+You alone, and You hereby agree to indemnify every Contributor for any
214+liability incurred by such Contributor as a result of warranty, support,
215+indemnity or liability terms You offer. You may include additional
216+disclaimers of warranty and limitations of liability specific to any
217+jurisdiction.
218+
219+4. Inability to Comply Due to Statute or Regulation
220+---------------------------------------------------
221+
222+If it is impossible for You to comply with any of the terms of this
223+License with respect to some or all of the Covered Software due to
224+statute, judicial order, or regulation then You must: (a) comply with
225+the terms of this License to the maximum extent possible; and (b)
226+describe the limitations and the code they affect. Such description must
227+be placed in a text file included with all distributions of the Covered
228+Software under this License. Except to the extent prohibited by statute
229+or regulation, such description must be sufficiently detailed for a
230+recipient of ordinary skill to be able to understand it.
231+
232+5. Termination
233+--------------
234+
235+5.1. The rights granted under this License will terminate automatically
236+if You fail to comply with any of its terms. However, if You become
237+compliant, then the rights granted under this License from a particular
238+Contributor are reinstated (a) provisionally, unless and until such
239+Contributor explicitly and finally terminates Your grants, and (b) on an
240+ongoing basis, if such Contributor fails to notify You of the
241+non-compliance by some reasonable means prior to 60 days after You have
242+come back into compliance. Moreover, Your grants from a particular
243+Contributor are reinstated on an ongoing basis if such Contributor
244+notifies You of the non-compliance by some reasonable means, this is the
245+first time You have received notice of non-compliance with this License
246+from such Contributor, and You become compliant prior to 30 days after
247+Your receipt of the notice.
248+
249+5.2. If You initiate litigation against any entity by asserting a patent
250+infringement claim (excluding declaratory judgment actions,
251+counter-claims, and cross-claims) alleging that a Contributor Version
252+directly or indirectly infringes any patent, then the rights granted to
253+You by any and all Contributors for the Covered Software under Section
254+2.1 of this License shall terminate.
255+
256+5.3. In the event of termination under Sections 5.1 or 5.2 above, all
257+end user license agreements (excluding distributors and resellers) which
258+have been validly granted by You or Your distributors under this License
259+prior to termination shall survive termination.
260+
261+************************************************************************
262+* *
263+* 6. Disclaimer of Warranty *
264+* ------------------------- *
265+* *
266+* Covered Software is provided under this License on an "as is" *
267+* basis, without warranty of any kind, either expressed, implied, or *
268+* statutory, including, without limitation, warranties that the *
269+* Covered Software is free of defects, merchantable, fit for a *
270+* particular purpose or non-infringing. The entire risk as to the *
271+* quality and performance of the Covered Software is with You. *
272+* Should any Covered Software prove defective in any respect, You *
273+* (not any Contributor) assume the cost of any necessary servicing, *
274+* repair, or correction. This disclaimer of warranty constitutes an *
275+* essential part of this License. No use of any Covered Software is *
276+* authorized under this License except under this disclaimer. *
277+* *
278+************************************************************************
279+
280+************************************************************************
281+* *
282+* 7. Limitation of Liability *
283+* -------------------------- *
284+* *
285+* Under no circumstances and under no legal theory, whether tort *
286+* (including negligence), contract, or otherwise, shall any *
287+* Contributor, or anyone who distributes Covered Software as *
288+* permitted above, be liable to You for any direct, indirect, *
289+* special, incidental, or consequential damages of any character *
290+* including, without limitation, damages for lost profits, loss of *
291+* goodwill, work stoppage, computer failure or malfunction, or any *
292+* and all other commercial damages or losses, even if such party *
293+* shall have been informed of the possibility of such damages. This *
294+* limitation of liability shall not apply to liability for death or *
295+* personal injury resulting from such party's negligence to the *
296+* extent applicable law prohibits such limitation. Some *
297+* jurisdictions do not allow the exclusion or limitation of *
298+* incidental or consequential damages, so this exclusion and *
299+* limitation may not apply to You. *
300+* *
301+************************************************************************
302+
303+8. Litigation
304+-------------
305+
306+Any litigation relating to this License may be brought only in the
307+courts of a jurisdiction where the defendant maintains its principal
308+place of business and such litigation shall be governed by laws of that
309+jurisdiction, without reference to its conflict-of-law provisions.
310+Nothing in this Section shall prevent a party's ability to bring
311+cross-claims or counter-claims.
312+
313+9. Miscellaneous
314+----------------
315+
316+This License represents the complete agreement concerning the subject
317+matter hereof. If any provision of this License is held to be
318+unenforceable, such provision shall be reformed only to the extent
319+necessary to make it enforceable. Any law or regulation which provides
320+that the language of a contract shall be construed against the drafter
321+shall not be used to construe this License against a Contributor.
322+
323+10. Versions of the License
324+---------------------------
325+
326+10.1. New Versions
327+
328+Mozilla Foundation is the license steward. Except as provided in Section
329+10.3, no one other than the license steward has the right to modify or
330+publish new versions of this License. Each version will be given a
331+distinguishing version number.
332+
333+10.2. Effect of New Versions
334+
335+You may distribute the Covered Software under the terms of the version
336+of the License under which You originally received the Covered Software,
337+or under the terms of any subsequent version published by the license
338+steward.
339+
340+10.3. Modified Versions
341+
342+If you create software not governed by this License, and you want to
343+create a new license for such software, you may create and use a
344+modified version of this License if you rename the license and remove
345+any references to the name of the license steward (except to note that
346+such modified license differs from this License).
347+
348+10.4. Distributing Source Code Form that is Incompatible With Secondary
349+Licenses
350+
351+If You choose to distribute Source Code Form that is Incompatible With
352+Secondary Licenses under the terms of this version of the License, the
353+notice described in Exhibit B of this License must be attached.
354+
355+Exhibit A - Source Code Form License Notice
356+-------------------------------------------
357+
358+ This Source Code Form is subject to the terms of the Mozilla Public
359+ License, v. 2.0. If a copy of the MPL was not distributed with this
360+ file, You can obtain one at http://mozilla.org/MPL/2.0/.
361+
362+If it is not possible or desirable to put the notice in a particular
363+file, then You may include the notice in a location (such as a LICENSE
364+file in a relevant directory) where a recipient would be likely to look
365+for such a notice.
366+
367+You may add additional accurate notices of copyright ownership.
368+
369+Exhibit B - "Incompatible With Secondary Licenses" Notice
370+---------------------------------------------------------
371+
372+ This Source Code Form is "Incompatible With Secondary Licenses", as
373+ defined by the Mozilla Public License, v. 2.0.
README.mdnew file+25
@@ -0,0 +1,25 @@
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Ü.
Setup.hsnew file+2
@@ -0,0 +1,2 @@
1+import Distribution.Simple
2+main = defaultMain
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.yamlnew file+55
@@ -0,0 +1,55 @@
1+name: github-app
2+version: 0.0.1
3+synopsis: Authetnicate as a GitHub App
4+description: Please see the README on GitHub at <https://github.com/serokell/github-app#readme>
5+category: Network
6+license: MPL-2.0
7+author: "Serokell"
8+maintainer: "Kirill Elagin <kirelagin@serokell.io>"
9+github: "serokell/github-app"
10+copyright: "2018 Serokell"
11+
12+extra-source-files:
13+ - README.md
14+ - ChangeLog.md
15+
16+default-extensions:
17+ - ApplicativeDo
18+ - DeriveDataTypeable
19+ - DeriveGeneric
20+ - FlexibleContexts
21+ - FlexibleInstances
22+ - GeneralizedNewtypeDeriving
23+ - LambdaCase
24+ - MultiParamTypeClasses
25+ - NamedFieldPuns
26+ - OverloadedStrings
27+ - RankNTypes
28+ - RecordWildCards
29+ - ScopedTypeVariables
30+ - StandaloneDeriving
31+ - TemplateHaskell
32+ - TupleSections
33+ - TypeApplications
34+
35+dependencies:
36+- base >= 4.7 && < 5
37+
38+library:
39+ source-dirs: src
40+ dependencies:
41+ - aeson
42+ - bytestring
43+ - cryptonite
44+ - github
45+ - http-client
46+ - http-client-tls
47+ - http-types
48+ - jwt >= 0.8.0
49+ - mtl
50+ - safe-exceptions
51+ - tagged
52+ - text
53+ - 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.hsnew file+187
@@ -0,0 +1,187 @@
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+{-# LANGUAGE DataKinds #-}
8+
9+module GitHub.App.Auth
10+ ( AppAuth (..)
11+
12+ , InstallationAuth
13+ , mkInstallationAuth
14+
15+ , obtainAccessToken
16+ ) where
17+
18+import Prelude hiding (exp)
19+
20+import Control.Concurrent (MVar, newMVar, putMVar, readMVar, takeMVar)
21+import Control.Exception.Safe (bracketOnError, catch)
22+import Control.Monad.Except (ExceptT, MonadError (throwError), 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
27+import Data.Functor (($>))
28+import Data.Maybe (fromMaybe)
29+import Data.Semigroup ((<>))
30+import Data.Tagged
31+import Data.Text (Text)
32+import qualified Data.Text as T
33+import Data.Text.Encoding (encodeUtf8)
34+import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)
35+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
36+import GitHub.Auth (Auth (OAuth))
37+import GitHub.Data.Apps (App)
38+import GitHub.Data.Definitions (Error (HTTPError))
39+import GitHub.Data.Id (Id, untagId)
40+import GitHub.Data.Installations (Installation)
41+import GitHub.Request (StatusMap, parseResponseJSON)
42+import Network.HTTP.Client as HTTP
43+import qualified Network.HTTP.Client.Internal as HTTP
44+import qualified Network.HTTP.Types as HTTP
45+import Web.JWT (JWTClaimsSet (exp, iat, iss), Signer (RSAPrivateKey), encodeSigned, numericDate,
46+ stringOrURI)
47+
48+
49+-- | JWT expiration time. Maximum accepted by GitHub is 10 minutes
50+jwtExpTime :: NominalDiffTime
51+jwtExpTime = 300
52+
53+-- | Installation access token expiration time. It is fixed by GitHub and is equal to 1 hour
54+instKeyExpTime :: NominalDiffTime
55+instKeyExpTime = 3600
56+
57+-- | When to renew the installation access token
58+--
59+-- We renew the access token when it is valid for less than 'bufferTime'
60+-- just to be on the safe side.
61+bufferTime :: NominalDiffTime
62+bufferTime = instKeyExpTime * 0.25
63+
64+baseUrl :: Text
65+baseUrl = "https://api.github.com"
66+
67+
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
75+data InstallationToken = InstallationToken
76+ { itToken :: !Auth
77+ , itExpirationTime :: !UTCTime
78+ } deriving (Show)
79+
80+instance FromJSON InstallationToken where
81+ parseJSON = withObject "Installation access token" $ \o ->
82+ InstallationToken
83+ <$> (OAuth . encodeUtf8 <$> o .: "token")
84+ <*> o .: "expires_at"
85+
86+
87+-- | Credentials required for an App to authenticate as an installation
88+data InstallationAuth = InstallationAuth
89+ { iaClaimsSet :: !JWTClaimsSet -- ^ Prefilled claims set
90+ , iaAppPrivateKey :: !PrivateKey -- ^ Private key to sign token requests
91+ , iaInstallationId :: !Text -- ^ Installation id
92+ , iaToken :: !(MVar (Maybe InstallationToken)) -- ^ Installation Auth token
93+ }
94+
95+
96+-- | Smart constructor for 'InstallationAuth'
97+mkInstallationAuth
98+ :: AppAuth
99+ -> Id Installation
100+ -> IO InstallationAuth
101+mkInstallationAuth AppAuth{aaAppId, aaPrivateKey} instId = do
102+ varToken <- newMVar Nothing
103+ let issuer = fromMaybe (error "impossible") . stringOrURI . T.pack . show . untagId $ aaAppId
104+ claimsSet = mempty { iss = Just issuer }
105+ pure $ InstallationAuth claimsSet aaPrivateKey (T.pack . show . untagId $ instId) varToken
106+
107+-- | Create a request which, when executed, will obtain a new access token
108+createAccessTokenR :: InstallationAuth -> IO HTTP.Request
109+createAccessTokenR InstallationAuth{..} = do
110+ currentTime <- utcTimeToPOSIXSeconds <$> getCurrentTime
111+ let expiryTime = currentTime + jwtExpTime
112+ claims = iaClaimsSet
113+ { iat = Just $ toJsonTime currentTime
114+ , exp = Just $ toJsonTime expiryTime
115+ }
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")
123+ , ("User-Agent", "github-app/Haskell")
124+ ]
125+ , HTTP.checkResponse = successOrMissing Nothing
126+ , HTTP.method = "POST"
127+ }
128+ where
129+ toJsonTime = fromMaybe (error "impossible") . numericDate
130+ url = baseUrl <> "/installations/" <> iaInstallationId <> "/access_tokens"
131+
132+-- | Get a valid access token
133+--
134+-- Tries to use the cached one. If it is invalid, requests a new one
135+-- and caches it for future use.
136+obtainAccessToken
137+ :: Manager
138+ -> InstallationAuth
139+ -> IO (Either Error Auth)
140+obtainAccessToken mgr ia@InstallationAuth{..} = readMVar iaToken >>= \case
141+ Nothing -> renew
142+ Just InstallationToken{itToken, itExpirationTime} -> do
143+ currentTime <- getCurrentTime
144+ if itExpirationTime `diffUTCTime` currentTime < bufferTime
145+ then renew
146+ else pure $ Right itToken
147+ where
148+ renew :: IO (Either Error Auth)
149+ renew = bracketOnError (takeMVar iaToken) (putMVar iaToken) $ \_ -> do
150+ req <- createAccessTokenR ia
151+ result <- runExceptT $ httpLbs' req >>= parseResponseJSON
152+ case result of
153+ Right newToken -> putMVar iaToken (Just newToken) $> Right (itToken newToken)
154+ Left err -> putMVar iaToken Nothing $> Left err
155+
156+ httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString)
157+ httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException
158+
159+
160+
161+---------------------------------------
162+-- Copy-pasted from the github package
163+---------------------------------------
164+
165+#if MIN_VERSION_http_client(0,5,0)
166+successOrMissing :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Response HTTP.BodyReader -> IO ()
167+successOrMissing sm _req res
168+ | check = pure ()
169+ | otherwise = do
170+ chunk <- HTTP.brReadSome (HTTP.responseBody res) 1024
171+ let res' = fmap (const ()) res
172+ HTTP.throwHttp $ HTTP.StatusCodeException res' (LBS.toStrict chunk)
173+ where
174+ HTTP.Status sci _ = HTTP.responseStatus res
175+#else
176+successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> HTTP.CookieJar -> Maybe E.SomeException
177+successOrMissing sm s@(Status sci _) hs cookiejar
178+ | check = Nothing
179+ | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar
180+ where
181+#endif
182+ check = case sm of
183+ Nothing -> 200 <= sci && sci < 300
184+ Just sm' -> sci `elem` map fst sm'
185+
186+onHttpException :: MonadError Error m => HttpException -> m a
187+onHttpException = throwError . HTTPError
src/GitHub/App/Request.hsnew file+40
@@ -0,0 +1,40 @@
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.App.Request
9+ ( executeAppRequest
10+ , executeAppRequestWithMgr
11+ ) where
12+
13+import Data.Aeson (FromJSON)
14+import GitHub.Data (Error (..))
15+import GitHub.Data.Request (Request)
16+import GitHub.Request (executeRequestWithMgr)
17+import Network.HTTP.Client (Manager)
18+import Network.HTTP.Client.TLS (newTlsManager)
19+
20+import GitHub.App.Auth (InstallationAuth, obtainAccessToken)
21+
22+
23+executeAppRequest :: FromJSON a => InstallationAuth -> Request k a -> IO (Either Error a)
24+executeAppRequest instAuth req = do
25+ manager <- newTlsManager
26+ x <- executeAppRequestWithMgr manager instAuth req
27+#if !MIN_VERSION_http_client(0, 4, 18)
28+ closeManager manager
29+#endif
30+ pure x
31+
32+executeAppRequestWithMgr
33+ :: FromJSON a
34+ => Manager
35+ -> InstallationAuth
36+ -> Request k a
37+ -> IO (Either Error a)
38+executeAppRequestWithMgr mgr instAuth req = obtainAccessToken mgr instAuth >>= \case
39+ Right auth -> executeRequestWithMgr mgr auth req
40+ Left err -> pure $ Left err
src/GitHub/Data/Apps.hsnew file+31
@@ -0,0 +1,31 @@
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.hsnew file+34
@@ -0,0 +1,34 @@
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.yamlnew file+11
@@ -0,0 +1,11 @@
1+resolver: lts-14.19
2+
3+packages:
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:
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
test/Spec.hsnew file+2
@@ -0,0 +1,2 @@
1+main :: IO ()
2+main = putStrLn "Test suite not yet implemented"