This commit is contained in:
Dmitry Zuikov 2023-07-17 10:36:31 +03:00
parent 32a7ecfd70
commit b304a514d7
3 changed files with 90 additions and 10 deletions

View File

@ -1,3 +1,24 @@
NOTE: on-refchans-tldr
CRDT с контролем прав доступа, но без полного онлайн-консенсуса.
Проблема: участники могут искажать историю после их удаления из
списка авторов.
Решение:
Транзакции требуют подтверждений от нескольких пиров.
Только авторизованные пиры могут подписывать и публиковать транзакции.
Транзакции подписываются автором и пиром, ссылаясь на актуальный ACL/HEAD.
Учитываем только транзакции, удовлетворяющие правилам HEAD.
Принимаем "запоздалые" записи в течение короткого периода после обновления HEAD.
Подход: комбинация CRDT и консенсуса. У нас есть PROPOSE и VOTE,
решения делаются через интерпретацию журнала или дополнительные
транзакции. "Авторы" публикуют только валидные транзакции,
достигая валидности при помощи сообщений эмеферного протокола
(фазы VALIDATE/PRECOMMIT).
NOTE: on-refchans-1
Написал, что фиксация владельцем истории не меняется, и это инвариант.
Смешно получилось.

View File

@ -6,10 +6,11 @@ module HBS2.Net.Proto.RefChan where
import HBS2.Prelude.Plated
import HBS2.Hash
import HBS2.Data.Detect
-- import HBS2.Clock
import HBS2.Clock
import HBS2.Net.Proto
import HBS2.Net.Auth.Credentials
import HBS2.Base58
import HBS2.Defaults
-- import HBS2.Events
import HBS2.Net.Proto.Peer
import HBS2.Net.Proto.BlockAnnounce
@ -129,6 +130,21 @@ data RefChanUpdate e =
instance ForRefChans e => Serialise (RefChanUpdate e)
type instance SessionData e (RefChanHeadBlock e) = RefChanHeadBlock e
newtype instance SessionKey e (RefChanHeadBlock e) =
RefChanHeadBlockKey (RefChanHeadKey (Encryption e))
deriving newtype instance ForRefChans L4Proto
=> Hashable (SessionKey L4Proto (RefChanHeadBlock L4Proto))
deriving stock instance ForRefChans L4Proto
=> Eq (SessionKey L4Proto (RefChanHeadBlock L4Proto))
-- TODO: define-expiration-time
instance Expires (SessionKey L4Proto (RefChanHeadBlock L4Proto)) where
expiresIn = const (Just defCookieTimeoutSec)
-- data RefChanNotifyMsg e =
-- Notify (SignedBox ByteString e)
-- deriving stock (Generic)
@ -205,6 +221,7 @@ refChanUpdateProto :: forall e s m . ( MonadIO m
, IsPeerAddr e m
, Pretty (Peer e)
, Sessions e (KnownPeer e) m
, Sessions e (RefChanHeadBlock e) m
, HasStorage m
, Signatures s
, IsRefPubKey s
@ -268,22 +285,20 @@ refChanUpdateProto self adapter msg = do
(authorKey, bs) <- MaybeT $ pure $ unboxSignedBox0 abox
-- итак, сначала достаём голову. как мы достаём голову?
h <- MaybeT $ liftIO $ getRef sto (RefChanHeadKey @s chan)
let refchanKey = RefChanHeadKey @s chan
h <- MaybeT $ liftIO $ getRef sto refchanKey
-- смотрим, что у нас такая же голова.
-- если нет -- значит, кто-то рассинхронизировался.
-- может быть, потом попробуем головы запросить
guard (HashRef h == headRef)
-- теперь достаём голову
-- FIXME: cache-this
hdblob <- MaybeT $ readBlobFromTree ( getBlock sto ) (HashRef h)
(_, headBlock) <- MaybeT $ pure $ unboxSignedBox @(RefChanHeadBlock e) @e hdblob
debug $ "OMG! Got trans" <+> pretty (AsBase58 peerKey) <+> pretty (AsBase58 authorKey)
-- теперь достаём голову
headBlock <- MaybeT $ getActualRefChanHead @e refchanKey
let pips = view refChanHeadPeers headBlock
let aus = view refChanHeadAuthors headBlock
@ -299,6 +314,42 @@ refChanUpdateProto self adapter msg = do
where
proto = Proxy @(RefChanUpdate e)
getActualRefChanHead :: forall e s m . ( MonadIO m
, Sessions e (RefChanHeadBlock e) m
, HasStorage m
, Signatures s
, IsRefPubKey s
, Pretty (AsBase58 (PubKey 'Sign s))
-- , Serialise (Signature s)
, ForRefChans e
, HasStorage m
, s ~ Encryption e
)
=> RefChanHeadKey s
-> m (Maybe (RefChanHeadBlock e))
getActualRefChanHead key = do
sto <- getStorage
runMaybeT do
mbHead <- do
lift $ find @e (RefChanHeadBlockKey key) id
case mbHead of
Just hd -> do
debug "HEAD DISCOVERED"
pure hd
Nothing -> do
debug "ABOUT TO FIND HEAD"
h <- MaybeT $ liftIO $ getRef sto key
hdblob <- MaybeT $ readBlobFromTree ( getBlock sto ) (HashRef h)
(_, headblk) <- MaybeT $ pure $ unboxSignedBox @(RefChanHeadBlock e) @e hdblob
lift $ update headblk (RefChanHeadBlockKey key) id -- set found head
debug "HEAD FOUND"
pure headblk
makeProposeTran :: forall e s m . ( MonadIO m
, ForRefChans e
, Signatures (Encryption e)

View File

@ -213,7 +213,6 @@ refChanWorker env brains = do
ourVersion <- runMaybeT do
cur <- MaybeT $ liftIO $ getRef sto rkey
lbss <- MaybeT $ readBlobFromTree (getBlock sto) (HashRef cur)
@ -230,6 +229,15 @@ refChanWorker env brains = do
liftIO $ updateRef sto rkey (fromHashRef hr)
-- если это мы сами его обновили - то неплохо бы
-- всем разослать уведомление. А как?
--
-- TODO: update-acl-here
forM_ (HashMap.keys $ view refChanHeadPeers blk) $ \pip -> do
debug $ "ADD PEER ACL" <+> pretty (AsBase58 chan) <+> pretty(AsBase58 pip)
forM_ (view refChanHeadAuthors blk) $ \au -> do
debug $ "ADD AUTHOR ACL" <+> pretty (AsBase58 chan) <+> pretty(AsBase58 au)
when notify do
debug $ "NOTIFY-ALL-HEAD-UPDATED" <+> pretty (AsBase58 pk) <+> pretty hr
broadCastMessage (RefChanHead @e pk (RefChanHeadBlockTran hr))