diff --git a/hbs2-git/git-hbs2/Main.hs b/hbs2-git/git-hbs2/Main.hs index 47dbcf9a..e8199481 100644 --- a/hbs2-git/git-hbs2/Main.hs +++ b/hbs2-git/git-hbs2/Main.hs @@ -27,9 +27,9 @@ main = join . customExecParser (prefs showHelpOnError) $ ) pExport = do - ref <- strArgument (metavar "HASH-REF") - kr <- optional $ strOption (short 'k' <> long "keyring" <> metavar "KEYRING-FILE") - pure $ runApp WithLog (runExport kr ref) + keyfile <- strArgument (metavar "KEIRING-FILE") + pure $ runApp WithLog do + runExport' keyfile pListRefs = do pure $ runApp NoLog runListRefs diff --git a/hbs2-git/hbs2-git.cabal b/hbs2-git/hbs2-git.cabal index 0d939561..6daf2d4c 100644 --- a/hbs2-git/hbs2-git.cabal +++ b/hbs2-git/hbs2-git.cabal @@ -80,6 +80,7 @@ common shared-properties , prettyprinter-ansi-terminal , resourcet , safe + , saltine , serialise , split , sqlite-simple diff --git a/hbs2-git/lib/HBS2Git/App.hs b/hbs2-git/lib/HBS2Git/App.hs index 7c230ebe..94c0b86d 100644 --- a/hbs2-git/lib/HBS2Git/App.hs +++ b/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 - cred <- pure (parseCredentials @Schema (AsCredFile krData)) `orDie` "bad keyring file" - let puk = view peerSignPk cred + (puk, cred) <- loadKeyring fn 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) diff --git a/hbs2-git/lib/HBS2Git/Export.hs b/hbs2-git/lib/HBS2Git/Export.hs index f168d513..8245a2e1 100644 --- a/hbs2-git/lib/HBS2Git/Export.hs +++ b/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 $