mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
32a7ecfd70
commit
b304a514d7
|
@ -1,3 +1,24 @@
|
|||
NOTE: on-refchans-tldr
|
||||
CRDT с контролем прав доступа, но без полного онлайн-консенсуса.
|
||||
Проблема: участники могут искажать историю после их удаления из
|
||||
списка авторов.
|
||||
|
||||
Решение:
|
||||
|
||||
Транзакции требуют подтверждений от нескольких пиров.
|
||||
Только авторизованные пиры могут подписывать и публиковать транзакции.
|
||||
Транзакции подписываются автором и пиром, ссылаясь на актуальный ACL/HEAD.
|
||||
Учитываем только транзакции, удовлетворяющие правилам HEAD.
|
||||
Принимаем "запоздалые" записи в течение короткого периода после обновления HEAD.
|
||||
|
||||
Подход: комбинация CRDT и консенсуса. У нас есть PROPOSE и VOTE,
|
||||
решения делаются через интерпретацию журнала или дополнительные
|
||||
транзакции. "Авторы" публикуют только валидные транзакции,
|
||||
достигая валидности при помощи сообщений эмеферного протокола
|
||||
(фазы VALIDATE/PRECOMMIT).
|
||||
|
||||
|
||||
|
||||
NOTE: on-refchans-1
|
||||
Написал, что фиксация владельцем истории не меняется, и это инвариант.
|
||||
Смешно получилось.
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue