{-# OPTIONS -Wno-ambiguous-fields #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Test.EJPD
  ( testEJPDRequest,
    testEJPDRequestRemote,
  )
where

import API.Brig
import qualified API.BrigInternal as BI
import API.Galley
import API.Gundeck
import Control.Lens hiding ((.=))
import Control.Monad.Reader
import qualified Data.Aeson as A
import Data.Aeson.Lens
import Data.String.Conversions (cs)
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUID
import qualified Network.Wreq as Wreq
import SetupHelpers
import Testlib.JSON
import Testlib.Prelude

-- | Create some teams & users, and return their expected ejpd response values.
setupEJPD :: (HasCallStack) => App (A.Value, A.Value, A.Value, A.Value, A.Value)
setupEJPD =
  do
    (owner1, tid1, [usr1, usr2]) <- createTeam OwnDomain 3
    handle1 <- liftIO $ UUID.nextRandom <&> ("usr1-handle-" <>) . UUID.toString
    handle2 <- liftIO $ UUID.nextRandom <&> ("usr2-handle-" <>) . UUID.toString
    owner1Handle <- liftIO $ UUID.nextRandom <&> ("owner1-handle-" <>) . UUID.toString
    void $ putHandle usr1 handle1
    void $ putHandle usr2 handle2
    void $ putHandle owner1 owner1Handle
    email3 <- liftIO $ UUID.nextRandom <&> \uuid -> "usr3-" <> UUID.toString uuid <> "@example.com"
    email4 <- liftIO $ UUID.nextRandom <&> \uuid -> "usr4-" <> UUID.toString uuid <> "@example.com"
    email5 <- liftIO $ UUID.nextRandom <&> \uuid -> "usr5-" <> UUID.toString uuid <> "@example.com"
    usr3 <- randomUser OwnDomain def {BI.email = Just email3, BI.name = Just "usr3"}
    usr4 <- randomUser OwnDomain def {BI.email = Just email4, BI.name = Just "usr4"}
    usr5 <- randomUser OwnDomain def {BI.email = Just email5, BI.name = Just "usr5"}
    usrRemote <- randomUser OtherDomain def {BI.email = Nothing, BI.name = Just "usrRemote"}
    handle3 <- liftIO $ UUID.nextRandom <&> ("usr3-handle-" <>) . UUID.toString
    handle4 <- liftIO $ UUID.nextRandom <&> ("usr4-handle-" <>) . UUID.toString
    handle5 <- liftIO $ UUID.nextRandom <&> ("usr5-handle-" <>) . UUID.toString
    void $ putHandle usr3 handle3
    void $ putHandle usr4 handle4
    void $ putHandle usr5 handle5

    connectTwoUsers usr3 usr5
    connectUsers [usr2, usr4, usr5, usrRemote]

    toks1 <- do
      cl11 <- objId $ addClient (usr1 %. "qualified_id") def >>= getJSON 201
      bindResponse (generateAndPostPushToken usr1 cl11 def) $ \resp -> do
        resp.status `shouldMatchInt` 201
        tok <- resp.json %. "token" & asString
        pure [tok]
    toks2 <- do
      cl21 <- objId $ addClient (usr2 %. "qualified_id") def >>= getJSON 201
      cl22 <- objId $ addClient (usr2 %. "qualified_id") def >>= getJSON 201
      t1 <- bindResponse (generateAndPostPushToken usr2 cl21 def) $ \resp -> do
        resp.status `shouldMatchInt` 201
        resp.json %. "token" & asString
      t2 <- bindResponse (generateAndPostPushToken usr2 cl22 def) $ \resp -> do
        resp.status `shouldMatchInt` 201
        resp.json %. "token" & asString
      pure [t1, t2]
    toks4 <- do
      cl41 <- objId $ addClient (usr4 %. "qualified_id") def >>= getJSON 201
      bindResponse (generateAndPostPushToken usr4 cl41 def) $ \resp -> do
        resp.status `shouldMatchInt` 201
        tok <- resp.json %. "token" & asString
        pure [tok]

    assets1 <- do
      a1 <- uploadDownloadProfilePicture usr1
      a2 <- uploadDownloadProfilePicture usr1
      pure $ snd <$> [a1, a2]
    assets2 <- (: []) . snd <$> uploadDownloadProfilePicture usr2
    assets3 <- (: []) . snd <$> uploadDownloadProfilePicture usr3
    assets4 <- (: []) . snd <$> uploadDownloadProfilePicture usr4

    (convs1, convs2, convs3, convs4, convs5) <- do
      let parse :: Response -> App Value
          parse resp =
            getJSON 201 resp <&> \val ->
              object
                [ "conv_name" .= do val ^?! key (fromString "name") . _String,
                  "conv_id" .= do val ^?! key (fromString "qualified_id") . _Object
                ]

      conv1 <-
        parse
          =<< postConversation usr1 do
            defMLS {name = Just "11", qualifiedUsers = [], team = Just tid1}
      conv12 <-
        parse
          =<< postConversation usr1 do
            defProteus {name = Just "12", qualifiedUsers = [usr2], team = Just tid1}
      conv35 <-
        parse
          =<< postConversation
            usr3
            do defProteus {name = Just "35", qualifiedUsers = [usr5]}
      conv524 <-
        parse
          =<< postConversation usr5 do
            defProteus {name = Just "524", qualifiedUsers = [usr2, usr4]}
      pure (Just ([conv1, conv12]), Just ([conv12, conv524]), Just [conv35], Just [conv524], Just [conv35, conv524])

    assertSuccess =<< postConversation usrRemote do
      defProteus {name = Just "remote245", qualifiedUsers = [usr2, usr4, usr5]}

    let usr2contacts = Just $ (,"accepted") <$> [ejpd4, ejpd5]
        usr3contacts = Just $ (,"accepted") <$> [ejpd5]
        usr4contacts = Just $ (,"accepted") <$> [ejpd2, ejpd5]
        usr5contacts = Just $ (,"accepted") <$> [ejpd2, ejpd3, ejpd4]

        ejpd0 = mkUsr owner1 (Just owner1Handle) [] Nothing (Just ([ejpd1, ejpd2], "list_complete")) Nothing Nothing
        ejpd1 = mkUsr usr1 (Just handle1) toks1 Nothing (Just ([ejpd0, ejpd2], "list_complete")) convs1 (Just assets1)
        ejpd2 = mkUsr usr2 (Just handle2) toks2 usr2contacts (Just ([ejpd0, ejpd1], "list_complete")) convs2 (Just assets2)
        ejpd3 = mkUsr usr3 (Just handle3) [] usr3contacts Nothing convs3 (Just assets3)
        ejpd4 = mkUsr usr4 (Just handle4) toks4 usr4contacts Nothing convs4 (Just assets4)
        ejpd5 = mkUsr usr5 (Just handle5) [] usr5contacts Nothing convs5 Nothing

    pure (ejpd1, ejpd2, ejpd3, ejpd4, ejpd5)
  where
    -- Return value is a 'EJPDResponseItem'.
    mkUsr ::
      (HasCallStack) =>
      A.Value {- user -} ->
      Maybe String {- handle (in case usr is not up to date, we pass this separately) -} ->
      [String {- push tokens -}] ->
      -- contacts
      Maybe [(A.Value {- ejpd response item of contact -}, String {- relation -})] ->
      -- team contacts
      Maybe ([A.Value {- ejpd response item -}], String {- pagination flag -}) ->
      -- conversations
      Maybe [A.Value] ->
      Maybe [String {- asset url -}] ->
      A.Value
    mkUsr usr hdl toks contacts teamContacts convs assets = result
      where
        result =
          object
            [ -- (We know we have "id", but using ^? instead of ^. avoids the need for a Monoid instance for Value.)
              "UserId" .= (usr ^? key (fromString "qualified_id")),
              "TeamId" .= (usr ^? key (fromString "team")),
              "Name" .= (usr ^? key (fromString "name")),
              "Handle" .= hdl,
              "Email" .= (usr ^? key (fromString "email")),
              "Phone" .= (usr ^? key (fromString "phone")),
              "PushTokens" .= toks,
              "Contacts"
                .= let f (item, relation) = object ["contact_item" .= item, "contact_relation" .= relation]
                    in (map (f . trimContact _1) <$> contacts),
              "TeamContacts"
                .= ( teamContacts
                       & maybe
                         Null
                         ( \(tcs, ltyp) ->
                             object
                               [ "TeamContacts" .= (trimContact id <$> tcs),
                                 "ListType" .= ltyp
                               ]
                         )
                   ),
              "Conversations" .= convs,
              "Assets" .= assets
            ]

    trimContact :: forall x. Lens' x A.Value -> x -> x
    trimContact lns =
      lns %~ \case
        trimmable@(A.Object _) -> trimItem trimmable
        other -> error $ show other

    trimItem :: A.Value -> A.Value
    trimItem =
      (key (fromString "Contacts") .~ A.Null)
        . (key (fromString "TeamContacts") .~ A.Null)
        . (key (fromString "Conversations") .~ A.Null)

testEJPDRequest :: (HasCallStack) => App ()
testEJPDRequest = do
  (usr1, usr2, usr3, usr4, usr5) <- setupEJPD

  let check :: (HasCallStack) => [A.Value] -> App ()
      check want = do
        let handle = cs . (^?! (key (fromString "Handle") . _String))
        have <- BI.getEJPDInfo OwnDomain (handle <$> want) "include_contacts"
        have.json `shouldMatchSpecial` object ["EJPDResponse" .= want]

      shouldMatchSpecial :: (MakesValue a, MakesValue b, HasCallStack) => a -> b -> App ()
      shouldMatchSpecial = shouldMatchWithRules [minBound ..] resolveAssetLinks

      -- query params and even the uuid in the path of asset urls may differ between actual
      -- and expected value because they are re-generated non-deterministically.  so we fetch
      -- the actual content.
      resolveAssetLinks :: A.Value -> App (Maybe A.Value)
      resolveAssetLinks = \case
        (A.String (cs -> url)) | isProbablyAssetUrl url -> (Just . toJSON) <$> fetchIt url
        _ -> pure Nothing
        where
          isProbablyAssetUrl :: String -> Bool
          isProbablyAssetUrl url = all (`isInfixOf` url) ["http", "://", "/dummy-bucket/v3/persistent/"]

          fetchIt :: String -> App String
          fetchIt url = liftIO $ (cs . view Wreq.responseBody) <$> Wreq.get url

  check [usr1]
  check [usr2]
  check [usr3]
  check [usr4, usr5]

testEJPDRequestRemote :: (HasCallStack) => App ()
testEJPDRequestRemote = do
  usrRemote <- randomUser OtherDomain def {BI.email = Nothing, BI.name = Just "usrRemote"}
  handleRemote <- liftIO $ UUID.nextRandom <&> UUID.toString
  assertSuccess =<< putHandle usrRemote handleRemote

  have <- BI.getEJPDInfo OwnDomain [handleRemote] "include_contacts"
  shouldBeEmpty $ have.json %. "EJPDResponse"
