0bede85 · github-app · git.iko.soy

.gitignore+2

compare with master

unifiedsplit

@@ -4,3 +4,5 @@ cabal.project.local

4cabal.project.local~

5.ghc.environment.*

6*.cabal

7+

8+.stack-work

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+4−4

@@ -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

@@ -113,7 +113,7 @@ 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

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

148 renew :: IO (Either Error Auth)

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

150 req <- createAccessTokenR ia

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

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

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