split ProvidedInfo and UserProvidedInfo

The latter is for git-annex matchexpression and matching against it can
throw an exception. Splitting out the former reduces the potential for
mistakes and avoids needing to worry about matching against that
throwing an exception.

This is more groundwork for matching largefiles while importing,
without downloading content.

This commit was sponsored by Graham Spencer on Patreon.

Annex/FileMatcher.hs

@@ -195,9 +195,9 @@ mkMatchExpressionParser = do
 		commonKeylessTokens LimitDiskFiles ++
 #ifdef WITH_MAGICMIME
 		[ mimer "mimetype" $
-			matchMagic "mimetype" getMagicMimeType providedMimeType
+			matchMagic "mimetype" getMagicMimeType providedMimeType userProvidedMimeType
 		, mimer "mimeencoding" $
-			matchMagic "mimeencoding" getMagicMimeEncoding providedMimeEncoding
+			matchMagic "mimeencoding" getMagicMimeEncoding providedMimeEncoding userProvidedMimeEncoding
 		]
 #else
 		[ mimer "mimetype"

Annex/Import.hs

@@ -541,15 +541,12 @@ wantImport :: FileMatcher Annex -> ImportLocation -> ByteSize -> Annex Bool
 wantImport matcher loc sz = checkMatcher' matcher mi mempty
   where
 	mi = MatchingInfo $ ProvidedInfo
-		{ providedFilePath = Right $ fromRawFilePath $ fromImportLocation loc
-		, providedKey = unavail "key"
-		, providedFileSize = Right sz
-		, providedMimeType = unavail "mime"
-		, providedMimeEncoding = unavail "mime"
+		{ providedFilePath = fromImportLocation loc
+		, providedKey = Nothing
+		, providedFileSize = sz
+		, providedMimeType = Nothing
+		, providedMimeEncoding = Nothing
 		}
-	-- This should never run, as long as the FileMatcher was generated
-	-- using the preferredContentKeylessTokens.
-	unavail v = Left $ error $ "Internal error: unavailable " ++ v
 
 {- If a file is not preferred content, but it was previously exported or
  - imported to the remote, not importing it would result in a remote

Annex/Ingest.hs

@@ -346,8 +346,8 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi)
 			(pure Nothing)
 			(\tmp -> liftIO $ catchMaybeIO $ fileMode <$> getFileStatus tmp)
 			mtmp
-		stagePointerFile (toRawFilePath file) mode =<< hashPointerFile key
-		Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath (toRawFilePath file))
+		stagePointerFile file' mode =<< hashPointerFile key
+		Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file')
 		case mtmp of
 			Just tmp -> ifM (moveAnnex key tmp)
 				( linkunlocked mode >> return True
@@ -367,23 +367,23 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi)
 	mi = case mtmp of
 		Just tmp -> MatchingFile $ FileInfo
 			{ contentFile = Just (toRawFilePath tmp)
-			, matchFile = toRawFilePath file
+			, matchFile = file'
 			}
 		-- Provide as much info as we can without access to the
-		-- file's content. It's better to provide wrong info
-		-- than for an operation to fail just because it can't
-		-- tell if a file should be unlocked or locked.
+		-- file's content.
 		Nothing -> MatchingInfo $ ProvidedInfo
-			{ providedFilePath = Right file
-			, providedKey = Right key
-			, providedFileSize = Right $ fromMaybe 0 $
+			{ providedFilePath = file'
+			, providedKey = Just key
+			, providedFileSize = fromMaybe 0 $
 				keySize `fromKey` key
-			, providedMimeType = Right "application/octet-stream"
-			, providedMimeEncoding = Right "binary"
+			, providedMimeType = Nothing
+			, providedMimeEncoding = Nothing
 			}
 	
 	linkunlocked mode = linkFromAnnex key file mode >>= \case
 		LinkAnnexFailed -> liftIO $
-			writePointerFile (toRawFilePath file) key mode
+			writePointerFile file' key mode
 		_ -> return ()
-	writepointer mode = liftIO $ writePointerFile (toRawFilePath file) key mode
+	writepointer mode = liftIO $ writePointerFile file' key mode
+
+	file' = toRawFilePath file

Command/MatchExpression.hs

@@ -37,9 +37,9 @@ optParser desc = MatchExpressionOptions
 		( long "largefiles"
 		<> help "parse as annex.largefiles expression"
 		)
-	<*> (MatchingInfo . addkeysize <$> dataparser)
+	<*> (MatchingUserInfo . addkeysize <$> dataparser)
   where
-	dataparser = ProvidedInfo
+	dataparser = UserProvidedInfo
 		<$> optinfo "file" (strOption
 			( long "file" <> metavar paramFile
 			<> help "specify filename to match against"
@@ -65,9 +65,9 @@ optParser desc = MatchExpressionOptions
 		<|> (pure $ Left $ missingdata datadesc)
 	missingdata datadesc = bail $ "cannot match this expression without " ++ datadesc ++ " data"
 	-- When a key is provided, make its size also be provided.
-	addkeysize p = case providedKey p of
+	addkeysize p = case userProvidedKey p of
 		Right k -> case fromKey keySize k of
-			Just sz -> p { providedFileSize = Right sz }
+			Just sz -> p { userProvidedFileSize = Right sz }
 			Nothing -> p
 		Left _ -> p
 

Limit.hs

@@ -117,20 +117,27 @@ matchGlobFile glob = go
   where
 	cglob = compileGlob glob CaseSensative -- memoized
 	go (MatchingFile fi) = pure $ matchGlob cglob (fromRawFilePath (matchFile fi))
-	go (MatchingInfo p) = matchGlob cglob <$> getInfo (providedFilePath p)
+	go (MatchingInfo p) = pure $ matchGlob cglob (fromRawFilePath (providedFilePath p))
+	go (MatchingUserInfo p) = matchGlob cglob <$> getUserInfo (userProvidedFilePath p)
 	go (MatchingKey _ (AssociatedFile Nothing)) = pure False
 	go (MatchingKey _ (AssociatedFile (Just af))) = pure $ matchGlob cglob (fromRawFilePath af)
 
 addMimeType :: String -> Annex ()
-addMimeType = addMagicLimit "mimetype" getMagicMimeType providedMimeType
+addMimeType = addMagicLimit "mimetype" getMagicMimeType providedMimeType userProvidedMimeType
 
 addMimeEncoding :: String -> Annex ()
-addMimeEncoding = addMagicLimit "mimeencoding" getMagicMimeEncoding providedMimeEncoding
+addMimeEncoding = addMagicLimit "mimeencoding" getMagicMimeEncoding providedMimeEncoding userProvidedMimeEncoding
 
-addMagicLimit :: String -> (Magic -> FilePath -> Annex (Maybe String)) -> (ProvidedInfo -> OptInfo String) -> String -> Annex ()
-addMagicLimit limitname querymagic selectprovidedinfo glob = do
+addMagicLimit
+	:: String
+	-> (Magic -> FilePath -> Annex (Maybe String))
+	-> (ProvidedInfo -> Maybe String)
+	-> (UserProvidedInfo -> UserInfo String)
+	-> String
+	-> Annex ()
+addMagicLimit limitname querymagic selectprovidedinfo selectuserprovidedinfo glob = do
 	magic <- liftIO initMagicMime
-	addLimit $ matchMagic limitname querymagic' selectprovidedinfo magic glob
+	addLimit $ matchMagic limitname querymagic' selectprovidedinfo selectuserprovidedinfo magic glob
   where
 	querymagic' magic f = liftIO (isPointerFile (toRawFilePath f)) >>= \case
 		-- Avoid getting magic of a pointer file, which would
@@ -143,8 +150,14 @@ addMagicLimit limitname querymagic selectprovidedinfo glob = do
 				querymagic magic . fromRawFilePath
 			Nothing -> querymagic magic f
 
-matchMagic :: String -> (Magic -> FilePath -> Annex (Maybe String)) -> (ProvidedInfo -> OptInfo String) -> Maybe Magic -> MkLimit Annex
-matchMagic _limitname querymagic selectprovidedinfo (Just magic) glob = 
+matchMagic
+	:: String
+	-> (Magic -> FilePath -> Annex (Maybe String))
+	-> (ProvidedInfo -> Maybe String)
+	-> (UserProvidedInfo -> UserInfo String)
+	-> Maybe Magic
+	-> MkLimit Annex
+matchMagic _limitname querymagic selectprovidedinfo selectuserprovidedinfo (Just magic) glob = 
 	Right $ MatchFiles
 		{ matchAction = const go
 		, matchNeedsFileName = True
@@ -160,9 +173,11 @@ matchMagic _limitname querymagic selectprovidedinfo (Just magic) glob =
 			maybe False (matchGlob cglob)
 				<$> querymagic magic (fromRawFilePath f)
 		Nothing -> return False
-	go (MatchingInfo p) =
-		matchGlob cglob <$> getInfo (selectprovidedinfo p)
-matchMagic limitname _ _ Nothing _ = 
+	go (MatchingInfo p) = pure $
+		maybe False (matchGlob cglob) (selectprovidedinfo p)
+	go (MatchingUserInfo p) =
+		matchGlob cglob <$> getUserInfo (selectuserprovidedinfo p)
+matchMagic limitname _ _ _ Nothing _ = 
 	Left $ "unable to load magic database; \""++limitname++"\" cannot be used"
 
 addUnlocked :: Annex ()
@@ -186,6 +201,7 @@ addLocked = addLimit $ Right $ MatchFiles
 matchLockStatus :: Bool -> MatchInfo -> Annex Bool
 matchLockStatus _ (MatchingKey _ _) = pure False
 matchLockStatus _ (MatchingInfo _) = pure False
+matchLockStatus _ (MatchingUserInfo _) = pure False
 matchLockStatus wantlocked (MatchingFile fi) = case contentFile fi of
 	Just f -> liftIO $ do
 		islocked <- isPointerFile f >>= \case
@@ -256,8 +272,9 @@ limitInDir dir = MatchFiles
   where
 	go (MatchingFile fi) = checkf $ fromRawFilePath $ matchFile fi
 	go (MatchingKey _ (AssociatedFile Nothing)) = return False
-	go (MatchingKey _ (AssociatedFile (Just af))) = checkf (fromRawFilePath af)
-	go (MatchingInfo p) = checkf =<< getInfo (providedFilePath p)
+	go (MatchingKey _ (AssociatedFile (Just af))) = checkf $ fromRawFilePath af
+	go (MatchingInfo p) = checkf $ fromRawFilePath $ providedFilePath p
+	go (MatchingUserInfo p) = checkf =<< getUserInfo (userProvidedFilePath p)
 	checkf = return . elem dir . splitPath . takeDirectory
 
 {- Adds a limit to skip files not believed to have the specified number
@@ -319,6 +336,7 @@ limitLackingCopies approx want = case readish want of
 					fromRawFilePath $ matchFile fi
 				MatchingKey _ _ -> approxNumCopies
 				MatchingInfo {} -> approxNumCopies
+				MatchingUserInfo {} -> approxNumCopies
 		us <- filter (`S.notMember` notpresent)
 			<$> (trustExclude UnTrusted =<< Remote.keyLocations key)
 		return $ numcopies - length us >= needed
@@ -339,10 +357,13 @@ limitUnused = MatchFiles
 	}
   where
  	go _ (MatchingFile _) = return False
-	go _ (MatchingKey k _) = S.member k <$> unusedKeys
-	go _ (MatchingInfo p) = do
-		k <- getInfo (providedKey p)
-		S.member k <$> unusedKeys
+	go _ (MatchingKey k _) = isunused k
+	go _ (MatchingInfo p) = maybe (pure False) isunused (providedKey p)
+	go _ (MatchingUserInfo p) = do
+		k <- getUserInfo (userProvidedKey p)
+		isunused k
+	
+	isunused k = S.member k <$> unusedKeys
 
 {- Limit that matches any version of any file or key. -}
 limitAnything :: MatchFiles Annex
@@ -448,8 +469,10 @@ limitSize lb vs s = case readSize dataUnits s of
 				return $ filesize `vs` Just sz
 			Nothing -> goannexed sz fi
 	go sz _ (MatchingKey key _) = checkkey sz key
-	go sz _ (MatchingInfo p) =
-		getInfo (providedFileSize p) 
+	go sz _ (MatchingInfo p) = return $
+		Just (providedFileSize p) `vs` Just sz
+	go sz _ (MatchingUserInfo p) =
+		getUserInfo (userProvidedFileSize p) 
 			>>= \sz' -> return (Just sz' `vs` Just sz)
 	goannexed sz fi = lookupFileKey fi >>= \case
 		Just key -> checkkey sz key
@@ -520,5 +543,5 @@ lookupFileKey fi = case contentFile fi of
 checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool
 checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a
 checkKey a (MatchingKey k _) = a k
-checkKey a (MatchingInfo p) = a =<< getInfo (providedKey p)
-
+checkKey a (MatchingInfo p) = maybe (return False) a (providedKey p)
+checkKey a (MatchingUserInfo p) = a =<< getUserInfo (userProvidedKey p)

Limit/Wanted.hs

@@ -38,4 +38,5 @@ addPreferredContentLimit a = do
 checkWant :: (AssociatedFile -> Annex Bool) -> MatchInfo -> Annex Bool
 checkWant a (MatchingFile fi) = a (AssociatedFile (Just $ matchFile fi))
 checkWant a (MatchingKey _ af) = a af
-checkWant _ (MatchingInfo {}) = return False
+checkWant a (MatchingInfo p) = a (AssociatedFile (Just $ providedFilePath p))
+checkWant _ (MatchingUserInfo {}) = return False

Types/FileMatcher.hs

@@ -1,6 +1,6 @@
 {- git-annex file matcher types
  -
- - Copyright 2013-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -23,6 +23,7 @@ data MatchInfo
 	= MatchingFile FileInfo
 	| MatchingKey Key AssociatedFile
 	| MatchingInfo ProvidedInfo
+	| MatchingUserInfo UserProvidedInfo
 
 data FileInfo = FileInfo
 	{ contentFile :: Maybe RawFilePath
@@ -32,23 +33,32 @@ data FileInfo = FileInfo
 	-- ^ filepath to match on; may be relative to top of repo or cwd
 	}
 
--- This is used when testing a matcher, with values to match against
--- provided in some way, rather than queried from files on disk.
 data ProvidedInfo = ProvidedInfo
-	{ providedFilePath :: OptInfo FilePath
-	, providedKey :: OptInfo Key
-	, providedFileSize :: OptInfo FileSize
-	, providedMimeType :: OptInfo MimeType
-	, providedMimeEncoding :: OptInfo MimeEncoding
+	{ providedFilePath :: RawFilePath
+	, providedKey :: Maybe Key
+	, providedFileSize :: FileSize
+	, providedMimeType :: Maybe MimeType
+	, providedMimeEncoding :: Maybe MimeEncoding
 	}
 
-type OptInfo a = Either (IO a) a
+-- This is used when testing a matcher, with values to match against
+-- provided by the user.
+data UserProvidedInfo = UserProvidedInfo
+	{ userProvidedFilePath :: UserInfo FilePath
+	, userProvidedKey :: UserInfo Key
+	, userProvidedFileSize :: UserInfo FileSize
+	, userProvidedMimeType :: UserInfo MimeType
+	, userProvidedMimeEncoding :: UserInfo MimeEncoding
+	}
 
--- If the OptInfo is not available, accessing it may result in eg an
+-- This may fail if the user did not provide the information.
+type UserInfo a = Either (IO a) a
+
+-- If the UserInfo is not available, accessing it may result in eg an
 -- exception being thrown.
-getInfo :: MonadIO m => OptInfo a -> m a
-getInfo (Right i) = return i
-getInfo (Left e) = liftIO e
+getUserInfo :: MonadIO m => UserInfo a -> m a
+getUserInfo (Right i) = return i
+getUserInfo (Left e) = liftIO e
 
 type FileMatcherMap a = M.Map UUID (FileMatcher a)