simplify base64 to only use ByteString

Note the use of fromString and toString from Data.ByteString.UTF8 dated
back to commit 9b93278e8abe1163d53fbf56909d0fe6d7de69e9. Back then it
was using the dataenc package for base64, which operated on Word8 and
String. But with the switch to sandi, it uses ByteString, and indeed
fromB64' and toB64' were already using ByteString without that
complication. So I think there is no risk of such an encoding related
breakage.

I also tested the case that 9b93278e8abe1163d53fbf56909d0fe6d7de69e9
fixed:

	git-annex metadata -s foo='a …' x
	git-annex metadata x
	metadata x
	  foo=a …

In Remote.Helper.Encryptable, it was avoiding using Utility.Base64
because of that UTF8 conversion. Since that's no longer done, it can
just use it now.

diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs
index cde24cdb74dd7ec905dfcf307fd9f22212489d57..d728678e9af428f1f927a4ed52e0e31754b2c261 100644 (file)
--- a/Annex/TaggedPush.hs
+++ b/Annex/TaggedPush.hs
@@ -38,14 +38,14 @@ toTaggedBranch :: UUID -> Maybe String -> Git.Branch -> Git.Ref
 toTaggedBranch u info b = Git.Ref $ S.intercalate "/" $ catMaybes
        [ Just "refs/synced"
        , Just $ fromUUID u
-       , toB64' . encodeBS <$> info
+       , toB64 . encodeBS <$> info
        , Just $ Git.fromRef' $ Git.Ref.base b
        ]
 
-fromTaggedBranch :: Git.Ref -> Maybe (UUID, Maybe String)
+fromTaggedBranch :: Git.Ref -> Maybe (UUID, Maybe S.ByteString)
 fromTaggedBranch b = case splitc '/' $ Git.fromRef b of
        ("refs":"synced":u:info:_base) ->
-               Just (toUUID u, fromB64Maybe info)
+               Just (toUUID u, fromB64Maybe (encodeBS info))
        ("refs":"synced":u:_base) ->
                Just (toUUID u, Nothing)
        _ -> Nothing

diff --git a/Creds.hs b/Creds.hs
index cfc6c3dc831f133bacb6b255777a06875bc22122..e429d796cffa09ddae62d26bd2d7407e658ed646 100644 (file)
--- a/Creds.hs
+++ b/Creds.hs
@@ -100,10 +100,10 @@ setRemoteCredPair' pc encsetup gc storage mcreds = case mcreds of
                cmd <- gpgCmd <$> Annex.getGitConfig
                s <- liftIO $ encrypt cmd (pc, gc) cipher
                        (feedBytes $ L.pack $ encodeCredPair creds)
-                       (readBytesStrictly $ return . S.unpack)
-               storeconfig' key (Accepted (toB64 s))
+                       (readBytesStrictly return)
+               storeconfig' key (Accepted (decodeBS (toB64 s)))
        storeconfig creds key Nothing =
-               storeconfig' key (Accepted (toB64 $ encodeCredPair creds))
+               storeconfig' key (Accepted (decodeBS $ toB64 $ encodeBS $ encodeCredPair creds))
        
        storeconfig' key val = return $ pc
                { parsedRemoteConfigMap = M.insert key (RemoteConfigValue val) (parsedRemoteConfigMap pc)
@@ -129,13 +129,13 @@ getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
                case (getval, mcipher) of
                        (Nothing, _) -> return Nothing
                        (Just enccreds, Just (cipher, storablecipher)) ->
-                               fromenccreds enccreds cipher storablecipher
+                               fromenccreds (encodeBS enccreds) cipher storablecipher
                        (Just bcreds, Nothing) ->
-                               fromcreds $ fromB64 bcreds
+                               fromcreds $ decodeBS $ fromB64 $ encodeBS bcreds
        fromenccreds enccreds cipher storablecipher = do
                cmd <- gpgCmd <$> Annex.getGitConfig
                mcreds <- liftIO $ catchMaybeIO $ decrypt cmd (c, gc) cipher
-                       (feedBytes $ L.pack $ fromB64 enccreds)
+                       (feedBytes $ L.fromStrict $ fromB64 enccreds)
                        (readBytesStrictly $ return . S.unpack)
                case mcreds of
                        Just creds -> fromcreds creds
@@ -146,7 +146,7 @@ getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
                                case storablecipher of
                                        SharedCipher {} -> showLongNote "gpg error above was caused by an old git-annex bug in credentials storage. Working around it.."
                                        _ -> giveup "*** Insecure credentials storage detected for this remote! See https://git-annex.branchable.com/upgrades/insecure_embedded_creds/"
-                               fromcreds $ fromB64 enccreds
+                               fromcreds $ decodeBS $ fromB64 enccreds
        fromcreds creds = case decodeCredPair creds of
                Just credpair -> do
                        writeCacheCredPair credpair storage

diff --git a/Logs/ContentIdentifier/Pure.hs b/Logs/ContentIdentifier/Pure.hs
index 7a0f6c161457159b149e73d7beb122b1431bd97c..bea98f4091c39234c34677ed808b97f4358ade4e 100644 (file)
--- a/Logs/ContentIdentifier/Pure.hs
+++ b/Logs/ContentIdentifier/Pure.hs
@@ -41,7 +41,7 @@ buildContentIdentifierList l = case l of
   where
        buildcid (ContentIdentifier c)
                | S8.any (`elem` [':', '\r', '\n']) c || "!" `S8.isPrefixOf` c =
-                       charUtf8 '!' <> byteString (toB64' c)
+                       charUtf8 '!' <> byteString (toB64 c)
                | otherwise = byteString c
        go [] = mempty
        go (c:[]) = buildcid c
@@ -58,7 +58,7 @@ parseContentIdentifierList = do
        cidparser = do
                b <- A8.takeWhile (/= ':')
                return $ if "!" `S8.isPrefixOf` b
-                       then ContentIdentifier $ fromMaybe b (fromB64Maybe' (S.drop 1 b))
+                       then ContentIdentifier $ fromMaybe b (fromB64Maybe (S.drop 1 b))
                        else ContentIdentifier b
        listparser first rest = ifM A8.atEnd
                ( return (first :| reverse rest)

diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index e0349a2fb63da5d4fc1d7170f7682f3bfde78258..e5f31de69138ba1eaebdb134031902fff55a658e 100644 (file)
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -28,8 +28,6 @@ module Remote.Helper.Encryptable (
 
 import qualified Data.Map as M
 import qualified Data.Set as S
-import qualified "sandi" Codec.Binary.Base64 as B64
-import qualified Data.ByteString as B
 import Control.Concurrent.STM
 
 import Annex.Common
@@ -39,6 +37,7 @@ import Types.Crypto
 import Types.ProposedAccepted
 import qualified Annex
 import Annex.SpecialRemote.Config
+import Utility.Base64
 
 -- Used to ensure that encryption has been set up before trying to
 -- eg, store creds in the remote config that would need to use the
@@ -272,7 +271,7 @@ storeCipher cip = case cip of
        (EncryptedCipher t _ ks) -> addcipher t . storekeys ks cipherkeysField
        (SharedPubKeyCipher t ks) -> addcipher t . storekeys ks pubkeysField
   where
-       addcipher t = M.insert cipherField (Accepted (toB64bs t))
+       addcipher t = M.insert cipherField (Accepted (decodeBS (toB64 (encodeBS t))))
        storekeys (KeyIds l) n = M.insert n (Accepted (intercalate "," l))
 
 {- Extracts an StorableCipher from a remote's configuration. -}
@@ -281,13 +280,13 @@ extractCipher c = case (getRemoteConfigValue cipherField c,
                        (getRemoteConfigValue cipherkeysField c <|> getRemoteConfigValue pubkeysField c),
                        getRemoteConfigValue encryptionField c) of
        (Just t, Just ks, Just HybridEncryption) ->
-               Just $ EncryptedCipher (fromB64bs t) Hybrid (readkeys ks)
+               Just $ EncryptedCipher (decodeBS (fromB64 (encodeBS t))) Hybrid (readkeys ks)
        (Just t, Just ks, Just PubKeyEncryption) ->
-               Just $ EncryptedCipher (fromB64bs t) PubKey (readkeys ks)
+               Just $ EncryptedCipher (decodeBS (fromB64 (encodeBS t))) PubKey (readkeys ks)
        (Just t, Just ks, Just SharedPubKeyEncryption) ->
-               Just $ SharedPubKeyCipher (fromB64bs t) (readkeys ks)
+               Just $ SharedPubKeyCipher (decodeBS (fromB64 (encodeBS t))) (readkeys ks)
        (Just t, Nothing, Just SharedEncryption) ->
-               Just $ SharedCipher (fromB64bs t)
+               Just $ SharedCipher (decodeBS (fromB64 (encodeBS t)))
        _ -> Nothing
   where
        readkeys = KeyIds . splitc ','
@@ -321,14 +320,3 @@ describeCipher c = case c of
        (SharedPubKeyCipher _ ks) -> showkeys ks
   where
        showkeys (KeyIds { keyIds = ks }) = "to gpg keys: " ++ unwords ks
-
-{- Not using Utility.Base64 because these "Strings" are really
- - bags of bytes and that would convert to unicode and not round-trip
- - cleanly. -}
-toB64bs :: String -> String
-toB64bs = w82s . B.unpack . B64.encode . B.pack . s2w8
-
-fromB64bs :: String -> String
-fromB64bs s = either (const bad) (w82s . B.unpack) (B64.decode $ B.pack $ s2w8 s)
-  where
-       bad = giveup "bad base64 encoded data"

diff --git a/Test.hs b/Test.hs
index e6204d4f3eba9dafa728f668d42e32f1a88695fe..9856974d7856da84775a67f22d72ef51ef577a1f 100644 (file)
--- a/Test.hs
+++ b/Test.hs
@@ -77,7 +77,6 @@ import qualified Utility.Hash
 import qualified Utility.Scheduled
 import qualified Utility.Scheduled.QuickCheck
 import qualified Utility.HumanTime
-import qualified Utility.Base64
 import qualified Utility.Tmp.Dir
 import qualified Utility.FileSystemEncoding
 import qualified Utility.Aeson
@@ -184,7 +183,6 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $
        , testProperty "prop_viewPath_roundtrips" Annex.View.prop_viewPath_roundtrips
        , testProperty "prop_view_roundtrips" Annex.View.prop_view_roundtrips
        , testProperty "prop_viewedFile_rountrips" Annex.View.ViewedFile.prop_viewedFile_roundtrips
-       , testProperty "prop_b64_roundtrips" Utility.Base64.prop_b64_roundtrips
        , testProperty "prop_standardGroups_parse" Logs.PreferredContent.prop_standardGroups_parse
        ] ++ map (uncurry testProperty) combos
   where

diff --git a/Types/MetaData.hs b/Types/MetaData.hs
index 7df07a87eb42646103e96b55ad5895e8f67bf99d..316c06a2f7ac4717d83b0535cf2e53c859ffd97a 100644 (file)
--- a/Types/MetaData.hs
+++ b/Types/MetaData.hs
@@ -137,14 +137,14 @@ instance MetaSerializable MetaValue where
        serialize (MetaValue isset v) =
                serialize isset <>
                if B8.any (`elem` [' ', '\r', '\n']) v || "!" `B8.isPrefixOf` v
-                       then "!" <> toB64' v
+                       then "!" <> toB64 v
                        else v
        deserialize b = do
                (isset, b') <- B8.uncons b
                case B8.uncons b' of
                        Just ('!', b'') -> MetaValue
                                <$> deserialize (B8.singleton isset)
-                               <*> fromB64Maybe' b''
+                               <*> fromB64Maybe b''
                        _ -> MetaValue
                                <$> deserialize (B8.singleton isset)
                                <*> pure b'

diff --git a/Utility/Base64.hs b/Utility/Base64.hs
index 32d90668232ef8ce8bbfd9e3c0f682e474844bd4..e2d90d6dac4c2f6fab474961a9cf6d513c78c073 100644 (file)
--- a/Utility/Base64.hs
+++ b/Utility/Base64.hs
@@ -1,55 +1,25 @@
 {- Simple Base64 encoding
  -
- - Copyright 2011-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE PackageImports #-}
-
 module Utility.Base64 where
 
-import Utility.FileSystemEncoding
-import Utility.QuickCheck
 import Utility.Exception
 
-import qualified "sandi" Codec.Binary.Base64 as B64
+import Codec.Binary.Base64 as B64
 import Data.Maybe
 import qualified Data.ByteString as B
-import Data.ByteString.UTF8 (fromString, toString)
-import Data.Char
-
--- | This uses the FileSystemEncoding, so it can be used on Strings
--- that represent filepaths containing arbitrarily encoded characters.
-toB64 :: String -> String
-toB64 = toString . B64.encode . encodeBS
 
-toB64' :: B.ByteString -> B.ByteString
-toB64' = B64.encode
+toB64 :: B.ByteString -> B.ByteString
+toB64 = B64.encode
 
-fromB64Maybe :: String -> Maybe String
-fromB64Maybe s = either (const Nothing) (Just . decodeBS)
-       (B64.decode $ fromString s)
+fromB64Maybe :: B.ByteString -> Maybe (B.ByteString)
+fromB64Maybe = either (const Nothing) Just . B64.decode
 
-fromB64Maybe' :: B.ByteString -> Maybe (B.ByteString)
-fromB64Maybe' = either (const Nothing) Just . B64.decode
-
-fromB64 :: String -> String
+fromB64 :: B.ByteString -> B.ByteString
 fromB64 = fromMaybe bad . fromB64Maybe
   where
        bad = giveup "bad base64 encoded data"
-
-fromB64' :: B.ByteString -> B.ByteString
-fromB64' = fromMaybe bad . fromB64Maybe'
-  where
-       bad = giveup "bad base64 encoded data"
-
--- Only ascii strings are tested, because an arbitrary string may contain
--- characters not encoded using the FileSystemEncoding, which would thus
--- not roundtrip, as decodeBS always generates an output encoded that way.
-prop_b64_roundtrips :: TestableString -> Bool
-prop_b64_roundtrips ts
-       | all (isAscii) s = s == decodeBS (fromB64' (toB64' (encodeBS s)))
-       | otherwise = True
-  where
-       s = fromTestableString ts