@@ -7,23 +7,24 @@
77{-# LANGUAGE DataKinds #-}
88
99module GitHub.App.Auth
10− ( InstallationAuth
10+ ( AppAuth
11+
12+ , InstallationAuth
1113 , mkInstallationAuth
1214
1315 , obtainAccessToken
14−
15− , AppId
16− , InstallationId
1716 ) where
1817
1918import Prelude hiding (exp)
2019
2120import Control.Concurrent (MVar, newMVar, putMVar, readMVar, takeMVar)
2221import Control.Exception.Safe (bracketOnError, catch)
23−import Control.Monad.Except (MonadError (throwError), ExceptT, runExceptT)
24−import Data.Functor (($>))
22+import Control.Monad.Except (ExceptT, MonadError (throwError), runExceptT)
23+import Control.Monad.Trans (lift)
2524import Crypto.Types.PubKey.RSA (PrivateKey)
2625import Data.Aeson (FromJSON (..), withObject, (.:))
26+import qualified Data.ByteString.Lazy as LBS
27+import Data.Functor (($>))
2728import Data.Maybe (fromMaybe)
2829import Data.Semigroup ((<>))
2930import Data.Text (Text)
@@ -31,18 +32,18 @@ import qualified Data.Text as T
3132import Data.Text.Encoding (encodeUtf8)
3233import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)
3334import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
34−import Control.Monad.Trans (lift)
35−import Data.Word (Word64)
3635import GitHub.Auth (Auth (OAuth))
36+import GitHub.Data.Apps (App)
3737import GitHub.Data.Definitions (Error (HTTPError))
38+import GitHub.Data.Id (Id, untagId)
39+import GitHub.Data.Installations (Installation)
3840import GitHub.Data.Request (StatusMap)
3941import GitHub.Request (parseResponse)
40−import Web.JWT (JWTClaimsSet (exp, iat, iss), Signer (RSAPrivateKey), encodeSigned,
41− numericDate, stringOrURI)
4242import Network.HTTP.Client as HTTP
4343import qualified Network.HTTP.Client.Internal as HTTP
4444import qualified Network.HTTP.Types as HTTP
45−import qualified Data.ByteString.Lazy as LBS
45+import Web.JWT (JWTClaimsSet (exp, iat, iss), Signer (RSAPrivateKey), encodeSigned, numericDate,
46+ stringOrURI)
4647
4748
4849-- | JWT expiration time. Maximum accepted by GitHub is 10 minutes
@@ -64,10 +65,16 @@ baseUrl :: Text
6465baseUrl = "https://api.github.com"
6566
6667
68+-- | Credentials of a GitHub App
69+data AppAuth = AppAuth
70+ { aaAppId :: !(Id App)
71+ , aaPrivateKey :: !PrivateKey
72+ }
73+
6774-- | Cached GitHub installation access token
6875data InstallationToken = InstallationToken
69− { itToken :: Auth
70− , itExpirationTime :: UTCTime
76+ { itToken :: !Auth
77+ , itExpirationTime :: !UTCTime
7178 } deriving (Show)
7279
7380instance FromJSON InstallationToken where
@@ -77,7 +84,7 @@ instance FromJSON InstallationToken where
7784 <*> o .: "expires_at"
7885
7986
80−-- | Credentials required for an app to authenticate as an installation
87+-- | Credentials required for an App to authenticate as an installation
8188data InstallationAuth = InstallationAuth
8289 { iaClaimsSet :: !JWTClaimsSet -- ^ Prefilled claims set
8390 , iaAppPrivateKey :: !PrivateKey -- ^ Private key to sign token requests
@@ -86,20 +93,16 @@ data InstallationAuth = InstallationAuth
8693 }
8794
8895
89−type AppId = Word64
90−type InstallationId = Word64
91−
9296-- | Smart constructor for 'InstallationAuth'
9397mkInstallationAuth
94− :: AppId -- ^ GitHub App ID
95− -> PrivateKey -- ^ GitHub App Private Key
96− -> InstallationId -- ^ Installation ID
98+ :: AppAuth
99+ -> Id Installation
97100 -> IO InstallationAuth
98−mkInstallationAuth appId pk instId = do
101+mkInstallationAuth AppAuth{aaAppId, aaPrivateKey} instId = do
99102 varToken <- newMVar Nothing
100− let issuer = fromMaybe (error "impossible") . stringOrURI . T.pack . show $ appId
103+ let issuer = fromMaybe (error "impossible") . stringOrURI . T.pack . show . untagId $ aaAppId
101104 claimsSet = mempty { iss = Just issuer }
102− pure $ InstallationAuth claimsSet pk (T.pack . show $ instId) varToken
105+ pure $ InstallationAuth claimsSet aaPrivateKey (T.pack . show . untagId $ instId) varToken
103106
104107-- | Create a request which, when executed, will obtain a new access token
105108createAccessTokenR :: InstallationAuth -> IO HTTP.Request