Assistant monad, stage 1

This adds the Assistant monad, and an AssistantData structure.
So far, none of the assistant's threads run in the monad yet.

Assistant/WebApp/Configurators/Edit.hs

@@ -69,7 +69,7 @@ setRepoConfig uuid mremote oldc newc = do
 	when (repoSyncable oldc /= repoSyncable newc) $
 		changeSyncable mremote (repoSyncable newc)
 	when (isJust mremote && repoName oldc /= repoName newc) $ do
-		dstatus <- daemonStatus <$> getYesod
+		dstatus <- getAssistantY daemonStatus
 		runAnnex undefined $ do
 			name <- fromRepo $ uniqueRemoteName (T.unpack $ repoName newc) 0
 			inRepo $ Git.Command.run "remote"

Assistant/WebApp/Configurators/Pairing.hs

@@ -87,7 +87,7 @@ getInprogressPairR _ = noPairing
  -}
 startPairing :: PairStage -> IO () -> (AlertButton -> Alert) -> Maybe UUID -> Text -> Secret -> Widget
 startPairing stage oncancel alert muuid displaysecret secret = do
-	dstatus <- daemonStatus <$> lift getYesod
+	dstatus <- lift $ getAssistantY daemonStatus
 	urlrender <- lift getUrlRender
 	reldir <- fromJust . relDir <$> lift getYesod
 

Assistant/WebApp/Configurators/S3.hs

@@ -116,13 +116,13 @@ getEnableS3R uuid = s3Configurator $ do
 
 makeS3Remote :: S3Creds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
 makeS3Remote (S3Creds ak sk) name setup config = do
-	webapp <- getYesod
-	let st = fromJust $ threadState webapp
+	d <- getAssistantY id
+	let st = threadState d
 	remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
 	liftIO $ S3.s3SetCredsEnv ( T.unpack ak, T.unpack sk)
 	r <- liftIO $ runThreadState st $ addRemote $ do
 		makeSpecialRemote name S3.remote config
 		return remotename
 	setup r
-	liftIO $ syncNewRemote st (daemonStatus webapp) (scanRemotes webapp) r
+	liftIO $ syncNewRemote st (daemonStatus d) (scanRemoteMap d) r
 	redirect $ EditNewCloudRepositoryR $ Remote.uuid r

Assistant/WebApp/Configurators/Ssh.hs

@@ -283,11 +283,11 @@ makeSsh' rsync setup sshdata keypair =
 
 makeSshRepo :: Bool -> (Remote -> Handler ()) -> SshData -> Handler RepHtml
 makeSshRepo forcersync setup sshdata = do
-	webapp <- getYesod
+	d <- getAssistantY id
 	r <- liftIO $ makeSshRemote
-		(fromJust $ threadState webapp)
-		(daemonStatus webapp)
-		(scanRemotes webapp)
+		(threadState d)
+		(daemonStatus d)
+		(scanRemoteMap d)
 		forcersync sshdata
 	setup r
 	redirect $ EditNewCloudRepositoryR $ Remote.uuid r

Assistant/WebApp/Configurators/XMPP.hs

@@ -34,7 +34,7 @@ import qualified Data.Text as T
 {- Displays an alert suggesting to configure XMPP, with a button. -}
 xmppNeeded :: Handler ()
 xmppNeeded = whenM (isNothing <$> runAnnex Nothing getXMPPCreds) $ do
-	dstatus <- daemonStatus <$> getYesod
+	dstatus <- getAssistantY daemonStatus
 	urlrender <- getUrlRender
 	void $ liftIO $ addAlert dstatus $ xmppNeededAlert $ AlertButton
 		{ buttonLabel = "Configure a Jabber account"
@@ -59,7 +59,7 @@ getXMPPR = xmppPage $ do
 	where
 		storecreds creds = do
 			void $ runAnnex undefined $ setXMPPCreds creds
-			liftIO . notifyRestart =<< pushNotifier <$> getYesod
+			liftIO . notifyRestart =<< getAssistantY pushNotifier
 			redirect ConfigR
 #else
 getXMPPR = xmppPage $