{- This file is part of Vervis.
 -
 - Written in 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.Handler.Loom
    ( getLoomR
    , getLoomInboxR
    , postLoomInboxR
    , getLoomOutboxR
    , getLoomOutboxItemR
    , getLoomFollowersR
    , getLoomClothsR

    , getLoomMessageR

    , getLoomNewR
    , postLoomNewR
    , postLoomFollowR
    , postLoomUnfollowR

    , getLoomStampR
    )
where

import Control.Monad
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Default.Class
import Data.Foldable
import Data.Maybe
import Data.Text (Text)
import Data.Time.Clock
import Data.Traversable
import Database.Persist
import Text.Blaze.Html (Html)
import Yesod.Auth (requireAuth)
import Yesod.Core
import Yesod.Core.Handler (redirect, setMessage, lookupPostParam, notFound)
import Yesod.Form.Functions (runFormPost, runFormGet)
import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404)

import qualified Data.ByteString.Lazy as BL
import qualified Database.Esqueleto as E

import Database.Persist.JSON
import Development.PatchMediaType
import Network.FedURI
import Yesod.ActivityPub
import Yesod.Hashids
import Yesod.FedURI
import Yesod.MonadSite

import qualified Web.ActivityPub as AP

import Control.Monad.Trans.Except.Local
import Data.Either.Local
import Data.Paginate.Local
import Database.Persist.Local
import Yesod.Form.Local
import Yesod.Persist.Local

import Vervis.Access
import Vervis.API
import Vervis.Federation.Auth
import Vervis.Federation.Collab
import Vervis.Federation.Discussion
import Vervis.Federation.Offer
import Vervis.Federation.Ticket
import Vervis.FedURI
import Vervis.Form.Ticket
import Vervis.Form.Tracker
import Vervis.Foundation
import Vervis.Model
import Vervis.Paginate
import Vervis.Recipient
import Vervis.Settings
import Vervis.Ticket
import Vervis.TicketFilter
import Vervis.Web.Actor
import Vervis.Widget.Ticket
import Vervis.Widget.Tracker

import qualified Vervis.Client as C

getLoomR :: KeyHashid Loom -> Handler TypedContent
getLoomR loomHash = do
    loomID <- decodeKeyHashid404 loomHash
    (loom, actor, sigKeyIDs) <- runDB $ do
        l <- get404 loomID
        let aid = loomActor l
        a <- getJust aid
        sigKeys <- selectKeysList [SigKeyActor ==. aid] [Asc SigKeyId]
        return (l, a, sigKeys)

    encodeRouteLocal <- getEncodeRouteLocal
    hashSigKey <- getEncodeKeyHashid
    perActor <- asksSite $ appPerActorKeys . appSettings
    let route mk = encodeRouteLocal $ mk loomHash
        loomAP = AP.Actor
            { AP.actorLocal = AP.ActorLocal
                { AP.actorId         = route LoomR
                , AP.actorInbox      = route LoomInboxR
                , AP.actorOutbox     = Just $ route LoomOutboxR
                , AP.actorFollowers  = Just $ route LoomFollowersR
                , AP.actorFollowing  = Nothing
                , AP.actorPublicKeys =
                    map (Left . encodeRouteLocal) $
                    if perActor
                        then map (LoomStampR loomHash . hashSigKey) sigKeyIDs
                        else [ActorKey1R, ActorKey2R]
                , AP.actorSshKeys    = []
                }
            , AP.actorDetail = AP.ActorDetail
                { AP.actorType       = AP.ActorTypePatchTracker
                , AP.actorUsername   = Nothing
                , AP.actorName       = Just $ actorName actor
                , AP.actorSummary    = Just $ actorDesc actor
                }
            }

    provideHtmlAndAP loomAP $ redirect $ LoomClothsR loomHash

getLoomInboxR :: KeyHashid Loom -> Handler TypedContent
getLoomInboxR = getInbox LoomInboxR loomActor

postLoomInboxR :: KeyHashid Loom -> Handler ()
postLoomInboxR loomHash = do
    loomID <- decodeKeyHashid404 loomHash
    postInbox $ LocalActorLoom loomID

