mirror of https://github.com/voidlizard/hbs2
hbs2-git-oracle init
This commit is contained in:
parent
37618a32bb
commit
3735b9b973
|
@ -23,9 +23,8 @@ main = do
|
||||||
<*> argument pLww (metavar "LWWREF")
|
<*> argument pLww (metavar "LWWREF")
|
||||||
join $ execParser (info (parser <**> helper)
|
join $ execParser (info (parser <**> helper)
|
||||||
( fullDesc
|
( fullDesc
|
||||||
<> progDesc "Parse command line arguments"
|
<> progDesc "subscribe to hbs2-git repo reference"
|
||||||
<> header "Command line arguments parsing example"))
|
<> header "hbs2-git-subscribe"))
|
||||||
|
|
||||||
|
|
||||||
where
|
where
|
||||||
pLww :: ReadM (LWWRefKey HBS2Basic)
|
pLww :: ReadM (LWWRefKey HBS2Basic)
|
||||||
|
|
|
@ -2,8 +2,29 @@ module Main where
|
||||||
|
|
||||||
import HBS2.Git.Oracle.Prelude
|
import HBS2.Git.Oracle.Prelude
|
||||||
|
|
||||||
|
import Options.Applicative
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
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
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -2,11 +2,13 @@ module HBS2.Git.Oracle.App where
|
||||||
|
|
||||||
import HBS2.Git.Oracle.Prelude
|
import HBS2.Git.Oracle.Prelude
|
||||||
|
|
||||||
import Control.Monad.Reader
|
import HBS2.Peer.CLI.Detect
|
||||||
|
|
||||||
data OracleEnv =
|
data OracleEnv =
|
||||||
OracleEnv
|
OracleEnv
|
||||||
{
|
{ _peerAPI :: ServiceCaller PeerAPI UNIX
|
||||||
|
, _reflogAPI :: ServiceCaller RefLogAPI UNIX
|
||||||
|
, _lwwAPI :: ServiceCaller LWWRefAPI UNIX
|
||||||
}
|
}
|
||||||
deriving stock (Generic)
|
deriving stock (Generic)
|
||||||
|
|
||||||
|
@ -21,8 +23,37 @@ newtype Oracle m a =
|
||||||
, MonadUnliftIO
|
, MonadUnliftIO
|
||||||
)
|
)
|
||||||
|
|
||||||
newOracleEnv :: MonadIO m => m OracleEnv
|
newOracleEnv :: MonadUnliftIO m => m OracleEnv
|
||||||
newOracleEnv = pure 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 :: MonadIO m => OracleEnv -> Oracle m a -> m a
|
||||||
withOracleEnv env m = runReaderT (fromOracle m) env
|
withOracleEnv env m = runReaderT (fromOracle m) env
|
||||||
|
|
|
@ -1,12 +1,40 @@
|
||||||
module HBS2.Git.Oracle.Prelude
|
module HBS2.Git.Oracle.Prelude
|
||||||
( module HBS2.Prelude.Plated
|
( 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
|
, module UnliftIO
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import HBS2.Prelude.Plated
|
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
|
import UnliftIO
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue