mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
Dmitry Zuikov
parent
860ced4689
commit
c0356439d2
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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'
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue