From b29088b8dc9fe543248bb29f03b096f85eb92019 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 6 Dec 2016 12:19:47 -0400
Subject: [PATCH] stub Remote.P2P

Similar to GCrypt remotes, P2P remotes have an url, so Remote.Git has to
separate them out and handle them, passing off to Remote.P2P.

This commit was sponsored by Ignacio on Patreon.
---
 P2P/Address.hs  |  5 +++
 Remote/Git.hs   |  6 +++-
 Remote/List.hs  |  4 ++-
 Remote/P2P.hs   | 85 +++++++++++++++++++++++++++++++++++++++++++++++++
 git-annex.cabal |  1 +
 5 files changed, 99 insertions(+), 2 deletions(-)
 create mode 100644 Remote/P2P.hs

diff --git a/P2P/Address.hs b/P2P/Address.hs
index 19ff82a89b..09ffc79735 100644
--- a/P2P/Address.hs
+++ b/P2P/Address.hs
@@ -10,6 +10,7 @@ module P2P.Address where
 import qualified Annex
 import Annex.Common
 import Git
+import Git.Types
 import Creds
 import Utility.AuthToken
 import Utility.Tor
@@ -54,6 +55,10 @@ instance FormatP2PAddress P2PAddressAuth where
 		authtoken <- toAuthToken (T.pack $ reverse ra)
 		return (P2PAddressAuth addr authtoken)
 
+repoP2PAddress :: Repo -> Maybe P2PAddress
+repoP2PAddress (Repo { location = Url url }) = unformatP2PAddress (show url)
+repoP2PAddress _ = Nothing
+
 -- | Load known P2P addresses for this repository.
 loadP2PAddresses :: Annex [P2PAddress]
 loadP2PAddresses = mapMaybe unformatP2PAddress . maybe [] lines
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 3304e2069f..41fb46e82e 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 9c231b124f..a5e305622f 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 0000000000..e0428eeeb5
--- /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
diff --git a/git-annex.cabal b/git-annex.cabal
index f6d8c54823..7fcba0623c 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -937,6 +937,7 @@ Executable git-annex
     Remote.Helper.Tor
     Remote.Hook
     Remote.List
+    Remote.P2P
     Remote.Rsync
     Remote.Rsync.RsyncUrl
     Remote.S3