diff options
Diffstat (limited to 'Remote')
| -rw-r--r-- | Remote/External.hs | 11 | ||||
| -rw-r--r-- | Remote/External/Types.hs | 11 |
2 files changed, 19 insertions, 3 deletions
diff --git a/Remote/External.hs b/Remote/External.hs index a8526566f..97aa247ba 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -70,7 +70,7 @@ gen r u c gc = do mkUnavailable = gen r u c $ gc { remoteAnnexExternalType = Just "!dne!" }, getInfo = return [("externaltype", externaltype)], - claimUrl = Nothing + claimUrl = Just (claimurl external) } where externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc) @@ -416,3 +416,12 @@ getAvailability external r gc = maybe query return (remoteAnnexAvailability gc) _ -> Nothing setRemoteAvailability r avail return avail + +claimurl :: External -> URLString -> Annex Bool +claimurl external url = + handleRequest external (CLAIMURL url) Nothing $ \req -> case req of + CLAIMURL_SUCCESS -> Just $ return True + CLAIMURL_FAILURE -> Just $ return False + UNSUPPORTED_REQUEST -> Just $ return False + _ -> Nothing + diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index cdcb657ea..2fc29e5b4 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -39,6 +39,7 @@ import Logs.Transfer (Direction(..)) import Config.Cost (Cost) import Types.Remote (RemoteConfig) import Types.Availability (Availability(..)) +import Utility.Url (URLString) import qualified Utility.SimpleProtocol as Proto import Control.Concurrent.STM @@ -90,6 +91,7 @@ data Request | INITREMOTE | GETCOST | GETAVAILABILITY + | CLAIMURL URLString | TRANSFER Direction Key FilePath | CHECKPRESENT Key | REMOVE Key @@ -106,6 +108,7 @@ instance Proto.Sendable Request where formatMessage INITREMOTE = ["INITREMOTE"] formatMessage GETCOST = ["GETCOST"] formatMessage GETAVAILABILITY = ["GETAVAILABILITY"] + formatMessage (CLAIMURL url) = [ "CLAIMURL", Proto.serialize url ] formatMessage (TRANSFER direction key file) = [ "TRANSFER" , Proto.serialize direction @@ -130,6 +133,8 @@ data Response | AVAILABILITY Availability | INITREMOTE_SUCCESS | INITREMOTE_FAILURE ErrorMsg + | CLAIMURL_SUCCESS + | CLAIMURL_FAILURE | UNSUPPORTED_REQUEST deriving (Show) @@ -147,6 +152,8 @@ instance Proto.Receivable Response where parseCommand "AVAILABILITY" = Proto.parse1 AVAILABILITY parseCommand "INITREMOTE-SUCCESS" = Proto.parse0 INITREMOTE_SUCCESS parseCommand "INITREMOTE-FAILURE" = Proto.parse1 INITREMOTE_FAILURE + parseCommand "CLAIMURL-SUCCESS" = Proto.parse0 CLAIMURL_SUCCESS + parseCommand "CLAIMURL-FAILURE" = Proto.parse0 CLAIMURL_FAILURE parseCommand "UNSUPPORTED-REQUEST" = Proto.parse0 UNSUPPORTED_REQUEST parseCommand _ = Proto.parseFail @@ -165,8 +172,8 @@ data RemoteRequest | GETWANTED | SETSTATE Key String | GETSTATE Key - | SETURLPRESENT Key String - | SETURLMISSING Key String + | SETURLPRESENT Key URLString + | SETURLMISSING Key URLString | GETURLS Key String | DEBUG String deriving (Show) |