AcquireRepository will configure gpg signature

Port gpg signature logic from bash implementation.

#297

src/Elegit/Cli/Action/AcquireRepository.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase  #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Elegit.Cli.Action.AcquireRepository
     ( cli
@@ -149,9 +150,36 @@ configureAliases cScope = do
             ]
 
 
--- TODO: port bash logic
 setupGPGSignature :: (MonadFree GA.GitF m) => m ()
-setupGPGSignature = pass
+setupGPGSignature = do
+    whenJustM (GA.readConfig GA.LocalConfig (configName UserEmailKey)) $ \userEmail -> do
+        GA.gpgListKeysVerbose userEmail >>= \case
+            Nothing -> do
+                GA.print =<< GA.formatInfo "There is no gpg key for the given email."
+                GA.print =<< GA.formatInfo "A signature is not configured."
+            Just gpgKeysOutput -> do
+                mapM_ GA.print gpgKeysOutput
+                GA.print ""
+                GA.print =<< GA.formatInfo "From the list of GPG keys above, copy the GPG key ID you'd like to use."
+                GA.print =<< GA.formatInfo "It will be"
+                GA.print =<< GA.formatInfo "    3AA5C34371567BD2"
+                GA.print =<< GA.formatInfo "for the output like this"
+                GA.print =<< GA.formatInfo "    sec   4096R/3AA5C34371567BD2 2016-03-10 [expires: 2017-03-10]"
+                GA.print =<< GA.formatInfo "    A330C91F8EC4BC7AECFA63E03AA5C34371567BD2"
+                GA.print =<< GA.formatInfo "    uid                          Hubot"
+                GA.print =<< GA.formatInfo ""
+                GA.print =<< GA.formatInfo "If you don't want to configure signature, just hit Enter button."
+                -- TODO: We could parse IDs out of the gpg output.
+                -- Then could ask for the index into list of keys instead?
+                key <- GA.promptDefault "Please pass a key that has to sign objects of the current repository: " (Just "")
+                if null key
+                   then GA.print =<< GA.formatInfo "The signature is not configured as the empty key is provided."
+                   else do
+                       GA.setConfigVerbose GA.LocalConfig "user.signingkey" key
+                       GA.setConfigVerbose GA.LocalConfig "gpg.program" "$(type -p gpg)"
+                       GA.setConfigVerbose GA.LocalConfig "commit.gpgsign" "true"
+                       GA.setConfigVerbose GA.LocalConfig "tag.forceSignAnnotated" "true"
+                       GA.setConfigVerbose GA.LocalConfig "tag.gpgSign" "true"
 
 
 -- | Execution description of the AcquireRepository action

src/Elegit/Git/Action.hs

@@ -148,6 +148,15 @@ instance RenderGitCommand GAliasesToRemoveData where
                 LocalConfig  -> "--local"
                 AutoConfig   -> ""
 
+newtype GGPGKeyListData
+  = GGPGKeyListData { email :: Text }
+
+instance RenderGitCommand GGPGKeyListData where
+  toolName _ = "gpg"
+
+  commandArgs (GGPGKeyListData gEmail) =
+    ["--list-secret-keys", "--keyid-format", "long", gEmail]
+
 -- | The declaration of all posible actions we can do in the git action.
 --
 -- This describes the data of the action, and whether it can return any value
@@ -165,6 +174,7 @@ data GitF a
   | AliasesToRemove GAliasesToRemoveData (Maybe (NonEmpty Text) -> a)
   | SetConfig GSetConfigData a
   | UnsetConfig GUnsetConfigData a
+  | GPGListKeys GGPGKeyListData (Maybe (NonEmpty Text) -> a)
   | Prompt Text (Maybe Text) (Text -> a)
   | FormatInfo Text (Text -> a)
   | FormatCommand Text (Text -> a)
