diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-09-01 13:02:07 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-09-01 13:05:09 -0400 |
commit | 2aea8192e1769c4acfbc130ba4d788abd5ee4539 (patch) | |
tree | 9713e2dfbca20263acebe53028ae949bb467b78b /Remote | |
parent | 441a5dfc2fd112fd165b95fb1106f15a1255e72a (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.hs | 7 | ||||
-rw-r--r-- | Remote/Bup.hs | 7 | ||||
-rw-r--r-- | Remote/Ddar.hs | 7 | ||||
-rw-r--r-- | Remote/Directory.hs | 14 | ||||
-rw-r--r-- | Remote/External.hs | 7 | ||||
-rw-r--r-- | Remote/GCrypt.hs | 7 | ||||
-rw-r--r-- | Remote/Git.hs | 7 | ||||
-rw-r--r-- | Remote/Glacier.hs | 7 | ||||
-rw-r--r-- | Remote/Helper/Export.hs | 21 | ||||
-rw-r--r-- | Remote/Hook.hs | 7 | ||||
-rw-r--r-- | Remote/P2P.hs | 7 | ||||
-rw-r--r-- | Remote/Rsync.hs | 7 | ||||
-rw-r--r-- | Remote/S3.hs | 7 | ||||
-rw-r--r-- | Remote/Tahoe.hs | 7 | ||||
-rw-r--r-- | Remote/Web.hs | 7 | ||||
-rw-r--r-- | Remote/WebDAV.hs | 7 |
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 |