DB: Add a Resource table, and use it in all local Actors except Person

migrations/603_2024-04-20_resource.model

@@ -0,0 +1,4 @@
+Resource
+    actor ActorId
+
+    UniqueResource actor

migrations/604_2024-04-20_resource.model

@@ -0,0 +1,84 @@
+OutboxItem
+Workflow
+PermitTopicExtend
+
+Inbox
+
+Outbox
+
+FollowerSet
+
+Actor
+    name      Text
+    desc      Text
+    createdAt UTCTime
+    inbox     InboxId
+    outbox    OutboxId
+    followers FollowerSetId
+    justCreatedBy ActorId Maybe
+
+    UniqueActorInbox     inbox
+    UniqueActorOutbox    outbox
+    UniqueActorFollowers followers
+
+Resource
+    actor ActorId
+
+    UniqueResource actor
+
+Group
+    actor    ActorId
+    resource ResourceId
+    create   OutboxItemId
+
+    UniqueGroupActor  actor
+    UniqueGroupCreate create
+
+Project
+    actor    ActorId
+    resource ResourceId
+    create   OutboxItemId
+
+    UniqueProjectActor  actor
+    UniqueProjectCreate create
+
+Deck
+    actor      ActorId
+    resource   ResourceId
+    workflow   WorkflowId
+    nextTicket Int
+    wiki       RepoId        Maybe
+    create     OutboxItemId
+
+    UniqueDeckActor  actor
+    UniqueDeckCreate create
+
+Loom
+    nextTicket Int
+    actor      ActorId
+    resource   ResourceId
+    repo       RepoId
+    create     OutboxItemId
+
+    UniqueLoomActor  actor
+    UniqueLoomRepo   repo
+    UniqueLoomCreate create
+
+Repo
+    vcs        VersionControlSystem
+    project    DeckId               Maybe
+    mainBranch Text
+    actor      ActorId
+    resource   ResourceId
+    create     OutboxItemId
+    loom       LoomId               Maybe
+
+    UniqueRepoActor  actor
+    UniqueRepoCreate create
+
+PermitTopicExtendResourceLocal
+    permit   PermitTopicExtendId
+    actor    ActorId
+    resource ResourceId
+
+    UniquePermitTopicExtendResourceLocal permit

src/Vervis/API.hs

@@ -1131,9 +1131,11 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips
     insertLoom now name msummary obiidCreate repoID = do
         actor@(Entity actorID _) <-
             insertActor now name (fromMaybe "" msummary) (Just $ personActor personUser)
+        resourceID <- insert $ Resource actorID
         loomID <- insert Loom
             { loomNextTicket = 1
             , loomActor      = actorID
+            , loomResource   = resourceID
             , loomRepo       = repoID
             , loomCreate     = obiidCreate
             }
@@ -1367,11 +1369,13 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r
     insertRepo now name msummary createID = do
         actor@(Entity actorID _) <-
             insertActor now name (fromMaybe "" msummary) (Just $ personActor personUser)
+        resourceID <- insert $ Resource actorID
         repoID <- insert Repo
             { repoVcs        = vcs
             , repoProject    = Nothing
             , repoMainBranch = "main"
             , repoActor      = actorID
+            , repoResource   = resourceID
             , repoCreate     = createID
             , repoLoom       = Nothing
             }

src/Vervis/Actor.hs

@@ -1,6 +1,7 @@
 {- This file is part of Vervis.
  -
- - Written in 2019, 2020, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2019, 2020, 2022, 2023, 2024
+ - by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -24,7 +25,10 @@
 module Vervis.Actor
     ( -- * Local actors
       LocalActorBy (..)
+    , LocalResourceBy (..)
     , LocalActor
+    , actorToResource
+    , resourceToActor
 
       -- * Converting between KeyHashid, Key, Identity and Entity
       --
@@ -40,6 +44,17 @@ module Vervis.Actor
     , unhashLocalActorE
     , unhashLocalActor404
 
+    , hashLocalResourcePure
+    , getHashLocalResource
+    , hashLocalResource
+
+    , unhashLocalResourcePure
+    , unhashLocalResource
+    , unhashLocalResourceF
+    , unhashLocalResourceM
+    , unhashLocalResourceE
+    , unhashLocalResource404
+
       -- * Local recipient set
     , TicketRoutes (..)
     , ClothRoutes (..)
@@ -147,6 +162,14 @@ data LocalActorBy f
     | LocalActorProject (f Project)
     deriving (Generic, FunctorB, ConstraintsB)
 
+data LocalResourceBy f
+    = LocalResourceGroup   (f Group)
+    | LocalResourceRepo    (f Repo)
+    | LocalResourceDeck    (f Deck)
+    | LocalResourceLoom    (f Loom)
+    | LocalResourceProject (f Project)
+    deriving (Generic, FunctorB, ConstraintsB)
+
 deriving instance AllBF Eq f LocalActorBy => Eq (LocalActorBy f)
 deriving instance AllBF Ord f LocalActorBy => Ord (LocalActorBy f)
 deriving instance AllBF Hashable f LocalActorBy => Hashable (LocalActorBy f)
@@ -154,6 +177,21 @@ deriving instance AllBF Show f LocalActorBy => Show (LocalActorBy f)
 
 type LocalActor = LocalActorBy KeyHashid
 
+actorToResource = \case
+    LocalActorPerson _ -> Nothing
+    LocalActorGroup g -> Just $ LocalResourceGroup g
+    LocalActorRepo r -> Just $ LocalResourceRepo r
+    LocalActorDeck d -> Just $ LocalResourceDeck d
+    LocalActorLoom l -> Just $ LocalResourceLoom l
+    LocalActorProject j -> Just $ LocalResourceProject j
+
+resourceToActor = \case
+    LocalResourceGroup g -> LocalActorGroup g
+    LocalResourceRepo r -> LocalActorRepo r
+    LocalResourceDeck d -> LocalActorDeck d
+    LocalResourceLoom l -> LocalActorLoom l
+    LocalResourceProject j -> LocalActorProject j
+
 hashLocalActorPure
     :: HashidsContext -> LocalActorBy Key -> LocalActorBy KeyHashid
 hashLocalActorPure ctx = f
@@ -227,6 +265,77 @@ unhashLocalActor404 actor = maybe notFound return =<< unhashLocalActor actor
         ctx <- asksSite siteHashidsContext
         return $ unhashLocalActorPure ctx byHash
 
+hashLocalResourcePure
+    :: HashidsContext -> LocalResourceBy Key -> LocalResourceBy KeyHashid
+hashLocalResourcePure ctx = f
+    where
+    f (LocalResourceGroup g)   = LocalResourceGroup $ encodeKeyHashidPure ctx g
+    f (LocalResourceRepo r)    = LocalResourceRepo $ encodeKeyHashidPure ctx r
+    f (LocalResourceDeck d)    = LocalResourceDeck $ encodeKeyHashidPure ctx d
+    f (LocalResourceLoom l)    = LocalResourceLoom $ encodeKeyHashidPure ctx l
+    f (LocalResourceProject j) = LocalResourceProject $ encodeKeyHashidPure ctx j
+
+getHashLocalResource
+    :: (MonadActor m, StageHashids (ActorEnv m))
+    => m (LocalResourceBy Key -> LocalResourceBy KeyHashid)
+getHashLocalResource = do
+    ctx <- asksEnv stageHashidsContext
+    return $ hashLocalResourcePure ctx
+
+hashLocalResource
+    :: (MonadActor m, StageHashids (ActorEnv m))
+    => LocalResourceBy Key -> m (LocalResourceBy KeyHashid)
+hashLocalResource actor = do
+    hash <- getHashLocalResource
+    return $ hash actor
+
+unhashLocalResourcePure
+    :: HashidsContext -> LocalResourceBy KeyHashid -> Maybe (LocalResourceBy Key)
+unhashLocalResourcePure ctx = f
+    where
+    f (LocalResourceGroup g)   = LocalResourceGroup <$> decodeKeyHashidPure ctx g
+    f (LocalResourceRepo r)    = LocalResourceRepo <$> decodeKeyHashidPure ctx r
+    f (LocalResourceDeck d)    = LocalResourceDeck <$> decodeKeyHashidPure ctx d
+    f (LocalResourceLoom l)    = LocalResourceLoom <$> decodeKeyHashidPure ctx l
+    f (LocalResourceProject j) = LocalResourceProject <$> decodeKeyHashidPure ctx j
+
+unhashLocalResource
+    :: (MonadActor m, StageHashids (ActorEnv m))
+    => LocalResourceBy KeyHashid -> m (Maybe (LocalResourceBy Key))
+unhashLocalResource actor = do
+    ctx <- asksEnv stageHashidsContext
+    return $ unhashLocalResourcePure ctx actor
+
+unhashLocalResourceF
+    :: (F.MonadFail m, MonadActor m, StageHashids (ActorEnv m))
+    => LocalResourceBy KeyHashid -> String -> m (LocalResourceBy Key)
+unhashLocalResourceF actor e = maybe (F.fail e) return =<< unhashLocalResource actor
+
+unhashLocalResourceM
+    :: (MonadActor m, StageHashids (ActorEnv m))
+    => LocalResourceBy KeyHashid -> MaybeT m (LocalResourceBy Key)
+unhashLocalResourceM = MaybeT . unhashLocalResource
+
+unhashLocalResourceE
+    :: (MonadActor m, StageHashids (ActorEnv m))
+    => LocalResourceBy KeyHashid -> e -> ExceptT e m (LocalResourceBy Key)
+unhashLocalResourceE actor e =
+    ExceptT $ maybe (Left e) Right <$> unhashLocalResource actor
+
+unhashLocalResource404
+    :: ( MonadSite m
+       , MonadHandler m
+       , HandlerSite m ~ SiteEnv m
+       , YesodHashids (HandlerSite m)
+       )
+    => LocalResourceBy KeyHashid
+    -> m (LocalResourceBy Key)
+unhashLocalResource404 actor = maybe notFound return =<< unhashLocalResource actor
+    where
+    unhashLocalResource byHash = do
+        ctx <- asksSite siteHashidsContext
+        return $ unhashLocalResourcePure ctx byHash
+
 data TicketRoutes = TicketRoutes
     { routeTicketFollowers :: Bool
     }

src/Vervis/Actor/Person/Client.hs

@@ -473,8 +473,10 @@ clientCreateDeck now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd
             , actorFollowers = fsid
             , actorJustCreatedBy = Just actorMeID
             }
+        rid <- insert $ Resource aid
         did <- insert Deck
             { deckActor      = aid
+            , deckResource   = rid
             , deckWorkflow   = wid
             , deckNextTicket = 1
             , deckWiki       = Nothing
@@ -641,8 +643,10 @@ clientCreateProject now personMeID (ClientMsg maybeCap localRecips remoteRecips
             , actorFollowers = fsid
             , actorJustCreatedBy = Just actorMeID
             }
+        rid <- insert $ Resource aid
         did <- insert Project
             { projectActor      = aid
+            , projectResource   = rid
             , projectCreate     = obiidCreate
             }
         return (did, fsid)
@@ -806,8 +810,10 @@ clientCreateTeam now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd
             , actorFollowers = fsid
             , actorJustCreatedBy = Just actorMeID
             }
+        rid <- insert $ Resource aid
         gid <- insert Group
             { groupActor      = aid
+            , groupResource   = rid
             , groupCreate     = obiidCreate
             }
         return (gid, fsid)

src/Vervis/Data/Actor.hs

@@ -22,12 +22,17 @@ module Vervis.Data.Actor
     , stampRoute
     , parseStampRoute
     , localActorID
+    , localResourceID
     , parseLocalURI
     , parseFedURIOld
     , parseLocalActorE
     , parseLocalActorE'
+    , parseLocalResourceE
+    , parseLocalResourceE'
     , parseActorURI
     , parseActorURI'
+    , parseResourceURI
+    , parseResourceURI'
     )
 where
 
@@ -175,6 +180,13 @@ localActorID (LocalActorDeck (Entity _ d))   = deckActor d
 localActorID (LocalActorLoom (Entity _ l))   = loomActor l
 localActorID (LocalActorProject (Entity _ r))   = projectActor r
 
+localResourceID :: LocalResourceBy Entity -> ResourceId
+localResourceID (LocalResourceGroup (Entity _ g))  = groupResource g
+localResourceID (LocalResourceRepo (Entity _ r))   = repoResource r
+localResourceID (LocalResourceDeck (Entity _ d))   = deckResource d
+localResourceID (LocalResourceLoom (Entity _ l))   = loomResource l
+localResourceID (LocalResourceProject (Entity _ r))   = projectResource r
+
 parseFedURIOld
     :: ( MonadSite m
        , SiteEnv m ~ site
@@ -201,6 +213,18 @@ parseLocalActorE' route = do
     actorByHash <- fromMaybeE (parseLocalActor route) "Not an actor route"
     VA.unhashLocalActorE actorByHash "Invalid actor keyhashid"
 
+parseLocalResourceE
+    :: (MonadSite m, YesodHashids (SiteEnv m))
+    => Route App -> ExceptT Text m (LocalResourceBy Key)
+parseLocalResourceE route = do
+    actorByHash <- fromMaybeE (parseLocalResource route) "Not a resource route"
+    unhashLocalResourceE actorByHash "Invalid resource keyhashid"
+
+parseLocalResourceE' :: Route App -> VA.ActE (LocalResourceBy Key)
+parseLocalResourceE' route = do
+    actorByHash <- fromMaybeE (parseLocalResource route) "Not a resource route"
+    VA.unhashLocalResourceE actorByHash "Invalid resource keyhashid"
+
 parseActorURI
     :: (MonadSite m, SiteEnv m ~ App)
     => FedURI
@@ -219,3 +243,22 @@ parseActorURI' u = do
         parseLocalActorE'
         pure
         routeOrRemote
+
+parseResourceURI
+    :: (MonadSite m, SiteEnv m ~ App)
+    => FedURI
+    -> ExceptT Text m (Either (LocalResourceBy Key) FedURI)
+parseResourceURI u = do
+    routeOrRemote <- parseFedURIOld u
+    bitraverse
+        parseLocalResourceE
+        pure
+        routeOrRemote
+
+parseResourceURI' :: FedURI -> VA.ActE (Either (LocalResourceBy Key) FedURI)
+parseResourceURI' u = do
+    routeOrRemote <- parseFedURI u
+    bitraverse
+        parseLocalResourceE'
+        pure
+        routeOrRemote

src/Vervis/Migration.hs

@@ -3341,6 +3341,154 @@ changes hLocal ctx =
     , addEntities model_601_permit_extend_resource
       -- 602
     , addFieldPrimRequired "PermitTopicExtend" ("RoleAdmin" :: String) "role"
+      -- 603
+    , addEntities model_603_resource
+      -- 604
+    , addFieldRefRequired''
+        "Repo"
+        (do inboxID <- insert Inbox604
+            outboxID <- insert Outbox604
+            followerSetID <- insert FollowerSet604
+            actorID <- insert $ Actor604 "" "" defaultTime inboxID outboxID followerSetID Nothing
+            insertEntity $ Resource604 actorID
+        )
+        (Just $ \ (Entity tempResourceID (Resource604 tempActorID)) -> do
+            l <- selectList [] []
+            for_ l $ \ (Entity k (Repo604 _ _ _ actorID _ _ _)) -> do
+                resourceID <- insert $ Resource604 actorID
+                update k [Repo604Resource =. resourceID]
+
+            Actor604 _ _ _ inboxID outboxID followerSetID _ <- getJust tempActorID
+            delete tempResourceID
+            delete tempActorID
+            delete inboxID
+            delete outboxID
+            delete followerSetID
+        )
+        "resource"
+        "Resource"
+      -- 605
+    , addFieldRefRequired''
+        "Deck"
+        (do inboxID <- insert Inbox604
+            outboxID <- insert Outbox604
+            followerSetID <- insert FollowerSet604
+            actorID <- insert $ Actor604 "" "" defaultTime inboxID outboxID followerSetID Nothing
+            insertEntity $ Resource604 actorID
+        )
+        (Just $ \ (Entity tempResourceID (Resource604 tempActorID)) -> do
+            l <- selectList [] []
+            for_ l $ \ (Entity k (Deck604 actorID _ _ _ _ _)) -> do
+                resourceID <- insert $ Resource604 actorID
+                update k [Deck604Resource =. resourceID]
+
+            Actor604 _ _ _ inboxID outboxID followerSetID _ <- getJust tempActorID
+            delete tempResourceID
+            delete tempActorID
+            delete inboxID
+            delete outboxID
+            delete followerSetID
+        )
+        "resource"
+        "Resource"
+      -- 606
+    , addFieldRefRequired''
+        "Loom"
+        (do inboxID <- insert Inbox604
+            outboxID <- insert Outbox604
+            followerSetID <- insert FollowerSet604
+            actorID <- insert $ Actor604 "" "" defaultTime inboxID outboxID followerSetID Nothing
+            insertEntity $ Resource604 actorID
+        )
+        (Just $ \ (Entity tempResourceID (Resource604 tempActorID)) -> do
+            l <- selectList [] []
+            for_ l $ \ (Entity k (Loom604 _ actorID _ _ _)) -> do
+                resourceID <- insert $ Resource604 actorID
+                update k [Loom604Resource =. resourceID]
+
+            Actor604 _ _ _ inboxID outboxID followerSetID _ <- getJust tempActorID
+            delete tempResourceID
+            delete tempActorID
+            delete inboxID
+            delete outboxID
+            delete followerSetID
+        )
+        "resource"
+        "Resource"
+      -- 607
+    , addFieldRefRequired''
+        "Project"
+        (do inboxID <- insert Inbox604
+            outboxID <- insert Outbox604
+            followerSetID <- insert FollowerSet604
+            actorID <- insert $ Actor604 "" "" defaultTime inboxID outboxID followerSetID Nothing
+            insertEntity $ Resource604 actorID
+        )
+        (Just $ \ (Entity tempResourceID (Resource604 tempActorID)) -> do
+            l <- selectList [] []
+            for_ l $ \ (Entity k (Project604 actorID _ _)) -> do
+                resourceID <- insert $ Resource604 actorID
+                update k [Project604Resource =. resourceID]
+
+            Actor604 _ _ _ inboxID outboxID followerSetID _ <- getJust tempActorID
+            delete tempResourceID
+            delete tempActorID
+            delete inboxID
+            delete outboxID
+            delete followerSetID
+        )
+        "resource"
+        "Resource"
+      -- 608
+    , addFieldRefRequired''
+        "Group"
+        (do inboxID <- insert Inbox604
+            outboxID <- insert Outbox604
+            followerSetID <- insert FollowerSet604
+            actorID <- insert $ Actor604 "" "" defaultTime inboxID outboxID followerSetID Nothing
+            insertEntity $ Resource604 actorID
+        )
+        (Just $ \ (Entity tempResourceID (Resource604 tempActorID)) -> do
+            l <- selectList [] []
+            for_ l $ \ (Entity k (Group604 actorID _ _)) -> do
+                resourceID <- insert $ Resource604 actorID
+                update k [Group604Resource =. resourceID]
+
+            Actor604 _ _ _ inboxID outboxID followerSetID _ <- getJust tempActorID
+            delete tempResourceID
+            delete tempActorID
+            delete inboxID
+            delete outboxID
+            delete followerSetID
+        )
+        "resource"
+        "Resource"
+      -- 609
+    {-
+    , addFieldRefRequired''
+        "PermitTopicExtendResourceLocal"
+        (do inboxID <- insert Inbox604
+            outboxID <- insert Outbox604
+            followerSetID <- insert FollowerSet604
+            actorID <- insert $ Actor604 "" "" defaultTime inboxID outboxID followerSetID Nothing
+            insertEntity $ Resource604 actorID
+        )
+        (Just $ \ (Entity tempResourceID (Resource604 tempActorID)) -> do
+            l <- selectList [] []
+            for_ l $ \ (Entity k (PermitTopicExtendResourceLocal604 _ actorID _)) -> do
+                resourceID <- getKeyByJust $ UniqueResource604 actorID
+                update k [PermitTopicExtendResourceLocal604Resource =. resourceID]
+
+            Actor604 _ _ _ inboxID outboxID followerSetID _ <- getJust tempActorID
+            delete tempResourceID
+            delete tempActorID
+            delete inboxID
+            delete outboxID
+            delete followerSetID
+        )
+        "resource"
+        "Resource"
+    -}
     ]
 
 migrateDB

