mirror of https://github.com/voidlizard/hbs2
timestamp-to-refchan-accept
This commit is contained in:
Dmitry Zuikov
parent
f3a4082099
commit
18bb821dfd
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue