content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  -- This file is part of the Wire Server implementation.
  --
  -- Copyright (C) 2022 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.Galley.Mapping where
  
  import Data.Containers.ListUtils (nubOrdOn)
  import Data.Domain
  import Data.Id
  import Data.Qualified
  import Data.Set qualified as Set
  import Galley.API.Error (InternalError)
  import Galley.API.Mapping
  import Imports
  import Polysemy (Sem)
  import Polysemy qualified as P
  import Polysemy.Error qualified as P
  import Polysemy.TinyLog qualified as P
  import Test.Tasty
  import Test.Tasty.QuickCheck
  import Wire.API.Conversation
  import Wire.API.Conversation.Protocol
  import Wire.API.Conversation.Role
  import Wire.API.Federation.API.Galley
    ( RemoteConvMembers (..),
      RemoteConversationV2 (..),
    )
  import Wire.Sem.Logger qualified as P
  import Wire.StoredConversation
  
  run :: Sem '[P.TinyLog, P.Error InternalError] a -> Either InternalError a
  run = P.run . P.runError . P.discardLogs
  
  tests :: TestTree
  tests =
    testGroup
      "ConversationMapping"
      [ testProperty "conversation view V9 for a valid user is non-empty" $
          \(ConvWithLocalUser c luid) -> isRight (run (conversationViewV9 luid c)),
        testProperty "conversation view V10 for a valid user is non-empty" $
          \(ConvWithLocalUser c luid) -> isRight (run (pure $ conversationView (qualifyAs luid ()) (Just luid) c)),
        testProperty "self user in conversation view is correct" $
          \(ConvWithLocalUser c luid) ->
            fmap (memId . cmSelf . cnvMembers) (run (conversationViewV9 luid c))
              == Right (tUntagged luid),
        testProperty "conversation view metadata is correct" $
          \(ConvWithLocalUser c luid) ->
            fmap cnvMetadata (run (conversationViewV9 luid c))
              == Right c.metadata,
        testProperty "other members in conversation view do not contain self" $
          \(ConvWithLocalUser c luid) -> case run $ conversationViewV9 luid c of
            Left _ -> False
            Right cnv ->
              tUntagged luid
                `notElem` map omQualifiedId (cmOthers (cnvMembers cnv)),
        testProperty "conversation view contains all users" $
          \(ConvWithLocalUser c luid) ->
            fmap (sort . cnvUids) (run (conversationViewV9 luid c))
              == Right (sort (convUids (tDomain luid) c)),
        testProperty "conversation view for an invalid user is empty" $
          \(RandomConversation c) luid ->
            notElem (tUnqualified luid) (map (.id_) c.localMembers) ==>
              isLeft (run (conversationViewV9 luid c)),
        testProperty "remote conversation view for a valid user is non-empty" $
          \(ConvWithRemoteUser c ruid) dom ->
            qDomain (tUntagged ruid) /= dom ==>
              isJust (conversationToRemote dom ruid c),
        testProperty "self user role in remote conversation view is correct" $
          \(ConvWithRemoteUser c ruid) dom ->
            qDomain (tUntagged ruid) /= dom ==>
              fmap (selfRole . (.members)) (conversationToRemote dom ruid c)
                == Just roleNameWireMember,
        testProperty "remote conversation view metadata is correct" $
          \(ConvWithRemoteUser c ruid) dom ->
            qDomain (tUntagged ruid) /= dom ==>
              fmap (.metadata) (conversationToRemote dom ruid c)
                == Just c.metadata,
        testProperty "remote conversation view does not contain self" $
          \(ConvWithRemoteUser c ruid) dom -> case conversationToRemote dom ruid c of
            Nothing -> False
            Just rcnv ->
              tUntagged ruid
                `notElem` map omQualifiedId rcnv.members.others
      ]
  
  cnvUids :: OwnConversation -> [Qualified UserId]
  cnvUids c =
    let mems = cnvMembers c
     in memId (cmSelf mems)
          : map omQualifiedId (cmOthers mems)
  
  convUids :: Domain -> StoredConversation -> [Qualified UserId]
  convUids dom c =
    map ((`Qualified` dom) . (.id_)) c.localMembers
      <> map (tUntagged . (.id_)) c.remoteMembers
  
  genLocalMember :: Gen LocalMember
  genLocalMember =
    LocalMember
      <$> arbitrary
      <*> pure defMemberStatus
      <*> pure Nothing
      <*> arbitrary
  
  genRemoteMember :: Gen RemoteMember
  genRemoteMember = RemoteMember <$> arbitrary <*> pure roleNameWireMember
  
  genConversation :: Gen StoredConversation
  genConversation =
    StoredConversation
      <$> arbitrary
      <*> listOf genLocalMember
      <*> listOf genRemoteMember
      <*> genConversationMetadata
      <*> pure ProtocolProteus
  
  genConversationMetadata :: Gen ConversationMetadata
  genConversationMetadata =
    ConversationMetadata RegularConv
      <$> arbitrary
      <*> pure []
      <*> pure (Set.fromList [TeamMemberAccessRole, NonTeamMemberAccessRole])
      <*> arbitrary
      <*> pure Nothing
      <*> pure Nothing
      <*> pure Nothing
      <*> arbitrary
      <*> arbitrary
      <*> arbitrary
      <*> arbitrary
  
  newtype RandomConversation = RandomConversation
    {unRandomConversation :: StoredConversation}
    deriving (Show)
  
  instance Arbitrary RandomConversation where
    arbitrary = RandomConversation <$> genConversation
  
  data ConvWithLocalUser = ConvWithLocalUser StoredConversation (Local UserId)
    deriving (Show)
  
  instance Arbitrary ConvWithLocalUser where
    arbitrary = do
      member <- genLocalMember
      ConvWithLocalUser <$> genConv member <*> genLocal member.id_
      where
        genLocal :: x -> Gen (Local x)
        genLocal v = flip toLocalUnsafe v <$> arbitrary
        genConv m = uniqueMembers m . unRandomConversation <$> arbitrary
        uniqueMembers :: LocalMember -> StoredConversation -> StoredConversation
        uniqueMembers m c =
          c {localMembers = nubOrdOn (.id_) (m : c.localMembers)}
  
  data ConvWithRemoteUser = ConvWithRemoteUser StoredConversation (Remote UserId)
    deriving (Show)
  
  instance Arbitrary ConvWithRemoteUser where
    arbitrary = do
      member <- genRemoteMember
      ConvWithRemoteUser <$> genConv member <*> pure member.id_
      where
        genConv m = uniqueMembers m . unRandomConversation <$> arbitrary
        uniqueMembers :: RemoteMember -> StoredConversation -> StoredConversation
        uniqueMembers m c =
          c {remoteMembers = nubOrdOn (.id_) (m : c.remoteMembers)}
  