From df337bb63b4ed6e5d2ce563ec89d28d192e791db Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 13 Sep 2012 00:57:52 -0400 Subject: hlint --- Assistant/Threads/Committer.hs | 2 +- Assistant/Threads/Merger.hs | 2 +- Assistant/Threads/NetWatcher.hs | 4 ++-- Assistant/Threads/PairListener.hs | 11 +++++----- Assistant/Threads/Pusher.hs | 41 ++++++++++++++++++------------------ Assistant/Threads/TransferScanner.hs | 4 ++-- Assistant/Threads/TransferWatcher.hs | 2 +- Assistant/Threads/Transferrer.hs | 2 +- Assistant/Threads/Watcher.hs | 8 +++---- Assistant/Threads/WebApp.hs | 9 ++++---- 10 files changed, 40 insertions(+), 45 deletions(-) (limited to 'Assistant/Threads') diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index fcf205311..43bb7b03d 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -132,7 +132,7 @@ handleAdds st changechan transferqueue dstatus cs = returnWhen (null pendingadds returnWhen (null toadd) $ do added <- catMaybes <$> forM toadd add - if (DirWatcher.eventsCoalesce || null added) + if DirWatcher.eventsCoalesce || null added then return $ added ++ otherchanges else do r <- handleAdds st changechan transferqueue dstatus diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs index 663ea40ff..9ed744808 100644 --- a/Assistant/Threads/Merger.hs +++ b/Assistant/Threads/Merger.hs @@ -44,7 +44,7 @@ type Handler = Git.Repo -> FilePath -> Maybe FileStatus -> IO () - Exceptions are ignored, otherwise a whole thread could be crashed. -} runHandler :: Git.Repo -> Handler -> FilePath -> Maybe FileStatus -> IO () -runHandler g handler file filestatus = void $ do +runHandler g handler file filestatus = void $ either print (const noop) =<< tryIO go where go = handler g file filestatus diff --git a/Assistant/Threads/NetWatcher.hs b/Assistant/Threads/NetWatcher.hs index b52657990..e9af2a53b 100644 --- a/Assistant/Threads/NetWatcher.hs +++ b/Assistant/Threads/NetWatcher.hs @@ -34,7 +34,7 @@ thisThread :: ThreadName thisThread = "NetWatcher" netWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> NamedThread -netWatcherThread st dstatus scanremotes = thread $ do +netWatcherThread st dstatus scanremotes = thread $ #if WITH_DBUS dbusThread st dstatus scanremotes #else @@ -49,7 +49,7 @@ netWatcherThread st dstatus scanremotes = thread $ do - while (despite the local network staying up), are synced with - periodically. -} netWatcherFallbackThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> NamedThread -netWatcherFallbackThread st dstatus scanremotes = thread $ do +netWatcherFallbackThread st dstatus scanremotes = thread $ runEvery (Seconds 3600) $ handleConnection st dstatus scanremotes where diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs index 746d88a96..9ce369032 100644 --- a/Assistant/Threads/PairListener.hs +++ b/Assistant/Threads/PairListener.hs @@ -50,7 +50,7 @@ pairListenerThread st dstatus scanremotes urlrenderer = thread $ withSocketsDo $ else do pairReqReceived verified dstatus urlrenderer m go sock (m:take 10 reqs) (invalidateCache m cache) - (_, _, PairAck) -> do + (_, _, PairAck) -> pairAckReceived verified pip st dstatus scanremotes m cache >>= go sock reqs (_, _, PairDone) -> do @@ -65,8 +65,8 @@ pairListenerThread st dstatus scanremotes urlrenderer = thread $ withSocketsDo $ -} verificationCheck m (Just pip) = do let verified = verifiedPairMsg m pip - let sameuuid = pairUUID (inProgressPairData pip) == pairUUID (pairMsgData $ m) - if (not verified && sameuuid) + let sameuuid = pairUUID (inProgressPairData pip) == pairUUID (pairMsgData m) + if not verified && sameuuid then do runThreadState st $ warning "detected possible pairing brute force attempt; disabled pairing" @@ -88,8 +88,7 @@ pairListenerThread st dstatus scanremotes urlrenderer = thread $ withSocketsDo $ {- PairReqs invalidate the cache of recently finished pairings. - This is so that, if a new pairing is started with the - same secret used before, a bogus PairDone is not sent. -} - invalidateCache msg = - filter (\pip -> not $ verifiedPairMsg msg pip) + invalidateCache msg = filter (not . verifiedPairMsg msg) getmsg sock c = do (msg, n, _) <- recvFrom sock chunksz @@ -124,7 +123,7 @@ pairAckReceived True (Just pip) st dstatus scanremotes msg cache = do finishedPairing st dstatus scanremotes msg (inProgressSshKeyPair pip) startSending dstatus pip PairDone $ multicastPairMsg (Just 1) (inProgressSecret pip) (inProgressPairData pip) - return $ pip:(take 10 cache) + return $ pip : take 10 cache {- A stale PairAck might also be seen, after we've finished pairing. - Perhaps our PairDone was not received. To handle this, we keep - a cache of recently finished pairings, and re-send PairDone in diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index dbe968cd7..dee563d74 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -44,27 +44,26 @@ pushRetryThread st dstatus pushmap = thread $ runEvery (Seconds halfhour) $ do {- This thread pushes git commits out to remotes soon after they are made. -} pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> NamedThread -pushThread st dstatus commitchan pushmap = thread $ do - runEvery (Seconds 2) $ do - -- We already waited two seconds as a simple rate limiter. - -- Next, wait until at least one commit has been made - commits <- getCommits commitchan - -- Now see if now's a good time to push. - now <- getCurrentTime - if shouldPush now commits - then do - remotes <- filter pushable . knownRemotes - <$> getDaemonStatus dstatus - unless (null remotes) $ - void $ alertWhile dstatus (pushAlert remotes) $ - pushToRemotes thisThread now st (Just pushmap) remotes - else do - debug thisThread - [ "delaying push of" - , show (length commits) - , "commits" - ] - refillCommits commitchan commits +pushThread st dstatus commitchan pushmap = thread $ runEvery (Seconds 2) $ do + -- We already waited two seconds as a simple rate limiter. + -- Next, wait until at least one commit has been made + commits <- getCommits commitchan + -- Now see if now's a good time to push. + now <- getCurrentTime + if shouldPush now commits + then do + remotes <- filter pushable . knownRemotes + <$> getDaemonStatus dstatus + unless (null remotes) $ + void $ alertWhile dstatus (pushAlert remotes) $ + pushToRemotes thisThread now st (Just pushmap) remotes + else do + debug thisThread + [ "delaying push of" + , show (length commits) + , "commits" + ] + refillCommits commitchan commits where thread = NamedThread thisThread pushable r diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index ecb9021f0..d8719f027 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -43,7 +43,7 @@ transferScannerThread st dstatus scanremotes transferqueue = thread $ do if any fullScan infos || any (`S.notMember` scanned) rs then do expensiveScan st dstatus transferqueue rs - go (S.union scanned (S.fromList rs)) + go $ scanned `S.union` S.fromList rs else do mapM_ (failedTransferScan st dstatus transferqueue) rs go scanned @@ -129,7 +129,7 @@ expensiveScan st dstatus transferqueue rs = unless onlyweb $ do ) check direction want key locs r | direction == Upload && Remote.readonly r = Nothing - | (Remote.uuid r `elem` locs) == want = Just $ + | (Remote.uuid r `elem` locs) == want = Just (r, Transfer direction (Remote.uuid r) key) | otherwise = Nothing diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index be15aef24..9ae4eb365 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -43,7 +43,7 @@ type Handler = ThreadState -> DaemonStatusHandle -> FilePath -> Maybe FileStatus - Exceptions are ignored, otherwise a whole thread could be crashed. -} runHandler :: ThreadState -> DaemonStatusHandle -> Handler -> FilePath -> Maybe FileStatus -> IO () -runHandler st dstatus handler file filestatus = void $ do +runHandler st dstatus handler file filestatus = void $ either print (const noop) =<< tryIO go where go = handler st dstatus file filestatus diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs index 3c1c44b9d..a38fa2ccc 100644 --- a/Assistant/Threads/Transferrer.hs +++ b/Assistant/Threads/Transferrer.hs @@ -38,7 +38,7 @@ transfererThread st dstatus transferqueue slots = thread $ go =<< readProgramFil maybe (return Nothing) (uncurry $ startTransfer st dstatus program) =<< getNextTransfer transferqueue dstatus notrunning {- Skip transfers that are already running. -} - notrunning i = startedTime i == Nothing + notrunning = isNothing . startedTime {- By the time this is called, the daemonstatus's transfer map should - already have been updated to include the transfer. -} diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 3054c50e1..17ec0b81f 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -44,7 +44,7 @@ thisThread = "Watcher" checkCanWatch :: Annex () checkCanWatch | canWatch = - unlessM (liftIO (inPath "lsof") <||> Annex.getState Annex.force) $ + unlessM (liftIO (inPath "lsof") <||> Annex.getState Annex.force) needLsof | otherwise = error "watch mode is not available on this system" @@ -75,7 +75,7 @@ watchThread st dstatus transferqueue changechan = NamedThread thisThread $ do startupScan :: ThreadState -> DaemonStatusHandle -> IO a -> IO a startupScan st dstatus scanner = do runThreadState st $ showAction "scanning" - r <- alertWhile' dstatus startupScanAlert $ do + alertWhile' dstatus startupScanAlert $ do r <- scanner -- Notice any files that were deleted before @@ -88,8 +88,6 @@ startupScan st dstatus scanner = do return (True, r) - return r - ignored :: FilePath -> Bool ignored = ig . takeFileName where @@ -135,7 +133,7 @@ runHandler threadname st dstatus transferqueue changechan handler file filestatu -} onAdd :: Handler onAdd threadname file filestatus dstatus _ - | maybe False isRegularFile filestatus = do + | maybe False isRegularFile filestatus = ifM (scanComplete <$> liftIO (getDaemonStatus dstatus)) ( go , ifM (null <$> inRepo (Git.LsFiles.notInRepo False [file])) diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 1bab94b0f..646734776 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -44,7 +44,7 @@ mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes") type Url = String webAppThread - :: (Maybe ThreadState) + :: Maybe ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> TransferQueue @@ -71,10 +71,9 @@ webAppThread mst dstatus scanremotes transferqueue transferslots urlrenderer pos ( return $ httpDebugLogger app , return app ) - runWebApp app' $ \port -> do - case mst of - Nothing -> withTempFile "webapp.html" $ \tmpfile _ -> go port webapp tmpfile - Just st -> go port webapp =<< runThreadState st (fromRepo gitAnnexHtmlShim) + runWebApp app' $ \port -> case mst of + Nothing -> withTempFile "webapp.html" $ \tmpfile _ -> go port webapp tmpfile + Just st -> go port webapp =<< runThreadState st (fromRepo gitAnnexHtmlShim) where thread = NamedThread thisThread getreldir Nothing = return Nothing -- cgit v1.2.3