-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2023 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.MLS.Unreachable where

import API.Galley
import Control.Monad.Codensity
import Control.Monad.Reader
import MLS.Util
import Notifications
import SetupHelpers
import Testlib.Prelude
import Testlib.ResourcePool

testAddUsersSomeReachable :: (HasCallStack) => App ()
testAddUsersSomeReachable = do
  (addCommit, d) <- startDynamicBackends [mempty] $ \[thirdDomain] -> do
    ownDomain <- make OwnDomain & asString
    otherDomain <- make OtherDomain & asString
    [alice, bob, charlie] <- createAndConnectUsers [ownDomain, otherDomain, thirdDomain]

    [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
    traverse_ (uploadNewKeyPackage def) [bob1, charlie1]
    convId <- createNewGroup def alice1
    void $ withWebSocket bob $ \ws -> do
      void $ createAddCommit alice1 convId [bob] >>= sendAndConsumeCommitBundle
      awaitMatch isMemberJoinNotif ws
    mp <- createAddCommit alice1 convId [charlie]
    pure (mp, thirdDomain)

  -- try adding Charlie now that his backend is unreachable
  bindResponse (postMLSCommitBundle addCommit.sender (mkBundle addCommit)) $ \resp -> do
    resp.status `shouldMatchInt` 533
    (resp.json %. "unreachable_backends" & asList) `shouldMatch` [d]

-- | There is analogous counterpart for Proteus in the 'Test.Conversation' module.
testAddUserWithUnreachableRemoteUsers :: (HasCallStack) => App ()
testAddUserWithUnreachableRemoteUsers = do
  resourcePool <- asks resourcePool
  runCodensity (acquireResources 1 resourcePool) $ \[cDom] -> do
    (alice1, bob, brad, chris, convId) <- runCodensity (startDynamicBackend cDom mempty) $ \_ -> do
      [own, other] <- forM [OwnDomain, OtherDomain] $ asString . make
      [alice, bob, brad, charlie, chris] <-
        createAndConnectUsers [own, other, other, cDom.berDomain, cDom.berDomain]
      [alice1, charlie1, chris1] <-
        traverse (createMLSClient def) [alice, charlie, chris]
      traverse_ (uploadNewKeyPackage def) [charlie1, chris1]
      convId <- createNewGroup def alice1
      void $ withWebSocket charlie $ \ws -> do
        void $ createAddCommit alice1 convId [charlie] >>= sendAndConsumeCommitBundle
        awaitMatch isMemberJoinNotif ws
      pure (alice1, bob, brad, chris, convId)

    [bob1, brad1] <- traverse (createMLSClient def) [bob, brad]
    traverse_ (uploadNewKeyPackage def) [bob1, brad1]

    do
      mp <- createAddCommit alice1 convId [bob]
      bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \resp -> do
        resp.status `shouldMatchInt` 533
        resp.json %. "unreachable_backends" `shouldMatchSet` [cDom.berDomain]

      runCodensity (startDynamicBackend cDom mempty) $ \_ ->
        void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getBody 201

    do
      mp <- createAddCommit alice1 convId [brad]
      void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getBody 201

    do
      mp <- runCodensity (startDynamicBackend cDom mempty) $ \_ ->
        createAddCommit alice1 convId [chris]
      bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \resp -> do
        resp.status `shouldMatchInt` 533
        resp.json %. "unreachable_backends" `shouldMatchSet` [cDom.berDomain]

testAddUnreachableUserFromFederatingBackend :: (HasCallStack) => App ()
testAddUnreachableUserFromFederatingBackend = do
  resourcePool <- asks resourcePool
  runCodensity (acquireResources 1 resourcePool) $ \[cDom] -> do
    mp <- runCodensity (startDynamicBackend cDom mempty) $ \_ -> do
      ownDomain <- make OwnDomain & asString
      otherDomain <- make OtherDomain & asString
      [alice, bob, charlie, chad] <-
        createAndConnectUsers [ownDomain, otherDomain, cDom.berDomain, cDom.berDomain]

      [alice1, bob1, charlie1, chad1] <- traverse (createMLSClient def) [alice, bob, charlie, chad]
      traverse_ (uploadNewKeyPackage def) [bob1, charlie1, chad1]
      convId <- createNewGroup def alice1
      withWebSockets [bob, charlie] $ \wss -> do
        void $ createAddCommit alice1 convId [bob, charlie] >>= sendAndConsumeCommitBundle
        forM_ wss $ awaitMatch isMemberJoinNotif
      createAddCommit alice1 convId [chad]

    bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \resp -> do
      resp.status `shouldMatchInt` 533
      resp.json %. "unreachable_backends" `shouldMatchSet` [cDom.berDomain]
