From 027e949ac885d48c7489472771a36bc1ec5b1613 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Mon, 25 Mar 2024 11:48:43 +0300 Subject: [PATCH] wip, hbs2-git-oracle refchan write --- hbs2-git/hbs2-git-oracle/app/Main.hs | 15 +++++++-- .../examples/oracle-refchan.dsl | 8 +++++ .../lib/HBS2/Git/Oracle/App.hs | 32 +++++++++++++------ .../lib/HBS2/Git/Oracle/Prelude.hs | 6 ++++ .../lib/HBS2/Git/Oracle/Run.hs | 24 +++++++++++--- hbs2-git/hbs2-git.cabal | 2 +- 6 files changed, 69 insertions(+), 18 deletions(-) create mode 100644 hbs2-git/hbs2-git-oracle/examples/oracle-refchan.dsl diff --git a/hbs2-git/hbs2-git-oracle/app/Main.hs b/hbs2-git/hbs2-git-oracle/app/Main.hs index b15cf801..486661f0 100644 --- a/hbs2-git/hbs2-git-oracle/app/Main.hs +++ b/hbs2-git/hbs2-git-oracle/app/Main.hs @@ -13,21 +13,30 @@ main = do <> short 's' <> help "serve" ) + <*> option pkey ( long "refchan" <> short 'r' <> help "refchan to post" ) + <*> option pkey ( long "author" <> short 'a' <> help "author" ) join $ execParser (O.info (parser <**> helper) ( fullDesc <> progDesc "hbs2-git oracle / distributed index builder" <> header "hbs2-git-oracle")) -runApp :: MonadUnliftIO m => Bool -> m () -runApp _ = do + where + pkey = maybeReader fromStringMay + +runApp :: MonadUnliftIO m + => Bool + -> RefChanId L4Proto + -> RefChanAuthor L4Proto + -> m () +runApp _ rchan author = do setLogging @DEBUG (toStderr . logPrefix "[debug] ") setLogging @WARN (toStderr . logPrefix "[warn] ") setLogging @ERROR (toStderr . logPrefix "[error] ") setLogging @NOTICE (toStderr . logPrefix "[debug] ") - runWithOracleEnv runOracle + runWithOracleEnv rchan author runOracle `finally` do setLoggingOff @DEBUG diff --git a/hbs2-git/hbs2-git-oracle/examples/oracle-refchan.dsl b/hbs2-git/hbs2-git-oracle/examples/oracle-refchan.dsl new file mode 100644 index 00000000..8431ce39 --- /dev/null +++ b/hbs2-git/hbs2-git-oracle/examples/oracle-refchan.dsl @@ -0,0 +1,8 @@ +(version 1) +(quorum 1) +(wait 5) +(peer "yFSaUfb97ZRtQqzHWdERsR7KJvN8qyWX1M8rJcxnsiu" 1) +(peer "5GnroAC8FXNRL8rcgJj6RTu9mt1AbuNd5MZVnDBcCKzb" 1) +(author "9zbtm335CDwgZeuutgp6kJFwUQ8Wn68izD5Qpmkr2U99") + + diff --git a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/App.hs b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/App.hs index ca217686..47b5fced 100644 --- a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/App.hs +++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/App.hs @@ -16,10 +16,13 @@ import Codec.Serialise data OracleEnv = OracleEnv - { _peerAPI :: ServiceCaller PeerAPI UNIX - , _reflogAPI :: ServiceCaller RefLogAPI UNIX - , _lwwAPI :: ServiceCaller LWWRefAPI UNIX - , _storage :: AnyStorage + { _refchanId :: RefChanId L4Proto + , _refchanAuthor :: RefChanAuthor L4Proto + , _peerAPI :: ServiceCaller PeerAPI UNIX + , _reflogAPI :: ServiceCaller RefLogAPI UNIX + , _refchanAPI :: ServiceCaller RefChanAPI UNIX + , _lwwAPI :: ServiceCaller LWWRefAPI UNIX + , _storage :: AnyStorage } deriving stock (Generic) @@ -34,8 +37,12 @@ newtype Oracle m a = , MonadUnliftIO ) -runWithOracleEnv :: MonadUnliftIO m => Oracle m () -> m () -runWithOracleEnv m = do +runWithOracleEnv :: MonadUnliftIO m + => RefChanId L4Proto + -> RefChanAuthor L4Proto + -> Oracle m () + -> m () +runWithOracleEnv rchan author m = do soname <- detectRPC `orDie` "can't locate rpc" @@ -45,17 +52,22 @@ runWithOracleEnv m = do peerAPI <- makeServiceCaller @PeerAPI (fromString soname) reflogAPI <- makeServiceCaller @RefLogAPI (fromString soname) + refchanAPI <- makeServiceCaller @RefChanAPI (fromString soname) lwwAPI <- makeServiceCaller @LWWRefAPI (fromString soname) storageAPI <- makeServiceCaller @StorageAPI (fromString soname) let sto = AnyStorage (StorageClient storageAPI) - env <- pure $ OracleEnv peerAPI - reflogAPI - lwwAPI - sto + env <- pure $ OracleEnv rchan + author + peerAPI + reflogAPI + refchanAPI + lwwAPI + sto let endpoints = [ Endpoint @UNIX peerAPI , Endpoint @UNIX reflogAPI + , Endpoint @UNIX refchanAPI , Endpoint @UNIX lwwAPI , Endpoint @UNIX storageAPI ] diff --git a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Prelude.hs b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Prelude.hs index 9bf0fb89..b9f025de 100644 --- a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Prelude.hs +++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Prelude.hs @@ -4,15 +4,18 @@ module HBS2.Git.Oracle.Prelude , module HBS2.OrDie , module HBS2.Data.Types.Refs , module HBS2.Net.Auth.Schema + , module HBS2.Net.Auth.Credentials , module HBS2.Storage , module HBS2.System.Logger.Simple.ANSI , module HBS2.Peer.Proto.RefLog , module HBS2.Peer.Proto.LWWRef + , module HBS2.Peer.Proto.RefChan , module HBS2.Net.Proto.Service , module HBS2.Peer.RPC.API.Peer , module HBS2.Peer.RPC.API.RefLog + , module HBS2.Peer.RPC.API.RefChan , module HBS2.Peer.RPC.API.LWWRef , module HBS2.Peer.RPC.API.Storage , module HBS2.Peer.RPC.Client.StorageClient @@ -29,7 +32,9 @@ import HBS2.Base58 import HBS2.OrDie import HBS2.Data.Types.Refs import HBS2.Net.Auth.Schema +import HBS2.Net.Auth.Credentials import HBS2.Net.Proto.Service +import HBS2.Peer.Proto.RefChan import HBS2.Storage import HBS2.System.Logger.Simple.ANSI @@ -38,6 +43,7 @@ import HBS2.Peer.Proto.LWWRef import HBS2.Peer.Proto.RefLog import HBS2.Peer.RPC.API.Peer import HBS2.Peer.RPC.API.RefLog +import HBS2.Peer.RPC.API.RefChan import HBS2.Peer.RPC.API.LWWRef import HBS2.Peer.RPC.API.Storage import HBS2.Peer.RPC.Client.StorageClient 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 dbbd2586..ba19b913 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 @@ -5,10 +5,14 @@ import HBS2.Git.Oracle.App import HBS2.Hash import HBS2.Merkle +import HBS2.Data.Types.SignedBox + +import HBS2.KeyMan.Keys.Direct import HBS2.Git.Data.LWWBlock import HBS2.Git.Data.Tx + import Data.Maybe import Lens.Micro.Platform @@ -21,6 +25,7 @@ import Data.Ord import Data.Text qualified as Text import Control.Monad.Trans.Except import Data.List +import Data.ByteString.Lazy qualified as LBS import Safe {- HLINT ignore "Functor law" -} @@ -66,7 +71,8 @@ instance Pretty GitRepoHeadFact where parens ( "gitrepoheadfact1" <+> hsep [pretty gitRepoHeadRef]) -runOracle :: forall m . MonadUnliftIO m => Oracle m () +runOracle :: forall m . MonadUnliftIO m + => Oracle m () runOracle = do debug "hbs2-git-oracle" @@ -141,8 +147,18 @@ runOracle = do lift $ S.yield f1 lift $ S.yield f2 + rchanAPI <- asks _refchanAPI + chan <- asks _refchanId + auPk <- asks _refchanAuthor + + auCreds <- runKeymanClient do + loadCredentials auPk >>= orThrowUser "can't load credentials" + + let ppk = view peerSignPk auCreds + let psk = view peerSignSk auCreds + for_ facts $ \f -> do - debug $ pretty f - pure () - + let box = makeSignedBox @L4Proto ppk psk (LBS.toStrict $ serialise f) + void $ callRpcWaitMay @RpcRefChanPropose (TimeoutSec 1) rchanAPI (chan, box) + debug $ "posted tx" <+> pretty (hashObject @HbSync (serialise f)) diff --git a/hbs2-git/hbs2-git.cabal b/hbs2-git/hbs2-git.cabal index 8d4113c5..49256766 100644 --- a/hbs2-git/hbs2-git.cabal +++ b/hbs2-git/hbs2-git.cabal @@ -189,7 +189,7 @@ executable hbs2-git-oracle -- other-modules: -- other-extensions: build-depends: - base, hbs2-git, hbs2-git-oracle-oracle-lib + base, hbs2-git, hbs2-git-oracle-oracle-lib, hbs2-keyman , binary , vector , optparse-applicative