AP representation of git repo branches & preparation for Push activities

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

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
                                             )

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

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

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