diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index cef02f0b20..67c986301b 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -183,7 +183,7 @@ runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant () runHandler handler file filestatus = void $ do r <- tryIO <~> handler (normalize file) filestatus case r of - Left e -> liftIO $ warningIO $ show e + Left e -> liftAnnex $ warning $ show e Right Nothing -> noop Right (Just change) -> recordChange change where diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 0c4d42cf57..ff948ba0d6 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -286,7 +286,7 @@ setupRepo gcryptid r {- Ask git-annex-shell to configure the repository as a gcrypt - repository. May fail if it is too old. -} gitannexshellsetup = Ssh.onRemote NoConsumeStdin r - (boolSystem, return False) + (\f p -> liftIO (boolSystem f p), return False) "gcryptsetup" [ Param gcryptid ] [] denyNonFastForwards = "receive.denyNonFastForwards" @@ -451,7 +451,7 @@ getGCryptId fast r gc | Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$> liftIO (catchMaybeIO $ Git.Config.read r) | not fast = extract . liftM fst <$> getM (eitherToMaybe <$>) - [ Ssh.onRemote NoConsumeStdin r (Git.Config.fromPipe r, return (Left $ error "configlist failed")) "configlist" [] [] + [ Ssh.onRemote NoConsumeStdin r (\f p -> liftIO (Git.Config.fromPipe r f p), return (Left $ error "configlist failed")) "configlist" [] [] , getConfigViaRsync r gc ] | otherwise = return (Nothing, r) diff --git a/Remote/Git.hs b/Remote/Git.hs index 7bdab21a1b..933e55ab04 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -249,21 +249,21 @@ tryGitConfigRead autoinit r haveconfig = not . M.null . Git.config pipedconfig cmd params = do - v <- Git.Config.fromPipe r cmd params + v <- liftIO $ Git.Config.fromPipe r cmd params case v of Right (r', val) -> do unless (isUUIDConfigured r' || null val) $ do - warningIO $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r - warningIO $ "Instead, got: " ++ show val - warningIO $ "This is unexpected; please check the network transport!" + warning $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r + warning $ "Instead, got: " ++ show val + warning $ "This is unexpected; please check the network transport!" return $ Right r' Left l -> return $ Left l geturlconfig = Url.withUrlOptions $ \uo -> do - v <- liftIO $ withTmpFile "git-annex.tmp" $ \tmpfile h -> do - hClose h + v <- withTmpFile "git-annex.tmp" $ \tmpfile h -> do + liftIO $ hClose h let url = Git.repoLocation r ++ "/config" - ifM (Url.downloadQuiet nullMeterUpdate url tmpfile uo) + ifM (liftIO $ Url.downloadQuiet nullMeterUpdate url tmpfile uo) ( Just <$> pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile] , return Nothing ) diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 47cf577218..cc17220f28 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -83,7 +83,7 @@ git_annex_shell cs r command params fields onRemote :: ConsumeStdin -> Git.Repo - -> (FilePath -> [CommandParam] -> IO a, Annex a) + -> (FilePath -> [CommandParam] -> Annex a, Annex a) -> String -> [CommandParam] -> [(Field, String)] @@ -91,7 +91,7 @@ onRemote onRemote cs r (with, errorval) command params fields = do s <- git_annex_shell cs r command params fields case s of - Just (c, ps) -> liftIO $ with c ps + Just (c, ps) -> with c ps Nothing -> errorval {- Checks if a remote contains a key. -} @@ -100,14 +100,14 @@ inAnnex r k = do showChecking r onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex" [Param $ serializeKey k] [] where - runcheck c p = dispatch =<< safeSystem c p + runcheck c p = liftIO $ dispatch =<< safeSystem c p dispatch ExitSuccess = return True dispatch (ExitFailure 1) = return False dispatch _ = cantCheck r {- Removes a key from a remote. -} dropKey :: Git.Repo -> Key -> Annex Bool -dropKey r key = onRemote NoConsumeStdin r (boolSystem, return False) "dropkey" +dropKey r key = onRemote NoConsumeStdin r (\f p -> liftIO (boolSystem f p), return False) "dropkey" [ Param "--quiet", Param "--force" , Param $ serializeKey key ] diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs index 79bf7e05ef..977a29112e 100644 --- a/RemoteDaemon/Transport/Tor.hs +++ b/RemoteDaemon/Transport/Tor.hs @@ -69,7 +69,7 @@ server ichan th@(TransportHandle (LocalRepo r) _) = go ) unless ok $ do hClose conn - warningIO "dropped Tor connection, too busy" + liftAnnex th $ warning "dropped Tor connection, too busy" handlecontrol servicerunning = do msg <- atomically $ readTChan ichan