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

wip, refchan creation simplification

This commit is contained in:
Dmitry Zuikov 2024-08-03 11:27:47 +03:00
parent 84c41c4e81
commit 0934dda57e
1 changed files with 47 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -132,15 +132,56 @@ HucjFUznHJeA2UYZCdUFHtnE3pTwhCW5Dp7LV3ArZBcr
_ -> throwIO (BadFormException @c nil) _ -> throwIO (BadFormException @c nil)
entry $ bindMatch "hbs2:refchan:create" $ \case entry $ bindMatch "hbs2:refchan:create" $ \syn -> do
peerApi <- getClientAPI @PeerAPI @UNIX
rchanApi <- getClientAPI @RefChanAPI @UNIX
sto <- getStorage
rch <- case syn of
[StringLike headFile] -> do [StringLike headFile] -> do
error "CREATES FUCKIN REFCHAN WITH HEAD BLOCK" liftIO (readFile headFile)
<&> fromStringMay @(RefChanHeadBlock L4Proto)
>>= orThrowUser "can't parse RefChanHeadBlock"
[] -> do [] -> do
error "CREATES FUCKIN DEFAULT REFCHAN" poked <- callService @RpcPoke peerApi ()
>>= orThrowUser "can't poke hbs2-peer"
<&> parseTop
>>= orThrowUser "invalid hbs2-peer attributes"
ke <- [ x
| ListVal [SymbolVal "peer-key:", SignPubKeyLike x] <- poked
] & headMay & orThrowUser "hbs2-peer key not found"
let rch0 = refChanHeadDefault @L4Proto
& set refChanHeadPeers (HM.singleton ke 1)
& set refChanHeadAuthors (HS.singleton ke)
pure rch0
_ -> throwIO (BadFormException @c nil) _ -> throwIO (BadFormException @c nil)
refchan <- keymanNewCredentials (Just "refchan") 0
creds <- runKeymanClient $ loadCredentials refchan
>>= orThrowUser "can't load credentials"
let box = makeSignedBox @'HBS2Basic (view peerSignPk creds) (view peerSignSk creds) rch
href <- writeAsMerkle sto (serialise box)
callService @RpcPollAdd peerApi (refchan, "refchan", 17)
>>= orThrowUser "can't subscribe to refchan"
callService @RpcRefChanHeadPost rchanApi (HashRef href)
>>= orThrowUser "can't post refchan head"
let r = mkStr @c $ show $ "; refchan " <+> pretty (AsBase58 refchan) <> line
<> pretty rch
pure r
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