6c565ec905
This has not been tested at all. It compiles! The only known missing things are support for encryption, and for get/set of special remote configuration, and of key state. (The latter needs separate work to add a new per-key log file to store that state.) Only thing I don't much like is that initremote needs to be passed both type=external and externaltype=foo. It would be better to have just type=foo Most of this is quite straightforward code, that largely wrote itself given the types. The only tricky parts were: * Need to lock the remote when using it to eg make a request, because in theory git-annex could have multiple threads that each try to use a remote at the same time. I don't think that git-annex ever does that currently, but better safe than sorry. * Rather than starting up every external special remote program when git-annex starts, they are started only on demand, when first used. This will avoid slowdown, especially when running fast git-annex query commands. Once started, they keep running until git-annex stops, currently, which may not be ideal, but it's hard to know a better time to stop them. * Bit of a chicken and egg problem with caching the cost of the remote, because setting annex-cost in the git config needs the remote to already be set up. Managed to finesse that. This commit was sponsored by Lukas Anzinger.
37 lines
1.1 KiB
Haskell
37 lines
1.1 KiB
Haskell
{- git-annex assistant webapp making remotes
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.WebApp.MakeRemote (
|
|
module Assistant.MakeRemote,
|
|
module Assistant.WebApp.MakeRemote
|
|
) where
|
|
|
|
import Assistant.Common
|
|
import Assistant.WebApp.Types
|
|
import Assistant.Sync
|
|
import qualified Remote
|
|
import qualified Types.Remote as Remote
|
|
import qualified Config
|
|
import Config.Cost
|
|
import Types.StandardGroups
|
|
import Git.Types (RemoteName)
|
|
import Logs.PreferredContent
|
|
import Assistant.MakeRemote
|
|
|
|
import Utility.Yesod
|
|
|
|
{- Runs an action that creates or enables a cloud remote,
|
|
- and finishes setting it up, then starts syncing with it,
|
|
- and finishes by displaying the page to edit it. -}
|
|
setupCloudRemote :: StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a
|
|
setupCloudRemote defaultgroup mcost maker = do
|
|
r <- liftAnnex $ addRemote maker
|
|
liftAnnex $ do
|
|
setStandardGroup (Remote.uuid r) defaultgroup
|
|
maybe noop (Config.setRemoteCost (Remote.repo r)) mcost
|
|
liftAssistant $ syncRemote r
|
|
redirect $ EditNewCloudRepositoryR $ Remote.uuid r
|