more groundwork for StatelessOpenPGP

no behavior changes

Crypto.hs

@@ -3,7 +3,7 @@
  - Currently using gpg; could later be modified to support different
  - crypto backends if necessary.
  -
- - Copyright 2011-2023 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -43,6 +43,7 @@ import Control.Monad.IO.Class
 
 import Annex.Common
 import qualified Utility.Gpg as Gpg
+import qualified Utility.StatelessOpenPGP as SOP
 import Types.Crypto
 import Types.Remote
 import Types.Key
@@ -195,7 +196,6 @@ readBytes a h = liftIO (L.hGetContents h) >>= a
 readBytesStrictly :: (MonadIO m) => (S.ByteString -> m a) -> Reader m a
 readBytesStrictly a h = liftIO (S.hGetContents h) >>= a
 
-
 {- Runs a Feeder action, that generates content that is symmetrically
  - encrypted with the Cipher (unless it is empty, in which case
  - public-key encryption is used) using the given gpg options, and then

Remote/Helper/Encryptable.hs

@@ -158,18 +158,18 @@ parseMac (Just (Proposed s)) = case readMac s of
 encryptionSetup :: RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, EncryptionIsSetup)
 encryptionSetup c gc = do
 	pc <- either giveup return $ parseEncryptionConfig c
-	cmd <- gpgCmd <$> Annex.getGitConfig
-	maybe (genCipher pc cmd) (updateCipher pc cmd) (extractCipher pc)
+	gpgcmd <- gpgCmd <$> Annex.getGitConfig
+	maybe (genCipher pc gpgcmd) (updateCipher pc gpgcmd) (extractCipher pc)
   where
 	-- The type of encryption
 	encryption = parseEncryptionMethod (fromProposedAccepted <$> M.lookup encryptionField c) c
 	-- Generate a new cipher, depending on the chosen encryption scheme
-	genCipher pc cmd = case encryption of
+	genCipher pc gpgcmd = case encryption of
 		Right NoneEncryption -> return (c, NoEncryption)
-		Right SharedEncryption -> encsetup $ genSharedCipher cmd
-		Right HybridEncryption -> encsetup $ genEncryptedCipher cmd (pc, gc) key Hybrid
-		Right PubKeyEncryption -> encsetup $ genEncryptedCipher cmd (pc, gc) key PubKey
-		Right SharedPubKeyEncryption -> encsetup $ genSharedPubKeyCipher cmd key
+		Right SharedEncryption -> encsetup $ genSharedCipher gpgcmd
+		Right HybridEncryption -> encsetup $ genEncryptedCipher gpgcmd (pc, gc) key Hybrid
+		Right PubKeyEncryption -> encsetup $ genEncryptedCipher gpgcmd (pc, gc) key PubKey
+		Right SharedPubKeyEncryption -> encsetup $ genSharedPubKeyCipher gpgcmd key
 		Left err -> giveup err
 	key = maybe (giveup "Specify keyid=...") fromProposedAccepted $
 		M.lookup (Accepted "keyid") c
@@ -177,13 +177,13 @@ encryptionSetup c gc = do
 		maybe [] (\k -> [(False,fromProposedAccepted k)]) (M.lookup (Accepted "keyid-") c)
 	cannotchange = giveup "Cannot set encryption type of existing remotes."
 	-- Update an existing cipher if possible.
