simplify base64 to only use ByteString
Note the use of fromString and toString from Data.ByteString.UTF8 dated back to commit9b93278e8a
. 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 that9b93278e8a
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.
This commit is contained in:
parent
985dd38847
commit
3742263c99
7 changed files with 27 additions and 71 deletions
|
@ -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
|
||||
|
|
14
Creds.hs
14
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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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"
|
||||
|
|
2
Test.hs
2
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
|
||||
|
|
|
@ -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'
|
||||
|
|
|
@ -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 :: B.ByteString -> Maybe (B.ByteString)
|
||||
fromB64Maybe = either (const Nothing) Just . B64.decode
|
||||
|
||||
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
|
||||
|
||||
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
|
||||
|
|
Loading…
Reference in a new issue