diff --git a/.gitignore b/.gitignore index dacd475..470320d 100644 --- a/.gitignore +++ b/.gitignore @@ -3,4 +3,5 @@ cabal.project.local cabal.project.local~ .ghc.environment.* -*.cabal + +.stack-work diff --git a/github-app.cabal b/github-app.cabal new file mode 100644 index 0000000..31be0f1 --- /dev/null +++ b/github-app.cabal @@ -0,0 +1,74 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.38.1. +-- +-- see: https://github.com/sol/hpack + +name: github-app +version: 0.0.1 +synopsis: Authetnicate as a GitHub App +description: Please see the README on GitHub at +category: Network +homepage: https://github.com/serokell/github-app#readme +bug-reports: https://github.com/serokell/github-app/issues +author: Serokell +maintainer: Kirill Elagin +copyright: 2018 Serokell +license: MPL-2.0 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/serokell/github-app + +library + exposed-modules: + Crypto.PubKey.RSA.Read + GitHub.App.Auth + GitHub.App.Request + GitHub.Data.Apps + GitHub.Data.Installations + other-modules: + Paths_github_app + hs-source-dirs: + src + default-extensions: + ApplicativeDo + DeriveDataTypeable + DeriveGeneric + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + LambdaCase + MultiParamTypeClasses + NamedFieldPuns + OverloadedStrings + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TemplateHaskell + TupleSections + TypeApplications + build-depends: + aeson + , base >=4.7 && <5 + , bytestring + , cryptonite + , github + , http-client + , http-client-tls + , http-types + , jwt >=0.8.0 + , mtl + , safe-exceptions + , tagged + , text + , time + , x509 + , x509-store + default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index c0a07d4..d72ec93 100644 --- a/package.yaml +++ b/package.yaml @@ -48,6 +48,7 @@ library: - jwt >= 0.8.0 - mtl - safe-exceptions + - tagged - text - time - x509 diff --git a/src/GitHub/App/Auth.hs b/src/GitHub/App/Auth.hs index e89f424..5d99313 100644 --- a/src/GitHub/App/Auth.hs +++ b/src/GitHub/App/Auth.hs @@ -27,6 +27,7 @@ import qualified Data.ByteString.Lazy as LBS import Data.Functor (($>)) import Data.Maybe (fromMaybe) import Data.Semigroup ((<>)) +import Data.Tagged import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) @@ -37,8 +38,7 @@ import GitHub.Data.Apps (App) import GitHub.Data.Definitions (Error (HTTPError)) import GitHub.Data.Id (Id, untagId) import GitHub.Data.Installations (Installation) -import GitHub.Data.Request (StatusMap) -import GitHub.Request (parseResponse) +import GitHub.Request (StatusMap, parseResponseJSON) import Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP import qualified Network.HTTP.Types as HTTP @@ -113,7 +113,7 @@ createAccessTokenR InstallationAuth{..} = do { iat = Just $ toJsonTime currentTime , exp = Just $ toJsonTime expiryTime } - jwt = encodeSigned (RSAPrivateKey iaAppPrivateKey) claims + jwt = encodeSigned (RSAPrivateKey iaAppPrivateKey) mempty claims req <- HTTP.parseRequest . T.unpack $ url pure req @@ -148,7 +148,7 @@ obtainAccessToken mgr ia@InstallationAuth{..} = readMVar iaToken >>= \case renew :: IO (Either Error Auth) renew = bracketOnError (takeMVar iaToken) (putMVar iaToken) $ \_ -> do req <- createAccessTokenR ia - result <- runExceptT $ httpLbs' req >>= parseResponse + result <- runExceptT $ httpLbs' req >>= parseResponseJSON case result of Right newToken -> putMVar iaToken (Just newToken) $> Right (itToken newToken) Left err -> putMVar iaToken Nothing $> Left err diff --git a/src/GitHub/App/Request.hs b/src/GitHub/App/Request.hs index 8832307..d4d8e06 100644 --- a/src/GitHub/App/Request.hs +++ b/src/GitHub/App/Request.hs @@ -10,6 +10,7 @@ module GitHub.App.Request , executeAppRequestWithMgr ) where +import Data.Aeson (FromJSON) import GitHub.Data (Error (..)) import GitHub.Data.Request (Request) import GitHub.Request (executeRequestWithMgr) @@ -19,7 +20,7 @@ import Network.HTTP.Client.TLS (newTlsManager) import GitHub.App.Auth (InstallationAuth, obtainAccessToken) -executeAppRequest :: InstallationAuth -> Request k a -> IO (Either Error a) +executeAppRequest :: FromJSON a => InstallationAuth -> Request k a -> IO (Either Error a) executeAppRequest instAuth req = do manager <- newTlsManager x <- executeAppRequestWithMgr manager instAuth req @@ -29,7 +30,8 @@ executeAppRequest instAuth req = do pure x executeAppRequestWithMgr - :: Manager + :: FromJSON a + => Manager -> InstallationAuth -> Request k a -> IO (Either Error a) diff --git a/stack.yaml b/stack.yaml index 570edc4..fcf7ead 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,9 +1,11 @@ -resolver: lts-11.5 +resolver: lts-14.19 packages: - . # Dependency packages to be pulled from upstream that are not in the resolver # using the same syntax as the packages field. # (e.g., acme-missiles-0.3) -extra-deps: - - jwt-0.8.0 \ No newline at end of file +extra-deps: + - github-0.24 + - binary-instances-1 + # - jwt-0.8.0 diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..167e34f --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,26 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/topics/lock_files + +packages: +- completed: + hackage: github-0.24@sha256:4bf5a06289d36f78bf347b6a4f9906f659be7335cde78386a6c95568714a730b,6955 + pantry-tree: + sha256: e0f84d7a3cdd76c6bd5395c8c72d24a1dda9616f857291820b08947c8290f042 + size: 7105 + original: + hackage: github-0.24 +- completed: + hackage: binary-instances-1@sha256:b17565598b8df3241f9b46fa8e3a3368ecc8e3f2eb175d7c28f319042a6f5c79,2613 + pantry-tree: + sha256: 938ffc6990cac12681c657f7afa93737eecf335e6f0212d8c0b7c1ea3e0f40f4 + size: 1035 + original: + hackage: binary-instances-1 +snapshots: +- completed: + sha256: 9f79f6494473c9b46911364b94c4b5ef19ca8d35ebf62e46697cf651f198ee19 + size: 524155 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/19.yaml + original: lts-14.19