diff options
Diffstat (limited to 'Remote')
| -rw-r--r-- | Remote/Git.hs | 6 | ||||
| -rw-r--r-- | Remote/List.hs | 4 | ||||
| -rw-r--r-- | Remote/P2P.hs | 85 |
3 files changed, 93 insertions, 2 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index 3304e2069..41fb46e82 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -49,6 +49,8 @@ import Remote.Helper.Git import Remote.Helper.Messages import qualified Remote.Helper.Ssh as Ssh import qualified Remote.GCrypt +import qualified Remote.P2P +import P2P.Address import Annex.Path import Creds import Annex.CatFile @@ -130,7 +132,9 @@ configRead autoinit r = do gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc | Git.GCrypt.isEncrypted r = Remote.GCrypt.chainGen r u c gc - | otherwise = go <$> remoteCost gc defcst + | otherwise = case repoP2PAddress r of + Nothing -> go <$> remoteCost gc defcst + Just addr -> Remote.P2P.chainGen addr r u c gc where defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost go cst = Just new diff --git a/Remote/List.hs b/Remote/List.hs index 9c231b124..a5e305622 100644 --- a/Remote/List.hs +++ b/Remote/List.hs @@ -23,6 +23,7 @@ import qualified Git.Config import qualified Remote.Git import qualified Remote.GCrypt +import qualified Remote.P2P #ifdef WITH_S3 import qualified Remote.S3 #endif @@ -44,6 +45,7 @@ remoteTypes :: [RemoteType] remoteTypes = [ Remote.Git.remote , Remote.GCrypt.remote + , Remote.P2P.remote #ifdef WITH_S3 , Remote.S3.remote #endif @@ -116,4 +118,4 @@ updateRemote remote = do {- Checks if a remote is syncable using git. -} gitSyncableRemote :: Remote -> Bool gitSyncableRemote r = remotetype r `elem` - [ Remote.Git.remote, Remote.GCrypt.remote ] + [ Remote.Git.remote, Remote.GCrypt.remote, Remote.P2P.remote ] diff --git a/Remote/P2P.hs b/Remote/P2P.hs new file mode 100644 index 000000000..e0428eeeb --- /dev/null +++ b/Remote/P2P.hs @@ -0,0 +1,85 @@ +{- git remotes using the git-annex P2P protocol + - + - Copyright 2016 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Remote.P2P ( + remote, + chainGen +) where + +import Annex.Common +import P2P.Address +import Types.Remote +import Types.GitConfig +import qualified Git +import Config +import Config.Cost +import Remote.Helper.Git +import Remote.Helper.Special + +remote :: RemoteType +remote = RemoteType { + typename = "p2p", + -- Remote.Git takes care of enumerating P2P remotes, + -- and will call chainGen on them. + enumerate = const (return []), + generate = \_ _ _ _ -> return Nothing, + setup = error "P2P remotes are set up using git-annex p2p" +} + +chainGen :: P2PAddress -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) +chainGen addr r u c gc = do + workerpool <- mkWorkerPool addr + cst <- remoteCost gc expensiveRemoteCost + let this = Remote + { uuid = u + , cost = cst + , name = Git.repoDescribe r + , storeKey = storeKeyDummy + , retrieveKeyFile = retreiveKeyFileDummy + , retrieveKeyFileCheap = \_ _ _ -> return False + , removeKey = removeKeyDummy + , lockContent = Nothing -- TODO use p2p protocol locking + , checkPresent = checkPresentDummy + , checkPresentCheap = False + , whereisKey = Nothing + , remoteFsck = Nothing + , repairRepo = Nothing + , config = c + , localpath = Nothing + , repo = r + , gitconfig = gc { remoteGitConfig = Just $ extractGitConfig r } + , readonly = False + , availability = GloballyAvailable + , remotetype = remote + , mkUnavailable = return Nothing + , getInfo = gitRepoInfo this + , claimUrl = Nothing + , checkUrl = Nothing + } + return $ Just $ specialRemote' (specialRemoteCfg c) c + (simplyPrepare $ store this workerpool) + (simplyPrepare $ retrieve this workerpool) + (simplyPrepare $ remove this workerpool) + (simplyPrepare $ checkKey this workerpool) + this + +data WorkerPool = WorkerPool + +mkWorkerPool :: P2PAddress -> Annex WorkerPool +mkWorkerPool addr = undefined + +store :: Remote -> WorkerPool -> Storer +store r workerpool = undefined + +retrieve :: Remote -> WorkerPool -> Retriever +retrieve r workerpool = undefined + +remove :: Remote -> WorkerPool -> Remover +remove r workerpool k = undefined + +checkKey :: Remote -> WorkerPool -> CheckPresent +checkKey r workerpool k = undefined |