diff --git a/docs/todo/refchan.txt b/docs/todo/refchan.txt index 2fd91293..df4c6c8c 100644 --- a/docs/todo/refchan.txt +++ b/docs/todo/refchan.txt @@ -1,3 +1,24 @@ +NOTE: on-refchans-tldr + CRDT с контролем прав доступа, но без полного онлайн-консенсуса. + Проблема: участники могут искажать историю после их удаления из + списка авторов. + +Решение: + + Транзакции требуют подтверждений от нескольких пиров. + Только авторизованные пиры могут подписывать и публиковать транзакции. + Транзакции подписываются автором и пиром, ссылаясь на актуальный ACL/HEAD. + Учитываем только транзакции, удовлетворяющие правилам HEAD. + Принимаем "запоздалые" записи в течение короткого периода после обновления HEAD. + +Подход: комбинация CRDT и консенсуса. У нас есть PROPOSE и VOTE, +решения делаются через интерпретацию журнала или дополнительные +транзакции. "Авторы" публикуют только валидные транзакции, +достигая валидности при помощи сообщений эмеферного протокола +(фазы VALIDATE/PRECOMMIT). + + + NOTE: on-refchans-1 Написал, что фиксация владельцем истории не меняется, и это инвариант. Смешно получилось. diff --git a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs b/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs index ab929204..c9d1ebe9 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs @@ -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) diff --git a/hbs2-peer/app/RefChan.hs b/hbs2-peer/app/RefChan.hs index 2ae2eac8..4a234ec5 100644 --- a/hbs2-peer/app/RefChan.hs +++ b/hbs2-peer/app/RefChan.hs @@ -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))