diff --git a/hbs2-core/lib/HBS2/Net/Proto/Service.hs b/hbs2-core/lib/HBS2/Net/Proto/Service.hs index 630473c7..893e68a0 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/Service.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/Service.hs @@ -261,6 +261,26 @@ callService caller input = do _ -> pure (Left ErrorInvalidResponse) +callRpcWaitMay :: forall method (api :: [Type]) m e proto t . ( MonadUnliftIO m + , KnownNat (FromJust (FindMethodIndex 0 method api)) + , HasProtocol e (ServiceProto api e) + , Serialise (Input method) + , Serialise (Output method) + , IsTimeout t + , proto ~ ServiceProto api e + ) + => Timeout t + -> ServiceCaller api e + -> Input method + -> m (Maybe (Output method)) + +callRpcWaitMay t caller args = do + race (pause t) (callService @method @api @e @m caller args) + >>= \case + Right (Right x) -> pure (Just x) + _ -> pure Nothing + + makeClient :: forall api e m . ( MonadIO m , HasProtocol e (ServiceProto api e) , Pretty (Peer e) diff --git a/hbs2-git/hbs2-git-oracle/app/Main.hs b/hbs2-git/hbs2-git-oracle/app/Main.hs index 67baefe3..b15cf801 100644 --- a/hbs2-git/hbs2-git-oracle/app/Main.hs +++ b/hbs2-git/hbs2-git-oracle/app/Main.hs @@ -1,8 +1,10 @@ module Main where import HBS2.Git.Oracle.Prelude +import HBS2.Git.Oracle.App +import HBS2.Git.Oracle.Run -import Options.Applicative +import Options.Applicative as O main :: IO () main = do @@ -12,19 +14,26 @@ main = do <> help "serve" ) - join $ execParser (info (parser <**> helper) + 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 - pure () + setLogging @DEBUG (toStderr . logPrefix "[debug] ") + setLogging @WARN (toStderr . logPrefix "[warn] ") + setLogging @ERROR (toStderr . logPrefix "[error] ") + setLogging @NOTICE (toStderr . logPrefix "[debug] ") - -- where - -- pLww :: ReadM (LWWRefKey HBS2Basic) - -- pLww = maybeReader fromStringMay + runWithOracleEnv runOracle + + `finally` do + setLoggingOff @DEBUG + setLoggingOff @WARN + setLoggingOff @ERROR + setLoggingOff @NOTICE 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 121b99d5..3c55a814 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 @@ -1,9 +1,19 @@ -module HBS2.Git.Oracle.App where +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE PolyKinds #-} +module HBS2.Git.Oracle.App + ( OracleEnv(..) + , Oracle(..) + , runWithOracleEnv + ) where import HBS2.Git.Oracle.Prelude import HBS2.Peer.CLI.Detect +import GHC.TypeLits +import Codec.Serialise + data OracleEnv = OracleEnv { _peerAPI :: ServiceCaller PeerAPI UNIX @@ -23,40 +33,35 @@ newtype Oracle m a = , MonadUnliftIO ) -newOracleEnv :: MonadUnliftIO m => m OracleEnv -newOracleEnv = do +runWithOracleEnv :: MonadUnliftIO m => Oracle m () -> m () +runWithOracleEnv m = do soname <- detectRPC `orDie` "can't locate rpc" - flip runContT pure do + client <- race (pause @'Seconds 1) (newMessagingUnix False 1.0 soname) + >>= orThrowUser ("can't connect to" <+> pretty soname) - client <- lift $ race (pause @'Seconds 1) (newMessagingUnix False 1.0 soname) - >>= orThrowUser ("can't connect to" <+> pretty soname) + peerAPI <- makeServiceCaller @PeerAPI (fromString soname) + reflogAPI <- makeServiceCaller @RefLogAPI (fromString soname) + lwwAPI <- makeServiceCaller @LWWRefAPI (fromString soname) + storageAPI <- makeServiceCaller @StorageAPI (fromString soname) + + env <- pure $ OracleEnv peerAPI + reflogAPI + lwwAPI + + let endpoints = [ Endpoint @UNIX peerAPI + , Endpoint @UNIX reflogAPI + , Endpoint @UNIX lwwAPI + , Endpoint @UNIX storageAPI + ] + + flip runContT pure do void $ ContT $ withAsync $ runMessagingUnix client - peerAPI <- makeServiceCaller @PeerAPI (fromString soname) - reflogAPI <- makeServiceCaller @RefLogAPI (fromString soname) - storageAPI <- makeServiceCaller @StorageAPI (fromString soname) - lwwAPI <- makeServiceCaller @LWWRefAPI (fromString soname) - - let sto = AnyStorage (StorageClient storageAPI) - - let endpoints = [ Endpoint @UNIX peerAPI - , Endpoint @UNIX reflogAPI - , Endpoint @UNIX lwwAPI - , Endpoint @UNIX storageAPI - ] - void $ ContT $ withAsync $ liftIO $ runReaderT (runServiceClientMulti endpoints) client - pure $ OracleEnv peerAPI - reflogAPI - lwwAPI - -withOracleEnv :: MonadIO m => OracleEnv -> Oracle m a -> m a -withOracleEnv env m = runReaderT (fromOracle m) env - - + lift $ runReaderT (fromOracle m) env 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 b58ad7d2..ebca824c 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 @@ -1,8 +1,12 @@ module HBS2.Git.Oracle.Prelude ( module HBS2.Prelude.Plated + , module HBS2.Base58 , module HBS2.OrDie , module HBS2.Net.Auth.Schema , module HBS2.Storage + + , module HBS2.System.Logger.Simple.ANSI + , module HBS2.Peer.Proto.RefLog , module HBS2.Peer.Proto.LWWRef , module HBS2.Net.Proto.Service @@ -13,17 +17,21 @@ module HBS2.Git.Oracle.Prelude , module HBS2.Peer.RPC.Client.StorageClient , module HBS2.Peer.RPC.Client.Unix + , module Data.Kind , module Control.Monad.Reader , module Control.Monad.Trans.Cont , module UnliftIO ) where import HBS2.Prelude.Plated +import HBS2.Base58 import HBS2.OrDie import HBS2.Net.Auth.Schema import HBS2.Net.Proto.Service import HBS2.Storage +import HBS2.System.Logger.Simple.ANSI + import HBS2.Peer.Proto.LWWRef import HBS2.Peer.Proto.RefLog import HBS2.Peer.RPC.API.Peer @@ -33,6 +41,7 @@ import HBS2.Peer.RPC.API.Storage import HBS2.Peer.RPC.Client.StorageClient import HBS2.Peer.RPC.Client.Unix +import Data.Kind import Control.Monad.Reader import Control.Monad.Trans.Cont import UnliftIO 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 new file mode 100644 index 00000000..c9bd5622 --- /dev/null +++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs @@ -0,0 +1,24 @@ +module HBS2.Git.Oracle.Run where + +import HBS2.Git.Oracle.Prelude +import HBS2.Git.Oracle.App + +import Data.Maybe + +runOracle :: MonadUnliftIO m => Oracle m () +runOracle = do + debug "hbs2-git-oracle" + + debug "list all git references from peer" + -- TODO: introduce-paging + + peer <- asks _peerAPI + + polls <- callRpcWaitMay @RpcPollList (TimeoutSec 1) peer () + <&> join . maybeToList + + + for_ polls $ \(p, s, _) -> do + debug $ "found poll" <+> pretty (AsBase58 p) <+> pretty s + + diff --git a/hbs2-git/hbs2-git.cabal b/hbs2-git/hbs2-git.cabal index 58b96779..ecf55583 100644 --- a/hbs2-git/hbs2-git.cabal +++ b/hbs2-git/hbs2-git.cabal @@ -174,6 +174,7 @@ library hbs2-git-oracle-oracle-lib exposed-modules: HBS2.Git.Oracle.Prelude HBS2.Git.Oracle.App + HBS2.Git.Oracle.Run build-depends: base , base16-bytestring