summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Assistant/DaemonStatus.hs9
-rw-r--r--Assistant/Drop.hs2
-rw-r--r--Assistant/Threads/DaemonStatus.hs4
-rw-r--r--Assistant/Threads/PairListener.hs2
-rw-r--r--Assistant/Threads/PushNotifier.hs2
-rw-r--r--Assistant/Threads/Pusher.hs2
-rw-r--r--Assistant/Threads/SanityChecker.hs2
-rw-r--r--Assistant/Threads/TransferPoller.hs4
-rw-r--r--Assistant/Threads/TransferScanner.hs4
-rw-r--r--Assistant/Threads/Watcher.hs6
-rw-r--r--Assistant/TransferQueue.hs4
11 files changed, 21 insertions, 20 deletions
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index 6525247eb..1706c0a57 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -24,11 +24,12 @@ import Data.Time
import System.Locale
import qualified Data.Map as M
-daemonStatus :: Assistant DaemonStatus
-daemonStatus = getDaemonStatus <<~ daemonStatusHandle
+-- TODO remove this
+getDaemonStatusOld :: DaemonStatusHandle -> IO DaemonStatus
+getDaemonStatusOld = atomically . readTMVar
-getDaemonStatus :: DaemonStatusHandle -> IO DaemonStatus
-getDaemonStatus = atomically . readTMVar
+getDaemonStatus :: Assistant DaemonStatus
+getDaemonStatus = (atomically . readTMVar) <<~ daemonStatusHandle
modifyDaemonStatus_ :: DaemonStatusHandle -> (DaemonStatus -> DaemonStatus) -> IO ()
modifyDaemonStatus_ dstatus a = modifyDaemonStatus dstatus $ \s -> (a s, ())
diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs
index cf20ef5b1..021e40a87 100644
--- a/Assistant/Drop.hs
+++ b/Assistant/Drop.hs
@@ -23,7 +23,7 @@ import Config
handleDrops :: DaemonStatusHandle -> Bool -> Key -> AssociatedFile -> Annex ()
handleDrops _ _ _ Nothing = noop
handleDrops dstatus fromhere key f = do
- syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
+ syncrs <- liftIO $ syncRemotes <$> getDaemonStatusOld dstatus
locs <- loggedLocations key
handleDrops' locs syncrs fromhere key f
diff --git a/Assistant/Threads/DaemonStatus.hs b/Assistant/Threads/DaemonStatus.hs
index 946bf1b05..07f0986a6 100644
--- a/Assistant/Threads/DaemonStatus.hs
+++ b/Assistant/Threads/DaemonStatus.hs
@@ -18,7 +18,7 @@ import Utility.NotificationBroadcaster
daemonStatusThread :: NamedThread
daemonStatusThread = NamedThread "DaemonStatus" $ do
notifier <- liftIO . newNotificationHandle
- =<< changeNotifier <$> daemonStatus
+ =<< changeNotifier <$> getDaemonStatus
checkpoint
runEvery (Seconds tenMinutes) <~> do
liftIO $ waitNotification notifier
@@ -26,4 +26,4 @@ daemonStatusThread = NamedThread "DaemonStatus" $ do
where
checkpoint = do
file <- liftAnnex $ fromRepo gitAnnexDaemonStatusFile
- liftIO . writeDaemonStatusFile file =<< daemonStatus
+ liftIO . writeDaemonStatusFile file =<< getDaemonStatus
diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs
index 235f7f124..b8e5f4683 100644
--- a/Assistant/Threads/PairListener.hs
+++ b/Assistant/Threads/PairListener.hs
@@ -41,7 +41,7 @@ pairListenerThread urlrenderer = NamedThread "PairListener" $ do
Just m -> do
sane <- checkSane msg
(pip, verified) <- verificationCheck m
- =<< (pairingInProgress <$> daemonStatus)
+ =<< (pairingInProgress <$> getDaemonStatus)
let wrongstage = maybe False (\p -> pairMsgStage m <= inProgressPairStage p) pip
case (wrongstage, sane, pairMsgStage m) of
-- ignore our own messages, and
diff --git a/Assistant/Threads/PushNotifier.hs b/Assistant/Threads/PushNotifier.hs
index 85c7fd9d9..b50a2e4b9 100644
--- a/Assistant/Threads/PushNotifier.hs
+++ b/Assistant/Threads/PushNotifier.hs
@@ -89,7 +89,7 @@ xmppClient iowaitpush iodebug iopull = do
pull :: [UUID] -> Assistant ()
pull [] = noop
pull us = do
- rs <- filter matching . syncRemotes <$> daemonStatus
+ rs <- filter matching . syncRemotes <$> getDaemonStatus
debug $ "push notification for" : map (fromUUID . Remote.uuid ) rs
pullone rs =<< liftAnnex (inRepo Git.Branch.current)
where
diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs
index 905cf81db..ac65ca14c 100644
--- a/Assistant/Threads/Pusher.hs
+++ b/Assistant/Threads/Pusher.hs
@@ -46,7 +46,7 @@ pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do
-- Now see if now's a good time to push.
if shouldPush commits
then do
- remotes <- filter pushable . syncRemotes <$> daemonStatus
+ remotes <- filter pushable . syncRemotes <$> getDaemonStatus
unless (null remotes) $
void $ alertWhile (pushAlert remotes) $ do
now <- liftIO $ getCurrentTime
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs
index 46f399dab..2ffdc9f32 100644
--- a/Assistant/Threads/SanityChecker.hs
+++ b/Assistant/Threads/SanityChecker.hs
@@ -49,7 +49,7 @@ sanityCheckerThread = NamedThread "SanityChecker" $ forever $ do
{- Only run one check per day, from the time of the last check. -}
waitForNextCheck :: Assistant ()
waitForNextCheck = do
- v <- lastSanityCheck <$> daemonStatus
+ v <- lastSanityCheck <$> getDaemonStatus
now <- liftIO getPOSIXTime
liftIO $ threadDelaySeconds $ Seconds $ calcdelay now v
where
diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs
index e28c24364..c9e20757d 100644
--- a/Assistant/Threads/TransferPoller.hs
+++ b/Assistant/Threads/TransferPoller.hs
@@ -22,10 +22,10 @@ transferPollerThread :: NamedThread
transferPollerThread = NamedThread "TransferPoller" $ do
g <- liftAnnex gitRepo
tn <- liftIO . newNotificationHandle =<<
- transferNotifier <$> daemonStatus
+ transferNotifier <$> getDaemonStatus
forever $ do
liftIO $ threadDelay 500000 -- 0.5 seconds
- ts <- currentTransfers <$> daemonStatus
+ ts <- currentTransfers <$> getDaemonStatus
if M.null ts
-- block until transfers running
then liftIO $ waitNotification tn
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index ec0bc0d9b..c37b1e3b9 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -57,7 +57,7 @@ transferScannerThread = NamedThread "TransferScanner" $ do
- and then the system (or us) crashed, and that info was
- lost.
-}
- startupScan = addScanRemotes True =<< syncRemotes <$> daemonStatus
+ startupScan = addScanRemotes True =<< syncRemotes <$> getDaemonStatus
{- This is a cheap scan for failed transfers involving a remote. -}
failedTransferScan :: Remote -> Assistant ()
@@ -122,7 +122,7 @@ expensiveScan rs = unless onlyweb $ do
locs <- loggedLocations key
{- The syncable remotes may have changed since this
- scan began. -}
- syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
+ syncrs <- liftIO $ syncRemotes <$> getDaemonStatusOld dstatus
present <- inAnnex key
handleDrops' locs syncrs present key (Just f)
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index dee71b731..8d155ecb1 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -133,18 +133,18 @@ onAddSymlink file filestatus = go =<< liftAnnex (Backend.lookupFile file)
link <- liftAnnex $ calcGitLink file key
ifM ((==) link <$> liftIO (readSymbolicLink file))
( do
- s <- daemonStatus
+ s <- getDaemonStatus
checkcontent key s
ensurestaged link s
, do
liftIO $ removeFile file
liftIO $ createSymbolicLink link file
- checkcontent key =<< daemonStatus
+ checkcontent key =<< getDaemonStatus
addlink link
)
go Nothing = do -- other symlink
link <- liftIO (readSymbolicLink file)
- ensurestaged link =<< daemonStatus
+ ensurestaged link =<< getDaemonStatus
{- This is often called on symlinks that are already
- staged correctly. A symlink may have been deleted
diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs
index 94a294549..13f9f0088 100644
--- a/Assistant/TransferQueue.hs
+++ b/Assistant/TransferQueue.hs
@@ -58,7 +58,7 @@ queueTransfersMatching matching schedule q dstatus k f direction
where
go = do
rs <- sufficientremotes
- =<< syncRemotes <$> liftIO (getDaemonStatus dstatus)
+ =<< syncRemotes <$> liftIO (getDaemonStatusOld dstatus)
let matchingrs = filter (matching . Remote.uuid) rs
if null matchingrs
then defer
@@ -92,7 +92,7 @@ queueTransfersMatching matching schedule q dstatus k f direction
queueDeferredDownloads :: Schedule -> TransferQueue -> DaemonStatusHandle -> Annex ()
queueDeferredDownloads schedule q dstatus = do
l <- liftIO $ atomically $ swapTVar (deferreddownloads q) []
- rs <- syncRemotes <$> liftIO (getDaemonStatus dstatus)
+ rs <- syncRemotes <$> liftIO (getDaemonStatusOld dstatus)
left <- filterM (queue rs) l
unless (null left) $
liftIO $ atomically $ modifyTVar' (deferreddownloads q) $
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-03 23:24:30 +0000