From c0356439d2617908c9696150ee7539d4d880e089 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Mon, 25 Mar 2024 10:27:15 +0300 Subject: [PATCH] wip --- hbs2-git/git-hbs2/Main.hs | 5 +- hbs2-git/git-remote-hbs2/Main.hs | 5 +- .../HBS2/Git/Client/Export.hs | 2 +- .../hbs2-git-client-lib/HBS2/Git/Data/Tx.hs | 3 +- .../lib/HBS2/Git/Oracle/Run.hs | 56 ++++++++++++++----- .../HBS2/Peer/Proto/RefChan/RefChanUpdate.hs | 24 -------- 6 files changed, 52 insertions(+), 43 deletions(-) diff --git a/hbs2-git/git-hbs2/Main.hs b/hbs2-git/git-hbs2/Main.hs index 65a4d950..24bb5f31 100644 --- a/hbs2-git/git-hbs2/Main.hs +++ b/hbs2-git/git-hbs2/Main.hs @@ -150,7 +150,7 @@ pShowRef = do tx <- withState do selectMaxAppliedTx >>= lift . toMPlus <&> fst - rh <- TX.readRepoHeadFromTx sto tx >>= toMPlus + rh <- TX.readRepoHeadFromTx sto tx >>= toMPlus <&> snd liftIO $ print $ vcat (fmap formatRef (_repoHeadRefs rh)) @@ -172,7 +172,8 @@ pKeyShow = do selectMaxAppliedTx >>= lift . toMPlus <&> fst rh <- TX.readRepoHeadFromTx sto tx - >>= toMPlus + >>= toMPlus + <&> snd gkh <- toMPlus (_repoHeadGK0 rh) diff --git a/hbs2-git/git-remote-hbs2/Main.hs b/hbs2-git/git-remote-hbs2/Main.hs index 7bd78504..9db39c3b 100644 --- a/hbs2-git/git-remote-hbs2/Main.hs +++ b/hbs2-git/git-remote-hbs2/Main.hs @@ -177,7 +177,10 @@ main = do r' <- runMaybeT $ withState do tx <- selectMaxAppliedTx >>= lift . toMPlus <&> fst - rh <- TX.readRepoHeadFromTx sto tx >>= lift . toMPlus + rh <- TX.readRepoHeadFromTx sto tx + >>= lift . toMPlus + <&> snd + pure (_repoHeadRefs rh) let r = fromMaybe mempty r' diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs index c48ee7b1..0242396e 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs +++ b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs @@ -191,7 +191,7 @@ export key refs = do tx0 <- getLastAppliedTx - rh0 <- runMaybeT ( toMPlus tx0 >>= readRepoHeadFromTx sto >>= toMPlus ) + rh0 <- runMaybeT ( toMPlus tx0 >>= readRepoHeadFromTx sto >>= toMPlus <&> snd) (name,brief,mf) <- lift getManifest diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx.hs index 75172dd3..d8ec8b76 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx.hs +++ b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx.hs @@ -212,7 +212,7 @@ readTx sto href = do readRepoHeadFromTx :: MonadIO m => AnyStorage -> HashRef - -> m (Maybe RepoHead) + -> m (Maybe (HashRef, RepoHead)) readRepoHeadFromTx sto href = runMaybeT do @@ -226,6 +226,7 @@ readRepoHeadFromTx sto href = runMaybeT do >>= toMPlus <&> deserialiseOrFail @RepoHead >>= toMPlus + <&> (rhh,) data BundleMeta = diff --git a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs index f48a13df..5f3c9d58 100644 --- a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs +++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs @@ -3,6 +3,7 @@ module HBS2.Git.Oracle.Run where import HBS2.Git.Oracle.Prelude import HBS2.Git.Oracle.App +import HBS2.Hash import HBS2.Merkle import HBS2.Git.Data.LWWBlock @@ -17,13 +18,14 @@ import Codec.Serialise import Control.Monad.Trans.Maybe import Data.Coerce import Data.Ord +import Data.Text qualified as Text import Control.Monad.Trans.Except import Data.List import Safe {- HLINT ignore "Functor law" -} -data GitRepoFact = +data GitRepoRefFact = GitRepoFact1 { gitLwwRef :: LWWRefKey HBS2Basic , gitLwwSeq :: Word64 @@ -32,23 +34,29 @@ data GitRepoFact = deriving stock (Generic) data GitRepoHeadFact = - GitRepoHeadFact - { + GitRepoHeadFact1 + { gitRepoName :: Text + , gitRepoBrief :: Text + , gitRepoEncrypted :: Bool + , gitRepoHeadRef :: HashRef } deriving stock (Generic) -instance Serialise GitRepoFact +data GitRepoFacts = + GitRepoRefFact GitRepoRefFact + | GitRepoHeadFact HashRef GitRepoHeadFact + deriving stock (Generic) -instance Pretty GitRepoFact where +instance Serialise GitRepoRefFact +instance Serialise GitRepoHeadFact +instance Serialise GitRepoFacts + +instance Pretty GitRepoRefFact where pretty (GitRepoFact1{..}) = parens ( "gitrepofact1" <+> hsep [pretty gitLwwRef, pretty gitLwwSeq, pretty gitRefLog]) -makeGitRepoFactBlock :: MonadUnliftIO m => [GitRepoFact] -> Oracle m HashRef -makeGitRepoFactBlock facts = do - undefined - runOracle :: forall m . MonadUnliftIO m => Oracle m () runOracle = do debug "hbs2-git-oracle" @@ -94,12 +102,14 @@ runOracle = do let tx' = maximumByMay (comparing fst) txs - forM_ tx' $ \(n,tx) -> void $ runMaybeT do - RepoHeadSimple{..} <- readRepoHeadFromTx sto tx >>= toMPlus + headFact <- forM tx' $ \(n,tx) -> void $ runMaybeT do - let enc = if isJust _repoHeadGK0 then "E" else "P" - let name = _repoHeadName - let brief = _repoHeadBrief + (rhh,RepoHeadSimple{..}) <- readRepoHeadFromTx sto tx + >>= toMPlus + + let enc = isJust _repoHeadGK0 + let name = Text.take 256 $ _repoHeadName + let brief = Text.take 1024 $ _repoHeadBrief let manifest = _repoManifest debug $ "found head" @@ -115,4 +125,22 @@ runOracle = do <> line <> line + let f1 = GitRepoRefFact what + let f2 = GitRepoHeadFact + repoFactHash + (GitRepoHeadFact1 name brief enc undefined + ) + + pure undefined + + pure () + -- debug $ "found head" + -- <+> pretty gitLwwRef + -- <+> pretty n + -- <+> pretty enc + -- <+> pretty gitRefLog + -- <+> pretty name + -- <+> pretty brief + -- <+> pretty manifest + -- <+> pretty tx diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/RefChanUpdate.hs b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/RefChanUpdate.hs index 2773c2b9..6b4ce512 100644 --- a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/RefChanUpdate.hs +++ b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/RefChanUpdate.hs @@ -299,30 +299,6 @@ refChanUpdateProto self pc adapter msg = do debug $ "OMG!!! TRANS AUTHORIZED" <+> pretty (AsBase58 peerKey) <+> pretty (AsBase58 authorKey) - -- TODO: validate-transaction - -- итак, как нам валидировать транзакцию? - -- HTTP ? - -- TCP ? - -- UDP ? (кстати, годно и быстро) - -- CLI ? - -- получается, риалтайм: ждём не более X секунд валидации, - -- иначе не валидируем. - -- по хорошему, не блокироваться бы в запросе. - -- тут мы зависим от состояния конвейра, нас можно DDoS-ить - -- большим количеством запросов и транзакции будут отклоняться - -- при большом потоке. - -- но решается это.. тадам! PoW! подбором красивых хэшей - -- при увеличении нагрузки. - -- тогда, правда, в открытой системе работает паттерн -- DDoS - -- всех, кроме своих узлов, а свои узлы всё принимают. - - -- для начала: сделаем хук для валидации, которыйне будет делать ничего - - -- если не смогли сохранить транзу, то и Accept разослать - -- не сможем - -- это правильно, так как транза содержит ссылку на RefChanId - -- следовательно, для другого рефчана будет другая транза - hash <- MaybeT $ liftIO $ putBlock sto (serialise msg) ts <- liftIO getTimeCoarse