minor speedup

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

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
 --  Блоки пишутся таким образом потому,
 --  что хотелось, что бы листы являлись частями

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
+            case r of
-            Left e  -> die (show e)
+              Left e  -> die (show e)
-            Right h -> hPrint stdout (pretty h)
+              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"
+  <> header "hbs2"
-  <> progDesc "fetches blocks from hbsync peers"
+  <> progDesc "hbs2 tools"
   )
   where
     parser ::  Parser (IO ())

hbs2/hbs2.cabal

@@ -97,6 +97,7 @@ executable hbs2
                     , terminal-progress-bar
                     , stm
                     , unliftio
+                    , network-byte-order
 
     hs-source-dirs:   .
     default-language: Haskell2010