{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PostfixOperators #-}

module Bots.DirectoryTests where

import ChatClient
import ChatTests.Utils
import Control.Concurrent (forkIO, killThread, threadDelay)
import Control.Exception (finally)
import Directory.Options
import Directory.Service
import Directory.Store
import Simplex.Chat.Bot.KnownContacts
import Simplex.Chat.Core
import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..))
import Simplex.Chat.Types (Profile (..), GroupMemberRole (GROwner))
import System.FilePath ((</>))
import Test.Hspec

directoryServiceTests :: SpecWith FilePath
directoryServiceTests = do
  it "should register group" testDirectoryService
  describe "de-listing the group" $ do
    it "should de-list if owner leaves the group" testDelistedOwnerLeaves
    it "should de-list if owner is removed from the group" testDelistedOwnerRemoved
    it "should NOT de-list if another member leaves the group" testNotDelistedMemberLeaves
    it "should NOT de-list if another member is removed from the group" testNotDelistedMemberRemoved
    it "should de-list if service is removed from the group" testDelistedServiceRemoved
  describe "should require re-approval if profile is changed by" $ do
    it "the registration owner" testRegOwnerChangedProfile
    it "another owner" testAnotherOwnerChangedProfile
  describe "should require profile update if group link is removed by " $ do
    it "the registration owner" testRegOwnerRemovedLink
    it "another owner" testAnotherOwnerRemovedLink

directoryProfile :: Profile
directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}

mkDirectoryOpts :: FilePath -> [KnownContact] -> DirectoryOpts
mkDirectoryOpts tmp superUsers =
  DirectoryOpts
    { coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp </> serviceDbPrefix},
      superUsers,
      directoryLog = tmp </> "directory_service.log",
      serviceName = "SimpleX-Directory"
    }

serviceDbPrefix :: FilePath
serviceDbPrefix = "directory_service"

testDirectoryService :: HasCallStack => FilePath -> IO ()
testDirectoryService tmp =
  withDirectoryService tmp $ \superUser dsLink ->
    withNewTestChat tmp "bob" bobProfile $ \bob ->
      withNewTestChat tmp "cath" cathProfile $ \cath -> do
        bob `connectVia` dsLink
        bob #> "@SimpleX-Directory privacy"
        bob <# "SimpleX-Directory> > privacy"
        bob <## "      No groups found"
        putStrLn "*** create a group"
        bob ##> "/g PSA Privacy, Security & Anonymity"
        bob <## "group #PSA (Privacy, Security & Anonymity) is created"
        bob <## "to add members use /a PSA <name> or /create link #PSA"
        bob ##> "/a PSA SimpleX-Directory member"
        bob <## "invitation to join the group #PSA sent to SimpleX-Directory"
        bob <# "SimpleX-Directory> You must grant directory service admin role to register the group"
        bob ##> "/mr PSA SimpleX-Directory admin"
        putStrLn "*** discover service joins group and creates the link for profile"
        bob <## "#PSA: you changed the role of SimpleX-Directory from member to admin"
        bob <# "SimpleX-Directory> Joining the group #PSA…"
        bob <## "#PSA: SimpleX-Directory joined the group"
        bob <# "SimpleX-Directory> Joined the group #PSA, creating the link…"
        bob <# "SimpleX-Directory> Created the public link to join the group via this directory service that is always online."
        bob <## ""
        bob <## "Please add it to the group welcome message."
        bob <## "For example, add:"
        welcomeWithLink <- dropStrPrefix "SimpleX-Directory> " . dropTime <$> getTermLine bob
        putStrLn "*** update profile without link"
        updateGroupProfile bob "Welcome!"
        bob <# "SimpleX-Directory> The profile updated for ID 1 (PSA), but the group link is not added to the welcome message."
        (superUser </)
        putStrLn "*** update profile so that it has link"
        updateGroupProfile bob welcomeWithLink
        bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (PSA) is added to the welcome message."
        bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
        approvalRequested superUser welcomeWithLink (1 :: Int)
        putStrLn "*** update profile so that it still has link"
        let welcomeWithLink' = "Welcome! " <> welcomeWithLink
        updateGroupProfile bob welcomeWithLink'
        bob <# "SimpleX-Directory> The group ID 1 (PSA) is updated!"
        bob <## "It is hidden from the directory until approved."
        superUser <# "SimpleX-Directory> The group ID 1 (PSA) is updated."
        approvalRequested superUser welcomeWithLink' (2 :: Int)
        putStrLn "*** try approving with the old registration code"
        superUser #> "@SimpleX-Directory /approve 1:PSA 1"
        superUser <# "SimpleX-Directory> > /approve 1:PSA 1"
        superUser <## "      Incorrect approval code"
        putStrLn "*** update profile so that it has no link"
        updateGroupProfile bob "Welcome!"
        bob <# "SimpleX-Directory> The group link for ID 1 (PSA) is removed from the welcome message."
        bob <## ""
        bob <## "The group is hidden from the directory until the group link is added and the group is re-approved."
        superUser <# "SimpleX-Directory> The group link is removed from ID 1 (PSA), de-listed."
        superUser #> "@SimpleX-Directory /approve 1:PSA 2"
        superUser <# "SimpleX-Directory> > /approve 1:PSA 2"
        superUser <## "      Error: the group ID 1 (PSA) is not pending approval."
        putStrLn "*** update profile so that it has link again"
        updateGroupProfile bob welcomeWithLink'
        bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (PSA) is added to the welcome message."
        bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
        approvalRequested superUser welcomeWithLink' (1 :: Int)
        superUser #> "@SimpleX-Directory /approve 1:PSA 1"
        superUser <# "SimpleX-Directory> > /approve 1:PSA 1"
        superUser <## "      Group approved!"
        bob <# "SimpleX-Directory> The group ID 1 (PSA) is approved and listed in directory!"
        bob <## "Please note: if you change the group profile it will be hidden from directory until it is re-approved."
        search bob "privacy" welcomeWithLink'
        search bob "security" welcomeWithLink'
        cath `connectVia` dsLink
        search cath "privacy" welcomeWithLink'
  where
    search u s welcome = do
      u #> ("@SimpleX-Directory " <> s)
      u <# ("SimpleX-Directory> > " <> s)
      u <## "      Found 1 group(s)"
      u <# "SimpleX-Directory> PSA (Privacy, Security & Anonymity)"
      u <## "Welcome message:"
      u <## welcome
    updateGroupProfile u welcome = do
      u ##> ("/set welcome #PSA " <> welcome)
      u <## "description changed to:"
      u <## welcome
    approvalRequested su welcome grId = do
      su <# "SimpleX-Directory> bob submitted the group ID 1: PSA (Privacy, Security & Anonymity)"
      su <## "Welcome message:"
      su <## welcome
      su <## ""
      su <## "To approve send:"
      su <# ("SimpleX-Directory> /approve 1:PSA " <> show grId)

