git hbs2 init

hbs2-git/git-hbs2/Main.hs

@@ -5,7 +5,7 @@ import HBS2.OrDie
 
 import HBS2Git.App
 import HBS2Git.Export
-import HBS2Git.ListRefs
+import HBS2Git.Tools
 import HBS2Git.KeysCommand
 import HBS2.Net.Proto.Definition()
 
@@ -23,7 +23,7 @@ main = join . customExecParser (prefs showHelpOnError) $
   )
   where
     parser ::  Parser (IO ())
-    parser = hsubparser (  command "export"    (info pExport (progDesc "export repo"))
+    parser = hsubparser (  command "init"      (info pInit (progDesc "init new hbs2 repo"))
                         <> command "list-refs" (info pListRefs (progDesc "list refs"))
                         <> command "show"      (info pShow (progDesc "show various types of objects"))
                         <> command "tools"     (info pTools (progDesc "misc tools"))
@@ -49,6 +49,7 @@ main = join . customExecParser (prefs showHelpOnError) $
       pure $ runApp NoLog (runShow object)
 
     pTools = hsubparser (    command "scan" (info pToolsScan (progDesc "scan reference"))
+                          <> command "export"    (info pExport (progDesc "export repo"))
                           <> command "refs" (info pToolsGetRefs (progDesc "list references"))
 
                         )
@@ -84,4 +85,30 @@ main = join . customExecParser (prefs showHelpOnError) $
         rk <- pure (fromStringMay ref) `orDie` "invalid REF-KEY"
         runApp WithLog (runKeysList rk)
 
+    pInit = do
+      opts <- pOpts
+      pure do
+        runInit (runInitRepo opts)
+
+      where
+        pOpts = pInteractive
+
+        pInteractive = NewRepoOpts <$> optional pKeyring
+                                   <*> pEncryption
+
+
+        pEncryption = pEncryptionHere <|> pure Nothing
+
+        pEncryptionHere = do
+          puk <- option pEncPk ( short 'p' <> long "encryption-pk" <> help "public key for encryption")
+          fn  <- strOption ( short 'e' <> long "keyring-enc" <> help "keyring for encryption" )
+          pure $ Just (puk, fn)
+
+
+        pEncPk :: ReadM (PubKey 'Encrypt (Encryption L4Proto))
+        pEncPk  = eitherReader $
+            maybe (Left "invalid encryption public key") pure . fromStringMay
+
+        pKeyring = do
+          strOption (short 'k' <> long "keyring" <> help "reference keyring file")
 

hbs2-git/git-hbs2/RunShow.hs

@@ -6,7 +6,7 @@ import HBS2.Base58
 import HBS2Git.App
 import HBS2Git.State
 import HBS2Git.Config
-import HBS2Git.ListRefs
+import HBS2Git.Tools
 import HBS2Git.PrettyStuff
 
 import Control.Monad.Catch (MonadMask)

hbs2-git/hbs2-git.cabal

@@ -72,6 +72,7 @@ common shared-properties
                , filelock
                , filepath
                , filepattern
+               , generic-lens
                , hashable
                , http-conduit
                , interpolatedstring-perl6
@@ -117,7 +118,7 @@ library
       HBS2Git.GitRepoLog
       HBS2Git.Import
       HBS2Git.KeysCommand
-      HBS2Git.ListRefs
+      HBS2Git.Tools
       HBS2.Git.Local
       HBS2.Git.Local.CLI
       HBS2Git.PrettyStuff

hbs2-git/lib/HBS2Git/App.hs

@@ -73,7 +73,12 @@ import Prettyprinter.Render.Terminal
 
 import Streaming.Prelude qualified as S
 
-import UnliftIO
+import UnliftIO as UIO
+
+data NoRPCException = NoRPCException
+  deriving stock (Show, Typeable)
+
+instance Exception NoRPCException
 
 -- instance HasTimeLimits  UNIX (ServiceProto PeerAPI UNIX) m where
 
@@ -158,7 +163,29 @@ withApp :: MonadIO m => AppEnv -> App m a -> m a
 withApp env m = runReaderT (fromApp m) env
 
 
-runWithRPC :: forall m . MonadUnliftIO m => (RPCEndpoints -> m ()) -> m ()
+detectRPC :: (MonadIO m, MonadThrow m) => Bool -> m FilePath
+detectRPC noisy = do
+  (_, o, _) <- readProcess (shell [qc|hbs2-peer poke|])
+
+  let answ = parseTop (LBS.unpack o) & fromRight mempty
+
+  so <- case headMay [ Text.unpack r | ListVal (Key "rpc:" [LitStrVal r]) <- answ  ] of
+          Nothing -> throwM NoRPCException
+          Just w  -> pure w
+
+  when noisy do
+
+    -- FIXME: logger-to-support-colors
+    liftIO $ hPutDoc stderr $ yellow "rpc: found RPC" <+> pretty so
+                              <> line <>
+                              yellow "rpc: add option" <+> parens ("rpc unix" <+> dquotes (pretty so))
+                              <+> "to the config .hbs2/config"
+                              <> line <> line
+
+
+  pure so
+
+runWithRPC :: forall m . (MonadUnliftIO m, MonadThrow m) => (RPCEndpoints -> m ()) -> m ()
 runWithRPC action = do
 
   (_, syn) <- configInit
@@ -167,7 +194,7 @@ runWithRPC action = do
                         | ListVal (Key "rpc" [SymbolVal "unix", LitStrVal n]) <- syn
                         ]
 
-  soname <- race ( pause @'Seconds 1) (maybe detectRPC pure soname') `orDie` "hbs2-peer rpc timeout!"
+  soname <- race ( pause @'Seconds 1) (maybe (detectRPC False) pure soname') `orDie` "hbs2-peer rpc timeout!"
 
   client <- race ( pause @'Seconds 1) (newMessagingUnix False 1.0 soname) `orDie` "hbs2-peer rpc timeout!"
 
@@ -198,27 +225,14 @@ runWithRPC action = do
 
   void $ waitAnyCatchCancel [messaging, c1]
 
-  where
+runInit :: (MonadUnliftIO m, MonadThrow m) => m () -> m ()
+runInit m = m
 
-    detectRPC = do
+runApp :: (MonadUnliftIO m, MonadThrow m) => WithLog -> App m () -> m ()
-      (_, o, _) <- readProcess (shell [qc|hbs2-peer poke|])
-
-      let answ = parseTop (LBS.unpack o) & fromRight mempty
-
-      so <- pure (headMay [ Text.unpack r | ListVal (Key "rpc:" [LitStrVal r]) <- answ  ])
-              `orDie` "hbs2-peer rpc not detected"
-
-      -- FIXME: logger-to-support-colors
-      liftIO $ hPutDoc stderr $ yellow "rpc: found RPC" <+> pretty so
-                                <> line <>
-                                yellow "rpc: add option" <+> parens ("rpc unix" <+> dquotes (pretty so))
-                                <+> "to the config .hbs2/config"
-                                <> line <> line
-      pure so
-
-runApp :: MonadUnliftIO m => WithLog -> App m () -> m ()
 runApp l m = do
 
+  flip UIO.catches dealWithException do
+
     case l of
       NoLog   -> pure ()
       WithLog -> do
@@ -256,6 +270,16 @@ runApp l m = do
     setLoggingOff @TRACE
     setLoggingOff @INFO
 
+  where
+    dealWithException = [ noWorkDir ]
+
+    noWorkDir = Handler $
+      \NoWorkDirException -> liftIO do
+        hPutDoc stderr $ "hbs2-git:" <+> red "*** no git working directory found."
+                                     <+> yellow "Perhaps you'd call" <+> "'git init'" <+> "first"
+                                     <> line
+        exitFailure
+
 readBlock :: forall m . (MonadIO m, HasStorage m) => HashRef -> m (Maybe ByteString)
 readBlock h = do
   sto <- getStorage

hbs2-git/lib/HBS2Git/Config.hs

@@ -14,17 +14,25 @@ import HBS2Git.Types
 
 import Control.Applicative
 
-import Data.Functor
+import Control.Exception
+import Control.Monad.Catch (MonadThrow, throwM)
 import System.FilePath
 import System.Directory
 import Data.Maybe
 import Data.Either
 import Data.List (isSuffixOf)
+import Control.Monad.Trans.Maybe
 
 import System.Environment
 
 import System.IO (stderr)
 
+data NoWorkDirException =
+  NoWorkDirException
+  deriving (Show, Typeable)
+
+instance Exception NoWorkDirException
+
 appName :: FilePath
 appName = "hbs2-git"
 
@@ -47,30 +55,35 @@ configPathOld pwd = liftIO do
   home <- liftIO getHomeDirectory
   pure $ xdg </> makeRelative home pwd
 
-configPath :: MonadIO m => FilePath -> m FilePath
+configPath :: (MonadIO m, MonadThrow m) => FilePath -> m FilePath
-configPath _ = liftIO do
+configPath _ = do
   pwd <- liftIO getCurrentDirectory
   git <- findGitDir pwd
-  byEnv <- lookupEnv "GIT_DIR"
+  byEnv <- liftIO $ lookupEnv "GIT_DIR"
 
   bare <- if isJust (git <|> byEnv) then do
             pure Nothing
-          else do
+          else runMaybeT do
             -- check may be it's a bare git repo
-            gitConf <- readFile "config"
+            gitConf <- toMPlus =<< liftIO ( try @IOException $
+                                             readFile "config"
                                                 <&> parseTop
-                         <&> fromRight mempty
+                                                <&> fromRight mempty )
 
             let core = or [True | SymbolVal @C "core" <- universeBi gitConf]
             let bare = or [True | ListVal [SymbolVal @C "bare", _, SymbolVal "true"] <- universeBi gitConf ]
             let repo = or [True | SymbolVal @C "repositoryformatversion" <- universeBi gitConf ]
 
             if core && bare && repo then do
-                pure $ Just pwd
+              pure pwd
             else
-                pure Nothing
+              MaybeT $ pure Nothing
 
-  path <- pure (dropSuffix <$> (git <|> byEnv <|> bare)) `orDie`  "*** hbs2-git: .git directory not found"
+  let maybePath = dropSuffix <$> (git <|> byEnv <|> bare)
+
+  path <- maybe (throwM NoWorkDirException)
+                pure
+                maybePath
 
   pure (path </> ".hbs2")
 
@@ -86,7 +99,7 @@ data ConfigPathInfo = ConfigPathInfo {
 } deriving (Eq, Show)
 
 -- returns git repository parent dir, config directory and config file path
-getConfigPathInfo :: MonadIO m => m ConfigPathInfo
+getConfigPathInfo :: (MonadIO m, MonadThrow m) => m ConfigPathInfo
 getConfigPathInfo = do
   trace "getConfigPathInfo"
   confP <- configPath ""
@@ -100,7 +113,7 @@ getConfigPathInfo = do
     }
 
 -- returns current directory, where found .git directory
-configInit :: MonadIO m => m (FilePath, [Syntax C])
+configInit :: (MonadIO m, MonadThrow m) => m (FilePath, [Syntax C])
 configInit = liftIO do
   trace "configInit"
   ConfigPathInfo{..} <- getConfigPathInfo
@@ -114,7 +127,7 @@ configInit = liftIO do
   cfg <- readFile configFilePath <&> parseTop <&> either mempty id
   pure (configRepoParentDir, cfg)
 
-cookieFile :: MonadIO m => m FilePath
+cookieFile :: (MonadIO m, MonadThrow m) => m FilePath
 cookieFile = configPath "" <&> (</> "cookie")
 
 getAppStateDir :: forall m . MonadIO m => m FilePath

hbs2-git/lib/HBS2Git/Evolve.hs

@@ -11,6 +11,7 @@ import HBS2Git.Config
 import HBS2Git.PrettyStuff
 
 import Control.Monad.Trans.Maybe
+import Control.Monad.Catch (MonadThrow(..))
 import Data.List qualified as List
 import System.Directory
 import System.Random
@@ -22,7 +23,7 @@ import UnliftIO
 --   новыми версиями.
 --   например, переносит конфиг
 
-evolve :: MonadIO m => m ()
+evolve :: (MonadIO m, MonadThrow m) => m ()
 evolve = void $ runMaybeT do
 
   here   <- liftIO getCurrentDirectory
@@ -43,7 +44,7 @@ makePolled ref = do
   n <- liftIO $ randomRIO (4,7)
   void $ callService @RpcPollAdd rpc (fromRefLogKey ref, "reflog", n)
 
-generateCookie :: MonadIO m => m ()
+generateCookie :: (MonadIO m, MonadThrow m) => m ()
 generateCookie = void $ runMaybeT do
   file <- cookieFile
 
@@ -57,7 +58,7 @@ generateCookie = void $ runMaybeT do
   liftIO $ writeFile file ""
 
 
-migrateConfig :: MonadIO m => m ()
+migrateConfig :: (MonadIO m, MonadThrow m) => m ()
 migrateConfig = void $ runMaybeT do
   here   <- liftIO getCurrentDirectory
 

hbs2-git/lib/HBS2Git/ListRefs.hs

@@ -1,112 +0,0 @@
-module HBS2Git.ListRefs where
-
-import HBS2.Prelude
-
-import HBS2Git.Types
-import HBS2.Prelude
-import HBS2Git.App
-import HBS2.Data.Types.Refs (HashRef)
-
-import HBS2.System.Logger.Simple
-import HBS2.Git.Local.CLI
-import HBS2.Git.Types
-import HBS2Git.Import (importRefLogNew)
-import HBS2Git.Config
-import HBS2Git.State
-import HBS2Git.PrettyStuff
-
-import Data.HashMap.Strict qualified as HashMap
-import Data.Functor
-import Data.Text qualified as Text
-import Data.Traversable
-import Prettyprinter.Render.Terminal
-import Control.Monad.IO.Unlift
-import Control.Monad.Catch
-import System.IO (stdout)
-
-data AsRemoteEntry = AsRemoteEntry
-  { remoteName :: Text,
-    remoteURL :: Text,
-    remoteRefValue :: Maybe HashRef
-  }
-
-remoteNameColWidth :: Int
-remoteNameColWidth = 16
-
-remoteURLColWidth :: Int
-remoteURLColWidth = 51
-
-remoteRefValueColWidth :: Int
-remoteRefValueColWidth = 44
-
-instance Pretty AsRemoteEntry where
-  pretty (AsRemoteEntry {..}) =
-    fill remoteNameColWidth (pretty remoteName)
-      <+> fill remoteURLColWidth (pretty remoteURL)
-      <+> fill remoteRefValueColWidth (maybe "-" pretty remoteRefValue)
-
-hbs2Prefix :: Text
-hbs2Prefix = "hbs2://"
-
--- TODO: backlog-list-refs-all-option
---  сделать опцию --all которая выведет
---  все известные ref-ы из стейта.
---  Сейчас выводятся только локальные
-
-runListRefs :: (MonadIO m, HasStorage (App m)) => App m ()
-runListRefs = do
-  refs <- gitGetRemotes <&> filter isHbs2
-  remoteEntries <-
-    forM
-      refs
-      ( \(name, url) -> do
-          refVal <- getRefVal url
-          pure $
-            AsRemoteEntry
-              { remoteName = name,
-                remoteURL = url,
-                remoteRefValue = refVal
-              }
-      )
-  let header =
-        fill remoteNameColWidth (green "Name")
-          <+> fill remoteURLColWidth (green "URL")
-          <+> fill remoteRefValueColWidth (green "Reference value")
-  liftIO $ putDoc $ header <> line
-  liftIO $ putDoc $ vcat $ pretty <$> remoteEntries
-  where
-    isHbs2 (_, b) = Text.isPrefixOf hbs2Prefix b
-
-runToolsScan :: (MonadUnliftIO m,MonadCatch m,MonadMask m,HasStorage (App m)) => RepoRef -> App m ()
-runToolsScan ref = do
-  trace $ "runToolsScan" <+> pretty ref
-  importRefLogNew True ref
-  shutUp
-  pure ()
-
-runToolsGetRefs :: (MonadUnliftIO m,MonadCatch m,MonadMask m) => RepoRef -> App m ()
-runToolsGetRefs ref = do
-  db <- makeDbPath ref >>= dbEnv
-  refs <- withDB db stateGetActualRefs
-  let rh = RepoHead Nothing (HashMap.fromList refs)
-  hPrint stdout $ pretty (AsGitRefsFile rh)
-  shutUp
-
-getRefVal :: (MonadIO m, HasStorage m) => Text -> m (Maybe HashRef)
-getRefVal url =
-  case Text.stripPrefix hbs2Prefix url of
-    Nothing -> do
-      liftIO $ print $ pretty "wrong URL format" <+> pretty url
-      pure Nothing
-    Just refStr -> case fromStringMay $ Text.unpack refStr of
-      Nothing -> do
-        liftIO $ print $ pretty "can't parse ref" <+> pretty refStr
-        pure Nothing
-      Just ref -> do
-        mRefVal <- readRef ref
-        case mRefVal of
-          Nothing -> do
-            liftIO $ print $ pretty "readRef error" <+> pretty ref
-            pure Nothing
-          Just v -> pure $ Just v
-

hbs2-git/lib/HBS2Git/State.hs

@@ -145,7 +145,7 @@ shutdownDB env = liftIO do
     pure conn
   maybe1 co none close
 
-stateInit :: MonadIO m => DB m ()
+stateInit :: (MonadIO m, MonadThrow m) => DB m ()
 stateInit = do
   conn <- stateConnection
   liftIO $ execute_ conn [qc|
@@ -304,7 +304,7 @@ stateInit = do
       let fs = [x | ((_, x, _, _, _, _) :: (Int, String, String, Int, Maybe String, Int)) <- fields ]
       pure ( col `elem` fs )
 
-readOrCreateCookie :: MonadIO m => DB m Cookie
+readOrCreateCookie :: (MonadIO m, MonadThrow m) => DB m Cookie
 readOrCreateCookie = do
   cfn <- cookieFile
   cf <- liftIO $ readFile cfn <&> take 4096

hbs2-git/lib/HBS2Git/Tools.hs

@@ -0,0 +1,306 @@
+module HBS2Git.Tools where
+
+import HBS2.Prelude.Plated
+import HBS2.Base58
+import HBS2.Net.Proto.Types
+import HBS2.Net.Auth.Credentials
+import HBS2.Data.Types.Refs (HashRef)
+import HBS2.OrDie
+
+import HBS2.System.Logger.Simple
+
+import HBS2Git.Types
+import HBS2Git.App
+
+import HBS2.Git.Local.CLI
+import HBS2.Git.Types
+import HBS2Git.Import (importRefLogNew)
+import HBS2Git.Config
+import HBS2Git.State
+import HBS2Git.PrettyStuff
+
+import Data.HashMap.Strict qualified as HashMap
+import Data.ByteString.Char8 qualified as BS8
+import Control.Monad.Trans.Maybe
+import Data.Text qualified as Text
+import Data.Traversable
+import Data.Maybe
+import Prettyprinter.Render.Terminal
+import Control.Monad.IO.Unlift
+import Control.Monad.Catch (MonadCatch,MonadThrow,MonadMask)
+import Data.Generics.Product (field)
+import Lens.Micro.Platform
+import System.FilePath
+import System.Directory
+import System.Process.Typed
+import Text.InterpolatedString.Perl6 (qc)
+import System.FilePattern.Directory
+import System.IO.Temp
+import System.IO (stdout,stderr)
+
+import UnliftIO
+
+data EncryptionOpts =
+  EncryptionOpts
+  { encryptKeyring :: FilePath
+  , encryptKey     :: PubKey 'Encrypt HBS2Basic
+  }
+  deriving stock Generic
+
+data NewRepoOpts =
+  NewRepoOpts
+  { newRepoKeyring      :: Maybe FilePath
+  , newRepoEncryption   :: Maybe (PubKey 'Encrypt HBS2Basic, FilePath)
+  }
+  deriving stock (Generic)
+
+data AsRemoteEntry = AsRemoteEntry
+  { remoteName :: Text,
+    remoteURL :: Text,
+    remoteRefValue :: Maybe HashRef
+  }
+
+remoteNameColWidth :: Int
+remoteNameColWidth = 16
+
+remoteURLColWidth :: Int
+remoteURLColWidth = 51
+
+remoteRefValueColWidth :: Int
+remoteRefValueColWidth = 44
+
+instance Pretty AsRemoteEntry where
+  pretty (AsRemoteEntry {..}) =
+    fill remoteNameColWidth (pretty remoteName)
+      <+> fill remoteURLColWidth (pretty remoteURL)
+      <+> fill remoteRefValueColWidth (maybe "-" pretty remoteRefValue)
+
+hbs2Prefix :: Text
+hbs2Prefix = "hbs2://"
+
+-- TODO: backlog-list-refs-all-option
+--  сделать опцию --all которая выведет
+--  все известные ref-ы из стейта.
+--  Сейчас выводятся только локальные
+
+runListRefs :: (MonadIO m, HasStorage (App m)) => App m ()
+runListRefs = do
+  refs <- gitGetRemotes <&> filter isHbs2
+  remoteEntries <-
+    forM
+      refs
+      ( \(name, url) -> do
+          refVal <- getRefVal url
+          pure $
+            AsRemoteEntry
+              { remoteName = name,
+                remoteURL = url,
+                remoteRefValue = refVal
+              }
+      )
+  let header =
+        fill remoteNameColWidth (green "Name")
+          <+> fill remoteURLColWidth (green "URL")
+          <+> fill remoteRefValueColWidth (green "Reference value")
+  liftIO $ putDoc $ header <> line
+  liftIO $ putDoc $ vcat $ pretty <$> remoteEntries
+  where
+    isHbs2 (_, b) = Text.isPrefixOf hbs2Prefix b
+
+runToolsScan :: (MonadUnliftIO m,MonadCatch m,MonadMask m,HasStorage (App m)) => RepoRef -> App m ()
+runToolsScan ref = do
+  trace $ "runToolsScan" <+> pretty ref
+  importRefLogNew True ref
+  shutUp
+  pure ()
+
+runToolsGetRefs :: (MonadUnliftIO m,MonadCatch m,MonadMask m) => RepoRef -> App m ()
+runToolsGetRefs ref = do
+  db <- makeDbPath ref >>= dbEnv
+  refs <- withDB db stateGetActualRefs
+  let rh = RepoHead Nothing (HashMap.fromList refs)
+  hPrint stdout $ pretty (AsGitRefsFile rh)
+  shutUp
+
+getRefVal :: (MonadIO m, HasStorage m) => Text -> m (Maybe HashRef)
+getRefVal url =
+  case Text.stripPrefix hbs2Prefix url of
+    Nothing -> do
+      liftIO $ print $ pretty "wrong URL format" <+> pretty url
+      pure Nothing
+    Just refStr -> case fromStringMay $ Text.unpack refStr of
+      Nothing -> do
+        liftIO $ print $ pretty "can't parse ref" <+> pretty refStr
+        pure Nothing
+      Just ref -> do
+        mRefVal <- readRef ref
+        case mRefVal of
+          Nothing -> do
+            liftIO $ print $ pretty "readRef error" <+> pretty ref
+            pure Nothing
+          Just v -> pure $ Just v
+
+
+
+runInitRepo :: (MonadUnliftIO m, MonadThrow m, MonadCatch m) => NewRepoOpts -> m ()
+runInitRepo = runInitInteractive
+
+runInitInteractive :: (MonadUnliftIO m, MonadThrow m, MonadCatch m) => NewRepoOpts -> m ()
+runInitInteractive opts = do
+
+  hSetBuffering stdin  NoBuffering
+  hSetBuffering stdout LineBuffering
+
+  conf <- configPath ""
+           `catch`
+            (\NoWorkDirException -> do
+                liftIO $ hPutDoc stderr $ red "init:"
+                                           <+> "No git working directory."
+                                           <+> yellow "Run" <+> "'git init'" <+> "first"
+                                           <> line
+                die "nope"
+            )
+
+  rpc <- (Just <$> detectRPC False)
+           `catch`
+            (\NoRPCException -> do
+                liftIO $ hPutDoc stderr $ yellow "init:"
+                                           <+> "No RPC found."
+                                           <+> "Perhaps, hbs2-peer is down"
+                                           <> line
+                                           <> "Okay, you may add it later"
+                                           <> line
+                pure Nothing
+            )
+
+  let confFile = conf </> "config"
+
+  liftIO $ createDirectoryIfMissing True conf
+
+  confHere <- liftIO $ doesFileExist confFile
+
+  when confHere do
+    liftIO $ hPutDoc stdout $ yellow "Config"
+                           <+> pretty confFile
+                           <+> yellow "is already here."
+                           <+> "Continue? [y/n]: "
+
+    liftIO $ hFlush stdout
+
+    y <- liftIO getChar
+
+    unless (y `elem` "'yY ") do
+      exitFailure
+
+  liftIO $ hPutStrLn stdout ""
+
+  puk <- case view (field @"newRepoKeyring") opts of
+    Just kr -> liftIO do
+      addKeyring confFile kr
+
+    Nothing -> do
+      tmp <- liftIO $ emptyTempFile "." "reflog.key"
+
+      code <- runProcess (shell [qc|hbs2 keyring-new > {tmp}|])
+
+      unless (code == ExitSuccess) do
+        liftIO $ hPutDoc stderr $ red "init:" <+> "can't generate new keyring file" <> line
+        die "nope"
+
+      addKeyring confFile tmp
+
+
+  encrypt <- if isJust (view (field @"newRepoEncryption") opts) then do
+               pure True
+             else do
+               liftIO $ hPutDoc stdout $ yellow "Make reflog" <+> pretty (AsBase58 puk)
+                                         <+> "encrypted?"
+                                         <+> "[y/n]: "
+
+               liftIO $ hFlush stdout
+
+               y2 <- liftIO getChar
+
+               liftIO $ hPutStrLn stdout ""
+
+               pure $ y2 `elem` "'yY "
+
+  when encrypt do
+    let enc = view (field @"newRepoEncryption") opts
+
+    case enc of
+      Just (epuk, fp') -> do
+        fp <- liftIO $ makeAbsolute fp'
+        addDecrypt confFile fp
+        addEncrypted confFile puk epuk
+
+      Nothing -> do
+        tmp <- liftIO $ emptyTempFile "." "cred.key"
+
+        code <- runProcess (shell [qc|hbs2 keyring-new -n1 > {tmp}|])
+
+        fp <- liftIO $ makeAbsolute tmp
+
+        ke <- readPubKeyFrom fp
+        addDecrypt confFile fp
+        addEncrypted confFile puk ke
+
+        pure ()
+
+    pure ()
+
+  liftIO $ hPutDoc stderr $ green "succeed!" <> line <> line
+  liftIO $ readFile confFile >>= putStrLn
+
+  where
+
+    readPubKeyFrom fp = do
+      bs <- liftIO $ BS8.readFile fp
+      cred <- pure (parseCredentials @HBS2Basic (AsCredFile bs))
+               `orDie` [qc|invalid credentials file {fp}|]
+
+      pure (view krPk <$> headMay (view peerKeyring cred))
+               `orDie` [qc|invalid credentials file {fp}|]
+
+    addEncrypted fn puk enc = liftIO do
+
+      appendFile fn $ show $
+        line
+        <> brackets (  "encrypted" <+> dquotes (pretty (AsBase58 puk))
+                      <> line
+                      <> parens ("ttl" <+> pretty 864000)
+                      <> line
+                      <> parens ("owner" <+> dquotes (pretty (AsBase58 enc)))
+                      <> line
+                    )
+        <> line
+
+      pure ()
+
+    addDecrypt fn kf = liftIO do
+      appendFile fn $ show
+                    $ ";; this keyring is a SECRET for encryption/decryption"
+                       <> line
+                       <> ";; move it to a private/safe place"
+                       <> line
+                       <> "decrypt" <+> dquotes (pretty kf)
+                       <> line
+
+    addKeyring fn kr = liftIO do
+      fp <- makeAbsolute kr
+
+      bs <- BS8.readFile fp
+      cred <- pure (parseCredentials @HBS2Basic (AsCredFile bs))
+               `orDie` [qc|invalid credentials file {fp}|]
+
+      let puk = view peerSignPk cred
+
+      liftIO $ hPutDoc stdout $ yellow "Adding reflog" <+> pretty (AsBase58 puk) <> line
+      appendFile fn  $ show $ ";; SECRET keyring for reflog" <+> pretty (AsBase58 puk) <> line
+      appendFile fn  $ show $ ";; move it to a private/safe place" <> line
+      appendFile fn  $ show line
+      appendFile fn  $ show $ "keyring" <+> dquotes (pretty fp) <> line <> line
+
+      pure puk
+
+