S2S: Deck Accept handler: Implement component mode

src/Vervis/Actor/Common.hs

@@ -193,21 +193,54 @@ actorFollow parseFollowee grabActor unread getFollowee getSieve makeLocalActor m
 
         return (action, recipientSet, remoteActors, fwdHosts)
 
+-- Meaning: An actor accepted something
+-- Behavior:
+--     * If it's on an Invite where I'm the resource:
+--         * Verify the Accept is by the Invite target
+--         * Forward the Accept to my followers
+--         * Send a Grant:
+--             * To: Accepter (i.e. Invite target)
+--             * CC: Invite sender, Accepter's followers, my followers
+--     * If it's on a Join where I'm the resource:
+--         * Verify the Accept is authorized
+--         * Forward the Accept to my followers
+--         * Send a Grant:
+--             * To: Join sender
+--             * CC: Accept sender, Join sender's followers, my followers
+--     * If it's an Invite (that I know about) where I'm invited to a project:
+--          * If I haven't yet seen the project's approval:
+--              * Verify the author is the project
+--              * Record the approval in the Stem record in DB
+--          * If I saw project's approval, but not my collaborators' approval:
+--              * Verify the Accept is authorized
+--              * Record the approval in the Stem record in DB
+--              * Forward to my followers
+--              * Publish and send an Accept:
+--                  * To: Inviter, project, Accept author
+--                  * CC: Project followers, my followers
+--              * Record it in the Stem record in DB as well
+--          * If I already saw both approvals, respond with error
+--     * If it's an Add (that I know about and already Accepted) where I'm
+--       invited to a project:
+--          * If I've already seen the project's accept, respond with error
+--          * Otherwise, just ignore the Accept
+--     * Otherwise respond with error
 topicAccept
     :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
     => (topic -> ActorId)
     -> (forall f. f topic -> GrantResourceBy f)
+    -> (forall f. f topic -> ComponentBy f)
     -> UTCTime
     -> Key topic
     -> Verse
     -> AP.Accept URIMode
     -> ActE (Text, Act (), Next)
-topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) accept = do
+topicAccept topicActor topicResource topicComponent now recipKey (Verse authorIdMsig body) accept = do
 
     -- Check input
     acceptee <- parseAccept accept
 
-    -- Verify the capability URI is one of:
+    -- Verify the capability URI, if provided, is one of:
     --   * Outbox item URI of a local actor, i.e. a local activity
     --   * A remote URI
     maybeCap <-
@@ -215,14 +248,14 @@ topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) acce
             (nameExceptT "Accept capability" . parseActivityURI')
             (AP.activityCapability $ actbActivity body)
 
-    maybeNew <- withDBExcept $ do
-
     -- Grab me from DB
-        (recipActorID, recipActor) <- lift $ do
+    (recipActorID, recipActor) <- lift $ withDB $ do
         recip <- getJust recipKey
         let actorID = topicActor recip
         (actorID,) <$> getJust actorID
 
+    collabOrStem <- withDBExcept $ do
+
         -- Find the accepted activity in our DB
         accepteeDB <- do
             a <- getActivity acceptee
@@ -230,12 +263,141 @@ topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) acce
 
         -- See if the accepted activity is an Invite or Join to a local
         -- resource, grabbing the Collab record from our DB
-        collab <- do
+        -- See if the accepted activity is an Invite or Add on a local
-            maybeCollab <-
+        -- component, grabbing the Stem record from our DB
+        maybeCollabOrStem <-
             lift $ runMaybeT $
-                    Left <$> tryInvite accepteeDB <|>
+                Left . Left <$> tryInviteCollab accepteeDB <|>
-                    Right <$> tryJoin accepteeDB
+                Left . Right <$> tryJoinCollab accepteeDB <|>
-            fromMaybeE maybeCollab "Accepted activity isn't an Invite or Join I'm aware of"
+                Right . Left <$> tryInviteComp accepteeDB <|>
+                Right . Right <$> tryAddComp accepteeDB
+        fromMaybeE maybeCollabOrStem "Accepted activity isn't an Invite/Join/Add I'm aware of"
+
+    case collabOrStem of
+        Left collab ->
+            topicAcceptCollab maybeCap recipActorID recipActor collab
+        Right stem ->
+            topicAcceptStem maybeCap recipActorID recipActor stem
+
+    where
+
+    tryInviteCollab (Left (actorByKey, _actorEntity, itemID)) =
+        (,Left actorByKey) . collabInviterLocalCollab <$>
+            MaybeT (getValBy $ UniqueCollabInviterLocalInvite itemID)
+    tryInviteCollab (Right remoteActivityID) = do
+        CollabInviterRemote collab actorID _ <-
+            MaybeT $ getValBy $
+                UniqueCollabInviterRemoteInvite remoteActivityID
+        actor <- lift $ getJust actorID
+        sender <-
+            lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
+        return (collab, Right sender)
+
+    tryJoinCollab (Left (actorByKey, _actorEntity, itemID)) =
+        (,Left actorByKey) . collabRecipLocalJoinFulfills <$>
+            MaybeT (getValBy $ UniqueCollabRecipLocalJoinJoin itemID)
+    tryJoinCollab (Right remoteActivityID) = do
+        CollabRecipRemoteJoin recipID fulfillsID _ <-
+            MaybeT $ getValBy $
+                UniqueCollabRecipRemoteJoinJoin remoteActivityID
+        remoteActorID <- lift $ collabRecipRemoteActor <$> getJust recipID
+        actor <- lift $ getJust remoteActorID
+        joiner <-
+            lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
+        return (fulfillsID, Right joiner)
+
+    tryInviteComp (Left (actorByKey, _actorEntity, itemID)) =
+        (,Left (actorByKey, itemID)) . stemProjectGestureLocalOrigin <$>
+            MaybeT (getValBy $ UniqueStemProjectGestureLocalInvite itemID)
+    tryInviteComp (Right remoteActivityID) = do
+        StemProjectGestureRemote originID actorID _ <-
+            MaybeT $ getValBy $
+                UniqueStemProjectGestureRemoteInvite remoteActivityID
+        actor <- lift $ getJust actorID
+        inviter <-
+            lift $ (,remoteActorFollowers actor, remoteActivityID) <$> getRemoteActorURI actor
+        return (originID, Right inviter)
+
+    tryAddComp (Left (actorByKey, _actorEntity, itemID)) = do
+        StemComponentGestureLocal stemID _ <-
+            MaybeT $ getValBy $ UniqueStemComponentGestureLocalActivity itemID
+        originID <- MaybeT $ getKeyBy $ UniqueStemOriginAdd stemID
+        return (stemID, originID, Left (actorByKey, itemID))
+    tryAddComp (Right remoteActivityID) = do
+        StemComponentGestureRemote stemID actorID _ <-
+            MaybeT $ getValBy $
+                UniqueStemComponentGestureRemoteActivity remoteActivityID
+        originID <- MaybeT $ getKeyBy $ UniqueStemOriginAdd stemID
+        actor <- lift $ getJust actorID
+        adder <-
+            lift $ (,remoteActorFollowers actor,remoteActivityID) <$> getRemoteActorURI actor
+        return (stemID, originID, Right adder)
+
+    prepareGrant isInvite sender role = do
+        encodeRouteHome <- getEncodeRouteHome
+        encodeRouteLocal <- getEncodeRouteLocal
+
+        audAccepter <- makeAudSenderWithFollowers authorIdMsig
+        audApprover <- lift $ makeAudSenderOnly authorIdMsig
+        recipHash <- encodeKeyHashid recipKey
+        let topicByHash = grantResourceLocalActor $ topicResource recipHash
+
+        senderHash <- bitraverse hashLocalActor pure sender
+
+        uAccepter <- lift $ getActorURI authorIdMsig
+
+        let audience =
+                if isInvite
+                    then
+                        let audInviter =
+                                case senderHash of
+                                    Left actor -> AudLocal [actor] []
+                                    Right (ObjURI h lu, _followers) ->
+                                        AudRemote h [lu] []
+                            audTopic = AudLocal [] [localActorFollowers topicByHash]
+                        in  [audInviter, audAccepter, audTopic]
+                    else
+                        let audJoiner =
+                                case senderHash of
+                                    Left actor -> AudLocal [actor] [localActorFollowers actor]
+                                    Right (ObjURI h lu, followers) ->
+                                        AudRemote h [lu] (maybeToList followers)
+                            audTopic = AudLocal [] [localActorFollowers topicByHash]
+                        in  [audJoiner, audApprover, audTopic]
+
+            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
+                collectAudience audience
+
+            recips = map encodeRouteHome audLocal ++ audRemote
+            action = AP.Action
+                { AP.actionCapability = Nothing
+                , AP.actionSummary    = Nothing
+                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
+                , AP.actionFulfills   = [AP.acceptObject accept]
+                , AP.actionSpecific   = AP.GrantActivity AP.Grant
+                    { AP.grantObject    = AP.RXRole role
+                    , AP.grantContext   =
+                        encodeRouteHome $ renderLocalActor topicByHash
+                    , AP.grantTarget    =
+                        if isInvite
+                            then uAccepter
+                            else case senderHash of
+                                Left actor ->
+                                    encodeRouteHome $ renderLocalActor actor
+                                Right (ObjURI h lu, _) -> ObjURI h lu
+                    , AP.grantResult    = Nothing
+                    , AP.grantStart     = Just now
+                    , AP.grantEnd       = Nothing
+                    , AP.grantAllows    = AP.Invoke
+                    , AP.grantDelegates = Nothing
+                    }
+                }
+
+        return (action, recipientSet, remoteActors, fwdHosts)
+
+    topicAcceptCollab maybeCap recipActorID recipActor collab = do
+
+        maybeNew <- withDBExcept $ do
 
             -- Find the local resource and verify it's me
             collabID <-
