{- This file is part of Vervis.
 -
 - Written in 2016, 2018, 2019, 2020, 2022
 - 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.Ticket
    ( getTicketR
    , getTicketDiscussionR
    , getTicketEventsR
    , getTicketFollowersR
    , getTicketDepsR
    , getTicketReverseDepsR

    , getTicketDepR

    , getTicketNewR
    , postTicketNewR

    , postTicketFollowR
    , postTicketUnfollowR

    , getTicketReplyR
    , postTicketReplyR
    , getTicketReplyOnR
    , postTicketReplyOnR







    {-
    , getProjectTicketsR
    , getProjectTicketTreeR
    , deleteProjectTicketR
    , postProjectTicketR
    , getProjectTicketEditR
    , postProjectTicketAcceptR
    , postProjectTicketClaimR
    , postProjectTicketUnclaimR
    , getProjectTicketAssignR
    , postProjectTicketAssignR
    , postProjectTicketUnassignR
    , getClaimRequestsPersonR
    , getClaimRequestsProjectR
    , getClaimRequestsTicketR
    , postClaimRequestsTicketR
    , getClaimRequestNewR
    , postProjectTicketDepsR
    , getProjectTicketDepNewR
    , postTicketDepOldR
    , deleteTicketDepOldR
    , getProjectTicketParticipantsR
    , getProjectTicketTeamR

    , getSharerTicketsR
    , getSharerTicketR
    , getSharerTicketDepsR
    , getSharerTicketReverseDepsR
    , getSharerTicketTeamR
    , getSharerTicketEventsR
    -}
    )
where

import Control.Applicative (liftA2)
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Except
import Data.Aeson (encode)
import Data.Bifunctor
import Data.Bitraversable
import Data.Bool (bool)
import Data.Default.Class (def)
import Data.Foldable (traverse_)
import Data.Function
import Data.Maybe
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Time.Calendar (Day (..))
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Data.Traversable (for)
import Database.Persist
import Network.HTTP.Types (StdMethod (DELETE, POST))
import Text.Blaze.Html (Html, toHtml)
import Text.Blaze.Html.Renderer.Text
import Text.HTML.SanitizeXSS
import Yesod.Auth
import Yesod.Core hiding (logWarn)
import Yesod.Core.Handler
import Yesod.Core.Widget
import Yesod.Form.Functions (runFormGet, runFormPost)
import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404)

import qualified Data.ByteString.Lazy as BL
import qualified Data.List.Ordered as LO
import qualified Data.Text as T (filter, intercalate, pack)
import qualified Data.Text.Lazy as TL
import qualified Database.Esqueleto as E

import Database.Persist.Sql.Graph.TransitiveReduction (trrFix)

import Data.Aeson.Encode.Pretty.ToEncoding
import Data.MediaType
import Network.FedURI
import Web.ActivityPub hiding (Ticket (..), Project, TicketDependency)
import Web.Text
import Yesod.ActivityPub
import Yesod.Auth.Unverified
import Yesod.FedURI
import Yesod.Hashids
import Yesod.MonadSite
import Yesod.RenderSource

import qualified Web.ActivityPub as AP

import Control.Monad.Trans.Except.Local
import Data.Either.Local
import Data.Maybe.Local (partitionMaybePairs)
import Data.Paginate.Local
import Database.Persist.Local
import Yesod.Form.Local
import Yesod.Persist.Local

import Vervis.ActivityPub
import Vervis.API
import Vervis.Data.Actor
import Vervis.FedURI
import Vervis.Form.Ticket
import Vervis.Foundation
--import Vervis.GraphProxy (ticketDepGraph)
import Vervis.Model
import Vervis.Model.Ident
import Vervis.Model.Ticket
import Vervis.Model.Workflow
import Vervis.Paginate
import Vervis.Persist.Actor
import Vervis.Persist.Discussion
import Vervis.Persist.Ticket
import Vervis.Recipient
import Vervis.Settings
import Vervis.Style
import Vervis.Ticket
import Vervis.TicketFilter (filterTickets)
import Vervis.Time (showDate)
import Vervis.Web.Actor
import Vervis.Web.Discussion
import Vervis.Widget.Discussion
import Vervis.Widget.Person
import Vervis.Widget.Tracker

import qualified Vervis.Client as C

selectDiscussionID deckHash taskHash = do
    (_, _, Entity _ ticket, _, _) <- getTicket404 deckHash taskHash
    return $ ticketDiscuss ticket