-	updateCipher pc cmd v = case v of
+	updateCipher pc gpgcmd v = case v of
 		SharedCipher _ | encryption == Right SharedEncryption ->
 			return (c', EncryptionIsSetup)
 		EncryptedCipher _ variant _ | sameasencryption variant ->
-			use "encryption update" $ updateCipherKeyIds cmd (pc, gc) newkeys v
+			use "encryption update" $ updateCipherKeyIds gpgcmd (pc, gc) newkeys v
 		SharedPubKeyCipher _ _ ->
-			use "encryption update" $ updateCipherKeyIds cmd (pc, gc) newkeys v
+			use "encryption update" $ updateCipherKeyIds gpgcmd (pc, gc) newkeys v
 		_ -> cannotchange
 	sameasencryption variant = case encryption of
 		Right HybridEncryption -> variant == Hybrid
@@ -236,8 +236,8 @@ remoteCipher' c gc = case extractCipher c of
 				(go cachev encipher)
   where
 	go cachev encipher cache = do
-		cmd <- gpgCmd <$> Annex.getGitConfig
-		cipher <- liftIO $ decryptCipher cmd (c, gc) encipher
+		gpgcmd <- gpgCmd <$> Annex.getGitConfig
+		cipher <- liftIO $ decryptCipher gpgcmd (c, gc) encipher
 		liftIO $ atomically $ putTMVar cachev $
 			M.insert encipher cipher cache
 		return $ Just (cipher, encipher)

Test.hs

@@ -1835,7 +1835,7 @@ test_sop_crypto = do
 	case filter (\(k, _) -> k == ck) gc of
 		[] -> noop
 		((_, sopcmd):_) -> go $ 
-			Utility.StatelessOpenPGP.SopCmd $
+			Utility.StatelessOpenPGP.SOPCmd $
 				Git.Types.fromConfigValue sopcmd
   where
 	ck = fromString "annex.shared-sop-command"

Types/GitConfig.hs

@@ -47,6 +47,7 @@ import Types.View
 import Config.DynamicConfig
 import Utility.HumanTime
 import Utility.Gpg (GpgCmd, mkGpgCmd)
+import Utility.StatelessOpenPGP (SOPCmd(..))
 import Utility.ThreadScheduler (Seconds(..))
 import Utility.Url (Scheme, mkScheme)
 
@@ -372,7 +373,7 @@ data RemoteGitConfig = RemoteGitConfig
 	, remoteAnnexRsyncTransport :: [String]
 	, remoteAnnexGnupgOptions :: [String]
 	, remoteAnnexGnupgDecryptOptions :: [String]
-	, remoteAnnexSharedSOPCommand :: Maybe String
+	, remoteAnnexSharedSOPCommand :: Maybe SOPCmd
 	, remoteAnnexSharedSOPProfile :: Maybe String
 	, remoteAnnexRsyncUrl :: Maybe String
 	, remoteAnnexBupRepo :: Maybe String
@@ -441,7 +442,8 @@ extractRemoteGitConfig r remotename = do
 		, remoteAnnexRsyncTransport = getoptions "rsync-transport"
 		, remoteAnnexGnupgOptions = getoptions "gnupg-options"
 		, remoteAnnexGnupgDecryptOptions = getoptions "gnupg-decrypt-options"
-		, remoteAnnexSharedSOPCommand = notempty $ getmaybe "shared-sop-command"
+		, remoteAnnexSharedSOPCommand = SOPCmd <$>
+			notempty (getmaybe "shared-sop-command")
 		, remoteAnnexSharedSOPProfile = notempty $ getmaybe "shared-sop-profile"
 		, remoteAnnexRsyncUrl = notempty $ getmaybe "rsyncurl"
 		, remoteAnnexBupRepo = getmaybe "buprepo"

Utility/StatelessOpenPGP.hs

@@ -8,7 +8,7 @@
 {-# LANGUAGE CPP, OverloadedStrings #-}
 
 module Utility.StatelessOpenPGP (
-	SopCmd(..),
+	SOPCmd(..),
 	SopSubCmd,
 	Password,
 	Profile,
@@ -34,7 +34,7 @@ import Control.Monad.IO.Class
 import qualified Data.ByteString as B
 
 {- The command to run, eq sqop. -}
-newtype SopCmd = SopCmd { unSopCmd :: String }
+newtype SOPCmd = SOPCmd { unSOPCmd :: String }
 
 {- The subcommand to run eg encrypt. -}
 type SopSubCmd = String
@@ -67,7 +67,7 @@ newtype EmptyDirectory = EmptyDirectory FilePath
 {- Encrypt using symmetric encryption with the specified password. -}
 encryptSymmetric
 	:: (MonadIO m, MonadMask m)
-	=> SopCmd
+	=> SOPCmd
 	-> Password
 	-> EmptyDirectory
 	-> Maybe Profile
@@ -91,7 +91,7 @@ encryptSymmetric sopcmd password emptydirectory mprofile armoring feeder reader
 {- Deccrypt using symmetric encryption with the specified password. -}
 decryptSymmetric
 	:: (MonadIO m, MonadMask m)
-	=> SopCmd
+	=> SOPCmd
 	-> Password
 	-> EmptyDirectory
 	-> (Handle -> IO ())
@@ -101,7 +101,7 @@ decryptSymmetric sopcmd password emptydirectory feeder reader =
 	feedRead sopcmd "decrypt" [] password emptydirectory feeder reader
 
 {- Test a value round-trips through symmetric encryption and decryption. -}
-test_encrypt_decrypt_Symmetric :: SopCmd -> SopCmd -> Password -> Armoring -> B.ByteString -> IO Bool
+test_encrypt_decrypt_Symmetric :: SOPCmd -> SOPCmd -> Password -> Armoring -> B.ByteString -> IO Bool
 test_encrypt_decrypt_Symmetric a b password armoring v = catchBoolIO $
 	withTmpDir "test" $ \d -> do
 		let ed = EmptyDirectory d
@@ -120,7 +120,7 @@ test_encrypt_decrypt_Symmetric a b password armoring v = catchBoolIO $
  - Note that the reader must fully consume its input before returning. -}
 feedRead
 	:: (MonadIO m, MonadMask m)
-	=> SopCmd
+	=> SOPCmd
 	-> SopSubCmd
 	-> [CommandParam]
 	-> Password
@@ -165,14 +165,14 @@ feedRead cmd subcmd params password emptydirectory feeder reader = do
 {- Like feedRead, but without password. -}
 feedRead'
 	:: (MonadIO m, MonadMask m)
-	=> SopCmd
+	=> SOPCmd
 	-> SopSubCmd
 	-> [CommandParam]
 	-> Maybe EmptyDirectory
 	-> (Handle -> IO ())
 	-> (Handle -> m a)
 	-> m a
-feedRead' (SopCmd cmd) subcmd params med feeder reader = do
+feedRead' (SOPCmd cmd) subcmd params med feeder reader = do
 	let p = (proc cmd (subcmd:toCommand params))
 		{ std_in = CreatePipe
 		, std_out = CreatePipe