From 973873b340dabe90260f3bf1088659856304bf8a Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Fri, 14 Jul 2023 13:46:22 +0300 Subject: [PATCH] wip, refchans --- hbs2-core/lib/HBS2/Net/Proto/RefChan.hs | 33 ++++++++++++++++++++++--- 1 file changed, 29 insertions(+), 4 deletions(-) diff --git a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs b/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs index 1ea26470..3dfb62b4 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs @@ -22,6 +22,7 @@ import Data.Config.Suckless -- import Data.Hashable import Data.Text qualified as Text import Data.ByteString (ByteString) +import Data.ByteString.Lazy qualified as LBS -- import Type.Reflection (someTypeRep) import Data.Either import Data.Maybe @@ -35,7 +36,7 @@ type RefChanOwner e = PubKey 'Sign (Encryption e) type RefChanAuthor e = PubKey 'Sign (Encryption e) data SignedBox p e = - SignedBox (PubKey 'Sign e) ByteString (Signature (Encryption e)) + SignedBox (PubKey 'Sign (Encryption e)) ByteString (Signature (Encryption e)) deriving stock (Generic) type Weight = Integer @@ -65,7 +66,6 @@ newtype RefChanHeadBlockTran e = instance Serialise (RefChanHeadBlockTran e) - data RefChanHead e = RefChanHead (RefChanId e) (RefChanHeadBlockTran e) | RefChanGetHead (RefChanId e) @@ -105,6 +105,18 @@ refChanHeadProto adapter msg = do pure () +makeSignedBox :: forall e p . (Serialise p, ForRefChans e, Signatures (Encryption e)) + => PubKey 'Sign (Encryption e) + -> PrivKey 'Sign (Encryption e) + -> p + -> SignedBox p e + +makeSignedBox pk sk msg = SignedBox @p @e pk bs sign + where + bs = LBS.toStrict (serialise msg) + sign = makeSign @(Encryption e) sk bs + + instance ForRefChans e => FromStringMaybe (RefChanHeadBlock e) where fromStringMay str = RefChanHeadBlockSmall <$> version <*> quorum @@ -116,8 +128,14 @@ instance ForRefChans e => FromStringMaybe (RefChanHeadBlock e) where version = lastMay [ n | (ListVal [SymbolVal "version", LitIntVal n] ) <- parsed ] quorum = lastMay [ n | (ListVal [SymbolVal "quorum", LitIntVal n] ) <- parsed ] wait = lastMay [ n | (ListVal [SymbolVal "wait", LitIntVal n] ) <- parsed ] - peers = catMaybes [ (,) <$> fromStringMay (Text.unpack s) <*> pure w | (ListVal [SymbolVal "peer", LitStrVal s, LitIntVal w] ) <- parsed ] - authors = catMaybes [ fromStringMay (Text.unpack s) | (ListVal [SymbolVal "author", LitStrVal s] ) <- parsed ] + + peers = catMaybes [ (,) <$> fromStringMay (Text.unpack s) <*> pure w + | (ListVal [SymbolVal "peer", LitStrVal s, LitIntVal w] ) <- parsed + ] + + authors = catMaybes [ fromStringMay (Text.unpack s) + | (ListVal [SymbolVal "author", LitStrVal s] ) <- parsed + ] instance ForRefChans e => Pretty (RefChanHeadBlock e) where pretty blk = parens ("version" <+> pretty (view refChanHeadVersion blk)) <> line @@ -135,3 +153,10 @@ instance ForRefChans e => Pretty (RefChanHeadBlock e) where author p = parens ("author" <+> dquotes (pretty (AsBase58 p))) +-- TODO: implement-refchans-head +-- Сгенерировать транзакцию RefHead +-- Послать транзакцию RefHead +-- Принять транзакцию RefHead +-- Валидировать транзакцию RefHead +-- Ответить на запрос RefChanGetHead +