module Bot.Gitea
  ( GiteaClient
  , newGiteaClient
  , getCurrentUser
  , getPrInfo
  , getPrDiff
  , getIssueComments
  , getPrReviews
  , createComment
  , updateComment
  , postReview
  , PrInfo (..)
  , GiteaComment (..)
  , GiteaReview (..)
  , InlineComment (..)
  ) where

import Data.Aeson
import Data.Aeson.Types (parseMaybe)
import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Time (UTCTime)
import Network.HTTP.Client
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types.Status (statusCode)

import Bot.Config (Config (..))

data GiteaClient = GiteaClient
  { gcManager :: Manager
  , gcBaseUrl :: Text   -- e.g. "https://gitea.example.com/api/v1"
  , gcToken   :: Text
  , gcOwner   :: Text
  , gcRepo    :: Text
  }

newGiteaClient :: Config -> IO GiteaClient
newGiteaClient cfg = do
  mgr <- newManager tlsManagerSettings
  pure GiteaClient
    { gcManager = mgr
    , gcBaseUrl = cfgGiteaUrl cfg <> "/api/v1"
    , gcToken   = cfgGiteaToken cfg
    , gcOwner   = cfgRepoOwner cfg
    , gcRepo    = cfgRepoName cfg
    }

-- Helpers

repoPath :: GiteaClient -> Text
repoPath gc = "/repos/" <> gcOwner gc <> "/" <> gcRepo gc

apiGet :: FromJSON a => GiteaClient -> Text -> IO a
apiGet gc path = do
  let url = T.unpack (gcBaseUrl gc <> path)
  req <- parseRequest url
  let req' = req
        { requestHeaders =
            [ ("Authorization", "token " <> TE.encodeUtf8 (gcToken gc))
            , ("Accept", "application/json")
            ]
        }
  resp <- httpLbs req' (gcManager gc)
  case eitherDecode (responseBody resp) of
    Right v  -> pure v
    Left err -> fail $ "API GET " <> url <> " decode error: " <> err

apiGetText :: GiteaClient -> Text -> IO Text
apiGetText gc path = do
  let url = T.unpack (gcBaseUrl gc <> path)
  req <- parseRequest url
  let req' = req
        { requestHeaders =
            [ ("Authorization", "token " <> TE.encodeUtf8 (gcToken gc))
            , ("Accept", "text/plain")
            ]
        }
  resp <- httpLbs req' (gcManager gc)
  pure $ TE.decodeUtf8 $ BL.toStrict $ responseBody resp

apiPost :: FromJSON a => GiteaClient -> Text -> Value -> IO a
apiPost gc path body = do
  let url = T.unpack (gcBaseUrl gc <> path)
  initReq <- parseRequest url
  let req = initReq
        { method = "POST"
        , requestHeaders =
            [ ("Authorization", "token " <> TE.encodeUtf8 (gcToken gc))
            , ("Accept", "application/json")
            , ("Content-Type", "application/json")
            ]
        , requestBody = RequestBodyLBS (encode body)
        }
  resp <- httpLbs req (gcManager gc)
  case eitherDecode (responseBody resp) of
    Right v  -> pure v
    Left err -> fail $ "API POST " <> url <> " decode error: " <> err
      <> "\nStatus: " <> show (statusCode $ responseStatus resp)
      <> "\nBody: " <> show (BL.toStrict $ responseBody resp)

apiPatch :: GiteaClient -> Text -> Value -> IO ()
apiPatch gc path body = do
  let url = T.unpack (gcBaseUrl gc <> path)
  initReq <- parseRequest url
  let req = initReq
        { method = "PATCH"
        , requestHeaders =
            [ ("Authorization", "token " <> TE.encodeUtf8 (gcToken gc))
            , ("Accept", "application/json")
            , ("Content-Type", "application/json")
            ]
        , requestBody = RequestBodyLBS (encode body)
        }
  resp <- httpLbs req (gcManager gc)
  let sc = statusCode (responseStatus resp)
  if sc >= 200 && sc < 300
    then pure ()
    else fail $ "API PATCH " <> url <> " failed with status " <> show sc
      <> ": " <> BS.unpack (BL.toStrict $ responseBody resp)

apiPostRaw :: GiteaClient -> Text -> Value -> IO (Int, BL.ByteString)
apiPostRaw gc path body = do
  let url = T.unpack (gcBaseUrl gc <> path)
  initReq <- parseRequest url
  let req = initReq
        { method = "POST"
        , requestHeaders =
            [ ("Authorization", "token " <> TE.encodeUtf8 (gcToken gc))
            , ("Accept", "application/json")
            , ("Content-Type", "application/json")
            ]
        , requestBody = RequestBodyLBS (encode body)
        }
  resp <- httpLbs req (gcManager gc)
  pure (statusCode $ responseStatus resp, responseBody resp)

