voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip, refactored

This commit is contained in:
Dmitry Zuikov 2024-08-03 10:20:50 +03:00
parent ffab0a7ecc
commit 4f563a760a
13 changed files with 353 additions and 193 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
hbs2-cli/app/Main.hs
View File

@ -80,16 +80,18 @@ main = do
entry $ bindMatch "debug:cli:show" $ nil_ \case entry $ bindMatch "debug:cli:show" $ nil_ \case
_ -> display cli _ -> display cli
runHBS2Cli do
case cli of case cli of
[ListVal [SymbolVal "stdin"]] -> do [ListVal [SymbolVal "stdin"]] -> do
what <- getContents what <- liftIO getContents
>>= either (error.show) pure . parseTop >>= either (error.show) pure . parseTop
run dict what >>= eatNil display
[] -> do recover $ run dict what >>= eatNil display
void $ run dict [mkForm "help" []]
_ -> do [] -> do
run dict cli >>= eatNil display void $ run dict [mkForm "help" []]
_ -> do
recover $ run dict cli >>= eatNil display

3
hbs2-cli/lib/Data/Config/Suckless/Script/Internal.hs
View File

@ -379,7 +379,8 @@ newtype RunM c m a = RunM { fromRunM :: ReaderT (TVar (Dict c m)) m a }
, MonadReader (TVar (Dict c m)) , 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 } newtype MakeDictM c m a = MakeDictM { fromMakeDict :: Writer (Dict c m) a }
deriving newtype ( Applicative deriving newtype ( Applicative

69
hbs2-cli/lib/HBS2/CLI/Run/GroupKey.hs
View File

@ -7,15 +7,20 @@ import HBS2.System.Logger.Simple.ANSI as All
import HBS2.Storage.Operations.Class import HBS2.Storage.Operations.Class
import HBS2.Storage.Operations.ByteString import HBS2.Storage.Operations.ByteString
import HBS2.Base58 import HBS2.Base58
import Data.List qualified as L
import Data.Maybe
import HBS2.CLI.Run.Internal import HBS2.CLI.Run.Internal
import HBS2.CLI.Run.Internal.GroupKey as G import HBS2.CLI.Run.Internal.GroupKey as G
import HBS2.Net.Auth.GroupKeySymm as Symm import HBS2.Net.Auth.GroupKeySymm as Symm
import HBS2.Storage
import HBS2.Net.Auth.Credentials import HBS2.Net.Auth.Credentials
import HBS2.KeyMan.Keys.Direct 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.Text qualified as Text
import Data.ByteString.Lazy.Char8 as LBS8 import Data.ByteString.Lazy.Char8 as LBS8
import Data.ByteString.Lazy as LBS import Data.ByteString.Lazy as LBS
@ -30,34 +35,35 @@ import Lens.Micro.Platform
{- HLINT ignore "Functor law" -} {- 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 groupKeyEntries = do
entry $ bindMatch "hbs2:groupkey:load" $ \case entry $ bindMatch "hbs2:groupkey:load" $ \case
[StringLike s] -> do [StringLike s] -> do
flip runContT pure do sto <- getStorage
sto <- ContT withPeerStorage
gk <- runExceptT (readFromMerkle sto (SimpleKey (fromString s))) gk <- runExceptT (readFromMerkle sto (SimpleKey (fromString s)))
>>= orThrowUser "can't load group key" >>= orThrowUser "can't load group key"
<&> deserialiseOrFail @(GroupKey 'Symm 'HBS2Basic) <&> deserialiseOrFail @(GroupKey 'Symm 'HBS2Basic)
>>= orThrowUser "invalid group key" >>= orThrowUser "invalid group key"
pure $ mkStr (show $ pretty $ AsGroupKeyFile gk) pure $ mkStr (show $ pretty $ AsGroupKeyFile gk)
_ -> throwIO $ BadFormException @C nil _ -> throwIO $ BadFormException @C nil
entry $ bindMatch "hbs2:groupkey:store" $ \case entry $ bindMatch "hbs2:groupkey:store" $ \case
[LitStrVal s] -> do [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) sto <- getStorage
gk <- pure (Symm.parseGroupKey @'HBS2Basic $ AsGroupKeyFile lbs) ha <- writeAsMerkle sto (serialise gk)
`orDie` "invalid group key" pure $ mkStr (show $ pretty ha)
sto <- ContT withPeerStorage
ha <- writeAsMerkle sto (serialise gk)
pure $ mkStr (show $ pretty ha)
_ -> throwIO $ BadFormException @C nil _ -> throwIO $ BadFormException @C nil
@ -69,17 +75,15 @@ groupKeyEntries = do
entry $ bindMatch "hbs2:groupkey:update" $ \case entry $ bindMatch "hbs2:groupkey:update" $ \case
[LitStrVal s, ListVal ins] -> do [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) gk1 <- modifyGroupKey gk ins
gk <- pure (Symm.parseGroupKey @'HBS2Basic $ AsGroupKeyFile lbs)
`orDie` "invalid group key"
gk1 <- lift $ modifyGroupKey gk ins pure $ mkStr (show $ pretty $ AsGroupKeyFile gk1)
pure $ mkStr (show $ pretty $ AsGroupKeyFile gk1)
_ -> throwIO $ BadFormException @C nil _ -> throwIO $ BadFormException @C nil
@ -118,16 +122,16 @@ groupKeyEntries = do
entry $ bindMatch "hbs2:groupkey:decrypt-block" $ \case 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 let lbs = LBS.fromStrict bs
seb <- pure (deserialiseOrFail lbs) seb <- pure (deserialiseOrFail lbs)
`orDie` "invalid SmallEncryptedBlock" `orDie` "invalid SmallEncryptedBlock"
decrypted <- lift $ G.decryptBlock sto seb decrypted <- G.decryptBlock sto seb
pure $ mkForm @c "blob" [mkStr (BS8.unpack decrypted)] pure $ mkForm @c "blob" [mkStr (BS8.unpack decrypted)]
@ -135,11 +139,10 @@ groupKeyEntries = do
entry $ bindMatch "hbs2:groupkey:encrypt-block" $ \case entry $ bindMatch "hbs2:groupkey:encrypt-block" $ \case
[StringLike gkh, BlobLike what] -> do [StringLike gkh, BlobLike what] -> do
flip runContT pure do sto <- getStorage
sto <- ContT withPeerStorage gk <- loadGroupKey (fromString gkh)
gk <- lift $ loadGroupKey (fromString gkh)
`orDie` "can't load group key" `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))] pure $ mkForm "blob" [mkStr (LBS8.unpack (serialise seb))]
_ -> throwIO $ BadFormException @C nil _ -> throwIO $ BadFormException @C nil

139
hbs2-cli/lib/HBS2/CLI/Run/Internal.hs
View File

@ -1,3 +1,4 @@
{-# Language TemplateHaskell #-}
{-# Language UndecidableInstances #-} {-# Language UndecidableInstances #-}
{-# Language AllowAmbiguousTypes #-} {-# Language AllowAmbiguousTypes #-}
module HBS2.CLI.Run.Internal module HBS2.CLI.Run.Internal
@ -12,16 +13,24 @@ import HBS2.Base58
import HBS2.Data.Types.Refs import HBS2.Data.Types.Refs
import HBS2.Storage import HBS2.Storage
import HBS2.Peer.CLI.Detect import HBS2.Peer.CLI.Detect
import HBS2.Peer.RPC.Client
import HBS2.Peer.RPC.Client.Unix import HBS2.Peer.RPC.Client.Unix
import HBS2.Peer.RPC.API.Peer 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.Storage
import HBS2.Peer.RPC.API.RefChan
import HBS2.Peer.RPC.Client.StorageClient import HBS2.Peer.RPC.Client.StorageClient
import Data.Config.Suckless.Script qualified as SC import Data.Config.Suckless.Script qualified as SC
import Data.Config.Suckless.Script hiding (internalEntries) 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.ByteString.Char8 qualified as BS8
import Data.Text qualified as Text import Data.Text qualified as Text
import Lens.Micro.Platform
pattern HashLike:: forall {c} . HashRef -> Syntax c pattern HashLike:: forall {c} . HashRef -> Syntax c
pattern HashLike x <- ( pattern HashLike x <- (
@ -37,6 +46,121 @@ pattern SignPubKeyLike x <- (
_ -> Nothing _ -> Nothing
-> Just x ) -> 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 :: forall c m . (IsContext c, Exception (BadFormException c), MonadUnliftIO m) => MakeDictM c m ()
internalEntries = do internalEntries = do
SC.internalEntries SC.internalEntries
@ -87,18 +211,3 @@ internalEntries = do
e -> throwIO (BadFormException @c nil) 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

12
hbs2-cli/lib/HBS2/CLI/Run/Internal/GroupKey.hs
View File

@ -16,6 +16,10 @@ import HBS2.Storage.Operations.ByteString
import HBS2.KeyMan.Keys.Direct import HBS2.KeyMan.Keys.Direct
import HBS2.Net.Auth.GroupKeySymm as Symm 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.HashMap.Strict qualified as HM
import Data.HashSet qualified as HS import Data.HashSet qualified as HS
import Data.Maybe import Data.Maybe
@ -56,11 +60,15 @@ decryptBlock sto seb = do
runExceptT (Symm.decryptBlock sto find seb) runExceptT (Symm.decryptBlock sto find seb)
>>= orThrowUser "can't decrypt block" >>= 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 loadGroupKey h = do
flip runContT pure do flip runContT pure do
sto <- ContT withPeerStorage sto <- getStorage
raw <- runExceptT (readFromMerkle sto (SimpleKey (fromHashRef h))) raw <- runExceptT (readFromMerkle sto (SimpleKey (fromHashRef h)))
<&> either (const Nothing) Just <&> either (const Nothing) Just

10
hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs
View File

@ -12,6 +12,8 @@ import HBS2.Merkle
import HBS2.Storage import HBS2.Storage
import HBS2.Storage.Operations.ByteString import HBS2.Storage.Operations.ByteString
import HBS2.Peer.RPC.Client.Unix import HBS2.Peer.RPC.Client.Unix
import HBS2.Peer.RPC.Client
import HBS2.Peer.RPC.API.Storage
import HBS2.KeyMan.Keys.Direct import HBS2.KeyMan.Keys.Direct
import HBS2.Net.Auth.Schema() import HBS2.Net.Auth.Schema()
@ -24,12 +26,16 @@ import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Cont import Control.Monad.Trans.Cont
import Control.Monad.Except import Control.Monad.Except
getGroupKeyHash :: (IsContext c, MonadUnliftIO m) getGroupKeyHash :: ( IsContext c
, MonadUnliftIO m
, HasStorage m
, HasClientAPI StorageAPI UNIX m
)
=> HashRef => HashRef
-> RunM c m (Maybe HashRef, MTreeAnn [HashRef]) -> RunM c m (Maybe HashRef, MTreeAnn [HashRef])
getGroupKeyHash h = do getGroupKeyHash h = do
flip runContT pure do flip runContT pure do
sto <- ContT withPeerStorage sto <- getStorage
headBlock <- getBlock sto (fromHashRef h) headBlock <- getBlock sto (fromHashRef h)
>>= orThrowUser "no-block" >>= orThrowUser "no-block"

83
hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs
View File

@ -8,6 +8,7 @@ import HBS2.Data.Types.Refs
import HBS2.Storage import HBS2.Storage
import HBS2.Peer.CLI.Detect import HBS2.Peer.CLI.Detect
import HBS2.Peer.RPC.Client.Unix import HBS2.Peer.RPC.Client.Unix
import HBS2.Peer.RPC.Client
import HBS2.Peer.RPC.API.Peer import HBS2.Peer.RPC.API.Peer
import HBS2.Peer.RPC.API.LWWRef import HBS2.Peer.RPC.API.LWWRef
@ -23,7 +24,12 @@ import HBS2.KeyMan.App.Types
import Control.Monad.Trans.Cont 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 lwwRefEntries = do
brief "creates a new lwwref" brief "creates a new lwwref"
@ -32,12 +38,9 @@ lwwRefEntries = do
$ entry $ bindMatch "hbs2:lwwref:create" $ \case $ entry $ bindMatch "hbs2:lwwref:create" $ \case
[] -> do [] -> do
reflog <- keymanNewCredentials (Just "lwwref") 0 reflog <- keymanNewCredentials (Just "lwwref") 0
api <- getClientAPI @PeerAPI @UNIX
flip runContT pure do void $ callService @RpcPollAdd api (reflog, "lwwref", 31)
so <- detectRPC `orDie` "rpc not found" pure $ mkStr (show $ pretty (AsBase58 reflog))
api <- ContT $ withRPC2 @PeerAPI @UNIX so
void $ callService @RpcPollAdd api (reflog, "lwwref", 31)
pure $ mkStr (show $ pretty (AsBase58 reflog))
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
@ -46,12 +49,10 @@ lwwRefEntries = do
$ returns "list of string" "lwwref list" $ returns "list of string" "lwwref list"
$ entry $ bindMatch "hbs2:lwwref:list" $ \case $ entry $ bindMatch "hbs2:lwwref:list" $ \case
[] -> do [] -> do
flip runContT pure do api <- getClientAPI @PeerAPI @UNIX
so <- detectRPC `orDie` "rpc not found" r <- callService @RpcPollList2 api (Just "lwwref", Nothing)
api <- ContT $ withRPC2 @PeerAPI @UNIX so >>= orThrowUser "can't get lwwref list"
r <- callService @RpcPollList2 api (Just "lwwref", Nothing) pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
>>= orThrowUser "can't get lwwref list"
pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
@ -62,12 +63,10 @@ lwwRefEntries = do
$ returns "atom" "okay" $ returns "atom" "okay"
$ entry $ bindMatch "hbs2:lwwref:fetch" $ \case $ entry $ bindMatch "hbs2:lwwref:fetch" $ \case
[StringLike puk] -> do [StringLike puk] -> do
flip runContT pure do lww <- orThrowUser "bad lwwref key" (fromStringMay puk)
lww <- orThrowUser "bad lwwref key" (fromStringMay puk) api <- getClientAPI @LWWRefAPI @UNIX
so <- detectRPC `orDie` "rpc not found" void $ callService @RpcLWWRefFetch api lww
api <- ContT $ withRPC2 @LWWRefAPI @UNIX so pure $ mkStr "okay"
void $ callService @RpcLWWRefFetch api lww
pure $ mkStr "okay"
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
@ -86,13 +85,11 @@ lwwRefEntries = do
$ entry $ bindMatch "hbs2:lwwref:get" $ \case $ entry $ bindMatch "hbs2:lwwref:get" $ \case
[StringLike puk] -> do [StringLike puk] -> do
flip runContT pure do ref <- orThrowUser "bad lwwref key" (fromStringMay puk)
ref <- orThrowUser "bad lwwref key" (fromStringMay puk) api <- getClientAPI @LWWRefAPI @UNIX
so <- detectRPC `orDie` "rpc not found" what <- callService @RpcLWWRefGet api ref
api <- ContT $ withRPC2 @LWWRefAPI @UNIX so >>= orThrowUser "can't get lwwref value"
what <- callService @RpcLWWRefGet api ref pure $ mkStr (show $ pretty what)
>>= orThrowUser "can't get lwwref value"
pure $ mkStr (show $ pretty what)
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
@ -104,31 +101,29 @@ lwwRefEntries = do
$ entry $ bindMatch "hbs2:lwwref:update" $ \case $ entry $ bindMatch "hbs2:lwwref:update" $ \case
[StringLike puks, HashLike new] -> do [StringLike puks, HashLike new] -> do
flip runContT pure do puk <- orThrowUser "bad lwwref key" (fromStringMay puks)
puk <- orThrowUser "bad lwwref key" (fromStringMay puks) api <- getClientAPI @LWWRefAPI @UNIX
so <- detectRPC `orDie` "rpc not found"
api <- ContT $ withRPC2 @LWWRefAPI @UNIX so
(sk,pk) <- liftIO $ runKeymanClient do (sk,pk) <- liftIO $ runKeymanClient do
creds <- loadCredentials puk creds <- loadCredentials puk
>>= orThrowUser "can't load credentials" >>= orThrowUser "can't load credentials"
pure ( view peerSignSk creds, view peerSignPk creds ) pure ( view peerSignSk creds, view peerSignPk creds )
what <- callService @RpcLWWRefGet api puk what <- callService @RpcLWWRefGet api puk
>>= orThrowUser "can't get lwwref value" >>= orThrowUser "can't get lwwref value"
sno' <- case what of sno' <- case what of
Nothing -> pure 0 Nothing -> pure 0
Just lwwv -> pure (lwwSeq lwwv) 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 callService @RpcLWWRefUpdate api box
>>= orThrowUser "lww ref update error" >>= orThrowUser "lww ref update error"
pure nil pure nil
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)

44
hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs
View File

@ -15,6 +15,10 @@ import HBS2.Storage.Operations.ByteString
import HBS2.Net.Auth.Schema() 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 Codec.Serialise
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Cont import Control.Monad.Trans.Cont
@ -50,7 +54,12 @@ metaFromSyntax syn =
t x = Text.pack (show $ pretty x) 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 metaDataEntries = do
brief "update group key for tree" brief "update group key for tree"
@ -84,20 +93,19 @@ metaDataEntries = do
gk1 <- modifyGroupKey gk ins gk1 <- modifyGroupKey gk ins
flip runContT pure do sto <- getStorage
sto <- ContT withPeerStorage gk1h <- writeAsMerkle sto (serialise gk1)
gk1h <- writeAsMerkle sto (serialise gk1)
case headBlk of case headBlk of
w@(MTreeAnn { _mtaCrypt = EncryptGroupNaClSymm _ nonce }) -> do w@(MTreeAnn { _mtaCrypt = EncryptGroupNaClSymm _ nonce }) -> do
let w1 = w { _mtaCrypt = EncryptGroupNaClSymm gk1h nonce } let w1 = w { _mtaCrypt = EncryptGroupNaClSymm gk1h nonce }
h <- putBlock sto (serialise w1) h <- putBlock sto (serialise w1)
>>= orThrowUser "can't put block" >>= orThrowUser "can't put block"
pure $ mkStr (show $ pretty h) pure $ mkStr (show $ pretty h)
_ -> pure nil _ -> pure nil
_ -> throwIO (BadFormException @c nil) _ -> throwIO (BadFormException @c nil)
@ -142,7 +150,7 @@ file-name: "qqq.txt"
r <- flip runContT pure do r <- flip runContT pure do
sto <- ContT withPeerStorage sto <- getStorage
runMaybeT do runMaybeT do
@ -179,7 +187,7 @@ file-name: "qqq.txt"
let xs = parseTop r0 let xs = parseTop r0
& fromRight mempty & either mempty (fmap fixContext)
pure $ mkForm "dict" xs 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 when (isJust enc && isNothing gk) do
error $ show $ "Can't load group key" <+> pretty enc 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) pure $ mkStr (show $ pretty href)
`orDie` "encryption error"
pure $ mkStr (show $ pretty href)
entry $ bindMatch "cbor:base58" $ \case entry $ bindMatch "cbor:base58" $ \case
[ LitStrVal x ] -> do [ LitStrVal x ] -> do

43
hbs2-cli/lib/HBS2/CLI/Run/Peer.hs
View File

@ -7,10 +7,12 @@ import HBS2.Hash
import HBS2.Base58 import HBS2.Base58
import HBS2.Data.Types.Refs import HBS2.Data.Types.Refs
import HBS2.Storage import HBS2.Storage
import HBS2.Peer.RPC.Client
import HBS2.Peer.CLI.Detect import HBS2.Peer.CLI.Detect
import HBS2.Peer.RPC.Client.Unix import HBS2.Peer.RPC.Client.Unix
import HBS2.Peer.RPC.API.Peer import HBS2.Peer.RPC.API.Peer
import HBS2.Peer.RPC.API.RefLog import HBS2.Peer.RPC.API.RefLog
import HBS2.Peer.RPC.API.Storage
import HBS2.Peer.RPC.API.LWWRef import HBS2.Peer.RPC.API.LWWRef
import HBS2.Net.Auth.Schema() import HBS2.Net.Auth.Schema()
@ -37,7 +39,13 @@ putTextLit sto s = do
pure (mkStr @c (show $ pretty h)) 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 peerEntries = do
entry $ bindMatch "hbs2:peer:detect" $ \case entry $ bindMatch "hbs2:peer:detect" $ \case
@ -47,7 +55,7 @@ peerEntries = do
[StringLike s] -> do [StringLike s] -> do
flip runContT pure do flip runContT pure do
sto <- ContT withPeerStorage sto <- getStorage
ha <- pure (fromStringMay @HashRef s) ha <- pure (fromStringMay @HashRef s)
`orDie` "invalid hash" `orDie` "invalid hash"
@ -56,13 +64,14 @@ peerEntries = do
pure $ mkForm "blob" [mkStr (LBS8.unpack lbs)] pure $ mkForm "blob" [mkStr (LBS8.unpack lbs)]
_ -> throwIO $ BadFormException @C nil _ -> throwIO $ BadFormException @c nil
entry $ bindMatch "hbs2:peer:has-block" $ \case entry $ bindMatch "hbs2:peer:has-block" $ \case
[StringLike s] -> do [StringLike s] -> do
flip runContT pure do flip runContT pure do
sto <- ContT withPeerStorage sto <- getStorage
ha <- pure (fromStringMay @HashRef s) ha <- pure (fromStringMay @HashRef s)
`orDie` "invalid hash" `orDie` "invalid hash"
@ -70,21 +79,21 @@ peerEntries = do
pure $ maybe (mkSym "no-block") mkInt mbsz pure $ maybe (mkSym "no-block") mkInt mbsz
_ -> throwIO $ BadFormException @C nil _ -> throwIO $ BadFormException @c nil
-- stores *small* block -- stores *small* block
entry $ bindMatch "hbs2:peer:put-block" $ \case entry $ bindMatch "hbs2:peer:put-block" $ \case
[ListVal [SymbolVal "blob", LitStrVal s]] -> do [ListVal [SymbolVal "blob", LitStrVal s]] -> do
flip runContT pure do flip runContT pure do
sto <- ContT withPeerStorage sto <- getStorage
lift $ putTextLit sto s lift $ putTextLit sto s
[LitStrVal s] -> do [LitStrVal s] -> do
flip runContT pure do flip runContT pure do
sto <- ContT withPeerStorage sto <- getStorage
lift $ putTextLit sto s lift $ putTextLit sto s
_ -> throwIO $ BadFormException @C nil _ -> throwIO $ BadFormException @c nil
brief "checks if peer available" brief "checks if peer available"
$ noArgs $ noArgs
@ -102,17 +111,11 @@ peerEntries = do
|] |]
$ entry $ bindMatch "hbs2:peer:poke" $ \case $ entry $ bindMatch "hbs2:peer:poke" $ \case
_ -> do _ -> do
so <- detectRPC `orDie` "hbs2-peer not found" api <- getClientAPI @PeerAPI @UNIX
r <- newTVarIO nil callRpcWaitMay @RpcPoke (TimeoutSec 1) api ()
withRPC2 @PeerAPI @UNIX so $ \caller -> do <&> fromMaybe ""
<&> parseTop
what <- callRpcWaitMay @RpcPoke (TimeoutSec 1) caller () <&> either (const nil) (mkForm "dict" . fmap fixContext)
<&> fromMaybe ""
<&> parseTop
<&> either (const nil) (mkForm "dict")
atomically $ writeTVar r what
readTVarIO r

30
hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs
View File

@ -30,6 +30,9 @@ import HBS2.Base58
import HBS2.Net.Auth.Credentials import HBS2.Net.Auth.Credentials
import HBS2.Net.Auth.Schema() import HBS2.Net.Auth.Schema()
import HBS2.Data.Types.SignedBox 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.Keys.Direct
import HBS2.KeyMan.App.Types import HBS2.KeyMan.App.Types
@ -42,7 +45,14 @@ import Control.Monad.Except
import Text.InterpolatedString.Perl6 (qc) 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 refchanEntries = do
brief "requests all rechans that peer is subcribed to" brief "requests all rechans that peer is subcribed to"
@ -98,8 +108,8 @@ HucjFUznHJeA2UYZCdUFHtnE3pTwhCW5Dp7LV3ArZBcr
callCC $ \exit -> do callCC $ \exit -> do
so <- detectRPC `orDie` "rpc not found" so <- detectRPC `orDie` "rpc not found"
api <- ContT $ withRPC2 @RefChanAPI @UNIX so api <- getClientAPI @RefChanAPI @UNIX
sto <- ContT $ withPeerStorage sto <- getStorage
w <- callService @RpcRefChanHeadGet api puk w <- callService @RpcRefChanHeadGet api puk
>>= orThrowUser "can't get refchan head" >>= orThrowUser "can't get refchan head"
@ -124,6 +134,15 @@ HucjFUznHJeA2UYZCdUFHtnE3pTwhCW5Dp7LV3ArZBcr
_ -> throwIO (BadFormException @c nil) _ -> 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" brief "prints refchan head example"
$ returns "nil" mempty $ returns "nil" mempty
$ entry $ bindMatch "hbs2:refchan:head:example" $ nil_ $ \case $ entry $ bindMatch "hbs2:refchan:head:example" $ nil_ $ \case
@ -131,10 +150,7 @@ HucjFUznHJeA2UYZCdUFHtnE3pTwhCW5Dp7LV3ArZBcr
let rch0 = refChanHeadDefault @L4Proto let rch0 = refChanHeadDefault @L4Proto
so <- detectRPC api <- getClientAPI @PeerAPI @UNIX
>>= orThrowUser "hbs2-peer not found"
api <- ContT $ withRPC2 @PeerAPI @UNIX so
pips <- callService @RpcPeers api () pips <- callService @RpcPeers api ()
<&> either (const mempty) (HM.fromList . fmap ((,1) . fst) . take 3) <&> either (const mempty) (HM.fromList . fmap ((,1) . fst) . take 3)

80
hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs
View File

@ -7,10 +7,12 @@ import HBS2.CLI.Run.Internal.KeyMan
import HBS2.Data.Types.Refs import HBS2.Data.Types.Refs
import HBS2.Merkle import HBS2.Merkle
import HBS2.Storage import HBS2.Storage
import HBS2.Peer.RPC.Client
import HBS2.Peer.CLI.Detect import HBS2.Peer.CLI.Detect
import HBS2.Peer.RPC.Client.Unix import HBS2.Peer.RPC.Client.Unix
import HBS2.Peer.RPC.API.Peer import HBS2.Peer.RPC.API.Peer
import HBS2.Peer.RPC.API.RefLog import HBS2.Peer.RPC.API.RefLog
import HBS2.Peer.RPC.API.Storage
import HBS2.Peer.Proto hiding (request) import HBS2.Peer.Proto hiding (request)
import HBS2.Base58 import HBS2.Base58
@ -48,18 +50,23 @@ mkRefLogUpdateFrom reflog mbs = do
makeRefLogUpdate @L4Proto @'HBS2Basic (coerce puk) privk txraw 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 reflogEntries = do
entry $ bindMatch "hbs2:reflog:create" $ \case entry $ bindMatch "hbs2:reflog:create" $ \case
[] -> do [] -> do
reflog <- keymanNewCredentials (Just "reflog") 0 reflog <- keymanNewCredentials (Just "reflog") 0
flip runContT pure do api <- getClientAPI @PeerAPI @UNIX
so <- detectRPC `orDie` "rpc not found" void $ callService @RpcPollAdd api (reflog, "reflog", 31)
api <- ContT $ withRPC2 @PeerAPI @UNIX so pure $ mkStr (show $ pretty (AsBase58 reflog))
void $ callService @RpcPollAdd api (reflog, "reflog", 31)
pure $ mkStr (show $ pretty (AsBase58 reflog))
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
@ -67,11 +74,9 @@ reflogEntries = do
[SignPubKeyLike reflog] -> do [SignPubKeyLike reflog] -> do
-- reflog <- keymanNewCredentials (Just "reflog") 0 -- reflog <- keymanNewCredentials (Just "reflog") 0
flip runContT pure do api <- getClientAPI @PeerAPI @UNIX
so <- detectRPC `orDie` "rpc not found" void $ callService @RpcPollAdd api (reflog, "reflog", 31)
api <- ContT $ withRPC2 @PeerAPI @UNIX so pure $ mkStr (show $ pretty (AsBase58 reflog))
void $ callService @RpcPollAdd api (reflog, "reflog", 31)
pure $ mkStr (show $ pretty (AsBase58 reflog))
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
@ -79,38 +84,35 @@ reflogEntries = do
entry $ bindMatch "hbs2:reflog:tx:annhashref:create" $ \case entry $ bindMatch "hbs2:reflog:tx:annhashref:create" $ \case
[StringLike puk, StringLike hash] -> do [StringLike puk, StringLike hash] -> do
flip runContT pure do reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
reflog <- orThrowUser "bad reflog key" (fromStringMay puk) sto <- getStorage
sto <- ContT withPeerStorage hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash)
hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash) void $ hasBlock sto (fromHashRef hashref) `orDie` "no block"
void $ hasBlock sto (fromHashRef hashref) `orDie` "no block" let sref = AnnotatedHashRef Nothing hashref
let sref = AnnotatedHashRef Nothing hashref rlu <- mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise
rlu <- lift $ mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
entry $ bindMatch "hbs2:reflog:tx:post" $ nil_ \case entry $ bindMatch "hbs2:reflog:tx:post" $ nil_ \case
[BlobLike blob] -> do [BlobLike blob] -> do
so <- detectRPC `orDie` "no rpc found" caller <- getClientAPI @RefLogAPI @UNIX
withRPC2 @RefLogAPI so $ \caller -> do wtf <- deserialiseOrFail @(RefLogUpdate L4Proto) (LBS.fromStrict blob)
wtf <- deserialiseOrFail @(RefLogUpdate L4Proto) (LBS.fromStrict blob) & orThrowUser "invalid tx"
& orThrowUser "invalid tx" void $ callService @RpcRefLogPost caller wtf
void $ callService @RpcRefLogPost caller wtf
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
entry $ bindMatch "hbs2:reflog:tx:seqref:create" $ \case entry $ bindMatch "hbs2:reflog:tx:seqref:create" $ \case
[StringLike puk, LitIntVal sn, StringLike hash] -> do [StringLike puk, LitIntVal sn, StringLike hash] -> do
flip runContT pure do reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
reflog <- orThrowUser "bad reflog key" (fromStringMay puk) sto <- getStorage
sto <- ContT withPeerStorage hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash)
hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash) void $ hasBlock sto (fromHashRef hashref) `orDie` "no block"
void $ hasBlock sto (fromHashRef hashref) `orDie` "no block" let sref = SequentialRef sn (AnnotatedHashRef Nothing hashref)
let sref = SequentialRef sn (AnnotatedHashRef Nothing hashref) rlu <- mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise
rlu <- lift $ mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
@ -138,8 +140,7 @@ reflogEntries = do
flip runContT pure do flip runContT pure do
reflog <- orThrowUser "bad reflog key" (fromStringMay puk) reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
so <- detectRPC `orDie` "rpc not found" api <- getClientAPI @RefLogAPI @UNIX
api <- ContT $ withRPC2 @RefLogAPI @UNIX so
what <- callService @RpcRefLogGet api reflog what <- callService @RpcRefLogGet api reflog
>>= orThrowUser "can't get reflog" >>= orThrowUser "can't get reflog"
pure $ mkStr (show $ pretty what) pure $ mkStr (show $ pretty what)
@ -150,8 +151,7 @@ reflogEntries = do
[StringLike puk] -> do [StringLike puk] -> do
flip runContT pure do flip runContT pure do
reflog <- orThrowUser "bad reflog key" (fromStringMay puk) reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
so <- detectRPC `orDie` "rpc not found" api <- getClientAPI @RefLogAPI @UNIX
api <- ContT $ withRPC2 @RefLogAPI @UNIX so
void $ callService @RpcRefLogFetch api reflog void $ callService @RpcRefLogFetch api reflog
pure $ mkStr "okay" pure $ mkStr "okay"
@ -160,8 +160,7 @@ reflogEntries = do
entry $ bindMatch "hbs2:reflog:list" $ \case entry $ bindMatch "hbs2:reflog:list" $ \case
[] -> do [] -> do
flip runContT pure do flip runContT pure do
so <- detectRPC `orDie` "rpc not found" api <- getClientAPI @PeerAPI @UNIX
api <- ContT $ withRPC2 @PeerAPI @UNIX so
r <- callService @RpcPollList2 api (Just "reflog", Nothing) r <- callService @RpcPollList2 api (Just "reflog", Nothing)
>>= orThrowUser "can't get reflog list" >>= orThrowUser "can't get reflog list"
pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
@ -187,9 +186,8 @@ reflogEntries = do
callCC \exit -> do callCC \exit -> do
so <- detectRPC `orDie` "rpc not found" api <- getClientAPI @RefLogAPI @UNIX
api <- ContT $ withRPC2 @RefLogAPI @UNIX so sto <- getStorage
sto <- ContT withPeerStorage
r <- callService @RpcRefLogGet api puk r <- callService @RpcRefLogGet api puk
>>= orThrowUser "can't get reflog value" >>= orThrowUser "can't get reflog value"

1
hbs2-peer/hbs2-peer.cabal
View File

@ -163,6 +163,7 @@ library
HBS2.Peer.Proto.LWWRef.Internal HBS2.Peer.Proto.LWWRef.Internal
HBS2.Peer.Proto.BrowserPlugin HBS2.Peer.Proto.BrowserPlugin
HBS2.Peer.RPC.Client
HBS2.Peer.RPC.Class HBS2.Peer.RPC.Class
HBS2.Peer.RPC.API.Peer HBS2.Peer.RPC.API.Peer
HBS2.Peer.RPC.API.RefLog HBS2.Peer.RPC.API.RefLog

12
hbs2-peer/lib/HBS2/Peer/RPC/Client.hs Normal file
View File

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