More tweaking & clarification of groupAccept comment and code

This commit is contained in:
Pere Lev 2024-06-15 17:51:24 +03:00
parent a84ea09dd9
commit 47736bb0a8
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D

View file

@ -873,53 +873,52 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
-- * To: Join sender -- * To: Join sender
-- * CC: Accept sender, Join sender's followers, my followers -- * CC: Accept sender, Join sender's followers, my followers
-- --
-- * Give me a new child active SourceOriginUs -- * Give me a new parent active SourceOriginUs
-- * Verify we haven't yet seen child's Accept -- * Verify we haven't yet seen parent's Accept
-- * Insert the Accept to my inbox -- * Insert the Accept to my inbox
-- * If sender is the child, record the Accept into the Source record -- * If sender is the parent, record the Accept into the Source record
-- * Prepare to send degelator-Grant -- * Prepare to send degelator-Grant
-- * Otherwise nothing to do -- * Otherwise nothing to do
-- * Forward the Accept to my followers -- * Forward the Accept to my followers
-- * Possibly send a Grant: -- * Possibly send a Grant:
-- * Child-active -- * If sender is the parent
-- * If sender is the child
-- * delegator-Grant -- * delegator-Grant
-- * To: Child -- * To: Parent
-- * CC: -- * CC:
-- - Child's followers -- - Parent's followers
-- - My followers -- - My followers
-- --
-- * Give me a new child passive SourceOriginThem -- * Give me a new parent passive SourceOriginThem
-- * Option 1: We haven't seen child's Accept yet -- * Option 1: We haven't seen parent's Accept yet
-- * Verify sender is the child -- * Verify sender is the parent
-- * Option 2: We saw it, but not my collaborator's Accept -- * Option 2: We saw it, but not my collaborator's Accept
-- * Verify the Accept is authorized -- * Verify the Accept is authorized
-- * Otherwise respond with error, no Accept is needed -- * Otherwise respond with error, no Accept is needed
-- * Insert the Accept to my inbox -- * Insert the Accept to my inbox
-- * Option 1: Record child's Accept in Source record -- * Option 1: Record parent's Accept in Source record
-- * Option 2: Record my collaborator's Accept -- * Option 2: Record my collaborator's Accept
-- * Prepare to send delegator-Grant -- * Prepare to send delegator-Grant
-- * Forward the Accept to my followers -- * Forward the Accept to my followers
-- * Possibly send a Grant: -- * Possibly send a Grant:
-- * In option 2 -- * In option 2
-- * delegator-Grant -- * delegator-Grant
-- * To: Child -- * To: Parent
-- * CC: -- * CC:
-- - Child's followers -- - Parent's followers
-- - My followers -- - My followers
-- - The Accept sender (my collaborator) -- - The Accept sender (my collaborator)
-- --
-- * Give me a new parent active DestOriginUs -- * Give me a new child active DestOriginUs
-- * Respond with error, we aren't supposed to get any Accept -- * Respond with error, we aren't supposed to get any Accept
-- --
-- * Give me a new parent passive DestOriginThem -- * Give me a new child passive DestOriginThem
-- * Option 1: I haven't yet seen parent's Accept -- * Option 1: I haven't yet seen child's Accept
-- * Verify sender is the parent -- * Verify sender is the child
-- * Option 2: I saw it, but not my collaborator's Accept -- * Option 2: I saw it, but not my collaborator's Accept
-- * Verify the accept is authorized -- * Verify the accept is authorized
-- * Otherwise respond with error, no Accept is needed -- * Otherwise respond with error, no Accept is needed
-- * Insert the Accept to my inbox -- * Insert the Accept to my inbox
-- * Option 1: Record parent's Accept in the Dest record -- * Option 1: Record child's Accept in the Dest record
-- * Option 2: Record my collaborator's Accept in the Dest record -- * Option 2: Record my collaborator's Accept in the Dest record
-- * Prepare to send my own Accept -- * Prepare to send my own Accept
-- * Forward the Accept to my followers -- * Forward the Accept to my followers
@ -927,9 +926,9 @@ groupAdd now groupID (Verse authorIdMsig body) add = do
-- * In option 2 -- * In option 2
-- * Object: The Add -- * Object: The Add
-- * Fulfills: My collaborator's Accept -- * Fulfills: My collaborator's Accept
-- * To: Parent -- * To: Child
-- * CC: -- * CC:
-- - Parent's followers -- - Child's followers
-- - My followers -- - My followers
-- - The Accept sender (my collaborator) -- - The Accept sender (my collaborator)
-- --
@ -1289,43 +1288,41 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do
doneDB inboxItemID "[Collab mode] Forwarded the Accept and published a Grant" doneDB inboxItemID "[Collab mode] Forwarded the Accept and published a Grant"
-- Add-a-parent mode -- Add-a-parent mode
-- Comments below might refer to child, because code is ported from Project
-- But this is add-a-new-parent mode!
addChildParent (Left (sourceID, topic, mode)) = do addChildParent (Left (sourceID, topic, mode)) = do
mode' <- mode' <-
bitraverse bitraverse
-- Child-active mode -- Parent-active mode
-- Verify we haven't yet seen child's Accept -- Verify we haven't yet seen parent's Accept
(\ () -> do (\ () -> do
maybeChildAccept <- maybeParentAccept <-
lift $ withDB $ lift $ withDB $
case bimap fst fst topic of case bimap fst fst topic of
Left localID -> (() <$) <$> getBy (UniqueSourceThemAcceptLocal localID) Left localID -> (() <$) <$> getBy (UniqueSourceThemAcceptLocal localID)
Right remoteID -> (() <$) <$> getBy (UniqueSourceThemAcceptRemote remoteID) Right remoteID -> (() <$) <$> getBy (UniqueSourceThemAcceptRemote remoteID)
verifyNothingE maybeChildAccept "I already saw child's Accept" verifyNothingE maybeParentAccept "I already saw parent's Accept"
) )
-- Child-passive mode -- Parent-passive mode
-- Option 1: We haven't seen child's Accept yet -- Option 1: We haven't seen parent's Accept yet
-- * Verify sender is the child -- * Verify sender is the parent
-- Option 2: We saw it, but not my collaborator's Accept -- Option 2: We saw it, but not my collaborator's Accept
-- * Verify the Accept is authorized -- * Verify the Accept is authorized
-- Otherwise respond with error, no Accept is needed -- Otherwise respond with error, no Accept is needed
(\ () -> do (\ () -> do
(maybeChildAccept, maybeGrant) <- (maybeParentAccept, maybeGrant) <-
lift $ withDB $ liftA2 (,) lift $ withDB $ liftA2 (,)
(case bimap fst fst topic of (case bimap fst fst topic of
Left localID -> (() <$) <$> getBy (UniqueSourceThemAcceptLocal localID) Left localID -> (() <$) <$> getBy (UniqueSourceThemAcceptLocal localID)
Right remoteID -> (() <$) <$> getBy (UniqueSourceThemAcceptRemote remoteID) Right remoteID -> (() <$) <$> getBy (UniqueSourceThemAcceptRemote remoteID)
) )
(getBy $ UniqueSourceUsSendDelegator sourceID) (getBy $ UniqueSourceUsSendDelegator sourceID)
case (isJust maybeChildAccept, isJust maybeGrant) of case (isJust maybeParentAccept, isJust maybeGrant) of
(False, True) -> error "Impossible/bug, didn't see child's Accept but sent a Grant" (False, True) -> error "Impossible/bug, didn't see parent's Accept but sent a Grant"
(False, False) -> do (False, False) -> do
unless (theyIsAuthor topic) $ unless (theyIsAuthor topic) $
throwE "The Accept I'm waiting for is from my new child" throwE "The Accept I'm waiting for is from my new parent"
return $ Left () return $ Left ()
(True, False) -> do (True, False) -> do
let muCap = AP.activityCapability $ actbActivity body let muCap = AP.activityCapability $ actbActivity body
@ -1336,7 +1333,7 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do
(LocalResourceGroup groupID) (LocalResourceGroup groupID)
AP.RoleAdmin AP.RoleAdmin
return $ Right () return $ Right ()
(True, True) -> throwE "Child already enabled, not needing any further Accept" (True, True) -> throwE "Parent already enabled, not needing any further Accept"
) )
mode mode
@ -1356,8 +1353,8 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do
lift $ lift $
bitraverse bitraverse
-- Child-active mode -- Parent-active mode
-- If sender is child, record the Accept into the -- If sender is parent, record the Accept into the
-- Source record & prepare to send degelator-Grant -- Source record & prepare to send degelator-Grant
-- Othrerwise do nothing -- Othrerwise do nothing
(\ () -> (\ () ->
@ -1375,11 +1372,11 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do
else pure Nothing else pure Nothing
) )
-- Child-passive mode -- Parent-passive mode
(\case (\case
-- Getting an Accept from the child -- Getting an Accept from the parent
-- Record child's Accept in Source record -- Record parent's Accept in Source record
Left () -> do Left () -> do
case (topic, acceptDB) of case (topic, acceptDB) of
(Left (localID, _), Left (_, _, acceptID)) -> (Left (localID, _), Left (_, _, acceptID)) ->
@ -1444,25 +1441,23 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do
doneDB inboxItemID "[Parent mode] Forwarded the Accept and maybe published a Grant/Accept" doneDB inboxItemID "[Parent mode] Forwarded the Accept and maybe published a Grant/Accept"
-- Add-a-child mode -- Add-a-child mode
-- Comments below might refer to parent, because code is ported from Project
-- But this is add-a-new-child mode!
addChildParent (Right (destID, topic, mode)) = do addChildParent (Right (destID, topic, mode)) = do
(themID, mode') <- (themID, mode') <-
case mode of case mode of
-- Parent-active mode -- Child-active mode
-- Respond with error, we aren't supposed to get any Accept -- Respond with error, we aren't supposed to get any Accept
Left () -> throwE "Parent-active (DestOriginUs) mode, I'm not expecting any Accept" Left () -> throwE "Child-active (DestOriginUs) mode, I'm not expecting any Accept"
-- Parent-passive mode -- Child-passive mode
-- Option 1: I haven't yet seen parent's Accept -- Option 1: I haven't yet seen child's Accept
-- * Verify sender is the parent -- * Verify sender is the child
-- Option 2: I saw it, but not my collaborator's Accept -- Option 2: I saw it, but not my collaborator's Accept
-- * Verify the accept is authorized -- * Verify the accept is authorized
-- Otherwise respond with error, no Accept is needed -- Otherwise respond with error, no Accept is needed
Right themID -> (themID,) <$> do Right themID -> (themID,) <$> do
(maybeParentAccept, maybeUsGesture) <- (maybeChildAccept, maybeUsGesture) <-
lift $ withDB $ liftA2 (,) lift $ withDB $ liftA2 (,)
(case bimap fst fst topic of (case bimap fst fst topic of
Left localID -> (() <$) <$> getBy (UniqueDestThemAcceptLocalTopic localID) Left localID -> (() <$) <$> getBy (UniqueDestThemAcceptLocalTopic localID)
@ -1476,11 +1471,11 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do
(True, False) -> pure $ Just () (True, False) -> pure $ Just ()
(True, True) -> error "Both DestUsGestureLocal and DestUsGestureRemote" (True, True) -> error "Both DestUsGestureLocal and DestUsGestureRemote"
) )
case (isJust maybeParentAccept, isJust maybeUsGesture) of case (isJust maybeChildAccept, isJust maybeUsGesture) of
(False, True) -> error "Impossible/bug, didn't see parent's Accept but recorded my collaborator's Accept" (False, True) -> error "Impossible/bug, didn't see child's Accept but recorded my collaborator's Accept"
(False, False) -> do (False, False) -> do
unless (theyIsAuthor topic) $ unless (theyIsAuthor topic) $
throwE "The Accept I'm waiting for is from my new parent" throwE "The Accept I'm waiting for is from my new child"
return $ Left () return $ Left ()
(True, False) -> do (True, False) -> do
let muCap = AP.activityCapability $ actbActivity body let muCap = AP.activityCapability $ actbActivity body
@ -1491,7 +1486,7 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do
(LocalResourceGroup groupID) (LocalResourceGroup groupID)
AP.RoleAdmin AP.RoleAdmin
return $ Right () return $ Right ()
(True, True) -> throwE "Just waiting for Grant from parent, or already have it, anyway not needing any further Accept" (True, True) -> throwE "Just waiting for Grant from child, or already have it, anyway not needing any further Accept"
maybeNew <- withDBExcept $ do maybeNew <- withDBExcept $ do
@ -1507,8 +1502,8 @@ groupAccept now groupID (Verse authorIdMsig body) accept = do
idsForGrant <- idsForGrant <-
lift $ case mode' of lift $ case mode' of
-- Getting an Accept from the parent -- Getting an Accept from the child
-- Record parent's Accept in the Dest record -- Record child's Accept in the Dest record
Left () -> do Left () -> do
case (topic, acceptDB) of case (topic, acceptDB) of
(Left (localID, _), Left (_, _, acceptID)) -> (Left (localID, _), Left (_, _, acceptID)) ->