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

wip

This commit is contained in:
Dmitry Zuikov 2023-01-11 16:55:37 +03:00
parent 5ce0f8c48f
commit 1ab9171b09
1 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
hbs2/Main.hs
View File

@ -40,15 +40,21 @@ newtype MerkleHash = MerkleHash { fromMerkleHash :: Hash HbSync }
deriving newtype (Eq,Ord,IsString,Pretty) deriving newtype (Eq,Ord,IsString,Pretty)
deriving stock (Data,Generic) deriving stock (Data,Generic)
newtype CatHashesOnly = CatHashesOnly Bool
deriving newtype (Eq,Ord,Pretty)
deriving stock (Data,Generic)
newtype StoreOpts = newtype StoreOpts =
StoreOpts { StoreOpts {
storeInputFile :: Maybe OptInputFile storeInputFile :: Maybe OptInputFile
} }
deriving stock (Data) deriving stock (Data)
newtype CatOpts = data CatOpts =
CatOpts { CatOpts
catMerkleHash :: Maybe MerkleHash { catMerkleHash :: Maybe MerkleHash
, catHashesOnly :: Maybe CatHashesOnly
} }
deriving stock (Data) deriving stock (Data)
@ -67,16 +73,21 @@ readChunked handle size = fuu
runCat :: Data opts => opts -> SimpleStorage HbSync -> IO () runCat :: Data opts => opts -> SimpleStorage HbSync -> IO ()
runCat opts ss = do runCat opts ss = do
let honly = or [ x | CatHashesOnly x <- universeBi opts ]
void $ runMaybeT $ do void $ runMaybeT $ do
mhash <- MaybeT $ pure $ uniLastMay @MerkleHash opts <&> fromMerkleHash mhash <- MaybeT $ pure $ uniLastMay @MerkleHash opts <&> fromMerkleHash
liftIO $ walkMerkle mhash (getBlock ss) $ \(hr :: [HashRef]) -> do liftIO $ walkMerkle mhash (getBlock ss) $ \(hr :: [HashRef]) -> do
forM_ hr $ \(HashRef h) -> do forM_ hr $ \(HashRef h) -> do
mblk <- getBlock ss h if honly then do
case mblk of print $ pretty h
Nothing -> error $ show $ "missed block: " <+> pretty h else do
Just blk -> LBS.putStr blk mblk <- getBlock ss h
case mblk of
Nothing -> error $ show $ "missed block: " <+> pretty h
Just blk -> LBS.putStr blk
runStore :: Data opts => opts -> SimpleStorage HbSync -> IO () runStore :: Data opts => opts -> SimpleStorage HbSync -> IO ()
@ -137,6 +148,7 @@ main = join . customExecParser (prefs showHelpOnError) $
pCat = do pCat = do
o <- common o <- common
hash <- optional $ strArgument ( metavar "HASH" ) hash <- optional $ strArgument ( metavar "HASH" )
pure $ withStore o (runCat ( CatOpts hash )) onlyh <- optional $ flag' True ( short 'H' <> long "hashes-only" <> help "list only block hashes" )
pure $ withStore o $ runCat $ CatOpts hash (CatHashesOnly <$> onlyh)