S3: Improve diagnostics when a remote is configured with exporttree and versioning, but no S3 version id has been recorded for a key.

When public access is used for the remote, it complained that the user
needed to set creds to use it, which was just wrong.

When creds were being used, it fell back from trying to use the version ID
to just accessing the key in the bucket, which was ok for non-export
remotes, but wrong for buckets.

In both cases, display a hopefully useful warning.

This should only come up when an existing S3 remote has been exported
to, and then later versioning was enabled.

Note that it would perhaps be possible to fall back from trying to use
retrieveKeyFile when it fails and instead use retrieveKeyFileFromExport,
which may work when S3 version ID is missing. But there are problems
with that approach; how to tell when retrieveKeyFile has failed due to this
rather than a network problem etc? Anyway, that approach would only work
until the file in the export got overwritten, and then it would no
longer be accessible. And with versioning enabled, the user wants old
versions of objects to remain accessible, so it seems better to warn
about the problem as soon as possible, so they can go back and add S3
version IDs.

This work is supported by the NIH-funded NICEMAN (ReproNim TR&D3) project.

CHANGELOG

@@ -1,3 +1,10 @@
+git-annex (7.20181206) UNRELEASED; urgency=medium
+
+  * S3: Improve diagnostics when a remote is configured with exporttree and
+    versioning, but no S3 version id has been recorded for a key.
+
+ -- Joey Hess <id@joeyh.name>  Thu, 06 Dec 2018 13:39:16 -0400
+
 git-annex (7.20181205) upstream; urgency=medium
 
   * Make bittorrent special remote work w/o btshowmetainfo installed

Creds.hs

@@ -11,7 +11,7 @@ module Creds (
 	setRemoteCredPair,
 	getRemoteCredPair,
 	getRemoteCredPairFor,
-	warnMissingCredPairFor,
+	missingCredPairFor,
 	getEnvCredPair,
 	writeCreds,
 	readCreds,
@@ -118,12 +118,12 @@ getRemoteCredPairFor :: String -> RemoteConfig -> RemoteGitConfig -> CredPairSto
 getRemoteCredPairFor this c gc storage = go =<< getRemoteCredPair c gc storage
   where
 	go Nothing = do
-		warnMissingCredPairFor this storage
+		warning $ missingCredPairFor this storage
 		return Nothing
 	go (Just credpair) = return $ Just credpair
 
-warnMissingCredPairFor :: String -> CredPairStorage -> Annex ()
+missingCredPairFor :: String -> CredPairStorage -> String
-warnMissingCredPairFor this storage = warning $ unwords
+missingCredPairFor this storage = unwords
 	[ "Set both", loginvar
 	, "and", passwordvar
 	, "to use", this

Remote/S3.hs

@@ -259,15 +259,18 @@ storeHelper info h f object p = case partSize info of
  - out to the file. Would be better to implement a byteRetriever, but
  - that is difficult. -}
 retrieve :: Remote -> RemoteConfig -> S3Info -> Maybe S3Handle -> Retriever
-retrieve r _ info (Just h) = fileRetriever $ \f k p -> do
+retrieve r c info (Just h) = fileRetriever $ \f k p ->
-	loc <- eitherS3VersionID info (uuid r) k (T.pack $ bucketObject info k)
+	eitherS3VersionID info (uuid r) c k (T.pack $ bucketObject info k) >>= \case
-	retrieveHelper info h loc f p
+		Left failreason -> do
+			warning failreason
+			giveup "cannot download content"
+		Right loc -> retrieveHelper info h loc f p
 retrieve r c info Nothing = fileRetriever $ \f k p ->
-	getPublicWebUrls (uuid r) info c k >>= \case
+	getPublicWebUrls' (uuid r) info c k >>= \case
-		[] -> do
+		Left failreason -> do
-			needS3Creds (uuid r)
+			warning failreason
-			giveup "No S3 credentials configured"
+			giveup "cannot download content"
-		us -> unlessM (downloadUrl k p us f) $
+		Right us -> unlessM (downloadUrl k p us f) $
 			giveup "failed to download content"
 
 retrieveHelper :: S3Info -> S3Handle -> (Either S3.Object S3VersionID) -> FilePath -> MeterUpdate -> Annex ()
@@ -292,16 +295,19 @@ remove info h k = do
 	return $ either (const False) (const True) res
 
 checkKey :: Remote -> RemoteConfig -> S3Info -> Maybe S3Handle -> CheckPresent
-checkKey r _ info (Just h) k = do
+checkKey r c info (Just h) k = do
 	showChecking r
-	loc <- eitherS3VersionID info (uuid r) k (T.pack $ bucketObject info k)
+	eitherS3VersionID info (uuid r) c k (T.pack $ bucketObject info k) >>= \case
-	checkKeyHelper info h loc
+		Left failreason -> do
+			warning failreason
+			giveup "cannot check content"
+		Right loc -> checkKeyHelper info h loc
 checkKey r c info Nothing k = 
-	getPublicWebUrls (uuid r) info c k >>= \case
+	getPublicWebUrls' (uuid r) info c k >>= \case
-		[] -> do
+		Left failreason -> do
-			needS3Creds (uuid r)
+			warning failreason
-			giveup "No S3 credentials configured"
+			giveup "cannot check content"
-		us -> do
+		Right us -> do
 			showChecking r
 			let check u = withUrlOptions $ 
 				liftIO . checkBoth u (keySize k)
@@ -347,7 +353,7 @@ storeExportS3 u info (Just h) f k loc p =
 			>>= setS3VersionID info u k
 		return True
 storeExportS3 u _ Nothing _ _ _ _ = do
-	needS3Creds u
+	warning $ needS3Creds u
 	return False
 
 retrieveExportS3 :: UUID -> S3Info -> Maybe S3Handle -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
@@ -360,7 +366,7 @@ retrieveExportS3 u info mh _k loc f p =
 			return True
 		Nothing -> case getPublicUrlMaker info of
 			Nothing -> do
-				needS3Creds u
+				warning $ needS3Creds u
 				return False
 			Just geturl -> Url.withUrlOptions $ 
 				liftIO . Url.download p (geturl exporturl) f
@@ -375,7 +381,7 @@ removeExportS3 _u info (Just h) _k loc =
 			S3.DeleteObject (T.pack $ bucketExportLocation info loc) (bucket info)
 		return $ either (const False) (const True) res
 removeExportS3 u _ Nothing _ _ = do
-	needS3Creds u
+	warning $ needS3Creds u
 	return False
 
 checkPresentExportS3 :: UUID -> S3Info -> Maybe S3Handle -> Key -> ExportLocation -> Annex Bool
@@ -383,7 +389,7 @@ checkPresentExportS3 _u info (Just h) _k loc =
 	checkKeyHelper info h (Left (T.pack $ bucketExportLocation info loc))
 checkPresentExportS3 u info Nothing k loc = case getPublicUrlMaker info of
 	Nothing -> do
-		needS3Creds u
+		warning $ needS3Creds u
 		giveup "No S3 credentials configured"
 	Just geturl -> withUrlOptions $ liftIO . 
 		checkBoth (geturl $ bucketExportLocation info loc) (keySize k)
@@ -403,7 +409,7 @@ renameExportS3 _u info (Just h) _k src dest = catchNonAsync go (\_ -> return Fal
 	srcobject = T.pack $ bucketExportLocation info src
 	dstobject = T.pack $ bucketExportLocation info dest
 renameExportS3 u _ Nothing _ _ _ = do
-	needS3Creds u
+	warning $ needS3Creds u
 	return False
 
 {- Generate the bucket if it does not already exist, including creating the
@@ -523,7 +529,7 @@ withS3Handle :: RemoteConfig -> RemoteGitConfig -> UUID -> (S3Handle -> Annex a)
 withS3Handle c gc u a = withS3HandleMaybe c gc u $ \mh -> case mh of
 	Just h -> a h
 	Nothing -> do
-		needS3Creds u
+		warning $ needS3Creds u
 		giveup "No S3 credentials configured"
 
 withS3HandleMaybe :: RemoteConfig -> RemoteGitConfig -> UUID -> (Maybe S3Handle -> Annex a) -> Annex a
@@ -542,8 +548,8 @@ withS3HandleMaybe c gc u a = do
   where
 	s3cfg = s3Configuration c
 
-needS3Creds :: UUID -> Annex ()
+needS3Creds :: UUID -> String
-needS3Creds u = warnMissingCredPairFor "S3" (AWS.creds u)
+needS3Creds u = missingCredPairFor "S3" (AWS.creds u)
 
 s3Configuration :: RemoteConfig -> S3.S3Configuration AWS.NormalQuery
 s3Configuration c = cfg
@@ -734,19 +740,28 @@ s3Info c info = catMaybes
 	showstorageclass sc = show sc
 
 getPublicWebUrls :: UUID -> S3Info -> RemoteConfig -> Key -> Annex [URLString]
-getPublicWebUrls u info c k
+getPublicWebUrls u info c k = either (const []) id <$> getPublicWebUrls' u info c k
-	| not (public info) = return []
+
+getPublicWebUrls' :: UUID -> S3Info -> RemoteConfig -> Key -> Annex (Either String [URLString])
+getPublicWebUrls' u info c k
+	| not (public info) = return $ Left $ 
+		"S3 bucket does not allow public access; " ++ needS3Creds u
 	| exportTree c = if versioning info
 		then case publicurl info of
-			Just url -> getS3VersionIDPublicUrls (const $ genericPublicUrl url) info u k
+			Just url -> getversionid (const $ genericPublicUrl url)
 			Nothing -> case host info of
 				Just h | h == AWS.s3DefaultHost ->
-					getS3VersionIDPublicUrls awsPublicUrl info u k
+					getversionid awsPublicUrl
-				_ -> return []
+				_ -> return nopublicurl
-		else return []
+		else return (Left "exporttree used without versioning")
 	| otherwise = case getPublicUrlMaker info of
-		Just geturl -> return [geturl $ bucketObject info k]
+		Just geturl -> return (Right [geturl $ bucketObject info k])
-		Nothing -> return []
+		Nothing -> return nopublicurl
+  where
+	nopublicurl = Left "No publicurl is configured for this remote"
+	getversionid url = getS3VersionIDPublicUrls url info u k >>= \case
+		[] -> return (Left "Remote is configured to use versioning, but no S3 version ID is recorded for this key")
+		l -> return (Right l)
 
 getPublicUrlMaker :: S3Info -> Maybe (BucketObject -> URLString)
 getPublicUrlMaker info = case publicurl info of
@@ -813,14 +828,16 @@ getS3VersionID u k = do
 s3VersionField :: MetaField
 s3VersionField = mkMetaFieldUnchecked "V"
 
-eitherS3VersionID :: S3Info -> UUID -> Key -> S3.Object -> Annex (Either S3.Object S3VersionID)
+eitherS3VersionID :: S3Info -> UUID -> RemoteConfig -> Key -> S3.Object -> Annex (Either String (Either S3.Object S3VersionID))
-eitherS3VersionID info u k fallback
+eitherS3VersionID info u c k fallback
 	| versioning info = getS3VersionID u k >>= return . \case
-		[] -> Left fallback
+		[] -> if exportTree c
+			then Left "Remote is configured to use versioning, but no S3 version ID is recorded for this key"
+			else Right (Left fallback)
 		-- It's possible for a key to be stored multiple timees in
 		-- a bucket with different version IDs; only use one of them.
-		(v:_) -> Right v
+		(v:_) -> Right (Right v)
-	| otherwise = return (Left fallback)
+	| otherwise = return (Right (Left fallback))
 
 s3VersionIDPublicUrl :: (S3Info -> BucketObject -> URLString) -> S3Info -> S3VersionID -> URLString
 s3VersionIDPublicUrl mk info (S3VersionID obj vid) = mk info $ concat