diff --git a/hbs2-core/CHANGELOG.md b/hbs2-core/CHANGELOG.md index 4ffba7ba..24663ce3 100644 --- a/hbs2-core/CHANGELOG.md +++ b/hbs2-core/CHANGELOG.md @@ -1,5 +1,5 @@ # Revision history for hbs2-core -## 0.1.0.0 -- YYYY-mm-dd +## 0.1.1.0 -- 2023-12-16 -* First version. Released on an unsuspecting world. +* RefChan breaking change. Timestamp field added to Accept transaction. diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal index c0e2fea3..b8a1ec1c 100644 --- a/hbs2-core/hbs2-core.cabal +++ b/hbs2-core/hbs2-core.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hbs2-core -version: 0.1.0.0 +version: 0.1.1.0 -- synopsis: -- description: license: BSD-3-Clause diff --git a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs b/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs index e2765d2e..036ce4f0 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs @@ -3,6 +3,7 @@ {-# Language TemplateHaskell #-} {-# Language FunctionalDependencies #-} {-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE PatternSynonyms, ViewPatterns #-} module HBS2.Net.Proto.RefChan where import HBS2.Prelude.Plated @@ -21,7 +22,6 @@ import HBS2.Data.Types.Refs import HBS2.Data.Types.SignedBox import HBS2.Actors.Peer.Types import HBS2.Data.Types.Peer -import HBS2.Net.Messaging.Unix (UNIX) import HBS2.Storage import Data.Config.Suckless @@ -32,21 +32,22 @@ import Codec.Serialise import Control.Monad.Identity import Control.Monad.Trans.Maybe import Data.ByteString (ByteString) -import Data.ByteString qualified as BS -import Data.ByteString.Lazy qualified as LBS import Data.Either import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict qualified as HashMap import Data.HashSet (HashSet) import Data.HashSet qualified as HashSet import Data.Maybe +import Data.Word import Data.Text qualified as Text import Lens.Micro.Platform import Data.Hashable hiding (Hashed) import Type.Reflection (someTypeRep) +import Data.Time.Clock.POSIX (getPOSIXTime) import UnliftIO + {- HLINT ignore "Use newtype instead of data" -} type RefChanId e = PubKey 'Sign (Encryption e) @@ -141,7 +142,7 @@ instance Pretty (AsBase58 (PubKey 'Sign s )) => Pretty (RefChanHeadKey s) where pretty (RefChanHeadKey k) = pretty (AsBase58 k) -newtype RefChanLogKey s = RefChanLogKey (PubKey 'Sign s) +newtype RefChanLogKey s = RefChanLogKey { fromRefChanLogKey :: PubKey 'Sign s } deriving stock instance IsRefPubKey s => Eq (RefChanLogKey s) @@ -183,14 +184,35 @@ instance ForRefChans e => Serialise (RefChanHead e) data ProposeTran e = ProposeTran HashRef (SignedBox ByteString e) -- произвольная бинарная транзакция, deriving stock (Generic) -- подписанная ключом **АВТОРА**, который её рассылает +newtype AcceptTime = AcceptTime Word64 + deriving stock (Eq,Ord,Data,Generic) + deriving newtype (Enum,Num,Real,Integral) -data AcceptTran e = AcceptTran HashRef HashRef -- ссылка на (ProposTran e) +instance Serialise AcceptTime + +data AcceptTran e = AcceptTran1 HashRef HashRef -- ссылка на (ProposTran e) + | AcceptTran2 (Maybe AcceptTime) HashRef HashRef deriving stock (Generic) +acceptTime :: SimpleGetter (AcceptTran e) (Maybe AcceptTime) +acceptTime = to getter + where + getter (AcceptTran1 _ _) = Nothing + getter (AcceptTran2 a _ _) = a + +unpackAcceptTran :: AcceptTran e -> (Maybe AcceptTime, HashRef, HashRef) +unpackAcceptTran (AcceptTran1 a b) = (Nothing, a, b) +unpackAcceptTran (AcceptTran2 t a b) = (t, a, b) + +pattern AcceptTran :: Maybe AcceptTime -> HashRef -> HashRef -> AcceptTran e +pattern AcceptTran t a b <- (unpackAcceptTran -> (t, a, b)) + where + AcceptTran Nothing a b = AcceptTran1 a b + AcceptTran (Just t) a b = AcceptTran2 (Just t) a b + instance ForRefChans e => Serialise (ProposeTran e) instance ForRefChans e => Serialise (AcceptTran e) - data RefChanRound e = RefChanRound { _refChanRoundKey :: HashRef -- ^ hash of the Propose transaction @@ -586,7 +608,8 @@ refChanUpdateProto self pc adapter msg = do -- если нет - то и всё, просто перешлём -- по госсипу исходную транзу - let tran = AcceptTran headRef (HashRef hash) + ts <- liftIO getPOSIXTime <&> round <&> Just + let tran = AcceptTran ts headRef (HashRef hash) -- -- генерируем Accept let accept = Accept chan (makeSignedBox @e pk sk tran) @@ -609,7 +632,7 @@ refChanUpdateProto self pc adapter msg = do debug $ "RefChanUpdate/ACCEPT" <+> pretty h0 - (peerKey, AcceptTran headRef hashRef) <- MaybeT $ pure $ unboxSignedBox0 box + (peerKey, AcceptTran _ headRef hashRef) <- MaybeT $ pure $ unboxSignedBox0 box let refchanKey = RefChanHeadKey @s chan diff --git a/hbs2-peer/app/RefChan.hs b/hbs2-peer/app/RefChan.hs index a8e43aeb..4ece608a 100644 --- a/hbs2-peer/app/RefChan.hs +++ b/hbs2-peer/app/RefChan.hs @@ -953,7 +953,7 @@ logMergeProcess penv env q = withPeerM penv do pure [(href, (quo,mempty))] Accept _ box -> do - (pk, AcceptTran headRef hashRef) <- MaybeT $ pure $ unboxSignedBox0 box + (pk, AcceptTran _ headRef hashRef) <- MaybeT $ pure $ unboxSignedBox0 box lift $ lift $ downloadMissedHead sto chan headRef