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

wip

This commit is contained in:
Dmitry Zuikov 2024-08-01 11:44:27 +03:00
parent c50b16610f
commit 0f4c45e752
5 changed files with 348 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,6 +4,7 @@ module Main where
import HBS2.CLI.Prelude import HBS2.CLI.Prelude
import HBS2.CLI.Run import HBS2.CLI.Run
import HBS2.CLI.Run.Help
import HBS2.CLI.Run.KeyMan import HBS2.CLI.Run.KeyMan
import HBS2.CLI.Run.Keyring import HBS2.CLI.Run.Keyring
import HBS2.CLI.Run.GroupKey import HBS2.CLI.Run.GroupKey
@ -25,6 +26,8 @@ import System.Environment
type RefLogId = PubKey 'Sign 'HBS2Basic type RefLogId = PubKey 'Sign 'HBS2Basic
{- HLINT ignore "Functor law" -}
setupLogger :: MonadIO m => m () setupLogger :: MonadIO m => m ()
setupLogger = do setupLogger = do
@ -46,22 +49,6 @@ silence = do
setLoggingOff @NOTICE setLoggingOff @NOTICE
helpList :: MonadUnliftIO m => Maybe String -> RunM c m ()
helpList p = do
let match = maybe (const True) (Text.isPrefixOf . Text.pack) p
d <- ask >>= readTVarIO <&> fromDict
let ks = [k | Id k <- List.sort (HM.keys d)
, match k
]
display_ $ vcat (fmap pretty ks)
main :: IO () main :: IO ()
main = do main = do
@ -82,22 +69,7 @@ main = do
reflogEntries reflogEntries
refchanEntries refchanEntries
lwwRefEntries lwwRefEntries
helpEntries
entry $ bindMatch "help" $ nil_ $ \syn -> do
display_ $ "hbs2-cli tool" <> line
case syn of
(StringLike p : _) -> do
helpList (Just p)
[ListVal (SymbolVal "builtin:lambda" : SymbolVal what : _ )] -> do
liftIO $ hPutDoc stdout $
"function" <+> ul (pretty what)
<> line
_ -> helpList Nothing
entry $ bindMatch "debug:cli:show" $ nil_ \case entry $ bindMatch "debug:cli:show" $ nil_ \case
_ -> display cli _ -> display cli

42
hbs2-cli/lib/HBS2/CLI/Run/Help.hs
View File

@ -1 +1,43 @@
module HBS2.CLI.Run.Help where module HBS2.CLI.Run.Help where
import HBS2.CLI.Prelude
import HBS2.CLI.Run.Internal
import Data.HashMap.Strict qualified as HM
import Data.List qualified as List
import Data.Text qualified as Text
{- HLINT ignore "Functor law" -}
helpList :: MonadUnliftIO m => Maybe String -> RunM c m ()
helpList p = do
let match = maybe (const True) (Text.isPrefixOf . Text.pack) p
d <- ask >>= readTVarIO
let ks = [k | Id k <- List.sort (HM.keys d)
, match k
]
display_ $ vcat (fmap pretty ks)
helpEntries :: (MonadUnliftIO m, IsContext c) => MakeDictM c m ()
helpEntries = do
entry $ bindMatch "help" $ nil_ $ \syn -> do
display_ $ "hbs2-cli tool" <> line
case syn of
(StringLike p : _) -> do
helpList (Just p)
[ListVal (SymbolVal "builtin:lambda" : SymbolVal what : _ )] -> do
man <- ask >>= readTVarIO
<&> HM.lookup what
<&> maybe mzero bindMan
liftIO $ hPutDoc stdout (pretty man)
_ -> helpList Nothing

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

