From fa7934c035ff09b46d646353683c6d9745f0c94d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 13 Jan 2014 14:41:10 -0400
Subject: add GETAVAILABILITY to external special remote protocol

And some reworking of types, and added an annex-availability git config
setting.
---
 Remote/Bup.hs            |  2 +-
 Remote/Directory.hs      |  2 +-
 Remote/External.hs       | 23 +++++++++++++++++++++--
 Remote/External/Types.hs | 13 +++++++++++++
 Remote/GCrypt.hs         |  2 +-
 Remote/Git.hs            |  2 +-
 Remote/Glacier.hs        |  2 +-
 Remote/Helper/Git.hs     | 16 +++++++++-------
 Remote/Hook.hs           |  2 +-
 Remote/Rsync.hs          |  2 +-
 Remote/S3.hs             |  2 +-
 Remote/Tahoe.hs          |  2 +-
 Remote/Web.hs            |  2 +-
 Remote/WebDAV.hs         |  2 +-
 14 files changed, 54 insertions(+), 20 deletions(-)

(limited to 'Remote')

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 4e89dcff2..370cbc1c0 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -72,7 +72,7 @@ gen r u c gc = do
 			then Just buprepo
 			else Nothing
 		, remotetype = remote
-		, globallyAvailable = not $ bupLocal buprepo
+		, availability = if bupLocal buprepo then LocallyAvailable else GloballyAvailable
 		, readonly = False
 		}
 	return $ Just $ encryptableRemote c
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index e6deee4bf..3cbde7aaf 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -61,7 +61,7 @@ gen r u c gc = do
 			gitconfig = gc,
 			localpath = Just dir,
 			readonly = False,
-			globallyAvailable = False,
+			availability = LocallyAvailable,
 			remotetype = remote
 		}
   where
diff --git a/Remote/External.hs b/Remote/External.hs
index 34810c4ac..26f511551 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -45,6 +45,7 @@ gen r u c gc = do
 	external <- newExternal externaltype u c
 	Annex.addCleanup (fromUUID u) $ stopExternal external
 	cst <- getCost external r gc
+	avail <- getAvailability external r gc
 	return $ Just $ encryptableRemote c
 		(storeEncrypted external $ getGpgEncParams (c,gc))
 		(retrieveEncrypted external)
@@ -66,11 +67,11 @@ gen r u c gc = do
 			repo = r,
 			gitconfig = gc,
 			readonly = False,
-			globallyAvailable = False,
+			availability = avail,
 			remotetype = remote
 		}
   where
-	externaltype = fromMaybe (error "missing externaltype") $ remoteAnnexExternalType gc
+	externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)
 
 externalSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
 externalSetup mu c = do
@@ -419,3 +420,21 @@ getCost external r gc = go =<< remoteCost' gc
 			_ -> Nothing
 		setRemoteCost r c
 		return c
+
+{- Caches the availability in the git config to avoid needing to start up an
+ - external special remote every time time just to ask it what its
+ - availability is.
+ -
+ - Most remotes do not bother to implement a reply to this request;
+ - globally available is the default.
+ -}
+getAvailability :: External -> Git.Repo -> RemoteGitConfig -> Annex Availability
+getAvailability external r gc = maybe query return (remoteAnnexAvailability gc)
+  where
+	query = do
+		avail <- handleRequest external GETAVAILABILITY Nothing $ \req -> case req of
+			AVAILABILITY avail -> Just $ return avail
+			UNSUPPORTED_REQUEST -> Just $ return GloballyAvailable
+			_ -> Nothing
+		setRemoteAvailability r avail
+		return avail
diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs
index c7085e39a..42c71b760 100644
--- a/Remote/External/Types.hs
+++ b/Remote/External/Types.hs
@@ -38,6 +38,7 @@ import Utility.Metered (BytesProcessed(..))
 import Logs.Transfer (Direction(..))
 import Config.Cost (Cost)
 import Types.Remote (RemoteConfig)
+import Types.Availability (Availability(..))
 
 import Data.Char
 import Control.Concurrent.STM
@@ -105,6 +106,7 @@ data Request
 	= PREPARE 
 	| INITREMOTE
 	| GETCOST
+	| GETAVAILABILITY
 	| TRANSFER Direction Key FilePath
 	| CHECKPRESENT Key
 	| REMOVE Key
@@ -120,6 +122,7 @@ instance Sendable Request where
 	formatMessage PREPARE = ["PREPARE"]
 	formatMessage INITREMOTE = ["INITREMOTE"]
 	formatMessage GETCOST = ["GETCOST"]
+	formatMessage GETAVAILABILITY = ["GETAVAILABILITY"]
 	formatMessage (TRANSFER direction key file) =
 		[ "TRANSFER", serialize direction, serialize key, serialize file ]
 	formatMessage (CHECKPRESENT key) = [ "CHECKPRESENT", serialize key ]
@@ -137,6 +140,7 @@ data Response
 	| REMOVE_SUCCESS Key
 	| REMOVE_FAILURE Key ErrorMsg
 	| COST Cost
+	| AVAILABILITY Availability
 	| INITREMOTE_SUCCESS
 	| INITREMOTE_FAILURE ErrorMsg
 	| UNSUPPORTED_REQUEST
@@ -153,6 +157,7 @@ instance Receivable Response where
 	parseCommand "REMOVE-SUCCESS" = parse1 REMOVE_SUCCESS
 	parseCommand "REMOVE-FAILURE" = parse2 REMOVE_FAILURE
 	parseCommand "COST" = parse1 COST