testDelistedOwnerLeaves :: HasCallStack => FilePath -> IO ()
testDelistedOwnerLeaves tmp =
  withDirectoryService tmp $ \superUser dsLink ->
    withNewTestChat tmp "bob" bobProfile $ \bob -> do
      withNewTestChat tmp "cath" cathProfile $ \cath -> do
        bob `connectVia` dsLink
        registerGroup superUser bob "privacy" "Privacy"
        addCathAsOwner bob cath
        leaveGroup "privacy" bob
        cath <## "#privacy: bob left the group"
        bob <# "SimpleX-Directory> You left the group ID 1 (privacy)."
        bob <## ""
        bob <## "Group is no longer listed in the directory."
        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner left)."
        groupNotFound cath "privacy"

testDelistedOwnerRemoved :: HasCallStack => FilePath -> IO ()
testDelistedOwnerRemoved tmp =
  withDirectoryService tmp $ \superUser dsLink ->
    withNewTestChat tmp "bob" bobProfile $ \bob ->
      withNewTestChat tmp "cath" cathProfile $ \cath -> do
        bob `connectVia` dsLink
        registerGroup superUser bob "privacy" "Privacy"
        addCathAsOwner bob cath
        removeMember "privacy" cath bob
        bob <# "SimpleX-Directory> You are removed from the group ID 1 (privacy)."
        bob <## ""
        bob <## "Group is no longer listed in the directory."
        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner is removed)."
        groupNotFound cath "privacy"

testNotDelistedMemberLeaves :: HasCallStack => FilePath -> IO ()
testNotDelistedMemberLeaves tmp =
  withDirectoryService tmp $ \superUser dsLink ->
    withNewTestChat tmp "bob" bobProfile $ \bob -> do
      withNewTestChat tmp "cath" cathProfile $ \cath -> do
        bob `connectVia` dsLink
        registerGroup superUser bob "privacy" "Privacy"
        addCathAsOwner bob cath
        leaveGroup "privacy" cath
        bob <## "#privacy: cath left the group"
        (superUser </)
        groupFound cath "privacy"

