diff --git a/config/routes b/config/routes index 9aef6e7..28a5801 100644 --- a/config/routes +++ b/config/routes @@ -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 diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 42b22c2..71d3e9c 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -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 ) diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 6c215e7..2a679d1 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -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 diff --git a/src/Vervis/Handler/Repo/Git.hs b/src/Vervis/Handler/Repo/Git.hs index ffc1c16..1946788 100644 --- a/src/Vervis/Handler/Repo/Git.hs +++ b/src/Vervis/Handler/Repo/Git.hs @@ -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 diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 1760da1..30d668a 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -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