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

refactor

Browse source
This commit is contained in:
Joey Hess 2012-11-10 00:24:26 -04:00
parent 0f8bbcc8fd
commit f57c2ef99e
1 changed files with 8 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
Assistant/XMPP/Git.hs
View file

@ -122,9 +122,7 @@ xmppPush cid remote refs = runPush (SendPushRunning cid) handleDeferred $ do
fromxmpp outh controlh = forever $ do fromxmpp outh controlh = forever $ do
m <- waitNetPushMessage m <- waitNetPushMessage
case m of case m of
(ReceivePackOutput _ b) -> liftIO $ do (ReceivePackOutput _ b) -> liftIO $ writeChunk outh b
B.hPut outh b
hFlush outh
(ReceivePackDone _ exitcode) -> liftIO $ do (ReceivePackDone _ exitcode) -> liftIO $ do
hPrint controlh exitcode hPrint controlh exitcode
hFlush controlh hFlush controlh
@ -183,8 +181,7 @@ xmppGitRelay = do
hClose fromh hClose fromh
hClose toh hClose toh
killThread =<< myThreadId killThread =<< myThreadId
B.hPut toh b writeChunk toh b
hFlush toh
{- Relays git receive-pack stdin and stdout via XMPP, as well as propigating {- Relays git receive-pack stdin and stdout via XMPP, as well as propigating
- its exit status to XMPP. -} - its exit status to XMPP. -}
@ -216,9 +213,7 @@ xmppReceivePack cid = runPush (ReceivePushRunning cid) handleDeferred $ do
relayfromxmpp inh = forever $ do relayfromxmpp inh = forever $ do
m <- waitNetPushMessage m <- waitNetPushMessage
case m of case m of
(SendPackOutput _ b) -> liftIO $ do (SendPackOutput _ b) -> liftIO $ writeChunk inh b
B.hPut inh b
hFlush inh
_ -> noop _ -> noop
xmppRemotes :: ClientID -> Assistant [Remote] xmppRemotes :: ClientID -> Assistant [Remote]
@ -252,3 +247,8 @@ handleDeferred = handlePushMessage
chunkSize :: Int chunkSize :: Int
chunkSize = 4096 chunkSize = 4096
writeChunk :: Handle -> B.ByteString -> IO ()
writeChunk h b = do
B.hPut h b
hFlush h