Added INFO to external special remote protocol.

It's left up to the special remote to detect when git-annex is new enough
to support the message; an old git-annex will blow up.

This commit was supported by the NSF-funded DataLad project.

CHANGELOG

@@ -1,6 +1,7 @@
 git-annex (6.20180113) UNRELEASED; urgency=medium
 
   * inprogress: Avoid showing failures for files not in progress. 
+  * Added INFO to external special remote protocol.
 
  -- Joey Hess <id@joeyh.name>  Wed, 24 Jan 2018 20:42:55 -0400
 

Messages.hs

@@ -19,6 +19,7 @@ module Messages (
 	showStoringStateAction,
 	showOutput,
 	showLongNote,
+	showInfo,
 	showEndOk,
 	showEndFail,
 	showEndResult,
@@ -123,7 +124,15 @@ showOutput = unlessM commandProgressDisabled $
 	outputMessage JSON.none "\n"
 
 showLongNote :: String -> Annex ()
-showLongNote s = outputMessage (JSON.note s) ('\n' : indent s ++ "\n")
+showLongNote s = outputMessage (JSON.note s) (formatLongNote s)
+
+formatLongNote :: String -> String
+formatLongNote s = '\n' : indent s ++ "\n"
+
+-- Used by external special remote, displayed same as showLongNote
+-- to console, but json object containing the info is emitted immediately.
+showInfo :: String -> Annex ()
+showInfo s = outputMessage' outputJSON (JSON.info s) (formatLongNote s)
 
 showEndOk :: Annex ()
 showEndOk = showEndResult True
@@ -165,11 +174,11 @@ indent = intercalate "\n" . map (\l -> "  " ++ l) . lines
 
 {- Shows a JSON chunk only when in json mode. -}
 maybeShowJSON :: JSON.JSONChunk v -> Annex ()
-maybeShowJSON v = void $ withMessageState $ outputJSON (JSON.add v)
+maybeShowJSON v = void $ withMessageState $ bufferJSON (JSON.add v)
 
 {- Shows a complete JSON value, only when in json mode. -}
 showFullJSON :: JSON.JSONChunk v -> Annex Bool
-showFullJSON v = withMessageState $ outputJSON (JSON.complete v)
+showFullJSON v = withMessageState $ bufferJSON (JSON.complete v)
 
 {- Performs an action that outputs nonstandard/customized output, and
  - in JSON mode wraps its output in JSON.start and JSON.end, so it's

Messages/Internal.hs

@@ -17,16 +17,19 @@ withMessageState :: (MessageState -> Annex a) -> Annex a
 withMessageState a = Annex.getState Annex.output >>= a
 
 outputMessage :: JSONBuilder -> String -> Annex ()
-outputMessage jsonbuilder msg = withMessageState $ \s -> case outputType s of
+outputMessage = outputMessage' bufferJSON
+
+outputMessage' :: (JSONBuilder -> MessageState -> Annex Bool) -> JSONBuilder -> String -> Annex ()
+outputMessage' jsonoutputter jsonbuilder msg = withMessageState $ \s -> case outputType s of
 	NormalOutput
 		| concurrentOutputEnabled s -> concurrentMessage s False msg q
 		| otherwise -> liftIO $ flushed $ putStr msg
-	JSONOutput _ -> void $ outputJSON jsonbuilder s
+	JSONOutput _ -> void $ jsonoutputter jsonbuilder s
 	QuietOutput -> q
 
 -- Buffer changes to JSON until end is reached and then emit it.
-outputJSON :: JSONBuilder -> MessageState -> Annex Bool
+bufferJSON :: JSONBuilder -> MessageState -> Annex Bool
-outputJSON jsonbuilder s = case outputType s of
+bufferJSON jsonbuilder s = case outputType s of
 	JSONOutput _
 		| endjson -> do
 			Annex.changeState $ \st -> 
@@ -46,6 +49,15 @@ outputJSON jsonbuilder s = case outputType s of
 		Nothing -> Nothing
 		Just b -> Just (b, False)
 
+-- Immediately output JSON.
+outputJSON :: JSONBuilder -> MessageState -> Annex Bool
+outputJSON jsonbuilder s = case outputType s of
+	JSONOutput _ -> do
+		maybe noop (liftIO . flushed . emit)
+			(fst <$> jsonbuilder Nothing)
+		return True
+	_ -> return False
+
 outputError :: String -> Annex ()
 outputError msg = withMessageState $ \s ->
 	if concurrentOutputEnabled s

Messages/JSON.hs

@@ -15,6 +15,7 @@ module Messages.JSON (
 	start,
 	end,
 	note,
+	info,
 	add,
 	complete,
 	progress,
@@ -77,6 +78,11 @@ note :: String -> JSONBuilder
 note s (Just (o, e)) = Just (HM.insert "note" (toJSON s) o, e)
 note _ Nothing = Nothing
 
+info :: String -> JSONBuilder
+info s _ = Just (o, True)
+  where
+	Object o = object ["info" .= toJSON s]
+
 data JSONChunk v where
 	AesonObject :: Object -> JSONChunk Object
 	JSONChunk :: ToJSON v => [(String, v)] -> JSONChunk [(String, v)]

Remote/External.hs

@@ -421,6 +421,7 @@ handleRequest' st external req mp responsehandler
 		mapM_ (send . VALUE) =<< getUrlsWithPrefix key prefix
 		send (VALUE "") -- end of list
 	handleRemoteRequest (DEBUG msg) = liftIO $ debugM "external" msg
+	handleRemoteRequest (INFO msg) = showInfo msg
 	handleRemoteRequest (VERSION _) =
 		sendMessage st external (ERROR "too late to send VERSION")
 

Remote/External/Types.hs

@@ -253,6 +253,7 @@ data RemoteRequest
 	| SETURIMISSING Key URI
 	| GETURLS Key String
 	| DEBUG String
+	| INFO String
 	deriving (Show)
 
 instance Proto.Receivable RemoteRequest where
@@ -276,6 +277,7 @@ instance Proto.Receivable RemoteRequest where
 	parseCommand "SETURIMISSING" = Proto.parse2 SETURIMISSING
 	parseCommand "GETURLS" = Proto.parse2 GETURLS
 	parseCommand "DEBUG" = Proto.parse1 DEBUG
+	parseCommand "INFO" = Proto.parse1 INFO
 	parseCommand _ = Proto.parseFail
 
 -- Responses to RemoteRequest.

doc/design/external_special_remote_protocol.mdwn

@@ -400,8 +400,15 @@ handling a request.
   (git-annex replies one or more times with VALUE for each url.
   The final VALUE has an empty value, indicating the end of the url list.)
 * `DEBUG message`
-  Tells git-annex to display the message if --debug is enabled.
+  Tells git-annex to display the message if --debug is enabled.  
   (git-annex does not send a reply to this message.)
+* `INFO message`
+  Tells git-annex to display the message to the user.  
+  When git-annex is in --json mode, the message will be emitted immediately
+  in its own json object, with an "info" field.  
+  (git-annex does not send a reply to this message.)  
+  This message was first supported by git-annex version 
+  6.20180206
 
 ## general messages
 

doc/todo/INFO_message_for_custom_special_remotes.mdwn

@@ -1,3 +1,5 @@
 I wondered if it would be sensible to ask to extend [externals special remote protocol](https://git-annex.branchable.com/design/external_special_remote_protocol/) with ability for custom remotes to pass back some INFO level message (not only DEBUG or ERROR).  The reason is:  in datalad-archives special remote we usually need to `git annex get` first the key containing the archive, which might be sizeable.  Since there is ATM no way to communicate back to git-annex, so it could communicate back to the datalad which runs it, it results in no output/message to the user that possibly a heavy download is happening in the background.  So, we would need to establish our own communication from datalad-archives special remote all the way to top level datalad process to report that, or I wondered if may be we could report back to git-annex, and it in turn report back to the original process (running e.g. `annex get --json --json-progress`) so it could spit out that message wrapped into a json record within the stream, so we could process and output that to the user.
 
 [[!meta author=yoh]]
+
+> [[done]] --[[Joey]]

doc/todo/INFO_message_for_custom_special_remotes/comment_1_ea99a5099f78767859c05aeb5217a12d._comment

@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2018-02-06T16:58:04Z"
+ content="""
+I've added it. However, note that previous versions of git-annex will
+not react well to an unknown message being sent, so to use it safely you
+will need to detect a new enough version of git-annex. (I've had a todo item
+on the protocol for a while to have a way to detect what messages git-annex
+understands.)
+"""]]