aboutsummaryrefslogtreecommitdiff
path: root/Assistant/Types/DaemonStatus.hs
blob: 8bb66261e548a4cb61da4d732582ea89715b3bc8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
{- git-annex assistant daemon status
 -
 - Copyright 2012 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Assistant.Types.DaemonStatus where

import Annex.Common
import Assistant.Pairing
import Utility.NotificationBroadcaster
import Types.Transfer
import Assistant.Types.ThreadName
import Assistant.Types.NetMessager
import Assistant.Types.Alert
import Utility.Url

import Control.Concurrent.STM
import Control.Concurrent.MVar
import Control.Concurrent.Async
import Data.Time.Clock.POSIX
import qualified Data.Map as M
import qualified Data.Set as S

data DaemonStatus = DaemonStatus
	-- All the named threads that comprise the daemon,
	-- and actions to run to restart them.
	{ startedThreads :: M.Map ThreadName (Async (), IO ())
	-- False when the daemon is performing its startup scan
	, scanComplete :: Bool
	-- True when all files should be restaged.
	, forceRestage :: Bool
	-- Time when a previous process of the daemon was running ok
	, lastRunning :: Maybe POSIXTime
	-- True when the daily sanity checker is running
	, sanityCheckRunning :: Bool
	-- Last time the daily sanity checker ran
	, lastSanityCheck :: Maybe POSIXTime
	-- True when a scan for file transfers is running
	, transferScanRunning :: Bool
	-- Currently running file content transfers
	, currentTransfers :: TransferMap
	-- Messages to display to the user.
	, alertMap :: AlertMap
	, lastAlertId :: AlertId
	-- Ordered list of all remotes that can be synced with
	, syncRemotes :: [Remote]
	-- Ordered list of remotes to sync git with
	, syncGitRemotes :: [Remote]
	-- Ordered list of remotes to sync data with
	, syncDataRemotes :: [Remote]
	-- Are we syncing to any cloud remotes?
	, syncingToCloudRemote :: Bool
	-- Set of uuids of remotes that are currently connected.
	, currentlyConnectedRemotes :: S.Set UUID
	-- List of uuids of remotes that we may have gotten out of sync with.
	, desynced :: S.Set UUID
	-- Pairing request that is in progress.
	, pairingInProgress :: Maybe PairingInProgress
	-- Broadcasts notifications about all changes to the DaemonStatus.
	, changeNotifier :: NotificationBroadcaster
	-- Broadcasts notifications when queued or current transfers change.
	, transferNotifier :: NotificationBroadcaster
	-- Broadcasts notifications when there's a change to the alerts.
	, alertNotifier :: NotificationBroadcaster
	-- Broadcasts notifications when the syncRemotes change.
	, syncRemotesNotifier :: NotificationBroadcaster
	-- Broadcasts notifications when the scheduleLog changes.
	, scheduleLogNotifier :: NotificationBroadcaster
	-- Broadcasts a notification once the startup sanity check has run.
	, startupSanityCheckNotifier :: NotificationBroadcaster
	-- Broadcasts notifications when the network is connected.
	, networkConnectedNotifier :: NotificationBroadcaster
	-- Broadcasts notifications when a global redirect is needed.
	, globalRedirNotifier :: NotificationBroadcaster
	, globalRedirUrl :: Maybe URLString
	-- Actions to run after a Key is transferred.
	, transferHook :: M.Map Key (Transfer -> IO ())
	-- When the XMPP client is connected, this will contain the XMPP
	-- address.
	, xmppClientID :: Maybe ClientID
	-- MVars to signal when a remote gets connected.
	, connectRemoteNotifiers :: M.Map UUID [MVar ()]
	}

type TransferMap = M.Map Transfer TransferInfo

{- This TMVar is never left empty, so accessing it will never block. -}
type DaemonStatusHandle = TMVar DaemonStatus

newDaemonStatus :: IO DaemonStatus
newDaemonStatus = DaemonStatus
	<$> pure M.empty
	<*> pure False
	<*> pure False
	<*> pure Nothing
	<*> pure False
	<*> pure Nothing
	<*> pure False
	<*> pure M.empty
	<*> pure M.empty
	<*> pure firstAlertId
	<*> pure []
	<*> pure []
	<*> pure []
	<*> pure False
	<*> pure S.empty
	<*> pure S.empty
	<*> pure Nothing
	<*> newNotificationBroadcaster
	<*> newNotificationBroadcaster
	<*> newNotificationBroadcaster
	<*> newNotificationBroadcaster
	<*> newNotificationBroadcaster
	<*> newNotificationBroadcaster
	<*> newNotificationBroadcaster
	<*> newNotificationBroadcaster
	<*> pure Nothing
	<*> pure M.empty
	<*> pure Nothing
	<*> pure M.empty