+	parseCommand "AVAILABILITY" = parse1 AVAILABILITY
 	parseCommand "INITREMOTE-SUCCESS" = parse0 INITREMOTE_SUCCESS
 	parseCommand "INITREMOTE-FAILURE" = parse1 INITREMOTE_FAILURE
 	parseCommand "UNSUPPORTED-REQUEST" = parse0 UNSUPPORTED_REQUEST
@@ -252,6 +257,14 @@ instance Serializable Cost where
 	serialize = show
 	deserialize = readish
 
+instance Serializable Availability where
+	serialize GloballyAvailable = "GLOBAL"
+	serialize LocallyAvailable = "LOCAL"
+
+	deserialize "GLOBAL" = Just GloballyAvailable
+	deserialize "LOCAL" = Just LocallyAvailable
+	deserialize _ = Nothing
+
 instance Serializable BytesProcessed where
 	serialize (BytesProcessed n) = show n
 	deserialize = BytesProcessed <$$> readish
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index e1b6811c7..03747314c 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -114,7 +114,7 @@ gen' r u c gc = do
 		, repo = r
 		, gitconfig = gc { remoteGitConfig = Just $ extractGitConfig r }
 		, readonly = Git.repoIsHttp r
-		, globallyAvailable = globallyAvailableCalc r
+		, availability = availabilityCalc r
 		, remotetype = remote
 	}
 	return $ Just $ encryptableRemote c
diff --git a/Remote/Git.hs b/Remote/Git.hs
index d4e5987dc..900b60926 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -126,7 +126,7 @@ gen r u c gc
 			, gitconfig = gc
 				{ remoteGitConfig = Just $ extractGitConfig r }
 			, readonly = Git.repoIsHttp r
-			, globallyAvailable = globallyAvailableCalc r
+			, availability = availabilityCalc r
 			, remotetype = remote
 			}
 
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 300e682a7..78b573506 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -66,7 +66,7 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 			gitconfig = gc,
 			localpath = Nothing,
 			readonly = False,
-			globallyAvailable = True,
+			availability = GloballyAvailable,
 			remotetype = remote
 		}
 
diff --git a/Remote/Helper/Git.hs b/Remote/Helper/Git.hs
index 7c24ff2e7..d76cb2ee7 100644
--- a/Remote/Helper/Git.hs
+++ b/Remote/Helper/Git.hs
@@ -1,6 +1,6 @@
 {- Utilities for git remotes.
  -
- - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -9,18 +9,20 @@ module Remote.Helper.Git where
 
 import Common.Annex
 import qualified Git
+import Types.Availability
 
 repoCheap :: Git.Repo -> Bool
 repoCheap = not . Git.repoIsUrl
 
 localpathCalc :: Git.Repo -> Maybe FilePath
-localpathCalc r = if globallyAvailableCalc r
-	then Nothing
-	else Just $ Git.repoPath r
+localpathCalc r
+	| availabilityCalc r == GloballyAvailable = Nothing
+	| otherwise = Just $ Git.repoPath r
 
-globallyAvailableCalc :: Git.Repo -> Bool
-globallyAvailableCalc r = not $
-	Git.repoIsLocal r || Git.repoIsLocalUnknown r
+availabilityCalc :: Git.Repo -> Availability
+availabilityCalc r
+	| (Git.repoIsLocal r || Git.repoIsLocalUnknown r) = LocallyAvailable
+	| otherwise = GloballyAvailable
 
 {- Avoids performing an action on a local repository that's not usable.
  - Does not check that the repository is still available on disk. -}
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 2d41f51c6..056ad264c 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -59,7 +59,7 @@ gen r u c gc = do
 			repo = r,
 			gitconfig = gc,
 			readonly = False,
-			globallyAvailable = False,
+			availability = GloballyAvailable,
 			remotetype = remote
 		}
   where
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index fd00d4674..409b5b760 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -88,7 +88,7 @@ gen r u c gc = do
 				then Just $ rsyncUrl o
 				else Nothing
 			, readonly = False
-			, globallyAvailable = not islocal
+			, availability = if islocal then LocallyAvailable else GloballyAvailable
 			, remotetype = remote
 			}
 
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 0933f30de..081f7c176 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -69,7 +69,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			gitconfig = gc,
 			localpath = Nothing,
 			readonly = False,
-			globallyAvailable = True,
+			availability = GloballyAvailable,
 			remotetype = remote
 		}
 
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index 6abbeaf5e..6b0113ac3 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -81,7 +81,7 @@ gen r u c gc = do
 		gitconfig = gc,
 		localpath = Nothing,
 		readonly = False,
-		globallyAvailable = True,
+		availability = GloballyAvailable,
 		remotetype = remote
 	}
 
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 0a8df35d5..975279edd 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -61,7 +61,7 @@ gen r _ c gc =
 		localpath = Nothing,
 		repo = r,
 		readonly = True,
-		globallyAvailable = True,
+		availability = GloballyAvailable,
 		remotetype = remote
 	}
 
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index acee624ae..7243e359d 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -72,7 +72,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			gitconfig = gc,
 			localpath = Nothing,
 			readonly = False,
-			globallyAvailable = True,
+			availability = GloballyAvailable,
 			remotetype = remote
 		}
 
-- 
cgit v1.2.3