mirror of https://github.com/voidlizard/hbs2
wip, debug
This commit is contained in:
parent
2602ecdbff
commit
8303a347b6
|
@ -15,6 +15,7 @@ data OperationError =
|
||||||
| DecryptError
|
| DecryptError
|
||||||
| DecryptionError
|
| DecryptionError
|
||||||
| MissedBlockError
|
| MissedBlockError
|
||||||
|
| MissedBlockError2 String
|
||||||
| UnsupportedFormat
|
| UnsupportedFormat
|
||||||
| IncompleteData
|
| IncompleteData
|
||||||
| GroupKeyNotFound Int
|
| GroupKeyNotFound Int
|
||||||
|
|
|
@ -9,6 +9,8 @@ import HBS2.Git3.State.Internal.Segment
|
||||||
import HBS2.Git3.State.Internal.RefLog
|
import HBS2.Git3.State.Internal.RefLog
|
||||||
import HBS2.Git3.Git
|
import HBS2.Git3.Git
|
||||||
|
|
||||||
|
import HBS2.Storage.Operations.Missed
|
||||||
|
|
||||||
import HBS2.Data.Log.Structured
|
import HBS2.Data.Log.Structured
|
||||||
|
|
||||||
import Data.ByteString qualified as BS
|
import Data.ByteString qualified as BS
|
||||||
|
@ -286,6 +288,7 @@ updateReflogIndex = do
|
||||||
reflog <- getGitRemoteKey >>= orThrow Git3ReflogNotSet
|
reflog <- getGitRemoteKey >>= orThrow Git3ReflogNotSet
|
||||||
|
|
||||||
api <- getClientAPI @RefLogAPI @UNIX
|
api <- getClientAPI @RefLogAPI @UNIX
|
||||||
|
peer <- getClientAPI @PeerAPI @UNIX
|
||||||
|
|
||||||
sto <- getStorage
|
sto <- getStorage
|
||||||
|
|
||||||
|
@ -313,9 +316,16 @@ updateReflogIndex = do
|
||||||
|
|
||||||
debug $ "STATE" <+> pretty idxPath
|
debug $ "STATE" <+> pretty idxPath
|
||||||
|
|
||||||
|
missed <- findMissedBlocks sto what
|
||||||
|
|
||||||
|
unless (L.null missed) do
|
||||||
|
for_ missed $ \h -> do
|
||||||
|
lift (callRpcWaitMay @RpcFetch (TimeoutSec 1) peer h) >>= orThrow RpcTimeout
|
||||||
|
throwIO RefLogNotReady
|
||||||
|
|
||||||
sink <- S.toList_ do
|
sink <- S.toList_ do
|
||||||
walkMerkle (coerce what) (getBlock sto) $ \case
|
walkMerkle (coerce what) (getBlock sto) $ \case
|
||||||
Left{} -> throwIO MissedBlockError
|
Left e -> throwIO $ MissedBlockError2 (show $ pretty e)
|
||||||
Right (hs :: [HashRef]) -> do
|
Right (hs :: [HashRef]) -> do
|
||||||
for_ [h | h <- hs, not (HS.member h written)] $ \h -> void $ runMaybeT do
|
for_ [h | h <- hs, not (HS.member h written)] $ \h -> void $ runMaybeT do
|
||||||
readTxMay sto (coerce h) >>= \case
|
readTxMay sto (coerce h) >>= \case
|
||||||
|
|
|
@ -64,6 +64,7 @@ data HBS2GitExcepion =
|
||||||
| GitRepoRefEmpty
|
| GitRepoRefEmpty
|
||||||
| GitRepoManifestMalformed
|
| GitRepoManifestMalformed
|
||||||
| RefLogCredentialsNotMatched
|
| RefLogCredentialsNotMatched
|
||||||
|
| RefLogNotReady
|
||||||
| RpcTimeout
|
| RpcTimeout
|
||||||
deriving stock (Show,Typeable)
|
deriving stock (Show,Typeable)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue