17c9ff576d
A long time ago I made Remote be an instance of the Ord typeclass, with an implementation that compared the costs of Remotes. That seemed like a good idea at the time, as it saved typing.. But at the time I was still making custom Read and Show instances too. I've since learned that this is *not* a good idea, and neither is making custom Ord instances, without deep thought about the possible sets of values in a type. Haskell typeclasses are not a toy. This Ord instance came around and bit me when I put Remotes into a Set, because now remotes with the same cost appeared to be in the Set even if they were not. Also affected putting Remotes into a Map. Rarely does a bug go this deep. I've fixed it comprehensively, first removing the Ord instance entirely, and fixing the places that wanted to order remotes by cost to do it explicitly. Then adding back an Ord instance that is much more sane. Also by checking the rest of the Ord instances in the code base (which were all ok). While doing that, I found lots of places that kept remotes in Maps and Sets. All of it was probably subtly broken in one way or another before this fix, but it would be hard to say exactly how the bugs would manifest.
91 lines
2.7 KiB
Haskell
91 lines
2.7 KiB
Haskell
{- git-annex remotes types
|
|
-
|
|
- Most things should not need this, using Types instead
|
|
-
|
|
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Types.Remote where
|
|
|
|
import Data.Map as M
|
|
import Data.Ord
|
|
|
|
import qualified Git
|
|
import Types.Key
|
|
import Types.UUID
|
|
import Types.Meters
|
|
import Types.GitConfig
|
|
import Config.Cost
|
|
|
|
type RemoteConfigKey = String
|
|
type RemoteConfig = M.Map RemoteConfigKey String
|
|
|
|
{- There are different types of remotes. -}
|
|
data RemoteTypeA a = RemoteType {
|
|
-- human visible type name
|
|
typename :: String,
|
|
-- enumerates remotes of this type
|
|
enumerate :: a [Git.Repo],
|
|
-- generates a remote of this type
|
|
generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (RemoteA a),
|
|
-- initializes or changes a remote
|
|
setup :: UUID -> RemoteConfig -> a RemoteConfig
|
|
}
|
|
|
|
instance Eq (RemoteTypeA a) where
|
|
x == y = typename x == typename y
|
|
|
|
{- A filename associated with a Key, for display to user. -}
|
|
type AssociatedFile = Maybe FilePath
|
|
|
|
{- An individual remote. -}
|
|
data RemoteA a = Remote {
|
|
-- each Remote has a unique uuid
|
|
uuid :: UUID,
|
|
-- each Remote has a human visible name
|
|
name :: String,
|
|
-- Remotes have a use cost; higher is more expensive
|
|
cost :: Cost,
|
|
-- Transfers a key to the remote.
|
|
storeKey :: Key -> AssociatedFile -> MeterUpdate -> a Bool,
|
|
-- retrieves a key's contents to a file
|
|
retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> a Bool,
|
|
-- retrieves a key's contents to a tmp file, if it can be done cheaply
|
|
retrieveKeyFileCheap :: Key -> FilePath -> a Bool,
|
|
-- removes a key's contents
|
|
removeKey :: Key -> a Bool,
|
|
-- Checks if a key is present in the remote; if the remote
|
|
-- cannot be accessed returns a Left error message.
|
|
hasKey :: Key -> a (Either String Bool),
|
|
-- Some remotes can check hasKey without an expensive network
|
|
-- operation.
|
|
hasKeyCheap :: Bool,
|
|
-- Some remotes can provide additional details for whereis.
|
|
whereisKey :: Maybe (Key -> a [String]),
|
|
-- a Remote has a persistent configuration store
|
|
config :: RemoteConfig,
|
|
-- git repo for the Remote
|
|
repo :: Git.Repo,
|
|
-- a Remote's configuration from git
|
|
gitconfig :: RemoteGitConfig,
|
|
-- a Remote can be assocated with a specific local filesystem path
|
|
localpath :: Maybe FilePath,
|
|
-- a Remote can be known to be readonly
|
|
readonly :: Bool,
|
|
-- a Remote can be globally available. (Ie, "in the cloud".)
|
|
globallyAvailable :: Bool,
|
|
-- the type of the remote
|
|
remotetype :: RemoteTypeA a
|
|
}
|
|
|
|
instance Show (RemoteA a) where
|
|
show remote = "Remote { name =\"" ++ name remote ++ "\" }"
|
|
|
|
-- two remotes are the same if they have the same uuid
|
|
instance Eq (RemoteA a) where
|
|
x == y = uuid x == uuid y
|
|
|
|
instance Ord (RemoteA a) where
|
|
compare = comparing uuid
|