From 3c10aad8287eeffb5db23702c7492dc02797629f Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Mon, 17 Jul 2023 11:37:01 +0300
Subject: [PATCH] wip, hunting typeable-e-error

---
 hbs2-core/lib/HBS2/Actors/Peer/Types.hs    |  5 ++++
 hbs2-core/lib/HBS2/Net/Proto/Definition.hs |  5 +++-
 hbs2-core/lib/HBS2/Net/Proto/RefChan.hs    | 12 ++++++++-
 hbs2-peer/app/PeerTypes.hs                 | 29 ++++++++++++++++------
 4 files changed, 42 insertions(+), 9 deletions(-)

diff --git a/hbs2-core/lib/HBS2/Actors/Peer/Types.hs b/hbs2-core/lib/HBS2/Actors/Peer/Types.hs
index e02739d4..18ccd5b0 100644
--- a/hbs2-core/lib/HBS2/Actors/Peer/Types.hs
+++ b/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 ()
+
+
diff --git a/hbs2-core/lib/HBS2/Net/Proto/Definition.hs b/hbs2-core/lib/HBS2/Net/Proto/Definition.hs
index 431a8858..5f920387 100644
--- a/hbs2-core/lib/HBS2/Net/Proto/Definition.hs
+++ b/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
diff --git a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs b/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs
index c9d1ebe9..e6e3b056 100644
--- a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs
+++ b/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 ()
 
 
diff --git a/hbs2-peer/app/PeerTypes.hs b/hbs2-peer/app/PeerTypes.hs
index 6e995956..1b7e18a1 100644
--- a/hbs2-peer/app/PeerTypes.hs
+++ b/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
-                                   , MyPeer e
-                                   , HasPeerLocator e m
-                                   , HasProtocol e p
-                                   , Request e p m
-                                   , Sessions e (KnownPeer e) 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
+
+
+