wip

fixme-new/lib/Fixme/Run.hs

@@ -419,8 +419,12 @@ runTop forms = do
         co <- lift listCommits <&> fmap (mkStr @C . view _1)
         pure $ mkList co
 
-       entry $ bindMatch "fixme:refchan:export" $ nil_ $ const do
-        void $ lift $ refchanExport
+       entry $ bindMatch "fixme:refchan:export" $ nil_ $ \case
+          [SymbolVal "dry"] -> do
+            notice $ yellow "export is running in dry mode"
+            void $ lift $ refchanExport True
+
+          _ ->  void $ lift $ refchanExport False
 
        entry $ bindMatch "fixme:refchan:import" $ nil_ $ const do
         void $ lift $ refchanImport

fixme-new/lib/Fixme/Run/Internal.hs

@@ -338,8 +338,8 @@ cat_ hash = do
 
 
 
-refchanExport :: FixmePerks m => FixmeM m ()
-refchanExport = do
+refchanExport :: FixmePerks m => Bool -> FixmeM m ()
+refchanExport dry = do
   sto <- getStorage
   rchanAPI <- getClientAPI @RefChanAPI @UNIX
 
@@ -364,9 +364,14 @@ refchanExport = do
     --   с ростом количества записей. Нужно отбирать
     --   только такие элементы, которые реально отсутствуют
     --   в рефчане
-    what <- select_ @_ @FixmeExported [qc|select distinct o,0,k,cast (v as text) from object order by o, k, v|]
+    what <- select_ @_ @FixmeExported [qc|
+      select distinct o,0,k,cast (v as text)
+      from object obj
+      where not exists (select null from scanned where hash = obj.nonce)
+      order by o, k, v
+      |]
 
-    let chu  = chunksOf 1000 what
+    let chu  = chunksOf 10000 what
 
     flip runContT pure do
 
@@ -385,16 +390,15 @@ refchanExport = do
 
           let lbs = serialise tx
 
-          liftIO $ print (LBS.length lbs)
-
           let box = makeSignedBox @'HBS2Basic @BS.ByteString pk sk (LBS.toStrict lbs)
 
           warn $ "POST" <+> red "unencrypted!" <+> pretty (hashObject @HbSync (serialise box))
 
-          r <- callRpcWaitMay @RpcRefChanPropose (TimeoutSec 1) rchanAPI (chan, box)
+          unless dry do
+            r <- callRpcWaitMay @RpcRefChanPropose (TimeoutSec 1) rchanAPI (chan, box)
 
-          when (isNothing r) do
-            err $ red "hbs2-peer rpc calling timeout"
+            when (isNothing r) do
+              err $ red "hbs2-peer rpc calling timeout"
 
 
 refchanImport :: FixmePerks m => FixmeM m ()
@@ -462,7 +466,7 @@ refchanImport = do
 
       unless (exportedWeight item == 0) do
         notice $ "import" <+> pretty (exportedKey item) <+> pretty (exportedWeight item)
-        insertFixmeExported item
+        insertFixmeExported (localNonce i) item
 
       atx <- readTVarIO accepts <&> fromMaybe mempty . HM.lookup h
       insertScanned txh

fixme-new/lib/Fixme/State.hs

@@ -20,6 +20,7 @@ module Fixme.State
   , FixmeExported(..)
   , HasPredicate(..)
   , SelectPredicate(..)
+  , LocalNonce(..)
   ) where
 
 import Fixme.Prelude hiding (key)
@@ -127,13 +128,12 @@ withState what = do
 createTables :: FixmePerks m => DBPipeM m ()
 createTables = do
 
-  ddl [qc| create table if not exists tree
-           ( hash text not null
-           , o    text not null
-           , k    text not null
-           , primary key (hash,o,k)
-           )
-         |]
+  -- ddl [qc| create table if not exists tree
+  --          ( hash   text not null
+  --          , nonce  text not null
+  --          , primary key (hash,nonce)
+  --          )
+  --        |]
 
   ddl [qc| create table if not exists scanned
            ( hash text not null primary key )
@@ -144,6 +144,7 @@ createTables = do
            , w   integer not null
            , k   text    not null
            , v   blob    not null
+           , nonce text  null
            , primary key (o,k)
            )
          |]
@@ -294,7 +295,7 @@ insertScannedFile file = do
   k <- lift $ scannedKeyForFile file
   insertScanned k
 
-insertScanned:: (FixmePerks m, MonadReader FixmeEnv m) => HashRef -> DBPipeM m ()
+insertScanned:: (FixmePerks m) => HashRef -> DBPipeM m ()
 insertScanned k = do
   insert [qc| insert into scanned (hash)
               values(?)
@@ -430,14 +431,27 @@ instance FromRow FixmeExported
 instance ToRow  FixmeExported
 instance Serialise FixmeExported
 
+class LocalNonce a where
+  localNonce :: a -> HashRef
 
-insertFixmeExported :: FixmePerks m => FixmeExported -> DBPipeM m ()
-insertFixmeExported item = do
+instance LocalNonce FixmeExported where
+  localNonce FixmeExported{..} =
+    HashRef $ hashObject @HbSync
+            $ serialise (exportedKey,exportedName,exportedValue)
+
+
+data WithNonce a = WithNonce HashRef a
+
+instance ToRow (WithNonce FixmeExported) where
+  toRow (WithNonce nonce f@FixmeExported{..}) = toRow (exportedKey, exportedWeight, exportedName, exportedValue, nonce)
+
+insertFixmeExported :: FixmePerks m => HashRef -> FixmeExported -> DBPipeM m ()
+insertFixmeExported h item = do
 
   let sql = [qc|
 
-      insert into object (o, w, k, v)
-      values (?, ?, ?, ?)
+      insert into object (o, w, k, v, nonce)
+      values (?, ?, ?, ?, ?)
       on conflict (o, k)
       do update set
         v = case
@@ -450,6 +464,7 @@ insertFixmeExported item = do
             end
   |]
 
-  insert sql item
+  insert sql (WithNonce h item)
+  insertScanned h