add GETAVAILABILITY to external special remote protocol

And some reworking of types, and added an annex-availability git config
setting.

22 files changed, 99 insertions, 26 deletions

diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index b9ad975b0..ef1e06594 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -64,7 +64,7 @@ calcSyncRemotes = do
 		, syncingToCloudRemote = any iscloud syncdata
 		}
   where
-  	iscloud r = not (Remote.readonly r) && Remote.globallyAvailable r
+  	iscloud r = not (Remote.readonly r) && Remote.availability r == Remote.GloballyAvailable
 
 {- Updates the syncRemotes list from the list of all remotes in Annex state. -}
 updateSyncRemotes :: Assistant ()
diff --git a/Config.hs b/Config.hs
index 3c6f3faa1..5003c1ce0 100644
--- a/Config.hs
+++ b/Config.hs
@@ -1,6 +1,6 @@
 {- Git configuration
  -
- - 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.
  -}
@@ -13,6 +13,7 @@ import qualified Git.Config
 import qualified Git.Command
 import qualified Annex
 import Config.Cost
+import Types.Availability
 
 type UnqualifiedConfigKey = String
 data ConfigKey = ConfigKey String
@@ -65,6 +66,9 @@ remoteCost' c = case remoteAnnexCostCommand c of
 setRemoteCost :: Git.Repo -> Cost -> Annex ()
 setRemoteCost r c = setConfig (remoteConfig r "cost") (show c)
 
+setRemoteAvailability :: Git.Repo -> Availability -> Annex ()
+setRemoteAvailability r c = setConfig (remoteConfig r "availability") (show c)
+
 getNumCopies :: Maybe Int -> Annex Int
 getNumCopies (Just v) = return v
 getNumCopies Nothing = annexNumCopies <$> Annex.getGitConfig
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
 		}
 
diff --git a/Types/Availability.hs b/Types/Availability.hs
new file mode 100644
index 000000000..f8c8ea3f3
--- /dev/null
+++ b/Types/Availability.hs
@@ -0,0 +1,11 @@
+{- git-annex remote availability
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.Availability where
+
+data Availability = GloballyAvailable | LocallyAvailable
+	deriving (Eq, Show, Read)
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index 8623258a1..cda53f229 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -18,6 +18,7 @@ import qualified Git.Config
 import Utility.DataUnits
 import Config.Cost
 import Types.Distribution
+import Types.Availability
 
 {- Main git-annex settings. Each setting corresponds to a git-config key
  - such as annex.foo -}
@@ -101,6 +102,7 @@ data RemoteGitConfig = RemoteGitConfig
 	, remoteAnnexTrustLevel :: Maybe String
 	, remoteAnnexStartCommand :: Maybe String
 	, remoteAnnexStopCommand :: Maybe String
+	, remoteAnnexAvailability :: Maybe Availability
 
 	{- These settings are specific to particular types of remotes
 	 - including special remotes. -}
@@ -130,6 +132,7 @@ extractRemoteGitConfig r remotename = RemoteGitConfig
 	, remoteAnnexTrustLevel = notempty $ getmaybe "trustlevel"
 	, remoteAnnexStartCommand = notempty $ getmaybe "start-command"
 	, remoteAnnexStopCommand = notempty $ getmaybe "stop-command"
+	, remoteAnnexAvailability = getmayberead "availability"
 
 	, remoteAnnexSshOptions = getoptions "ssh-options"
 	, remoteAnnexRsyncOptions = getoptions "rsync-options"
diff --git a/Types/Remote.hs b/Types/Remote.hs
index 8a94dcc05..2a02d99aa 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -2,12 +2,19 @@
  -
  - Most things should not need this, using Types instead
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Types.Remote where
+module Types.Remote
+	( RemoteConfigKey
+	, RemoteConfig
+	, RemoteTypeA(..)
+	, RemoteA(..)
+	, Availability(..)
+	)
+	where
 
 import Data.Map as M
 import Data.Ord
@@ -16,6 +23,7 @@ import qualified Git
 import Types.Key
 import Types.UUID
 import Types.GitConfig
+import Types.Availability
 import Config.Cost
 import Utility.Metered
 import Git.Types
@@ -82,7 +90,7 @@ data RemoteA a = Remote {
 	-- a Remote can be known to be readonly
 	readonly :: Bool,
 	-- a Remote can be globally available. (Ie, "in the cloud".)
-	globallyAvailable :: Bool,
+	availability :: Availability,
 	-- the type of the remote
 	remotetype :: RemoteTypeA a
 }
diff --git a/debian/changelog b/debian/changelog
index be9e2e695..f4a2e4f9e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,7 +1,7 @@
 git-annex (5.20140108) UNRELEASED; urgency=medium
 
   * Added tahoe special remote.
-  * external special remote protocol: Added GETGITDIR.
+  * external special remote protocol: Added GETGITDIR, and GETAVAILABILITY.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 08 Jan 2014 13:13:54 -0400
 
diff --git a/doc/design/external_special_remote_protocol.mdwn b/doc/design/external_special_remote_protocol.mdwn
index 85df31681..ef09148db 100644
--- a/doc/design/external_special_remote_protocol.mdwn
+++ b/doc/design/external_special_remote_protocol.mdwn
@@ -118,6 +118,11 @@ replying with `UNSUPPORTED-REQUEST` is acceptable.
 * `GETCOST`  
   Requests the remote return a use cost. Higher costs are more expensive.
   (See Config/Cost.hs for some standard costs.)
+* `GETAVAILABILITY`
+  Requests the remote send back an `AVAILABILITY` reply.
+  If the remote replies with `UNSUPPORTED-REQUEST`, its availability
+  is asssumed to be global. So, only remotes that are only reachable
+  locally need to worry about implementing this.
 
 More optional requests may be added, without changing the protocol version,
 so if an unknown request is seen, reply with `UNSUPPORTED-REQUEST`.
@@ -153,6 +158,9 @@ while it's handling a request.
   Indicates that the key was unable to be removed from the remote.
 * `COST Int`  
   Indicates the cost of the remote.
+* `AVAILABILITY GLOBAL|LOCAL`
+  Indicates if the remote is globally or only locally available.
+  (Ie stored in the cloud vs on a local disk.)
 * `INITREMOTE-SUCCESS`  
   Indicates the INITREMOTE succeeded and the remote is ready to use.
 * `INITREMOTE-FAILURE ErrorMsg`  
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 2071f515c..4f802f4e3 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -1297,6 +1297,11 @@ Here are all the supported configuration settings.
   configured by the trust and untrust commands. The value can be any of
   "trusted", "semitrusted" or "untrusted".
 
+* `remote.<name>.availability`
+
+  Can be used to tell git-annex whether a remote is LocallyAvailable
+  or GloballyAvailable. Normally, git-annex determines this automatically.
+
 * `remote.<name>.annex-ssh-options`
 
   Options to use when using ssh to talk to this remote.