diff --git a/src/Vervis/Darcs.hs b/src/Vervis/Darcs.hs index 248790d..d02976e 100644 --- a/src/Vervis/Darcs.hs +++ b/src/Vervis/Darcs.hs @@ -19,8 +19,8 @@ module Vervis.Darcs --, readWikiView --, readChangesView --, lastChange - --, readPatch - writePostApplyHooks + readPatch + , writePostApplyHooks --, applyDarcsPatch ) where @@ -261,6 +261,7 @@ lastChange path now = fmap maybeRight $ runExceptT $ do intervalToEventTime $ FriendlyConvert $ now `diffUTCTime` piTime pi +-} data Change = AddFile FilePath @@ -389,7 +390,6 @@ readPatch path hash = handle $ runExceptT $ do mkedit' (Replace fp regex old new) = AddTextFile "Replace" 0 [T.concat ["replace ", T.pack fp, " ", regex, " ", old, " ", new]] mkedit' (Binary fp old new) = EditBinaryFile fp (fromIntegral $ B.length old) 0 (fromIntegral $ B.length new) 0 mkedit' (Pref pref old new) = AddTextFile "Pref" 0 [T.concat ["changepref ", pref, " ", old, " ", new]] --} writePostApplyHooks :: WorkerDB () writePostApplyHooks = do diff --git a/src/Vervis/Git.hs b/src/Vervis/Git.hs index 5d549a7..b85622b 100644 --- a/src/Vervis/Git.hs +++ b/src/Vervis/Git.hs @@ -15,15 +15,12 @@ -} module Vervis.Git - ( - {- - readSourceView - , readChangesView - , listRefs - , readPatch - , lastCommitTime - -} - writePostReceiveHooks + ( --readSourceView + --, readChangesView + --, listRefs + readPatch + --, lastCommitTime + , writePostReceiveHooks --, applyGitPatches ) where @@ -216,6 +213,7 @@ readChangesView path ref off lim = G.withRepo (fromString path) $ \ git -> do listRefs :: FilePath -> IO (Set Text, Set Text) listRefs path = G.withRepo (fromString path) $ \ git -> (,) <$> listBranches git <*> listTags git +-} patch :: [Edit] -> Commit SHA1 -> P.Patch patch edits c = P.Patch @@ -325,6 +323,7 @@ readPatch path hash = G.withRepo (fromString path) $ \ git -> do Left parents -> (patch [] c, parents) Right edits -> (patch edits c, []) +{- lastCommitTime :: FilePath -> IO (Maybe UTCTime) lastCommitTime repo = (either fail return =<<) $ fmap join $ withRepo (fromString repo) $ runExceptT $ do diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index d78a6b4..9b62bf0 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -166,6 +166,8 @@ import Vervis.Settings import Vervis.SourceTree import Vervis.Style import Vervis.Web.Actor +import Vervis.Web.Darcs +import Vervis.Web.Git import qualified Vervis.Client as C import qualified Vervis.Formatting as F @@ -398,14 +400,11 @@ getRepoBranchCommitsR repoHash branch = do getRepoCommitR :: KeyHashid Repo -> Text -> Handler TypedContent getRepoCommitR repoHash ref = do - error "Temporarily disabled" - {- repoID <- decodeKeyHashid404 repoHash repo <- runDB $ get404 repoID case repoVcs repo of VCSDarcs -> getDarcsPatch repoHash ref VCSGit -> getGitPatch repoHash ref - -} getRepoNewR :: Handler Html getRepoNewR = do diff --git a/src/Vervis/Handler/Repo/Darcs.hs b/src/Vervis/Web/Darcs.hs similarity index 93% rename from src/Vervis/Handler/Repo/Darcs.hs rename to src/Vervis/Web/Darcs.hs index 3f1ba41..fcecb11 100644 --- a/src/Vervis/Handler/Repo/Darcs.hs +++ b/src/Vervis/Web/Darcs.hs @@ -13,11 +13,11 @@ - . -} -module Vervis.Handler.Repo.Darcs - ( getDarcsRepoSource - , getDarcsRepoHeadChanges - , getDarcsRepoChanges - , getDarcsPatch +module Vervis.Web.Darcs + ( --getDarcsRepoSource + --, getDarcsRepoHeadChanges + --, getDarcsRepoChanges + getDarcsPatch ) where @@ -47,9 +47,11 @@ import qualified Data.Text as T import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With) import Data.MediaType +import Development.PatchMediaType import Web.ActivityPub hiding (Repo, Project) import Yesod.ActivityPub import Yesod.FedURI +import Yesod.Hashids import Yesod.RenderSource import Data.ByteString.Char8.Local (takeLine) @@ -63,17 +65,17 @@ import Vervis.Changes import Vervis.Foundation import Vervis.Path import Vervis.Model -import Vervis.Model.Ident -import Development.PatchMediaType import Vervis.Paginate import Vervis.Readme import Vervis.Settings import Vervis.SourceTree import Vervis.Style import Vervis.Time +import Vervis.Web.Repo -import qualified Vervis.Darcs as D (readSourceView, readChangesView, readPatch) +import qualified Vervis.Darcs as D +{- getDarcsRepoSource :: (Maybe (Sharer, Project, Workflow, Sharer), Repo) -> ShrIdent -> RpIdent -> [Text] -> Handler Html getDarcsRepoSource (mproject, repository) user repo dir = do path <- askRepoDir user repo @@ -97,7 +99,9 @@ getDarcsRepoSource (mproject, repository) user repo dir = do (RepoFollowR user repo) (RepoUnfollowR user repo) (return $ repoFollowers repository) +-} +{- getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler TypedContent getDarcsRepoHeadChanges shar repo = do path <- askRepoDir shar repo @@ -153,14 +157,17 @@ getDarcsRepoHeadChanges shar repo = do let changes = changesW shar repo items pageNav = navWidget navModel in $(widgetFile "repo/changes-darcs") +-} +{- getDarcsRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler TypedContent getDarcsRepoChanges shar repo tag = notFound +-} -getDarcsPatch :: ShrIdent -> RpIdent -> Text -> Handler TypedContent -getDarcsPatch shr rp ref = do - path <- askRepoDir shr rp +getDarcsPatch :: KeyHashid Repo -> Text -> Handler TypedContent +getDarcsPatch hash ref = do + path <- askRepoDir hash mpatch <- liftIO $ D.readPatch path ref case mpatch of Nothing -> notFound - Just patch -> serveCommit shr rp ref patch [] + Just patch -> serveCommit hash ref patch [] diff --git a/src/Vervis/Handler/Repo/Git.hs b/src/Vervis/Web/Git.hs similarity index 93% rename from src/Vervis/Handler/Repo/Git.hs rename to src/Vervis/Web/Git.hs index 0303166..64d97d4 100644 --- a/src/Vervis/Handler/Repo/Git.hs +++ b/src/Vervis/Web/Git.hs @@ -1,6 +1,7 @@ {- This file is part of Vervis. - - - Written in 2016, 2018, 2019, 2020 by fr33domlover . + - Written in 2016, 2018, 2019, 2020, 2022 + - by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -13,12 +14,12 @@ - . -} -module Vervis.Handler.Repo.Git - ( getGitRepoSource - , getGitRepoHeadChanges - , getGitRepoBranch - , getGitRepoChanges - , getGitPatch +module Vervis.Web.Git + ( --getGitRepoSource + --, getGitRepoHeadChanges + --, getGitRepoBranch + --, getGitRepoChanges + getGitPatch ) where @@ -62,6 +63,7 @@ import Data.MediaType import Web.ActivityPub hiding (Commit, Author, Repo, Project) import Yesod.ActivityPub import Yesod.FedURI +import Yesod.Hashids import Yesod.RenderSource import qualified Web.ActivityPub as AP @@ -86,10 +88,12 @@ import Vervis.Settings import Vervis.SourceTree import Vervis.Style import Vervis.Time (showDate) +import Vervis.Web.Repo import qualified Data.ByteString.Lazy as BL (ByteString) -import qualified Vervis.Git as G (readSourceView, readChangesView, listRefs, readPatch) +import qualified Vervis.Git as G +{- getGitRepoSource :: (Maybe (Sharer, Project, Workflow, Sharer), Repo) -> ShrIdent -> RpIdent -> Text -> [Text] -> Handler Html getGitRepoSource (mproject, repository) user repo ref dir = do path <- askRepoDir user repo @@ -113,11 +117,15 @@ getGitRepoSource (mproject, repository) user repo ref dir = do (RepoFollowR user repo) (RepoUnfollowR user repo) (return $ repoFollowers repository) +-} +{- getGitRepoHeadChanges :: Repo -> ShrIdent -> RpIdent -> Handler TypedContent getGitRepoHeadChanges repository shar repo = getGitRepoChanges shar repo $ repoMainBranch repository +-} +{- getGitRepoBranch :: ShrIdent -> RpIdent -> Text -> Handler TypedContent getGitRepoBranch shar repo ref = do path <- askRepoDir shar repo @@ -133,7 +141,9 @@ getGitRepoBranch shar repo ref = do } provideHtmlAndAP branchAP $ redirectToPrettyJSON here else notFound +-} +{- getGitRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler TypedContent getGitRepoChanges shar repo ref = do path <- askRepoDir shar repo @@ -189,9 +199,10 @@ getGitRepoChanges shar repo ref = do changes = changesW shar repo items pageNav = navWidget navModel in $(widgetFile "repo/changes-git") +-} -getGitPatch :: ShrIdent -> RpIdent -> Text -> Handler TypedContent -getGitPatch shr rp ref = do - path <- askRepoDir shr rp +getGitPatch :: KeyHashid Repo -> Text -> Handler TypedContent +getGitPatch hash ref = do + path <- askRepoDir hash (patch, parents) <- liftIO $ G.readPatch path ref - serveCommit shr rp ref patch parents + serveCommit hash ref patch parents diff --git a/src/Vervis/Web/Repo.hs b/src/Vervis/Web/Repo.hs new file mode 100644 index 0000000..0460128 --- /dev/null +++ b/src/Vervis/Web/Repo.hs @@ -0,0 +1,94 @@ +{- This file is part of Vervis. + - + - Written in 2019, 2020, 2021, 2022 by fr33domlover . + - + - ♡ 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 + - . + -} + +module Vervis.Web.Repo + ( serveCommit + ) +where + +import Data.Text (Text) +import Data.Text.Encoding +import Data.Traversable +import Database.Persist +import Yesod.Core hiding (logError, logWarn, logInfo, logDebug) +import Yesod.Persist.Core + +import qualified Data.Text as T + +import Web.ActivityPub hiding (Author (..), Ticket, Repo, ActorLocal (..)) +import Yesod.ActivityPub +import Yesod.FedURI +import Yesod.Hashids + +import qualified Web.ActivityPub as AP + +import Data.Patch.Local hiding (Patch) + +import qualified Data.Patch.Local as P + +import Vervis.Foundation +import Vervis.Model +import Vervis.Settings +import Vervis.Time +import Vervis.Widget.Person +import Vervis.Widget.Repo + +serveCommit + :: KeyHashid Repo + -> Text + -> P.Patch + -> [Text] + -> Handler TypedContent +serveCommit repoHash ref patch parents = do + (mpersonWritten, mpersonCommitted) <- runDB $ (,) + <$> getPerson (patchWritten patch) + <*> maybe (pure Nothing) getPerson (patchCommitted patch) + encodeRouteLocal <- getEncodeRouteLocal + encodeRouteHome <- getEncodeRouteHome + hashPerson <- getEncodeKeyHashid + let (author, written) = patchWritten patch + mcommitter = patchCommitted patch + makeAuthor' = makeAuthor hashPerson encodeRouteHome + patchAP = AP.Commit + { commitId = encodeRouteLocal $ RepoCommitR repoHash ref + , commitRepository = encodeRouteLocal $ RepoR repoHash + , commitAuthor = makeAuthor' mpersonWritten author + , commitCommitter = + makeAuthor' mpersonCommitted . fst <$> mcommitter + , commitTitle = patchTitle patch + , commitHash = Hash $ encodeUtf8 ref + , commitDescription = + let desc = patchDescription patch + in if T.null desc + then Nothing + else Just desc + , commitWritten = written + , commitCommitted = snd <$> patchCommitted patch + } + provideHtmlAndAP patchAP $ + let number = zip ([1..] :: [Int]) + in $(widgetFile "repo/patch") + where + getPerson (author, _time) = do + mp <- getBy $ UniquePersonEmail $ authorEmail author + for mp $ \ ep@(Entity _ person) -> + (ep,) <$> getJust (personActor person) + + makeAuthor _ _ Nothing author = Left AP.Author + { AP.authorName = authorName author + , AP.authorEmail = authorEmail author + } + makeAuthor hashPerson encodeRouteHome (Just (Entity personID _, _)) _ = + Right $ encodeRouteHome $ PersonR $ hashPerson personID diff --git a/templates/repo/patch.hamlet b/templates/repo/patch.hamlet index 1eaad48..919e91e 100644 --- a/templates/repo/patch.hamlet +++ b/templates/repo/patch.hamlet @@ -16,14 +16,14 @@ $# . By - $maybe sharer <- msharerWritten - ^{sharerLinkW sharer} + $maybe (person, actor) <- mpersonWritten + ^{personLinkW person actor} $nothing #{authorName author} $maybe (committer, _) <- patchCommitted patch ; - $maybe sharer <- msharerCommitted - ^{sharerLinkW sharer} + $maybe (person, actor) <- mpersonCommitted + ^{personLinkW person actor} $nothing #{authorName committer} diff --git a/vervis.cabal b/vervis.cabal index 8750b63..5ee43c5 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -184,8 +184,6 @@ library Vervis.Handler.Loom Vervis.Handler.Person Vervis.Handler.Repo - --Vervis.Handler.Repo.Darcs - --Vervis.Handler.Repo.Git --Vervis.Handler.Role --Vervis.Handler.Sharer Vervis.Handler.Ticket @@ -228,6 +226,9 @@ library Vervis.Time Vervis.Web.Actor + Vervis.Web.Darcs + Vervis.Web.Git + Vervis.Web.Repo Vervis.Widget Vervis.Widget.Discussion