@@ -241,6 +251,9 @@ setConfig cScope cName cValue = liftF $ SetConfig (GSetConfigData cScope cName c
 unsetConfig :: MonadFree GitF m => ConfigScope -> Text -> m ()
 unsetConfig cScope cName = liftF $ UnsetConfig (GUnsetConfigData cScope cName) ()
 
+gpgListKeys :: MonadFree GitF m => Text -> m (Maybe (NonEmpty Text))
+gpgListKeys gEmail = liftF $ GPGListKeys (GGPGKeyListData gEmail) id
+
 promptDefault :: MonadFree GitF m => Text -> Maybe Text -> m Text
 promptDefault pText pDefault = liftF $ Prompt pText pDefault id
 
@@ -268,6 +281,12 @@ unsetConfigVerbose cScope cName = do
   unsetConfig cScope cName
   print =<< formatGitCommand (GUnsetConfigData cScope cName)
 
+gpgListKeysVerbose :: MonadFree GitF m => Text -> m (Maybe (NonEmpty Text))
+gpgListKeysVerbose gEmail = do
+  gpgKeys <- gpgListKeys gEmail
+  print =<< formatGitCommand (GGPGKeyListData gEmail)
+  return gpgKeys
+
 freshestDefaultBranch :: MonadFree GitF m => m Text
 freshestDefaultBranch = do
     -- TODO: Port bash logic

src/Elegit/Git/Exec.hs

@@ -4,8 +4,8 @@ import           Control.Monad.Catch  as MC
 import           Data.Text            (stripEnd)
 import           Elegit.Git.Action
 import           GHC.IO.Handle        (hFlush)
-import           System.Process.Typed (ExitCode (ExitFailure, ExitSuccess), proc, readProcess)
-import           Universum
+import           System.Process.Typed (ExitCode (ExitFailure, ExitSuccess), ProcessConfig, proc, readProcess)
+import           Universum            as U
 
 
 newtype GitExecT m a
@@ -23,19 +23,25 @@ data GitCommand
   | GCSC GSetConfigData
   | GCUC GUnsetConfigData
   | GCATR GAliasesToRemoveData
+  | GCGKL GGPGKeyListData
+
+
+procText :: Text -> [Text] -> ProcessConfig () () ()
+procText name args = proc (toString name) (toString <$> args)
 
 
 -- TODO: cover with tests
-gitCommandArgs :: GitCommand -> [Text]
-gitCommandArgs (GCCB gc)  = commandArgs gc
-gitCommandArgs (GCBU gc)  = commandArgs gc
-gitCommandArgs (GCL gc)   = "-c":"color.ui=always":commandArgs gc
-gitCommandArgs (GCS gc)   = "-c":"color.status=always":commandArgs gc
-gitCommandArgs (GCSL gc)  = commandArgs gc
-gitCommandArgs (GCRC gc)  = commandArgs gc
-gitCommandArgs (GCSC gc)  = commandArgs gc
-gitCommandArgs (GCUC gc)  = commandArgs gc
-gitCommandArgs (GCATR gc) = commandArgs gc
+procFromCmd :: GitCommand -> ProcessConfig () () ()
+procFromCmd (GCCB gc)  = procText (toolName gc) (commandArgs gc)
+procFromCmd (GCBU gc)  = procText (toolName gc) (commandArgs gc)
+procFromCmd (GCL gc)   = procText (toolName gc) ("-c":"color.ui=always":commandArgs gc)
+procFromCmd (GCS gc)   = procText (toolName gc) ("-c":"color.status=always":commandArgs gc)
+procFromCmd (GCSL gc)  = procText (toolName gc) (commandArgs gc)
+procFromCmd (GCRC gc)  = procText (toolName gc) (commandArgs gc)
+procFromCmd (GCSC gc)  = procText (toolName gc) (commandArgs gc)
+procFromCmd (GCUC gc)  = procText (toolName gc) (commandArgs gc)
+procFromCmd (GCATR gc) = procText (toolName gc) (commandArgs gc)
+procFromCmd (GCGKL gc) = procText (toolName gc) (commandArgs gc)
 
 
 class Monad m => MonadGitExec m where
@@ -46,7 +52,7 @@ class Monad m => MonadGitExec m where
 
 instance MonadIO m => MonadGitExec (GitExecT m) where
   execGit gc = do
-    (eCode, outputBS, _errBS) <- readProcess $ proc "git" (toString <$> gitCommandArgs gc)
+    (eCode, outputBS, _errBS) <- readProcess $ procFromCmd gc
     case eCode of
       -- TODO: Handle error codes per `gc`
       ExitFailure _ -> do

src/Elegit/Git/Runner/Real.hs

@@ -41,6 +41,9 @@ executeGitF arg = case arg of
     stashes <- lines . fromMaybe "" <$> execGit (GCSL gc)
     return $ next stashes
 
+  GA.GPGListKeys gc next -> do
+    mGpgKeys <- execGit (GCGKL gc)
+    return $ next (mGpgKeys >>= nonEmpty . lines)
   GA.AliasesToRemove gc next -> do
     oldAliasesM <- execGit (GCATR gc)
     return $ next (oldAliasesM >>= nonEmpty . lines)

src/Elegit/Git/Runner/Simulated.hs

@@ -156,6 +156,10 @@ collectImpureCommandsF cmd = case cmd of
       [ fmt "stash@{"+||i||+"}: "+|(stash^.gsName)|+" on "+|(stash^.gsBranchName)|+"" | (i, stash) <- zip [(0 :: Int)..] stashes
       ] -- this is excessive, I guess? @teggotic
 
+  GA.GPGListKeys (GA.GGPGKeyListData _email) next -> do
+    -- Ideally we want to see this
+    return $ next (Just ("3AA5C34371567BD2":|[]))
+
   GA.AliasesToRemove (GA.GAliasesToRemoveData cScope) next -> do
     case cScope of
      GA.LocalConfig -> do

test/Elegit/Cli/Action/AcquireRepositorySpec.hs

@@ -89,6 +89,24 @@ signatureOutputBlock =
   [ PrintText "=============================="
   , PrintText "== Configuring signature... =="
   , PrintText "=============================="
+  , PrintText "==>> gpg --list-secret-keys --keyid-format long test"
+  , PrintText "3AA5C34371567BD2"
+  , PrintText ""
+  , PrintText "From the list of GPG keys above, copy the GPG key ID you'd like to use."
+  , PrintText "It will be"
+  , PrintText "    3AA5C34371567BD2"
+  , PrintText "for the output like this"
+  , PrintText "    sec   4096R/3AA5C34371567BD2 2016-03-10 [expires: 2017-03-10]"
+  , PrintText "    A330C91F8EC4BC7AECFA63E03AA5C34371567BD2"
+  , PrintText "    uid                          Hubot"
+  , PrintText ""
+  , PrintText "If you don't want to configure signature, just hit Enter button."
+  , Prompt "Please pass a key that has to sign objects of the current repository:  {}: test"
+  , PrintText "==>> git config --local user.signingkey \"test\""
+  , PrintText "==>> git config --local gpg.program \"$(type -p gpg)\""
+  , PrintText "==>> git config --local commit.gpgsign \"true\""
+  , PrintText "==>> git config --local tag.forceSignAnnotated \"true\""
+  , PrintText "==>> git config --local tag.gpgSign \"true\""
   ]
 
 configuredStandards :: HashMap Text Text
@@ -132,14 +150,23 @@ configuredAliases =
   , ("alias.start-work",         "elegant start-work")
   ]
 
