added refchan-notify skeleton

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

@@ -30,6 +30,7 @@ import Data.ByteString.Lazy (ByteString)
 import Data.ByteString qualified as BS
 import Codec.Serialise (deserialiseOrFail,serialise)
 
+import Crypto.Saltine.Core.Box qualified as Crypto
 import Crypto.Saltine.Class qualified as Crypto
 import Crypto.Saltine.Core.Sign qualified as Sign
 import Crypto.Saltine.Core.Box qualified as Encrypt
@@ -39,6 +40,11 @@ import HBS2.Data.Types.Crypto
 
 type instance Encryption L4Proto = HBS2Basic
 
+type instance PubKey  'Sign HBS2Basic = Sign.PublicKey
+type instance PrivKey 'Sign HBS2Basic = Sign.SecretKey
+type instance PubKey  'Encrypt HBS2Basic = Encrypt.PublicKey
+type instance PrivKey 'Encrypt HBS2Basic = Encrypt.SecretKey
+
 -- FIXME: proper-serialise-for-keys
 --   Возможно, нужно написать ручные инстансы Serialise
 --   использовать encode/decode для каждого инстанса ниже $(c:end + 4)
@@ -46,6 +52,11 @@ type instance Encryption L4Proto = HBS2Basic
 --   но возможно, будет работать и так, ведь ключи
 --   это же всего лишь байтстроки внутри.
 
+instance Serialise Sign.PublicKey
+instance Serialise Encrypt.PublicKey
+instance Serialise Sign.SecretKey
+instance Serialise Encrypt.SecretKey
+
 deserialiseCustom :: (Serialise a, MonadPlus m) => ByteString -> m a
 deserialiseCustom = either (const mzero) pure . deserialiseOrFail
 -- deserialiseCustom = either (\msg -> trace ("deserialiseCustom: " <> show msg) mzero) pure . deserialiseOrFail
@@ -129,6 +140,15 @@ instance HasProtocol L4Proto (RefChanHead L4Proto) where
   -- TODO: find-out-optimal-max-frequency
   requestPeriodLim = ReqLimPerMessage 60
 
+instance HasProtocol L4Proto (EncryptionHandshake L4Proto) where
+  type instance ProtocolId (EncryptionHandshake L4Proto) = 10
+  type instance Encoded L4Proto = ByteString
+  decode = deserialiseCustom
+  encode = serialise
+
+  requestPeriodLim = ReqLimPerProto 0.5
+
+
 instance HasProtocol L4Proto (RefChanUpdate L4Proto) where
   type instance ProtocolId (RefChanUpdate L4Proto) = 11002
   type instance Encoded L4Proto = ByteString
@@ -151,13 +171,19 @@ instance HasProtocol L4Proto (RefChanRequest L4Proto) where
   -- но poll у нас в минутах, и с минимальным периодом 1 минута
   requestPeriodLim = ReqLimPerMessage 1
 
-instance HasProtocol L4Proto (EncryptionHandshake L4Proto) where
-  type instance ProtocolId (EncryptionHandshake L4Proto) = 10
+
+instance HasProtocol L4Proto (RefChanNotify L4Proto) where
+  type instance ProtocolId (RefChanNotify L4Proto) = 11004
   type instance Encoded L4Proto = ByteString
-  decode = deserialiseCustom
+  decode = either (const Nothing) Just . deserialiseOrFail
   encode = serialise
 
-  requestPeriodLim = ReqLimPerProto 0.5
+  -- не чаще раза в секуду, хотя бы.
+  -- или сколько? минуту? минуты мало.
+  -- но сообщения должны быть разные,
+  -- тогда и минута нормально.
+  -- возьмем пока 10 секунд
+  requestPeriodLim = ReqLimPerMessage 10
 
 instance Expires (SessionKey L4Proto (BlockInfo L4Proto)) where
   expiresIn _ = Just defCookieTimeoutSec
@@ -177,48 +203,49 @@ instance Expires (SessionKey L4Proto (KnownPeer L4Proto)) where
 instance Expires (SessionKey L4Proto (PeerHandshake L4Proto)) where
   expiresIn _ = Just 60
 
-instance Expires (SessionKey L4Proto (EncryptionHandshake L4Proto)) where
-  expiresIn _ = Just 60
-
 instance Expires (EventKey L4Proto (PeerAnnounce L4Proto)) where
   expiresIn _ = Nothing
 
 instance Expires (EventKey L4Proto (PeerMetaProto L4Proto)) where
   expiresIn _ = Just 600
 
--- instance Expires (EventKey L4Proto (EncryptionHandshake L4Proto)) where
---   expiresIn _ = Just 600
-
 -- instance MonadIO m => HasNonces () m where
 --   type instance Nonce (PeerHandshake L4Proto) = BS.ByteString
 --   newNonce = do
---     n <- liftIO ( Encrypt.newNonce <&> Crypto.encode )
+--     n <- liftIO ( Crypto.newNonce <&> Crypto.encode )
 --     pure $ BS.take 32 n
 
 instance MonadIO m => HasNonces (PeerHandshake L4Proto) m where
   type instance Nonce (PeerHandshake L4Proto) = BS.ByteString
   newNonce = do
-    n <- liftIO ( Encrypt.newNonce <&> Crypto.encode )
+    n <- liftIO ( Crypto.newNonce <&> Crypto.encode )
     pure $ BS.take 32 n
 
 instance MonadIO m => HasNonces (PeerExchange L4Proto) m where
   type instance Nonce (PeerExchange L4Proto) = BS.ByteString
   newNonce = do
-    n <- liftIO ( Encrypt.newNonce <&> Crypto.encode )
+    n <- liftIO ( Crypto.newNonce <&> Crypto.encode )
     pure $ BS.take 32 n
 
 instance MonadIO m => HasNonces (RefLogUpdate L4Proto) m where
   type instance Nonce (RefLogUpdate L4Proto) = BS.ByteString
   newNonce = do
-    n <- liftIO ( Encrypt.newNonce <&> Crypto.encode )
+    n <- liftIO ( Crypto.newNonce <&> Crypto.encode )
     pure $ BS.take 32 n
 
 instance MonadIO m => HasNonces () m where
   type instance Nonce () = BS.ByteString
   newNonce = do
-    n <- liftIO ( Encrypt.newNonce <&> Crypto.encode )
+    n <- liftIO ( Crypto.newNonce <&> Crypto.encode )
     pure $ BS.take 32 n
 
+instance Serialise Sign.Signature
+
+instance Signatures HBS2Basic where
+  type Signature HBS2Basic = Sign.Signature
+  makeSign = Sign.signDetached
+  verifySign = Sign.signVerifyDetached
+
 instance Asymm HBS2Basic where
   type AsymmKeypair HBS2Basic = Encrypt.Keypair
   type AsymmPrivKey HBS2Basic = Encrypt.SecretKey

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

@@ -260,6 +260,14 @@ instance Typeable (RefChanRequest e) => Hashable (EventKey e (RefChanRequest e))
     where
       p = Proxy @(RefChanRequest e)
 
+-- принимается, только если соответствует текущему HEAD
+-- не пишется в журнал
+data RefChanNotify e =
+  Notify (RefChanId e) (SignedBox ByteString e) -- подписано ключом автора
+  deriving stock (Generic)
+
+instance ForRefChans e => Serialise (RefChanNotify e)
+
 -- FIXME: rename
 data RefChanAdapter e m =
   RefChanAdapter
@@ -645,6 +653,31 @@ refChanRequestProto self adapter msg = do
     proto = Proxy @(RefChanRequest e)
 
 
+refChanNotifyProto :: forall e s m . ( MonadIO m
+                                     , Request e (RefChanNotify e) m
+                                     , HasDeferred e (RefChanNotify e) m
+                                     , HasGossip e (RefChanNotify e) m
+                                     , IsPeerAddr e m
+                                     , Pretty (Peer e)
+                                     , Sessions e (KnownPeer e) m
+                                     , HasStorage m
+                                     , Signatures s
+                                     , IsRefPubKey s
+                                     , Pretty (AsBase58 (PubKey 'Sign s))
+                                     , s ~ Encryption e
+                                     )
+                  => Bool
+                  -> RefChanAdapter e m
+                  -> RefChanNotify e
+                  -> m ()
+
+refChanNotifyProto _ _ _ = do
+  -- аутентифицируем
+  -- проверяем ACL
+  -- пересылаем всем
+  pure ()
+
+
 getActualRefChanHead :: forall e s m . ( MonadIO m
                                        , Sessions e (RefChanHeadBlock e) m
                                        , HasStorage m

hbs2-peer/app/PeerMain.hs

@@ -981,6 +981,7 @@ runPeer opts = U.handle (\e -> myException e
                     , makeResponse (refChanHeadProto False refChanAdapter)
                     , makeResponse (refChanUpdateProto False pc refChanAdapter)
                     , makeResponse (refChanRequestProto False refChanAdapter)
+                    , makeResponse (refChanNotifyProto False refChanAdapter)
                     ]
 
               void $ liftIO $ waitAnyCancel workers