very basic acls work

hbs2-core/lib/HBS2/Net/Proto/RefChan.hs

@@ -224,8 +224,7 @@ refChanUpdateProto self adapter msg = do
 
   void $ runMaybeT do
 
-    guard auth
+    guard (auth || self)
-
 
     case msg of
      Propose chan box -> do
@@ -259,7 +258,10 @@ refChanUpdateProto self adapter msg = do
        deferred proto do
 
         -- проверили подпись пира
-        (peerKey, (ProposeTran headRef bs)) <- MaybeT $ pure $ unboxSignedBox0 box
+        (peerKey, ProposeTran headRef abox) <- MaybeT $ pure $ unboxSignedBox0 box
+
+        -- проверили подпись автора
+        (authorKey, bs) <- MaybeT $ pure $ unboxSignedBox0 abox
 
         -- итак, сначала достаём голову. как мы достаём голову?
         h <- MaybeT $ liftIO $ getRef sto (RefChanHeadKey @s chan)
@@ -274,7 +276,18 @@ refChanUpdateProto self adapter msg = do
         -- FIXME: cache-this
         hdblob <- MaybeT $ readBlobFromTree ( getBlock sto ) (HashRef h)
 
-        debug "OMG! OMG! We've got a transaction!!"
+        (_, headBlock) <- MaybeT $ pure $ unboxSignedBox @(RefChanHeadBlock e) @e hdblob
+
+        debug $ "OMG! Got trans" <+> pretty (AsBase58 peerKey)  <+> pretty (AsBase58 authorKey)
+
+        let pips = view refChanHeadPeers headBlock & fmap fst
+        let aus  = view refChanHeadAuthors headBlock
+
+        guard ( peerKey `elem` pips )
+
+        guard ( authorKey `elem` aus )
+
+        debug $ "OMG!!! TRANS AUTHORIZED" <+> pretty (AsBase58 peerKey)  <+> pretty (AsBase58 authorKey)
 
         pure ()
 

hbs2-peer/app/CLI/RefChan.hs

@@ -110,7 +110,7 @@ pRefChanPropose = do
 
     lbs <- maybe1 fn LBS.getContents LBS.readFile
 
-    let box = makeSignedBox @L4Proto @ByteString (view peerSignPk creds) (view peerSignSk creds) lbs
+    let box = makeSignedBox @L4Proto @BS.ByteString (view peerSignPk creds) (view peerSignSk creds) (LBS.toStrict lbs)
 
     if dry then do
       LBS.putStr (serialise box)

hbs2-peer/app/PeerMain.hs

@@ -963,8 +963,7 @@ runPeer opts = U.handle (\e -> myException e
   let reflogFetchAction puk = do
         trace "reflogFetchAction"
         void $ liftIO $ async $ withPeerM penv $ do
-          forKnownPeers @e $ \p _ -> do
+          broadCastMessage (RefLogRequest @e puk)
-            request p (RefLogRequest @e puk)
 
   let reflogGetAction puk = do
         trace $ "reflogGetAction" <+> pretty (AsBase58 puk)
@@ -1011,10 +1010,18 @@ runPeer opts = U.handle (\e -> myException e
   let refChanProposeAction (puk, lbs) = do
         trace "reChanProposeAction"
         void $ liftIO $ async $ withPeerM penv $ do
-          let mbox = deserialiseOrFail lbs & either (const Nothing) Just
+          me <- ownPeer @e
-          maybe1 mbox (err "proposal: Can't read SignedBox") $ \box -> do
+          runMaybeT do
-            proposed <- makeProposeTran @e pc puk box
+            box <- MaybeT $ pure $ deserialiseOrFail lbs & either (const Nothing) Just
+            proposed <- MaybeT $ makeProposeTran @e pc puk box
+
             debug $ "PROPOSAL:" <+> pretty (LBS.length (serialise proposed))
+            lift $ broadCastMessage (Propose @e puk proposed)
+
+            -- FIXME: remove-this-debug-stuff
+            --   или оставить? нода будет сама себе
+            --   консенсус слать тогда. может, и оставить
+            lift $ runResponseM me $ refChanUpdateProto @e True refChanHeadAdapter (Propose @e puk proposed)
 
   let arpc = RpcAdapter pokeAction
                         dieAction