summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2017-09-01 13:02:07 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2017-09-01 13:05:09 -0400
commit2aea8192e1769c4acfbc130ba4d788abd5ee4539 (patch)
tree9713e2dfbca20263acebe53028ae949bb467b78b /Remote
parent441a5dfc2fd112fd165b95fb1106f15a1255e72a (diff)
refactor ExportActions
This will allow disabling exports for remotes that are not configured to allow them. Also, exportSupported will be useful for the external special remote to probe. This commit was supported by the NSF-funded DataLad project
Diffstat (limited to 'Remote')
-rw-r--r--Remote/BitTorrent.hs7
-rw-r--r--Remote/Bup.hs7
-rw-r--r--Remote/Ddar.hs7
-rw-r--r--Remote/Directory.hs14
-rw-r--r--Remote/External.hs7
-rw-r--r--Remote/GCrypt.hs7
-rw-r--r--Remote/Git.hs7
-rw-r--r--Remote/Glacier.hs7
-rw-r--r--Remote/Helper/Export.hs21
-rw-r--r--Remote/Hook.hs7
-rw-r--r--Remote/P2P.hs7
-rw-r--r--Remote/Rsync.hs7
-rw-r--r--Remote/S3.hs7
-rw-r--r--Remote/Tahoe.hs7
-rw-r--r--Remote/Web.hs7
-rw-r--r--Remote/WebDAV.hs7
16 files changed, 58 insertions, 75 deletions
diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs
index 887a0898e..9a1be1c0e 100644
--- a/Remote/BitTorrent.hs
+++ b/Remote/BitTorrent.hs
@@ -26,6 +26,7 @@ import Backend.URL
import Annex.Perms
import Annex.UUID
import qualified Annex.Url as Url
+import Remote.Helper.Export
import Network.URI
@@ -61,11 +62,7 @@ gen r _ c gc =
, lockContent = Nothing
, checkPresent = checkKey
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index aad8e6bba..6ff2aa885 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -25,6 +25,7 @@ import Config.Cost
import qualified Remote.Helper.Ssh as Ssh
import Remote.Helper.Special
import Remote.Helper.Messages
+import Remote.Helper.Export
import Utility.Hash
import Utility.UserInfo
import Annex.UUID
@@ -61,11 +62,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = bupLocal buprepo
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 1da3ff412..c5d02a4e6 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -19,6 +19,7 @@ import qualified Git
import Config
import Config.Cost
import Remote.Helper.Special
+import Remote.Helper.Export
import Annex.Ssh
import Annex.UUID
import Utility.SshHost
@@ -60,11 +61,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = ddarLocal ddarrepo
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index f5d7f7e49..e2e517b84 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -25,6 +25,7 @@ import Config.Cost
import Config
import Utility.FileMode
import Remote.Helper.Special
+import Remote.Helper.Export
import qualified Remote.Directory.LegacyChunked as Legacy
import Annex.Content
import Annex.UUID
@@ -59,11 +60,14 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = True
- , storeExport = Just $ storeExportDirectory dir
- , retrieveExport = Just $ retrieveExportDirectory dir
- , removeExport = Just $ removeExportDirectory dir
- , checkPresentExport = Just $ checkPresentExportDirectory dir
- , renameExport = Just $ renameExportDirectory dir
+ , exportActions = ExportActions
+ { exportSupported = return True
+ , storeExport = storeExportDirectory dir
+ , retrieveExport = retrieveExportDirectory dir
+ , removeExport = removeExportDirectory dir
+ , checkPresentExport = checkPresentExportDirectory dir
+ , renameExport = renameExportDirectory dir
+ }
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/External.hs b/Remote/External.hs
index dd62c1539..fca60a995 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -18,6 +18,7 @@ import Config
import Git.Config (isTrue, boolConfig)
import Git.Env
import Remote.Helper.Special
+import Remote.Helper.Export
import Remote.Helper.ReadOnly
import Remote.Helper.Messages
import Utility.Metered
@@ -85,11 +86,7 @@ gen r u c gc
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = towhereis
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 95b7ae287..dd681a75c 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -38,6 +38,7 @@ import Remote.Helper.Git
import Remote.Helper.Encryptable
import Remote.Helper.Special
import Remote.Helper.Messages
+import Remote.Helper.Export
import qualified Remote.Helper.Ssh as Ssh
import Utility.Metered
import Annex.UUID
@@ -114,11 +115,7 @@ gen' r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = repoCheap r
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 020cd1c61..129d5e171 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -50,6 +50,7 @@ import Utility.Batch
import Utility.SimpleProtocol
import Remote.Helper.Git
import Remote.Helper.Messages
+import Remote.Helper.Export
import qualified Remote.Helper.Ssh as Ssh
import qualified Remote.GCrypt
import qualified Remote.P2P
@@ -157,11 +158,7 @@ gen r u c gc
, lockContent = Just (lockKey new)
, checkPresent = inAnnex new
, checkPresentCheap = repoCheap r
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = if Git.repoIsUrl r
then Nothing
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index be65cecb7..b21167aaf 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -18,6 +18,7 @@ import Config
import Config.Cost
import Remote.Helper.Special
import Remote.Helper.Messages
+import Remote.Helper.Export
import qualified Remote.Helper.AWS as AWS
import Creds
import Utility.Metered
@@ -57,11 +58,7 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs
new file mode 100644
index 000000000..d623818e7
--- /dev/null
+++ b/Remote/Helper/Export.hs
@@ -0,0 +1,21 @@
+{- exports to remotes
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Remote.Helper.Export where
+
+import Annex.Common
+import Types.Remote
+
+exportUnsupported :: ExportActions Annex
+exportUnsupported = ExportActions
+ { exportSupported = return False
+ , storeExport = \_ _ _ _ -> return False
+ , retrieveExport = \_ _ _ _ -> return (False, UnVerified)
+ , removeExport = \_ _ -> return False
+ , checkPresentExport = \_ _ -> return False
+ , renameExport = \_ _ _ -> return False
+ }
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 2a9874242..5be4339e3 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -16,6 +16,7 @@ import Config.Cost
import Annex.UUID
import Remote.Helper.Special
import Remote.Helper.Messages
+import Remote.Helper.Export
import Utility.Env
import Messages.Progress
@@ -51,11 +52,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/P2P.hs b/Remote/P2P.hs
index d77ac89d8..f51b73b33 100644
--- a/Remote/P2P.hs
+++ b/Remote/P2P.hs
@@ -24,6 +24,7 @@ import Annex.UUID
import Config
import Config.Cost
import Remote.Helper.Git
+import Remote.Helper.Export
import Messages.Progress
import Utility.Metered
import Utility.AuthToken
@@ -57,11 +58,7 @@ chainGen addr r u c gc = do
, lockContent = Just (lock u addr connpool)
, checkPresent = checkpresent u addr connpool
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index d40d23bae..33485c78b 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -28,6 +28,7 @@ import Annex.UUID
import Annex.Ssh
import Remote.Helper.Special
import Remote.Helper.Messages
+import Remote.Helper.Export
import Remote.Rsync.RsyncUrl
import Crypto
import Utility.Rsync
@@ -73,11 +74,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/S3.hs b/Remote/S3.hs
index ce6776595..341d14b4e 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -39,6 +39,7 @@ import Config.Cost
import Remote.Helper.Special
import Remote.Helper.Http
import Remote.Helper.Messages
+import Remote.Helper.Export
import qualified Remote.Helper.AWS as AWS
import Creds
import Annex.UUID
@@ -84,11 +85,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Just (getWebUrls info)
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index cf65634b0..b197edca2 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -34,6 +34,7 @@ import qualified Git
import Config
import Config.Cost
import Remote.Helper.Special
+import Remote.Helper.Export
import Annex.UUID
import Annex.Content
import Logs.RemoteState
@@ -75,11 +76,7 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkKey u hdl
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Just (getWhereisKey u)
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 4d55389ec..45e8d1c22 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -10,6 +10,7 @@ module Remote.Web (remote, getWebUrls) where
import Annex.Common
import Types.Remote
import Remote.Helper.Messages
+import Remote.Helper.Export
import qualified Git
import qualified Git.Construct
import Annex.Content
@@ -50,11 +51,7 @@ gen r _ c gc =
, lockContent = Nothing
, checkPresent = checkKey
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 9230a027d..4c9552a6f 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -28,6 +28,7 @@ import Config.Cost
import Remote.Helper.Special
import Remote.Helper.Messages
import Remote.Helper.Http
+import Remote.Helper.Export
import qualified Remote.Helper.Chunked.Legacy as Legacy
import Creds
import Utility.Metered
@@ -68,11 +69,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
- , storeExport = Nothing
- , retrieveExport = Nothing
- , removeExport = Nothing
- , checkPresentExport = Nothing
- , renameExport = Nothing
+ , exportActions = exportUnsupported
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing