async proto basically working

Simplified the protocol by removing END-ASYNC.

There's a STM crash when a non-async protocol message is sent, which
needs to be fixed.
This commit is contained in:
Joey Hess 2020-08-13 15:49:43 -04:00
parent c9e8cafb98
commit 7546e686a2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 210 additions and 146 deletions

View file

@ -504,18 +504,17 @@ handleRequest' st external req mp responsehandler
withurl mk uri = handleRemoteRequest $ mk $
setDownloader (show uri) OtherDownloader
sendMessage :: Sendable m => ExternalState -> m -> Annex ()
sendMessage st m = liftIO $ externalSend st line
where
line = unwords $ formatMessage m
sendMessage :: (Sendable m, ToAsyncWrapped m) => ExternalState -> m -> Annex ()
sendMessage st m = liftIO $ externalSend st m
sendMessageAddonProcess :: AddonProcess.ExternalAddonProcess -> String -> IO ()
sendMessageAddonProcess p line = do
sendMessageAddonProcess :: Sendable m => AddonProcess.ExternalAddonProcess -> m -> IO ()
sendMessageAddonProcess p m = do
AddonProcess.protocolDebug p True line
hPutStrLn h line
hFlush h
where
h = AddonProcess.externalSend p
line = unwords $ formatMessage m
receiveMessageAddonProcess :: AddonProcess.ExternalAddonProcess -> IO (Maybe String)
receiveMessageAddonProcess p = do
@ -551,7 +550,7 @@ receiveMessage
receiveMessage st external handleresponse handlerequest handleexceptional =
go =<< liftIO (externalReceive st)
where
go Nothing = protocolError False ""
go Nothing = protocolError False "<EOF>"
go (Just s) = case parseMessage s :: Maybe Response of
Just resp -> case handleresponse resp of
Nothing -> protocolError True s