{-# OPTIONS_GHC -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.ChannelSearch where

import API.Galley
import qualified API.GalleyInternal as I
import MLS.Util
import SetupHelpers
import Testlib.Prelude
import Text.Printf

getPostgresMigration :: App Value
getPostgresMigration :: App Value
getPostgresMigration = do
  cfg <- Service -> App Value
readServiceConfig Service
Galley
  cfg %. "postgresMigration"

testChannelSearch :: App ()
testChannelSearch :: App ()
testChannelSearch = do
  mig <- App Value
getPostgresMigration App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  when (mig == "postgresql") $ do
    (alice, tid, [bob, charlie]) <- createTeam OwnDomain 3
    [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
    dee <- randomUser OwnDomain def
    traverse_ (uploadNewKeyPackage def) [bob1, charlie1]
    I.setTeamFeatureLockStatus alice tid "channels" "unlocked"
    I.setTeamFeatureConfig alice tid "channels" (config "everyone") >>= assertSuccess

    -- unnamed channel
    unnamed <-
      postConversation
        alice1
        defMLS
          { groupConvType = Just "channel",
            team = Just tid
          }
        >>= getJSON 201
    void $ do
      convId <- objConvId unnamed
      createGroup def alice1 convId
      let update = [String
"access" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([String
"link"] :: [String]), String
"access_role" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"team_member"]]
      void
        $ createAddCommit alice1 convId [bob, charlie]
        >>= sendAndConsumeCommitBundle
      void $ updateAccess alice convId update >>= getJSON 200

    -- named channels
    named <- for [0 :: Int .. 20] $ \Int
i ->
      ClientIdentity -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation
        ClientIdentity
alice1
        CreateConv
defMLS
          { groupConvType = Just "channel",
            team = Just tid,
            name = Just ("foo" <> printf "%02d" i)
          }
        App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201

    -- regular group conversations (should be ignored)
    void $ postConversation alice1 defProteus {team = Just tid} >>= getJSON 201

    -- search channels, default parameters
    bindResponse (searchChannels alice tid def) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      results <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      length results `shouldMatchInt` 15

      results %. "0.id" `shouldMatch` (unnamed %. "qualified_id.id")
      results %. "0.member_count" `shouldMatchInt` 3
      results %. "0.admin_count" `shouldMatchInt` 1
      results %. "0.access" `shouldMatch` ["link"]
      lookupField results "0.name" `shouldMatch` (Nothing :: Maybe Value)

      results %. "1.id" `shouldMatch` (last named %. "qualified_id.id")
      results %. "1.name" `shouldMatch` "foo20"
      results %. "1.member_count" `shouldMatchInt` 1
      results %. "1.admin_count" `shouldMatchInt` 1
      results %. "1.access" `shouldMatch` ["invite"]

    -- smaller page, ascending
    (lastName, lastId) <- bindResponse
      ( searchChannels
          alice
          tid
          def
            { sortOrder = Just "asc",
              pageSize = Just 5
            }
      )
      $ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        results <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
        length results `shouldMatchInt` 5
        for_ (zip results named) $ \(Value
actual, Value
expected) ->
          Value
actual Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
expected Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id")
        lastName <- last results %. "name" & asString
        lastId <- last results %. "id" & asString
        pure (lastName, lastId)

    -- next page
    bindResponse
      ( searchChannels
          alice
          tid
          def
            { sortOrder = Just "asc",
              pageSize = Just 5,
              lastName = Just lastName,
              lastId = Just lastId
            }
      )
      $ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        results <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
        length results `shouldMatchInt` 5
        for_ (zip results (drop 5 named)) $ \(Value
actual, Value
expected) ->
          Value
actual Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
expected Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id")

    -- public channels
    bindResponse (searchChannels bob tid def {discoverable = True})
      $ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        results <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
        length results `shouldMatchInt` 1
        head results %. "id" `shouldMatch` (unnamed %. "qualified_id.id")
    bindResponse (searchChannels bob tid def) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    bindResponse (searchChannels dee tid def {discoverable = True}) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403

testChannelSearchSortCaseInsensitive :: App ()
testChannelSearchSortCaseInsensitive :: App ()
testChannelSearchSortCaseInsensitive = do
  mig <- App Value
getPostgresMigration App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  when (mig == "postgresql") $ do
    (alice, tid, _) <- createTeam OwnDomain 1
    I.setTeamFeatureLockStatus alice tid "channels" "unlocked"
    I.setTeamFeatureConfig alice tid "channels" (config "everyone") >>= assertSuccess

    let names =
          [ String
"apple",
            String
"Banana",
            String
"grape",
            String
"Orange",
            String
"pear",
            String
"Peach",
            String
"cherry",
            String
"Mango",
            String
"kiwi",
            String
"Apricot"
          ]
        channelConf String
name =
          CreateConv
defMLS
            { groupConvType = Just "channel",
              team = Just tid,
              skipCreator = Just True,
              name = Just name
            }
    for_ names $ \String
name -> Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (String -> CreateConv
channelConf String
name) App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    let namesSorted = (String -> String) -> [String] -> [String]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) [String]
names
    bindResponse (searchChannels alice tid def {sortOrder = Just "asc"}) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      results <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      length results `shouldMatchInt` 10
      for_ (zip results namesSorted) $ \(Value
result, String
expectedName) -> do
        Value
result Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
expectedName

    bindResponse (searchChannels alice tid def {sortOrder = Just "desc"}) $ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      results <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"page" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      length results `shouldMatchInt` 10
      for_ (zip results (reverse namesSorted)) $ \(Value
result, String
expectedName) -> do
        Value
result Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
expectedName

config :: String -> Value
config :: String -> Value
config String
perms =
  [Pair] -> Value
object
    [ String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled",
      String
"config"
        String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
          [ String
"allowed_to_create_channels" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
perms,
            String
"allowed_to_open_channels" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
perms
          ]
    ]