+configuredGpg :: HashMap Text Text
+configuredGpg =
+  [ ("user.signingkey","test")
+  , ("tag.gpgSign","true")
+  , ("gpg.program","$(type -p gpg)")
+  , ("commit.gpgsign","true")
+  , ("tag.forceSignAnnotated","true")
+  ]
+
 spec :: Spec
 spec = do
   describe "cmd" $ do
     it "prepares local git repository for further work" $ do
       let
         repoWithNewConfig = defaultGit
           & gRepository.grConfig %~ union
-            (configuredStandards `union` configuredAliases)
+            (configuredStandards `union` configuredAliases `union` configuredGpg)
 
       runGitActionPure defaultGit AcquireRepository.cmd `shouldBe`
         ( repoWithNewConfig
@@ -176,7 +203,7 @@ spec = do
 
         repoWithNewConfig = git
           & gRepository.grConfig %~ union
-            (configuredStandards `union` configuredAliases)
+            (configuredStandards `union` configuredAliases `union` configuredGpg)
 
       runGitActionPure git AcquireRepository.cmd `shouldBe`
         ( repoWithNewConfig
@@ -211,7 +238,7 @@ spec = do
 
         repoWithNewConfig = git
           & gRepository.grConfig %~ union
-            (configuredStandards `union` configuredAliases)
+            (configuredStandards `union` configuredAliases `union` configuredGpg)
 
       runGitActionPure git AcquireRepository.cmd `shouldBe`
         ( repoWithNewConfig
@@ -248,7 +275,7 @@ spec = do
           & gRepository.grConfig %~
             delete "elegant.acquired"
           & gRepository.grConfig %~ union
-            (configuredStandards `union` configuredAliases)
+            (configuredStandards `union` configuredAliases `union` configuredGpg)
 
       runGitActionPure git AcquireRepository.cmd `shouldBe`
         ( repoWithNewConfig
@@ -287,7 +314,7 @@ spec = do
 
         repoWithNewConfig = git
           & gRepository.grConfig %~ union
-            (configuredStandards `union` configuredAliases)
+            (configuredStandards `union` configuredAliases `union` configuredGpg)
 
       runGitActionPure git AcquireRepository.cmd `shouldBe`
         ( repoWithNewConfig