added GETWANTED, SETWANTED for Tobias's flickr remote

This was unexpectedly difficult because of a depdenency cycle. To parse a
preferred content expression involves several things that need to operate
on the list of remotes. Which needs Remote.External. The only way to avoid
this cycle (I tried breaking it at several points) was to skip parsing the
expression in SETWANTED.

That's sorta ok, because git-annex already has to deal with unparsable
preferred content expressions being stored, in order to handle eg,
upgrades. But I'm still not very happy that I cannot check it.

I feel this is a strong indication that I need to beware of further
bloating the special remote protocol interface.

2 files changed, 18 insertions, 4 deletions

diff --git a/Remote/External.hs b/Remote/External.hs
index 3a567d834..f682d242d 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -18,6 +18,7 @@ import Remote.Helper.Encryptable
 import Crypto
 import Utility.Metered
 import Logs.Transfer
+import Logs.PreferredContent.Raw
 import Config.Cost
 import Annex.Content
 import Annex.UUID
@@ -206,7 +207,7 @@ handleRequest' lck external req mp responsehandler
 	handleRemoteRequest (PROGRESS bytesprocessed) =
 		maybe noop (\a -> liftIO $ a bytesprocessed) mp
 	handleRemoteRequest (DIRHASH k) = 
-		sendMessage lck external $ VALUE $ hashDirMixed k
+		send $ VALUE $ hashDirMixed k
 	handleRemoteRequest (SETCONFIG setting value) =
 		liftIO $ atomically $ do
 			let v = externalConfig external
@@ -215,7 +216,7 @@ handleRequest' lck external req mp responsehandler
 	handleRemoteRequest (GETCONFIG setting) = do
 		value <- fromMaybe "" . M.lookup setting
 			<$> liftIO (atomically $ readTMVar $ externalConfig external)
-		sendMessage lck external $ VALUE value
+		send $ VALUE value
 	handleRemoteRequest (SETCREDS setting login password) = do
 		c <- liftIO $ atomically $ readTMVar $ externalConfig external
 		c' <- setRemoteCredPair' c (credstorage setting)
@@ -225,14 +226,22 @@ handleRequest' lck external req mp responsehandler
 		c <- liftIO $ atomically $ readTMVar $ externalConfig external
 		creds <- fromMaybe ("", "") <$> 
 			getRemoteCredPair c (credstorage setting)
-		sendMessage lck external $ CREDS (fst creds) (snd creds)
-	handleRemoteRequest GETUUID = sendMessage lck external $
+		send $ CREDS (fst creds) (snd creds)
+	handleRemoteRequest GETUUID = send $
 		VALUE $ fromUUID $ externalUUID external
+	handleRemoteRequest (SETWANTED expr) =
+		preferredContentSet (externalUUID external) expr
+	handleRemoteRequest GETWANTED = do
+		expr <- fromMaybe "" . M.lookup (externalUUID external)
+			<$> preferredContentMapRaw
+		send $ VALUE expr
 	handleRemoteRequest (VERSION _) =
 		sendMessage lck external $ ERROR "too late to send VERSION"
 
 	handleAsyncMessage (ERROR err) = error $ "external special remote error: " ++ err
 
+	send = sendMessage lck external
+
 	credstorage setting = CredPairStorage
 		{ credPairFile = base
 		, credPairEnvironment = (base ++ "login", base ++ "password")
diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs
index 40bd8d52e..e925f0e91 100644
--- a/Remote/External/Types.hs
+++ b/Remote/External/Types.hs
@@ -33,6 +33,7 @@ module Remote.External.Types (
 import Common.Annex
 import Annex.Exception
 import Types.Key (file2key, key2file)
+import Types.StandardGroups (PreferredContentExpression)
 import Utility.Metered (BytesProcessed(..))
 import Logs.Transfer (Direction(..))
 import Config.Cost (Cost)
@@ -167,6 +168,8 @@ data RemoteRequest
 	| SETCREDS Setting String String
 	| GETCREDS Setting
 	| GETUUID
+	| SETWANTED PreferredContentExpression
+	| GETWANTED
 	deriving (Show)
 
 instance Receivable RemoteRequest where
@@ -178,6 +181,8 @@ instance Receivable RemoteRequest where
 	parseCommand "SETCREDS" = parse3 SETCREDS
 	parseCommand "GETCREDS" = parse1 GETCREDS
 	parseCommand "GETUUID" = parse0 GETUUID
+	parseCommand "SETWANTED" = parse1 SETWANTED
+	parseCommand "GETWANTED" = parse0 GETWANTED
 	parseCommand _ = parseFail
 
 -- Responses to RemoteRequest.