{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

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

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

handleGitlabException ::
  Client.Response () ->
  ByteString ->
  Text
handleGitlabException :: Response () -> ByteString -> Text
handleGitlabException Response ()
resp ByteString
body =
  case Status -> Int
statusCode (forall body. Response body -> Status
Client.responseStatus Response ()
resp) of
    Int
400 -> Text
tryShowNiceErr
    Int
404 -> Text
gitlabNotFoundErrorText
    Int
403 -> Text
tryShowNiceErr
    Int
_ -> Response () -> ByteString -> Text
showRawResponse Response ()
resp ByteString
body
  where
    err :: Maybe GitlabError
err = forall a. FromJSON a => ByteString -> Maybe a
decode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict ByteString
body :: Maybe GitlabError
    tryShowNiceErr :: Text
tryShowNiceErr = case Maybe GitlabError
err of
      Just GitlabError
gitlabError -> GitlabError -> Text
showRawGitlabMessage GitlabError
gitlabError
      Maybe GitlabError
Nothing -> Response () -> ByteString -> Text
showRawResponse Response ()
resp ByteString
body

showRawGitlabMessage ::
  GitlabError ->
  Text
showRawGitlabMessage :: GitlabError -> Text
showRawGitlabMessage GitlabError
err
  | Text -> Bool
isApiRateLimitError Text
msg = Text
gitlabAPILimitErrorText
  | Bool
otherwise = [fmt|From Gitlab: {msg}|]
  where
    msg :: Text
msg = GitlabError -> Text
message GitlabError
err

gitlabNotFoundErrorText :: Text
gitlabNotFoundErrorText :: Text
gitlabNotFoundErrorText =
  [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 gitlab API key with the --issuetracker-gitlabhost option.
See https://github.com/guibou/krank/blob/master/docs/Checkers/IssueTracker.md#gitlab|]

gitlabAPILimitErrorText :: Text
gitlabAPILimitErrorText :: Text
gitlabAPILimitErrorText =
  [fmt|\
Gitlab API Rate limit exceeded.
You might want to provide a gitlab API key with the --issuetracker-gitlabhost option.
See https://github.com/guibou/krank/blob/master/docs/Checkers/IssueTracker.md#gitlab|]

apiRateLimitPrefix :: Text
apiRateLimitPrefix :: Text
apiRateLimitPrefix = Text
"API rate limit exceeded"

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