@ -1,4 +1,5 @@
{-# Language UndecidableInstances #-} {-# Language UndecidableInstances #-}
{-# Language AllowAmbiguousTypes #-}
module HBS2.CLI.Run.Internal where module HBS2.CLI.Run.Internal where
import HBS2.CLI.Prelude import HBS2.CLI.Prelude
@ -13,11 +14,13 @@ import HBS2.Peer.RPC.API.Peer
import HBS2.Peer.RPC.API.Storage import HBS2.Peer.RPC.API.Storage
import HBS2.Peer.RPC.Client.StorageClient import HBS2.Peer.RPC.Client.StorageClient
import Control.Applicative
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import Data.List qualified as List import Data.List qualified as List
import Data.Kind import Data.Kind
import Data.Maybe import Data.Maybe
import Data.Either import Data.Either
import Data.Coerce
import Data.HashMap.Strict qualified as HM import Data.HashMap.Strict qualified as HM
import Data.Text qualified as Text import Data.Text qualified as Text
import Data.Text.IO qualified as TIO import Data.Text.IO qualified as TIO
@ -27,16 +30,138 @@ import Data.ByteString (ByteString)
import Control.Monad.Identity import Control.Monad.Identity
import Control.Monad.Writer import Control.Monad.Writer
import System.Environment import System.Environment
import Text.InterpolatedString.Perl6 (qc)
import Prettyprinter.Render.Terminal
import Streaming.Prelude qualified as S import Streaming.Prelude qualified as S
data ManApplyArg = ManApplyArg Text Text
deriving stock (Eq,Show,Data,Generic)
newtype ManApply = ManApply [ ManApplyArg ]
deriving stock (Eq,Show,Data,Generic)
deriving newtype (Semigroup,Monoid)
data ManSynopsis =
ManSynopsis ManApply
deriving stock (Eq,Show,Data,Generic)
data ManDesc = ManDescRaw Text
deriving stock (Eq,Show,Data,Generic)
data ManRetVal = ManRetVal
deriving stock (Eq,Show,Data,Generic)
newtype ManName a = ManName Id
deriving stock (Eq,Show,Data,Generic)
deriving newtype (IsString,Pretty)
newtype ManBrief = ManBrief Text
deriving stock (Eq,Show,Data,Generic)
deriving newtype (Pretty,IsString)
data ManReturns = ManReturns Text Text
deriving stock (Eq,Show,Data,Generic)
newtype ManExamples =
ManExamples Text
deriving stock (Eq,Show,Data,Generic)
deriving newtype (Pretty,IsString,Monoid,Semigroup)
class ManNameOf a ann where
manNameOf :: a -> ManName ann
data Man a =
Man
{ manName :: Maybe (ManName a)
, manBrief :: Maybe ManBrief
, manSynopsis :: [ManSynopsis]
, manDesc :: Maybe ManDesc
, manReturns :: Maybe ManReturns
, manExamples :: [ManExamples]
}
deriving stock (Eq,Show,Generic)
instance Monoid (Man a) where
mempty = Man Nothing Nothing mempty Nothing Nothing mempty
instance Semigroup (Man a) where
(<>) a b = Man (manName b <|> manName a)
(manBrief b <|> manBrief a)
(manSynopsis a <> manSynopsis b)
(manDesc b <|> manDesc a)
(manReturns b <|> manReturns a)
(manExamples a <> manExamples b)
instance ManNameOf Id a where
manNameOf = ManName
instance Pretty ManDesc where
pretty = \case
ManDescRaw t -> pretty t
instance Pretty (Man a) where
pretty e = "NAME"
<> line
<> indent 8 (pretty (manName e) <> fmtBrief e)
<> line
<> fmtSynopsis
<> fmtDescription
<> retval
<> fmtExamples
where
fmtBrief a = case manBrief a of
Nothing -> mempty
Just x -> " - " <> pretty x
retval = case manReturns e of
Nothing -> mempty
Just (ManReturns t s) ->
line <> "RETURN VALUE" <> line
<> indent 8 (
pretty t <> line
<> pretty s) <> line
fmtDescription = line
<> "DESCRIPTION" <> line
<> indent 8 ( case manDesc e of
Nothing -> pretty (manBrief e)
Just x -> pretty x)
<> line
fmtSynopsis = case manSynopsis e of
[] -> mempty
_ ->
line
<> "SYNOPSIS"
<> line
<> vcat (fmap synEntry (manSynopsis e))
<> line
fmtExamples = case manExamples e of
[] -> mempty
es -> line
<> "EXAMPLES"
<> line
<> indent 8 ( vcat (fmap pretty es) )
synEntry (ManSynopsis (ManApply [])) =
indent 8 ( parens (pretty (manName e)) ) <> line
synEntry (ManSynopsis (ManApply xs)) = do
indent 8 do
parens (pretty (manName e) <+>
hsep [ pretty n | ManApplyArg t n <- xs ] )
pattern StringLike :: forall {c} . String -> Syntax c pattern StringLike :: forall {c} . String -> Syntax c
pattern StringLike e <- (stringLike -> Just e) pattern StringLike e <- (stringLike -> Just e)
pattern StringLikeList :: forall {c} . [String] -> [Syntax c] pattern StringLikeList :: forall {c} . [String] -> [Syntax c]
pattern StringLikeList e <- (stringLikeList -> e) pattern StringLikeList e <- (stringLikeList -> e)
pattern BlobLike :: forall {c} . ByteString -> Syntax c pattern BlobLike :: forall {c} . ByteString -> Syntax c
pattern BlobLike s <- (blobLike -> Just s) pattern BlobLike s <- (blobLike -> Just s)
@ -206,9 +331,8 @@ data BindAction c ( m :: Type -> Type) =
| BindValue (Syntax c) | BindValue (Syntax c)
data Bind c ( m :: Type -> Type) = Bind data Bind c ( m :: Type -> Type) = Bind
{ bindAction :: BindAction c m { bindMan :: Maybe (Man AnsiStyle)
, bindName :: Id , bindAction :: BindAction c m
, bindDescShort :: Text
} deriving (Generic) } deriving (Generic)
deriving newtype instance Hashable Id deriving newtype instance Hashable Id
@ -248,8 +372,7 @@ instance Exception (BadFormException C)
instance Exception BadValueException instance Exception BadValueException
newtype Dict c m = Dict { fromDict :: HashMap Id (Bind c m) } type Dict c m = HashMap Id (Bind c m)
deriving newtype (Semigroup, Monoid)
newtype RunM c m a = RunM { fromRunM :: ReaderT (TVar (Dict c m)) m a } newtype RunM c m a = RunM { fromRunM :: ReaderT (TVar (Dict c m)) m a }
deriving newtype ( Applicative deriving newtype ( Applicative
@ -275,6 +398,44 @@ makeDict w = execWriter ( fromMakeDict w )
entry :: Dict c m -> MakeDictM c m () entry :: Dict c m -> MakeDictM c m ()
entry = tell entry = tell
brief :: ManBrief -> MakeDictM c m () -> MakeDictM c m ()
brief txt = censor (HM.map setBrief)
where
w0 = mempty { manBrief = Just txt }
setBrief (Bind w x) = Bind (Just (maybe w0 (<> w0) w)) x
returns :: Text -> Text -> MakeDictM c m () -> MakeDictM c m ()
returns tp txt = censor (HM.map setReturns)
where
w0 = mempty { manReturns = Just (ManReturns tp txt) }
setReturns (Bind w x) = Bind (Just (maybe w0 (<>w0) w)) x
addSynopsis :: ManSynopsis -> Bind c m -> Bind c m
addSynopsis synopsis (Bind w x) = Bind (Just updatedMan) x
where
updatedMan = case w of
Nothing -> mempty { manSynopsis = [synopsis] }
Just man -> man { manSynopsis = manSynopsis man <> [synopsis] }
noArgs :: MakeDictM c m () -> MakeDictM c m ()
noArgs = censor (HM.map (addSynopsis (ManSynopsis (ManApply []))))
arg :: Text -> Text -> ManApplyArg
arg = ManApplyArg
args :: [ManApplyArg] -> MakeDictM c m () -> MakeDictM c m ()
args argList = censor (HM.map (addSynopsis (ManSynopsis (ManApply argList))))
examples :: ManExamples -> MakeDictM c m () -> MakeDictM c m ()
examples (ManExamples s) = censor (HM.map setExamples )
where
ex = ManExamples (Text.unlines $ Text.strip <$> Text.lines (Text.strip s))
ex0 = mempty { manExamples = [ex] }
setExamples (Bind w x) = Bind (Just (maybe ex0 (<>ex0) w)) x
splitForms :: [String] -> [[String]] splitForms :: [String] -> [[String]]
splitForms s0 = runIdentity $ S.toList_ (go mempty s0) splitForms s0 = runIdentity $ S.toList_ (go mempty s0)
where where
@ -322,7 +483,7 @@ apply :: forall c m . ( IsContext c
-> RunM c m (Syntax c) -> RunM c m (Syntax c)
apply name args' = do apply name args' = do
-- notice $ red "APPLY" <+> pretty name -- notice $ red "APPLY" <+> pretty name
what <- ask >>= readTVarIO <&> HM.lookup name . fromDict what <- ask >>= readTVarIO <&> HM.lookup name
case bindAction <$> what of case bindAction <$> what of
Just (BindLambda e) -> mapM eval args' >>= e Just (BindLambda e) -> mapM eval args' >>= e
@ -347,13 +508,13 @@ bind name expr = do
what <- case expr of what <- case expr of
ListVal [SymbolVal "builtin:lambda", SymbolVal n] -> do ListVal [SymbolVal "builtin:lambda", SymbolVal n] -> do
Dict m <- readTVarIO t m <- readTVarIO t
HM.lookup n m & maybe (throwIO (NameNotBound n)) pure HM.lookup n m & maybe (throwIO (NameNotBound n)) pure
e -> pure $ Bind (BindValue e) "" "" e -> pure $ Bind mzero (BindValue e)
atomically do atomically do
modifyTVar t (Dict . HM.insert name what . fromDict) modifyTVar t (HM.insert name what)
eval :: forall c m . ( IsContext c eval :: forall c m . ( IsContext c
, MonadUnliftIO m , MonadUnliftIO m
@ -361,7 +522,7 @@ eval :: forall c m . ( IsContext c
) => Syntax c -> RunM c m (Syntax c) ) => Syntax c -> RunM c m (Syntax c)
eval syn = handle (handleForm syn) $ do eval syn = handle (handleForm syn) $ do
dict <- ask >>= readTVarIO <&> fromDict dict <- ask >>= readTVarIO
case syn of case syn of
@ -448,10 +609,12 @@ evalTop :: forall c m . ( IsContext c
evalTop syn = lastDef nil <$> mapM eval syn evalTop syn = lastDef nil <$> mapM eval syn
bindMatch :: Id -> ([Syntax c] -> RunM c m (Syntax c)) -> Dict c m bindMatch :: Id -> ([Syntax c] -> RunM c m (Syntax c)) -> Dict c m
bindMatch n fn = Dict (HM.singleton n (Bind (BindLambda fn) n "")) bindMatch n fn = HM.singleton n (Bind man (BindLambda fn))
where
man = Just $ mempty { manName = Just (manNameOf n) }
bindValue :: Id -> Syntax c -> Dict c m bindValue :: Id -> Syntax c -> Dict c m
bindValue n e = Dict (HM.singleton n (Bind (BindValue e) "" "")) bindValue n e = HM.singleton n (Bind mzero (BindValue e))
nil :: forall c . IsContext c => Syntax c nil :: forall c . IsContext c => Syntax c
nil = List noContext [] nil = List noContext []
@ -468,26 +631,47 @@ fixContext = go
Literal _ l -> Literal noContext l Literal _ l -> Literal noContext l
fmt :: Syntax c -> Doc ann
fmt = \case
LitStrVal x -> pretty $ Text.unpack x
x -> pretty x
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
entry $ bindValue "false" (Literal noContext (LitBool False)) entry $ bindValue "false" (Literal noContext (LitBool False))
entry $ bindValue "true" (Literal noContext (LitBool True)) entry $ bindValue "true" (Literal noContext (LitBool True))
entry $ bindMatch "concat" $ \syn -> do brief "concatenates list of string-like elements into a string"
$ args [arg "list" "(list ...)"]
$ args [arg "..." "..."]
$ returns "string" ""
$ examples [qc|
(concat a b c d)
abcd|]
$ examples [qc|
(concat 1 2 3 4 5)
12345|]
case syn of $ entry $ bindMatch "concat" $ \syn -> do
[ListVal (StringLikeList xs)] -> do
pure $ mkStr ( mconcat xs )
StringLikeList xs -> do case syn of
pure $ mkStr ( mconcat xs ) [ListVal xs] -> do
pure $ mkStr ( show $ hcat (fmap fmt xs) )
_ -> throwIO (BadFormException @C nil) xs -> do
pure $ mkStr ( show $ hcat (fmap fmt xs) )
entry $ bindMatch "list" $ \case brief "creates a list of elements"
es -> do $ args [arg "..." "..."]
pure $ mkList es $ returns "list" ""
$ examples [qc|
(list 1 2 3 fuu bar "baz")
(1 2 3 fuu bar "baz")
|]
$ entry $ bindMatch "list" $ \case
es -> do
pure $ mkList es
entry $ bindMatch "dict" $ \case entry $ bindMatch "dict" $ \case
(pairList -> es@(_:_)) -> do (pairList -> es@(_:_)) -> do
@ -554,22 +738,26 @@ internalEntries = do
_ -> throwIO (BadFormException @c nil) _ -> throwIO (BadFormException @c nil)
brief "returns current unix time"
entry $ bindMatch "now" $ \case $ returns "int" "current unix time in seconds"
[] -> mkInt . round <$> liftIO getPOSIXTime $ noArgs
_ -> throwIO (BadFormException @c nil) $ entry $ bindMatch "now" $ \case
[] -> mkInt . round <$> liftIO getPOSIXTime
_ -> throwIO (BadFormException @c nil)
entry $ bindMatch "display" $ nil_ \case entry $ bindMatch "display" $ nil_ \case
[ sy ] -> display sy [ sy ] -> display sy
ss -> display (mkList ss) ss -> display (mkList ss)
entry $ bindMatch "newline" $ nil_ $ \case brief "prints new line character to stdout"
[] -> liftIO (putStrLn "") $ entry $ bindMatch "newline" $ nil_ $ \case
_ -> throwIO (BadFormException @c nil) [] -> liftIO (putStrLn "")
_ -> throwIO (BadFormException @c nil)
entry $ bindMatch "print" $ nil_ $ \case brief "prints a list of terms to stdout"
[ sy ] -> display sy $ entry $ bindMatch "print" $ nil_ $ \case
ss -> mapM_ display ss [ sy ] -> display sy
ss -> mapM_ display ss
entry $ bindMatch "println" $ nil_ $ \case entry $ bindMatch "println" $ nil_ $ \case
[ sy ] -> display sy >> liftIO (putStrLn "") [ sy ] -> display sy >> liftIO (putStrLn "")
@ -584,10 +772,11 @@ internalEntries = do
[LitStrVal s] -> liftIO $ TIO.putStr s [LitStrVal s] -> liftIO $ TIO.putStr s
_ -> throwIO (BadFormException @c nil) _ -> throwIO (BadFormException @c nil)
entry $ bindMatch "str:read-file" $ \case brief "reads file as a string" do
[StringLike fn] -> liftIO (TIO.readFile fn) <&> mkStr entry $ bindMatch "str:read-file" $ \case
[StringLike fn] -> liftIO (TIO.readFile fn) <&> mkStr
_ -> throwIO (BadFormException @c nil) _ -> throwIO (BadFormException @c nil)
entry $ bindMatch "str:save" $ nil_ \case entry $ bindMatch "str:save" $ nil_ \case
[StringLike fn, StringLike what] -> [StringLike fn, StringLike what] ->
@ -615,22 +804,40 @@ internalEntries = do
[StringLike s] -> pure (mkSym s) [StringLike s] -> pure (mkSym s)
e -> pure (mkSym $ show $ pretty e) e -> pure (mkSym $ show $ pretty e)
entry $ bindMatch "eq?" $ \case brief "compares two terms" $
[a, b] -> do args [arg "term" "a", arg "term" "b"] $
pure $ if a == b then mkBool True else mkBool False returns "boolean" "#t if terms are equal, otherwise #f" $
_ -> throwIO (BadFormException @c nil) entry $ bindMatch "eq?" $ \case
[a, b] -> do
pure $ if a == b then mkBool True else mkBool False
_ -> throwIO (BadFormException @c nil)
entry $ bindMatch "not" $ \case entry $ bindMatch "not" $ \case
[v] -> do [w] -> do
w <- eval v
pure $ if isFalse w then mkBool True else mkBool False pure $ if isFalse w then mkBool True else mkBool False
_ -> throwIO (BadFormException @c nil) _ -> throwIO (BadFormException @c nil)
entry $ bindMatch "env" $ \case brief "get system environment"
[StringLike s] -> do $ args []
liftIO (lookupEnv s) $ args [ arg "string" "string" ]
<&> maybe nil mkStr $ returns "env" "single var or dict of all vars"
_ -> throwIO (BadFormException @c nil) $ examples [qc|
(env HOME)
/home/user
(env)
(dict
(HOME "/home/user") ... (CC "gcc") ...)
|]
$ entry $ bindMatch "env" $ \case
[] -> do
s <- liftIO getEnvironment
pure $ mkForm "dict" [ mkList [mkSym @c a, mkStr b] | (a,b) <- s ]
[StringLike s] -> do
liftIO (lookupEnv s)
<&> maybe nil mkStr
_ -> throwIO (BadFormException @c nil)
-- FIXME: we-need-opaque-type -- FIXME: we-need-opaque-type
entry $ bindMatch "blob:read-stdin" $ \case entry $ bindMatch "blob:read-stdin" $ \case

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

@ -21,6 +21,8 @@ import Data.Text qualified as Text
import Data.ByteString.Lazy.Char8 qualified as LBS8 import Data.ByteString.Lazy.Char8 qualified as LBS8
import Lens.Micro.Platform import Lens.Micro.Platform
import Text.InterpolatedString.Perl6 (qc)
{- HLINT ignore "Functor law" -} {- HLINT ignore "Functor law" -}
putTextLit :: forall c m . (IsContext c, MonadUnliftIO m) putTextLit :: forall c m . (IsContext c, MonadUnliftIO m)
@ -84,20 +86,33 @@ peerEntries = do
_ -> throwIO $ BadFormException @C nil _ -> throwIO $ BadFormException @C nil
entry $ bindMatch "hbs2:peer:poke" $ \case brief "checks if peer available"
_ -> do $ noArgs
so <- detectRPC `orDie` "hbs2-peer not found" $ returns "dict" "dictionary of peer attributes"
r <- newTVarIO nil $ examples [qc|
withRPC2 @PeerAPI @UNIX so $ \caller -> do (hbs2:peer:poke)
what <- callRpcWaitMay @RpcPoke (TimeoutSec 1) caller () (dict
<&> fromMaybe "" (peer-key: "35gKUG1mwBTr3tQpjWwR2kBYEnDmHxesoJL5Lj7tMjq3")
<&> parseTop (udp: "0.0.0.0:7354")
<&> either (const nil) (mkForm "dict") (tcp: "tcp://0.0.0.0:3001")
(local-multicast: "239.192.152.145:10153")
(rpc: "/tmp/hbs2-rpc.socket")
(http-port: 5000))
|]
$ entry $ bindMatch "hbs2:peer:poke" $ \case
_ -> do
so <- detectRPC `orDie` "hbs2-peer not found"
r <- newTVarIO nil
withRPC2 @PeerAPI @UNIX so $ \caller -> do
atomically $ writeTVar r what what <- callRpcWaitMay @RpcPoke (TimeoutSec 1) caller ()
<&> fromMaybe ""
readTVarIO r <&> parseTop
<&> either (const nil) (mkForm "dict")
atomically $ writeTVar r what
readTVarIO r

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

@ -22,18 +22,30 @@ import HBS2.KeyMan.App.Types
import Control.Monad.Trans.Cont import Control.Monad.Trans.Cont
import Text.InterpolatedString.Perl6 (qc)
refchanEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m () refchanEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m ()
refchanEntries = do refchanEntries = do
entry $ bindMatch "hbs2:refchan:list" $ \case
[] -> do
flip runContT pure do
so <- detectRPC `orDie` "rpc not found"
api <- ContT $ withRPC2 @PeerAPI @UNIX so
r <- callService @RpcPollList2 api (Just "refchan", Nothing)
>>= orThrowUser "can't get refchan list"
pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
_ -> throwIO (BadFormException @C nil) brief "requests all rechans that peer is subcribed to"
$ args []
$ returns "list" "list of all refchans"
$ examples [qc|
(hbs2:refchan:list)
("Atg67E6CPMJWKvR9BvwZTTEjg3Hjz4CYCaEARGANepGP"
"A5W6jPBjzvdpxaQ2e8xBLYaRZjPXzi4yX7xjC52gTiKk"
"EjjK7rpgRRJ4yzAhTcwis4XawwagCbmkns8n73ogY3uS")
|]
$ entry $ bindMatch "hbs2:refchan:list" $ \case
[] -> do
flip runContT pure do
so <- detectRPC `orDie` "rpc not found"
api <- ContT $ withRPC2 @PeerAPI @UNIX so
r <- callService @RpcPollList2 api (Just "refchan", Nothing)
>>= orThrowUser "can't get refchan list"
pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
_ -> throwIO (BadFormException @C nil)