voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip

This commit is contained in:
Dmitry Zuikov 2024-03-25 10:36:51 +03:00
parent c0356439d2
commit 8f1b59b0a0
1 changed files with 43 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs
View File

@ -35,10 +35,10 @@ data GitRepoRefFact =
data GitRepoHeadFact = data GitRepoHeadFact =
GitRepoHeadFact1 GitRepoHeadFact1
{ gitRepoName :: Text { gitRepoHeadRef :: HashRef
, gitRepoName :: Text
, gitRepoBrief :: Text , gitRepoBrief :: Text
, gitRepoEncrypted :: Bool , gitRepoEncrypted :: Bool
, gitRepoHeadRef :: HashRef
} }
deriving stock (Generic) deriving stock (Generic)
@ -48,14 +48,23 @@ data GitRepoFacts =
| GitRepoHeadFact HashRef GitRepoHeadFact | GitRepoHeadFact HashRef GitRepoHeadFact
deriving stock (Generic) deriving stock (Generic)
instance Serialise GitRepoRefFact instance Serialise GitRepoRefFact
instance Serialise GitRepoHeadFact instance Serialise GitRepoHeadFact
instance Serialise GitRepoFacts instance Serialise GitRepoFacts
instance Pretty GitRepoFacts where
pretty (GitRepoRefFact x) = pretty x
pretty (GitRepoHeadFact _ x) = pretty x
instance Pretty GitRepoRefFact where instance Pretty GitRepoRefFact where
pretty (GitRepoFact1{..}) = pretty (GitRepoFact1{..}) =
parens ( "gitrepofact1" <+> hsep [pretty gitLwwRef, pretty gitLwwSeq, pretty gitRefLog]) parens ( "gitrepofact1" <+> hsep [pretty gitLwwRef, pretty gitLwwSeq, pretty gitRefLog])
instance Pretty GitRepoHeadFact where
pretty (GitRepoHeadFact1{..}) =
parens ( "gitrepoheadfact1" <+> hsep [pretty gitRepoHeadRef])
runOracle :: forall m . MonadUnliftIO m => Oracle m () runOracle :: forall m . MonadUnliftIO m => Oracle m ()
runOracle = do runOracle = do
@ -80,12 +89,14 @@ runOracle = do
(lwwSeq lw) (lwwSeq lw)
(RefLogKey rk) (RefLogKey rk)
facts <- S.toList_ do
for_ repos $ \what@GitRepoFact1{..} -> do for_ repos $ \what@GitRepoFact1{..} -> do
mhead <- callRpcWaitMay @RpcRefLogGet (TimeoutSec 1) reflog (coerce gitRefLog) mhead <- lift $ callRpcWaitMay @RpcRefLogGet (TimeoutSec 1) reflog (coerce gitRefLog)
<&> join <&> join
forM_ mhead $ \mh -> do for_ mhead $ \mh -> do
txs <- S.toList_ $ do txs <- S.toList_ $ do
walkMerkle @[HashRef] (fromHashRef mh) (getBlock sto) $ \case walkMerkle @[HashRef] (fromHashRef mh) (getBlock sto) $ \case
@ -102,16 +113,11 @@ runOracle = do
let tx' = maximumByMay (comparing fst) txs let tx' = maximumByMay (comparing fst) txs
headFact <- forM tx' $ \(n,tx) -> void $ runMaybeT do for_ tx' $ \(n,tx) -> void $ runMaybeT do
(rhh,RepoHeadSimple{..}) <- readRepoHeadFromTx sto tx (rhh,RepoHeadSimple{..}) <- readRepoHeadFromTx sto tx
>>= toMPlus >>= toMPlus
let enc = isJust _repoHeadGK0
let name = Text.take 256 $ _repoHeadName
let brief = Text.take 1024 $ _repoHeadBrief
let manifest = _repoManifest
debug $ "found head" debug $ "found head"
<+> pretty enc <+> pretty enc
<+> pretty n <+> pretty n
@ -125,22 +131,18 @@ runOracle = do
<> line <> line
<> line <> line
let repoFactHash = hashObject @HbSync (serialise what) & HashRef
let f1 = GitRepoRefFact what let f1 = GitRepoRefFact what
let f2 = GitRepoHeadFact let f2 = GitRepoHeadFact
repoFactHash repoFactHash
(GitRepoHeadFact1 name brief enc undefined (GitRepoHeadFact1 rhh name brief enc)
)
pure undefined lift $ S.yield f1
lift $ S.yield f2
for_ facts $ \f -> do
debug $ pretty f
pure () pure ()
-- debug $ "found head"
-- <+> pretty gitLwwRef
-- <+> pretty n
-- <+> pretty enc
-- <+> pretty gitRefLog
-- <+> pretty name
-- <+> pretty brief
-- <+> pretty manifest
-- <+> pretty tx