diff options
author | Joey Hess <joey@kitenet.net> | 2012-11-09 23:43:08 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-11-09 23:52:51 -0400 |
commit | de9f2fa14a82cf1ef7359e8b7ccea4c14c3b8f89 (patch) | |
tree | 80b3ba6b8dd75361e59c1d3788f1b0e4e6cb760b /Assistant/XMPP | |
parent | dfa3da4efa401d0373d8e7062eb9045b9c54c474 (diff) |
refactor
Diffstat (limited to 'Assistant/XMPP')
-rw-r--r-- | Assistant/XMPP/Git.hs | 29 |
1 files changed, 14 insertions, 15 deletions
diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 0ff6f3ed1..b2d645fad 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -42,14 +42,16 @@ finishXMPPPairing jid u = void $ alertWhile alert $ buddy = T.unpack $ buddyName jid alert = pairRequestAcknowledgedAlert buddy Nothing +gitXMPPLocation :: JID -> String +gitXMPPLocation jid = "xmpp::" ++ T.unpack (formatJID $ baseJID jid) + makeXMPPGitRemote :: String -> JID -> UUID -> Assistant Bool makeXMPPGitRemote buddyname jid u = do - remote <- liftAnnex $ addRemote $ makeGitRemote buddyname xmppaddress + remote <- liftAnnex $ addRemote $ + makeGitRemote buddyname $ gitXMPPLocation jid liftAnnex $ storeUUID (remoteConfig (Remote.repo remote) "uuid") u syncNewRemote remote return True - where - xmppaddress = "xmpp::" ++ T.unpack (formatJID $ baseJID jid) {- Pushes the named refs to the remote, over XMPP, communicating with a - specific client that either requested the push, or responded to our @@ -104,16 +106,15 @@ xmppPush cid remote refs = runPush (SendPushRunning cid) handleDeferred $ do {- This can take a long time to run, so avoid running it in the - Annex monad. Also, override environment. -} g <- liftAnnex gitRepo - let g' = g { gitEnv = Just $ M.toList myenv } - let name = Remote.name remote - let params = Param name : map (Param . show) refs - ok <- liftIO $ Git.Command.runBool "push" params g' + let params = Param (Remote.name remote) : map (Param . show) refs + r <- liftIO $ Git.Command.runBool "push" params $ + g { gitEnv = Just $ M.toList myenv } liftIO $ do mapM_ killThread [t1, t2] mapM_ hClose [inh, outh, controlh] - return ok + return r where toxmpp inh = forever $ do b <- liftIO $ B.hGetSome inh chunkSize @@ -229,13 +230,11 @@ xmppRemotes :: ClientID -> Assistant [Remote] xmppRemotes cid = case baseJID <$> parseJID cid of Nothing -> return [] Just jid -> do - rs <- syncRemotes <$> getDaemonStatus - let want = T.unpack $ formatJID jid - liftAnnex $ filterM (matching want) rs + let loc = gitXMPPLocation jid + filter (matching loc . Remote.repo) . syncRemotes + <$> getDaemonStatus where - matching want remote = do - let r = Remote.repo remote - return $ repoIsUrl r && repoLocation r == "xmpp::" ++ want + matching loc r = repoIsUrl r && repoLocation r == loc whenXMPPRemote :: ClientID -> Assistant () -> Assistant () whenXMPPRemote cid = unlessM (null <$> xmppRemotes cid) @@ -247,7 +246,7 @@ handlePushMessage (PushRequest cid) = do rs <- xmppRemotes cid current <- liftAnnex $ inRepo Git.Branch.current --let refs = catMaybes [current, Just Annex.Branch.fullname] -- TODO - let refs = [Ref "master:refs/xmpp/newmaster"] + let refs = [Ref "master:refs/remotes/xmpp/newmaster"] forM_ rs $ \r -> xmppPush cid r refs handlePushMessage (StartingPush cid) = whenXMPPRemote cid $ void $ xmppReceivePack cid |