diff --git a/hbs2-git/git-hbs2-subscribe/Main.hs b/hbs2-git/git-hbs2-subscribe/Main.hs index d65fdaa5..b5e3176f 100644 --- a/hbs2-git/git-hbs2-subscribe/Main.hs +++ b/hbs2-git/git-hbs2-subscribe/Main.hs @@ -23,9 +23,8 @@ main = do <*> argument pLww (metavar "LWWREF") join $ execParser (info (parser <**> helper) ( fullDesc - <> progDesc "Parse command line arguments" - <> header "Command line arguments parsing example")) - + <> progDesc "subscribe to hbs2-git repo reference" + <> header "hbs2-git-subscribe")) where pLww :: ReadM (LWWRefKey HBS2Basic) diff --git a/hbs2-git/hbs2-git-oracle/app/Main.hs b/hbs2-git/hbs2-git-oracle/app/Main.hs index fa399b3d..67baefe3 100644 --- a/hbs2-git/hbs2-git-oracle/app/Main.hs +++ b/hbs2-git/hbs2-git-oracle/app/Main.hs @@ -2,8 +2,29 @@ module Main where import HBS2.Git.Oracle.Prelude +import Options.Applicative + main :: IO () main = do - print "hbs2-git-oracle" + let parser = runApp + <$> flag False True ( long "serve" + <> short 's' + <> help "serve" + ) + + join $ execParser (info (parser <**> helper) + ( fullDesc + <> progDesc "hbs2-git oracle / distributed index builder" + <> header "hbs2-git-oracle")) + +runApp :: MonadUnliftIO m => Bool -> m () +runApp _ = do + pure () + + + -- where + -- pLww :: ReadM (LWWRefKey HBS2Basic) + -- pLww = maybeReader fromStringMay + 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 f61ed714..121b99d5 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 @@ -2,11 +2,13 @@ module HBS2.Git.Oracle.App where import HBS2.Git.Oracle.Prelude -import Control.Monad.Reader +import HBS2.Peer.CLI.Detect data OracleEnv = OracleEnv - { + { _peerAPI :: ServiceCaller PeerAPI UNIX + , _reflogAPI :: ServiceCaller RefLogAPI UNIX + , _lwwAPI :: ServiceCaller LWWRefAPI UNIX } deriving stock (Generic) @@ -21,8 +23,37 @@ newtype Oracle m a = , MonadUnliftIO ) -newOracleEnv :: MonadIO m => m OracleEnv -newOracleEnv = pure OracleEnv +newOracleEnv :: MonadUnliftIO m => m OracleEnv +newOracleEnv = do + + soname <- detectRPC + `orDie` "can't locate rpc" + + flip runContT pure do + + client <- lift $ race (pause @'Seconds 1) (newMessagingUnix False 1.0 soname) + >>= orThrowUser ("can't connect to" <+> pretty soname) + + 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 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 5dfb14e8..b58ad7d2 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,12 +1,40 @@ module HBS2.Git.Oracle.Prelude ( module HBS2.Prelude.Plated - , module Control.Monad.Reader.Class + , module HBS2.OrDie + , module HBS2.Net.Auth.Schema + , module HBS2.Storage + , module HBS2.Peer.Proto.RefLog + , module HBS2.Peer.Proto.LWWRef + , module HBS2.Net.Proto.Service + , module HBS2.Peer.RPC.API.Peer + , module HBS2.Peer.RPC.API.RefLog + , module HBS2.Peer.RPC.API.LWWRef + , module HBS2.Peer.RPC.API.Storage + , module HBS2.Peer.RPC.Client.StorageClient + , module HBS2.Peer.RPC.Client.Unix + + , module Control.Monad.Reader + , module Control.Monad.Trans.Cont , module UnliftIO ) where import HBS2.Prelude.Plated +import HBS2.OrDie +import HBS2.Net.Auth.Schema +import HBS2.Net.Proto.Service +import HBS2.Storage -import Control.Monad.Reader.Class +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.LWWRef +import HBS2.Peer.RPC.API.Storage +import HBS2.Peer.RPC.Client.StorageClient +import HBS2.Peer.RPC.Client.Unix + +import Control.Monad.Reader +import Control.Monad.Trans.Cont import UnliftIO