External special remote protocol extended to support export.

Also updated example.sh to support export.

This commit was supported by the NSF-funded DataLad project.
This commit is contained in:
Joey Hess 2017-09-08 14:24:05 -04:00
parent 3b885d7914
commit a1b195d84c
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 306 additions and 69 deletions

View file

@ -36,7 +36,7 @@ import Types.StandardGroups (PreferredContentExpression)
import Utility.Metered (BytesProcessed(..))
import Types.Transfer (Direction(..))
import Config.Cost (Cost)
import Types.Remote (RemoteConfig)
import Types.Remote (RemoteConfig, ExportLocation(..))
import Types.Availability (Availability(..))
import Types.Key
import Utility.Url (URLString)
@ -116,12 +116,19 @@ data Request
| CHECKPRESENT SafeKey
| REMOVE SafeKey
| WHEREIS SafeKey
| EXPORTSUPPORTED
| EXPORT ExportLocation
| TRANSFEREXPORT Direction SafeKey FilePath
| CHECKPRESENTEXPORT SafeKey
| REMOVEEXPORT SafeKey
| RENAMEEXPORT SafeKey ExportLocation
deriving (Show)
-- Does PREPARE need to have been sent before this request?
needsPREPARE :: Request -> Bool
needsPREPARE PREPARE = False
needsPREPARE INITREMOTE = False
needsPREPARE EXPORTSUPPORTED = False
needsPREPARE _ = True
instance Proto.Sendable Request where
@ -137,9 +144,27 @@ instance Proto.Sendable Request where
, Proto.serialize key
, Proto.serialize file
]
formatMessage (CHECKPRESENT key) = [ "CHECKPRESENT", Proto.serialize key ]
formatMessage (CHECKPRESENT key) =
[ "CHECKPRESENT", Proto.serialize key ]
formatMessage (REMOVE key) = [ "REMOVE", Proto.serialize key ]
formatMessage (WHEREIS key) = [ "WHEREIS", Proto.serialize key ]
formatMessage EXPORTSUPPORTED = ["EXPORTSUPPORTED"]
formatMessage (EXPORT loc) = [ "EXPORT", Proto.serialize loc ]
formatMessage (TRANSFEREXPORT direction key file) =
[ "TRANSFEREXPORT"
, Proto.serialize direction
, Proto.serialize key
, Proto.serialize file
]
formatMessage (CHECKPRESENTEXPORT key) =
[ "CHECKPRESENTEXPORT", Proto.serialize key ]
formatMessage (REMOVEEXPORT key) =
[ "REMOVEEXPORT", Proto.serialize key ]
formatMessage (RENAMEEXPORT key newloc) =
[ "RENAMEEXPORT"
, Proto.serialize key
, Proto.serialize newloc
]
-- Responses the external remote can make to requests.
data Response
@ -163,6 +188,10 @@ data Response
| CHECKURL_FAILURE ErrorMsg
| WHEREIS_SUCCESS String
| WHEREIS_FAILURE
| EXPORTSUPPORTED_SUCCESS
| EXPORTSUPPORTED_FAILURE
| RENAMEEXPORT_SUCCESS Key
| RENAMEEXPORT_FAILURE Key
| UNSUPPORTED_REQUEST
deriving (Show)
@ -187,6 +216,10 @@ instance Proto.Receivable Response where
parseCommand "CHECKURL-FAILURE" = Proto.parse1 CHECKURL_FAILURE
parseCommand "WHEREIS-SUCCESS" = Just . WHEREIS_SUCCESS
parseCommand "WHEREIS-FAILURE" = Proto.parse0 WHEREIS_FAILURE
parseCommand "EXPORTSUPPORTED-SUCCESS" = Proto.parse0 EXPORTSUPPORTED_SUCCESS
parseCommand "EXPORTSUPPORTED-FAILURE" = Proto.parse0 EXPORTSUPPORTED_FAILURE
parseCommand "RENAMEEXPORT-SUCCESS" = Proto.parse1 RENAMEEXPORT_SUCCESS
parseCommand "RENAMEEXPORT-FAILURE" = Proto.parse1 RENAMEEXPORT_FAILURE
parseCommand "UNSUPPORTED-REQUEST" = Proto.parse0 UNSUPPORTED_REQUEST
parseCommand _ = Proto.parseFail
@ -315,3 +348,7 @@ instance Proto.Serializable [(URLString, Size, FilePath)] where
instance Proto.Serializable URI where
serialize = show
deserialize = parseURI
instance Proto.Serializable ExportLocation where
serialize (ExportLocation loc) = loc
deserialize = Just . ExportLocation