lwwref proto skeleton

hbs2-peer/app/PeerMain.hs

@@ -1048,7 +1048,8 @@ runPeer opts = Exception.handle (\e -> myException e
                     , makeResponse (refChanUpdateProto False pc refChanAdapter)
                     , makeResponse (refChanRequestProto False refChanAdapter)
                     , makeResponse (refChanNotifyProto False refChanAdapter)
-                    , makeResponse lwwRefProto
+                    -- TODO: change-all-to-authorized
+                    , makeResponse (authorized lwwRefProto)
                     ]
 
 

hbs2-peer/app/PeerTypes.hs

@@ -481,4 +481,15 @@ simpleBlockAnnounce size h = do
     pure $ BlockAnnounce @e no annInfo
 
 
+authorized :: forall e proto m . ( MonadIO m
+                                 , Request e proto m
+                                 , Response e proto m
+                                 , Sessions e (KnownPeer e) m
+                                 )
+           => (proto -> m ()) -> proto -> m ()
+authorized f req = do
+  p <- thatPeer @proto
+  auth <- find (KnownPeerKey p) id <&> isJust
+  when auth (f req)
+
 

hbs2-peer/lib/HBS2/Peer/Proto/LWWRef/Internal.hs

@@ -5,6 +5,7 @@ module HBS2.Peer.Proto.LWWRef.Internal
 
 import HBS2.Prelude.Plated
 import HBS2.Peer.Proto.LWWRef
+import HBS2.Storage
 
 import HBS2.Hash
 import HBS2.Clock
@@ -33,6 +34,7 @@ lwwRefProto :: forall e s m proto . ( MonadIO m
                                     , Response e proto m
                                     , HasDeferred proto e m
                                     , HasGossip e (LWWRefProto e) m
+                                    , HasStorage m
                                     , IsPeerAddr e m
                                     , Pretty (Peer e)
                                     , Sessions e (KnownPeer e) m