wip, hbs2-git-oracle refchan write

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

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")
+
+

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
                   ]

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

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))
 

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