diff --git a/config/models b/config/models index e083ca1..38bba65 100644 --- a/config/models +++ b/config/models @@ -287,8 +287,10 @@ Project wiki RepoId Maybe collabUser RoleId Maybe collabAnon RoleId Maybe + create OutboxItemId - UniqueProjectActor actor + UniqueProjectActor actor + UniqueProjectCreate create UniqueProject ident sharer Repo @@ -645,3 +647,10 @@ CollabRecipRemote actor RemoteActorId UniqueCollabRecipRemote collab + +-------------------------------- Collab reason ------------------------------- + +CollabFulfillsLocalTopicCreation + collab CollabId + + UniqueCollabFulfillsLocalTopicCreation collab diff --git a/migrations/2022_07_24_collab_fulfills.model b/migrations/2022_07_24_collab_fulfills.model new file mode 100644 index 0000000..495575b --- /dev/null +++ b/migrations/2022_07_24_collab_fulfills.model @@ -0,0 +1,4 @@ +CollabFulfillsLocalTopicCreation + collab CollabId + + UniqueCollabFulfillsLocalTopicCreation collab diff --git a/migrations/2022_07_24_project_create.model b/migrations/2022_07_24_project_create.model new file mode 100644 index 0000000..30aa882 --- /dev/null +++ b/migrations/2022_07_24_project_create.model @@ -0,0 +1,52 @@ +Outbox + +OutboxItem + outbox OutboxId + activity PersistJSONObject + published UTCTime + +Project + actor Int64 + ident Text + sharer SharerId + name Text Maybe + desc Text Maybe + workflow Int64 + nextTicket Int + wiki Int64 Maybe + collabUser Int64 Maybe + collabAnon Int64 Maybe + create OutboxItemId + + UniqueProjectActor actor + UniqueProjectCreate create + UniqueProject ident sharer + +Sharer + ident Text + name Text Maybe + created UTCTime + + UniqueSharer ident + +Person + ident SharerId + login Text + passphraseHash ByteString + email Text + verified Bool + verifiedKey Text + verifiedKeyCreated UTCTime + resetPassKey Text + resetPassKeyCreated UTCTime + about Text + inbox Int64 + outbox OutboxId + followers Int64 + + UniquePersonIdent ident + UniquePersonLogin login + UniquePersonEmail email + UniquePersonInbox inbox + UniquePersonOutbox outbox + UniquePersonFollowers followers diff --git a/migrations/2022_07_25_collab_fulfills_mig.model b/migrations/2022_07_25_collab_fulfills_mig.model new file mode 100644 index 0000000..4458ef5 --- /dev/null +++ b/migrations/2022_07_25_collab_fulfills_mig.model @@ -0,0 +1,88 @@ +Collab + +CollabTopicLocalRepo + collab CollabId + repo RepoId + + UniqueCollabTopicLocalRepo collab + +CollabTopicLocalProject + collab CollabId + project ProjectId + + UniqueCollabTopicLocalProject collab + +CollabRecipLocal + collab CollabId + person PersonId + + UniqueCollabRecipLocal collab + +CollabFulfillsLocalTopicCreation + collab CollabId + + UniqueCollabFulfillsLocalTopicCreation collab + +Sharer + ident ShrIdent + name Text Maybe + created UTCTime + + UniqueSharer ident + +Person + ident SharerId + login Text + passphraseHash ByteString + email Text + verified Bool + verifiedKey Text + verifiedKeyCreated UTCTime + resetPassKey Text + resetPassKeyCreated UTCTime + about Text + inbox Int64 + outbox Int64 + followers Int64 + + UniquePersonIdent ident + UniquePersonLogin login + UniquePersonEmail email + UniquePersonInbox inbox + UniquePersonOutbox outbox + UniquePersonFollowers followers + +Project + actor Int64 + ident Text + sharer SharerId + name Text Maybe + desc Text Maybe + workflow Int64 + nextTicket Int + wiki RepoId Maybe + collabUser Int64 Maybe + collabAnon Int64 Maybe + create Int64 + + UniqueProjectActor actor + UniqueProjectCreate create + UniqueProject ident sharer + +Repo + ident Text + sharer SharerId + vcs Text + project ProjectId Maybe + desc Text Maybe + mainBranch Text + collabUser Int64 Maybe + collabAnon Int64 Maybe + inbox Int64 + outbox Int64 + followers Int64 + + UniqueRepo ident sharer + UniqueRepoInbox inbox + UniqueRepoOutbox outbox + UniqueRepoFollowers followers diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 4ff5b3f..5256da5 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -19,6 +19,7 @@ module Vervis.API , noteC , createNoteC , createTicketC + , createTicketTrackerC , followC , offerTicketC , offerDepC @@ -87,7 +88,7 @@ import Crypto.PublicVerifKey import Database.Persist.JSON import Network.FedURI import Network.HTTP.Digest -import Web.ActivityPub hiding (Patch, Ticket, Follow, Repo (..), ActorLocal (..)) +import Web.ActivityPub hiding (Patch, Ticket, Follow, Repo (..), ActorLocal (..), ActorDetail (..), Actor (..)) import Yesod.ActivityPub import Yesod.Auth.Unverified import Yesod.FedURI @@ -116,6 +117,7 @@ import Vervis.Git import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Role +import Vervis.Model.Workflow import Development.PatchMediaType import Vervis.Model.Ticket import Vervis.RemoteActorStore @@ -1729,6 +1731,191 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc accept] return accept +createTicketTrackerC + :: Entity Person + -> Sharer + -> Maybe TextHtml + -> Audience URIMode + -> AP.ActorDetail + -> Maybe FedURI + -> ExceptT Text Handler OutboxItemId +createTicketTrackerC (Entity pidUser personUser) sharerUser summary audience tracker muTarget = do + + -- Check input + (name, msummary) <- parseTracker tracker + let shrUser = sharerIdent sharerUser + now <- liftIO getCurrentTime + verifyNothingE muTarget "'target' not supported in Create TicketTracker" + ParsedAudience localRecips remoteRecips blinded fwdHosts <- do + mrecips <- parseAudience audience + fromMaybeE mrecips "Create TicketTracker with no recipients" + checkFederation remoteRecips + (obiid, deliverHttpCreate, deliverHttpGrant) <- runDBExcept $ do + + -- Insert new project to DB + obiidCreate <- lift $ insertEmptyOutboxItem (personOutbox personUser) now + wid <- findWorkflow $ personIdent personUser + (jid, prj, obidDeck, ibidDeck) <- lift $ insertDeck now name msummary obiidCreate wid + + -- Insert the Create activity to author's outbox + docCreate <- lift $ insertCreateToOutbox shrUser now blinded name msummary obiidCreate prj + + -- Deliver the Create activity to local recipients, and schedule + -- delivery for unavailable remote recipients + remoteRecipsHttpCreate <- do + let sieve = makeRecipientSet + [] + [LocalPersonCollectionSharerFollowers shrUser] + moreRemoteRecips <- + lift $ deliverLocal' True (LocalActorSharer shrUser) (personInbox personUser) obiidCreate $ + localRecipSieve sieve False localRecips + checkFederation moreRemoteRecips + lift $ deliverRemoteDB'' fwdHosts obiidCreate remoteRecips moreRemoteRecips + + -- Insert collaboration access for project's creator + obiidGrant <- lift $ insertEmptyOutboxItem obidDeck now + lift $ insertCollab jid obiidGrant + + -- Insert a Grant activity to project's outbox + let grantRecipActors = [LocalActorSharer shrUser] + grantRecipCollections = [LocalPersonCollectionSharerFollowers shrUser] + docGrant <- + lift $ insertGrantToOutbox shrUser prj obiidCreate obiidGrant grantRecipActors grantRecipCollections + + -- Deliver the Grant activity to local recipients, and schedule + -- delivery for unavailable remote recipients + remoteRecipsHttpGrant <- do + remoteRecips <- + lift $ deliverLocal' True (LocalActorProject shrUser prj) ibidDeck obiidGrant $ + makeRecipientSet grantRecipActors grantRecipCollections + checkFederation remoteRecips + lift $ deliverRemoteDB'' [] obiidGrant [] remoteRecips + + -- Return instructions for HTTP delivery to remote recipients + return + ( obiidCreate + , deliverRemoteHttp' fwdHosts obiidCreate docCreate remoteRecipsHttpCreate + , deliverRemoteHttp' [] obiidGrant docGrant remoteRecipsHttpGrant + ) + + -- Launch asynchronous HTTP delivery of Create and Grant + lift $ do + forkWorker "createTicketTrackerC: async HTTP Create delivery" deliverHttpCreate + forkWorker "createTicketTrackerC: async HTTP Grant delivery" deliverHttpGrant + + return obiid + where + parseTracker (AP.ActorDetail typ muser mname msummary) = do + unless (typ == AP.ActorTypeTicketTracker) $ + error "createTicketTrackerC: Create object isn't a TicketTracker" + verifyNothingE muser "TicketTracker can't have a username" + name <- fromMaybeE mname "TicketTracker doesn't specify name" + return (name, msummary) + + findWorkflow sid = do + mw <- + lift $ + selectFirst + ([WorkflowSharer ==. sid] ||. [WorkflowScope !=. WSSharer]) + [Asc WorkflowId] + entityKey <$> fromMaybeE mw "Can't find a suitable workflow" + + insertDeck now name msummary obiidCreate wid = do + ibid <- insert Inbox + obid <- insert Outbox + fsid <- insert FollowerSet + aid <- insert Actor + { actorName = name + , actorDesc = fromMaybe "" msummary + , actorCreatedAt = now + , actorInbox = ibid + , actorOutbox = obid + , actorFollowers = fsid + } + let ident = text2prj $ "actor_id_" <> T.pack (show $ fromSqlKey aid) + jid <- insert Project + { projectActor = aid + , projectIdent = ident + , projectSharer = personIdent personUser + , projectName = Just name + , projectDesc = msummary + , projectWorkflow = wid + , projectNextTicket = 1 + , projectWiki = Nothing + , projectCollabAnon = Nothing + , projectCollabUser = Nothing + , projectCreate = obiidCreate + } + return (jid, ident, obid, ibid) + + insertCreateToOutbox shrUser now blinded name msummary obiidCreate prj = do + encodeRouteLocal <- getEncodeRouteLocal + hLocal <- asksSite siteInstanceHost + obikhid <- encodeKeyHashid obiidCreate + let ttdetail = AP.ActorDetail + { AP.actorType = AP.ActorTypeTicketTracker + , AP.actorUsername = Nothing + , AP.actorName = Just name + , AP.actorSummary = msummary + } + ttlocal = AP.ActorLocal + { AP.actorId = encodeRouteLocal $ ProjectR shrUser prj + , AP.actorInbox = encodeRouteLocal $ ProjectInboxR shrUser prj + , AP.actorOutbox = Nothing + , AP.actorFollowers = Nothing + , AP.actorFollowing = Nothing + , AP.actorPublicKeys = [] + , AP.actorSshKeys = [] + } + create = Doc hLocal Activity + { activityId = Just $ encodeRouteLocal $ SharerOutboxItemR shrUser obikhid + , activityActor = encodeRouteLocal $ SharerR shrUser + , activityCapability = Nothing + , activitySummary = summary + , activityAudience = blinded + , activitySpecific = CreateActivity Create + { createObject = CreateTicketTracker ttdetail (Just (hLocal, ttlocal)) + , createTarget = Nothing + } + } + update obiidCreate [OutboxItemActivity =. persistJSONObjectFromDoc create] + return create + + insertCollab jid obiidGrant = do + cid <- insert Collab + insert_ $ CollabTopicLocalProject cid jid + insert_ $ CollabSenderLocal cid obiidGrant + insert_ $ CollabRecipLocal cid pidUser + insert_ $ CollabFulfillsLocalTopicCreation cid + + insertGrantToOutbox shrUser prj obiidCreate obiidGrant actors collections = do + encodeRouteLocal <- getEncodeRouteLocal + encodeRouteHome <- getEncodeRouteHome + hLocal <- asksSite siteInstanceHost + obikhidCreate <- encodeKeyHashid obiidCreate + obikhidGrant <- encodeKeyHashid obiidGrant + let recips = + map encodeRouteHome $ + map renderLocalActor actors ++ + map renderLocalPersonCollection collections + grant = Doc hLocal Activity + { activityId = + Just $ encodeRouteLocal $ + ProjectOutboxItemR shrUser prj obikhidGrant + , activityActor = encodeRouteLocal $ ProjectR shrUser prj + , activityCapability = Nothing + , activitySummary = Nothing + , activityAudience = Audience recips [] [] [] [] [] + , activitySpecific = GrantActivity Grant + { grantObject = Left RoleAdmin + , grantContext = encodeRouteHome $ ProjectR shrUser prj + , grantTarget = encodeRouteHome $ SharerR shrUser + , grantFulfills = Just $ encodeRouteHome $ SharerOutboxItemR shrUser obikhidCreate + } + } + update obiidGrant [OutboxItemActivity =. persistJSONObjectFromDoc grant] + return grant + data Followee = FolloweeSharer ShrIdent | FolloweeSharerTicket ShrIdent (KeyHashid TicketAuthorLocal) diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index 3fd852d..2f1bc9b 100644 --- a/src/Vervis/Client.hs +++ b/src/Vervis/Client.hs @@ -31,6 +31,7 @@ module Vervis.Client , unresolve , createMR , offerMR + , createDeck ) where @@ -683,3 +684,28 @@ offerMR shrAuthor title desc uContext muBranch typ diff = runExceptT $ do ) } return (Nothing, Audience recips [] [] [] [] [], ticket) + +createDeck + :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App) + => ShrIdent + -> Text + -> Maybe Text + -> m (Maybe TextHtml, Audience URIMode, AP.ActorDetail, Maybe FedURI) +createDeck shrAuthor name mdesc = do + encodeRouteHome <- getEncodeRouteHome + + let audAuthor = + AudLocal [] [LocalPersonCollectionSharerFollowers shrAuthor] + + (_, _, _, audLocal, audRemote) = collectAudience [audAuthor] + + recips = map encodeRouteHome audLocal ++ audRemote + + detail = AP.ActorDetail + { AP.actorType = AP.ActorTypeTicketTracker + , AP.actorUsername = Nothing + , AP.actorName = Just name + , AP.actorSummary = mdesc + } + + return (Nothing, Audience recips [] [] [] [] [], detail, Nothing) diff --git a/src/Vervis/Form/Project.hs b/src/Vervis/Form/Project.hs index 74ccf92..f72c23b 100644 --- a/src/Vervis/Form/Project.hs +++ b/src/Vervis/Form/Project.hs @@ -42,8 +42,7 @@ import Development.PatchMediaType import Vervis.Model.Workflow data NewProject = NewProject - { npIdent :: PrjIdent - , npName :: Maybe Text + { npName :: Text , npDesc :: Maybe Text , npWflow :: WorkflowId , npRole :: Maybe RoleId @@ -51,8 +50,7 @@ data NewProject = NewProject newProjectAForm :: SharerId -> AForm Handler NewProject newProjectAForm sid = NewProject - <$> areq (newProjectIdentField sid) "Identifier*" Nothing - <*> aopt textField "Name" Nothing + <$> areq textField "Name*" Nothing <*> aopt textField "Description" Nothing <*> areq selectWorkflow "Workflow*" Nothing <*> aopt selectRole "Custom role" Nothing @@ -123,6 +121,7 @@ editProjectAForm sid (Entity jid project) = Project <*> aopt selectWiki "Wiki" (Just $ projectWiki project) <*> aopt selectRole "User role" (Just $ projectCollabUser project) <*> aopt selectRole "Guest role" (Just $ projectCollabAnon project) + <*> pure (projectCreate project) where selectWiki = selectField $ diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index c1b3eb5..564df5f 100644 --- a/src/Vervis/Handler/Project.hs +++ b/src/Vervis/Handler/Project.hs @@ -32,6 +32,8 @@ module Vervis.Handler.Project ) where +import Control.Monad +import Control.Monad.Trans.Except import Data.Foldable import Data.Maybe (fromMaybe) import Data.Text (Text) @@ -40,7 +42,7 @@ import Data.Traversable import Database.Persist import Database.Esqueleto hiding (delete, (%), (==.)) import Text.Blaze.Html (Html) -import Yesod.Auth (requireAuthId) +import Yesod.Auth (requireAuth) import Yesod.Core import Yesod.Core.Handler (redirect, setMessage, lookupPostParam, notFound) import Yesod.Form.Functions (runFormPost) @@ -58,11 +60,13 @@ import Yesod.MonadSite import qualified Web.ActivityPub as AP +import Control.Monad.Trans.Except.Local import Data.Either.Local import Database.Persist.Local import Yesod.Persist.Local import Vervis.API +import Vervis.Client import Vervis.Federation import Vervis.Form.Project import Vervis.Foundation @@ -86,58 +90,31 @@ getProjectsR ident = do postProjectsR :: ShrIdent -> Handler Html postProjectsR shr = do - Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr + ep@(Entity _ p) <- requireAuth + Entity sid s <- runDB $ do + _ <- getBy404 $ UniqueSharer shr + getJustEntity $ personIdent p + unless (sharerIdent s == shr) $ + invalidArgs ["Trying to create project under someone/something else"] ((result, widget), enctype) <- runFormPost $ newProjectForm sid - case result of - FormSuccess np -> do - now <- liftIO getCurrentTime - host <- asksSite siteInstanceHost - pid <- requireAuthId - runDB $ do - ibid <- insert Inbox - obid <- insert Outbox - fsid <- insert FollowerSet - aid <- insert Actor - { actorName = fromMaybe "" $ npName np - , actorDesc = fromMaybe "" $ npDesc np - , actorCreatedAt = now - , actorInbox = ibid - , actorOutbox = obid - , actorFollowers = fsid - } - let project = Project - { projectActor = aid - , projectIdent = npIdent np - , projectSharer = sid - , projectName = npName np - , projectDesc = npDesc np - , projectWorkflow = npWflow np - , projectNextTicket = 1 - , projectWiki = Nothing - , projectCollabAnon = Nothing - , projectCollabUser = Nothing - } - jid <- insert project - - obiid <- - insert $ - OutboxItem - obid - (persistJSONObjectFromDoc $ Doc host emptyActivity) - now - cid <- insert Collab - for_ (npRole np) $ \ rlid -> insert_ $ CollabRoleLocal cid rlid - insert_ $ CollabTopicLocalProject cid jid - insert_ $ CollabSenderLocal cid obiid - insert_ $ CollabRecipLocal cid pid - setMessage "Project added." - redirect $ ProjectR shr (npIdent np) - FormMissing -> do - setMessage "Field(s) missing" - defaultLayout $(widgetFile "project/new") - FormFailure _l -> do - setMessage "Project creation failed, see below" + eprj <- runExceptT $ do + NewProject name mdesc _ _ <- + case result of + FormSuccess np -> return np + FormMissing -> throwE "Field(s) missing" + FormFailure _l -> throwE "Project creation failed, see below" + (msummary, audience, detail, mtarget) <- lift $ createDeck shr name mdesc + obiidCreate <- createTicketTrackerC ep s msummary audience detail mtarget + runDBExcept $ do + mj <- lift $ getValBy $ UniqueProjectCreate obiidCreate + projectIdent <$> fromMaybeE mj "New project not found" + case eprj of + Left e -> do + setMessage $ toHtml e defaultLayout $(widgetFile "project/new") + Right prj -> do + setMessage "Project created!" + redirect $ ProjectR shr prj getProjectNewR :: ShrIdent -> Handler Html getProjectNewR shr = do diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 847c184..15c2f94 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -1874,6 +1874,53 @@ changes hLocal ctx = , removeField "Project" "outbox" -- 296 , removeField "Project" "followers" + -- 297 + , addFieldRefRequired'' + "Project" + (do obid <- insert Outbox297 + let doc = persistJSONObjectFromDoc $ Doc hLocal emptyActivity + insertEntity $ OutboxItem297 obid doc defaultTime + ) + (Just $ \ (Entity obiidTemp obiTemp) -> do + js <- selectList ([] :: [Filter Project297]) [] + for_ js $ \ (Entity jid j) -> do + mp <- getValBy $ UniquePersonIdent297 $ project297Sharer j + p <- + case mp of + Nothing -> error "Project sharer isn't a Person" + Just person -> return person + let doc = persistJSONObjectFromDoc $ Doc hLocal emptyActivity + obiid <- + insert $ OutboxItem297 (person297Outbox p) doc defaultTime + update jid [Project297Create =. obiid] + + delete obiidTemp + delete $ outboxItem297Outbox obiTemp + ) + "create" + "OutboxItem" + -- 298 + , addUnique "Project" $ Unique "UniqueProjectCreate" ["create"] + -- 299 + , addEntities model_2022_07_24 + -- 300 + , unchecked $ lift $ do + ctsJ <- selectList ([] :: [Filter CollabTopicLocalProject300]) [] + for_ ctsJ $ \ (Entity _ (CollabTopicLocalProject300 cid jid)) -> do + j <- getJust jid + mcr <- getValBy $ UniqueCollabRecipLocal300 cid + for_ mcr $ \ (CollabRecipLocal300 _ pid) -> do + p <- getJust pid + when (project300Sharer j == person300Ident p) $ + insert_ $ CollabFulfillsLocalTopicCreation300 cid + ctsR <- selectList ([] :: [Filter CollabTopicLocalRepo300]) [] + for_ ctsR $ \ (Entity _ (CollabTopicLocalRepo300 cid rid)) -> do + r <- getJust rid + mcr <- getValBy $ UniqueCollabRecipLocal300 cid + for_ mcr $ \ (CollabRecipLocal300 _ pid) -> do + p <- getJust pid + when (repo300Sharer r == person300Ident p) $ + insert_ $ CollabFulfillsLocalTopicCreation300 cid ] migrateDB diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs index e2dd322..ce84821 100644 --- a/src/Vervis/Migration/Model.hs +++ b/src/Vervis/Migration/Model.hs @@ -266,6 +266,21 @@ module Vervis.Migration.Model , FollowerSet289Generic (..) , Actor289Generic (..) , Project289Generic (..) + , Outbox297Generic (..) + , OutboxItem297Generic (..) + , Project297 + , Project297Generic (..) + , Person297Generic (..) + , model_2022_07_24 + , CollabTopicLocalProject300 + , CollabTopicLocalProject300Generic (..) + , CollabTopicLocalRepo300 + , CollabTopicLocalRepo300Generic (..) + , CollabRecipLocal300Generic (..) + , Person300Generic (..) + , Project300Generic (..) + , Repo300Generic (..) + , CollabFulfillsLocalTopicCreation300Generic (..) ) where @@ -514,3 +529,12 @@ model_2022_07_17 = $(schema "2022_07_17_actor") makeEntitiesMigration "289" $(modelFile "migrations/2022_07_17_project_actor.model") + +makeEntitiesMigration "297" + $(modelFile "migrations/2022_07_24_project_create.model") + +model_2022_07_24 :: [Entity SqlBackend] +model_2022_07_24 = $(schema "2022_07_24_collab_fulfills") + +makeEntitiesMigration "300" + $(modelFile "migrations/2022_07_25_collab_fulfills_mig.model") diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 761b637..7e40a6c 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -59,6 +59,7 @@ module Web.ActivityPub , Hash (..) , Commit (..) , Branch (..) + , Role (..) -- * Activity , Accept (..) @@ -68,6 +69,7 @@ module Web.ActivityPub , CreateObject (..) , Create (..) , Follow (..) + , Grant (..) , OfferObject (..) , Offer (..) , Push (..) @@ -1328,6 +1330,20 @@ instance ActivityPub Branch where <> "ref" .= ref <> "context" .= ObjURI authority repo +data Role = RoleAdmin deriving Eq + +instance FromJSON Role where + parseJSON = withText "Role" parse + where + parse "https://forgefed.org/ns#admin" = pure RoleAdmin + parse t = fail $ "Unknown role: " ++ T.unpack t + +instance ToJSON Role where + toJSON = error "toJSON Role" + toEncoding r = + toEncoding $ case r of + RoleAdmin -> "https://forgefed.org/ns#admin" :: Text + data Accept u = Accept { acceptObject :: ObjURI u , acceptResult :: Maybe LocalURI @@ -1457,6 +1473,28 @@ encodeFollow (Follow obj mcontext hide) <> "context" .=? mcontext <> "hide" .= hide +data Grant u = Grant + { grantObject :: Either Role (ObjURI u) + , grantContext :: ObjURI u + , grantTarget :: ObjURI u + , grantFulfills :: Maybe (ObjURI u) + } + +parseGrant :: UriMode u => Object -> Parser (Grant u) +parseGrant o = + Grant + <$> o .: "object" + <*> o .: "context" + <*> o .: "target" + <*> o .:? "fulfills" + +encodeGrant :: UriMode u => Grant u -> Series +encodeGrant (Grant obj context target mfulfills) + = "object" .= obj + <> "context" .= context + <> "target" .= target + <> "fulfills" .=? mfulfills + data OfferObject u = OfferTicket (Ticket u) | OfferDep (TicketDependency u) instance ActivityPub OfferObject where @@ -1568,6 +1606,7 @@ data SpecificActivity u | ApplyActivity (Apply u) | CreateActivity (Create u) | FollowActivity (Follow u) + | GrantActivity (Grant u) | OfferActivity (Offer u) | PushActivity (Push u) | RejectActivity (Reject u) @@ -1602,6 +1641,7 @@ instance ActivityPub Activity where "Apply" -> ApplyActivity <$> parseApply o "Create" -> CreateActivity <$> parseCreate o a actor "Follow" -> FollowActivity <$> parseFollow o + "Grant" -> GrantActivity <$> parseGrant o "Offer" -> OfferActivity <$> parseOffer o a actor "Push" -> PushActivity <$> parsePush a o "Reject" -> RejectActivity <$> parseReject o @@ -1625,6 +1665,7 @@ instance ActivityPub Activity where activityType (ApplyActivity _) = "Apply" activityType (CreateActivity _) = "Create" activityType (FollowActivity _) = "Follow" + activityType (GrantActivity _) = "Grant" activityType (OfferActivity _) = "Offer" activityType (PushActivity _) = "Push" activityType (RejectActivity _) = "Reject" @@ -1635,6 +1676,7 @@ instance ActivityPub Activity where encodeSpecific _ _ (ApplyActivity a) = encodeApply a encodeSpecific _ _ (CreateActivity a) = encodeCreate a encodeSpecific _ _ (FollowActivity a) = encodeFollow a + encodeSpecific _ _ (GrantActivity a) = encodeGrant a encodeSpecific h u (OfferActivity a) = encodeOffer h u a encodeSpecific h _ (PushActivity a) = encodePush h a encodeSpecific _ _ (RejectActivity a) = encodeReject a diff --git a/templates/project/new.hamlet b/templates/project/new.hamlet index 328e5d4..9a151cc 100644 --- a/templates/project/new.hamlet +++ b/templates/project/new.hamlet @@ -1,6 +1,6 @@ $# This file is part of Vervis. $# -$# Written in 2016 by fr33domlover . +$# Written in 2016, 2022 by fr33domlover . $# $# ♡ Copying is an act of love. Please copy, reuse and share. $# @@ -12,6 +12,10 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . +

+ NOTE: Your workflow and role choices will be ignored. They're temporarily + not in use while these features are being federated. +

^{widget}