support prompt in message serialization

That seems to be the last thing needed for message serialization.
Although it's only used in the assistant currently, so hard to tell if I
forgot something.

At this point, it should be possible to start using transferkeys
when performing transfers, which will allow killing a transferkeys
process if a transfer times out or stalls. But that's for another day.

This commit was sponsored by Ethan Aubin.
This commit is contained in:
Joey Hess 2020-12-04 14:54:09 -04:00
parent 581792bcf0
commit 438d5be1f7
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 77 additions and 29 deletions

View file

@ -41,8 +41,9 @@ start :: CommandStart
start = do
enableInteractiveBranchAccess
(readh, writeh) <- liftIO dupIoHandles
Annex.setOutput $ SerializedOutput $
hPutStrLn writeh . show . TransferOutput
Annex.setOutput $ SerializedOutput
(hPutStrLn writeh . show . TransferOutput)
(readMaybe <$> hGetLine readh)
runRequests readh writeh runner
stop
where
@ -101,7 +102,7 @@ runRequests readh writeh a = go Nothing Nothing
hPutStrLn writeh $ show $ TransferResult b
hFlush writeh
-- FIXME this is bad when used with inAnnex
-- | Send a request to this command to perform a transfer.
sendRequest :: Transfer -> TransferInfo -> Handle -> IO ()
sendRequest t tinfo h = hPutStrLn h $ show $ TransferRequest
(transferDirection t)
@ -109,6 +110,9 @@ sendRequest t tinfo h = hPutStrLn h $ show $ TransferRequest
(keyData (transferKey t))
(associatedFile tinfo)
sendSerializedOutputResponse :: Handle -> SerializedOutputResponse -> IO ()
sendSerializedOutputResponse h sor = hPutStrLn h $ show sor
-- | Read a response from this command.
--
-- Before the final response, this will return whatever SerializedOutput