{- This file is part of Vervis.
 -
 - Written in 2016, 2018, 2019, 2020, 2022, 2023
 - by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Vervis.Actor.Person
    ( personBehavior
    )
where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Data.Bitraversable
import Data.ByteString (ByteString)
import Data.Foldable
import Data.Text (Text)
import Data.Time.Clock
import Data.Traversable
import Database.Persist
import Database.Persist.Sql
import Yesod.Persist.Core

import qualified Data.Text as T

import Control.Concurrent.Actor
import Network.FedURI
import Web.Actor.Persist
import Yesod.MonadSite

import qualified Web.ActivityPub as AP

import Control.Monad.Trans.Except.Local
import Database.Persist.Local

import Vervis.Actor
import Vervis.Actor2
import Vervis.Cloth
import Vervis.Data.Collab
import Vervis.Data.Discussion
import Vervis.FedURI
import Vervis.Federation.Util
import Vervis.Foundation
import Vervis.Model
import Vervis.Recipient (makeRecipientSet, LocalStageBy (..))
import Vervis.Persist.Actor
import Vervis.Persist.Collab
import Vervis.Persist.Discussion
import Vervis.Ticket

------------------------------------------------------------------------------
-- Commenting
------------------------------------------------------------------------------

-- Meaning: Someone commented on an issue/PR
-- Behavior: Insert to inbox
personCreateNote
    :: UTCTime
    -> PersonId
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Note URIMode
    -> ActE (Text, Act (), Next)
personCreateNote now recipPersonID author body mfwd luCreate note = do

    -- Check input
    (luNote, published, Comment maybeParent topic source content) <- do
        (luId, luAuthor, published, comment) <- parseRemoteComment note
        unless (luAuthor == objUriLocal (remoteAuthorURI author)) $
            throwE "Create author != note author"
        return (luId, published, comment)

    mractid <- withDBExcept $ do
        Entity recipActorID recipActor <- lift $ do
            person <- getJust recipPersonID
            let actorID = personActor person
            Entity actorID <$> getJust actorID

        case topic of

            Right uContext -> do
                checkContextParent uContext maybeParent
                lift $ insertToInbox now author body (actorInbox recipActor) luCreate True

            Left (CommentTopicTicket deckID taskID) -> do
                (_, _, Entity _ ticket, _, _) <- do
                    mticket <- lift $ getTicket deckID taskID
                    fromMaybeE mticket "Context: No such deck-ticket"
                let did = ticketDiscuss ticket
                _ <- traverse (getMessageParent did) maybeParent
                lift $ insertToInbox now author body (actorInbox recipActor) luCreate True

            Left (CommentTopicCloth loomID clothID) -> do
                (_, _, Entity _ ticket, _, _, _) <- do
                    mticket <- lift $ getCloth loomID clothID
                    fromMaybeE mticket "Context: No such loom-cloth"
                let did = ticketDiscuss ticket
                _ <- traverse (getMessageParent did) maybeParent
                lift $ insertToInbox now author body (actorInbox recipActor) luCreate True

    done $
        case mractid of
            Nothing -> "I already have this activity in my inbox, doing nothing"
            Just _ -> "Inserted Create{Note} to my inbox"
    where
    checkContextParent (ObjURI hContext luContext) mparent = do
        mdid <- lift $ runMaybeT $ do
            iid <- MaybeT $ getKeyBy $ UniqueInstance hContext
            roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luContext
            rd <- MaybeT $ getValBy $ UniqueRemoteDiscussionIdent roid
            return $ remoteDiscussionDiscuss rd
        for_ mparent $ \ parent ->
            case parent of
                Left msg -> do
                    did <- fromMaybeE mdid "Local parent inexistent, no RemoteDiscussion"
                    void $ getLocalParentMessageId did msg
                Right (ObjURI hParent luParent) -> do
                    mrm <- lift $ runMaybeT $ do
                        iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
                        roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent
                        MaybeT $ getValBy $ UniqueRemoteMessageIdent roid
                    for_ mrm $ \ rm -> do
                        let mid = remoteMessageRest rm
                        m <- lift $ getJust mid
                        did <- fromMaybeE mdid "Remote parent known, but no context RemoteDiscussion"
                        unless (messageRoot m == did) $
                            throwE "Remote parent belongs to a different discussion"

------------------------------------------------------------------------------
-- Access
------------------------------------------------------------------------------

-- Meaning: A remote actor published a Grant
-- Behavior:
--      * Insert to my inbox
--      * If I'm the target, forward the Grant to my followers
personGrant
    :: UTCTime
    -> PersonId
    -> RemoteAuthor
    -> ActivityBody
    -> Maybe (RecipientRoutes, ByteString)
    -> LocalURI
    -> AP.Grant URIMode
    -> ActE (Text, Act (), Next)
personGrant now recipPersonID author body mfwd luGrant grant = do

    -- Check input
    (_remoteResource, recipient) <- do
        (resource, recip) <- parseGrant grant
        let u@(ObjURI h _) = remoteAuthorURI author
        resourceURI <-
            case resource of
                Right (ObjURI h' r) | h == h' -> return (u, r)
                _ -> throwE "Grant resource and Grant author are from different instances"
        when (recip == Right u) $
            throwE "Grant sender and target are the same remote actor"
        return (resourceURI, recip)

    maybeGrant <- withDBExcept $ do

        -- Grab recipient person from DB
        (personRecip, actorRecip) <- lift $ do
            p <- getJust recipPersonID
            (p,) <$> getJust (personActor p)

        mractid <- lift $ insertToInbox now author body (actorInbox actorRecip) luGrant True
        for mractid $ \ grantID -> do

            -- If recipient is local, find it in our DB
            _recipientDB <-
                bitraverse
                    (flip getGrantRecip "Grant local target not found in DB")
                    pure
                    recipient

            return (personActor personRecip, grantID)

    case maybeGrant of
        Nothing -> done "I already have this activity in my inbox"
        Just (actorID, grantID) -> do
            let targetIsRecip =
                    case recipient of
                        Left (GrantRecipPerson p) -> p == recipPersonID
                        _ -> False
            if not targetIsRecip
                then done "I'm not the target; Inserted to inbox"
                else case mfwd of
                    Nothing ->
                        done
                            "I'm the target; Inserted to inbox; \
                            \Forwarding not approved"
                    Just (localRecips, sig) -> do
                        recipHash <- encodeKeyHashid recipPersonID
                        let sieve =
                                makeRecipientSet
                                    []
                                    [LocalStagePersonFollowers recipHash]
                        lift $ forwardActivity
                            (actbBL body) localRecips sig
                            actorID
                            (LocalActorPerson recipPersonID) sieve
                            (EventRemoteGrantLocalRecipFwdToFollower grantID)
                        done
                            "I'm the target; Inserted to inbox; \
                            \Forwarded to followers if addressed"

------------------------------------------------------------------------------
-- Main behavior function
------------------------------------------------------------------------------

insertActivityToInbox
    :: MonadIO m
    => UTCTime -> ActorId -> OutboxItemId -> ReaderT SqlBackend m Bool
insertActivityToInbox now recipActorID outboxItemID = do
    inboxID <- actorInbox <$> getJust recipActorID
    inboxItemID <- insert $ InboxItem True now
    maybeItem <- insertUnique $ InboxItemLocal inboxID outboxItemID inboxItemID
    case maybeItem of
        Nothing -> do
            delete inboxItemID
            return False
        Just _ -> return True

personBehavior :: UTCTime -> PersonId -> Verse -> ActE (Text, Act (), Next)
personBehavior now personID (Left event) =
    case event of
        -- Meaning: Someone X received a Grant and forwarded it to me because
        --          I'm a follower of X
        -- Behavior: Insert to my inbox
        EventRemoteGrantLocalRecipFwdToFollower grantID -> do
            lift $ withDB $ do
                (_personRecip, actorRecip) <- do
                    p <- getJust personID
                    (p,) <$> getJust (personActor p)
                let inboxID = actorInbox actorRecip
                itemID <- insert $ InboxItem True now
                insert_ $ InboxItemRemote inboxID grantID itemID
            done "Inserted Grant to inbox"
        -- Meaning: A remote actor has forwarded to me a remote activity
        -- Behavior: Insert it to my inbox
        EventRemoteFwdLocalActivity authorByKey outboxItemID -> withDBExcept $ do
                recipPerson <- lift $ getJust personID
                verifyLocalActivityExistsInDB authorByKey outboxItemID
                if LocalActorPerson personID == authorByKey
                    then done "Received activity authored by self, ignoring"
                    else do
                        inserted <- lift $ insertActivityToInbox now (personActor recipPerson) outboxItemID
                        done $
                            if inserted
                                then "Activity inserted to my inbox"
                                else "Activity already exists in my inbox, ignoring"
        _ -> throwE $ "Unsupported event for Person: " <> T.pack (show event)
personBehavior now personID (Right (VerseRemote author body mfwd luActivity)) =
    case AP.activitySpecific $ actbActivity body of
        AP.CreateActivity (AP.Create obj mtarget) ->
            case obj of
                AP.CreateNote _ note ->
                    personCreateNote now personID author body mfwd luActivity note
                _ -> throwE "Unsupported create object type for people"
        {-
        AP.FollowActivity follow ->
            personFollowA now personID author body mfwd luActivity follow
        -}
        AP.GrantActivity grant ->
            personGrant now personID author body mfwd luActivity grant
        {-
        AP.InviteActivity invite ->
            personInviteA now personID author body mfwd luActivity invite
        AP.UndoActivity undo ->
            (,Nothing) <$> personUndoA now personID author body mfwd luActivity undo
        -}
        _ -> throwE "Unsupported activity type for Person"