mirror of https://github.com/voidlizard/hbs2
62 lines
1.9 KiB
Haskell
62 lines
1.9 KiB
Haskell
{-# Language AllowAmbiguousTypes #-}
|
|
module HBS2.CLI.Run.Internal.RefChan (createNewRefChan) where
|
|
|
|
import HBS2.CLI.Prelude hiding (mapMaybe)
|
|
import HBS2.CLI.Run.Internal
|
|
import HBS2.CLI.Run.Internal.KeyMan
|
|
|
|
import HBS2.Peer.Proto.RefChan
|
|
import HBS2.Storage
|
|
import HBS2.Net.Auth.Credentials
|
|
import HBS2.Net.Auth.Schema()
|
|
import HBS2.Data.Types.SignedBox
|
|
import HBS2.Data.Types.Refs
|
|
import HBS2.Storage.Operations.Class
|
|
import HBS2.KeyMan.Keys.Direct
|
|
|
|
import HBS2.Peer.RPC.Client.Unix
|
|
import HBS2.Peer.RPC.Client
|
|
import HBS2.Peer.RPC.API.Storage
|
|
import HBS2.Peer.RPC.API.Peer
|
|
import HBS2.Peer.RPC.API.RefChan
|
|
|
|
import Lens.Micro.Platform
|
|
|
|
createNewRefChan :: forall c m . ( IsContext c
|
|
, MonadUnliftIO m
|
|
, Exception (BadFormException c)
|
|
, HasClientAPI RefChanAPI UNIX m
|
|
, HasClientAPI StorageAPI UNIX m
|
|
, HasClientAPI PeerAPI UNIX m
|
|
, HasStorage m
|
|
)
|
|
=> Maybe (PubKey Sign HBS2Basic)
|
|
-> RefChanHeadBlock L4Proto
|
|
-> m (PubKey Sign HBS2Basic)
|
|
|
|
createNewRefChan mbk rch = do
|
|
|
|
peerApi <- getClientAPI @PeerAPI @UNIX
|
|
rchanApi <- getClientAPI @RefChanAPI @UNIX
|
|
sto <- getStorage
|
|
|
|
refchan <- maybe1 mbk (keymanNewCredentials (Just "refchan") 0) pure
|
|
|
|
creds <- runKeymanClientRO $ loadCredentials refchan
|
|
>>= orThrowUser "can't load credentials"
|
|
|
|
let box = makeSignedBox @'HBS2Basic (view peerSignPk creds) (view peerSignSk creds) rch
|
|
|
|
href <- writeAsMerkle sto (serialise box)
|
|
|
|
--FIXME: timeout-hardcode
|
|
callService @RpcPollAdd peerApi (refchan, "refchan", 17)
|
|
>>= orThrowUser "can't subscribe to refchan"
|
|
|
|
callService @RpcRefChanHeadPost rchanApi (HashRef href)
|
|
>>= orThrowUser "can't post refchan head"
|
|
|
|
pure refchan
|
|
|
|
|