From ee011b3cbbe3e78d7af72b450af7eb26b8e74f29 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 29 Jan 2019 13:44:55 -0400
Subject: [PATCH] initremote S3: Automatically enable versioning in S3 buckets
 when configured with versioning=yes.

Needs not yet released version 0.22 of aws library; with older versions
asks the user to configure the bucket versioning themselves.

Note that S3 endpoints that don't support versioning will cause putBucketVersioning
to throw an exception, so initremote will fail.

This commit was sponsored by Jake Vosloo on Patreon.
---
 CHANGELOG    |  4 ++++
 Remote/S3.hs | 35 +++++++++++++++++++++++++++++++++--
 2 files changed, 37 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index bed8582a2f..096deedc4d 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -3,6 +3,10 @@ git-annex (7.20190123) UNRELEASED; urgency=medium
   * S3: Send a Content-Type header when storing objects in S3,
     so exports to public buckets can be linked to from web pages.
     (When git-annex is built with MagicMime support.)
+  * initremote S3: Automatically enable versioning in S3 buckets when configured
+    with versioning=yes. Needs not yet released version 0.22 of aws library;
+    with older versions asks the user to configure the bucket versioning
+    themselves.
 
  -- Joey Hess <id@joeyh.name>  Wed, 23 Jan 2019 12:54:56 -0400
 
diff --git a/Remote/S3.hs b/Remote/S3.hs
index b3248ba7ee..60ab2db486 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -148,6 +148,12 @@ s3Setup' ss u mcreds c gc
 		]
 		
 	use fullconfig = do
+		case ss of
+			Init -> do
+				info <- extractS3Info fullconfig
+				when (versioning info) $
+					enableBucketVersioning (bucket info) fullconfig gc u
+			_ -> return ()
 		gitConfigSpecialRemote u fullconfig [("s3", "true")]
 		return (fullconfig, u)
 
@@ -425,8 +431,8 @@ renameExportS3 u _ Nothing _ _ _ = do
  - UUID file within the bucket.
  -
  - Some ACLs can allow read/write to buckets, but not querying them,
- - so first check if the UUID file already exists and we can skip doing
- - anything.
+ - so first check if the UUID file already exists and we can skip creating
+ - it.
  -}
 genBucket :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
 genBucket c gc u = do
@@ -857,3 +863,28 @@ s3VersionIDPublicUrl mk info (S3VersionID obj vid) = mk info $ concat
 getS3VersionIDPublicUrls :: (S3Info -> BucketObject -> URLString) -> S3Info -> UUID -> Key -> Annex [URLString]
 getS3VersionIDPublicUrls mk info u k =
 	map (s3VersionIDPublicUrl mk info) <$> getS3VersionID u k
+
+-- Enable versioning on the bucket.
+--
+-- This must only be done at init time; setting versioning in a bucket
+-- that git-annex has already exported files to risks losing the content of
+-- those un-versioned files.
+enableBucketVersioning :: S3.Bucket -> RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
+enableBucketVersioning b c gc u = do
+#if MIN_VERSION_aws(0,22,0)
+	showAction "enabling bucket versioning"
+	withS3Handle c gc u $ \h ->
+		void $ sendS3Handle h $ S3.putBucketVersioning b S3.VersioningEnabled
+#else
+	let ConfigKey c = remoteConfig c "s3-versioning-enabled"
+	showLongNote $ unlines
+		[ "This version of git-annex cannot auto-enable S3 bucket versioning."
+		, "You need to manually enable versioning in the S3 console"
+		, "for the bucket \"" ++ T.unpack b ++ "\""
+		, "https://docs.aws.amazon.com/AmazonS3/latest/user-guide/enable-versioning.html"
+		, "It's important you do this before storing anything in the bucket!"
+		]
+#endif
+
+-- 
+-- verifyBucketVersioningEnabled :: Annex Bool