diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2015-08-13 17:26:09 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2015-08-13 17:27:50 -0400 |
| commit | c4e65d4c3e8a226fb3ec933bdea3daea903b3e84 (patch) | |
| tree | 3fa47712d7cd352bd5221a5c1d774632c30c135f /Remote | |
| parent | 411cf4993f47562524b476ab7f2b9721775eabdf (diff) | |
Added WHEREIS to external special remote protocol.
Diffstat (limited to 'Remote')
| -rw-r--r-- | Remote/External.hs | 9 | ||||
| -rw-r--r-- | Remote/External/Types.hs | 6 |
2 files changed, 14 insertions, 1 deletions
diff --git a/Remote/External.hs b/Remote/External.hs index 6c36d879a..cd062e0c2 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -60,7 +60,7 @@ gen r u c gc = do , removeKey = removeKeyDummy , checkPresent = checkPresentDummy , checkPresentCheap = False - , whereisKey = Nothing + , whereisKey = Just $ whereis external , remoteFsck = Nothing , repairRepo = Nothing , config = c @@ -144,6 +144,13 @@ checkKey external k = either error id <$> go | k' == k -> Just $ return $ Left errmsg _ -> Nothing +whereis :: External -> Key -> Annex [String] +whereis external k = handleRequest external (WHEREIS k) Nothing $ \resp -> case resp of + WHEREIS_SUCCESS s -> Just $ return [s] + WHEREIS_FAILURE -> Just $ return [] + UNSUPPORTED_REQUEST -> Just $ return [] + _ -> Nothing + safely :: Annex Bool -> Annex Bool safely a = go =<< tryNonAsync a where diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 3c9e89d40..4bb9f6717 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -97,6 +97,7 @@ data Request | TRANSFER Direction Key FilePath | CHECKPRESENT Key | REMOVE Key + | WHEREIS Key deriving (Show) -- Does PREPARE need to have been sent before this request? @@ -120,6 +121,7 @@ instance Proto.Sendable Request where ] formatMessage (CHECKPRESENT key) = [ "CHECKPRESENT", Proto.serialize key ] formatMessage (REMOVE key) = [ "REMOVE", Proto.serialize key ] + formatMessage (WHEREIS key) = [ "WHEREIS", Proto.serialize key ] -- Responses the external remote can make to requests. data Response @@ -141,6 +143,8 @@ data Response | CHECKURL_CONTENTS Size FilePath | CHECKURL_MULTI [(URLString, Size, FilePath)] | CHECKURL_FAILURE ErrorMsg + | WHEREIS_SUCCESS String + | WHEREIS_FAILURE | UNSUPPORTED_REQUEST deriving (Show) @@ -163,6 +167,8 @@ instance Proto.Receivable Response where parseCommand "CHECKURL-CONTENTS" = Proto.parse2 CHECKURL_CONTENTS parseCommand "CHECKURL-MULTI" = Proto.parse1 CHECKURL_MULTI parseCommand "CHECKURL-FAILURE" = Proto.parse1 CHECKURL_FAILURE + parseCommand "WHEREIS-SUCCESS" = Just . WHEREIS_SUCCESS + parseCommand "WHEREIS-FAILURE" = Proto.parse0 WHEREIS_FAILURE parseCommand "UNSUPPORTED-REQUEST" = Proto.parse0 UNSUPPORTED_REQUEST parseCommand _ = Proto.parseFail |