@@ -344,95 +506,185 @@ topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) acce
                     remoteRecipsGrant fwdHostsGrant grantID actionGrant
                 done "Forwarded the Accept and published a Grant"
 
-    where
+    prepareReact project inviter = do
-
-    tryInvite (Left (actorByKey, _actorEntity, itemID)) =
-        (,Left actorByKey) . collabInviterLocalCollab <$>
-            MaybeT (getValBy $ UniqueCollabInviterLocalInvite itemID)
-    tryInvite (Right remoteActivityID) = do
-        CollabInviterRemote collab actorID _ <-
-            MaybeT $ getValBy $
-                UniqueCollabInviterRemoteInvite remoteActivityID
-        actor <- lift $ getJust actorID
-        sender <-
-            lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
-        return (collab, Right sender)
-
-    tryJoin (Left (actorByKey, _actorEntity, itemID)) =
-        (,Left actorByKey) . collabRecipLocalJoinFulfills <$>
-            MaybeT (getValBy $ UniqueCollabRecipLocalJoinJoin itemID)
-    tryJoin (Right remoteActivityID) = do
-        CollabRecipRemoteJoin recipID fulfillsID _ <-
-            MaybeT $ getValBy $
-                UniqueCollabRecipRemoteJoinJoin remoteActivityID
-        remoteActorID <- lift $ collabRecipRemoteActor <$> getJust recipID
-        actor <- lift $ getJust remoteActorID
-        joiner <-
-            lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
-        return (fulfillsID, Right joiner)
-
-    prepareGrant isInvite sender role = do
         encodeRouteHome <- getEncodeRouteHome
-        encodeRouteLocal <- getEncodeRouteLocal
 
