mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

refactor ExportActions

Browse source 
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
This commit is contained in:
Joey Hess 2017-09-01 13:02:07 -04:00
parent 5483ea90ec
commit a4328b49d2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
20 changed files with 143 additions and 149 deletions
Download patch file Download diff file Expand all files Collapse all files

7
Remote/BitTorrent.hs
View file

@ -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

7
Remote/Bup.hs
View file

@ -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

7
Remote/Ddar.hs
View file

@ -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

14
Remote/Directory.hs
View file

@ -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

7
Remote/External.hs
View file

@ -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

7
Remote/GCrypt.hs
View file

@ -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

7
Remote/Git.hs
View file

@ -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

7
Remote/Glacier.hs
View file

@ -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

21
Remote/Helper/Export.hs Normal file
View file

@ -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
}

7
Remote/Hook.hs
View file

@ -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

7
Remote/P2P.hs
View file

@ -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

7
Remote/Rsync.hs
View file

@ -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

7
Remote/S3.hs
View file

@ -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

7
Remote/Tahoe.hs
View file

@ -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

7
Remote/Web.hs
View file

@ -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

7
Remote/WebDAV.hs
View file

@ -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