getTicketR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent
getTicketR deckHash ticketHash = do
    (ticket, author, resolve) <- runDB $ do
        (_, _, Entity _ ticket', author', resolve') <-
            getTicket404 deckHash ticketHash
        (,,) ticket'
            <$> (case author' of
                    Left (Entity _ tal) ->
                        return $ Left $ ticketAuthorLocalAuthor tal
                    Right (Entity _ tar) -> Right <$> do
                        ra <- getJust $ ticketAuthorRemoteAuthor tar
                        ro <- getJust $ remoteActorIdent ra
                        i <- getJust $ remoteObjectInstance ro
                        return (i, ro)
                )
            <*> (for resolve' $ \ (_, etrx) ->
                    bitraverse
                        (\ (Entity _ trl) -> do
                            let obiid = ticketResolveLocalActivity trl
                            obid <- outboxItemOutbox <$> getJust obiid
                            actorID <- do
                                maybeActorID <- getKeyBy $ UniqueActorOutbox obid
                                case maybeActorID of
                                    Nothing -> error "Found outbox not used by any actor"
                                    Just a -> return a
                            actor <- getLocalActor actorID
                            return (actor, obiid)
                        )
                        (\ (Entity _ trr) -> do
                            roid <-
                                remoteActivityIdent <$>
                                    getJust (ticketResolveRemoteActivity trr)
                            ro <- getJust roid
                            i <- getJust $ remoteObjectInstance ro
                            return (i, ro)
                        )
                        etrx
                )

    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    hashPerson <- getEncodeKeyHashid
    hashItem <- getEncodeKeyHashid
    hashActor <- getHashLocalActor
    hLocal <- getsYesod siteInstanceHost
    let route mk = encodeRouteLocal $ mk deckHash ticketHash
        authorHost =
            case author of
                Left _       -> hLocal
                Right (i, _) -> instanceHost i
        ticketLocalAP = AP.TicketLocal
            { AP.ticketId           = route TicketR
            , AP.ticketReplies      = route TicketDiscussionR
            , AP.ticketParticipants = route TicketFollowersR
            , AP.ticketTeam         = Nothing
            , AP.ticketEvents       = route TicketEventsR
            , AP.ticketDeps         = route TicketDepsR
            , AP.ticketReverseDeps  = route TicketReverseDepsR
            }
        ticketAP = AP.Ticket
            { AP.ticketLocal        = Just (hLocal, ticketLocalAP)
            , AP.ticketAttributedTo =
                case author of
                    Left authorID ->
                        encodeRouteLocal $ PersonR $ hashPerson authorID
                    Right (_instance, object) ->
                        remoteObjectIdent object
            , AP.ticketPublished    = Just $ ticketCreated ticket
            , AP.ticketUpdated      = Nothing
            , AP.ticketContext      = Just $ encodeRouteHome $ DeckR deckHash
            -- , AP.ticketName         = Just $ "#" <> T.pack (show num)
            , AP.ticketSummary      = encodeEntities $ ticketTitle ticket
            , AP.ticketContent      = ticketDescription ticket
            , AP.ticketSource       = ticketSource ticket
            , AP.ticketAssignedTo   = Nothing
            , AP.ticketResolved     =
                let u (Left (actor, obiid)) =
                        encodeRouteHome $
                            activityRoute (hashActor actor) (hashItem obiid)
                    u (Right (i, ro)) =
                        ObjURI (instanceHost i) (remoteObjectIdent ro)
                in  (,Nothing) . Just . u <$> resolve
            , AP.ticketAttachment = Nothing
            }

    provideHtmlAndAP' authorHost ticketAP getTicketHtml
    where
    getTicketHtml = do
        mpid <- maybeAuthId
        (edeck, actor, ticket, author, tparams, eparams, cparams, resolved) <- handlerToWidget $ runDB $ do
            (deck, _ticketdeck, Entity ticketID ticket, author, maybeResolve) <-
                getTicket404 deckHash ticketHash
            actor <- getJust $ deckActor $ entityVal deck
            (deck,actor,ticket,,,,,)
                <$> bitraverse
                        (\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
                            p <- getJust personID
                            (Entity personID p,) <$> getJust (personActor p)
                        )
                        (\ (Entity _ (TicketAuthorRemote _ remoteActorID _)) -> do
                            ra <- getJust remoteActorID
                            ro <- getJust $ remoteActorIdent ra
                            i <- getJust $ remoteObjectInstance ro
                            return (i, ro, ra)
                        )
                        author
                <*> getTicketTextParams ticketID --wid
                <*> getTicketEnumParams ticketID --wid
                <*> getTicketClasses ticketID --wid
                <*> traverse getTicketResolve maybeResolve
        hashMessageKey <- handlerToWidget getEncodeKeyHashid
        let desc :: Widget
            desc = toWidget $ markupHTML $ ticketDescription ticket
            discuss =
                discussionW
                    (return $ ticketDiscuss ticket)
                    (TicketReplyR deckHash ticketHash)
                    (TicketReplyOnR deckHash ticketHash . hashMessageKey)
        cRelevant <- newIdent
        cIrrelevant <- newIdent
        let relevant filt =
                bool cIrrelevant cRelevant $
                {-
                case ticketStatus ticket of
                    TSNew    -> wffNew filt
                    TSTodo   -> wffTodo filt
                    TSClosed -> wffClosed filt
                -}
                True
        let followButton =
                followW
                    (TicketFollowR deckHash ticketHash)
                    (TicketUnfollowR deckHash ticketHash)
                    (ticketFollowers ticket)
        $(widgetFile "ticket/one")

getTicketDiscussionR
    :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent
getTicketDiscussionR deckHash taskHash = do
    hashMsg <- getEncodeKeyHashid
    serveDiscussion
        (TicketDiscussionR deckHash taskHash)
        (TicketReplyOnR deckHash taskHash . hashMsg)
        (TicketReplyR deckHash taskHash)
        (selectDiscussionID deckHash taskHash)

getTicketEventsR
    :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent
getTicketEventsR _ _ = do
    error "Not implemented yet"

getTicketFollowersR
    :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent
getTicketFollowersR deckHash ticketHash = getFollowersCollection here getFsid
    where
    here = TicketFollowersR deckHash ticketHash
    getFsid = do
        (_, _, Entity _ t, _, _) <- getTicket404 deckHash ticketHash
        return $ ticketFollowers t

getTicketDepsR
    :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent
getTicketDepsR deckHash ticketHash =
    error "Temporarily disabled"
    {-
    getDependencyCollection here dep getLocalTicketId404
    where
    here = TicketDepsR deckHash ticketHash
    dep = TicketDepR deckHash ticketHash
    getLocalTicketId404 = do
        (_, _, Entity ltid _, _, _, _, _) <- getTicket404 dkhid ltkhid
        return ltid
    -}

getTicketReverseDepsR
    :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler TypedContent
getTicketReverseDepsR deckHash ticketHash =
    error "Temporarily disabled"
    {-
    getReverseDependencyCollection here getLocalTicketId404
    where
    here = TicketReverseDepsR deckhash ticketHash
    getLocalTicketId404 = do
        (_, _, _, Entity ltid _, _, _, _, _) <- getTicket404 deckHash ticketHash
        return ltid
    -}

getTicketDepR
    :: KeyHashid Deck
    -> KeyHashid TicketDeck
    -> KeyHashid LocalTicketDependency
    -> Handler TypedContent
getTicketDepR _ _ _ = do
    error "Temporarily disabled"
    {-
    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    wiRoute <- askWorkItemRoute
    hLocal <- asksSite siteInstanceHost

    tdid <- decodeKeyHashid404 tdkhid
    (td, author, parent, child) <- runDB $ do
        td <- get404 tdid
        (td,,,)
            <$> getAuthor tdid
            <*> getWorkItem ( localTicketDependencyParent td)
            <*> getChild tdid
    let host =
            case author of
                Left _ -> hLocal
                Right (h, _) -> h
        tdepAP = AP.TicketDependency
            { ticketDepId           = Just $ encodeRouteHome here
            , ticketDepParent       = encodeRouteHome $ wiRoute parent
            , ticketDepChild        =
                case child of
                    Left wi -> encodeRouteHome $ wiRoute wi
                    Right (h, lu) -> ObjURI h lu
            , ticketDepAttributedTo =
                case author of
                    Left shr -> encodeRouteLocal $ SharerR shr
                    Right (_h, lu) -> lu
            , ticketDepPublished    = Just $ localTicketDependencyCreated td
            , ticketDepUpdated      = Nothing
            }
    provideHtmlAndAP' host tdepAP $ redirectToPrettyJSON here
    where
    here = TicketDepR tdkhid
    getAuthor tdid = do
        tda <- requireEitherAlt
            (getValBy $ UniqueTicketDependencyAuthorLocal tdid)
            (getValBy $ UniqueTicketDependencyAuthorRemote tdid)
            "No TDA"
            "Both TDAL and TDAR"
        bitraverse
            (\ tdal -> do
                p <- getJust $ ticketDependencyAuthorLocalAuthor tdal
                s <- getJust $ personIdent p
                return $ sharerIdent s
            )
            (\ tdar -> do
                ra <- getJust $ ticketDependencyAuthorRemoteAuthor tdar
                ro <- getJust $ remoteActorIdent ra
                i <- getJust $ remoteObjectInstance ro
                return (instanceHost i, remoteObjectIdent ro)
            )
            tda
    getChild tdid = do
        tdc <- requireEitherAlt
            (getValBy $ UniqueTicketDependencyChildLocal tdid)
            (getValBy $ UniqueTicketDependencyChildRemote tdid)
            "No TDC"
            "Both TDCL and TDCR"
        bitraverse
            (getWorkItem . ticketDependencyChildLocalChild)
            (\ tdcr -> do
                ro <- getJust $ ticketDependencyChildRemoteChild tdcr
                i <- getJust $ remoteObjectInstance ro
                return (instanceHost i, remoteObjectIdent ro)
            )
            tdc
    -}

getTicketNewR :: KeyHashid Deck -> Handler Html
getTicketNewR deckHash = do
    deckID <- decodeKeyHashid404 deckHash
    wid <- runDB $ deckWorkflow <$> get404 deckID
    ((_result, widget), enctype) <- runFormPost $ newTicketForm wid
    defaultLayout $(widgetFile "ticket/new")

postTicketNewR :: KeyHashid Deck -> Handler Html
postTicketNewR deckHash = do
    deckID <- decodeKeyHashid404 deckHash
    person@(Entity pid p) <- requireAuth
    (wid, actor) <- runDB $ do
        wid <- deckWorkflow <$> get404 deckID
        a <- getJust $ personActor p
        return (wid, a)
    NewTicket title desc <-
        runFormPostRedirect (TicketNewR deckHash) $ newTicketForm wid
    errorOrTicket <- runExceptT $ do
        encodeRouteHome <- getEncodeRouteHome
        let uDeck = encodeRouteHome $ DeckR deckHash
        senderHash <- encodeKeyHashid pid
        (maybeSummary, audience, ticket) <-
            C.offerIssue senderHash title desc uDeck
        (localRecips, remoteRecips, fwdHosts, action) <-
            lift $ C.makeServerInput Nothing maybeSummary audience $
                AP.OfferActivity $ AP.Offer (AP.OfferTicket ticket) uDeck
        offerID <-
            offerTicketC
                person actor Nothing localRecips remoteRecips fwdHosts action
                ticket uDeck
        runDBExcept $ do
            mtal <- lift $ getValBy $ UniqueTicketAuthorLocalOpen offerID
            tal <- fromMaybeE mtal "Offer processed bu no ticket created"
            return $ ticketAuthorLocalTicket tal
    case errorOrTicket of
        Left e -> do
            setMessage $ toHtml e
            redirect $ TicketNewR deckHash
        Right ticketID -> do
            taskID <- do
                maybeTaskID <- runDB $ getKeyBy $ UniqueTicketDeck ticketID
                case maybeTaskID of
                    Nothing -> error "No TicketDeck for the new Ticket"
                    Just t -> return t
            taskHash <- encodeKeyHashid taskID
            setMessage "Ticket created"
            redirect $ TicketR deckHash taskHash

postTicketFollowR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler ()
postTicketFollowR _ = error "Temporarily disabled"

postTicketUnfollowR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler ()
postTicketUnfollowR _ = error "Temporarily disabled"

getTicketReplyR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler Html
getTicketReplyR deckHash taskHash =
    getTopReply $ TicketReplyR deckHash taskHash

postTicketReplyR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler Html
postTicketReplyR deckHash taskHash =
    postReply
        (TicketReplyR deckHash taskHash)
        [LocalActorDeck deckHash]
        [ LocalStageDeckFollowers deckHash
        , LocalStageTicketFollowers deckHash taskHash
        ]
        (TicketR deckHash taskHash)
        Nothing

getTicketReplyOnR
    :: KeyHashid Deck
    -> KeyHashid TicketDeck
    -> KeyHashid Message
    -> Handler Html
getTicketReplyOnR deckHash taskHash msgHash = do
    msgID <- decodeKeyHashid404 msgHash
    hashMsg <- getEncodeKeyHashid
    getReply
        (TicketReplyOnR deckHash taskHash . hashMsg)
        (selectDiscussionID deckHash taskHash)
        msgID

postTicketReplyOnR
    :: KeyHashid Deck
    -> KeyHashid TicketDeck
    -> KeyHashid Message
    -> Handler Html
postTicketReplyOnR deckHash taskHash msgHash = do
    msgID <- decodeKeyHashid404 msgHash
    postReply
        (TicketReplyOnR deckHash taskHash msgHash)
        [LocalActorDeck deckHash]
        [ LocalStageDeckFollowers deckHash
        , LocalStageTicketFollowers deckHash taskHash
        ]
        (TicketR deckHash taskHash)
        (Just (selectDiscussionID deckHash taskHash, msgID))





























{-
deleteProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
deleteProjectTicketR _shr _prj _ltkhid =
    --TODO: I can easily implement this, but should it even be possible to
    --delete tickets?
    error "Not implemented"

postProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postProjectTicketR shr prj ltkhid = do
    mmethod <- lookupPostParam "_method"
    case mmethod of
        Just "PUT"    -> putProjectTicketR shr prj ltkhid
        Just "DELETE" -> deleteProjectTicketR shr prj ltkhid
        _             -> notFound

getProjectTicketEditR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getProjectTicketEditR shr prj ltkhid = do
    (tid, ticket, wid) <- runDB $ do
        (_es, Entity _ project, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid
        return (tid, ticket, projectWorkflow project)
    ((_result, widget), enctype) <-
        runFormPost $ editTicketContentForm tid ticket wid
    defaultLayout $(widgetFile "ticket/edit")

postProjectTicketAcceptR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postProjectTicketAcceptR shr prj ltkhid = do
    succ <- runDB $ do
        (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid
        case ticketStatus ticket of
            TSNew -> do
                update tid [TicketStatus =. TSTodo]
                return True
            _ -> return False
    setMessage $
        if succ
            then "Ticket accepted."
            else "Ticket is already accepted."
    redirect $ ProjectTicketR shr prj ltkhid

postProjectTicketClaimR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postProjectTicketClaimR shr prj ltkhid = do
    pid <- requireAuthId
    mmsg <- runDB $ do
        (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid
        case (ticketStatus ticket, ticketAssignee ticket) of
            (TSNew, _) ->
                return $
                Just "The ticket isn’t accepted yet. Can’t claim it."
            (TSClosed, _) ->
                return $
                Just "The ticket is closed. Can’t claim closed tickets."
            (TSTodo, Just _) ->
                return $
                Just "The ticket is already assigned to someone."
            (TSTodo, Nothing) -> do
                update tid [TicketAssignee =. Just pid]
                return Nothing
    setMessage $ fromMaybe "The ticket is now assigned to you." mmsg
    redirect $ ProjectTicketR shr prj ltkhid

postProjectTicketUnclaimR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postProjectTicketUnclaimR shr prj ltkhid = do
    pid <- requireAuthId
    mmsg <- runDB $ do
        (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid
        case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
            (Nothing, _) ->
                return $ Just "The ticket is already unassigned."
            (Just False, _) ->
                return $ Just "The ticket is assigned to someone else."
            (Just True, TSNew) -> do
                logWarn "Found a new claimed ticket, this is invalid"
                return $
                    Just "The ticket isn’t accepted yet. Can’t unclaim it."
            (Just True, TSClosed) -> do
                logWarn "Found a closed claimed ticket, this is invalid"
                return $
                    Just "The ticket is closed. Can’t unclaim closed tickets."
            (Just True, TSTodo) -> do
                update tid [TicketAssignee =. Nothing]
                return Nothing
    setMessage $ fromMaybe "The ticket is now unassigned." mmsg
    redirect $ ProjectTicketR shr prj ltkhid

getProjectTicketAssignR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getProjectTicketAssignR shr prj ltkhid = do
    vpid <- requireAuthId
    (_es, Entity jid _, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- runDB $ getProjectTicket404 shr prj ltkhid
    let msg t = do
            setMessage t
            redirect $ ProjectTicketR shr prj ltkhid
    case (ticketStatus ticket, ticketAssignee ticket) of
        (TSNew, _) -> msg "The ticket isn’t accepted yet. Can’t assign it."
        (TSClosed, _) -> msg "The ticket is closed. Can’t assign it."
        (TSTodo, Just _) -> msg "The ticket is already assigned to someone."
        (TSTodo, Nothing) -> do
            ((_result, widget), enctype) <-
                runFormPost $ assignTicketForm vpid jid
            defaultLayout $(widgetFile "ticket/assign")

postProjectTicketAssignR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postProjectTicketAssignR shr prj ltkhid = do
    vpid <- requireAuthId
    (_es, Entity jid _, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- runDB $ getProjectTicket404 shr prj ltkhid
    let msg t = do
            setMessage t
            redirect $ ProjectTicketR shr prj ltkhid
    case (ticketStatus ticket, ticketAssignee ticket) of
        (TSNew, _) -> msg "The ticket isn’t accepted yet. Can’t assign it."
        (TSClosed, _) -> msg "The ticket is closed. Can’t assign it."
        (TSTodo, Just _) -> msg "The ticket is already assigned to someone."
        (TSTodo, Nothing) -> do
            ((result, widget), enctype) <-
                runFormPost $ assignTicketForm vpid jid
            case result of
                FormSuccess pid -> do
                    sharer <- runDB $ do
                        update tid [TicketAssignee =. Just pid]
                        person <- getJust pid
                        getJust $ personIdent person
                    let si = sharerIdent sharer
                    msg $ toHtml $
                        "The ticket is now assigned to " <> shr2text si <> "."
                FormMissing -> do
                    setMessage "Field(s) missing."
                    defaultLayout $(widgetFile "ticket/assign")
                FormFailure _l -> do
                    setMessage "Ticket assignment failed, see errors below."
                    defaultLayout $(widgetFile "ticket/assign")

postProjectTicketUnassignR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postProjectTicketUnassignR shr prj ltkhid = do
    pid <- requireAuthId
    mmsg <- runDB $ do
        (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid
        case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
            (Nothing, _) ->
                return $ Just "The ticket is already unassigned."
            (Just True, _) ->
                return $ Just "The ticket is assigned to you, unclaim instead."
            (Just False, TSNew) -> do
                logWarn "Found a new claimed ticket, this is invalid"
                return $
                    Just "The ticket isn’t accepted yet. Can’t unclaim it."
            (Just False, TSClosed) -> do
                logWarn "Found a closed claimed ticket, this is invalid"
                return $
                    Just "The ticket is closed. Can’t unclaim closed tickets."
            (Just False, TSTodo) -> do
                update tid [TicketAssignee =. Nothing]
                return Nothing
    setMessage $ fromMaybe "The ticket is now unassigned." mmsg
    redirect $ ProjectTicketR shr prj ltkhid

-- | The logged-in user gets a list of the ticket claim requests they have
-- opened, in any project.
getClaimRequestsPersonR :: Handler Html
getClaimRequestsPersonR = do
    pid <- requireAuthId
    rqs <- runDB $ E.select $ E.from $
        \ (tcr `E.InnerJoin` ticket `E.InnerJoin` lticket `E.InnerJoin` tcl `E.InnerJoin` tpl `E.InnerJoin` project `E.InnerJoin` sharer) -> do
            E.on $ project E.^. ProjectSharer E.==. sharer E.^. SharerId
            E.on $ tpl E.^. TicketProjectLocalProject E.==. project E.^. ProjectId
            E.on $ tcl E.^. TicketContextLocalId E.==. tpl E.^. TicketProjectLocalContext
            E.on $ ticket E.^. TicketId E.==. tcl E.^. TicketContextLocalTicket
            E.on $ ticket E.^. TicketId E.==. lticket E.^. LocalTicketTicket
            E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId
            E.where_ $ tcr E.^. TicketClaimRequestPerson E.==. E.val pid
            E.orderBy [E.desc $ tcr E.^. TicketClaimRequestCreated]
            return
                ( sharer E.^. SharerIdent
                , project E.^. ProjectIdent
                , lticket E.^. LocalTicketId
                , ticket E.^. TicketTitle
                , tcr E.^. TicketClaimRequestCreated
                )
    encodeHid <- getEncodeKeyHashid
    defaultLayout $(widgetFile "person/claim-requests")

-- | Get a list of ticket claim requests for a given project.
getClaimRequestsProjectR :: ShrIdent -> PrjIdent -> Handler Html
getClaimRequestsProjectR shr prj = do
    rqs <- runDB $ do
        Entity sid _ <- getBy404 $ UniqueSharer shr
        Entity jid _ <- getBy404 $ UniqueProject prj sid
        E.select $ E.from $
            \ ( tcr     `E.InnerJoin`
                ticket  `E.InnerJoin`
                lticket `E.InnerJoin`
                tcl     `E.InnerJoin`
                tpl     `E.InnerJoin`
                person  `E.InnerJoin`
                sharer
              ) -> do
                E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
                E.on $ tcr E.^. TicketClaimRequestPerson E.==. person E.^. PersonId
                E.on $ tcl E.^. TicketContextLocalId E.==. tpl E.^. TicketProjectLocalContext
                E.on $ ticket E.^. TicketId E.==. tcl E.^. TicketContextLocalTicket
                E.on $ ticket E.^. TicketId E.==. lticket E.^. LocalTicketTicket
                E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId
                E.where_ $ tpl E.^. TicketProjectLocalProject E.==. E.val jid
                E.orderBy [E.desc $ tcr E.^. TicketClaimRequestCreated]
                return
                    ( sharer
                    , lticket E.^. LocalTicketId
                    , ticket E.^. TicketTitle
                    , tcr E.^. TicketClaimRequestCreated
                    )
    encodeHid <- getEncodeKeyHashid
    defaultLayout $(widgetFile "project/claim-request/list")

-- | Get a list of ticket claim requests for a given ticket.
getClaimRequestsTicketR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getClaimRequestsTicketR shr prj ltkhid = do
    rqs <- runDB $ do
        (_es, _ej, Entity tid _, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid
        E.select $ E.from $ \ (tcr `E.InnerJoin` person `E.InnerJoin` sharer) -> do
                E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
                E.on $ tcr E.^. TicketClaimRequestPerson E.==. person E.^. PersonId
                E.where_ $ tcr E.^. TicketClaimRequestTicket E.==. E.val tid
                E.orderBy [E.desc $ tcr E.^. TicketClaimRequestCreated]
                return (sharer, tcr)
    defaultLayout $(widgetFile "ticket/claim-request/list")

getClaimRequestNewR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getClaimRequestNewR shr prj ltkhid = do
    ((_result, widget), etype) <- runFormPost claimRequestForm
    defaultLayout $(widgetFile "ticket/claim-request/new")

postClaimRequestsTicketR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postClaimRequestsTicketR shr prj ltkhid = do
    ((result, widget), etype) <- runFormPost claimRequestForm
    case result of
        FormSuccess msg -> do
            now <- liftIO getCurrentTime
            pid <- requireAuthId
            runDB $ do
                (_es, _ej, Entity tid _, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid
                let cr = TicketClaimRequest
                        { ticketClaimRequestPerson  = pid
                        , ticketClaimRequestTicket  = tid
                        , ticketClaimRequestMessage = msg
                        , ticketClaimRequestCreated = now
                        }
                insert_ cr
            setMessage "Ticket claim request opened."
            redirect $ ProjectTicketR shr prj ltkhid
        FormMissing -> do
            setMessage "Field(s) missing."
            defaultLayout $(widgetFile "ticket/claim-request/new")
        FormFailure _l -> do
            setMessage "Submission failed, see errors below."
            defaultLayout $(widgetFile "ticket/claim-request/new")

postProjectTicketDepsR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postProjectTicketDepsR _shr _prj _ltkhid = error "Temporarily disabled"
{-
    (_es, Entity jid _, Entity tid _, _elt, _etcl, _etpl, _author) <- runDB $ getProjectTicket404 shr prj ltkhid
    ((result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
    case result of
        FormSuccess ctid -> do
            pidAuthor <- requireVerifiedAuthId
            now <- liftIO getCurrentTime
            runDB $ do
                let td = TicketDependency
                        { ticketDependencyParent  = tid
                        , ticketDependencyChild   = ctid
                        , ticketDependencyCreated = now
                        }
                tdid <- insert td
                insert_ TicketDependencyAuthorLocal
                    { ticketDependencyAuthorLocalDep    = tdid
                    , ticketDependencyAuthorLocalAuthor = pidAuthor
                    , ticketDependencyAuthorLocalOpen   = obiidOffer?
                    }
                trrFix td ticketDepGraph
            setMessage "Ticket dependency added."
            redirect $ ProjectTicketR shr prj ltkhid
        FormMissing -> do
            setMessage "Field(s) missing."
            defaultLayout $(widgetFile "ticket/dep/new")
        FormFailure _l -> do
            setMessage "Submission failed, see errors below."
            defaultLayout $(widgetFile "ticket/dep/new")
-}

getProjectTicketDepNewR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getProjectTicketDepNewR _shr _prj _ltkhid = error "Currently disabled"
    {-
    (_es, Entity jid _, Entity tid _, _elt, _etcl, _etpl, _author) <- runDB $ getProjectTicket404 shr prj ltkhid
    ((_result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
    defaultLayout $(widgetFile "ticket/dep/new")
    -}

postTicketDepOldR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> KeyHashid LocalTicket -> Handler Html
postTicketDepOldR shr prj pnum cnum = do
    mmethod <- lookupPostParam "_method"
    case mmethod of
        Just "DELETE" -> deleteTicketDepOldR shr prj pnum cnum
        _             -> notFound

deleteTicketDepOldR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> KeyHashid LocalTicket -> Handler Html
deleteTicketDepOldR _shr _prj _pnum _cnum = error "Dep deletion disabled for now"
{-
    runDB $ do
        (_es, Entity jid _, Entity ptid _, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj pnum

        cltid <- decodeKeyHashid404 cnum
        clt <- get404 cltid
        let ctid = localTicketTicket clt
        ctclid <- getKeyBy404 $ UniqueTicketContextLocal ctid
        ctpl <- getValBy404 $ UniqueTicketProjectLocal ctclid
        unless (ticketProjectLocalProject ctpl == jid) notFound

        Entity tdid _ <- getBy404 $ UniqueTicketDependency ptid ctid
        delete tdid
    setMessage "Ticket dependency removed."
    redirect $ ProjectTicketDepsR shr prj pnum
-}

getProjectTicketParticipantsR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getProjectTicketParticipantsR shr prj ltkhid = getFollowersCollection here getFsid
    where
    here = ProjectTicketParticipantsR shr prj ltkhid
    getFsid = do
        (_es, _ej, _et, Entity _ lt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid
        return $ localTicketFollowers lt

getProjectTicketTeamR
    :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getProjectTicketTeamR shr prj ltkhid = do
    memberShrs <- runDB $ do
        (Entity sid _, _ej, _et, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid
        id_ <-
            requireEitherAlt
                (getKeyBy $ UniquePersonIdent sid)
                (getKeyBy $ UniqueGroup sid)
                "Found sharer that is neither person nor group"
                "Found sharer that is both person and group"
        case id_ of
            Left pid -> return [shr]
            Right gid -> do
                pids <-
                    map (groupMemberPerson . entityVal) <$>
                        selectList [GroupMemberGroup ==. gid] []
                sids <-
                    map (personIdent . entityVal) <$>
                        selectList [PersonId <-. pids] []
                map (sharerIdent . entityVal) <$>
                    selectList [SharerId <-. sids] []

    let here = ProjectTicketTeamR shr prj ltkhid

    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    let team = Collection
            { collectionId         = encodeRouteLocal here
            , collectionType       = CollectionTypeUnordered
            , collectionTotalItems = Just $ length memberShrs
            , collectionCurrent    = Nothing
            , collectionFirst      = Nothing
            , collectionLast       = Nothing
            , collectionItems      = map (encodeRouteHome . SharerR) memberShrs
            }
    provideHtmlAndAP team $ redirectToPrettyJSON here

getSharerTicketsR :: ShrIdent -> Handler TypedContent
getSharerTicketsR =
    getSharerWorkItems SharerTicketsR SharerTicketR countTickets selectTickets
    where
    countTickets pid = fmap toOne $
        E.select $ E.from $ \ (tal `E.InnerJoin` lt `E.LeftOuterJoin` tup `E.LeftOuterJoin` bn) -> do
            E.on $ E.just (lt E.^. LocalTicketTicket) E.==. bn E.?. BundleTicket
            E.on $ E.just (tal E.^. TicketAuthorLocalId) E.==. tup E.?. TicketUnderProjectAuthor
            E.on $ tal E.^. TicketAuthorLocalTicket E.==. lt E.^. LocalTicketId
            E.where_ $
                tal E.^. TicketAuthorLocalAuthor E.==. E.val pid E.&&.
                E.isNothing (tup E.?. TicketUnderProjectId) E.&&.
                E.isNothing (bn E.?. BundleId)
            return $ E.count $ tal E.^. TicketAuthorLocalId
        where
        toOne [x] = E.unValue x
        toOne []  = error "toOne = 0"
        toOne _   = error "toOne > 1"
    selectTickets pid off lim =
        E.select $ E.from $ \ (tal `E.InnerJoin` lt `E.LeftOuterJoin` tup `E.LeftOuterJoin` bn) -> do
            E.on $ E.just (lt E.^. LocalTicketTicket) E.==. bn E.?. BundleTicket
            E.on $ E.just (tal E.^. TicketAuthorLocalId) E.==. tup E.?. TicketUnderProjectAuthor
            E.on $ tal E.^. TicketAuthorLocalTicket E.==. lt E.^. LocalTicketId
            E.where_ $
                tal E.^. TicketAuthorLocalAuthor E.==. E.val pid E.&&.
                E.isNothing (tup E.?. TicketUnderProjectId) E.&&.
                E.isNothing (bn E.?. BundleId)
            E.orderBy [E.desc $ tal E.^. TicketAuthorLocalId]
            E.offset $ fromIntegral off
            E.limit $ fromIntegral lim
            return $ tal E.^. TicketAuthorLocalId

getSharerTicketR
    :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerTicketR shr talkhid = do
    (ticket, project, massignee, mresolved) <- runDB $ do
        (_, _, Entity _ t, tp, tr) <- getSharerTicket404 shr talkhid
        (,,,) t
            <$> bitraverse
                    (\ (_, Entity _ tpl) -> do
                        j <- getJust $ ticketProjectLocalProject tpl
                        s <- getJust $ projectSharer j
                        return (s, j)
                    )
                    (\ (Entity _ tpr, _) -> do
                        roid <-
                            case ticketProjectRemoteProject tpr of
                                Nothing ->
                                    remoteActorIdent <$>
                                        getJust (ticketProjectRemoteTracker tpr)
                                Just roid -> return roid
                        ro <- getJust roid
                        i <- getJust $ remoteObjectInstance ro
                        return (i, ro)
                    )
                    tp
            <*> (for (ticketAssignee t) $ \ pidAssignee -> do
                    p <- getJust pidAssignee
                    getJust $ personIdent p
                )
            <*> (for tr $ \ (_, etrx) ->
                    bitraverse
                        (\ (Entity _ trl) -> do
                            let obiid = ticketResolveLocalActivity trl
                            obid <- outboxItemOutbox <$> getJust obiid
                            ent <- getOutboxActorEntity obid
                            actor <- actorEntityPath ent
                            return (actor, obiid)
                        )
                        (\ (Entity _ trr) -> do
                            roid <-
                                remoteActivityIdent <$>
                                    getJust (ticketResolveRemoteActivity trr)
                            ro <- getJust roid
                            i <- getJust $ remoteObjectInstance ro
                            return (i, ro)
                        )
                        etrx
                )
    hLocal <- getsYesod siteInstanceHost
    encodeRouteLocal <- getEncodeRouteLocal
    encodeRouteHome <- getEncodeRouteHome
    encodeKeyHashid <- getEncodeKeyHashid
    let ticketAP = AP.Ticket
            { AP.ticketLocal        = Just
                ( hLocal
                , AP.TicketLocal
                    { AP.ticketId =
                        encodeRouteLocal $ SharerTicketR shr talkhid
                    , AP.ticketReplies =
                        encodeRouteLocal $ SharerTicketDiscussionR shr talkhid
                    , AP.ticketParticipants =
                        encodeRouteLocal $ SharerTicketFollowersR shr talkhid
                    , AP.ticketTeam =
                        Just $ encodeRouteLocal $ SharerTicketTeamR shr talkhid
                    , AP.ticketEvents =
                        encodeRouteLocal $ SharerTicketEventsR shr talkhid
                    , AP.ticketDeps =
                        encodeRouteLocal $ SharerTicketDepsR shr talkhid
                    , AP.ticketReverseDeps =
                        encodeRouteLocal $ SharerTicketReverseDepsR shr talkhid
                    }
                )
            , AP.ticketAttributedTo = encodeRouteLocal $ SharerR shr
            , AP.ticketPublished    = Just $ ticketCreated ticket
            , AP.ticketUpdated      = Nothing
            , AP.ticketContext      =
                Just $
                    case project of
                        Left (s, j) ->
                            encodeRouteHome $
                                ProjectR (sharerIdent s) (projectIdent j)
                        Right (i, ro) ->
                            ObjURI (instanceHost i) (remoteObjectIdent ro)
            , AP.ticketSummary      = encodeEntities $ ticketTitle ticket
            , AP.ticketContent      = ticketDescription ticket
            , AP.ticketSource       = ticketSource ticket
            , AP.ticketAssignedTo   =
                encodeRouteHome . SharerR . sharerIdent <$> massignee
            , AP.ticketResolved     =
                let u (Left (actor, obiid)) =
                        encodeRouteHome $
                            outboxItemRoute actor $ encodeKeyHashid obiid
                    u (Right (i, ro)) =
                        ObjURI (instanceHost i) (remoteObjectIdent ro)
                in  (,Nothing) . Just . u <$> mresolved
            , AP.ticketAttachment   = Nothing
            }
    provideHtmlAndAP ticketAP $ redirectToPrettyJSON here
    where
    here = SharerTicketR shr talkhid

getSharerTicketDepsR
    :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerTicketDepsR shr talkhid =
    getDependencyCollection here getLocalTicketId404
    where
    here = SharerTicketDepsR shr talkhid
    getLocalTicketId404 = do
        (_, Entity ltid _, _, _, _) <- getSharerTicket404 shr talkhid
        return ltid

getSharerTicketReverseDepsR
    :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerTicketReverseDepsR shr talkhid =
    getReverseDependencyCollection here getLocalTicketId404
    where
    here = SharerTicketReverseDepsR shr talkhid
    getLocalTicketId404 = do
        (_, Entity ltid _, _, _, _) <- getSharerTicket404 shr talkhid
        return ltid

getSharerTicketTeamR
    :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerTicketTeamR shr talkhid = do
    _ <- runDB $ getSharerTicket404 shr talkhid
    provideEmptyCollection
        CollectionTypeUnordered
        (SharerTicketTeamR shr talkhid)

getSharerTicketEventsR
    :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerTicketEventsR shr talkhid = do
    _ <- runDB $ getSharerTicket404 shr talkhid
    provideEmptyCollection
        CollectionTypeOrdered
        (SharerTicketEventsR shr talkhid)
-}