-        audAccepter <- makeAudSenderWithFollowers authorIdMsig
+        (audInviter, uInvite) <-
-        audApprover <- lift $ makeAudSenderOnly authorIdMsig
+            case inviter of
-        recipHash <- encodeKeyHashid recipKey
+                Left (byKey, itemID) -> do
-        let topicByHash = grantResourceLocalActor $ topicResource recipHash
+                    byHash <- hashLocalActor byKey
+                    itemHash <- encodeKeyHashid itemID
+                    return
+                        ( AudLocal [byHash] []
+                        , encodeRouteHome $ activityRoute byHash itemHash
+                        )
+                Right (ObjURI h lu, _followers, activityID) -> do
+                    objectID <- remoteActivityIdent <$> getJust activityID
+                    luAct <- remoteObjectIdent <$> getJust objectID
+                    return (AudRemote h [lu] [], ObjURI h luAct)
+        audProject <-
+            case project of
+                Left (Entity _ (StemProjectLocal _ projectID)) -> do
+                    projectHash <- encodeKeyHashid projectID
+                    return $
+                        AudLocal
+                            [LocalActorProject projectHash]
+                            [LocalStageProjectFollowers projectHash]
+                Right (Entity _ (StemProjectRemote _ actorID)) -> do
+                    actor <- getJust actorID
+                    ObjURI h lu <- getRemoteActorURI actor
+                    let followers = remoteActorFollowers actor
+                    return $ AudRemote h [lu] (maybeToList followers)
+        audAccepter <- lift $ makeAudSenderOnly authorIdMsig
+        audMe <-
+            AudLocal [] . pure . localActorFollowers .
+            grantResourceLocalActor . topicResource <$>
+                encodeKeyHashid recipKey
 
