mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

Assistant monad, stage 1

Browse source 
This adds the Assistant monad, and an AssistantData structure.
So far, none of the assistant's threads run in the monad yet.
This commit is contained in:
Joey Hess 2012-10-29 00:15:43 -04:00
parent ec0bac9d73
commit 4e765327ca
18 changed files with 259 additions and 210 deletions
Download patch file Download diff file Expand all files Collapse all files

6
Assistant/WebApp/Configurators/S3.hs
View file

@ -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