diff options
| author |  Joey Hess <joey@kitenet.net> | 2013-04-10 18:39:56 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2013-04-10 18:39:56 -0400 |
| commit | 9a418f32746c551833136726c052ea2d9549538a (patch) | |
| tree | c2d7806cbf23b4220b5cc8f56fb2f4634d772c01 /Assistant/XMPP.hs | |
| parent | 8102072f091e394e9e4dbae515c9965b34745563 (diff) | |
assistant: Added sequence numbers to XMPP git push packets. (Not yet used.)
For backwards compatability, "" is treated as "0" sequence number.
--debug will show xmpp sequence numbers now, but they are not otherwise
used.
Diffstat (limited to 'Assistant/XMPP.hs')
| -rw-r--r-- | Assistant/XMPP.hs | 22 |
1 files changed, 12 insertions, 10 deletions
diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs index 2c0004403..01d42ba9b 100644 --- a/Assistant/XMPP.hs +++ b/Assistant/XMPP.hs @@ -134,13 +134,13 @@ pushMessage = gitAnnexMessage . encode encode CanPush = gitAnnexTag canPushAttr T.empty encode PushRequest = gitAnnexTag pushRequestAttr T.empty encode StartingPush = gitAnnexTag startingPushAttr T.empty - encode (ReceivePackOutput b) = - gitAnnexTagContent receivePackAttr T.empty $ encodeTagContent b - encode (SendPackOutput b) = - gitAnnexTagContent sendPackAttr T.empty $ encodeTagContent b + encode (ReceivePackOutput n b) = + gitAnnexTagContent receivePackAttr (val n) $ encodeTagContent b + encode (SendPackOutput n b) = + gitAnnexTagContent sendPackAttr (val n) $ encodeTagContent b encode (ReceivePackDone code) = - gitAnnexTag receivePackDoneAttr $ - T.pack $ show $ encodeExitCode code + gitAnnexTag receivePackDoneAttr $ val $ encodeExitCode code + val = T.pack . show decodeMessage :: Message -> Maybe NetMessage decodeMessage m = decode =<< gitAnnexTagInfo m @@ -160,10 +160,8 @@ decodeMessage m = decode =<< gitAnnexTagInfo m , pushdecoder $ const $ Just CanPush , pushdecoder $ const $ Just PushRequest , pushdecoder $ const $ Just StartingPush - , pushdecoder $ - fmap ReceivePackOutput . decodeTagContent . tagElement - , pushdecoder $ - fmap SendPackOutput . decodeTagContent . tagElement + , pushdecoder $ gen ReceivePackOutput + , pushdecoder $ gen SendPackOutput , pushdecoder $ fmap (ReceivePackDone . decodeExitCode) . readish . T.unpack . tagValue @@ -171,6 +169,10 @@ decodeMessage m = decode =<< gitAnnexTagInfo m pushdecoder a m' i = Pushing <$> (formatJID <$> messageFrom m') <*> a i + gen c i = do + packet <- decodeTagContent $ tagElement i + let sequence = fromMaybe 0 $ readish $ T.unpack $ tagValue i + return $ c sequence packet decodeExitCode :: Int -> ExitCode decodeExitCode 0 = ExitSuccess |