diff --git a/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs b/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs index c7d5f013..a032b324 100644 --- a/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs +++ b/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs @@ -177,19 +177,6 @@ instance NonceFrom SK.Nonce BS.ByteString where $ BS.take typicalNonceLength $ bs <> BS.replicate typicalNonceLength 0 --- Раз уж такое, то будем писать метаинформацию --- В блок #0, --- А HashRef#1 - будет ссылка на групповой ключ --- Таким образом, мы обеспечим прозрачное скачивание --- блоков, не будем экспонировать лишнюю метаинформацию, --- но вместе с тем раздуваем количество раундтрипов, --- это вообще касается такого способа сохранения --- Merkle Tree. --- Но накладные расходны не так велики, упрощается --- сборка мусора, упрощается код. Нам не надо делать --- специальную обработку на каждый тип данных, --- достаточно иметь [HashRef]. - instance ( MonadIO m , MonadError OperationError m , Storage sto h ByteString m diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs index 9f7a3b0b..5b0f7a4b 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs @@ -47,6 +47,7 @@ readChunked handle size = fuu S.yield chunk next + -- TODO: sparse-merkle-tree-representation -- Блоки пишутся таким образом потому, -- что хотелось, что бы листы являлись частями diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 04653b1f..aea09c7f 100644 --- a/hbs2/Main.hs +++ b/hbs2/Main.hs @@ -39,6 +39,8 @@ import Data.ByteString.Char8 qualified as BS8 import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy qualified as LBS import Data.ByteString qualified as BS +import Data.ByteArray.Hash (SipHash(..), SipKey(..)) +import Data.ByteArray.Hash qualified as BA import Data.Either import Data.Function import Data.Functor @@ -56,6 +58,7 @@ import System.Exit qualified as Exit import System.IO qualified as IO import System.IO.Temp (emptySystemTempFile) import UnliftIO +import Network.ByteOrder qualified as N tracePrefix :: SetLoggerEntry @@ -318,7 +321,6 @@ runStore opts ss = runResourceT do (liftIO . removeFile) SB.writeFile fn (SB.fromHandle stdin) - debug $ "It worked out!" <+> pretty fn pure fn maybe (pure stdin) (flip openFile ReadMode . unOptFile) fname @@ -364,21 +366,25 @@ runStore opts ss = runResourceT do gks <- pure (Symm.lookupGroupKey (snd sk) pk gk) `orDie` ("can't find secret key for " <> show (pretty (AsBase58 (fst sk)))) - HbSyncHash nonce <- liftIO $ LBS.readFile inputFile <&> hashObject @HbSync + void $ liftIO $ IO.withFile inputFile IO.ReadMode $ \fh -> do + let reader = readChunked fh (fromIntegral defBlockSize) + qqq <- S.toList_ $ reader + & S.map (BA.sipHash (SipKey 2716310006254639645 507093936407764973) . LBS.toStrict) + & S.map \(SipHash w) -> w - debug $ "NONCE FUCKING CALCULATED:" <+> pretty (AsBase58 nonce) + let (HbSyncHash nonce) = hashObject @HbSync (serialise qqq) - fh <- liftIO $ IO.openFile inputFile IO.ReadMode + IO.hSeek fh IO.AbsoluteSeek 0 - let segments = readChunked fh (fromIntegral defBlockSize) + let segments = readChunked fh (fromIntegral defBlockSize) - let source = ToEncryptSymmBS gks nonce segments gk + let source = ToEncryptSymmBS gks nonce segments gk - r <- runExceptT $ writeAsMerkle ss source + r <- runExceptT $ writeAsMerkle ss source - case r of - Left e -> die (show e) - Right h -> hPrint stdout (pretty h) + case r of + Left e -> die (show e) + Right h -> hPrint stdout (pretty h) Just (EncAsymm gk) -> liftIO $ IO.withFile inputFile IO.ReadMode $ \ha -> do @@ -516,8 +522,8 @@ main :: IO () main = join . customExecParser (prefs showHelpOnError) $ info (helper <*> parser) ( fullDesc - <> header "hbsync block fetch" - <> progDesc "fetches blocks from hbsync peers" + <> header "hbs2" + <> progDesc "hbs2 tools" ) where parser :: Parser (IO ()) diff --git a/hbs2/hbs2.cabal b/hbs2/hbs2.cabal index f0b7f4a1..c8cdbd5d 100644 --- a/hbs2/hbs2.cabal +++ b/hbs2/hbs2.cabal @@ -97,6 +97,7 @@ executable hbs2 , terminal-progress-bar , stm , unliftio + , network-byte-order hs-source-dirs: . default-language: Haskell2010