-        senderHash <- bitraverse hashLocalActor pure sender
+        let (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
-
+                collectAudience [audInviter, audProject, audAccepter, audMe]
-        uAccepter <- lift $ getActorURI authorIdMsig
-
-        let audience =
-                if isInvite
-                    then
-                        let audInviter =
-                                case senderHash of
-                                    Left actor -> AudLocal [actor] []
-                                    Right (ObjURI h lu, _followers) ->
-                                        AudRemote h [lu] []
-                            audTopic = AudLocal [] [localActorFollowers topicByHash]
-                        in  [audInviter, audAccepter, audTopic]
-                    else
-                        let audJoiner =
-                                case senderHash of
-                                    Left actor -> AudLocal [actor] [localActorFollowers actor]
-                                    Right (ObjURI h lu, followers) ->
-                                        AudRemote h [lu] (maybeToList followers)
-                            audTopic = AudLocal [] [localActorFollowers topicByHash]
-                        in  [audJoiner, audApprover, audTopic]
-
-            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
-                collectAudience audience
 
             recips = map encodeRouteHome audLocal ++ audRemote
             action = AP.Action
                 { AP.actionCapability = Nothing
                 , AP.actionSummary    = Nothing
                 , AP.actionAudience   = AP.Audience recips [] [] [] [] []
-                , AP.actionFulfills   = [AP.acceptObject accept]
+                , AP.actionFulfills   = []
-                , AP.actionSpecific   = AP.GrantActivity AP.Grant
+                , AP.actionSpecific   = AP.AcceptActivity AP.Accept
-                    { AP.grantObject    = AP.RXRole role
+                    { AP.acceptObject   = uInvite
-                    , AP.grantContext   =
+                    , AP.acceptResult   = Nothing
-                        encodeRouteHome $ renderLocalActor topicByHash
-                    , AP.grantTarget    =
-                        if isInvite
-                            then uAccepter
-                            else case senderHash of
-                                Left actor ->
-                                    encodeRouteHome $ renderLocalActor actor
-                                Right (ObjURI h lu, _) -> ObjURI h lu
-                    , AP.grantResult    = Nothing
-                    , AP.grantStart     = Just now
-                    , AP.grantEnd       = Nothing
-                    , AP.grantAllows    = AP.Invoke
-                    , AP.grantDelegates = Nothing
                     }
                 }
 
         return (action, recipientSet, remoteActors, fwdHosts)
 
+    topicAcceptStem maybeCap recipActorID recipActor stem = do
+
+        maybeNew <- withDBExcept $ do
+
+            -- Find the local component and verify it's me
+            stemID <-
+                lift $ case stem of
+                    Left (originInviteID, _inviter) ->
+                        stemOriginInviteStem <$> getJust originInviteID
+                    Right (stemID, _originAddID, _adder) ->
+                        return stemID
+            ident <- lift $ getStemIdent stemID
+            unless (topicComponent recipKey == ident) $
+                throwE "Accept object is an Invite/Add for some other component"
+
+            project <-
+                lift $
+                requireEitherAlt
+                    (getBy $ UniqueStemProjectLocal stemID)
+                    (getBy $ UniqueStemProjectRemote stemID)
+                    "Found Stem with no project"
+                    "Found Stem with multiple projects"
+
+            idsForLater <- bitraverse
+
+                -- Accepting an Invite
+                -- If I haven't seen the project's approval, verify
+                -- the author is the project
+                -- Otherwise, verify the Accept is authorized
+                (\ (originInviteID, inviter) -> do
+                    scgl <- lift $ getBy $ UniqueStemComponentGestureLocal stemID
+                    scgr <- lift $ getBy $ UniqueStemComponentGestureRemote stemID
+                    unless (isNothing scgl && isNothing scgr) $
+                        throwE "I've already recorded my collaborator's Accept on the Invite, no need for further Accepts from anyone"
+                    seen <-
+                        lift $ case project of
+                            Left (Entity k _) -> isJust <$> getBy (UniqueStemProjectAcceptLocalProject k)
+                            Right (Entity k _) -> isJust <$> getBy (UniqueStemProjectAcceptRemoteProject k)
+                    if seen
+                        then do
+                            capID <- fromMaybeE maybeCap "No capability provided"
+                            capability <-
+                                case capID of
+                                    Left (capActor, _, capItem) -> return (capActor, capItem)
+                                    Right _ -> throwE "Capability is a remote URI, i.e. not authored by the local resource"
+                            verifyCapability'
+                                capability
+                                authorIdMsig
+                                (topicResource recipKey)
+                                AP.RoleAdmin
+                        else case (project, authorIdMsig) of
+                            (Left (Entity _ sjl), Left (LocalActorProject projectID, _, _))
+                                | stemProjectLocalProject sjl == projectID ->
+                                    return ()
+                            (Right (Entity _ sjr), Right (author, _, _))
+                                | stemProjectRemoteProject sjr == remoteAuthorId author ->
+                                    return ()
+                            _ -> throwE "The Accept I'm waiting for is by the project"
+                    return (originInviteID, seen, inviter)
+                )
+
+                (\ (_stemID, _originAddID, _adder) -> do
+                    seen <-
+                        lift $ case project of
+                            Left (Entity k _) -> isJust <$> getBy (UniqueStemProjectGrantLocalProject k)
+                            Right (Entity k _) -> isJust <$> getBy (UniqueStemProjectGrantRemoteProject k)
+                    when seen $
+                        throwE "Already saw project's Grant, no need for any Accepts"
+                )
+
+                stem
+
+            maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
+            for maybeAcceptDB $ \ acceptDB ->
+
+                case idsForLater of
+
+                    Left (originInviteID, seen, inviter) -> do
+
+                        if not seen
+                            then do
+                                lift $ case (project, acceptDB) of
+                                    (Left (Entity j _), Left (_, _, acceptID)) ->
+                                        insert_ $ StemProjectAcceptLocal originInviteID j acceptID
+                                    (Right (Entity j _), Right (_, _, acceptID)) ->
+                                        insert_ $ StemProjectAcceptRemote originInviteID j acceptID
+                                    _ -> error "topicAccept Impossible"
+                                return Nothing
+                            else do
+                                lift $ case acceptDB of
+                                    Left (_, _, acceptID) ->
+                                        insert_ $ StemComponentGestureLocal stemID acceptID
+                                    Right (author, _, acceptID) ->
+                                        insert_ $ StemComponentGestureRemote stemID (remoteAuthorId author) acceptID
+
+                                -- Prepare forwarding of Accept to my followers
+                                let recipByID = grantResourceLocalActor $ topicResource recipKey
+                                recipByHash <- hashLocalActor recipByID
+                                let sieve = makeRecipientSet [] [localActorFollowers recipByHash]
+
+                                reactInfo <- do
+
+                                    -- Record the fresh Accept in our DB
+                                    reactID <- lift $ insertEmptyOutboxItem' (actorOutbox recipActor) now
+                                    lift $ insert_ $ StemComponentAccept stemID reactID
+
+                                    -- Prepare an Accept activity and insert to my outbox
+                                    react@(actionReact, _, _, _) <- lift $ prepareReact project inviter
+                                    let recipByKey = grantResourceLocalActor $ topicResource recipKey
+                                    _luReact <- lift $ updateOutboxItem' recipByKey reactID actionReact
+                                    return (reactID, react)
+
+                                return $ Just (sieve, reactInfo)
+
+                    Right () -> return Nothing
+
+        case maybeNew of
+            Nothing -> done "I already have this activity in my inbox"
+            Just Nothing -> done "Done"
+            Just (Just (sieve, (reactID, (actionReact, localRecipsReact, remoteRecipsReact, fwdHostsReact)))) -> do
+                let recipByID = grantResourceLocalActor $ topicResource recipKey
+                forwardActivity authorIdMsig body recipByID recipActorID sieve
+                lift $ sendActivity
+                    recipByID recipActorID localRecipsReact
+                    remoteRecipsReact fwdHostsReact reactID actionReact
+                done "Forwarded the Accept and published an Accept"
+
 topicReject
     :: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
     => (topic -> ActorId)

src/Vervis/Actor/Deck.hs

@@ -372,6 +372,23 @@ deckFollow now recipDeckID verse follow = do
 --         * Send a Grant:
 --             * To: Join sender
 --             * CC: Accept sender, Join sender's followers, my followers
+--     * If it's an Invite (that I know about) where I'm invited to a project:
+--          * If I haven't yet seen the project's approval:
+--              * Verify the author is the project
+--              * Record the approval in the Stem record in DB
+--          * If I saw project's approval, but not my collaborators' approval:
+--              * Verify the Accept is authorized
+--              * Record the approval in the Stem record in DB
+--              * Forward to my followers
+--              * Publish and send an Accept:
+--                  * To: Inviter, project, Accept author
+--                  * CC: Project followers, my followers
+--              * Record it in the Stem record in DB as well
+--          * If I already saw both approvals, respond with error
+--     * If it's an Add (that I know about and already Accepted) where I'm
+--       invited to a project:
+--          * If I've already seen the project's accept, respond with error
+--          * Otherwise, just ignore the Accept
 --     * Otherwise respond with error
 deckAccept
     :: UTCTime
@@ -379,7 +396,7 @@ deckAccept
     -> Verse
     -> AP.Accept URIMode
     -> ActE (Text, Act (), Next)
-deckAccept = topicAccept deckActor GrantResourceDeck
+deckAccept = topicAccept deckActor GrantResourceDeck ComponentDeck
 
 -- Meaning: An actor rejected something
 -- Behavior:

src/Vervis/Persist/Collab.hs

@@ -16,6 +16,7 @@
 module Vervis.Persist.Collab
     ( getCollabTopic
     , getCollabTopic'
+    , getStemIdent
     , getGrantRecip
     , getComponentE
     , getTopicGrants
@@ -107,6 +108,19 @@ getCollabTopic' collabID = do
                 (delete k, GrantResourceProject $ collabTopicProjectProject l)
             _ -> error "Found Collab with multiple topics"
 
+getStemIdent :: MonadIO m => StemId -> ReaderT SqlBackend m (ComponentBy Key)
+getStemIdent stemID = do
+    maybeRepo <- getValBy $ UniqueStemIdentRepo stemID
+    maybeDeck <- getValBy $ UniqueStemIdentDeck stemID
+    maybeLoom <- getValBy $ UniqueStemIdentLoom stemID
+    return $
+        case (maybeRepo, maybeDeck, maybeLoom) of
+            (Nothing, Nothing, Nothing) -> error "Found Stem without ident"
+            (Just r, Nothing, Nothing) -> ComponentRepo $ stemIdentRepoRepo r
+            (Nothing, Just d, Nothing) -> ComponentDeck $ stemIdentDeckDeck d
+            (Nothing, Nothing, Just l) -> ComponentLoom $ stemIdentLoomLoom l
+            _ -> error "Found Stem with multiple idents"
+
 getGrantRecip (GrantRecipPerson k) e = GrantRecipPerson <$> getEntityE k e
 
 getComponentE (ComponentRepo k) e = ComponentRepo <$> getEntityE k e