mirror of https://github.com/voidlizard/hbs2
subscribe lwwref
This commit is contained in:
parent
b6c85789b9
commit
97521d4577
|
@ -160,13 +160,17 @@ export key refs = do
|
||||||
reflog <- asks _refLogAPI
|
reflog <- asks _refLogAPI
|
||||||
ip <- asks _progress
|
ip <- asks _progress
|
||||||
|
|
||||||
|
subscribeLWWRef key
|
||||||
|
|
||||||
lww@LWWBlockData{..} <- waitOrInitLWWRef
|
lww@LWWBlockData{..} <- waitOrInitLWWRef
|
||||||
|
|
||||||
|
let puk0 = fromLwwRefKey key
|
||||||
|
|
||||||
debug $ red $ pretty $ AsBase58 lwwRefLogPubKey
|
debug $ red $ pretty $ AsBase58 lwwRefLogPubKey
|
||||||
|
|
||||||
(sk0,pk0) <- liftIO $ runKeymanClient do
|
(sk0,pk0) <- liftIO $ runKeymanClient do
|
||||||
creds <- loadCredentials lwwRefLogPubKey
|
creds <- loadCredentials puk0
|
||||||
>>= orThrowUser "can't load credentials"
|
>>= orThrowUser ("can't load credentials" <+> pretty (AsBase58 puk0))
|
||||||
pure ( view peerSignSk creds, view peerSignPk creds )
|
pure ( view peerSignSk creds, view peerSignPk creds )
|
||||||
|
|
||||||
(puk,sk) <- derivedKey @HBS2Basic @'Sign lwwRefSeed sk0
|
(puk,sk) <- derivedKey @HBS2Basic @'Sign lwwRefSeed sk0
|
||||||
|
|
|
@ -72,6 +72,8 @@ importRepoWait lwwKey = do
|
||||||
|
|
||||||
meet <- newTVarIO (mempty :: HashMap HashRef Int)
|
meet <- newTVarIO (mempty :: HashMap HashRef Int)
|
||||||
|
|
||||||
|
subscribeLWWRef lwwKey
|
||||||
|
|
||||||
flip fix (IWaitLWWBlock 20) $ \next -> \case
|
flip fix (IWaitLWWBlock 20) $ \next -> \case
|
||||||
|
|
||||||
IWaitLWWBlock w | w <= 0 -> do
|
IWaitLWWBlock w | w <= 0 -> do
|
||||||
|
@ -86,9 +88,8 @@ importRepoWait lwwKey = do
|
||||||
pause @'Seconds 2
|
pause @'Seconds 2
|
||||||
next (IWaitLWWBlock (pred w))
|
next (IWaitLWWBlock (pred w))
|
||||||
|
|
||||||
Just blk -> do
|
Just (LWWBlockData{..}) -> do
|
||||||
error "FOUND SHIT!"
|
next (IWaitRefLog 20 lwwRefLogPubKey)
|
||||||
pure ()
|
|
||||||
|
|
||||||
IWaitRefLog w puk | w <= 0 -> do
|
IWaitRefLog w puk | w <= 0 -> do
|
||||||
throwIO ImportRefLogNotFound
|
throwIO ImportRefLogNotFound
|
||||||
|
|
|
@ -3,6 +3,7 @@ module HBS2.Git.Client.RefLog where
|
||||||
import HBS2.Git.Client.Prelude
|
import HBS2.Git.Client.Prelude
|
||||||
import HBS2.Git.Client.App.Types
|
import HBS2.Git.Client.App.Types
|
||||||
import HBS2.Git.Data.RefLog
|
import HBS2.Git.Data.RefLog
|
||||||
|
import HBS2.Git.Data.LWWBlock
|
||||||
|
|
||||||
data RefLogRequestTimeout = RefLogRequestTimeout
|
data RefLogRequestTimeout = RefLogRequestTimeout
|
||||||
deriving (Show,Typeable)
|
deriving (Show,Typeable)
|
||||||
|
@ -20,6 +21,11 @@ subscribeRefLog puk = do
|
||||||
void $ callService @RpcPollAdd api (puk, "reflog", 13)
|
void $ callService @RpcPollAdd api (puk, "reflog", 13)
|
||||||
|
|
||||||
|
|
||||||
|
subscribeLWWRef :: (GitPerks m, MonadReader GitEnv m) => LWWRefKey HBS2Basic -> m ()
|
||||||
|
subscribeLWWRef puk = do
|
||||||
|
api <- asks _peerAPI
|
||||||
|
void $ callService @RpcPollAdd api (fromLwwRefKey puk, "lwwref", 17)
|
||||||
|
|
||||||
getRefLogMerkle :: (GitPerks m, MonadReader GitEnv m) => RefLogId -> m (Maybe HashRef)
|
getRefLogMerkle :: (GitPerks m, MonadReader GitEnv m) => RefLogId -> m (Maybe HashRef)
|
||||||
getRefLogMerkle puk = do
|
getRefLogMerkle puk = do
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue