more groundwork for StatelessOpenPGP

no behavior changes

diff --git a/Crypto.hs b/Crypto.hs
index 7f667a3b0ce0cc3bff66de9d2c2641d249e01012..288042b1be5594bd90234e1cb2152baa9c1f41e8 100644 (file)
--- a/Crypto.hs
+++ b/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

diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 528aa2bca19d1553e9cb481728efc294ff5725ff..884d53d7bf28f1204cf75608803f5d87b6f52241 100644 (file)
--- a/Remote/Helper/Encryptable.hs
+++ b/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)

diff --git a/Test.hs b/Test.hs
index 75a963ca8713b73fb108f40d2666db83e28fe4c3..c8db8147a4c78c9a7a35a6b5405802aba6b4445f 100644 (file)
--- a/Test.hs
+++ b/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"

diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index cb8ecdf003f859d929bfb290c8740b5197b76e95..b8158ea8e6f3ef381b9d7142436ec688f98709f0 100644 (file)
--- a/Types/GitConfig.hs
+++ b/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"

diff --git a/Utility/StatelessOpenPGP.hs b/Utility/StatelessOpenPGP.hs
index 73e3746a3a537ba3c666f9331645bc88967b9b9c..35b4b17ccc9379d9703960ffdc98db8f15c1c789 100644 (file)
--- a/Utility/StatelessOpenPGP.hs
+++ b/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