-- API operations

getCurrentUser :: GiteaClient -> IO Text
getCurrentUser gc = do
  v <- apiGet gc "/user" :: IO Value
  case parseMaybe parseLogin v of
    Just login -> pure login
    Nothing    -> fail "GET /user: missing login field"
  where
    parseLogin = withObject "User" $ \o -> o .: "login"

data PrInfo = PrInfo
  { piTitle :: Text
  , piBody  :: Maybe Text
  , piUser  :: Text
  , piHead  :: Text
  , piBase  :: Text
  }

instance FromJSON PrInfo where
  parseJSON = withObject "PrInfo" $ \o -> do
    title <- o .: "title"
    body  <- o .:? "body"
    user  <- o .: "user" >>= (.: "login")
    head_ <- o .: "head" >>= (.: "label")
    base  <- o .: "base" >>= (.: "label")
    pure PrInfo
      { piTitle = title
      , piBody  = body
      , piUser  = user
      , piHead  = head_
      , piBase  = base
      }

getPrInfo :: GiteaClient -> Int -> IO PrInfo
getPrInfo gc n =
  apiGet gc (repoPath gc <> "/pulls/" <> T.pack (show n))

getPrDiff :: GiteaClient -> Int -> IO Text
getPrDiff gc n =
  apiGetText gc (repoPath gc <> "/pulls/" <> T.pack (show n) <> ".diff")

data GiteaComment = GiteaComment
  { gcBody      :: Text
  , gcUser      :: Text
  , gcCreatedAt :: UTCTime
  }

instance FromJSON GiteaComment where
  parseJSON = withObject "GiteaComment" $ \o -> do
    body      <- o .: "body"
    user      <- o .: "user" >>= (.: "login")
    createdAt <- o .: "created_at"
    pure GiteaComment
      { gcBody      = body
      , gcUser      = user
      , gcCreatedAt = createdAt
      }

getIssueComments :: GiteaClient -> Int -> IO [GiteaComment]
getIssueComments gc n =
  apiGet gc (repoPath gc <> "/issues/" <> T.pack (show n) <> "/comments")

data GiteaReview = GiteaReview
  { grBody  :: Maybe Text
  , grUser  :: Text
  , grState :: Text
  }

instance FromJSON GiteaReview where
  parseJSON = withObject "GiteaReview" $ \o -> do
    body  <- o .:? "body"
    user  <- o .: "user" >>= (.: "login")
    state <- o .: "state"
    pure GiteaReview
      { grBody  = body
      , grUser  = user
      , grState = state
      }

getPrReviews :: GiteaClient -> Int -> IO [GiteaReview]
getPrReviews gc n =
  apiGet gc (repoPath gc <> "/pulls/" <> T.pack (show n) <> "/reviews")

-- Returns the comment ID
createComment :: GiteaClient -> Int -> Text -> IO Int
createComment gc n body = do
  let payload = object ["body" .= body]
  v <- apiPost gc (repoPath gc <> "/issues/" <> T.pack (show n) <> "/comments") payload
  case parseMaybe parseId (v :: Value) of
    Just i  -> pure i
    Nothing -> fail "createComment: missing 'id' field"
  where
    parseId = withObject "Comment" $ \o -> o .: "id"

updateComment :: GiteaClient -> Int -> Text -> IO ()
updateComment gc commentId body = do
  let payload = object ["body" .= body]
  apiPatch gc (repoPath gc <> "/issues/comments/" <> T.pack (show commentId)) payload

data InlineComment = InlineComment
  { icPath        :: Text
  , icNewPosition :: Int
  , icBody        :: Text
  }

postReview :: GiteaClient -> Int -> Text -> [InlineComment] -> IO ()
postReview gc prNum body comments = do
  let commentObjs = map (\ic -> object
        [ "path"         .= icPath ic
        , "new_position" .= icNewPosition ic
        , "body"         .= icBody ic
        ]) comments
      payload = object
        [ "body"     .= body
        , "event"    .= ("COMMENT" :: Text)
        , "comments" .= commentObjs
        ]
  (sc, respBody) <- apiPostRaw gc (repoPath gc <> "/pulls/" <> T.pack (show prNum) <> "/reviews") payload
  if sc >= 200 && sc < 300
    then pure ()
    else fail $ "postReview failed with status " <> show sc
      <> ": " <> BS.unpack (BL.toStrict respBody)