{-# 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)

-- | Represents a typical Github Error serialized as JSON like so:
--
-- @
-- {
--    "message": "the error reason"
-- }
-- @
newtype GithubError
  = GithubError
      { GithubError -> Text
message :: Text
      }
  deriving stock ((forall x. GithubError -> Rep GithubError x)
-> (forall x. Rep GithubError x -> GithubError)
-> Generic GithubError
forall x. Rep GithubError x -> GithubError
forall x. GithubError -> Rep GithubError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GithubError x -> GithubError
$cfrom :: forall x. GithubError -> Rep GithubError x
Generic, Int -> GithubError -> ShowS
[GithubError] -> ShowS
GithubError -> String
(Int -> GithubError -> ShowS)
-> (GithubError -> String)
-> ([GithubError] -> ShowS)
-> Show GithubError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GithubError] -> ShowS
$cshowList :: [GithubError] -> ShowS
show :: GithubError -> String
$cshow :: GithubError -> String
showsPrec :: Int -> GithubError -> ShowS
$cshowsPrec :: Int -> GithubError -> ShowS
Show)
  deriving anyclass (Value -> Parser [GithubError]
Value -> Parser GithubError
(Value -> Parser GithubError)
-> (Value -> Parser [GithubError]) -> FromJSON GithubError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GithubError]
$cparseJSONList :: Value -> Parser [GithubError]
parseJSON :: Value -> Parser GithubError
$cparseJSON :: Value -> Parser GithubError
FromJSON, [GithubError] -> Encoding
[GithubError] -> Value
GithubError -> Encoding
GithubError -> Value
(GithubError -> Value)
-> (GithubError -> Encoding)
-> ([GithubError] -> Value)
-> ([GithubError] -> Encoding)
-> ToJSON GithubError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GithubError] -> Encoding
$ctoEncodingList :: [GithubError] -> Encoding
toJSONList :: [GithubError] -> Value
$ctoJSONList :: [GithubError] -> Value
toEncoding :: GithubError -> Encoding
$ctoEncoding :: GithubError -> Encoding
toJSON :: GithubError -> Value
$ctoJSON :: GithubError -> Value
ToJSON)

-- | Uses the helper to show generic HTTP issues and provides a specific handler for Github
-- "business" exceptions
showGithubException ::
  Req.HttpException ->
  Text
showGithubException :: HttpException -> Text
showGithubException = (Response () -> ByteString -> Text) -> HttpException -> Text
showHTTPException Response () -> ByteString -> Text
handleGithubException

handleGithubException ::
  Client.Response () ->
  ByteString ->
  Text
handleGithubException :: Response () -> ByteString -> Text
handleGithubException Response ()
resp ByteString
body =
  case Status -> Int
statusCode (Response () -> Status
forall body. Response body -> Status
Client.responseStatus Response ()
resp) of
    Int
400 -> Text
tryShowNiceErr
    Int
404 -> Text
githubNotFoundErrorText
    Int
403 -> Text
tryShowNiceErr
    Int
_ -> Response () -> ByteString -> Text
showRawResponse Response ()
resp ByteString
body
  where
    err :: Maybe GithubError
err = ByteString -> Maybe GithubError
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe GithubError)
-> ByteString -> Maybe GithubError
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict ByteString
body :: Maybe GithubError
    tryShowNiceErr :: Text
tryShowNiceErr = case Maybe GithubError
err of
      Just GithubError
githubError -> GithubError -> Text
showRawGithubMessage GithubError
githubError
      Maybe GithubError
Nothing -> Response () -> ByteString -> Text
showRawResponse Response ()
resp ByteString
body

showRawGithubMessage ::
  GithubError ->
  Text
showRawGithubMessage :: GithubError -> Text
showRawGithubMessage GithubError
err
  | Text -> Bool
isApiRateLimitError Text
msg = Text
githubAPILimitErrorText
  | Bool
otherwise = [fmt|From Github: {msg}|]
  where
    msg :: Text
msg = GithubError -> Text
message GithubError
err

githubNotFoundErrorText :: Text
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 :: 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 :: Text
apiRateLimitPrefix = Text
"API rate limit exceeded"

isApiRateLimitError ::
  Text ->
  Bool
isApiRateLimitError :: Text -> Bool
isApiRateLimitError = Text -> Text -> Bool
isPrefixOf Text
apiRateLimitPrefix