{- This file is part of Vervis.
 -
 - Written in 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.Fetch
    ( Result (..)
    , httpGetRemoteTip
    , httpGetRemoteRepo
    )
where

import Control.Applicative
import Control.Exception.Base
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Data.Align
import Data.Barbie
import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable
import Data.Foldable
import Data.Functor
import Data.Functor.Identity
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe
import Data.Text (Text)
import Data.These
import Data.Time.Clock
import Data.Traversable
import Database.Persist hiding (deleteBy)
import Database.Persist.Sql hiding (deleteBy)
import Network.HTTP.Client
import System.Directory
import System.Exit
import System.FilePath
import System.IO.Temp
import System.Process.Typed
import Text.Blaze.Html.Renderer.Text
import Yesod.Core hiding (logError, logWarn, logInfo, logDebug)
import Yesod.Persist.Core

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL

import Database.Persist.JSON
import Development.PatchMediaType
import Network.FedURI
import Web.ActivityPub hiding (Patch, Ticket, Follow, Repo (..), ActorLocal (..), ActorDetail (..), Actor (..))
import Web.Text
import Yesod.ActivityPub
import Yesod.FedURI
import Yesod.Hashids
import Yesod.MonadSite

import qualified Web.ActivityPub as AP

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

import qualified Data.Git.Local as G (createRepo)
import qualified Data.Text.UTF8.Local as TU
import qualified Darcs.Local.Repository as D (createRepo)

import Vervis.Access
import Vervis.ActivityPub
import Vervis.Cloth
import Vervis.Data.Actor
import Vervis.Data.Collab
import Vervis.Data.Ticket
import Vervis.Web.Delivery
import Vervis.FedURI
import Vervis.Foundation
import Vervis.Model
import Vervis.Model.Ident
import Vervis.Model.Role
import Vervis.Model.Workflow
import Vervis.Model.Ticket
import Vervis.Path
import Vervis.Persist.Actor
import Vervis.Persist.Collab
import Vervis.Recipient
import Vervis.RemoteActorStore
import Vervis.Settings
import Vervis.Query
import Vervis.Ticket

data Result
    = ResultSomeException SomeException
    | ResultIdMismatch
    | ResultGetError APGetError
    | ResultNotActor
    deriving Show

fetchRepoE :: (MonadSite m, SiteEnv m ~ App) => Host -> LocalURI -> ExceptT Result m (AP.Repo URIMode)
fetchRepoE h lu = do
    manager <- asksSite getHttpManager
    let apRepoId = AP.actorId . AP.actorLocal . AP.repoActor
    ExceptT $ first (maybe ResultIdMismatch ResultGetError) <$>
        fetchAPID' manager apRepoId h lu

insertRemoteActor
    :: MonadIO m
    => Host
    -> LocalURI
    -> AP.Actor URIMode
    -> ReaderT SqlBackend m RemoteActorId
insertRemoteActor h lu (AP.Actor local detail) = do
    iid <- either entityKey id <$> insertBy' (Instance h)
    roid <- either entityKey id <$> insertBy' (RemoteObject iid lu)
    let ra = RemoteActor
            { remoteActorIdent      = roid
            , remoteActorName       =
                AP.actorName detail <|> AP.actorUsername detail
            , remoteActorInbox      = AP.actorInbox local
            , remoteActorFollowers  = AP.actorFollowers local
            , remoteActorErrorSince = Nothing
            }
    either entityKey id <$> insertBy' ra

httpGetRemoteTip
    :: (MonadUnliftIO m, MonadSite m, SiteEnv m ~ App)
    => FedURI
    -> ExceptT Result m
        ( VersionControlSystem
        , RemoteActorId
        , FedURI
        , Maybe (LocalURI, Text)
        )
httpGetRemoteTip (ObjURI host localURI) = do
    repoOrBranch <- fetchTipE host localURI
    case repoOrBranch of
        Left repo -> do
            remoteActorID <-
                lift $ runSiteDB $
                    insertRemoteActor host localURI $ AP.repoActor repo
            let uClone = ObjURI host $ NE.head $ AP.repoClone repo
            return (AP.repoVcs repo, remoteActorID, uClone, Nothing)
        Right (AP.Branch name _ luRepo) -> do
            repo <- fetchRepoE host luRepo
            remoteActorID <-
                lift $ runSiteDB $
                    insertRemoteActor host luRepo $ AP.repoActor repo
            let uClone = ObjURI host $ NE.head $ AP.repoClone repo
            return (AP.repoVcs repo, remoteActorID, uClone, Just (localURI, name))
    where
    fetchTipE h lu = do
        manager <- asksSite getHttpManager
        ExceptT $ first (maybe ResultIdMismatch ResultGetError) <$>
            fetchTip manager h lu

httpGetRemoteRepo
    :: (MonadUnliftIO m, MonadSite m, SiteEnv m ~ App)
    => FedURI
    -> ExceptT Result m (VersionControlSystem, RemoteActorId, FedURI)
httpGetRemoteRepo (ObjURI host localURI) = do
    repo <- fetchRepoE host localURI
    remoteActorID <-
        lift $ runSiteDB $
            insertRemoteActor host localURI $ AP.repoActor repo
    let uClone = ObjURI host $ NE.head $ AP.repoClone repo
    return (AP.repoVcs repo, remoteActorID, uClone)