@@ -27,6 +27,7 @@ import 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,12 +113,13 @@ 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
120120 { HTTP.requestHeaders =
121121 [ ("Authorization", "Bearer " <> encodeUtf8 jwt)
122+ , ("Accept", "application/vnd.github.machine-man-preview+json")
122123 , ("User-Agent", "github-app/Haskell")
123124 ]
124125 , HTTP.checkResponse = successOrMissing Nothing
@@ -147,7 +148,7 @@ obtainAccessToken mgr ia@InstallationAuth{..} = readMVar iaToken >>= \case
147148 renew :: IO (Either Error Auth)
148149 renew = bracketOnError (takeMVar iaToken) (putMVar iaToken) $ \_ -> do
149150 req <- createAccessTokenR ia
150− result <- runExceptT $ httpLbs' req >>= parseResponse
151+ result <- runExceptT $ httpLbs' req >>= parseResponseJSON
151152 case result of
152153 Right newToken -> putMVar iaToken (Just newToken) $> Right (itToken newToken)
153154 Left err -> putMVar iaToken Nothing $> Left err