mirror of https://github.com/voidlizard/hbs2
wip, refactored
This commit is contained in:
Dmitry Zuikov
parent
ffab0a7ecc
commit
4f563a760a
|
|
@ -80,16 +80,18 @@ main = do
|
|||
entry $ bindMatch "debug:cli:show" $ nil_ \case
|
||||
_ -> display cli
|
||||
|
||||
runHBS2Cli do
|
||||
|
||||
case cli of
|
||||
[ListVal [SymbolVal "stdin"]] -> do
|
||||
what <- getContents
|
||||
>>= either (error.show) pure . parseTop
|
||||
run dict what >>= eatNil display
|
||||
case cli of
|
||||
[ListVal [SymbolVal "stdin"]] -> do
|
||||
what <- liftIO getContents
|
||||
>>= either (error.show) pure . parseTop
|
||||
|
||||
[] -> do
|
||||
void $ run dict [mkForm "help" []]
|
||||
recover $ run dict what >>= eatNil display
|
||||
|
||||
_ -> do
|
||||
run dict cli >>= eatNil display
|
||||
[] -> do
|
||||
void $ run dict [mkForm "help" []]
|
||||
|
||||
_ -> do
|
||||
recover $ run dict cli >>= eatNil display
|
||||
|
||||
|
|
|
|||
|
|
@ -379,7 +379,8 @@ newtype RunM c m a = RunM { fromRunM :: ReaderT (TVar (Dict c m)) m a }
|
|||
, MonadReader (TVar (Dict c m))
|
||||
)
|
||||
|
||||
|
||||
instance MonadTrans (RunM c) where
|
||||
lift = RunM . lift
|
||||
|
||||
newtype MakeDictM c m a = MakeDictM { fromMakeDict :: Writer (Dict c m) a }
|
||||
deriving newtype ( Applicative
|
||||
|
|
|
|||
|
|
@ -7,15 +7,20 @@ import HBS2.System.Logger.Simple.ANSI as All
|
|||
import HBS2.Storage.Operations.Class
|
||||
import HBS2.Storage.Operations.ByteString
|
||||
import HBS2.Base58
|
||||
import Data.List qualified as L
|
||||
import Data.Maybe
|
||||
import HBS2.CLI.Run.Internal
|
||||
import HBS2.CLI.Run.Internal.GroupKey as G
|
||||
import HBS2.Net.Auth.GroupKeySymm as Symm
|
||||
import HBS2.Storage
|
||||
|
||||
import HBS2.Net.Auth.Credentials
|
||||
import HBS2.KeyMan.Keys.Direct
|
||||
|
||||
import HBS2.Peer.RPC.API.Storage
|
||||
import HBS2.Peer.RPC.Client
|
||||
import HBS2.Peer.RPC.Client.Unix
|
||||
|
||||
import Data.List qualified as L
|
||||
import Data.Maybe
|
||||
import Data.Text qualified as Text
|
||||
import Data.ByteString.Lazy.Char8 as LBS8
|
||||
import Data.ByteString.Lazy as LBS
|
||||
|
|
@ -30,34 +35,35 @@ import Lens.Micro.Platform
|
|||
{- HLINT ignore "Functor law" -}
|
||||
|
||||
|
||||
groupKeyEntries :: forall c m . (MonadUnliftIO m, IsContext c) => MakeDictM c m ()
|
||||
groupKeyEntries :: forall c m . ( MonadUnliftIO m
|
||||
, IsContext c
|
||||
, HasClientAPI StorageAPI UNIX m
|
||||
, HasStorage m
|
||||
) => MakeDictM c m ()
|
||||
groupKeyEntries = do
|
||||
|
||||
entry $ bindMatch "hbs2:groupkey:load" $ \case
|
||||
[StringLike s] -> do
|
||||
flip runContT pure do
|
||||
sto <- ContT withPeerStorage
|
||||
sto <- getStorage
|
||||
|
||||
gk <- runExceptT (readFromMerkle sto (SimpleKey (fromString s)))
|
||||
>>= orThrowUser "can't load group key"
|
||||
<&> deserialiseOrFail @(GroupKey 'Symm 'HBS2Basic)
|
||||
>>= orThrowUser "invalid group key"
|
||||
gk <- runExceptT (readFromMerkle sto (SimpleKey (fromString s)))
|
||||
>>= orThrowUser "can't load group key"
|
||||
<&> deserialiseOrFail @(GroupKey 'Symm 'HBS2Basic)
|
||||
>>= orThrowUser "invalid group key"
|
||||
|
||||
pure $ mkStr (show $ pretty $ AsGroupKeyFile gk)
|
||||
pure $ mkStr (show $ pretty $ AsGroupKeyFile gk)
|
||||
|
||||
_ -> throwIO $ BadFormException @C nil
|
||||
|
||||
entry $ bindMatch "hbs2:groupkey:store" $ \case
|
||||
[LitStrVal s] -> do
|
||||
flip runContT pure do
|
||||
let lbs = LBS8.pack (Text.unpack s)
|
||||
gk <- pure (Symm.parseGroupKey @'HBS2Basic $ AsGroupKeyFile lbs)
|
||||
`orDie` "invalid group key"
|
||||
|
||||
let lbs = LBS8.pack (Text.unpack s)
|
||||
gk <- pure (Symm.parseGroupKey @'HBS2Basic $ AsGroupKeyFile lbs)
|
||||
`orDie` "invalid group key"
|
||||
|
||||
sto <- ContT withPeerStorage
|
||||
ha <- writeAsMerkle sto (serialise gk)
|
||||
pure $ mkStr (show $ pretty ha)
|
||||
sto <- getStorage
|
||||
ha <- writeAsMerkle sto (serialise gk)
|
||||
pure $ mkStr (show $ pretty ha)
|
||||
|
||||
_ -> throwIO $ BadFormException @C nil
|
||||
|
||||
|
|
@ -69,17 +75,15 @@ groupKeyEntries = do
|
|||
entry $ bindMatch "hbs2:groupkey:update" $ \case
|
||||
[LitStrVal s, ListVal ins] -> do
|
||||
|
||||
flip runContT pure do
|
||||
sto <- getStorage
|
||||
|
||||
sto <- ContT withPeerStorage
|
||||
let lbs = LBS8.pack (Text.unpack s)
|
||||
gk <- pure (Symm.parseGroupKey @'HBS2Basic $ AsGroupKeyFile lbs)
|
||||
`orDie` "invalid group key"
|
||||
|
||||
let lbs = LBS8.pack (Text.unpack s)
|
||||
gk <- pure (Symm.parseGroupKey @'HBS2Basic $ AsGroupKeyFile lbs)
|
||||
`orDie` "invalid group key"
|
||||
gk1 <- modifyGroupKey gk ins
|
||||
|
||||
gk1 <- lift $ modifyGroupKey gk ins
|
||||
|
||||
pure $ mkStr (show $ pretty $ AsGroupKeyFile gk1)
|
||||
pure $ mkStr (show $ pretty $ AsGroupKeyFile gk1)
|
||||
|
||||
_ -> throwIO $ BadFormException @C nil
|
||||
|
||||
|
|
@ -118,16 +122,16 @@ groupKeyEntries = do
|
|||
|
||||
|
||||
entry $ bindMatch "hbs2:groupkey:decrypt-block" $ \case
|
||||
[BlobLike bs] -> flip runContT pure do
|
||||
[BlobLike bs] -> do
|
||||
|
||||
sto <- ContT withPeerStorage
|
||||
sto <- getStorage
|
||||
|
||||
let lbs = LBS.fromStrict bs
|
||||
|
||||
seb <- pure (deserialiseOrFail lbs)
|
||||
`orDie` "invalid SmallEncryptedBlock"
|
||||
|
||||
decrypted <- lift $ G.decryptBlock sto seb
|
||||
decrypted <- G.decryptBlock sto seb
|
||||
|
||||
pure $ mkForm @c "blob" [mkStr (BS8.unpack decrypted)]
|
||||
|
||||
|
|
@ -135,11 +139,10 @@ groupKeyEntries = do
|
|||
|
||||
entry $ bindMatch "hbs2:groupkey:encrypt-block" $ \case
|
||||
[StringLike gkh, BlobLike what] -> do
|
||||
flip runContT pure do
|
||||
sto <- ContT withPeerStorage
|
||||
gk <- lift $ loadGroupKey (fromString gkh)
|
||||
sto <- getStorage
|
||||
gk <- loadGroupKey (fromString gkh)
|
||||
`orDie` "can't load group key"
|
||||
seb <- lift $ G.encryptBlock sto gk what
|
||||
seb <- G.encryptBlock sto gk what
|
||||
pure $ mkForm "blob" [mkStr (LBS8.unpack (serialise seb))]
|
||||
|
||||
_ -> throwIO $ BadFormException @C nil
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
{-# Language TemplateHaskell #-}
|
||||
{-# Language UndecidableInstances #-}
|
||||
{-# Language AllowAmbiguousTypes #-}
|
||||
module HBS2.CLI.Run.Internal
|
||||
|
|
@ -12,16 +13,24 @@ import HBS2.Base58
|
|||
import HBS2.Data.Types.Refs
|
||||
import HBS2.Storage
|
||||
import HBS2.Peer.CLI.Detect
|
||||
import HBS2.Peer.RPC.Client
|
||||
import HBS2.Peer.RPC.Client.Unix
|
||||
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.API.RefChan
|
||||
import HBS2.Peer.RPC.Client.StorageClient
|
||||
|
||||
import Data.Config.Suckless.Script qualified as SC
|
||||
import Data.Config.Suckless.Script hiding (internalEntries)
|
||||
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Control.Monad.Trans.Cont
|
||||
import Data.ByteString.Char8 qualified as BS8
|
||||
import Data.Text qualified as Text
|
||||
import Lens.Micro.Platform
|
||||
|
||||
pattern HashLike:: forall {c} . HashRef -> Syntax c
|
||||
pattern HashLike x <- (
|
||||
|
|
@ -37,6 +46,121 @@ pattern SignPubKeyLike x <- (
|
|||
_ -> Nothing
|
||||
-> Just x )
|
||||
|
||||
|
||||
data HBS2CliEnv =
|
||||
HBS2CliEnv
|
||||
{ _peerSocket :: FilePath
|
||||
, _peerRefChanAPI :: ServiceCaller RefChanAPI UNIX
|
||||
, _peerRefLogAPI :: ServiceCaller RefLogAPI UNIX
|
||||
, _peerLwwRefAPI :: ServiceCaller LWWRefAPI UNIX
|
||||
, _peerPeerAPI :: ServiceCaller PeerAPI UNIX
|
||||
, _peerStorageAPI :: ServiceCaller StorageAPI UNIX
|
||||
}
|
||||
|
||||
makeLenses 'HBS2CliEnv
|
||||
|
||||
newtype HBS2Cli m a = HBS2Cli { fromHBS2Cli :: ReaderT (TVar (Maybe HBS2CliEnv)) m a }
|
||||
deriving newtype ( Applicative
|
||||
, Functor
|
||||
, Monad
|
||||
, MonadIO
|
||||
, MonadUnliftIO
|
||||
, MonadReader (TVar (Maybe HBS2CliEnv))
|
||||
)
|
||||
|
||||
withHBS2Cli :: TVar (Maybe HBS2CliEnv) -> HBS2Cli m a -> m a
|
||||
withHBS2Cli env action = runReaderT (fromHBS2Cli action) env
|
||||
|
||||
recover :: HBS2Cli IO a -> HBS2Cli IO a
|
||||
recover what = do
|
||||
catch what $ \case
|
||||
PeerNotConnectedException -> do
|
||||
|
||||
soname <- detectRPC
|
||||
`orDie` "can't locate hbs2-peer 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)
|
||||
refChanAPI <- makeServiceCaller @RefChanAPI (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 refChanAPI
|
||||
, Endpoint @UNIX lwwAPI
|
||||
, Endpoint @UNIX storageAPI
|
||||
]
|
||||
|
||||
void $ ContT $ withAsync $ liftIO $ runReaderT (runServiceClientMulti endpoints) client
|
||||
|
||||
let env = Just (HBS2CliEnv soname refChanAPI refLogAPI lwwAPI peerAPI storageAPI)
|
||||
tv <- newTVarIO env
|
||||
|
||||
liftIO $ withHBS2Cli tv what
|
||||
|
||||
|
||||
runHBS2Cli :: MonadUnliftIO m => HBS2Cli m a -> m a
|
||||
runHBS2Cli action = do
|
||||
noenv <- newTVarIO Nothing
|
||||
withHBS2Cli noenv action
|
||||
|
||||
data PeerException =
|
||||
PeerNotConnectedException
|
||||
deriving stock (Show, Typeable)
|
||||
|
||||
instance Exception PeerException
|
||||
|
||||
|
||||
instance (MonadUnliftIO m, HasClientAPI api proto m) => HasClientAPI api proto (RunM c m) where
|
||||
getClientAPI = lift (getClientAPI @api @proto)
|
||||
|
||||
instance (MonadUnliftIO m, HasStorage m) => HasStorage (RunM c m) where
|
||||
getStorage = lift getStorage
|
||||
|
||||
instance (MonadUnliftIO m, HasClientAPI StorageAPI UNIX m, HasStorage m) => HasStorage (ContT a (RunM c m)) where
|
||||
getStorage = lift getStorage
|
||||
|
||||
instance (MonadUnliftIO m, HasClientAPI api proto m) => HasClientAPI api proto (ContT a (RunM c m)) where
|
||||
getClientAPI = lift $ getClientAPI @api @proto
|
||||
|
||||
instance MonadUnliftIO m => HasClientAPI RefChanAPI UNIX (HBS2Cli m) where
|
||||
getClientAPI = do
|
||||
what <- ask >>= readTVarIO >>= orThrow PeerNotConnectedException
|
||||
pure $ view peerRefChanAPI what
|
||||
|
||||
instance MonadUnliftIO m => HasClientAPI RefLogAPI UNIX (HBS2Cli m) where
|
||||
getClientAPI = do
|
||||
what <- ask >>= readTVarIO >>= orThrow PeerNotConnectedException
|
||||
pure $ view peerRefLogAPI what
|
||||
|
||||
instance MonadUnliftIO m => HasClientAPI PeerAPI UNIX (HBS2Cli m) where
|
||||
getClientAPI = do
|
||||
what <- ask >>= readTVarIO >>= orThrow PeerNotConnectedException
|
||||
pure $ view peerPeerAPI what
|
||||
|
||||
instance MonadUnliftIO m => HasClientAPI StorageAPI UNIX (HBS2Cli m) where
|
||||
getClientAPI = do
|
||||
what <- ask >>= readTVarIO >>= orThrow PeerNotConnectedException
|
||||
pure $ view peerStorageAPI what
|
||||
|
||||
instance MonadUnliftIO m => HasClientAPI LWWRefAPI UNIX (HBS2Cli m) where
|
||||
getClientAPI = do
|
||||
what <- ask >>= readTVarIO >>= orThrow PeerNotConnectedException
|
||||
pure $ view peerLwwRefAPI what
|
||||
|
||||
instance MonadUnliftIO m => HasStorage (HBS2Cli m) where
|
||||
getStorage = getClientAPI @StorageAPI @UNIX <&> AnyStorage . StorageClient
|
||||
|
||||
internalEntries :: forall c m . (IsContext c, Exception (BadFormException c), MonadUnliftIO m) => MakeDictM c m ()
|
||||
internalEntries = do
|
||||
SC.internalEntries
|
||||
|
|
@ -87,18 +211,3 @@ internalEntries = do
|
|||
e -> throwIO (BadFormException @c nil)
|
||||
|
||||
|
||||
instance MonadUnliftIO m => HasStorage (RunM c m) where
|
||||
getStorage = do
|
||||
so <- detectRPC `orDie` "hbs2-peer not found"
|
||||
withRPC2 @StorageAPI @UNIX so $ \caller -> do
|
||||
pure $ AnyStorage (StorageClient caller)
|
||||
|
||||
withPeerStorage :: (IsContext c, MonadUnliftIO m) => (AnyStorage -> RunM c m a) -> RunM c m a
|
||||
withPeerStorage m = do
|
||||
so <- detectRPC `orDie` "hbs2-peer not found"
|
||||
|
||||
withRPC2 @StorageAPI @UNIX so $ \caller -> do
|
||||
let sto = AnyStorage (StorageClient caller)
|
||||
m sto
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -16,6 +16,10 @@ import HBS2.Storage.Operations.ByteString
|
|||
import HBS2.KeyMan.Keys.Direct
|
||||
import HBS2.Net.Auth.GroupKeySymm as Symm
|
||||
|
||||
import HBS2.Peer.RPC.Client.Unix
|
||||
import HBS2.Peer.RPC.Client
|
||||
import HBS2.Peer.RPC.API.Storage
|
||||
|
||||
import Data.HashMap.Strict qualified as HM
|
||||
import Data.HashSet qualified as HS
|
||||
import Data.Maybe
|
||||
|
|
@ -56,11 +60,15 @@ decryptBlock sto seb = do
|
|||
runExceptT (Symm.decryptBlock sto find seb)
|
||||
>>= orThrowUser "can't decrypt block"
|
||||
|
||||
loadGroupKey :: (IsContext c, MonadUnliftIO m) => HashRef -> RunM c m (Maybe (GroupKey 'Symm HBS2Basic))
|
||||
loadGroupKey :: ( IsContext c
|
||||
, MonadUnliftIO m
|
||||
, HasStorage m
|
||||
, HasClientAPI StorageAPI UNIX m
|
||||
) => HashRef -> RunM c m (Maybe (GroupKey 'Symm HBS2Basic))
|
||||
loadGroupKey h = do
|
||||
|
||||
flip runContT pure do
|
||||
sto <- ContT withPeerStorage
|
||||
sto <- getStorage
|
||||
|
||||
raw <- runExceptT (readFromMerkle sto (SimpleKey (fromHashRef h)))
|
||||
<&> either (const Nothing) Just
|
||||
|
|
|
|||
|
|
@ -12,6 +12,8 @@ import HBS2.Merkle
|
|||
import HBS2.Storage
|
||||
import HBS2.Storage.Operations.ByteString
|
||||
import HBS2.Peer.RPC.Client.Unix
|
||||
import HBS2.Peer.RPC.Client
|
||||
import HBS2.Peer.RPC.API.Storage
|
||||
import HBS2.KeyMan.Keys.Direct
|
||||
|
||||
import HBS2.Net.Auth.Schema()
|
||||
|
|
@ -24,12 +26,16 @@ import Control.Monad.Trans.Maybe
|
|||
import Control.Monad.Trans.Cont
|
||||
import Control.Monad.Except
|
||||
|
||||
getGroupKeyHash :: (IsContext c, MonadUnliftIO m)
|
||||
getGroupKeyHash :: ( IsContext c
|
||||
, MonadUnliftIO m
|
||||
, HasStorage m
|
||||
, HasClientAPI StorageAPI UNIX m
|
||||
)
|
||||
=> HashRef
|
||||
-> RunM c m (Maybe HashRef, MTreeAnn [HashRef])
|
||||
getGroupKeyHash h = do
|
||||
flip runContT pure do
|
||||
sto <- ContT withPeerStorage
|
||||
sto <- getStorage
|
||||
|
||||
headBlock <- getBlock sto (fromHashRef h)
|
||||
>>= orThrowUser "no-block"
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@ import HBS2.Data.Types.Refs
|
|||
import HBS2.Storage
|
||||
import HBS2.Peer.CLI.Detect
|
||||
import HBS2.Peer.RPC.Client.Unix
|
||||
import HBS2.Peer.RPC.Client
|
||||
import HBS2.Peer.RPC.API.Peer
|
||||
import HBS2.Peer.RPC.API.LWWRef
|
||||
|
||||
|
|
@ -23,7 +24,12 @@ import HBS2.KeyMan.App.Types
|
|||
import Control.Monad.Trans.Cont
|
||||
|
||||
|
||||
lwwRefEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m ()
|
||||
lwwRefEntries :: forall c m . ( IsContext c
|
||||
, MonadUnliftIO m
|
||||
, Exception (BadFormException c)
|
||||
, HasClientAPI PeerAPI UNIX m
|
||||
, HasClientAPI LWWRefAPI UNIX m
|
||||
) => MakeDictM c m ()
|
||||
lwwRefEntries = do
|
||||
|
||||
brief "creates a new lwwref"
|
||||
|
|
@ -32,12 +38,9 @@ lwwRefEntries = do
|
|||
$ entry $ bindMatch "hbs2:lwwref:create" $ \case
|
||||
[] -> do
|
||||
reflog <- keymanNewCredentials (Just "lwwref") 0
|
||||
|
||||
flip runContT pure do
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @PeerAPI @UNIX so
|
||||
void $ callService @RpcPollAdd api (reflog, "lwwref", 31)
|
||||
pure $ mkStr (show $ pretty (AsBase58 reflog))
|
||||
api <- getClientAPI @PeerAPI @UNIX
|
||||
void $ callService @RpcPollAdd api (reflog, "lwwref", 31)
|
||||
pure $ mkStr (show $ pretty (AsBase58 reflog))
|
||||
|
||||
_ -> throwIO (BadFormException @C nil)
|
||||
|
||||
|
|
@ -46,12 +49,10 @@ lwwRefEntries = do
|
|||
$ returns "list of string" "lwwref list"
|
||||
$ entry $ bindMatch "hbs2:lwwref:list" $ \case
|
||||
[] -> do
|
||||
flip runContT pure do
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @PeerAPI @UNIX so
|
||||
r <- callService @RpcPollList2 api (Just "lwwref", Nothing)
|
||||
>>= orThrowUser "can't get lwwref list"
|
||||
pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
|
||||
api <- getClientAPI @PeerAPI @UNIX
|
||||
r <- callService @RpcPollList2 api (Just "lwwref", Nothing)
|
||||
>>= orThrowUser "can't get lwwref list"
|
||||
pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
|
||||
|
||||
_ -> throwIO (BadFormException @C nil)
|
||||
|
||||
|
|
@ -62,12 +63,10 @@ lwwRefEntries = do
|
|||
$ returns "atom" "okay"
|
||||
$ entry $ bindMatch "hbs2:lwwref:fetch" $ \case
|
||||
[StringLike puk] -> do
|
||||
flip runContT pure do
|
||||
lww <- orThrowUser "bad lwwref key" (fromStringMay puk)
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @LWWRefAPI @UNIX so
|
||||
void $ callService @RpcLWWRefFetch api lww
|
||||
pure $ mkStr "okay"
|
||||
lww <- orThrowUser "bad lwwref key" (fromStringMay puk)
|
||||
api <- getClientAPI @LWWRefAPI @UNIX
|
||||
void $ callService @RpcLWWRefFetch api lww
|
||||
pure $ mkStr "okay"
|
||||
|
||||
_ -> throwIO (BadFormException @C nil)
|
||||
|
||||
|
|
@ -86,13 +85,11 @@ lwwRefEntries = do
|
|||
$ entry $ bindMatch "hbs2:lwwref:get" $ \case
|
||||
[StringLike puk] -> do
|
||||
|
||||
flip runContT pure do
|
||||
ref <- orThrowUser "bad lwwref key" (fromStringMay puk)
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @LWWRefAPI @UNIX so
|
||||
what <- callService @RpcLWWRefGet api ref
|
||||
>>= orThrowUser "can't get lwwref value"
|
||||
pure $ mkStr (show $ pretty what)
|
||||
ref <- orThrowUser "bad lwwref key" (fromStringMay puk)
|
||||
api <- getClientAPI @LWWRefAPI @UNIX
|
||||
what <- callService @RpcLWWRefGet api ref
|
||||
>>= orThrowUser "can't get lwwref value"
|
||||
pure $ mkStr (show $ pretty what)
|
||||
|
||||
_ -> throwIO (BadFormException @C nil)
|
||||
|
||||
|
|
@ -104,31 +101,29 @@ lwwRefEntries = do
|
|||
$ entry $ bindMatch "hbs2:lwwref:update" $ \case
|
||||
[StringLike puks, HashLike new] -> do
|
||||
|
||||
flip runContT pure do
|
||||
puk <- orThrowUser "bad lwwref key" (fromStringMay puks)
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @LWWRefAPI @UNIX so
|
||||
puk <- orThrowUser "bad lwwref key" (fromStringMay puks)
|
||||
api <- getClientAPI @LWWRefAPI @UNIX
|
||||
|
||||
(sk,pk) <- liftIO $ runKeymanClient do
|
||||
creds <- loadCredentials puk
|
||||
>>= orThrowUser "can't load credentials"
|
||||
pure ( view peerSignSk creds, view peerSignPk creds )
|
||||
(sk,pk) <- liftIO $ runKeymanClient do
|
||||
creds <- loadCredentials puk
|
||||
>>= orThrowUser "can't load credentials"
|
||||
pure ( view peerSignSk creds, view peerSignPk creds )
|
||||
|
||||
what <- callService @RpcLWWRefGet api puk
|
||||
>>= orThrowUser "can't get lwwref value"
|
||||
what <- callService @RpcLWWRefGet api puk
|
||||
>>= orThrowUser "can't get lwwref value"
|
||||
|
||||
sno' <- case what of
|
||||
Nothing -> pure 0
|
||||
Just lwwv -> pure (lwwSeq lwwv)
|
||||
sno' <- case what of
|
||||
Nothing -> pure 0
|
||||
Just lwwv -> pure (lwwSeq lwwv)
|
||||
|
||||
let sno = succ sno'
|
||||
let sno = succ sno'
|
||||
|
||||
let box = makeSignedBox pk sk (LWWRef sno new Nothing)
|
||||
let box = makeSignedBox pk sk (LWWRef sno new Nothing)
|
||||
|
||||
callService @RpcLWWRefUpdate api box
|
||||
>>= orThrowUser "lww ref update error"
|
||||
callService @RpcLWWRefUpdate api box
|
||||
>>= orThrowUser "lww ref update error"
|
||||
|
||||
pure nil
|
||||
pure nil
|
||||
|
||||
_ -> throwIO (BadFormException @C nil)
|
||||
|
||||
|
|
|
|||
|
|
@ -15,6 +15,10 @@ import HBS2.Storage.Operations.ByteString
|
|||
|
||||
import HBS2.Net.Auth.Schema()
|
||||
|
||||
import HBS2.Peer.RPC.API.Storage
|
||||
import HBS2.Peer.RPC.Client
|
||||
import HBS2.Peer.RPC.Client.Unix
|
||||
|
||||
import Codec.Serialise
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Control.Monad.Trans.Cont
|
||||
|
|
@ -50,7 +54,12 @@ metaFromSyntax syn =
|
|||
t x = Text.pack (show $ pretty x)
|
||||
|
||||
|
||||
metaDataEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m ()
|
||||
metaDataEntries :: forall c m . ( IsContext c
|
||||
, MonadUnliftIO m
|
||||
, Exception (BadFormException c)
|
||||
, HasStorage m
|
||||
, HasClientAPI StorageAPI UNIX m
|
||||
) => MakeDictM c m ()
|
||||
metaDataEntries = do
|
||||
|
||||
brief "update group key for tree"
|
||||
|
|
@ -84,20 +93,19 @@ metaDataEntries = do
|
|||
|
||||
gk1 <- modifyGroupKey gk ins
|
||||
|
||||
flip runContT pure do
|
||||
sto <- ContT withPeerStorage
|
||||
gk1h <- writeAsMerkle sto (serialise gk1)
|
||||
sto <- getStorage
|
||||
gk1h <- writeAsMerkle sto (serialise gk1)
|
||||
|
||||
case headBlk of
|
||||
w@(MTreeAnn { _mtaCrypt = EncryptGroupNaClSymm _ nonce }) -> do
|
||||
let w1 = w { _mtaCrypt = EncryptGroupNaClSymm gk1h nonce }
|
||||
case headBlk of
|
||||
w@(MTreeAnn { _mtaCrypt = EncryptGroupNaClSymm _ nonce }) -> do
|
||||
let w1 = w { _mtaCrypt = EncryptGroupNaClSymm gk1h nonce }
|
||||
|
||||
h <- putBlock sto (serialise w1)
|
||||
>>= orThrowUser "can't put block"
|
||||
h <- putBlock sto (serialise w1)
|
||||
>>= orThrowUser "can't put block"
|
||||
|
||||
pure $ mkStr (show $ pretty h)
|
||||
pure $ mkStr (show $ pretty h)
|
||||
|
||||
_ -> pure nil
|
||||
_ -> pure nil
|
||||
|
||||
_ -> throwIO (BadFormException @c nil)
|
||||
|
||||
|
|
@ -142,7 +150,7 @@ file-name: "qqq.txt"
|
|||
|
||||
r <- flip runContT pure do
|
||||
|
||||
sto <- ContT withPeerStorage
|
||||
sto <- getStorage
|
||||
|
||||
runMaybeT do
|
||||
|
||||
|
|
@ -179,7 +187,7 @@ file-name: "qqq.txt"
|
|||
|
||||
|
||||
let xs = parseTop r0
|
||||
& fromRight mempty
|
||||
& either mempty (fmap fixContext)
|
||||
|
||||
pure $ mkForm "dict" xs
|
||||
|
||||
|
|
@ -302,14 +310,12 @@ $ hbs2-cli hbs2:groupkey:list-public-keys [hbs2:groupkey:load GixS4wssCD4x7LzvHv
|
|||
when (isJust enc && isNothing gk) do
|
||||
error $ show $ "Can't load group key" <+> pretty enc
|
||||
|
||||
flip runContT pure do
|
||||
sto <- getStorage
|
||||
|
||||
sto <- ContT withPeerStorage
|
||||
href <- lift (createTreeWithMetadata sto gk (meta0 <> meta1) lbs)
|
||||
`orDie` "encryption error"
|
||||
|
||||
href <- lift (createTreeWithMetadata sto gk (meta0 <> meta1) lbs)
|
||||
`orDie` "encryption error"
|
||||
|
||||
pure $ mkStr (show $ pretty href)
|
||||
pure $ mkStr (show $ pretty href)
|
||||
|
||||
entry $ bindMatch "cbor:base58" $ \case
|
||||
[ LitStrVal x ] -> do
|
||||
|
|
|
|||
|
|
@ -7,10 +7,12 @@ import HBS2.Hash
|
|||
import HBS2.Base58
|
||||
import HBS2.Data.Types.Refs
|
||||
import HBS2.Storage
|
||||
import HBS2.Peer.RPC.Client
|
||||
import HBS2.Peer.CLI.Detect
|
||||
import HBS2.Peer.RPC.Client.Unix
|
||||
import HBS2.Peer.RPC.API.Peer
|
||||
import HBS2.Peer.RPC.API.RefLog
|
||||
import HBS2.Peer.RPC.API.Storage
|
||||
import HBS2.Peer.RPC.API.LWWRef
|
||||
import HBS2.Net.Auth.Schema()
|
||||
|
||||
|
|
@ -37,7 +39,13 @@ putTextLit sto s = do
|
|||
|
||||
pure (mkStr @c (show $ pretty h))
|
||||
|
||||
peerEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m ()
|
||||
peerEntries :: forall c m . ( IsContext c
|
||||
, MonadUnliftIO m
|
||||
, HasClientAPI PeerAPI UNIX m
|
||||
, HasClientAPI StorageAPI UNIX m
|
||||
, HasStorage m
|
||||
, Exception (BadFormException c)
|
||||
) => MakeDictM c m ()
|
||||
peerEntries = do
|
||||
|
||||
entry $ bindMatch "hbs2:peer:detect" $ \case
|
||||
|
|
@ -47,7 +55,7 @@ peerEntries = do
|
|||
[StringLike s] -> do
|
||||
flip runContT pure do
|
||||
|
||||
sto <- ContT withPeerStorage
|
||||
sto <- getStorage
|
||||
ha <- pure (fromStringMay @HashRef s)
|
||||
`orDie` "invalid hash"
|
||||
|
||||
|
|
@ -56,13 +64,14 @@ peerEntries = do
|
|||
|
||||
pure $ mkForm "blob" [mkStr (LBS8.unpack lbs)]
|
||||
|
||||
_ -> throwIO $ BadFormException @C nil
|
||||
_ -> throwIO $ BadFormException @c nil
|
||||
|
||||
entry $ bindMatch "hbs2:peer:has-block" $ \case
|
||||
[StringLike s] -> do
|
||||
flip runContT pure do
|
||||
|
||||
sto <- ContT withPeerStorage
|
||||
sto <- getStorage
|
||||
|
||||
ha <- pure (fromStringMay @HashRef s)
|
||||
`orDie` "invalid hash"
|
||||
|
||||
|
|
@ -70,21 +79,21 @@ peerEntries = do
|
|||
|
||||
pure $ maybe (mkSym "no-block") mkInt mbsz
|
||||
|
||||
_ -> throwIO $ BadFormException @C nil
|
||||
_ -> throwIO $ BadFormException @c nil
|
||||
|
||||
-- stores *small* block
|
||||
entry $ bindMatch "hbs2:peer:put-block" $ \case
|
||||
[ListVal [SymbolVal "blob", LitStrVal s]] -> do
|
||||
flip runContT pure do
|
||||
sto <- ContT withPeerStorage
|
||||
sto <- getStorage
|
||||
lift $ putTextLit sto s
|
||||
|
||||
[LitStrVal s] -> do
|
||||
flip runContT pure do
|
||||
sto <- ContT withPeerStorage
|
||||
sto <- getStorage
|
||||
lift $ putTextLit sto s
|
||||
|
||||
_ -> throwIO $ BadFormException @C nil
|
||||
_ -> throwIO $ BadFormException @c nil
|
||||
|
||||
brief "checks if peer available"
|
||||
$ noArgs
|
||||
|
|
@ -102,17 +111,11 @@ peerEntries = do
|
|||
|]
|
||||
$ entry $ bindMatch "hbs2:peer:poke" $ \case
|
||||
_ -> do
|
||||
so <- detectRPC `orDie` "hbs2-peer not found"
|
||||
r <- newTVarIO nil
|
||||
withRPC2 @PeerAPI @UNIX so $ \caller -> do
|
||||
|
||||
what <- callRpcWaitMay @RpcPoke (TimeoutSec 1) caller ()
|
||||
<&> fromMaybe ""
|
||||
<&> parseTop
|
||||
<&> either (const nil) (mkForm "dict")
|
||||
|
||||
atomically $ writeTVar r what
|
||||
|
||||
readTVarIO r
|
||||
api <- getClientAPI @PeerAPI @UNIX
|
||||
callRpcWaitMay @RpcPoke (TimeoutSec 1) api ()
|
||||
<&> fromMaybe ""
|
||||
<&> parseTop
|
||||
<&> either (const nil) (mkForm "dict" . fmap fixContext)
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -30,6 +30,9 @@ import HBS2.Base58
|
|||
import HBS2.Net.Auth.Credentials
|
||||
import HBS2.Net.Auth.Schema()
|
||||
import HBS2.Data.Types.SignedBox
|
||||
import HBS2.Peer.RPC.Client
|
||||
import HBS2.Peer.RPC.API.Storage
|
||||
import HBS2.Storage
|
||||
|
||||
import HBS2.KeyMan.Keys.Direct
|
||||
import HBS2.KeyMan.App.Types
|
||||
|
|
@ -42,7 +45,14 @@ import Control.Monad.Except
|
|||
|
||||
import Text.InterpolatedString.Perl6 (qc)
|
||||
|
||||
refchanEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m ()
|
||||
refchanEntries :: forall c m . ( IsContext c
|
||||
, MonadUnliftIO m
|
||||
, Exception (BadFormException c)
|
||||
, HasClientAPI RefChanAPI UNIX m
|
||||
, HasClientAPI StorageAPI UNIX m
|
||||
, HasClientAPI PeerAPI UNIX m
|
||||
, HasStorage m
|
||||
) => MakeDictM c m ()
|
||||
refchanEntries = do
|
||||
|
||||
brief "requests all rechans that peer is subcribed to"
|
||||
|
|
@ -98,8 +108,8 @@ HucjFUznHJeA2UYZCdUFHtnE3pTwhCW5Dp7LV3ArZBcr
|
|||
callCC $ \exit -> do
|
||||
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @RefChanAPI @UNIX so
|
||||
sto <- ContT $ withPeerStorage
|
||||
api <- getClientAPI @RefChanAPI @UNIX
|
||||
sto <- getStorage
|
||||
|
||||
w <- callService @RpcRefChanHeadGet api puk
|
||||
>>= orThrowUser "can't get refchan head"
|
||||
|
|
@ -124,6 +134,15 @@ HucjFUznHJeA2UYZCdUFHtnE3pTwhCW5Dp7LV3ArZBcr
|
|||
|
||||
_ -> throwIO (BadFormException @c nil)
|
||||
|
||||
entry $ bindMatch "hbs2:refchan:create" $ \case
|
||||
[StringLike headFile] -> do
|
||||
error "CREATES FUCKIN REFCHAN WITH HEAD BLOCK"
|
||||
|
||||
[] -> do
|
||||
error "CREATES FUCKIN DEFAULT REFCHAN"
|
||||
|
||||
_ -> throwIO (BadFormException @c nil)
|
||||
|
||||
brief "prints refchan head example"
|
||||
$ returns "nil" mempty
|
||||
$ entry $ bindMatch "hbs2:refchan:head:example" $ nil_ $ \case
|
||||
|
|
@ -131,10 +150,7 @@ HucjFUznHJeA2UYZCdUFHtnE3pTwhCW5Dp7LV3ArZBcr
|
|||
|
||||
let rch0 = refChanHeadDefault @L4Proto
|
||||
|
||||
so <- detectRPC
|
||||
>>= orThrowUser "hbs2-peer not found"
|
||||
|
||||
api <- ContT $ withRPC2 @PeerAPI @UNIX so
|
||||
api <- getClientAPI @PeerAPI @UNIX
|
||||
|
||||
pips <- callService @RpcPeers api ()
|
||||
<&> either (const mempty) (HM.fromList . fmap ((,1) . fst) . take 3)
|
||||
|
|
|
|||
|
|
@ -7,10 +7,12 @@ import HBS2.CLI.Run.Internal.KeyMan
|
|||
import HBS2.Data.Types.Refs
|
||||
import HBS2.Merkle
|
||||
import HBS2.Storage
|
||||
import HBS2.Peer.RPC.Client
|
||||
import HBS2.Peer.CLI.Detect
|
||||
import HBS2.Peer.RPC.Client.Unix
|
||||
import HBS2.Peer.RPC.API.Peer
|
||||
import HBS2.Peer.RPC.API.RefLog
|
||||
import HBS2.Peer.RPC.API.Storage
|
||||
|
||||
import HBS2.Peer.Proto hiding (request)
|
||||
import HBS2.Base58
|
||||
|
|
@ -48,18 +50,23 @@ mkRefLogUpdateFrom reflog mbs = do
|
|||
makeRefLogUpdate @L4Proto @'HBS2Basic (coerce puk) privk txraw
|
||||
|
||||
|
||||
reflogEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m ()
|
||||
reflogEntries :: forall c m . ( IsContext c
|
||||
, Exception (BadFormException c)
|
||||
, MonadUnliftIO m
|
||||
, HasStorage m
|
||||
, HasClientAPI PeerAPI UNIX m
|
||||
, HasClientAPI RefLogAPI UNIX m
|
||||
, HasClientAPI StorageAPI UNIX m
|
||||
) => MakeDictM c m ()
|
||||
reflogEntries = do
|
||||
|
||||
entry $ bindMatch "hbs2:reflog:create" $ \case
|
||||
[] -> do
|
||||
reflog <- keymanNewCredentials (Just "reflog") 0
|
||||
|
||||
flip runContT pure do
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @PeerAPI @UNIX so
|
||||
void $ callService @RpcPollAdd api (reflog, "reflog", 31)
|
||||
pure $ mkStr (show $ pretty (AsBase58 reflog))
|
||||
api <- getClientAPI @PeerAPI @UNIX
|
||||
void $ callService @RpcPollAdd api (reflog, "reflog", 31)
|
||||
pure $ mkStr (show $ pretty (AsBase58 reflog))
|
||||
|
||||
_ -> throwIO (BadFormException @C nil)
|
||||
|
||||
|
|
@ -67,11 +74,9 @@ reflogEntries = do
|
|||
[SignPubKeyLike reflog] -> do
|
||||
-- reflog <- keymanNewCredentials (Just "reflog") 0
|
||||
|
||||
flip runContT pure do
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @PeerAPI @UNIX so
|
||||
void $ callService @RpcPollAdd api (reflog, "reflog", 31)
|
||||
pure $ mkStr (show $ pretty (AsBase58 reflog))
|
||||
api <- getClientAPI @PeerAPI @UNIX
|
||||
void $ callService @RpcPollAdd api (reflog, "reflog", 31)
|
||||
pure $ mkStr (show $ pretty (AsBase58 reflog))
|
||||
|
||||
_ -> throwIO (BadFormException @C nil)
|
||||
|
||||
|
|
@ -79,38 +84,35 @@ reflogEntries = do
|
|||
|
||||
entry $ bindMatch "hbs2:reflog:tx:annhashref:create" $ \case
|
||||
[StringLike puk, StringLike hash] -> do
|
||||
flip runContT pure do
|
||||
reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
|
||||
sto <- ContT withPeerStorage
|
||||
hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash)
|
||||
void $ hasBlock sto (fromHashRef hashref) `orDie` "no block"
|
||||
let sref = AnnotatedHashRef Nothing hashref
|
||||
rlu <- lift $ mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise
|
||||
pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
|
||||
reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
|
||||
sto <- getStorage
|
||||
hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash)
|
||||
void $ hasBlock sto (fromHashRef hashref) `orDie` "no block"
|
||||
let sref = AnnotatedHashRef Nothing hashref
|
||||
rlu <- mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise
|
||||
pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
|
||||
|
||||
_ -> throwIO (BadFormException @C nil)
|
||||
|
||||
|
||||
entry $ bindMatch "hbs2:reflog:tx:post" $ nil_ \case
|
||||
[BlobLike blob] -> do
|
||||
so <- detectRPC `orDie` "no rpc found"
|
||||
withRPC2 @RefLogAPI so $ \caller -> do
|
||||
wtf <- deserialiseOrFail @(RefLogUpdate L4Proto) (LBS.fromStrict blob)
|
||||
& orThrowUser "invalid tx"
|
||||
void $ callService @RpcRefLogPost caller wtf
|
||||
caller <- getClientAPI @RefLogAPI @UNIX
|
||||
wtf <- deserialiseOrFail @(RefLogUpdate L4Proto) (LBS.fromStrict blob)
|
||||
& orThrowUser "invalid tx"
|
||||
void $ callService @RpcRefLogPost caller wtf
|
||||
|
||||
_ -> throwIO (BadFormException @C nil)
|
||||
|
||||
entry $ bindMatch "hbs2:reflog:tx:seqref:create" $ \case
|
||||
[StringLike puk, LitIntVal sn, StringLike hash] -> do
|
||||
flip runContT pure do
|
||||
reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
|
||||
sto <- ContT withPeerStorage
|
||||
hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash)
|
||||
void $ hasBlock sto (fromHashRef hashref) `orDie` "no block"
|
||||
let sref = SequentialRef sn (AnnotatedHashRef Nothing hashref)
|
||||
rlu <- lift $ mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise
|
||||
pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
|
||||
reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
|
||||
sto <- getStorage
|
||||
hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash)
|
||||
void $ hasBlock sto (fromHashRef hashref) `orDie` "no block"
|
||||
let sref = SequentialRef sn (AnnotatedHashRef Nothing hashref)
|
||||
rlu <- mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise
|
||||
pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
|
||||
|
||||
_ -> throwIO (BadFormException @C nil)
|
||||
|
||||
|
|
@ -138,8 +140,7 @@ reflogEntries = do
|
|||
|
||||
flip runContT pure do
|
||||
reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @RefLogAPI @UNIX so
|
||||
api <- getClientAPI @RefLogAPI @UNIX
|
||||
what <- callService @RpcRefLogGet api reflog
|
||||
>>= orThrowUser "can't get reflog"
|
||||
pure $ mkStr (show $ pretty what)
|
||||
|
|
@ -150,8 +151,7 @@ reflogEntries = do
|
|||
[StringLike puk] -> do
|
||||
flip runContT pure do
|
||||
reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @RefLogAPI @UNIX so
|
||||
api <- getClientAPI @RefLogAPI @UNIX
|
||||
void $ callService @RpcRefLogFetch api reflog
|
||||
pure $ mkStr "okay"
|
||||
|
||||
|
|
@ -160,8 +160,7 @@ reflogEntries = do
|
|||
entry $ bindMatch "hbs2:reflog:list" $ \case
|
||||
[] -> do
|
||||
flip runContT pure do
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @PeerAPI @UNIX so
|
||||
api <- getClientAPI @PeerAPI @UNIX
|
||||
r <- callService @RpcPollList2 api (Just "reflog", Nothing)
|
||||
>>= orThrowUser "can't get reflog list"
|
||||
pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
|
||||
|
|
@ -187,9 +186,8 @@ reflogEntries = do
|
|||
|
||||
callCC \exit -> do
|
||||
|
||||
so <- detectRPC `orDie` "rpc not found"
|
||||
api <- ContT $ withRPC2 @RefLogAPI @UNIX so
|
||||
sto <- ContT withPeerStorage
|
||||
api <- getClientAPI @RefLogAPI @UNIX
|
||||
sto <- getStorage
|
||||
|
||||
r <- callService @RpcRefLogGet api puk
|
||||
>>= orThrowUser "can't get reflog value"
|
||||
|
|
|
|||
|
|
@ -163,6 +163,7 @@ library
|
|||
HBS2.Peer.Proto.LWWRef.Internal
|
||||
HBS2.Peer.Proto.BrowserPlugin
|
||||
|
||||
HBS2.Peer.RPC.Client
|
||||
HBS2.Peer.RPC.Class
|
||||
HBS2.Peer.RPC.API.Peer
|
||||
HBS2.Peer.RPC.API.RefLog
|
||||
|
|
|
|||
|
|
@ -0,0 +1,12 @@
|
|||
module HBS2.Peer.RPC.Client where
|
||||
|
||||
import HBS2.Net.Proto.Service
|
||||
|
||||
import Data.Kind
|
||||
|
||||
class Monad m => HasClientAPI (api :: [Type]) proto m where
|
||||
getClientAPI :: m (ServiceCaller api proto)
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue