E variant of external backend keys

Backend/Utilities.hs

@@ -1,17 +1,25 @@
 {- git-annex backend utilities
  -
- - Copyright 2012-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Backend.Utilities where
 
 import Annex.Common
+import qualified Annex
 import Utility.Hash
+import Types.Key
+import Types.KeySource
 
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
+import qualified System.FilePath.ByteString as P
+import Data.Char
+import Data.Word
 
 {- Generates a keyName from an input string. Takes care of sanitizing it.
  - If it's not too long, the full string is used as the keyName.
@@ -32,3 +40,34 @@ genKeyName s
 	sha256len = 64
 	md5len = 32
 
+{- Converts a key to a version that includes an extension from the
+ - file that the key was generated from.  -}
+addE :: KeySource -> (KeyVariety -> KeyVariety) -> Key -> Annex Key
+addE source sethasext k = do
+	maxlen <- annexMaxExtensionLength <$> Annex.getGitConfig
+	let ext = selectExtension maxlen (keyFilename source)
+	return $ alterKey k $ \d -> d
+		{ keyName = keyName d <> ext
+		, keyVariety = sethasext (keyVariety d)
+		}
+
+selectExtension :: Maybe Int -> RawFilePath -> S.ByteString
+selectExtension maxlen f
+	| null es = ""
+	| otherwise = S.intercalate "." ("":es)
+  where
+	es = filter (not . S.null) $ reverse $
+		take 2 $ filter (S.all validInExtension) $
+		takeWhile shortenough $
+		reverse $ S.split (fromIntegral (ord '.')) (P.takeExtensions f)
+	shortenough e = S.length e <= fromMaybe maxExtensionLen maxlen
+
+validInExtension :: Word8 -> Bool
+validInExtension c
+	| isAlphaNum (chr (fromIntegral c)) = True
+	| fromIntegral c == ord '.' = True
+	| c <= 127 = False -- other ascii: spaces, punctuation, control chars
+	| otherwise = True -- utf8 is allowed, also other encodings
+
+maxExtensionLen :: Int
+maxExtensionLen = 4 -- long enough for "jpeg"