AP representation of git repo branches & preparation for Push activities

This commit is contained in:
fr33domlover 2019-08-28 15:31:40 +00:00
parent 704b0550f5
commit d4d45c6fe7
5 changed files with 91 additions and 0 deletions

View file

@ -81,6 +81,7 @@
/s/#ShrIdent/r/#RpIdent/edit RepoEditR GET
/s/#ShrIdent/r/#RpIdent/s/+Texts RepoSourceR GET
/s/#ShrIdent/r/#RpIdent/c RepoHeadChangesR GET
/s/#ShrIdent/r/#RpIdent/b/#Text RepoBranchR GET
/s/#ShrIdent/r/#RpIdent/c/#Text RepoChangesR GET
/s/#ShrIdent/r/#RpIdent/p/#Text RepoPatchR GET
/s/#ShrIdent/r/#RpIdent/d RepoDevsR GET POST

View file

@ -794,6 +794,7 @@ instance YesodBreadcrumbs App where
init refdir
)
RepoHeadChangesR shar repo -> ("Changes", Just $ RepoR shar repo)
RepoBranchR shar repo ref -> (ref, Just $ RepoR shar repo)
RepoChangesR shar repo ref -> ( ref
, Just $ RepoHeadChangesR shar repo
)

View file

@ -24,6 +24,7 @@ module Vervis.Handler.Repo
, getRepoEditR
, getRepoSourceR
, getRepoHeadChangesR
, getRepoBranchR
, getRepoChangesR
, getRepoPatchR
, getRepoDevsR
@ -256,6 +257,13 @@ getRepoHeadChangesR user repo = do
VCSDarcs -> getDarcsRepoHeadChanges user repo
VCSGit -> getGitRepoHeadChanges repository user repo
getRepoBranchR :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
getRepoBranchR shar repo ref = do
repository <- runDB $ selectRepo shar repo
case repoVcs repository of
VCSDarcs -> notFound
VCSGit -> getGitRepoBranch shar repo ref
getRepoChangesR :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
getRepoChangesR shar repo ref = do
repository <- runDB $ selectRepo shar repo

View file

@ -16,6 +16,7 @@
module Vervis.Handler.Repo.Git
( getGitRepoSource
, getGitRepoHeadChanges
, getGitRepoBranch
, getGitRepoChanges
, getGitPatch
)
@ -113,6 +114,22 @@ 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
(branches, _tags) <- liftIO $ G.listRefs path
if ref `S.member` branches
then do
encodeRouteLocal <- getEncodeRouteLocal
let here = RepoBranchR shar repo ref
branchAP = Branch
{ branchName = ref
, branchRef = "refs/heads/" <> ref
, branchRepo = encodeRouteLocal $ RepoR shar repo
}
provideHtmlAndAP branchAP $ redirectToPrettyJSON here
else notFound
getGitRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
getGitRepoChanges shar repo ref = do
path <- askRepoDir shar repo

View file

@ -48,12 +48,14 @@ module Web.ActivityPub
, Author (..)
, Hash (..)
, Commit (..)
, Branch (..)
-- * Activity
, Accept (..)
, Create (..)
, Follow (..)
, Offer (..)
, Push (..)
, Reject (..)
, Audience (..)
, SpecificActivity (..)
@ -119,6 +121,7 @@ import qualified Data.Attoparsec.ByteString as A
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.HashMap.Strict as M
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Network.HTTP.Signature as S
@ -922,6 +925,32 @@ instance ActivityPub Commit where
<> "created" .= written
<> "committed" .=? mcommitted
data Branch u = Branch
{ branchName :: Text
, branchRef :: Text
, branchRepo :: LocalURI
}
instance ActivityPub Branch where
jsonldContext _ = [as2Context, forgeContext]
parseObject o = do
typ <- o .: "type"
unless (typ == ("Branch" :: Text)) $
fail "type isn't Branch"
ObjURI a repo <- o .: "context"
fmap (a,) $
Branch
<$> o .: "name"
<*> o .: "ref"
<*> pure repo
toSeries authority (Branch name ref repo)
= "type" .= ("Branch" :: Text)
<> "name" .= name
<> "ref" .= ref
<> "context" .= ObjURI authority repo
data Accept u = Accept
{ acceptObject :: ObjURI u
, acceptResult :: LocalURI
@ -991,6 +1020,37 @@ encodeOffer authority actor (Offer obj target)
= "object" `pair` pairs (toSeries authority obj)
<> "target" .= target
data Push u = Push
{ pushCommits :: NonEmpty (Commit u)
, pushCommitsTotal :: Int
, pushTarget :: LocalURI
, pushHashBefore :: Text
, pushHashAfter :: Text
}
parsePush :: UriMode u => Authority u -> Object -> Parser (Push u)
parsePush a o = do
c <- o .: "object"
Push
<$> (traverse (withAuthorityT a . parseObject) =<< c .: "items")
<*> c .: "totalItems"
<*> withAuthorityO a (o .: "target")
<*> o .: "hashBefore"
<*> o .: "hashAfter"
encodePush :: UriMode u => Authority u -> Push u -> Series
encodePush a (Push commits total target before after)
= "object" `pair` pairs
( "type" .= ("OrderedCollection" :: Text)
<> pair
"items"
(listEncoding (pairs . toSeries a) (NE.toList commits))
<> "totalItems" .= total
)
<> "target" .= ObjURI a target
<> "hashBefore" .= before
<> "hashAfter" .= after
data Reject u = Reject
{ rejectObject :: ObjURI u
}
@ -1006,6 +1066,7 @@ data SpecificActivity u
| CreateActivity (Create u)
| FollowActivity (Follow u)
| OfferActivity (Offer u)
| PushActivity (Push u)
| RejectActivity (Reject u)
data Activity u = Activity
@ -1033,6 +1094,7 @@ instance ActivityPub Activity where
"Create" -> CreateActivity <$> parseCreate o a actor
"Follow" -> FollowActivity <$> parseFollow o
"Offer" -> OfferActivity <$> parseOffer o a actor
"Push" -> PushActivity <$> parsePush a o
"Reject" -> RejectActivity <$> parseReject o
_ ->
fail $
@ -1050,11 +1112,13 @@ instance ActivityPub Activity where
activityType (CreateActivity _) = "Create"
activityType (FollowActivity _) = "Follow"
activityType (OfferActivity _) = "Offer"
activityType (PushActivity _) = "Push"
activityType (RejectActivity _) = "Reject"
encodeSpecific h _ (AcceptActivity a) = encodeAccept h a
encodeSpecific h u (CreateActivity a) = encodeCreate h u a
encodeSpecific _ _ (FollowActivity a) = encodeFollow a
encodeSpecific h u (OfferActivity a) = encodeOffer h u a
encodeSpecific h _ (PushActivity a) = encodePush h a
encodeSpecific _ _ (RejectActivity a) = encodeReject a
typeActivityStreams2 :: ContentType