feat(hbs2-cli): add --announce flag to block:put (#5)

block:put writes to local storage only; other peers do not learn the
block exists until an RpcAnnounce fires. Add an opt-in --announce flag
that broadcasts a BlockAnnounce right after putBlock, so a "put on A,
get on B" flow works without a separate `hbs2-peer announce`.

Off by default so encrypted-refchan and group-key workflows that gate
publication are not surprised. Document it in COOKBOOK.md.

Author: NCrashed

docs/COOKBOOK.md

@@ -140,7 +140,23 @@ Merkle layer:
 echo "some content" | hbs2-cli hbs2:peer:storage:block:put
 ```
 
-The output is the block hash. Read it back with:
+The output is the block hash.
+
+By default `block:put` only writes to your local peer's storage; other
+peers do not learn the block exists until something emits a
+`BlockAnnounce`. Pass `--announce` to broadcast one right after
+storing, so a "put on A, get on B" flow works without a separate
+`hbs2-peer announce`:
+
+```
+hbs2-cli "(hbs2:peer:storage:block:put --announce \"some content\")"
+```
+
+It is off by default so encrypted-refchan and group-key workflows that
+gate publication are not surprised. Higher-level flows (git push, sync)
+do not need it: they emit reflog transactions that announce internally.
+
+Read it back with:
 
 ```
 hbs2-cli "(hbs2:peer:storage:block:get \"<HASH>\")"

hbs2-cli/lib/HBS2/CLI/Run/Peer.hs

@@ -88,38 +88,50 @@ peerEntries = do
 
     _ -> throwIO $ BadFormException @c nil
 
-  -- stores *small* block
-  entry $ bindMatch "hbs2:peer:storage:block:put" $ \case
-
-    [isOpaqueOf @LBS.ByteString -> Just lbs] -> do
-      sto <- getStorage
-      (putBlock sto lbs <&> fmap (mkSym . show . pretty . HashRef) )
-        >>= orThrowUser "storage error"
-
-    [isOpaqueOf @BS.ByteString -> Just bs] -> do
-      sto <- getStorage
-      (putBlock sto (LBS.fromStrict bs) <&> fmap (mkSym . show . pretty . HashRef) )
-        >>= orThrowUser "storage error"
-
-    -- FIXME: deprecate-this
-    [ListVal [SymbolVal "blob", LitStrVal s]] -> do
-      flip runContT pure do
-        sto <- getStorage
-        lift $ putTextLit sto s
-
-    [LitStrVal s] -> do
-      flip runContT pure do
-        sto <- getStorage
-        lift $ putTextLit sto s
-
-    [] -> do
-        bs <- liftIO BS.getContents
-        sto <- getStorage
-        putBlock sto (LBS.fromStrict bs) >>= \case
-          Nothing -> pure nil
-          Just h  -> pure $ mkSym (show $ pretty $ HashRef h)
-
-    e -> throwIO $ BadFormException @c (mkList e)
+  -- stores *small* block. With the optional --announce flag, emits a
+  -- BlockAnnounce after storing so other peers learn the block exists.
+  -- Off by default so encrypted-refchan and group-key workflows that
+  -- gate publication are not surprised.
+  brief "stores a small block; with --announce also broadcasts a BlockAnnounce"
+    $ entry $ bindMatch "hbs2:peer:storage:block:put" $ \syn -> do
+
+    let isAnnounceFlag = \case { SymbolVal "--announce" -> True; _ -> False }
+        (flags, rest)  = L.partition isAnnounceFlag syn
+        doAnnounce     = not (L.null flags)
+
+    let putArgs = \case
+
+          [isOpaqueOf @LBS.ByteString -> Just lbs] -> do
+            sto <- getStorage
+            putBlock sto lbs >>= orThrowUser "storage error" <&> (Just . HashRef)
+
+          [isOpaqueOf @BS.ByteString -> Just bs] -> do
+            sto <- getStorage
+            putBlock sto (LBS.fromStrict bs) >>= orThrowUser "storage error" <&> (Just . HashRef)
+
+          -- FIXME: deprecate-this
+          [ListVal [SymbolVal "blob", LitStrVal s]] -> do
+            sto <- getStorage
+            putBlock sto (LBS8.pack (Text.unpack s)) >>= orThrowUser "storage error" <&> (Just . HashRef)
+
+          [LitStrVal s] -> do
+            sto <- getStorage
+            putBlock sto (LBS8.pack (Text.unpack s)) >>= orThrowUser "storage error" <&> (Just . HashRef)
+
+          [] -> do
+            bs <- liftIO BS.getContents
+            sto <- getStorage
+            putBlock sto (LBS.fromStrict bs) <&> fmap HashRef
+
+          e -> throwIO $ BadFormException @c (mkList e)
+
+    putArgs rest >>= \case
+      Nothing -> pure nil
+      Just h  -> do
+        when doAnnounce do
+          api <- getClientAPI @PeerAPI @UNIX
+          void $ callRpcWaitMay @RpcAnnounce (TimeoutSec 1) api h
+        pure $ mkSym (show $ pretty h)
 
   brief "checks if peer available"
     $ noArgs