testNotDelistedMemberRemoved :: HasCallStack => FilePath -> IO ()
testNotDelistedMemberRemoved tmp = 
  withDirectoryService tmp $ \superUser dsLink ->
    withNewTestChat tmp "bob" bobProfile $ \bob -> do
      withNewTestChat tmp "cath" cathProfile $ \cath -> do
        bob `connectVia` dsLink
        registerGroup superUser bob "privacy" "Privacy"
        addCathAsOwner bob cath
        removeMember "privacy" bob cath
        (superUser </)
        groupFound cath "privacy"

testDelistedServiceRemoved :: HasCallStack => FilePath -> IO ()
testDelistedServiceRemoved tmp =
  withDirectoryService tmp $ \superUser dsLink ->
    withNewTestChat tmp "bob" bobProfile $ \bob -> do
      withNewTestChat tmp "cath" cathProfile $ \cath -> do
        bob `connectVia` dsLink
        registerGroup superUser bob "privacy" "Privacy"
        addCathAsOwner bob cath
        bob ##> "/rm #privacy SimpleX-Directory"
        bob <## "#privacy: you removed SimpleX-Directory from the group"
        cath <## "#privacy: bob removed SimpleX-Directory from the group"
        bob <# "SimpleX-Directory> SimpleX-Directory is removed from the group ID 1 (privacy)."
        bob <## ""
        bob <## "Group is no longer listed in the directory."
        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (directory service is removed)."
        groupNotFound cath "privacy"

testRegOwnerChangedProfile :: HasCallStack => FilePath -> IO ()
testRegOwnerChangedProfile tmp =
  withDirectoryService tmp $ \superUser dsLink ->
    withNewTestChat tmp "bob" bobProfile $ \bob -> do
      withNewTestChat tmp "cath" cathProfile $ \cath -> do
        bob `connectVia` dsLink
        registerGroup superUser bob "privacy" "Privacy"
        addCathAsOwner bob cath
        bob ##> "/gp privacy privacy Privacy and Security"
        bob <## "full name changed to: Privacy and Security"
        bob <# "SimpleX-Directory> The group ID 1 (privacy) is updated!"
        bob <## "It is hidden from the directory until approved."
        cath <## "bob updated group #privacy:"
        cath <## "full name changed to: Privacy and Security"
        groupNotFound cath "privacy"
        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is updated."
        reapproveGroup superUser bob
        groupFound cath "privacy"

testAnotherOwnerChangedProfile :: HasCallStack => FilePath -> IO ()
testAnotherOwnerChangedProfile tmp =
  withDirectoryService tmp $ \superUser dsLink ->
    withNewTestChat tmp "bob" bobProfile $ \bob -> do
      withNewTestChat tmp "cath" cathProfile $ \cath -> do
        bob `connectVia` dsLink
        registerGroup superUser bob "privacy" "Privacy"
        addCathAsOwner bob cath
        cath ##> "/gp privacy privacy Privacy and Security"
        cath <## "full name changed to: Privacy and Security"
        bob <## "cath updated group #privacy:"
        bob <## "full name changed to: Privacy and Security"
        bob <# "SimpleX-Directory> The group ID 1 (privacy) is updated!"
        bob <## "It is hidden from the directory until approved."
        groupNotFound cath "privacy"
        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is updated."
        reapproveGroup superUser bob
        groupFound cath "privacy"

testRegOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
testRegOwnerRemovedLink tmp =
  withDirectoryService tmp $ \superUser dsLink ->
  withNewTestChat tmp "bob" bobProfile $ \bob -> do
    withNewTestChat tmp "cath" cathProfile $ \cath -> do
      bob `connectVia` dsLink
      registerGroup superUser bob "privacy" "Privacy"
      addCathAsOwner bob cath
      bob ##> "/show welcome #privacy"
      bob <## "Welcome message:"
      welcomeWithLink <- getTermLine bob
      bob ##> "/set welcome #privacy Welcome!"
      bob <## "description changed to:"
      bob <## "Welcome!"
      bob <# "SimpleX-Directory> The group link for ID 1 (privacy) is removed from the welcome message."
      bob <## ""
      bob <## "The group is hidden from the directory until the group link is added and the group is re-approved."
      cath <## "bob updated group #privacy:"
      cath <## "description changed to:"
      cath <## "Welcome!"
      superUser <# "SimpleX-Directory> The group link is removed from ID 1 (privacy), de-listed."
      groupNotFound cath "privacy"
      bob ##> ("/set welcome #privacy " <> welcomeWithLink)
      bob <## "description changed to:"
      bob <## welcomeWithLink
      bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (privacy) is added to the welcome message."
      bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
      cath <## "bob updated group #privacy:"
      cath <## "description changed to:"
      cath <## welcomeWithLink
      reapproveGroup superUser bob
      groupFound cath "privacy"

testAnotherOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
testAnotherOwnerRemovedLink tmp =
  withDirectoryService tmp $ \superUser dsLink ->
  withNewTestChat tmp "bob" bobProfile $ \bob -> do
    withNewTestChat tmp "cath" cathProfile $ \cath -> do
      bob `connectVia` dsLink
      registerGroup superUser bob "privacy" "Privacy"
      addCathAsOwner bob cath
      bob ##> "/show welcome #privacy"
      bob <## "Welcome message:"
      welcomeWithLink <- getTermLine bob
      cath ##> "/set welcome #privacy Welcome!"
      cath <## "description changed to:"
      cath <## "Welcome!"
      bob <## "cath updated group #privacy:"
      bob <## "description changed to:"
      bob <## "Welcome!"
      bob <# "SimpleX-Directory> The group link for ID 1 (privacy) is removed from the welcome message."
      bob <## ""
      bob <## "The group is hidden from the directory until the group link is added and the group is re-approved."
      superUser <# "SimpleX-Directory> The group link is removed from ID 1 (privacy), de-listed."
      groupNotFound cath "privacy"
      cath ##> ("/set welcome #privacy " <> welcomeWithLink)
      cath <## "description changed to:"
      cath <## welcomeWithLink
      bob <## "cath updated group #privacy:"
      bob <## "description changed to:"
      bob <## welcomeWithLink
      bob <# "SimpleX-Directory> The group link is added by another group member, your registration will not be processed."
      bob <## ""
      bob <## "Please update the group profile yourself."
      bob ##> ("/set welcome #privacy " <> welcomeWithLink <> " - welcome!")
      bob <## "description changed to:"
      bob <## (welcomeWithLink <> " - welcome!")
      bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (privacy) is added to the welcome message."
      bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
      cath <## "bob updated group #privacy:"
      cath <## "description changed to:"
      cath <## (welcomeWithLink <> " - welcome!")
      reapproveGroup superUser bob
      groupFound cath "privacy"

reapproveGroup :: HasCallStack => TestCC -> TestCC -> IO ()
reapproveGroup superUser bob = do
  superUser <#. "SimpleX-Directory> bob submitted the group ID 1: privacy ("
  superUser <## "Welcome message:"
  superUser <##. "Link to join the group privacy: "
  superUser <## ""
  superUser <## "To approve send:"
  superUser <# "SimpleX-Directory> /approve 1:privacy 1"
  superUser #> "@SimpleX-Directory /approve 1:privacy 1"
  superUser <# "SimpleX-Directory> > /approve 1:privacy 1"
  superUser <## "      Group approved!"
  bob <# "SimpleX-Directory> The group ID 1 (privacy) is approved and listed in directory!"
  bob <## "Please note: if you change the group profile it will be hidden from directory until it is re-approved."

addCathAsOwner :: HasCallStack => TestCC -> TestCC -> IO ()
addCathAsOwner bob cath = do
  connectUsers bob cath
  fullAddMember "privacy" "Privacy" bob cath GROwner
  joinGroup "privacy" cath bob
  cath <## "#privacy: member SimpleX-Directory is connected"

withDirectoryService :: HasCallStack => FilePath -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryService tmp test = do
  dsLink <-
    withNewTestChat tmp serviceDbPrefix directoryProfile $ \ds ->
      withNewTestChat tmp "super_user" aliceProfile $ \superUser -> do
        connectUsers ds superUser
        ds ##> "/ad"
        getContactLink ds True
  let opts = mkDirectoryOpts tmp [KnownContact 2 "alice"]
  withDirectory opts $
    withTestChat tmp "super_user" $ \superUser -> do
      superUser <## "1 contacts connected (use /cs for the list)"
      test superUser dsLink
  where
    withDirectory :: DirectoryOpts -> IO () -> IO ()
    withDirectory opts@DirectoryOpts {directoryLog} action = do
      st <- getDirectoryStore directoryLog
      t <- forkIO $ bot st
      threadDelay 500000
      action `finally` killThread t
      where
        bot st = simplexChatCore testCfg (mkChatOpts opts) Nothing $ directoryService st opts