src/Vervis/Migration/Entities.hs

@@ -74,6 +74,7 @@ module Vervis.Migration.Entities
     , model_591_component_gather
     , model_592_permit_extend
     , model_601_permit_extend_resource
+    , model_603_resource
     )
 where
 
@@ -289,3 +290,6 @@ model_592_permit_extend = $(schema "592_2024-04-18_permit_extend")
 model_601_permit_extend_resource :: [Entity SqlBackend]
 model_601_permit_extend_resource =
     $(schema "601_2024-04-18_permit_extend_resource")
+
+model_603_resource :: [Entity SqlBackend]
+model_603_resource = $(schema "603_2024-04-20_resource")

src/Vervis/Migration/Model2024.hs

@@ -60,3 +60,6 @@ makeEntitiesMigration "584"
 
 makeEntitiesMigration "593"
     $(modelFile "migrations/593_2024-04-18_permit_extend.model")
+
+makeEntitiesMigration "604"
+    $(modelFile "migrations/604_2024-04-20_resource.model")

src/Vervis/Persist/Actor.hs

@@ -15,10 +15,15 @@
 
 module Vervis.Persist.Actor
     ( getLocalActor
+    , getLocalResource
     , getLocalActorEnt
+    --, getLocalResourceEnt
     , getLocalActorEntity
     , getLocalActorEntityE
     , getLocalActorEntity404
+    , getLocalResourceEntity
+    , getLocalResourceEntityE
+    , getLocalResourceEntity404
     , verifyLocalActivityExistsInDB
     , getRemoteObjectURI
     , getRemoteActorURI
@@ -68,6 +73,7 @@ import qualified Web.Actor as WA
 import qualified Web.Actor.Persist as WAP
 
 import Control.Monad.Trans.Except.Local
+import Data.Maybe.Local
 import Database.Persist.Local
 
 import Vervis.Data.Actor
@@ -83,6 +89,10 @@ getLocalActor
     :: MonadIO m => ActorId -> ReaderT SqlBackend m (LocalActorBy Key)
 getLocalActor = fmap (bmap entityKey) . getLocalActorEnt
 
+getLocalResource
+    :: MonadIO m => ResourceId -> ReaderT SqlBackend m (LocalResourceBy Key)
+getLocalResource = fmap (bmap entityKey) . getLocalResourceEnt
+
 getLocalActorEnt
     :: MonadIO m => ActorId -> ReaderT SqlBackend m (LocalActorBy Entity)
 getLocalActorEnt actorID = do
@@ -103,6 +113,23 @@ getLocalActorEnt actorID = do
             (Nothing, Nothing, Nothing, Nothing, Nothing, Just j) -> LocalActorProject j
             _ -> error "Multi-usage of an ActorId"
 
+getLocalResourceEnt
+    :: MonadIO m => ResourceId -> ReaderT SqlBackend m (LocalResourceBy Entity)
+getLocalResourceEnt resourceID = do
+    Resource actorID <- getJust resourceID
+    options <-
+        sequence
+            [ fmap LocalResourceRepo <$> getBy (UniqueRepoActor actorID)
+            , fmap LocalResourceDeck <$> getBy (UniqueDeckActor actorID)
+            , fmap LocalResourceLoom <$> getBy (UniqueLoomActor actorID)
+            , fmap LocalResourceProject <$> getBy (UniqueProjectActor actorID)
+            , fmap LocalResourceGroup <$> getBy (UniqueGroupActor actorID)
+            ]
+    exactlyOneJust
+        options
+        "Found Resource without specific actor"
+        "Found Resource with multiple actors"
+
 getLocalActorEntity
     :: MonadIO m
     => LocalActorBy Key
@@ -128,6 +155,29 @@ getLocalActorEntityE a e = do
 
 getLocalActorEntity404 = maybe notFound return <=< getLocalActorEntity
 
+getLocalResourceEntity
+    :: MonadIO m
+    => LocalResourceBy Key
+    -> ReaderT SqlBackend m (Maybe (LocalResourceBy Entity))
+getLocalResourceEntity (LocalResourceGroup g) =
+    fmap (LocalResourceGroup . Entity g) <$> get g
+getLocalResourceEntity (LocalResourceRepo r) =
+    fmap (LocalResourceRepo . Entity r) <$> get r
+getLocalResourceEntity (LocalResourceDeck d) =
+    fmap (LocalResourceDeck . Entity d) <$> get d
+getLocalResourceEntity (LocalResourceLoom l) =
+    fmap (LocalResourceLoom . Entity l) <$> get l
+getLocalResourceEntity (LocalResourceProject r) =
+    fmap (LocalResourceProject . Entity r) <$> get r
+
+getLocalResourceEntityE a e = do
+    m <- lift $ getLocalResourceEntity a
+    case m of
+        Nothing -> throwE e
+        Just a' -> return a'
+
+getLocalResourceEntity404 = maybe notFound return <=< getLocalResourceEntity
+
 verifyLocalActivityExistsInDB
     :: MonadIO m
     => LocalActorBy Key

src/Vervis/Recipient.hs

@@ -1,6 +1,7 @@
 {- This file is part of Vervis.
  -
- - Written in 2019, 2020, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2019, 2020, 2022, 2023, 2024
+ - by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -22,9 +23,12 @@
 module Vervis.Recipient
     ( -- * Local actors
       LocalActorBy (..)
+    , LocalResourceBy (..)
     , LocalActor
     , parseLocalActor
     , renderLocalActor
+    , parseLocalResource
+    , renderLocalResource
 
       -- * Local collections of (local and remote) actors
     , LocalStageBy (..)
@@ -46,6 +50,17 @@ module Vervis.Recipient
     , unhashLocalActorE
     , unhashLocalActor404
 
+    , hashLocalResourcePure
+    , getHashLocalResource
+    , hashLocalResource
+
+    , unhashLocalResourcePure
+    , unhashLocalResource
+    , unhashLocalResourceF
+    , unhashLocalResourceM
+    , unhashLocalResourceE
+    , unhashLocalResource404
+
     , hashLocalStagePure
     , getHashLocalStage
     , hashLocalStage
@@ -143,6 +158,12 @@ import Vervis.Actor hiding
     , unhashLocalActorF
     , unhashLocalActorM
     , unhashLocalActorE
+    , getHashLocalResource
+    , hashLocalResource
+    , unhashLocalResource
+    , unhashLocalResourceF
+    , unhashLocalResourceM
+    , unhashLocalResourceE
     )
 import Vervis.FedURI
 import Vervis.Foundation
@@ -204,6 +225,21 @@ renderLocalActor (LocalActorDeck dkhid)   = DeckR dkhid
 renderLocalActor (LocalActorLoom lkhid)   = LoomR lkhid
 renderLocalActor (LocalActorProject jkhid)   = ProjectR jkhid
 
+parseLocalResource :: Route App -> Maybe (LocalResourceBy KeyHashid)
+parseLocalResource (GroupR gkhid)  = Just $ LocalResourceGroup gkhid
+parseLocalResource (RepoR rkhid)   = Just $ LocalResourceRepo rkhid
+parseLocalResource (DeckR dkhid)   = Just $ LocalResourceDeck dkhid
+parseLocalResource (LoomR lkhid)   = Just $ LocalResourceLoom lkhid
+parseLocalResource (ProjectR jkhid)   = Just $ LocalResourceProject jkhid
+parseLocalResource _               = Nothing
+
+renderLocalResource :: LocalResourceBy KeyHashid -> Route App
+renderLocalResource (LocalResourceGroup gkhid)  = GroupR gkhid
+renderLocalResource (LocalResourceRepo rkhid)   = RepoR rkhid
+renderLocalResource (LocalResourceDeck dkhid)   = DeckR dkhid
+renderLocalResource (LocalResourceLoom lkhid)   = LoomR lkhid
+renderLocalResource (LocalResourceProject jkhid)   = ProjectR jkhid
+
 data LocalStageBy f
     = LocalStagePersonFollowers (f Person)
 
@@ -315,6 +351,43 @@ unhashLocalActorE
 unhashLocalActorE actor e =
     ExceptT $ maybe (Left e) Right <$> unhashLocalActor actor
 
+getHashLocalResource
+    :: (MonadSite m, YesodHashids (SiteEnv m))
+    => m (LocalResourceBy Key -> LocalResourceBy KeyHashid)
+getHashLocalResource = do
+    ctx <- asksSite siteHashidsContext
+    return $ hashLocalResourcePure ctx
+
+hashLocalResource
+    :: (MonadSite m, YesodHashids (SiteEnv m))
+    => LocalResourceBy Key -> m (LocalResourceBy KeyHashid)
+hashLocalResource actor = do
+    hash <- getHashLocalResource
+    return $ hash actor
+
+unhashLocalResource
+    :: (MonadSite m, YesodHashids (SiteEnv m))
+    => LocalResourceBy KeyHashid -> m (Maybe (LocalResourceBy Key))
+unhashLocalResource actor = do
+    ctx <- asksSite siteHashidsContext
+    return $ unhashLocalResourcePure ctx actor
+
+unhashLocalResourceF
+    :: (F.MonadFail m, MonadSite m, YesodHashids (SiteEnv m))
+    => LocalResourceBy KeyHashid -> String -> m (LocalResourceBy Key)
+unhashLocalResourceF actor e = maybe (F.fail e) return =<< unhashLocalResource actor
+
+unhashLocalResourceM
+    :: (MonadSite m, YesodHashids (SiteEnv m))
+    => LocalResourceBy KeyHashid -> MaybeT m (LocalResourceBy Key)
+unhashLocalResourceM = MaybeT . unhashLocalResource
+
+unhashLocalResourceE
+    :: (MonadSite m, YesodHashids (SiteEnv m))
+    => LocalResourceBy KeyHashid -> e -> ExceptT e m (LocalResourceBy Key)
+unhashLocalResourceE actor e =
+    ExceptT $ maybe (Left e) Right <$> unhashLocalResource actor
+
 hashLocalStagePure
     :: HashidsContext -> LocalStageBy Key -> LocalStageBy KeyHashid
 hashLocalStagePure ctx = f

th/models

@@ -149,6 +149,11 @@ Person
     UniquePersonEmail    email
     UniquePersonActor    actor
 
+Resource
+    actor ActorId
+
+    UniqueResource actor
+
 -- ========================================================================= --
 -- Delivery
 -- ========================================================================= --
@@ -270,8 +275,9 @@ SshKey
     UniqueSshKey person ident
 
 Group
-    actor  ActorId
+    actor    ActorId
-    create OutboxItemId
+    resource ResourceId
+    create   OutboxItemId
 
     UniqueGroupActor  actor
     UniqueGroupCreate create
@@ -289,14 +295,16 @@ GroupMember
 -------------------------------------------------------------------------------
 
 Project
-    actor  ActorId
+    actor    ActorId
-    create OutboxItemId
+    resource ResourceId
+    create   OutboxItemId
 
     UniqueProjectActor  actor
     UniqueProjectCreate create
 
 Deck
     actor      ActorId
+    resource   ResourceId
     workflow   WorkflowId
     nextTicket Int
     wiki       RepoId        Maybe
@@ -308,6 +316,7 @@ Deck
 Loom
     nextTicket Int
     actor      ActorId
+    resource   ResourceId
     repo       RepoId
     create     OutboxItemId
 
@@ -320,6 +329,7 @@ Repo
     project    DeckId               Maybe
     mainBranch Text
     actor      ActorId
+    resource   ResourceId
     create     OutboxItemId
     loom       LoomId               Maybe
 
@@ -936,8 +946,9 @@ PermitTopicExtendRemote
     UniquePermitTopicExtendRemoteGrant grant
 
 PermitTopicExtendResourceLocal
-    permit PermitTopicExtendId
+    permit   PermitTopicExtendId
-    actor  ActorId
+    actor    ActorId
+    --resource ResourceId
 
     UniquePermitTopicExtendResourceLocal permit