Update command `export`

hbs2-git/git-hbs2/Main.hs

@@ -27,9 +27,9 @@ main = join . customExecParser (prefs showHelpOnError) $
                         )
 
     pExport = do
-      ref  <- strArgument (metavar "HASH-REF")
+      keyfile   <- strArgument (metavar "KEIRING-FILE")
-      kr   <- optional $ strOption (short 'k' <> long "keyring" <> metavar "KEYRING-FILE")
+      pure $ runApp WithLog do
-      pure $ runApp WithLog (runExport kr ref)
+          runExport' keyfile
 
     pListRefs = do
       pure $ runApp NoLog runListRefs

hbs2-git/hbs2-git.cabal

@@ -80,6 +80,7 @@ common shared-properties
                , prettyprinter-ansi-terminal
                , resourcet
                , safe
+               , saltine
                , serialise
                , split
                , sqlite-simple

hbs2-git/lib/HBS2Git/App.hs

@@ -14,6 +14,7 @@ import HBS2.OrDie
 import HBS2.Hash
 import HBS2.System.Logger.Simple
 import HBS2.Merkle
+import HBS2.Net.Proto.Types
 import HBS2.Git.Types
 import HBS2.Net.Proto.Definition()
 import HBS2.Net.Auth.Credentials hiding (getCredentials)
@@ -29,6 +30,7 @@ import Control.Monad.Trans.Maybe
 import Data.Foldable
 import Data.Either
 import Control.Monad.Reader
+import Crypto.Saltine.Core.Sign qualified as Sign
 import Data.ByteString.Lazy.Char8 (ByteString)
 import Data.ByteString.Char8 qualified as B8
 import Data.ByteString.Lazy.Char8 qualified as LBS
@@ -447,13 +449,28 @@ loadCredentials fp = do
     die "keyring not set"
 
   for_ krOpt $ \fn -> do
-    krData <- liftIO $ B8.readFile fn
+    (puk, cred) <- loadKeyring fn
-    cred <- pure (parseCredentials @Schema (AsCredFile krData)) `orDie` "bad keyring file"
-    let puk = view peerSignPk cred
     trace $ "got creds for" <+> pretty (AsBase58 puk)
     setCredentials (RefLogKey puk) cred
     pure ()
 
+loadCredentials' ::
+    ( MonadIO m
+    , HasRefCredentials m
+    )
+    => FilePath -> m Sign.PublicKey
+loadCredentials' fn = do
+    (puk, cred) <- loadKeyring fn
+    trace $ "got creds for" <+> pretty (AsBase58 puk)
+    setCredentials (RefLogKey puk) cred
+    pure puk
+
+loadKeyring :: (MonadIO m) => FilePath -> m (Sign.PublicKey, PeerCredentials Schema)
+loadKeyring fn = do
+    krData <- liftIO $ B8.readFile fn
+    cred <- pure (parseCredentials @Schema (AsCredFile krData)) `orDie` "bad keyring file"
+    let puk = view peerSignPk cred
+    pure (puk, cred)
 
 green = annotate (color Green)
 

hbs2-git/lib/HBS2Git/Export.hs

@@ -5,6 +5,7 @@ module HBS2Git.Export
   ( exportRefDeleted
   , exportRefOnly
   , runExport
+  , runExport'
   , ExportRepoOps
   ) where
 
@@ -15,6 +16,7 @@ import HBS2.System.Logger.Simple
 import HBS2.Net.Proto.Definition()
 import HBS2.Clock
 import HBS2.Base58
+import HBS2.Net.Proto.RefLog
 
 import HBS2.Git.Local
 import HBS2.Git.Local.CLI
@@ -349,6 +351,8 @@ exportRefOnly _ remote rfrom ref val = do
     --       что бы оставить совместимость
     pure $ lastMay logz
 
+---
+
 runExport :: forall m . ( MonadIO m
                         , MonadUnliftIO m
                         , MonadCatch m
@@ -357,8 +361,37 @@ runExport :: forall m . ( MonadIO m
                         )
 
           => Maybe FilePath -> RepoRef -> App m ()
-runExport fp repo = do
+runExport mfp repo = do
+    loadCredentials (maybeToList mfp)
+    let krf = fromMaybe "keyring-file" mfp & takeFileName
+    runExport'' krf repo
 
+---
+
+runExport' :: forall m . ( MonadIO m
+                        , MonadUnliftIO m
+                        , MonadCatch m
+                        , HasProgress (App m)
+                        , MonadMask (App m)
+                        )
+
+          => FilePath -> App m ()
+
+runExport' fp = do
+    repo <- loadCredentials' fp
+    runExport'' (takeFileName fp) (RefLogKey repo)
+
+---
+
+runExport'' :: forall m . ( MonadIO m
+                        , MonadUnliftIO m
+                        , MonadCatch m
+                        , HasProgress (App m)
+                        , MonadMask (App m)
+                        )
+
+          => FilePath -> RepoRef -> App m ()
+runExport'' krf repo = do
 
   liftIO $ putDoc $
        line
@@ -371,8 +404,6 @@ runExport fp repo = do
 
   trace $ "git directory is" <+> pretty git
 
-  loadCredentials (maybeToList fp)
-
   -- FIXME: wtf-runExport
   branchesGr <- cfgValue @ConfBranch <&> Set.map normalizeRef
 
@@ -404,7 +435,6 @@ runExport fp repo = do
 
   cwd <- liftIO getCurrentDirectory
   cfgPath <- configPath cwd
-  let krf = fromMaybe "keyring-file" fp & takeFileName
 
   liftIO $ putStrLn ""
   liftIO $ putDoc $