registerGroup :: TestCC -> TestCC -> String -> String -> IO ()
registerGroup su u n fn = do
  u ##> ("/g " <> n <> " " <> fn)
  u <## ("group #" <> n <> " (" <> fn <> ") is created")
  u <## ("to add members use /a " <> n <> " <name> or /create link #" <> n)
  u ##> ("/a " <> n <> " SimpleX-Directory admin")
  u <## ("invitation to join the group #" <> n <> " sent to SimpleX-Directory")
  u <# ("SimpleX-Directory> Joining the group #" <> n <> "…")
  u <## ("#" <> n <> ": SimpleX-Directory joined the group")
  u <# ("SimpleX-Directory> Joined the group #" <> n <> ", creating the link…")
  u <# "SimpleX-Directory> Created the public link to join the group via this directory service that is always online."
  u <## ""
  u <## "Please add it to the group welcome message."
  u <## "For example, add:"
  welcomeWithLink <- dropStrPrefix "SimpleX-Directory> " . dropTime <$> getTermLine u
  u ##> ("/set welcome " <> n <> " " <> welcomeWithLink)
  u <## "description changed to:"
  u <## welcomeWithLink
  u <# ("SimpleX-Directory> Thank you! The group link for ID 1 (" <> n <> ") is added to the welcome message.")
  u <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
  su <# ("SimpleX-Directory> bob submitted the group ID 1: " <> n <> " (" <> fn <> ")")
  su <## "Welcome message:"
  su <## welcomeWithLink
  su <## ""
  su <## "To approve send:"
  let approve = "/approve 1:" <> n <> " 1"
  su <# ("SimpleX-Directory> " <> approve)
  su #> ("@SimpleX-Directory " <> approve)
  su <# ("SimpleX-Directory> > " <> approve)
  su <## "      Group approved!"
  u <# ("SimpleX-Directory> The group ID 1 (" <> n <> ") is approved and listed in directory!")
  u <## "Please note: if you change the group profile it will be hidden from directory until it is re-approved."

connectVia :: TestCC -> String -> IO ()
u `connectVia` dsLink = do
  u ##> ("/c " <> dsLink)
  u <## "connection request sent!"
  u <## "SimpleX-Directory: contact is connected"
  u <# "SimpleX-Directory> Welcome to SimpleX-Directory service!"
  u <## "Send a search string to find groups or /help to learn how to add groups to directory."
  u <## ""
  u <## "For example, send privacy to find groups about privacy."

joinGroup :: String -> TestCC -> TestCC -> IO ()
joinGroup gName member host = do
  let gn = "#" <> gName
  memberName <- userName member
  hostName <- userName host
  member ##> ("/j " <> gName)
  member <## (gn <> ": you joined the group")
  member <#. (gn <> " " <> hostName <> "> Link to join the group " <> gName <> ": ")
  host <## (gn <> ": " <> memberName <> " joined the group")

leaveGroup :: String -> TestCC -> IO ()
leaveGroup gName member = do
  let gn = "#" <> gName
  member ##> ("/l " <> gName)
  member <## (gn <> ": you left the group")
  member <## ("use /d " <> gn <> " to delete the group")

removeMember :: String -> TestCC -> TestCC -> IO ()
removeMember gName admin removed = do
  let gn = "#" <> gName
  adminName <- userName admin
  removedName <- userName removed
  admin ##> ("/rm " <> gName <> " " <> removedName)
  admin <## (gn <> ": you removed " <> removedName <> " from the group")
  removed <## (gn <> ": " <> adminName <> " removed you from the group")
  removed <## ("use /d " <> gn <> " to delete the group")

groupFound :: TestCC -> String -> IO ()
groupFound u s = do
  u #> ("@SimpleX-Directory " <> s)
  u <# ("SimpleX-Directory> > " <> s)
  u <## "      Found 1 group(s)"
  u <#. "SimpleX-Directory> privacy ("
  u <## "Welcome message:"
  u <##. "Link to join the group privacy: "

groupNotFound :: TestCC -> String -> IO ()
groupNotFound u s = do
  u #> ("@SimpleX-Directory " <> s)
  u <# ("SimpleX-Directory> > " <> s)
  u <## "      No groups found"