{- This file is part of Vervis. - - Written in 2020 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.Patch ( getSharerProposal , getSharerProposal404 , getRepoProposal , getRepoProposal404 ) where import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader import Data.List.NonEmpty (NonEmpty, nonEmpty) import Data.Maybe import Data.Traversable import Database.Persist import Database.Persist.Sql import Yesod.Core import Yesod.Hashids import Data.Either.Local import Database.Persist.Local import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident getResolved :: MonadIO m => LocalTicketId -> ReaderT SqlBackend m (Maybe ( Entity TicketResolve , Either (Entity TicketResolveLocal) (Entity TicketResolveRemote) ) ) getResolved ltid = do metr <- getBy $ UniqueTicketResolve ltid for metr $ \ etr@(Entity trid _) -> (etr,) <$> requireEitherAlt (getBy $ UniqueTicketResolveLocal trid) (getBy $ UniqueTicketResolveRemote trid) "No TRX" "Both TRL and TRR" getSharerProposal :: MonadIO m => ShrIdent -> TicketAuthorLocalId -> ReaderT SqlBackend m ( Maybe ( Entity TicketAuthorLocal , Entity LocalTicket , Entity Ticket , Either ( Entity TicketContextLocal , Entity TicketRepoLocal ) ( Entity TicketProjectRemote , Maybe (Entity TicketProjectRemoteAccept) ) , Maybe ( Entity TicketResolve , Either (Entity TicketResolveLocal) (Entity TicketResolveRemote) ) , NonEmpty BundleId ) ) getSharerProposal shr talid = runMaybeT $ do pid <- do sid <- MaybeT $ getKeyBy $ UniqueSharer shr MaybeT $ getKeyBy $ UniquePersonIdent sid tal <- MaybeT $ get talid guard $ ticketAuthorLocalAuthor tal == pid let ltid = ticketAuthorLocalTicket tal lt <- lift $ getJust ltid let tid = localTicketTicket lt t <- lift $ getJust tid bnids <- MaybeT $ nonEmpty <$> selectKeysList [BundleTicket ==. tid] [Desc BundleId] repo <- requireEitherAlt (do mtcl <- lift $ getBy $ UniqueTicketContextLocal tid for mtcl $ \ etcl@(Entity tclid _) -> do etrl <- MaybeT $ getBy $ UniqueTicketRepoLocal tclid mtup1 <- lift $ getBy $ UniqueTicketUnderProjectProject tclid mtup2 <- lift $ getBy $ UniqueTicketUnderProjectAuthor talid unless (isJust mtup1 == isJust mtup2) $ error "TUP points to unrelated TAL and TCL!" guard $ not $ isJust mtup1 return (etcl, etrl) ) (do mtpr <- lift $ getBy $ UniqueTicketProjectRemote talid lift $ for mtpr $ \ etpr@(Entity tprid _) -> (etpr,) <$> getBy (UniqueTicketProjectRemoteAccept tprid) ) "MR doesn't have context" "MR has both local and remote context" mresolved <- lift $ getResolved ltid return (Entity talid tal, Entity ltid lt, Entity tid t, repo, mresolved, bnids) getSharerProposal404 :: ShrIdent -> KeyHashid TicketAuthorLocal -> AppDB ( Entity TicketAuthorLocal , Entity LocalTicket , Entity Ticket , Either ( Entity TicketContextLocal , Entity TicketRepoLocal ) ( Entity TicketProjectRemote , Maybe (Entity TicketProjectRemoteAccept) ) , Maybe ( Entity TicketResolve , Either (Entity TicketResolveLocal) (Entity TicketResolveRemote) ) , NonEmpty BundleId ) getSharerProposal404 shr talkhid = do talid <- decodeKeyHashid404 talkhid mpatch <- getSharerProposal shr talid case mpatch of Nothing -> notFound Just patch -> return patch getRepoProposal :: MonadIO m => ShrIdent -> RpIdent -> LocalTicketId -> ReaderT SqlBackend m ( Maybe ( Entity Sharer , Entity Repo , Entity Ticket , Entity LocalTicket , Entity TicketContextLocal , Entity TicketRepoLocal , Either (Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorRemote) , Maybe ( Entity TicketResolve , Either (Entity TicketResolveLocal) (Entity TicketResolveRemote) ) , NonEmpty BundleId ) ) getRepoProposal shr rp ltid = runMaybeT $ do es@(Entity sid _) <- MaybeT $ getBy $ UniqueSharer shr er@(Entity rid _) <- MaybeT $ getBy $ UniqueRepo rp sid lt <- MaybeT $ get ltid let tid = localTicketTicket lt t <- MaybeT $ get tid etcl@(Entity tclid _) <- MaybeT $ getBy $ UniqueTicketContextLocal tid etrl@(Entity _ trl) <- MaybeT $ getBy $ UniqueTicketRepoLocal tclid guard $ ticketRepoLocalRepo trl == rid bnids <- MaybeT $ nonEmpty <$> selectKeysList [BundleTicket ==. tid] [Desc BundleId] author <- requireEitherAlt (do mtal <- lift $ getBy $ UniqueTicketAuthorLocal ltid for mtal $ \ tal@(Entity talid _) -> do tupid1 <- MaybeT $ getKeyBy $ UniqueTicketUnderProjectProject tclid tup@(Entity tupid2 _) <- MaybeT $ getBy $ UniqueTicketUnderProjectAuthor talid unless (tupid1 == tupid2) $ error "TAL and TPL used by different TUPs!" return (tal, tup) ) (lift $ getBy $ UniqueTicketAuthorRemote tclid) "MR doesn't have author" "MR has both local and remote author" mresolved <- lift $ getResolved ltid return (es, er, Entity tid t, Entity ltid lt, etcl, etrl, author, mresolved, bnids) getRepoProposal404 :: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> AppDB ( Entity Sharer , Entity Repo , Entity Ticket , Entity LocalTicket , Entity TicketContextLocal , Entity TicketRepoLocal , Either (Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorRemote) , Maybe ( Entity TicketResolve , Either (Entity TicketResolveLocal) (Entity TicketResolveRemote) ) , NonEmpty BundleId ) getRepoProposal404 shr rp ltkhid = do ltid <- decodeKeyHashid404 ltkhid mpatch <- getRepoProposal shr rp ltid case mpatch of Nothing -> notFound Just patch -> return patch