mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

assistant: Added sequence numbers to XMPP git push packets. (Not yet used.)

Browse source 
For backwards compatability, "" is treated as "0" sequence number.

--debug will show xmpp sequence numbers now, but they are not otherwise
used.
This commit is contained in:
Joey Hess 2013-04-10 18:39:56 -04:00
parent 92b1b8e9ab
commit 271a919d14
5 changed files with 45 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

22
Assistant/XMPP.hs
View file

@ -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