2011-06-02 01:56:04 +00:00
|
|
|
{- git-annex remotes types
|
2011-03-27 21:12:32 +00:00
|
|
|
-
|
2011-12-31 08:14:33 +00:00
|
|
|
- Most things should not need this, using Types instead
|
2011-03-27 19:56:43 +00:00
|
|
|
-
|
2014-01-13 18:41:10 +00:00
|
|
|
- Copyright 2011-2014 Joey Hess <joey@kitenet.net>
|
2011-03-27 19:56:43 +00:00
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
2014-01-13 18:41:10 +00:00
|
|
|
module Types.Remote
|
|
|
|
( RemoteConfigKey
|
|
|
|
, RemoteConfig
|
|
|
|
, RemoteTypeA(..)
|
|
|
|
, RemoteA(..)
|
|
|
|
, Availability(..)
|
|
|
|
)
|
|
|
|
where
|
2011-03-27 19:56:43 +00:00
|
|
|
|
2011-03-29 03:51:07 +00:00
|
|
|
import Data.Map as M
|
2011-07-15 07:12:05 +00:00
|
|
|
import Data.Ord
|
2011-03-27 19:56:43 +00:00
|
|
|
|
2011-06-30 17:16:57 +00:00
|
|
|
import qualified Git
|
2011-06-02 01:56:04 +00:00
|
|
|
import Types.Key
|
2011-11-07 18:46:01 +00:00
|
|
|
import Types.UUID
|
2013-01-01 17:52:47 +00:00
|
|
|
import Types.GitConfig
|
2014-01-13 18:41:10 +00:00
|
|
|
import Types.Availability
|
2014-02-11 18:06:50 +00:00
|
|
|
import Types.Creds
|
2014-12-11 19:32:42 +00:00
|
|
|
import Types.UrlContents
|
2013-03-13 20:16:01 +00:00
|
|
|
import Config.Cost
|
2013-03-28 21:03:04 +00:00
|
|
|
import Utility.Metered
|
2013-11-07 22:02:00 +00:00
|
|
|
import Git.Types
|
2013-10-11 20:03:18 +00:00
|
|
|
import Utility.SafeCommand
|
2014-12-08 17:40:15 +00:00
|
|
|
import Utility.Url
|
2011-03-27 19:56:43 +00:00
|
|
|
|
2012-11-14 23:32:27 +00:00
|
|
|
type RemoteConfigKey = String
|
|
|
|
type RemoteConfig = M.Map RemoteConfigKey String
|
2011-04-15 19:09:36 +00:00
|
|
|
|
2011-03-29 03:51:07 +00:00
|
|
|
{- There are different types of remotes. -}
|
2011-12-31 08:11:39 +00:00
|
|
|
data RemoteTypeA a = RemoteType {
|
2011-03-29 03:51:07 +00:00
|
|
|
-- human visible type name
|
|
|
|
typename :: String,
|
2011-03-29 21:57:20 +00:00
|
|
|
-- enumerates remotes of this type
|
|
|
|
enumerate :: a [Git.Repo],
|
|
|
|
-- generates a remote of this type
|
2013-09-12 19:54:35 +00:00
|
|
|
generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (Maybe (RemoteA a)),
|
2011-03-29 18:55:59 +00:00
|
|
|
-- initializes or changes a remote
|
2014-02-11 18:06:50 +00:00
|
|
|
setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> a (RemoteConfig, UUID)
|
2011-03-29 03:51:07 +00:00
|
|
|
}
|
|
|
|
|
2011-12-31 08:11:39 +00:00
|
|
|
instance Eq (RemoteTypeA a) where
|
2011-12-31 07:27:37 +00:00
|
|
|
x == y = typename x == typename y
|
|
|
|
|
2011-03-29 03:51:07 +00:00
|
|
|
{- An individual remote. -}
|
2011-12-31 08:11:39 +00:00
|
|
|
data RemoteA a = Remote {
|
2011-03-27 19:56:43 +00:00
|
|
|
-- each Remote has a unique uuid
|
2011-11-07 18:46:01 +00:00
|
|
|
uuid :: UUID,
|
2011-03-27 19:56:43 +00:00
|
|
|
-- each Remote has a human visible name
|
2013-09-27 03:28:25 +00:00
|
|
|
name :: RemoteName,
|
2011-03-27 19:56:43 +00:00
|
|
|
-- Remotes have a use cost; higher is more expensive
|
2013-03-13 20:16:01 +00:00
|
|
|
cost :: Cost,
|
2014-07-26 17:25:06 +00:00
|
|
|
-- Transfers a key's contents from disk to the remote.
|
resume interrupted chunked uploads
Leverage the new chunked remotes to automatically resume uploads.
Sort of like rsync, although of course not as efficient since this
needs to start at a chunk boundry.
But, unlike rsync, this method will work for S3, WebDAV, external
special remotes, etc, etc. Only directory special remotes so far,
but many more soon!
This implementation will also allow starting an upload from one repository,
interrupting it, and then resuming the upload to the same remote from
an entirely different repository.
Note that I added a comment that storeKey should atomically move the content
into place once it's all received. This was already an undocumented
requirement -- it's necessary for hasKey to work reliably. This resume code
just uses hasKey to find the first chunk that's missing.
Note that if there are two uploads of the same key to the same chunked remote,
one might resume at the point the other had gotten to, but both will then
redundantly upload. As before.
In the non-resume case, this adds one hasKey call per storeKey, and only
if the remote is configured to use chunks. Future work: Try to eliminate that
hasKey. Notice that eg, `git annex copy --to` checks if the key is present
before sending it, so is already running hasKey.. which could perhaps
be cached and reused.
However, this additional overhead is not very large compared with
transferring an entire large file, and the ability to resume
is certianly worth it. There is an optimisation in place for small files,
that avoids trying to resume if the whole file fits within one chunk.
This commit was sponsored by Georg Bauer.
2014-07-28 18:18:08 +00:00
|
|
|
-- The key should not appear to be present on the remote until
|
|
|
|
-- all of its contents have been transferred.
|
2012-09-21 18:50:14 +00:00
|
|
|
storeKey :: Key -> AssociatedFile -> MeterUpdate -> a Bool,
|
2013-04-11 21:15:45 +00:00
|
|
|
-- Retrieves a key's contents to a file.
|
|
|
|
-- (The MeterUpdate does not need to be used if it retrieves
|
|
|
|
-- directly to the file, and not to an intermediate file.)
|
|
|
|
retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> a Bool,
|
2012-01-20 17:23:11 +00:00
|
|
|
-- retrieves a key's contents to a tmp file, if it can be done cheaply
|
|
|
|
retrieveKeyFileCheap :: Key -> FilePath -> a Bool,
|
2014-07-28 18:14:01 +00:00
|
|
|
-- removes a key's contents (succeeds if the contents are not present)
|
2011-03-27 20:17:56 +00:00
|
|
|
removeKey :: Key -> a Bool,
|
2014-08-06 17:45:19 +00:00
|
|
|
-- Checks if a key is present in the remote.
|
|
|
|
-- Throws an exception if the remote cannot be accessed.
|
|
|
|
checkPresent :: Key -> a Bool,
|
|
|
|
-- Some remotes can checkPresent without an expensive network
|
2011-03-27 19:56:43 +00:00
|
|
|
-- operation.
|
2014-08-06 17:45:19 +00:00
|
|
|
checkPresentCheap :: Bool,
|
2012-02-14 07:49:48 +00:00
|
|
|
-- Some remotes can provide additional details for whereis.
|
|
|
|
whereisKey :: Maybe (Key -> a [String]),
|
2013-10-11 20:03:18 +00:00
|
|
|
-- Some remotes can run a fsck operation on the remote,
|
|
|
|
-- without transferring all the data to the local repo
|
|
|
|
-- The parameters are passed to the fsck command on the remote.
|
|
|
|
remoteFsck :: Maybe ([CommandParam] -> a (IO Bool)),
|
2013-10-27 19:38:59 +00:00
|
|
|
-- Runs an action to repair the remote's git repository.
|
|
|
|
repairRepo :: Maybe (a Bool -> a (IO Bool)),
|
2012-11-30 04:55:59 +00:00
|
|
|
-- a Remote has a persistent configuration store
|
|
|
|
config :: RemoteConfig,
|
2013-01-01 17:52:47 +00:00
|
|
|
-- git repo for the Remote
|
2011-12-31 07:27:37 +00:00
|
|
|
repo :: Git.Repo,
|
2013-01-01 17:52:47 +00:00
|
|
|
-- a Remote's configuration from git
|
|
|
|
gitconfig :: RemoteGitConfig,
|
2012-08-26 18:26:43 +00:00
|
|
|
-- a Remote can be assocated with a specific local filesystem path
|
|
|
|
localpath :: Maybe FilePath,
|
2012-08-26 19:39:02 +00:00
|
|
|
-- a Remote can be known to be readonly
|
|
|
|
readonly :: Bool,
|
2013-03-15 23:16:13 +00:00
|
|
|
-- a Remote can be globally available. (Ie, "in the cloud".)
|
2014-01-13 18:41:10 +00:00
|
|
|
availability :: Availability,
|
2011-12-31 07:27:37 +00:00
|
|
|
-- the type of the remote
|
2014-08-10 18:52:58 +00:00
|
|
|
remotetype :: RemoteTypeA a,
|
|
|
|
-- For testing, makes a version of this remote that is not
|
|
|
|
-- available for use. All its actions should fail.
|
2014-10-21 18:36:09 +00:00
|
|
|
mkUnavailable :: a (Maybe (RemoteA a)),
|
|
|
|
-- Information about the remote, for git annex info to display.
|
2014-12-08 17:40:15 +00:00
|
|
|
getInfo :: a [(String, String)],
|
|
|
|
-- Some remotes can download from an url (or uri).
|
2014-12-11 18:09:57 +00:00
|
|
|
claimUrl :: Maybe (URLString -> a Bool),
|
2014-12-11 19:32:42 +00:00
|
|
|
-- Checks that the url is accessible, and gets information about
|
|
|
|
-- its contents, without downloading the full content.
|
2014-12-08 23:14:24 +00:00
|
|
|
-- Throws an exception if the url is inaccessible.
|
2014-12-11 19:32:42 +00:00
|
|
|
checkUrl :: Maybe (URLString -> a UrlContents)
|
2011-03-27 19:56:43 +00:00
|
|
|
}
|
|
|
|
|
2011-12-31 08:11:39 +00:00
|
|
|
instance Show (RemoteA a) where
|
2011-03-30 19:15:46 +00:00
|
|
|
show remote = "Remote { name =\"" ++ name remote ++ "\" }"
|
2011-03-27 19:56:43 +00:00
|
|
|
|
|
|
|
-- two remotes are the same if they have the same uuid
|
2011-12-31 08:11:39 +00:00
|
|
|
instance Eq (RemoteA a) where
|
2011-03-27 20:17:56 +00:00
|
|
|
x == y = uuid x == uuid y
|
2011-03-27 19:56:43 +00:00
|
|
|
|
2011-12-31 08:11:39 +00:00
|
|
|
instance Ord (RemoteA a) where
|
2013-03-16 21:43:42 +00:00
|
|
|
compare = comparing uuid
|