basic data types and serialization for external special remote protocol

This is mostly straightforward, but did turn out quite nicely stronly
typed, and with a quite nice automatic tokenization and parsing of received
messages.

Made a few minor changes to the protocol to clear up ambiguities and make
it easier to parse. Note particularly that setting remote configuration
is moved to a separate command, which allows a remote to set arbitrary data.

2 files changed, 269 insertions, 12 deletions

diff --git a/Remote/External.hs b/Remote/External.hs
new file mode 100644
index 000000000..c3297c7ea
--- /dev/null
+++ b/Remote/External.hs
@@ -0,0 +1,252 @@
+{- External special remote interface.
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+
+module Remote.External (remote) where
+
+import Data.Char
+
+import Common.Annex
+import Types.Remote
+import Types.Key
+import qualified Git
+import Config
+import Remote.Helper.Special
+import Remote.Helper.Encryptable
+import Crypto
+import Utility.Metered
+import Logs.Transfer
+import Config.Cost
+
+remote :: RemoteType
+remote = RemoteType {
+	typename = "hook",
+	enumerate = findSpecialRemotes "hooktype",
+	generate = gen,
+	setup = undefined
+}
+
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
+gen r u c gc = do
+	cst <- remoteCost gc expensiveRemoteCost
+	return $ Just $ encryptableRemote c
+		(storeEncrypted $ getGpgEncParams (c,gc))
+		retrieveEncrypted
+		Remote {
+			uuid = u,
+			cost = cst,
+			name = Git.repoDescribe r,
+			storeKey = store,
+			retrieveKeyFile = retrieve,
+			retrieveKeyFileCheap = retrieveCheap,
+			removeKey = remove,
+			hasKey = checkPresent r,
+			hasKeyCheap = False,
+			whereisKey = Nothing,
+			remoteFsck = Nothing,
+			repairRepo = Nothing,
+			config = c,
+			localpath = Nothing,
+			repo = r,
+			gitconfig = gc,
+			readonly = False,
+			globallyAvailable = False,
+			remotetype = remote
+		}
+
+store :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
+store k _f _p = undefined
+
+storeEncrypted :: [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeEncrypted gpgOpts (cipher, enck) k _p = undefined
+
+retrieve :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+retrieve k _f d _p = undefined
+
+retrieveCheap :: Key -> FilePath -> Annex Bool
+retrieveCheap _ _ = undefined
+
+retrieveEncrypted :: (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+retrieveEncrypted (cipher, enck) _ f _p = undefined
+
+remove :: Key -> Annex Bool
+remove k = undefined
+
+checkPresent :: Git.Repo -> Key -> Annex (Either String Bool)
+checkPresent r k = undefined
+
+-- Messages that git-annex can send.
+class Sendable m where
+	formatMessage :: m -> [String]
+
+-- Messages that git-annex can receive.
+class Receivable m where
+	-- Passed the first word of the message, returns
+	-- a Parser that can be be fed the rest of the message to generate
+	-- the value.
+	parseCommand :: String -> Parser m
+
+parseMessage :: (Receivable m) => String -> Maybe m
+parseMessage s = parseCommand command rest
+  where
+	(command, rest) = splitWord s
+
+-- Messages that can be sent to the external remote to request it do something.
+data Request 
+	= PREPARE 
+	| INITREMOTE
+	| GETCOST
+	| TRANSFER Direction Key FilePath
+	| CHECKPRESENT Key
+	| REMOVE Key
+	deriving (Show)
+
+instance Sendable Request where
+	formatMessage PREPARE = ["PREPARE"]
+	formatMessage INITREMOTE = ["INITREMOTE"]
+	formatMessage GETCOST = ["GETCOST"]
+	formatMessage (TRANSFER direction key file) =
+		[ "TRANSFER", serialize direction, serialize key, serialize file ]
+	formatMessage (CHECKPRESENT key) = [ "CHECKPRESENT", serialize key ]
+	formatMessage (REMOVE key) = [ "REMOVE", serialize key ]
+
+-- Responses the external remote can make to requests.
+data Response
+	= PREPARE_SUCCESS
+	| TRANSFER_SUCCESS Direction Key
+	| TRANSFER_FAILURE Direction Key ErrorMsg
+	| CHECKPRESENT_SUCCESS Key
+	| CHECKPRESENT_FAILURE Key
+	| CHECKPRESENT_UNKNOWN Key ErrorMsg
+	| REMOVE_SUCCESS Key
+	| REMOVE_FAILURE Key ErrorMsg
+	| COST Cost
+	| COST_UNKNOWN
+	| INITREMOTE_SUCCESS
+	| INITREMOTE_FAILURE ErrorMsg
+	deriving (Show)
+
+instance Receivable Response where
+	parseCommand "PREPARE-SUCCESS" = parse0 PREPARE_SUCCESS
+	parseCommand "TRANSFER-SUCCESS" = parse2 TRANSFER_SUCCESS
+	parseCommand "TRANSFER-FAILURE" = parse3 TRANSFER_FAILURE
+	parseCommand "CHECKPRESENT-SUCCESS" = parse1 CHECKPRESENT_SUCCESS
+	parseCommand "CHECKPRESENT-FAILURE" = parse1 CHECKPRESENT_FAILURE
+	parseCommand "CHECKPRESENT-UNKNOWN" = parse2 CHECKPRESENT_UNKNOWN
+	parseCommand "REMOVE-SUCCESS" = parse1 REMOVE_SUCCESS
+	parseCommand "REMOVE-FAILURE" = parse2 REMOVE_FAILURE
+	parseCommand "COST" = parse1 COST
+	parseCommand "COST_UNKNOWN" = parse0 COST_UNKNOWN
+	parseCommand "INITREMOTE-SUCCESS" = parse0 INITREMOTE_SUCCESS
+	parseCommand "INITREMOTE-FAILURE" = parse1 INITREMOTE_FAILURE
+	parseCommand _ = parseFail
+
+-- Requests that the external remote can send at any time it's in control.
+data RemoteRequest
+	= VERSION Int
+	| PROGRESS Direction Key Int
+	| DIRHASH Key
+	| SETCONFIG Setting String
+	| GETCONFIG Setting
+	| SETSTATE Key String
+	| GETSTATE Key
+	deriving (Show)
+
+instance Receivable RemoteRequest where
+	parseCommand "VERSION" = parse1 VERSION
+	parseCommand "PROGRESS" = parse3 PROGRESS
+	parseCommand "DIRHASH" = parse1 DIRHASH
+	parseCommand "SETCONFIG" = parse2 SETCONFIG
+	parseCommand "GETCONFIG" = parse1 GETCONFIG
+	parseCommand "SETSTATE" = parse2 SETSTATE
+	parseCommand "GETSTATE" = parse1 GETSTATE
+	parseCommand _ = parseFail
+
+-- Responses to RemoteRequest.
+data RemoteResponse
+	= VALUE String
+	deriving (Show)
+
+instance Sendable RemoteResponse where
+	formatMessage (VALUE s) = [ "VALUE", serialize s ]
+
+-- Messages that can be sent at any time by either git-annex or the remote.
+data AsyncMessages 
+	= ERROR ErrorMsg
+	deriving (Show)
+
+instance Sendable AsyncMessages where
+	formatMessage (ERROR err) = [ "ERROR", serialize err ]
+
+instance Receivable AsyncMessages where
+	parseCommand "ERROR" = parse1 ERROR
+	parseCommand _ = parseFail
+
+-- Data types used for parameters when communicating with the remote.
+-- All are serializable.
+type ErrorMsg = String
+type Setting = String
+
+class Serializable a where
+	serialize :: a -> String
+	deserialize :: String -> Maybe a
+
+instance Serializable Direction where
+	serialize Upload = "STORE"
+	serialize Download = "RETRIEVE"
+
+	deserialize "STORE" = Just Upload
+	deserialize "RETRIEVE" = Just Download
+	deserialize _ = Nothing
+
+instance Serializable Key where
+	serialize = key2file
+	deserialize = file2key
+
+instance Serializable [Char] where
+	serialize = id
+	deserialize = Just
+
+instance Serializable Cost where
+	serialize = show
+	deserialize = readish
+
+instance Serializable Int where
+	serialize = show
+	deserialize = readish
+
+{- Parsing the parameters of messages. Using the right parseN ensures
+ - that the string is split into exactly the requested number of words,
+ - which allows the last parameter of a message to contain arbitrary
+ - whitespace, etc, without needing any special quoting.
+ -}
+type Parser a = String -> Maybe a
+
+parseFail :: Parser a
+parseFail _ = Nothing
+
+parse0 :: a -> Parser a
+parse0 mk "" = Just mk
+parse0 _ _ = Nothing
+
+parse1 :: Serializable p1 => (p1 -> a) -> Parser a
+parse1 mk p1 = mk <$> deserialize p1
+
+parse2 :: (Serializable p1, Serializable p2) => (p1 -> p2 -> a) -> Parser a
+parse2 mk s = mk <$> deserialize p1 <*> deserialize p2
+  where
+	(p1, p2) = splitWord s
+
+parse3 :: (Serializable p1, Serializable p2, Serializable p3) => (p1 -> p2 -> p3 -> a) -> Parser a
+parse3 mk s = mk <$> deserialize p1 <*> deserialize p2 <*> deserialize p3
+  where
+	(p1, rest) = splitWord s
+	(p2, p3) = splitWord rest
+
+splitWord :: String -> (String, String)
+splitWord = separate isSpace
diff --git a/doc/design/external_special_remote_protocol.mdwn b/doc/design/external_special_remote_protocol.mdwn
index 19640fb7f..a17ce96fc 100644
--- a/doc/design/external_special_remote_protocol.mdwn
+++ b/doc/design/external_special_remote_protocol.mdwn
@@ -95,9 +95,10 @@ send one of the corresponding replies listed in the next section.
   (See Config/Cost.hs for some standard costs.)
 * `TRANSFER STORE|RETRIEVE Key File`  
   Requests the transfer of a key. For Send, the File is the file to upload;
-  for Receive the File is where to store the download. Note that the File
-  should not influence the filename used on the remote. The filename used
-  should be derived from the Key.  
+  for Receive the File is where to store the download.  
+  Note that the File should not influence the filename used on the remote.
+  The filename used should be derived from the Key, and will not contain
+  any whitespace.  
   Multiple transfers might be requested by git-annex, but it's fine for the 
   program to serialize them and only do one at a time.
 * `CHECKPRESENT Key`  
@@ -130,17 +131,14 @@ while it's handling a request.
 * `REMOVE-SUCCESS Key`  
   Indicates the key has been removed from the remote. May be returned if
   the remote didn't have the key at the point removal was requested.
-* `REMOVE-FAILURE Key`  
+* `REMOVE-FAILURE Key ErrorMsg`  
   Indicates that the key was unable to be removed from the remote.
 * `COST Int`  
   Indicates the cost of the remote.
 * `COST-UNKNOWN`  
   Indicates the remote has no opinion of its cost.
-* `INITREMOTE-SUCCESS Setting=Value ...`  
+* `INITREMOTE-SUCCESS`  
   Indicates the INITREMOTE succeeded and the remote is ready to use.
-  The settings and values can optionally be returned. They will be added
-  to the existing configuration of the remote (and may change existing
-  values in it).
 * `INITREMOTE-FAILURE ErrorMsg`  
   Indicates that INITREMOTE failed.
 
@@ -154,8 +152,8 @@ in control.
   thing at startup, as until it sees this git-annex does not know how to
   talk with the special remote program!
 * `PROGRESS STORE|RETRIEVE Key Int`  
-  Indicates the current progress of the transfer. May be repeated any
-  number of times during the transfer process. This is highly recommended
+  Indicates the current progress of the transfer (in bytes). May be repeated
+  any number of times during the transfer process. This is highly recommended
   for STORE. (It is optional but good for RETRIEVE.)  
   (git-annex does not send a reply to this message.)
 * `DIRHASH Key`  
@@ -163,7 +161,13 @@ in control.
   This is always the same for any given Key, so can be used for eg,
   creating hash directory structures to store Keys in.  
   (git-annex replies with VALUE followed by the value.)
-* `GETCONFIG Setting`
+* `SETCONFIG Setting`  
+  Sets one of the special remote's configuration settings. These settings
+  are stored in the git-annex branch, so will be available if the same
+  special remote is used elsewhere.  
+  (Typically only done during INITREMOTE, although it is accepted at other
+  times.)
+* `GETCONFIG Setting`  
   Gets one of the special remote's configuration settings.  
   (git-annex replies with VALUE followed by the value.)
 * `SETSTATE Key Value`  
@@ -206,7 +210,8 @@ while read line; do
 			# XXX do anything necessary to create resources
 			# used by the remote. Try to be idempotent.
 			# Use GETCONFIG to get any needed configuration
-			# settings.
+			# settings, and SETCONFIG to set any persistent
+			# configuration settings.
 			echo INITREMOTE-SUCCESS
 		;;
 		GETCOST)