partially complete gcrypt remote (local send done; rest not)
This is a git-remote-gcrypt encrypted special remote. Only sending files in to the remote works, and only for local repositories. Most of the work so far has involved making initremote work. A particular problem is that remote setup in this case needs to generate its own uuid, derivied from the gcrypt-id. That required some larger changes in the code to support. For ssh remotes, this will probably just reuse Remote.Rsync's code, so should be easy enough. And for downloading from a web remote, I will need to factor out the part of Remote.Git that does that. One particular thing that will need work is supporting hot-swapping a local gcrypt remote. I think it needs to store the gcrypt-id in the git config of the local remote, so that it can check it every time, and compare with the cached annex-uuid for the remote. If there is a mismatch, it can change both the cached annex-uuid and the gcrypt-id. That should work, and I laid some groundwork for it by already reading the remote's config when it's local. (Also needed for other reasons.) This commit was sponsored by Daniel Callahan.
This commit is contained in:
parent
0ab6764fe9
commit
7c1a9cdeb9
17 changed files with 306 additions and 92 deletions
|
@ -68,8 +68,8 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $
|
||||||
go =<< Command.InitRemote.findExisting name
|
go =<< Command.InitRemote.findExisting name
|
||||||
where
|
where
|
||||||
go Nothing = setupSpecialRemote name Rsync.remote config
|
go Nothing = setupSpecialRemote name Rsync.remote config
|
||||||
=<< Command.InitRemote.generateNew name
|
(Nothing, Command.InitRemote.newConfig name)
|
||||||
go (Just v) = setupSpecialRemote name Rsync.remote config v
|
go (Just (u, c)) = setupSpecialRemote name Rsync.remote config (Just u, c)
|
||||||
config = M.fromList
|
config = M.fromList
|
||||||
[ ("encryption", "shared")
|
[ ("encryption", "shared")
|
||||||
, ("rsyncurl", location)
|
, ("rsyncurl", location)
|
||||||
|
@ -89,7 +89,7 @@ initSpecialRemote name remotetype config = go 0
|
||||||
r <- Command.InitRemote.findExisting fullname
|
r <- Command.InitRemote.findExisting fullname
|
||||||
case r of
|
case r of
|
||||||
Nothing -> setupSpecialRemote fullname remotetype config
|
Nothing -> setupSpecialRemote fullname remotetype config
|
||||||
=<< Command.InitRemote.generateNew fullname
|
(Nothing, Command.InitRemote.newConfig fullname)
|
||||||
Just _ -> go (n + 1)
|
Just _ -> go (n + 1)
|
||||||
|
|
||||||
{- Enables an existing special remote. -}
|
{- Enables an existing special remote. -}
|
||||||
|
@ -98,15 +98,15 @@ enableSpecialRemote name remotetype config = do
|
||||||
r <- Command.InitRemote.findExisting name
|
r <- Command.InitRemote.findExisting name
|
||||||
case r of
|
case r of
|
||||||
Nothing -> error $ "Cannot find a special remote named " ++ name
|
Nothing -> error $ "Cannot find a special remote named " ++ name
|
||||||
Just v -> setupSpecialRemote name remotetype config v
|
Just (u, c) -> setupSpecialRemote name remotetype config (Just u, c)
|
||||||
|
|
||||||
setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> (UUID, R.RemoteConfig) -> Annex RemoteName
|
setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName
|
||||||
setupSpecialRemote name remotetype config (u, c) = do
|
setupSpecialRemote name remotetype config (mu, c) = do
|
||||||
{- Currently, only 'weak' ciphers can be generated from the
|
{- Currently, only 'weak' ciphers can be generated from the
|
||||||
- assistant, because otherwise GnuPG may block once the entropy
|
- assistant, because otherwise GnuPG may block once the entropy
|
||||||
- pool is drained, and as of now there's no way to tell the user
|
- pool is drained, and as of now there's no way to tell the user
|
||||||
- to perform IO actions to refill the pool. -}
|
- to perform IO actions to refill the pool. -}
|
||||||
c' <- R.setup remotetype u $
|
(c', u) <- R.setup remotetype mu $
|
||||||
M.insert "highRandomQuality" "false" $ M.union config c
|
M.insert "highRandomQuality" "false" $ M.union config c
|
||||||
describeUUID u name
|
describeUUID u name
|
||||||
configSet u c'
|
configSet u c'
|
||||||
|
|
|
@ -47,8 +47,8 @@ unknownNameError prefix = do
|
||||||
|
|
||||||
perform :: RemoteType -> UUID -> R.RemoteConfig -> CommandPerform
|
perform :: RemoteType -> UUID -> R.RemoteConfig -> CommandPerform
|
||||||
perform t u c = do
|
perform t u c = do
|
||||||
c' <- R.setup t u c
|
(c', u') <- R.setup t (Just u) c
|
||||||
next $ cleanup u c'
|
next $ cleanup u' c'
|
||||||
|
|
||||||
cleanup :: UUID -> R.RemoteConfig -> CommandCleanup
|
cleanup :: UUID -> R.RemoteConfig -> CommandCleanup
|
||||||
cleanup u c = do
|
cleanup u c = do
|
||||||
|
|
|
@ -14,7 +14,6 @@ import Command
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Logs.Remote
|
import qualified Logs.Remote
|
||||||
import qualified Types.Remote as R
|
import qualified Types.Remote as R
|
||||||
import Annex.UUID
|
|
||||||
import Logs.UUID
|
import Logs.UUID
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
|
|
||||||
|
@ -34,18 +33,18 @@ start (name:ws) = ifM (isJust <$> findExisting name)
|
||||||
( error $ "There is already a special remote named \"" ++ name ++
|
( error $ "There is already a special remote named \"" ++ name ++
|
||||||
"\". (Use enableremote to enable an existing special remote.)"
|
"\". (Use enableremote to enable an existing special remote.)"
|
||||||
, do
|
, do
|
||||||
(u, c) <- generateNew name
|
let c = newConfig name
|
||||||
t <- findType config
|
t <- findType config
|
||||||
|
|
||||||
showStart "initremote" name
|
showStart "initremote" name
|
||||||
next $ perform t u name $ M.union config c
|
next $ perform t name $ M.union config c
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
config = Logs.Remote.keyValToConfig ws
|
config = Logs.Remote.keyValToConfig ws
|
||||||
|
|
||||||
perform :: RemoteType -> UUID -> String -> R.RemoteConfig -> CommandPerform
|
perform :: RemoteType -> String -> R.RemoteConfig -> CommandPerform
|
||||||
perform t u name c = do
|
perform t name c = do
|
||||||
c' <- R.setup t u c
|
(c', u) <- R.setup t Nothing c
|
||||||
next $ cleanup u name c'
|
next $ cleanup u name c'
|
||||||
|
|
||||||
cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup
|
cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup
|
||||||
|
@ -63,10 +62,8 @@ findExisting name = do
|
||||||
<$> Logs.Remote.readRemoteLog
|
<$> Logs.Remote.readRemoteLog
|
||||||
return $ headMaybe matches
|
return $ headMaybe matches
|
||||||
|
|
||||||
generateNew :: String -> Annex (UUID, R.RemoteConfig)
|
newConfig :: String -> R.RemoteConfig
|
||||||
generateNew name = do
|
newConfig name = M.singleton nameKey name
|
||||||
uuid <- liftIO genUUID
|
|
||||||
return (uuid, M.singleton nameKey name)
|
|
||||||
|
|
||||||
findByName :: String -> M.Map UUID R.RemoteConfig -> [(UUID, R.RemoteConfig)]
|
findByName :: String -> M.Map UUID R.RemoteConfig -> [(UUID, R.RemoteConfig)]
|
||||||
findByName n = filter (matching . snd) . M.toList
|
findByName n = filter (matching . snd) . M.toList
|
||||||
|
|
|
@ -44,23 +44,25 @@ encryptedRepo baserepo = go
|
||||||
go _ = notencrypted
|
go _ = notencrypted
|
||||||
notencrypted = error "not a gcrypt encrypted repository"
|
notencrypted = error "not a gcrypt encrypted repository"
|
||||||
|
|
||||||
|
type RemoteName = String
|
||||||
|
|
||||||
{- gcrypt gives each encrypted repository a uique gcrypt-id,
|
{- gcrypt gives each encrypted repository a uique gcrypt-id,
|
||||||
- which is stored in the repository (in encrypted form)
|
- which is stored in the repository (in encrypted form)
|
||||||
- and cached in a per-remote gcrypt-id configuration setting. -}
|
- and cached in a per-remote gcrypt-id configuration setting. -}
|
||||||
remoteRepoId :: Repo -> Repo -> Maybe String
|
remoteRepoId :: Repo -> Maybe RemoteName -> Maybe String
|
||||||
remoteRepoId = getRemoteConfig "gcrypt-id"
|
remoteRepoId = getRemoteConfig "gcrypt-id"
|
||||||
|
|
||||||
getRemoteConfig :: String -> Repo -> Repo -> Maybe String
|
getRemoteConfig :: String -> Repo -> Maybe RemoteName -> Maybe String
|
||||||
getRemoteConfig field baserepo remote = do
|
getRemoteConfig field repo remotename = do
|
||||||
name <- remoteName remote
|
n <- remotename
|
||||||
Config.getMaybe (remoteConfigKey field name) baserepo
|
Config.getMaybe (remoteConfigKey field n) repo
|
||||||
|
|
||||||
{- Gpg keys that the remote is encrypted for.
|
{- Gpg keys that the remote is encrypted for.
|
||||||
- If empty, gcrypt uses --default-recipient-self -}
|
- If empty, gcrypt uses --default-recipient-self -}
|
||||||
particiantList :: Maybe Repo -> Repo -> Repo -> KeyIds
|
getParticiantList :: Maybe Repo -> Repo -> Maybe RemoteName -> KeyIds
|
||||||
particiantList globalconfigrepo baserepo remote = KeyIds $ parse $ firstJust
|
getParticiantList globalconfigrepo repo remotename = KeyIds $ parse $ firstJust
|
||||||
[ getRemoteConfig "participants" baserepo remote
|
[ getRemoteConfig "gcrypt-participants" repo remotename
|
||||||
, Config.getMaybe defaultkey baserepo
|
, Config.getMaybe defaultkey repo
|
||||||
, Config.getMaybe defaultkey =<< globalconfigrepo
|
, Config.getMaybe defaultkey =<< globalconfigrepo
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
|
@ -69,5 +71,8 @@ particiantList globalconfigrepo baserepo remote = KeyIds $ parse $ firstJust
|
||||||
parse (Just l) = words l
|
parse (Just l) = words l
|
||||||
parse Nothing = []
|
parse Nothing = []
|
||||||
|
|
||||||
remoteConfigKey :: String -> String -> String
|
remoteParticipantConfigKey :: RemoteName -> String
|
||||||
remoteConfigKey key field = "remote." ++ field ++ "." ++ key
|
remoteParticipantConfigKey = remoteConfigKey "gcrypt-participants"
|
||||||
|
|
||||||
|
remoteConfigKey :: String -> RemoteName -> String
|
||||||
|
remoteConfigKey key remotename = "remote." ++ remotename ++ "." ++ key
|
||||||
|
|
|
@ -29,6 +29,7 @@ import Data.ByteString.Lazy.UTF8 (fromString)
|
||||||
import Data.Digest.Pure.SHA
|
import Data.Digest.Pure.SHA
|
||||||
import Utility.UserInfo
|
import Utility.UserInfo
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
import Annex.UUID
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
|
|
||||||
type BupRepo = String
|
type BupRepo = String
|
||||||
|
@ -78,8 +79,10 @@ gen r u c gc = do
|
||||||
where
|
where
|
||||||
buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc
|
buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc
|
||||||
|
|
||||||
bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
|
bupSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||||
bupSetup u c = do
|
bupSetup mu c = do
|
||||||
|
u <- maybe (liftIO genUUID) return mu
|
||||||
|
|
||||||
-- verify configuration is sane
|
-- verify configuration is sane
|
||||||
let buprepo = fromMaybe (error "Specify buprepo=") $
|
let buprepo = fromMaybe (error "Specify buprepo=") $
|
||||||
M.lookup "buprepo" c
|
M.lookup "buprepo" c
|
||||||
|
@ -96,7 +99,7 @@ bupSetup u c = do
|
||||||
-- persistant state, so it can vary between hosts.
|
-- persistant state, so it can vary between hosts.
|
||||||
gitConfigSpecialRemote u c' "buprepo" buprepo
|
gitConfigSpecialRemote u c' "buprepo" buprepo
|
||||||
|
|
||||||
return c'
|
return (c', u)
|
||||||
|
|
||||||
bupParams :: String -> BupRepo -> [CommandParam] -> [CommandParam]
|
bupParams :: String -> BupRepo -> [CommandParam] -> [CommandParam]
|
||||||
bupParams command buprepo params =
|
bupParams command buprepo params =
|
||||||
|
|
|
@ -26,6 +26,7 @@ import Remote.Helper.Encryptable
|
||||||
import Remote.Helper.Chunked
|
import Remote.Helper.Chunked
|
||||||
import Crypto
|
import Crypto
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
import Annex.UUID
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
|
|
||||||
remote :: RemoteType
|
remote :: RemoteType
|
||||||
|
@ -65,8 +66,9 @@ gen r u c gc = do
|
||||||
where
|
where
|
||||||
dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
|
dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
|
||||||
|
|
||||||
directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig
|
directorySetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||||
directorySetup u c = do
|
directorySetup mu c = do
|
||||||
|
u <- maybe (liftIO genUUID) return mu
|
||||||
-- verify configuration is sane
|
-- verify configuration is sane
|
||||||
let dir = fromMaybe (error "Specify directory=") $
|
let dir = fromMaybe (error "Specify directory=") $
|
||||||
M.lookup "directory" c
|
M.lookup "directory" c
|
||||||
|
@ -78,7 +80,7 @@ directorySetup u c = do
|
||||||
-- The directory is stored in git config, not in this remote's
|
-- The directory is stored in git config, not in this remote's
|
||||||
-- persistant state, so it can vary between hosts.
|
-- persistant state, so it can vary between hosts.
|
||||||
gitConfigSpecialRemote u c' "directory" absdir
|
gitConfigSpecialRemote u c' "directory" absdir
|
||||||
return $ M.delete "directory" c'
|
return (M.delete "directory" c', u)
|
||||||
|
|
||||||
{- Locations to try to access a given Key in the Directory.
|
{- Locations to try to access a given Key in the Directory.
|
||||||
- We try more than since we used to write to different hash directories. -}
|
- We try more than since we used to write to different hash directories. -}
|
||||||
|
|
164
Remote/GCrypt.hs
Normal file
164
Remote/GCrypt.hs
Normal file
|
@ -0,0 +1,164 @@
|
||||||
|
{- git remotes encrypted using git-remote-gcrypt
|
||||||
|
-
|
||||||
|
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||||
|
-
|
||||||
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Remote.GCrypt (remote, gen) where
|
||||||
|
|
||||||
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
import Common.Annex
|
||||||
|
import Types.Remote
|
||||||
|
import Types.GitConfig
|
||||||
|
import Types.Crypto
|
||||||
|
import qualified Git
|
||||||
|
import qualified Git.Command
|
||||||
|
import qualified Git.Config
|
||||||
|
import qualified Git.GCrypt
|
||||||
|
import qualified Git.Types as Git ()
|
||||||
|
import qualified Annex.Branch
|
||||||
|
import qualified Annex.Content
|
||||||
|
import Config
|
||||||
|
import Config.Cost
|
||||||
|
import Remote.Helper.Git
|
||||||
|
import Remote.Helper.Encryptable
|
||||||
|
import Utility.Metered
|
||||||
|
import Crypto
|
||||||
|
import Annex.UUID
|
||||||
|
|
||||||
|
remote :: RemoteType
|
||||||
|
remote = RemoteType {
|
||||||
|
typename = "gcrypt",
|
||||||
|
-- Remote.Git takes care of enumerating gcrypt remotes too,
|
||||||
|
-- and will call our gen on them.
|
||||||
|
enumerate = return [],
|
||||||
|
generate = gen,
|
||||||
|
setup = gCryptSetup
|
||||||
|
}
|
||||||
|
|
||||||
|
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
|
||||||
|
gen gcryptr u c gc = do
|
||||||
|
g <- gitRepo
|
||||||
|
-- get underlying git repo with real path, not gcrypt path
|
||||||
|
r <- liftIO $ Git.GCrypt.encryptedRepo g gcryptr
|
||||||
|
let r' = r { Git.remoteName = Git.remoteName gcryptr }
|
||||||
|
-- read config of underlying repo if it's local
|
||||||
|
r'' <- if Git.repoIsLocalUnknown r'
|
||||||
|
then liftIO $ catchDefaultIO r' $ Git.Config.read r'
|
||||||
|
else return r'
|
||||||
|
gen' r'' u c gc
|
||||||
|
|
||||||
|
gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
|
||||||
|
gen' r u c gc = new <$> remoteCost gc defcst
|
||||||
|
where
|
||||||
|
defcst = if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost
|
||||||
|
new cst = encryptableRemote c
|
||||||
|
(store this)
|
||||||
|
(retrieve this)
|
||||||
|
this
|
||||||
|
where
|
||||||
|
this = Remote
|
||||||
|
{ uuid = u
|
||||||
|
, cost = cst
|
||||||
|
, name = Git.repoDescribe r
|
||||||
|
, storeKey = \_ _ _ -> noCrypto
|
||||||
|
, retrieveKeyFile = \_ _ _ _ -> noCrypto
|
||||||
|
, retrieveKeyFileCheap = \_ _ -> return False
|
||||||
|
, removeKey = remove
|
||||||
|
, hasKey = checkPresent this
|
||||||
|
, hasKeyCheap = repoCheap r
|
||||||
|
, whereisKey = Nothing
|
||||||
|
, config = M.empty
|
||||||
|
, localpath = localpathCalc r
|
||||||
|
, repo = r
|
||||||
|
, gitconfig = gc { remoteGitConfig = Just $ extractGitConfig r }
|
||||||
|
, readonly = Git.repoIsHttp r
|
||||||
|
, globallyAvailable = globallyAvailableCalc r
|
||||||
|
, remotetype = remote
|
||||||
|
}
|
||||||
|
|
||||||
|
noCrypto :: Annex a
|
||||||
|
noCrypto = error "cannot use gcrypt remote without encryption enabled"
|
||||||
|
|
||||||
|
gCryptSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||||
|
gCryptSetup mu c = go $ M.lookup "gitrepo" c
|
||||||
|
where
|
||||||
|
remotename = fromJust (M.lookup "name" c)
|
||||||
|
go Nothing = error "Specify gitrepo="
|
||||||
|
go (Just gitrepo) = do
|
||||||
|
c' <- encryptionSetup c
|
||||||
|
inRepo $ Git.Command.run
|
||||||
|
[ Params "remote add"
|
||||||
|
, Param remotename
|
||||||
|
, Param $ Git.GCrypt.urlPrefix ++ gitrepo
|
||||||
|
]
|
||||||
|
|
||||||
|
{- Configure gcrypt to use the same list of keyids that
|
||||||
|
- were passed to initremote, unless shared encryption
|
||||||
|
- was used. -}
|
||||||
|
case extractCipher c' of
|
||||||
|
Nothing -> noCrypto
|
||||||
|
Just (EncryptedCipher _ _ (KeyIds { keyIds = ks})) ->
|
||||||
|
setConfig (ConfigKey $ Git.GCrypt.remoteParticipantConfigKey remotename) (unwords ks)
|
||||||
|
_ -> noop
|
||||||
|
|
||||||
|
{- Run a git fetch and a push to the git repo in order to get
|
||||||
|
- its gcrypt-id set up, so that later git annex commands
|
||||||
|
- will use the remote as a ggcrypt remote. The fetch is
|
||||||
|
- needed if the repo already exists; the push is needed
|
||||||
|
- if the repo has not yet been initialized by gcrypt. -}
|
||||||
|
void $ inRepo $ Git.Command.runBool
|
||||||
|
[ Param "fetch"
|
||||||
|
, Param remotename
|
||||||
|
]
|
||||||
|
void $ inRepo $ Git.Command.runBool
|
||||||
|
[ Param "push"
|
||||||
|
, Param remotename
|
||||||
|
, Param $ show $ Annex.Branch.fullname
|
||||||
|
]
|
||||||
|
g <- inRepo Git.Config.reRead
|
||||||
|
case Git.GCrypt.remoteRepoId g (Just remotename) of
|
||||||
|
Nothing -> error "unable to determine gcrypt-id of remote"
|
||||||
|
Just v -> do
|
||||||
|
let u = genUUIDInNameSpace gCryptNameSpace v
|
||||||
|
if Just u == mu || mu == Nothing
|
||||||
|
then return (c', u)
|
||||||
|
else error "uuid mismatch"
|
||||||
|
|
||||||
|
store :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
|
||||||
|
store r (cipher, enck) k p
|
||||||
|
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $
|
||||||
|
sendwith $ \meterupdate h -> do
|
||||||
|
createDirectoryIfMissing True $ parentDir dest
|
||||||
|
readBytes (meteredWriteFile meterupdate dest) h
|
||||||
|
return True
|
||||||
|
| Git.repoIsSsh (repo r) = sendwith $ \h -> undefined
|
||||||
|
| otherwise = error "storing on non-ssh remote repo not supported"
|
||||||
|
where
|
||||||
|
dest = gCryptLocation r enck
|
||||||
|
sendwith a = metered (Just p) k $ \meterupdate ->
|
||||||
|
Annex.Content.sendAnnex k noop $ \src ->
|
||||||
|
liftIO $ catchBoolIO $
|
||||||
|
encrypt (getGpgEncParams r) cipher (feedFile src) (a meterupdate)
|
||||||
|
|
||||||
|
retrieve :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
|
||||||
|
retrieve r (cipher, enck) k d p = undefined
|
||||||
|
|
||||||
|
remove :: Key -> Annex Bool
|
||||||
|
remove k = undefined
|
||||||
|
|
||||||
|
checkPresent :: Remote -> Key -> Annex (Either String Bool)
|
||||||
|
checkPresent r k
|
||||||
|
| not $ Git.repoIsUrl (repo r) =
|
||||||
|
guardUsable (repo r) unknown $
|
||||||
|
liftIO $ catchDefaultIO unknown $
|
||||||
|
Right <$> doesFileExist (gCryptLocation r k)
|
||||||
|
| Git.repoIsSsh (repo r) = undefined
|
||||||
|
| otherwise = error "storing on non-ssh remote repo not supported"
|
||||||
|
where
|
||||||
|
unknown = Left $ "unable to check " ++ Git.repoDescribe (repo r) ++ show (repo r)
|
||||||
|
|
||||||
|
gCryptLocation :: Remote -> Key -> FilePath
|
||||||
|
gCryptLocation r key = Git.repoLocation (repo r) </> annexLocation key hashDirLower
|
|
@ -13,9 +13,6 @@ module Remote.Git (
|
||||||
repoAvail,
|
repoAvail,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
|
||||||
import Control.Exception.Extensible
|
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Utility.Rsync
|
import Utility.Rsync
|
||||||
import Remote.Helper.Ssh
|
import Remote.Helper.Ssh
|
||||||
|
@ -47,10 +44,14 @@ import Utility.Metered
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
import Utility.CopyFile
|
import Utility.CopyFile
|
||||||
#endif
|
#endif
|
||||||
|
import Remote.Helper.Git
|
||||||
|
import qualified Remote.GCrypt
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Concurrent.MSampleVar
|
import Control.Concurrent.MSampleVar
|
||||||
import System.Process (std_in, std_err)
|
import System.Process (std_in, std_err)
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Control.Exception.Extensible
|
||||||
|
|
||||||
remote :: RemoteType
|
remote :: RemoteType
|
||||||
remote = RemoteType {
|
remote = RemoteType {
|
||||||
|
@ -91,11 +92,10 @@ configRead r = do
|
||||||
(False, _, NoUUID) -> tryGitConfigRead r
|
(False, _, NoUUID) -> tryGitConfigRead r
|
||||||
_ -> return r
|
_ -> return r
|
||||||
|
|
||||||
repoCheap :: Git.Repo -> Bool
|
|
||||||
repoCheap = not . Git.repoIsUrl
|
|
||||||
|
|
||||||
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
|
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
|
||||||
gen r u _ gc = go <$> remoteCost gc defcst
|
gen r u c gc
|
||||||
|
| Git.GCrypt.isEncrypted r = Remote.GCrypt.gen r u c gc
|
||||||
|
| otherwise = go <$> remoteCost gc defcst
|
||||||
where
|
where
|
||||||
defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
|
defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
|
||||||
go cst = new
|
go cst = new
|
||||||
|
@ -112,14 +112,12 @@ gen r u _ gc = go <$> remoteCost gc defcst
|
||||||
, hasKeyCheap = repoCheap r
|
, hasKeyCheap = repoCheap r
|
||||||
, whereisKey = Nothing
|
, whereisKey = Nothing
|
||||||
, config = M.empty
|
, config = M.empty
|
||||||
, localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r
|
, localpath = localpathCalc r
|
||||||
then Just $ Git.repoPath r
|
|
||||||
else Nothing
|
|
||||||
, repo = r
|
, repo = r
|
||||||
, gitconfig = gc
|
, gitconfig = gc
|
||||||
{ remoteGitConfig = Just $ extractGitConfig r }
|
{ remoteGitConfig = Just $ extractGitConfig r }
|
||||||
, readonly = Git.repoIsHttp r
|
, readonly = Git.repoIsHttp r
|
||||||
, globallyAvailable = not $ Git.repoIsLocal r || Git.repoIsLocalUnknown r
|
, globallyAvailable = globallyAvailableCalc r
|
||||||
, remotetype = remote
|
, remotetype = remote
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -131,13 +129,6 @@ repoAvail r
|
||||||
| Git.repoIsLocalUnknown r = return False
|
| Git.repoIsLocalUnknown r = return False
|
||||||
| otherwise = liftIO $ catchBoolIO $ onLocal r $ return True
|
| otherwise = liftIO $ catchBoolIO $ onLocal r $ return True
|
||||||
|
|
||||||
{- Avoids performing an action on a local repository that's not usable.
|
|
||||||
- Does not check that the repository is still available on disk. -}
|
|
||||||
guardUsable :: Git.Repo -> a -> Annex a -> Annex a
|
|
||||||
guardUsable r onerr a
|
|
||||||
| Git.repoIsLocalUnknown r = return onerr
|
|
||||||
| otherwise = a
|
|
||||||
|
|
||||||
{- Tries to read the config for a specified remote, updates state, and
|
{- Tries to read the config for a specified remote, updates state, and
|
||||||
- returns the updated repo. -}
|
- returns the updated repo. -}
|
||||||
tryGitConfigRead :: Git.Repo -> Annex Git.Repo
|
tryGitConfigRead :: Git.Repo -> Annex Git.Repo
|
||||||
|
@ -154,8 +145,9 @@ tryGitConfigRead r
|
||||||
headers <- getHttpHeaders
|
headers <- getHttpHeaders
|
||||||
store $ geturlconfig headers
|
store $ geturlconfig headers
|
||||||
| Git.GCrypt.isEncrypted r = do
|
| Git.GCrypt.isEncrypted r = do
|
||||||
|
-- Generate a UUID from the gcrypt-id
|
||||||
g <- gitRepo
|
g <- gitRepo
|
||||||
case Git.GCrypt.remoteRepoId g r of
|
case Git.GCrypt.remoteRepoId g (Git.remoteName r) of
|
||||||
Nothing -> return r
|
Nothing -> return r
|
||||||
Just v -> store $ liftIO $ setUUID r $
|
Just v -> store $ liftIO $ setUUID r $
|
||||||
genUUIDInNameSpace gCryptNameSpace v
|
genUUIDInNameSpace gCryptNameSpace v
|
||||||
|
@ -261,17 +253,6 @@ inAnnex r key
|
||||||
unknown = Left $ "unable to check " ++ Git.repoDescribe r
|
unknown = Left $ "unable to check " ++ Git.repoDescribe r
|
||||||
showchecking = showAction $ "checking " ++ Git.repoDescribe r
|
showchecking = showAction $ "checking " ++ Git.repoDescribe r
|
||||||
|
|
||||||
{- Runs an action on a local repository inexpensively, by making an annex
|
|
||||||
- monad using that repository. -}
|
|
||||||
onLocal :: Git.Repo -> Annex a -> IO a
|
|
||||||
onLocal r a = do
|
|
||||||
s <- Annex.new r
|
|
||||||
Annex.eval s $ do
|
|
||||||
-- No need to update the branch; its data is not used
|
|
||||||
-- for anything onLocal is used to do.
|
|
||||||
Annex.BranchState.disableUpdate
|
|
||||||
a
|
|
||||||
|
|
||||||
keyUrls :: Git.Repo -> Key -> [String]
|
keyUrls :: Git.Repo -> Key -> [String]
|
||||||
keyUrls r key = map tourl locs
|
keyUrls r key = map tourl locs
|
||||||
where
|
where
|
||||||
|
@ -415,15 +396,16 @@ copyToRemote r key file p
|
||||||
(\d -> rsyncOrCopyFile params object d p)
|
(\d -> rsyncOrCopyFile params object d p)
|
||||||
)
|
)
|
||||||
|
|
||||||
rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool
|
{- Runs an action on a local repository inexpensively, by making an annex
|
||||||
rsyncHelper callback params = do
|
- monad using that repository. -}
|
||||||
showOutput -- make way for progress bar
|
onLocal :: Git.Repo -> Annex a -> IO a
|
||||||
ifM (liftIO $ (maybe rsync rsyncProgress callback) params)
|
onLocal r a = do
|
||||||
( return True
|
s <- Annex.new r
|
||||||
, do
|
Annex.eval s $ do
|
||||||
showLongNote "rsync failed -- run git annex again to resume file transfer"
|
-- No need to update the branch; its data is not used
|
||||||
return False
|
-- for anything onLocal is used to do.
|
||||||
)
|
Annex.BranchState.disableUpdate
|
||||||
|
a
|
||||||
|
|
||||||
{- Copys a file with rsync unless both locations are on the same
|
{- Copys a file with rsync unless both locations are on the same
|
||||||
- filesystem. Then cp could be faster. -}
|
- filesystem. Then cp could be faster. -}
|
||||||
|
@ -456,6 +438,16 @@ rsyncOrCopyFile rsyncparams src dest p =
|
||||||
dorsync = rsyncHelper (Just p) $
|
dorsync = rsyncHelper (Just p) $
|
||||||
rsyncparams ++ [File src, File dest]
|
rsyncparams ++ [File src, File dest]
|
||||||
|
|
||||||
|
rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool
|
||||||
|
rsyncHelper callback params = do
|
||||||
|
showOutput -- make way for progress bar
|
||||||
|
ifM (liftIO $ (maybe rsync rsyncProgress callback) params)
|
||||||
|
( return True
|
||||||
|
, do
|
||||||
|
showLongNote "rsync failed -- run git annex again to resume file transfer"
|
||||||
|
return False
|
||||||
|
)
|
||||||
|
|
||||||
{- Generates rsync parameters that ssh to the remote and asks it
|
{- Generates rsync parameters that ssh to the remote and asks it
|
||||||
- to either receive or send the key's content. -}
|
- to either receive or send the key's content. -}
|
||||||
rsyncParamsRemote :: Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
|
rsyncParamsRemote :: Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
|
||||||
|
|
|
@ -25,6 +25,7 @@ import Creds
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
import Annex.UUID
|
||||||
|
|
||||||
import System.Process
|
import System.Process
|
||||||
|
|
||||||
|
@ -67,13 +68,18 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
|
||||||
remotetype = remote
|
remotetype = remote
|
||||||
}
|
}
|
||||||
|
|
||||||
glacierSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
|
glacierSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||||
glacierSetup u c = do
|
glacierSetup mu c = do
|
||||||
|
u <- maybe (liftIO genUUID) return mu
|
||||||
|
glacierSetup' u c
|
||||||
|
glacierSetup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||||
|
glacierSetup' u c = do
|
||||||
c' <- encryptionSetup c
|
c' <- encryptionSetup c
|
||||||
let fullconfig = c' `M.union` defaults
|
let fullconfig = c' `M.union` defaults
|
||||||
genVault fullconfig u
|
genVault fullconfig u
|
||||||
gitConfigSpecialRemote u fullconfig "glacier" "true"
|
gitConfigSpecialRemote u fullconfig "glacier" "true"
|
||||||
setRemoteCredPair fullconfig (AWS.creds u)
|
c'' <- setRemoteCredPair fullconfig (AWS.creds u)
|
||||||
|
return (c'', u)
|
||||||
where
|
where
|
||||||
remotename = fromJust (M.lookup "name" c)
|
remotename = fromJust (M.lookup "name" c)
|
||||||
defvault = remotename ++ "-" ++ fromUUID u
|
defvault = remotename ++ "-" ++ fromUUID u
|
||||||
|
|
30
Remote/Helper/Git.hs
Normal file
30
Remote/Helper/Git.hs
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
{- Utilities for git remotes.
|
||||||
|
-
|
||||||
|
- Copyright 2011-2012 Joey Hess <joey@kitenet.net>
|
||||||
|
-
|
||||||
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Remote.Helper.Git where
|
||||||
|
|
||||||
|
import Common.Annex
|
||||||
|
import qualified Git
|
||||||
|
|
||||||
|
repoCheap :: Git.Repo -> Bool
|
||||||
|
repoCheap = not . Git.repoIsUrl
|
||||||
|
|
||||||
|
localpathCalc :: Git.Repo -> Maybe FilePath
|
||||||
|
localpathCalc r = if globallyAvailableCalc r
|
||||||
|
then Nothing
|
||||||
|
else Just $ Git.repoPath r
|
||||||
|
|
||||||
|
globallyAvailableCalc :: Git.Repo -> Bool
|
||||||
|
globallyAvailableCalc r = not $
|
||||||
|
Git.repoIsLocal r || Git.repoIsLocalUnknown r
|
||||||
|
|
||||||
|
{- Avoids performing an action on a local repository that's not usable.
|
||||||
|
- Does not check that the repository is still available on disk. -}
|
||||||
|
guardUsable :: Git.Repo -> a -> Annex a -> Annex a
|
||||||
|
guardUsable r onerr a
|
||||||
|
| Git.repoIsLocalUnknown r = return onerr
|
||||||
|
| otherwise = a
|
|
@ -18,6 +18,7 @@ import qualified Git
|
||||||
import Config
|
import Config
|
||||||
import Config.Cost
|
import Config.Cost
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
import Annex.UUID
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Encryptable
|
import Remote.Helper.Encryptable
|
||||||
import Crypto
|
import Crypto
|
||||||
|
@ -62,13 +63,14 @@ gen r u c gc = do
|
||||||
where
|
where
|
||||||
hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc
|
hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc
|
||||||
|
|
||||||
hookSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
|
hookSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||||
hookSetup u c = do
|
hookSetup mu c = do
|
||||||
|
u <- maybe (liftIO genUUID) return mu
|
||||||
let hooktype = fromMaybe (error "Specify hooktype=") $
|
let hooktype = fromMaybe (error "Specify hooktype=") $
|
||||||
M.lookup "hooktype" c
|
M.lookup "hooktype" c
|
||||||
c' <- encryptionSetup c
|
c' <- encryptionSetup c
|
||||||
gitConfigSpecialRemote u c' "hooktype" hooktype
|
gitConfigSpecialRemote u c' "hooktype" hooktype
|
||||||
return c'
|
return (c', u)
|
||||||
|
|
||||||
hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)])
|
hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)])
|
||||||
hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
|
hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
|
||||||
|
|
|
@ -22,6 +22,7 @@ import qualified Git
|
||||||
import qualified Git.Config
|
import qualified Git.Config
|
||||||
|
|
||||||
import qualified Remote.Git
|
import qualified Remote.Git
|
||||||
|
import qualified Remote.GCrypt
|
||||||
#ifdef WITH_S3
|
#ifdef WITH_S3
|
||||||
import qualified Remote.S3
|
import qualified Remote.S3
|
||||||
#endif
|
#endif
|
||||||
|
@ -38,6 +39,7 @@ import qualified Remote.Hook
|
||||||
remoteTypes :: [RemoteType]
|
remoteTypes :: [RemoteType]
|
||||||
remoteTypes =
|
remoteTypes =
|
||||||
[ Remote.Git.remote
|
[ Remote.Git.remote
|
||||||
|
, Remote.GCrypt.remote
|
||||||
#ifdef WITH_S3
|
#ifdef WITH_S3
|
||||||
, Remote.S3.remote
|
, Remote.S3.remote
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -23,6 +23,7 @@ import qualified Git
|
||||||
import Config
|
import Config
|
||||||
import Config.Cost
|
import Config.Cost
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
import Annex.UUID
|
||||||
import Annex.Ssh
|
import Annex.Ssh
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Encryptable
|
import Remote.Helper.Encryptable
|
||||||
|
@ -111,8 +112,9 @@ gen r u c gc = do
|
||||||
++ unwords rsh
|
++ unwords rsh
|
||||||
else return ([], rawurl)
|
else return ([], rawurl)
|
||||||
|
|
||||||
rsyncSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
|
rsyncSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||||
rsyncSetup u c = do
|
rsyncSetup mu c = do
|
||||||
|
u <- maybe (liftIO genUUID) return mu
|
||||||
-- verify configuration is sane
|
-- verify configuration is sane
|
||||||
let url = fromMaybe (error "Specify rsyncurl=") $
|
let url = fromMaybe (error "Specify rsyncurl=") $
|
||||||
M.lookup "rsyncurl" c
|
M.lookup "rsyncurl" c
|
||||||
|
@ -121,7 +123,7 @@ rsyncSetup u c = do
|
||||||
-- The rsyncurl is stored in git config, not only in this remote's
|
-- The rsyncurl is stored in git config, not only in this remote's
|
||||||
-- persistant state, so it can vary between hosts.
|
-- persistant state, so it can vary between hosts.
|
||||||
gitConfigSpecialRemote u c' "rsyncurl" url
|
gitConfigSpecialRemote u c' "rsyncurl" url
|
||||||
return c'
|
return (c', u)
|
||||||
|
|
||||||
rsyncEscape :: RsyncOpts -> String -> String
|
rsyncEscape :: RsyncOpts -> String -> String
|
||||||
rsyncEscape o s
|
rsyncEscape o s
|
||||||
|
|
12
Remote/S3.hs
12
Remote/S3.hs
|
@ -30,6 +30,7 @@ import Crypto
|
||||||
import Creds
|
import Creds
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
import Annex.UUID
|
||||||
import Logs.Web
|
import Logs.Web
|
||||||
|
|
||||||
type Bucket = String
|
type Bucket = String
|
||||||
|
@ -70,8 +71,12 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
|
||||||
remotetype = remote
|
remotetype = remote
|
||||||
}
|
}
|
||||||
|
|
||||||
s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig
|
s3Setup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||||
s3Setup u c = if isIA c then archiveorg else defaulthost
|
s3Setup mu c = do
|
||||||
|
u <- maybe (liftIO genUUID) return mu
|
||||||
|
s3Setup' u c
|
||||||
|
s3Setup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||||
|
s3Setup' u c = if isIA c then archiveorg else defaulthost
|
||||||
where
|
where
|
||||||
remotename = fromJust (M.lookup "name" c)
|
remotename = fromJust (M.lookup "name" c)
|
||||||
defbucket = remotename ++ "-" ++ fromUUID u
|
defbucket = remotename ++ "-" ++ fromUUID u
|
||||||
|
@ -85,7 +90,8 @@ s3Setup u c = if isIA c then archiveorg else defaulthost
|
||||||
|
|
||||||
use fullconfig = do
|
use fullconfig = do
|
||||||
gitConfigSpecialRemote u fullconfig "s3" "true"
|
gitConfigSpecialRemote u fullconfig "s3" "true"
|
||||||
setRemoteCredPair fullconfig (AWS.creds u)
|
c' <- setRemoteCredPair fullconfig (AWS.creds u)
|
||||||
|
return (c', u)
|
||||||
|
|
||||||
defaulthost = do
|
defaulthost = do
|
||||||
c' <- encryptionSetup c
|
c' <- encryptionSetup c
|
||||||
|
|
|
@ -32,6 +32,7 @@ import Crypto
|
||||||
import Creds
|
import Creds
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
import Annex.UUID
|
||||||
|
|
||||||
type DavUrl = String
|
type DavUrl = String
|
||||||
type DavUser = B8.ByteString
|
type DavUser = B8.ByteString
|
||||||
|
@ -73,15 +74,17 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
|
||||||
remotetype = remote
|
remotetype = remote
|
||||||
}
|
}
|
||||||
|
|
||||||
webdavSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
|
webdavSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||||
webdavSetup u c = do
|
webdavSetup mu c = do
|
||||||
|
u <- maybe (liftIO genUUID) return mu
|
||||||
let url = fromMaybe (error "Specify url=") $
|
let url = fromMaybe (error "Specify url=") $
|
||||||
M.lookup "url" c
|
M.lookup "url" c
|
||||||
c' <- encryptionSetup c
|
c' <- encryptionSetup c
|
||||||
creds <- getCreds c' u
|
creds <- getCreds c' u
|
||||||
testDav url creds
|
testDav url creds
|
||||||
gitConfigSpecialRemote u c' "webdav" "true"
|
gitConfigSpecialRemote u c' "webdav" "true"
|
||||||
setRemoteCredPair c' (davCreds u)
|
c'' <- setRemoteCredPair c' (davCreds u)
|
||||||
|
return (c'', u)
|
||||||
|
|
||||||
store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
|
store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
|
||||||
store r k _f p = metered (Just p) k $ \meterupdate ->
|
store r k _f p = metered (Just p) k $ \meterupdate ->
|
||||||
|
|
|
@ -70,4 +70,4 @@ calcMac mac = case mac of
|
||||||
HmacSha384 -> showDigest $* hmacSha384
|
HmacSha384 -> showDigest $* hmacSha384
|
||||||
HmacSha512 -> showDigest $* hmacSha512
|
HmacSha512 -> showDigest $* hmacSha512
|
||||||
where
|
where
|
||||||
($*) g f x y = g $ f x y
|
($*) g f x y = g $ f x y
|
||||||
|
|
|
@ -31,7 +31,7 @@ data RemoteTypeA a = RemoteType {
|
||||||
-- generates a remote of this type
|
-- generates a remote of this type
|
||||||
generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (RemoteA a),
|
generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (RemoteA a),
|
||||||
-- initializes or changes a remote
|
-- initializes or changes a remote
|
||||||
setup :: UUID -> RemoteConfig -> a RemoteConfig
|
setup :: Maybe UUID -> RemoteConfig -> a (RemoteConfig, UUID)
|
||||||
}
|
}
|
||||||
|
|
||||||
instance Eq (RemoteTypeA a) where
|
instance Eq (RemoteTypeA a) where
|
||||||
|
|
Loading…
Reference in a new issue