From 027c45fe2cc4dfa3d85811ff33ffb93e625ceefa Mon Sep 17 00:00:00 2001 From: voidlizard Date: Sun, 13 Oct 2024 10:36:33 +0300 Subject: [PATCH] wip, debug --- hbs2-peer/app/MailboxProtoWorker.hs | 8 ++++++++ hbs2-peer/lib/HBS2/Peer/Proto/Mailbox/Entry.hs | 7 +++---- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/hbs2-peer/app/MailboxProtoWorker.hs b/hbs2-peer/app/MailboxProtoWorker.hs index 43c5bfea..35411d26 100644 --- a/hbs2-peer/app/MailboxProtoWorker.hs +++ b/hbs2-peer/app/MailboxProtoWorker.hs @@ -610,6 +610,14 @@ mailboxProtoWorker readConf me@MailboxProtoWorker{..} = do debug $ "mailbox/debug: drop state" <+> pretty pk <+> pretty mailboxStatusRef atomically $ modifyTVar inMailboxDownloadQ (HM.delete pk) + -- FIXME: assume-huge-mailboxes + + walkMerkle @[HashRef] (coerce mailboxStatusRef) (getBlock mpwStorage) $ \case + Left what -> err $ red "mailbox: missed block for tree" <+> pretty mailboxStatusRef + Right hs -> void $ runMaybeT do + for_ hs $ \h -> do + debug $ red ">>>" <+> "MERGE MAILBOX ENTRY" <+> pretty h + mailboxFetchQ dbe = forever do toFetch <- atomically $ do q <- readTVar mpwFetchQ diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox/Entry.hs b/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox/Entry.hs index 909f5f79..15149126 100644 --- a/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox/Entry.hs +++ b/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox/Entry.hs @@ -10,8 +10,7 @@ import Data.Hashable data ProofOfDelete = ProofOfDelete - { deletePolicy :: Maybe HashRef - , deleteMessage :: Maybe HashRef + { deleteMessage :: Maybe HashRef } deriving stock (Generic,Eq,Ord,Show) @@ -22,10 +21,10 @@ data ProofOfExist = deriving stock (Generic,Eq,Ord,Show) instance Monoid ProofOfDelete where - mempty = ProofOfDelete mzero mzero + mempty = ProofOfDelete mzero instance Semigroup ProofOfDelete where - (<>) (ProofOfDelete a1 b1) (ProofOfDelete a2 b2) = ProofOfDelete (a1 <|> a2) (b1 <|> b2) + (<>) (ProofOfDelete a1) (ProofOfDelete a2) = ProofOfDelete (a1 <|> a2) instance Monoid ProofOfExist where mempty = ProofOfExist mzero