{-
            AP.AcceptActivity accept ->
                loomAcceptF now recipLoomHash author body mfwd luActivity accept
            AP.ApplyActivity apply->
                loomApplyF now recipLoomHash author body mfwd luActivity apply
            AP.CreateActivity (AP.Create obj _mtarget) ->
                case obj of
                    AP.CreateNote _ note ->
                        (,Nothing) <$> loomCreateNoteF now recipLoomHash author body mfwd luActivity note
                    _ -> return ("Unsupported create object type for looms", Nothing)
            AP.FollowActivity follow ->
                loomFollowF now recipLoomHash author body mfwd luActivity follow
            AP.InviteActivity invite ->
                topicInviteF now (GrantResourceLoom recipLoomHash) author body mfwd luActivity invite
            AP.JoinActivity join ->
                loomJoinF now recipLoomHash author body mfwd luActivity join
            AP.OfferActivity (AP.Offer obj target) ->
                case obj of
                    AP.OfferTicket ticket ->
                        loomOfferTicketF now recipLoomHash author body mfwd luActivity ticket target
                    _ -> return ("Unsupported offer object type for looms", Nothing)
            AP.ResolveActivity resolve ->
                loomResolveF now recipLoomHash author body mfwd luActivity resolve
            AP.UndoActivity undo ->
                (,Nothing) <$> loomUndoF now recipLoomHash author body mfwd luActivity undo
            _ -> return ("Unsupported activity type for looms", Nothing)
-}

getLoomOutboxR :: KeyHashid Loom -> Handler TypedContent
getLoomOutboxR = getOutbox LoomOutboxR LoomOutboxItemR loomActor

getLoomOutboxItemR
    :: KeyHashid Loom -> KeyHashid OutboxItem -> Handler TypedContent
getLoomOutboxItemR = getOutboxItem LoomOutboxItemR loomActor

getLoomFollowersR :: KeyHashid Loom -> Handler TypedContent
getLoomFollowersR = getActorFollowersCollection LoomFollowersR loomActor

getLoomClothsR :: KeyHashid Loom -> Handler TypedContent
getLoomClothsR loomHash = selectRep $ do
    provideRep $ do
        let tf = def
        {-
        ((filtResult, filtWidget), filtEnctype) <- runFormPost ticketFilterForm
        let tf =
                case filtResult of
                    FormSuccess filt -> filt
                    FormMissing      -> def
                    FormFailure l    ->
                        error $ "Ticket filter form failed: " ++ show l
        -}
        loomID <- decodeKeyHashid404 loomHash
        (loom, actor, (total, pages, mpage)) <- runDB $ do
            loom <- get404 loomID
            actor <- getJust $ loomActor loom
            let countAllTickets = count [TicketLoomLoom ==. loomID]
                selectTickets off lim =
                    getClothSummaries
                        (filterTickets tf)
                        (Just $ \ t -> [E.desc $ t E.^. TicketId])
                        (Just (off, lim))
                        loomID
            (loom,actor,) <$> getPageAndNavCount countAllTickets selectTickets
        case mpage of
            Nothing -> redirectFirstPage here
            Just (rows, navModel) ->
                let pageNav = navWidget navModel
                in  defaultLayout $(widgetFile "cloth/list")
    AP.provideAP' $ do
        loomID <- decodeKeyHashid404 loomHash
        (total, pages, mpage) <- runDB $ do
            let countAllTickets = count [TicketLoomLoom ==. loomID]
                selectTickets off lim =
                    selectKeysList
                        [TicketLoomLoom ==. loomID]
                        [OffsetBy off, LimitTo lim, Desc TicketLoomTicket]
            getPageAndNavCount countAllTickets selectTickets

        encodeRouteHome <- getEncodeRouteHome
        encodeRouteLocal <- getEncodeRouteLocal
        hashTicket <- getEncodeKeyHashid
        encodeRoutePageLocal <- getEncodeRoutePageLocal
        let pageUrl = encodeRoutePageLocal here
        host <- asksSite siteInstanceHost
        return $
            case mpage of
                Nothing -> encodeStrict $ AP.Doc host $ AP.Collection
                    { AP.collectionId         = encodeRouteLocal here
                    , AP.collectionType       = AP.CollectionTypeOrdered
                    , AP.collectionTotalItems = Just total
                    , AP.collectionCurrent    = Nothing
                    , AP.collectionFirst      = Just $ pageUrl 1
                    , AP.collectionLast       = Just $ pageUrl pages
                    , AP.collectionItems      = [] :: [Text]
                    }
                Just (tickets, navModel) ->
                    let current = nmCurrent navModel
                    in  encodeStrict $ AP.Doc host $ AP.CollectionPage
                            { AP.collectionPageId         = pageUrl current
                            , AP.collectionPageType       = AP.CollectionPageTypeOrdered
                            , AP.collectionPageTotalItems = Nothing
                            , AP.collectionPageCurrent    = Just $ pageUrl current
                            , AP.collectionPageFirst      = Just $ pageUrl 1
                            , AP.collectionPageLast       = Just $ pageUrl pages
                            , AP.collectionPagePartOf     = encodeRouteLocal here
                            , AP.collectionPagePrev       =
                                if current > 1
                                    then Just $ pageUrl $ current - 1
                                    else Nothing
                            , AP.collectionPageNext       =
                                if current < pages
                                    then Just $ pageUrl $ current + 1
                                    else Nothing
                            , AP.collectionPageStartIndex = Nothing
                            , AP.collectionPageItems      =
                                encodeRouteHome . ClothR loomHash . hashTicket <$> tickets
                            }
    where
    here = LoomClothsR loomHash
    encodeStrict = BL.toStrict . encode

