More tweaking & clarification of groupAccept comment and code
This commit is contained in:
parent
a84ea09dd9
commit
47736bb0a8
1 changed files with 48 additions and 53 deletions
|
@ -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)) ->
|
||||||
|
|
Loading…
Reference in a new issue