{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Utils.Github
( showGithubException,
githubAPILimitErrorText,
githubNotFoundErrorText,
)
where
import Data.Aeson (FromJSON, ToJSON, decode)
import Data.ByteString.Char8 (ByteString)
import Data.ByteString.Lazy (fromStrict)
import Data.Text (Text, isPrefixOf)
import GHC.Generics (Generic)
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Req as Req
import Network.HTTP.Types (Status (..))
import PyF (fmt)
import Utils.Req (showHTTPException, showRawResponse)
newtype GithubError
= GithubError
{ message :: Text
}
deriving stock (Generic, Show)
deriving anyclass (FromJSON, ToJSON)
showGithubException ::
Req.HttpException ->
Text
showGithubException = showHTTPException handleGithubException
handleGithubException ::
Client.Response () ->
ByteString ->
Text
handleGithubException resp body =
case statusCode (Client.responseStatus resp) of
400 -> tryShowNiceErr
404 -> githubNotFoundErrorText
403 -> tryShowNiceErr
_ -> showRawResponse resp body
where
err = decode $ fromStrict body :: Maybe GithubError
tryShowNiceErr = case err of
Just githubError -> showRawGithubMessage githubError
Nothing -> showRawResponse resp body
showRawGithubMessage ::
GithubError ->
Text
showRawGithubMessage err
| isApiRateLimitError msg = githubAPILimitErrorText
| otherwise = [fmt|From Github: {msg}|]
where
msg = message err
githubNotFoundErrorText :: Text
githubNotFoundErrorText =
[fmt|\
Could not find the indicated url.
It's possible that you have mistyped the URL
If not, this URL likely points to a private repository and you need to be authenticated to query its issues.
You might want to provide a github API key with the --issuetracker-githubkey option.
See https://github.com/guibou/krank/blob/master/docs/Checkers/IssueTracker.md#private-repositories|]
githubAPILimitErrorText :: Text
githubAPILimitErrorText =
[fmt|\
Github API Rate limit exceeded.
You might want to provide a github API key with the --issuetracker-githubkey option.
See https://github.com/guibou/krank/blob/master/docs/Checkers/IssueTracker.md#api-rate-limitation|]
apiRateLimitPrefix :: Text
apiRateLimitPrefix = "API rate limit exceeded"
isApiRateLimitError ::
Text ->
Bool
isApiRateLimitError = isPrefixOf apiRateLimitPrefix