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
|
|
|
-
|
|
|
|
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
2011-06-02 01:56:04 +00:00
|
|
|
module Types.Remote 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
|
2013-03-13 20:16:01 +00:00
|
|
|
import Config.Cost
|
2013-03-28 21:03:04 +00:00
|
|
|
import Utility.Metered
|
2013-09-27 03:28:25 +00:00
|
|
|
import Git.Remote
|
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
|
2013-09-07 22:38:00 +00:00
|
|
|
setup :: Maybe UUID -> 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,
|
2011-03-27 19:56:43 +00:00
|
|
|
-- Transfers a key to the remote.
|
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,
|
2011-03-27 19:56:43 +00:00
|
|
|
-- removes a key's contents
|
2011-03-27 20:17:56 +00:00
|
|
|
removeKey :: Key -> a Bool,
|
2011-03-27 19:56:43 +00:00
|
|
|
-- Checks if a key is present in the remote; if the remote
|
2011-11-09 22:33:15 +00:00
|
|
|
-- cannot be accessed returns a Left error message.
|
|
|
|
hasKey :: Key -> a (Either String Bool),
|
2011-03-27 19:56:43 +00:00
|
|
|
-- Some remotes can check hasKey without an expensive network
|
|
|
|
-- operation.
|
2011-03-29 03:51:07 +00:00
|
|
|
hasKeyCheap :: Bool,
|
2012-02-14 07:49:48 +00:00
|
|
|
-- Some remotes can provide additional details for whereis.
|
|
|
|
whereisKey :: Maybe (Key -> a [String]),
|
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".)
|
|
|
|
globallyAvailable :: Bool,
|
2011-12-31 07:27:37 +00:00
|
|
|
-- the type of the remote
|
2011-12-31 08:11:39 +00:00
|
|
|
remotetype :: RemoteTypeA a
|
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
|