wip, hunting typeable-e-error

hbs2-core/lib/HBS2/Actors/Peer/Types.hs

@@ -1,6 +1,7 @@
 module HBS2.Actors.Peer.Types where
 
 import HBS2.Storage
+import HBS2.Net.Proto.Types
 import HBS2.Hash
 
 import Control.Monad.Trans.Class
@@ -30,3 +31,7 @@ instance (Monad m, HasStorage m) => HasStorage (MaybeT m) where
   getStorage = lift getStorage
 
 
+class HasProtocol e p => HasGossip p e m where
+  gossip :: p -> m ()
+
+

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

@@ -105,7 +105,7 @@ instance HasProtocol L4Proto (RefLogUpdate L4Proto) where
   encode = serialise
 
   -- TODO: find-out-optimal-max-safe-frequency
-  requestPeriodLim = ReqLimPerMessage 60
+  requestPeriodLim = ReqLimPerMessage 600
 
 instance HasProtocol L4Proto (RefLogRequest L4Proto) where
   type instance ProtocolId (RefLogRequest L4Proto) = 8
@@ -137,6 +137,9 @@ instance HasProtocol L4Proto (RefChanUpdate L4Proto) where
   decode = either (const Nothing) Just . deserialiseOrFail
   encode = serialise
 
+  -- мы не можем рассылать одинаковые сообщения никогда,
+  -- ну или хотя бы не чаще, чем раз в 10 минут.
+  requestPeriodLim = ReqLimPerMessage 600
 
 instance Expires (SessionKey L4Proto (BlockInfo L4Proto)) where
   expiresIn _ = Just defCookieTimeoutSec

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

@@ -165,6 +165,7 @@ refChanHeadProto :: forall e s m . ( MonadIO m
                                    , Pretty (Peer e)
                                    , Sessions e (KnownPeer e) m
                                    , HasStorage m
+                                   , HasGossip (RefChanHead e) e m
                                    , Signatures s
                                    , IsRefPubKey s
                                    , Pretty (AsBase58 (PubKey 'Sign s))
@@ -213,7 +214,6 @@ refChanHeadProto self adapter msg = do
     proto = Proxy @(RefChanHead e)
 
 
-
 refChanUpdateProto :: forall e s m . ( MonadIO m
                                      , Request e (RefChanUpdate e) m
                                      , Response e (RefChanUpdate e) m
@@ -223,6 +223,7 @@ refChanUpdateProto :: forall e s m . ( MonadIO m
                                      , Sessions e (KnownPeer e) m
                                      , Sessions e (RefChanHeadBlock e) m
                                      , HasStorage m
+                                     , HasGossip (RefChanUpdate e) e m
                                      , Signatures s
                                      , IsRefPubKey s
                                      , Pretty (AsBase58 (PubKey 'Sign s))
@@ -308,6 +309,15 @@ refChanUpdateProto self adapter msg = do
 
         debug $ "OMG!!! TRANS AUTHORIZED" <+> pretty (AsBase58 peerKey)  <+> pretty (AsBase58 authorKey)
 
+        -- ок, теперь мы можем:
+        --  gossip propose если еще нет
+
+        lift $ gossip msg
+
+        --  генерируем Accept и рассылаем всем
+        --   рассылаем ли себе?
+        --   как сюда просунуть ручку Gossip ?
+
         pure ()
 
 

hbs2-peer/app/PeerTypes.hs

@@ -1,10 +1,12 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# Language TemplateHaskell #-}
 {-# Language UndecidableInstances #-}
+{-# Language AllowAmbiguousTypes #-}
 {-# Language MultiWayIf #-}
 module PeerTypes where
 
 import HBS2.Actors.Peer
+import HBS2.Actors.Peer.Types
 import HBS2.Clock
 import HBS2.Defaults
 import HBS2.Events
@@ -345,13 +347,16 @@ failedDownload p h = do
   addDownload mzero h
   -- FIXME: brains-download-fail
 
-broadCastMessage :: forall e p m . ( MonadIO m
+type ForGossip p e m =
+  ( MonadIO m
   , MyPeer e
   , HasPeerLocator e m
   , HasProtocol e p
   , Request e p m
   , Sessions e (KnownPeer e) m
   )
+
+broadCastMessage :: forall e p m . ( ForGossip p e m )
                    => p -> m ()
 
 broadCastMessage msg = do
@@ -450,3 +455,13 @@ polling o listEntries action = do
     ) refs0
 
 
+instance (ForGossip p e m, HasPeer e, Sessions e (KnownPeer e) m, HasPeerLocator e m) => HasGossip p e (PeerM e m) where
+  gossip msg = do
+    pips <- getKnownPeers @e
+    pure ()
+
+instance (Monad m, HasGossip p e (PeerM e m)) => HasGossip p e (ResponseM e (PeerM e m)) where
+  gossip = lift . gossip
+
+
+