mirror of https://github.com/voidlizard/hbs2
wip, fixme:refchan:init
This commit is contained in:
Dmitry Zuikov
parent
4e96b1f7f1
commit
457531688e
|
|
@ -107,6 +107,7 @@ library
|
||||||
|
|
||||||
other-modules:
|
other-modules:
|
||||||
Fixme.Run.Internal
|
Fixme.Run.Internal
|
||||||
|
Fixme.Run.Internal.RefChan
|
||||||
|
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Fixme
|
Fixme
|
||||||
|
|
|
||||||
|
|
@ -6,6 +6,7 @@ import Fixme.Types
|
||||||
import Fixme.Config
|
import Fixme.Config
|
||||||
import Fixme.State
|
import Fixme.State
|
||||||
import Fixme.Run.Internal
|
import Fixme.Run.Internal
|
||||||
|
import Fixme.Run.Internal.RefChan
|
||||||
import Fixme.Scan.Git.Local as Git
|
import Fixme.Scan.Git.Local as Git
|
||||||
import Fixme.Scan as Scan
|
import Fixme.Scan as Scan
|
||||||
import Fixme.GK as GK
|
import Fixme.GK as GK
|
||||||
|
|
@ -504,8 +505,10 @@ runTop forms = do
|
||||||
) $
|
) $
|
||||||
args [] $
|
args [] $
|
||||||
returns "string" "refchan-key" $ do
|
returns "string" "refchan-key" $ do
|
||||||
entry $ bindMatch "fixme:refchan:init" $ nil_ $ const $ lift do
|
entry $ bindMatch "fixme:refchan:init" $ nil_ $ \case
|
||||||
fixmeRefChanInit
|
[] -> lift $ fixmeRefChanInit Nothing
|
||||||
|
[SignPubKeyLike rc] -> lift $ fixmeRefChanInit (Just rc)
|
||||||
|
_ -> throwIO $ BadFormException @C nil
|
||||||
|
|
||||||
entry $ bindMatch "set-template" $ nil_ \case
|
entry $ bindMatch "set-template" $ nil_ \case
|
||||||
[SymbolVal who, SymbolVal w] -> do
|
[SymbolVal who, SymbolVal w] -> do
|
||||||
|
|
|
||||||
|
|
@ -67,10 +67,6 @@ pattern IsSimpleTemplate xs <- ListVal (SymbolVal "simple" : xs)
|
||||||
|
|
||||||
{- HLINT ignore "Functor law" -}
|
{- HLINT ignore "Functor law" -}
|
||||||
|
|
||||||
notEmpty :: [a] -> Maybe [a]
|
|
||||||
notEmpty = \case
|
|
||||||
[] -> Nothing
|
|
||||||
x -> Just x
|
|
||||||
|
|
||||||
defaultTemplate :: HashMap Id FixmeTemplate
|
defaultTemplate :: HashMap Id FixmeTemplate
|
||||||
defaultTemplate = HM.fromList [ ("default", Simple (SimpleTemplate short)) ]
|
defaultTemplate = HM.fromList [ ("default", Simple (SimpleTemplate short)) ]
|
||||||
|
|
@ -701,139 +697,6 @@ refchanImport = do
|
||||||
for_ atx insertScanned
|
for_ atx insertScanned
|
||||||
|
|
||||||
|
|
||||||
fixmeRefChanInit :: FixmePerks m => FixmeM m ()
|
|
||||||
fixmeRefChanInit = do
|
|
||||||
let rch0 = refChanHeadDefault @L4Proto
|
|
||||||
sto <- getStorage
|
|
||||||
peer <- getClientAPI @PeerAPI @UNIX
|
|
||||||
rchanApi <- getClientAPI @RefChanAPI @UNIX
|
|
||||||
|
|
||||||
dir <- localConfigDir
|
|
||||||
confFile <- localConfig
|
|
||||||
|
|
||||||
rchan <- asks fixmeEnvRefChan
|
|
||||||
>>= readTVarIO
|
|
||||||
|
|
||||||
flip runContT pure $ callCC \done -> do
|
|
||||||
|
|
||||||
when (isJust rchan) do
|
|
||||||
warn $ red "refchan is already set" <+> pretty (fmap AsBase58 rchan)
|
|
||||||
warn $ "done" <+> pretty (fmap AsBase58 rchan)
|
|
||||||
done ()
|
|
||||||
|
|
||||||
poked <- lift $ callRpcWaitMay @RpcPoke (TimeoutSec 1) peer ()
|
|
||||||
>>= orThrowUser "hbs2-peer not connected"
|
|
||||||
<&> parseTop
|
|
||||||
<&> fromRight mempty
|
|
||||||
|
|
||||||
pkey <- [ fromStringMay @(PubKey 'Sign 'HBS2Basic) x
|
|
||||||
| ListVal [SymbolVal "peer-key:", StringLike x ] <- poked
|
|
||||||
] & headMay . catMaybes & orThrowUser "hbs2-peer key not set"
|
|
||||||
|
|
||||||
|
|
||||||
notice $ green "default peer" <+> pretty (AsBase58 pkey)
|
|
||||||
|
|
||||||
|
|
||||||
signK' <- lift $ runKeymanClientRO $ listCredentials
|
|
||||||
<&> headMay
|
|
||||||
|
|
||||||
signK <- ContT $ maybe1 signK' (throwIO $ userError "no default author key found in hbs2-keyman")
|
|
||||||
|
|
||||||
notice $ green "default author" <+> pretty (AsBase58 signK)
|
|
||||||
|
|
||||||
-- TODO: use-hbs2-git-api?
|
|
||||||
(_, gkh', _) <- readProcess (shell [qc|git hbs2 key|])
|
|
||||||
<&> over _2 ( (fromStringMay @HashRef) <=< (notEmpty . headDef "" . lines . LBS8.unpack) )
|
|
||||||
<&> \x -> case view _1 x of
|
|
||||||
ExitFailure _ -> set _2 Nothing x
|
|
||||||
ExitSuccess -> x
|
|
||||||
|
|
||||||
notice $ green "group key" <+> maybe "none" pretty gkh'
|
|
||||||
|
|
||||||
readers <- fromMaybe mempty <$> runMaybeT do
|
|
||||||
gh <- toMPlus gkh'
|
|
||||||
gk <- loadGroupKeyMaybe @'HBS2Basic sto gh
|
|
||||||
>>= toMPlus
|
|
||||||
pure $ HM.keys (recipients gk)
|
|
||||||
|
|
||||||
notice $ green "readers" <+> pretty (length readers)
|
|
||||||
|
|
||||||
rk <- lift $ runKeymanClientRO $ loadKeyRingEntries readers
|
|
||||||
<&> fmap snd . headMay
|
|
||||||
|
|
||||||
|
|
||||||
let rch1 = rch0 & set refChanHeadReaders (HS.fromList readers)
|
|
||||||
& set refChanHeadAuthors (HS.singleton signK)
|
|
||||||
& set refChanHeadPeers (HM.singleton pkey 1)
|
|
||||||
|
|
||||||
|
|
||||||
let unlucky = HM.null (view refChanHeadPeers rch1)
|
|
||||||
|| HS.null (view refChanHeadAuthors rch1)
|
|
||||||
|
|
||||||
|
|
||||||
liftIO $ print $ pretty rch1
|
|
||||||
|
|
||||||
if unlucky then do
|
|
||||||
warn $ red $ "refchan definition is not complete;" <+>
|
|
||||||
"you may add missed keys, edit the" <+>
|
|
||||||
"defition and add if manually or repeat init attempt"
|
|
||||||
<> line
|
|
||||||
else do
|
|
||||||
notice "refchan definition seems okay, adding new refchan"
|
|
||||||
|
|
||||||
refchan <- lift $ keymanNewCredentials (Just "refchan") 0
|
|
||||||
|
|
||||||
creds <- lift $ runKeymanClientRO $ loadCredentials refchan
|
|
||||||
>>= orThrowUser "can't load credentials"
|
|
||||||
|
|
||||||
let box = makeSignedBox @'HBS2Basic (view peerSignPk creds) (view peerSignSk creds) rch1
|
|
||||||
|
|
||||||
href <- writeAsMerkle sto (serialise box)
|
|
||||||
|
|
||||||
callService @RpcPollAdd peer (refchan, "refchan", 17)
|
|
||||||
>>= orThrowUser "can't subscribe to refchan"
|
|
||||||
|
|
||||||
callService @RpcRefChanHeadPost rchanApi (HashRef href)
|
|
||||||
>>= orThrowUser "can't post refchan head"
|
|
||||||
|
|
||||||
|
|
||||||
let nonce = take 6 $ show $ pretty (AsBase58 refchan)
|
|
||||||
let rchanFile = "refchan-" <> nonce <> ".local"
|
|
||||||
let rchanFilePath = dir </> rchanFile
|
|
||||||
|
|
||||||
let note = ";; author and reader are inferred automatically" <> line
|
|
||||||
<> ";; from hbs2-keyman data" <> line
|
|
||||||
<> ";; edit them if needed" <> line
|
|
||||||
<> ";; reader is *your* reading public key." <> line
|
|
||||||
<> ";; author is *your* signing public key." <> line
|
|
||||||
|
|
||||||
let refChanClause = mkList @C [ mkSym "refchan"
|
|
||||||
, mkSym (show $ pretty (AsBase58 refchan))
|
|
||||||
]
|
|
||||||
|
|
||||||
let theirReaderKeyClause = maybe1 rk ";; reader ..."$ \(KeyringEntry pk _ _) -> do
|
|
||||||
pretty $ mkList @C [ mkSym "reader", mkSym (show $ pretty (AsBase58 pk) ) ]
|
|
||||||
|
|
||||||
let theirAuthorClause = mkList @C [ mkSym "author", mkSym (show $ pretty (AsBase58 signK) ) ]
|
|
||||||
|
|
||||||
let content = line
|
|
||||||
<> note
|
|
||||||
<> line
|
|
||||||
<> vcat [ theirReaderKeyClause
|
|
||||||
, pretty theirAuthorClause
|
|
||||||
]
|
|
||||||
|
|
||||||
liftIO do
|
|
||||||
writeFile rchanFilePath $
|
|
||||||
show content
|
|
||||||
|
|
||||||
appendFile confFile $ show $
|
|
||||||
line
|
|
||||||
<> vcat [ pretty refChanClause ]
|
|
||||||
<> line <>
|
|
||||||
pretty (mkList @C [ mkSym "source", mkSym ( "." </> rchanFile ) ])
|
|
||||||
|
|
||||||
notice $ green "refchan added" <+> pretty (AsBase58 refchan)
|
|
||||||
|
|
||||||
|
|
||||||
refchanExportGroupKeys :: FixmePerks m => FixmeM m ()
|
refchanExportGroupKeys :: FixmePerks m => FixmeM m ()
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,284 @@
|
||||||
|
{-# Language MultiWayIf #-}
|
||||||
|
module Fixme.Run.Internal.RefChan (fixmeRefChanInit) where
|
||||||
|
|
||||||
|
import Prelude hiding (init)
|
||||||
|
import Fixme.Prelude hiding (indent)
|
||||||
|
import Fixme.Types
|
||||||
|
import Fixme.Config
|
||||||
|
|
||||||
|
import HBS2.OrDie
|
||||||
|
import HBS2.Base58
|
||||||
|
import HBS2.Net.Auth.GroupKeySymm
|
||||||
|
import HBS2.Data.Types.SignedBox
|
||||||
|
import HBS2.Peer.Proto.RefChan as RefChan
|
||||||
|
import HBS2.Storage.Operations.ByteString
|
||||||
|
import HBS2.System.Dir
|
||||||
|
import HBS2.Net.Auth.Credentials
|
||||||
|
|
||||||
|
import HBS2.CLI.Run.KeyMan (keymanNewCredentials)
|
||||||
|
import HBS2.KeyMan.Keys.Direct
|
||||||
|
|
||||||
|
|
||||||
|
import Data.ByteString.Lazy.Char8 qualified as LBS8
|
||||||
|
import Data.Either
|
||||||
|
import Data.Maybe
|
||||||
|
import Data.List qualified as List
|
||||||
|
import Data.HashSet qualified as HS
|
||||||
|
import Data.HashMap.Strict qualified as HM
|
||||||
|
import Text.InterpolatedString.Perl6 (qc)
|
||||||
|
import Lens.Micro.Platform
|
||||||
|
import System.Process.Typed
|
||||||
|
import Control.Monad.Trans.Cont
|
||||||
|
import Control.Monad.Trans.Maybe
|
||||||
|
import Data.Word
|
||||||
|
import System.IO qualified as IO
|
||||||
|
|
||||||
|
{- HLINT ignore "Functor law"-}
|
||||||
|
|
||||||
|
notEmpty :: [a] -> Maybe [a]
|
||||||
|
notEmpty = \case
|
||||||
|
[] -> Nothing
|
||||||
|
x -> Just x
|
||||||
|
|
||||||
|
|
||||||
|
data RefChanInitFSM =
|
||||||
|
InitInit
|
||||||
|
| SetupNewRefChan
|
||||||
|
| SetupExitFailure
|
||||||
|
| CheckRefChan (PubKey 'Sign 'HBS2Basic)
|
||||||
|
| RefChanHeadFound (PubKey 'Sign 'HBS2Basic) (RefChanHeadBlock L4Proto)
|
||||||
|
| WaitRefChanHeadStart (PubKey 'Sign 'HBS2Basic) Word64
|
||||||
|
| WaitRefChanHead (PubKey 'Sign 'HBS2Basic) Word64
|
||||||
|
|
||||||
|
fixmeRefChanInit :: FixmePerks m => Maybe (PubKey 'Sign 'HBS2Basic) -> FixmeM m ()
|
||||||
|
fixmeRefChanInit mbRc = do
|
||||||
|
let rch0 = refChanHeadDefault @L4Proto
|
||||||
|
sto <- getStorage
|
||||||
|
peer <- getClientAPI @PeerAPI @UNIX
|
||||||
|
rchanApi <- getClientAPI @RefChanAPI @UNIX
|
||||||
|
|
||||||
|
dir <- localConfigDir
|
||||||
|
confFile <- localConfig
|
||||||
|
|
||||||
|
rchan <- asks fixmeEnvRefChan
|
||||||
|
>>= readTVarIO
|
||||||
|
|
||||||
|
poked <- callRpcWaitMay @RpcPoke (TimeoutSec 1) peer ()
|
||||||
|
>>= orThrowUser "hbs2-peer not connected"
|
||||||
|
<&> parseTop
|
||||||
|
<&> fromRight mempty
|
||||||
|
|
||||||
|
pkey <- [ fromStringMay @(PubKey 'Sign 'HBS2Basic) x
|
||||||
|
| ListVal [SymbolVal "peer-key:", StringLike x ] <- poked
|
||||||
|
] & headMay . catMaybes & orThrowUser "hbs2-peer key not set"
|
||||||
|
|
||||||
|
|
||||||
|
let refChanClause r = mkList @C [ mkSym "refchan"
|
||||||
|
, mkSym (show $ pretty (AsBase58 r))
|
||||||
|
]
|
||||||
|
|
||||||
|
flip runContT pure $ callCC \done -> do
|
||||||
|
|
||||||
|
flip fix InitInit $ \next -> \case
|
||||||
|
InitInit -> do
|
||||||
|
|
||||||
|
case (rchan, mbRc) of
|
||||||
|
(Nothing, Nothing) -> next SetupNewRefChan
|
||||||
|
(_, Just r2) -> next (CheckRefChan r2)
|
||||||
|
(Just r1, Nothing) -> next (CheckRefChan r1)
|
||||||
|
|
||||||
|
CheckRefChan rc -> do
|
||||||
|
notice $ "check refchan:" <+> pretty (AsBase58 rc)
|
||||||
|
|
||||||
|
notice $ "subscribe to refchan" <+> pretty (AsBase58 rc)
|
||||||
|
|
||||||
|
-- FIXME: poll-time-hardcode
|
||||||
|
-- $class: hardcode
|
||||||
|
void $ callService @RpcPollAdd peer (rc, "refchan", 17)
|
||||||
|
|
||||||
|
notice $ "fetch refchan head" <+> pretty (AsBase58 rc)
|
||||||
|
void $ lift $ callRpcWaitMay @RpcRefChanHeadFetch (TimeoutSec 1) rchanApi rc
|
||||||
|
|
||||||
|
now <- liftIO $ getPOSIXTime <&> round
|
||||||
|
pause @'Seconds 1
|
||||||
|
next $ WaitRefChanHead rc now
|
||||||
|
|
||||||
|
WaitRefChanHeadStart rc t -> do
|
||||||
|
notice $ "wait for refchan head" <+> pretty (AsBase58 rc)
|
||||||
|
next (WaitRefChanHead rc t)
|
||||||
|
|
||||||
|
WaitRefChanHead rc t -> do
|
||||||
|
now <- liftIO $ getPOSIXTime <&> round
|
||||||
|
let s = 60 - (now -t)
|
||||||
|
hd <- getRefChanHead @L4Proto sto (RefChanHeadKey rc)
|
||||||
|
|
||||||
|
liftIO $ IO.hPutStr stderr $ show $ "waiting" <+> pretty s <+> " \r"
|
||||||
|
|
||||||
|
if | now - t < 60 && isNothing hd -> do
|
||||||
|
pause @'Seconds 1
|
||||||
|
next $ WaitRefChanHead rc t
|
||||||
|
|
||||||
|
| now - t > 60 && isNothing hd -> do
|
||||||
|
err "refchan wait timeout"
|
||||||
|
next $ SetupExitFailure
|
||||||
|
|
||||||
|
| isJust hd -> do
|
||||||
|
next $ RefChanHeadFound rc (fromJust hd)
|
||||||
|
|
||||||
|
| otherwise -> next $ SetupExitFailure
|
||||||
|
|
||||||
|
RefChanHeadFound rc hd -> do
|
||||||
|
notice $ "found refchan head for" <+> pretty (AsBase58 rc)
|
||||||
|
void $ lift $ callRpcWaitMay @RpcRefChanFetch (TimeoutSec 1) rchanApi rc
|
||||||
|
|
||||||
|
author <- lift $ asks fixmeEnvAuthor >>= readTVarIO
|
||||||
|
|
||||||
|
let readers = view refChanHeadReaders hd
|
||||||
|
let authors = view refChanHeadAuthors hd
|
||||||
|
|
||||||
|
-- hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs
|
||||||
|
rs <- liftIO (runKeymanClientRO $ loadKeyRingEntries (HS.toList readers))
|
||||||
|
|
||||||
|
let isReader = case rs of
|
||||||
|
[] -> False
|
||||||
|
_ -> True
|
||||||
|
|
||||||
|
let canRead = if isReader then
|
||||||
|
green "yes"
|
||||||
|
else
|
||||||
|
red "no"
|
||||||
|
|
||||||
|
notice $ "reader:" <+> canRead
|
||||||
|
|
||||||
|
let isAuthor = maybe1 author False (`HS.member` authors)
|
||||||
|
|
||||||
|
let canWrite = if isAuthor
|
||||||
|
then green "yes"
|
||||||
|
else red "no"
|
||||||
|
|
||||||
|
notice $ "author:" <+> canWrite
|
||||||
|
|
||||||
|
unless isReader do
|
||||||
|
warn $ yellow "no reader key found" <> line
|
||||||
|
<> "it's may be ok, if this refchan is not encrypted" <> line
|
||||||
|
<> "otherwise, make your encryption key a member of this refchan head"
|
||||||
|
<> line
|
||||||
|
|
||||||
|
unless isAuthor do
|
||||||
|
warn $ red "no author key found" <> line
|
||||||
|
<> "it's may be ok if you have only read-only access to this refchan" <> line
|
||||||
|
<> "otherwise, use" <+> yellow "author KEY" <+> "settings in the .fixme-new/config" <> line
|
||||||
|
<> "and make sure it is added to the refchan head"
|
||||||
|
<> line
|
||||||
|
|
||||||
|
unless (isJust rchan) do
|
||||||
|
notice $ "adding refchan to" <+> pretty confFile
|
||||||
|
liftIO do
|
||||||
|
appendFile confFile $ show $
|
||||||
|
line
|
||||||
|
<> vcat [ pretty (refChanClause rc) ]
|
||||||
|
|
||||||
|
SetupExitFailure -> do
|
||||||
|
err "refchan init failed"
|
||||||
|
|
||||||
|
SetupNewRefChan -> do
|
||||||
|
|
||||||
|
notice $ green "default peer" <+> pretty (AsBase58 pkey)
|
||||||
|
|
||||||
|
signK' <- lift $ runKeymanClientRO $ listCredentials
|
||||||
|
<&> headMay
|
||||||
|
|
||||||
|
signK <- ContT $ maybe1 signK' (throwIO $ userError "no default author key found in hbs2-keyman")
|
||||||
|
|
||||||
|
notice $ green "default author" <+> pretty (AsBase58 signK)
|
||||||
|
|
||||||
|
-- TODO: use-hbs2-git-api?
|
||||||
|
(_, gkh', _) <- readProcess (shell [qc|git hbs2 key|])
|
||||||
|
<&> over _2 ( (fromStringMay @HashRef) <=< (notEmpty . headDef "" . lines . LBS8.unpack) )
|
||||||
|
<&> \x -> case view _1 x of
|
||||||
|
ExitFailure _ -> set _2 Nothing x
|
||||||
|
ExitSuccess -> x
|
||||||
|
|
||||||
|
notice $ green "group key" <+> maybe "none" pretty gkh'
|
||||||
|
|
||||||
|
readers <- fromMaybe mempty <$> runMaybeT do
|
||||||
|
gh <- toMPlus gkh'
|
||||||
|
gk <- loadGroupKeyMaybe @'HBS2Basic sto gh
|
||||||
|
>>= toMPlus
|
||||||
|
pure $ HM.keys (recipients gk)
|
||||||
|
|
||||||
|
notice $ green "readers" <+> pretty (length readers)
|
||||||
|
|
||||||
|
rk <- lift $ runKeymanClientRO $ loadKeyRingEntries readers
|
||||||
|
<&> fmap snd . headMay
|
||||||
|
|
||||||
|
|
||||||
|
let rch1 = rch0 & set refChanHeadReaders (HS.fromList readers)
|
||||||
|
& set refChanHeadAuthors (HS.singleton signK)
|
||||||
|
& set refChanHeadPeers (HM.singleton pkey 1)
|
||||||
|
|
||||||
|
|
||||||
|
let unlucky = HM.null (view refChanHeadPeers rch1)
|
||||||
|
|| HS.null (view refChanHeadAuthors rch1)
|
||||||
|
|
||||||
|
liftIO $ print $ pretty rch1
|
||||||
|
|
||||||
|
if unlucky then do
|
||||||
|
warn $ red $ "refchan definition is not complete;" <+>
|
||||||
|
"you may add missed keys, edit the" <+>
|
||||||
|
"defition and add if manually or repeat init attempt"
|
||||||
|
<> line
|
||||||
|
else do
|
||||||
|
notice "refchan definition seems okay, adding new refchan"
|
||||||
|
|
||||||
|
refchan <- lift $ keymanNewCredentials (Just "refchan") 0
|
||||||
|
|
||||||
|
creds <- lift $ runKeymanClientRO $ loadCredentials refchan
|
||||||
|
>>= orThrowUser "can't load credentials"
|
||||||
|
|
||||||
|
let box = makeSignedBox @'HBS2Basic (view peerSignPk creds) (view peerSignSk creds) rch1
|
||||||
|
|
||||||
|
href <- writeAsMerkle sto (serialise box)
|
||||||
|
|
||||||
|
callService @RpcPollAdd peer (refchan, "refchan", 17)
|
||||||
|
>>= orThrowUser "can't subscribe to refchan"
|
||||||
|
|
||||||
|
callService @RpcRefChanHeadPost rchanApi (HashRef href)
|
||||||
|
>>= orThrowUser "can't post refchan head"
|
||||||
|
|
||||||
|
|
||||||
|
let nonce = take 6 $ show $ pretty (AsBase58 refchan)
|
||||||
|
let rchanFile = "refchan-" <> nonce <> ".local"
|
||||||
|
let rchanFilePath = dir </> rchanFile
|
||||||
|
|
||||||
|
let note = ";; author and reader are inferred automatically" <> line
|
||||||
|
<> ";; from hbs2-keyman data" <> line
|
||||||
|
<> ";; edit them if needed" <> line
|
||||||
|
<> ";; reader is *your* reading public key." <> line
|
||||||
|
<> ";; author is *your* signing public key." <> line
|
||||||
|
|
||||||
|
let theirReaderKeyClause = maybe1 rk ";; reader ..."$ \(KeyringEntry pk _ _) -> do
|
||||||
|
pretty $ mkList @C [ mkSym "reader", mkSym (show $ pretty (AsBase58 pk) ) ]
|
||||||
|
|
||||||
|
let theirAuthorClause = mkList @C [ mkSym "author", mkSym (show $ pretty (AsBase58 signK) ) ]
|
||||||
|
|
||||||
|
let content = line
|
||||||
|
<> note
|
||||||
|
<> line
|
||||||
|
<> vcat [ theirReaderKeyClause
|
||||||
|
, pretty theirAuthorClause
|
||||||
|
]
|
||||||
|
|
||||||
|
liftIO do
|
||||||
|
writeFile rchanFilePath $
|
||||||
|
show content
|
||||||
|
|
||||||
|
notice $ "adding refchan to" <+> pretty confFile
|
||||||
|
liftIO do
|
||||||
|
appendFile confFile $ show $
|
||||||
|
line
|
||||||
|
<> vcat [ pretty (refChanClause refchan) ]
|
||||||
|
|
||||||
|
next $ CheckRefChan refchan
|
||||||
|
|
||||||
|
|
||||||
Loading…
Reference in New Issue