From b6c85789b9ade4e43db6e5420fbfd6e7bce30ac3 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Thu, 14 Mar 2024 13:26:56 +0300
Subject: [PATCH] wip

---
 .../hbs2-git-client-lib/HBS2/Git/Client/Export.hs    | 11 ++++++++---
 hbs21-git/hbs2-git-client-lib/HBS2/Git/Data/Tx.hs    | 12 +++++-------
 2 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/hbs21-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs b/hbs21-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs
index 38ac041e..f2526c39 100644
--- a/hbs21-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs
+++ b/hbs21-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs
@@ -160,11 +160,16 @@ export key refs  = do
   reflog <- asks _refLogAPI
   ip <- asks _progress
 
-  LWWBlockData{..} <- waitOrInitLWWRef
+  lww@LWWBlockData{..} <- waitOrInitLWWRef
 
   debug $ red $ pretty $ AsBase58 lwwRefLogPubKey
 
-  puk <- error $ show $ "FIXME: puk" <+> pretty (AsBase58 lwwRefLogPubKey)
+  (sk0,pk0) <- liftIO $ runKeymanClient do
+                creds <- loadCredentials lwwRefLogPubKey
+                             >>= orThrowUser "can't load credentials"
+                pure ( view peerSignSk  creds, view peerSignPk creds )
+
+  (puk,sk) <- derivedKey @HBS2Basic @'Sign lwwRefSeed sk0
 
   subscribeRefLog puk
 
@@ -246,7 +251,7 @@ export key refs  = do
 
       debug $ red "MAKE TX" <+> pretty rw <+> pretty gk0old <+> "->" <+> pretty gk0new
 
-      tx <- lift $ makeTx sto rw rank puk repohead bss out
+      tx <- lift $ makeTx sto rw rank puk (const $ pure (Just sk)) repohead bss out
 
       r <- lift $ race (pause @'Seconds 1) (callService @RpcRefLogPost reflog tx)
              >>= orThrowUser "hbs2-peer rpc timeout"
diff --git a/hbs21-git/hbs2-git-client-lib/HBS2/Git/Data/Tx.hs b/hbs21-git/hbs2-git-client-lib/HBS2/Git/Data/Tx.hs
index a898705f..75172dd3 100644
--- a/hbs21-git/hbs2-git-client-lib/HBS2/Git/Data/Tx.hs
+++ b/hbs21-git/hbs2-git-client-lib/HBS2/Git/Data/Tx.hs
@@ -85,26 +85,24 @@ makeRepoHeadSimple name brief manifest gk refs = do
 writeRepoHead :: MonadUnliftIO  m => AnyStorage -> RepoHead -> m HashRef
 writeRepoHead sto rh = writeAsMerkle sto (serialise rh) <&> HashRef
 
-makeTx :: (MonadUnliftIO m, GroupKeyOperations m)
+makeTx :: forall s m . (MonadUnliftIO m, GroupKeyOperations m, s ~ HBS2Basic)
        => AnyStorage
        -> Bool   -- ^ rewrite bundle merkle tree with new gk0
        -> Rank   -- ^ tx rank
        -> RefLogId
+       -> ( PubKey 'Sign s -> m (Maybe (PrivKey 'Sign s) ) )
        -> RepoHead
        -> [HashRef]
        -> [LBS]
        -> m RepoTx
 
-makeTx sto rewrite r puk rh prev lbss = do
+makeTx sto rewrite r puk findSk rh prev lbss = do
 
   let rfk = RefLogKey @HBS2Basic puk
 
-  creds <- liftIO ( runKeymanClient $ loadCredentials puk )
+  privk <- findSk puk
              >>= orThrow TxKeyringNotFound
 
-  let pubk = view peerSignPk creds
-  let privk = view peerSignSk creds
-
   -- FIXME: delete-on-fail
   headRef <- writeRepoHead sto rh
 
@@ -168,7 +166,7 @@ makeTx sto rewrite r puk rh prev lbss = do
             & serialise
             & LBS.toStrict
 
-  makeRefLogUpdate @L4Proto @HBS2Basic pubk privk tx
+  makeRefLogUpdate @L4Proto @HBS2Basic puk privk tx
 
 
 unpackTx :: MonadIO m