wip

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"

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