getLoomMessageR
    :: KeyHashid Loom -> KeyHashid LocalMessage -> Handler TypedContent
getLoomMessageR _ _ = notFound

getLoomNewR :: Handler Html
getLoomNewR = do
    ((_result, widget), enctype) <- runFormPost newLoomForm
    defaultLayout
        [whamlet|
            <form method=POST action=@{LoomNewR} enctype=#{enctype}>
              ^{widget}
              <div class="submit">
                  <input type="submit">
        |]

postLoomNewR :: Handler Html
postLoomNewR = do
    NewLoom name desc repoID <- runFormPostRedirect LoomNewR newLoomForm

    personEntity@(Entity personID person) <- requireAuth
    personHash <- encodeKeyHashid personID
    repoHash <- encodeKeyHashid repoID
    (maybeSummary, audience, detail, repos) <-
        C.createLoom personHash name desc repoHash
    actor <- runDB $ do

        -- Find the specified repo in DB
        _ <- getJust repoID

        -- Make sure the repo has a single, full-access collab, granted to the
        -- creator of the loom
        maybeApproved <- runMaybeT $ do
            collabs <- lift $ selectList [CollabTopicRepoRepo ==. repoID] []
            collabID <- 
                case collabs of
                    [Entity _ c] -> return $ collabTopicRepoCollab c
                    _ -> mzero
            CollabRecipLocal _ recipID <-
                MaybeT $ getValBy $ UniqueCollabRecipLocal collabID
            guard $ recipID == personID
            _ <- MaybeT $ getBy $ UniqueCollabEnable collabID
            _ <- MaybeT $ getBy $ UniqueCollabFulfillsLocalTopicCreation collabID
            return ()
        unless (isJust maybeApproved) $ do
            setMessage "Can't link with the repo chosen"
            redirect LoomNewR

        getJust $ personActor person

    result <- do
        (localRecips, remoteRecips, fwdHosts, action) <-
            C.makeServerInput Nothing maybeSummary audience $ AP.CreateActivity $ AP.Create (AP.CreatePatchTracker detail repos Nothing) Nothing
        runExceptT $ createPatchTrackerC personEntity actor Nothing localRecips remoteRecips fwdHosts action detail repos Nothing Nothing

    case result of
        Left e -> do
            setMessage $ toHtml e
            redirect LoomNewR
        Right createID -> do
            maybeLoomID <- runDB $ getKeyBy $ UniqueLoomCreate createID
            case maybeLoomID of
                Nothing -> error "Can't find the newly created loom"
                Just loomID -> do
                    loomHash <- encodeKeyHashid loomID
                    setMessage "New patch tracker created"
                    redirect $ LoomR loomHash

postLoomFollowR :: KeyHashid Loom -> Handler ()
postLoomFollowR _ = error "Temporarily disabled"

postLoomUnfollowR :: KeyHashid Loom -> Handler ()
postLoomUnfollowR _ = error "Temporarily disabled"

getLoomStampR :: KeyHashid Loom -> KeyHashid SigKey -> Handler TypedContent
getLoomStampR = servePerActorKey loomActor LocalActorLoom