implement DATA-PRESENT in p2p protocol

Not yet implemented for the http server or the proxy.

diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs
index 1f5b0c76a328b190e64a9c656d2172bd402cd781..db461382ef4c43a6f9b247e428ab79682e2b1514 100644 (file)
--- a/P2P/Protocol.hs
+++ b/P2P/Protocol.hs
@@ -61,12 +61,13 @@ defaultProtocolVersion :: ProtocolVersion
 defaultProtocolVersion = ProtocolVersion 0
 
 maxProtocolVersion :: ProtocolVersion
-maxProtocolVersion = ProtocolVersion 3
+maxProtocolVersion = ProtocolVersion 4
 
 -- In order from newest to oldest.
 allProtocolVersions :: [ProtocolVersion]
 allProtocolVersions =
-       [ ProtocolVersion 3
+       [ ProtocolVersion 4
+       , ProtocolVersion 3
        , ProtocolVersion 2
        , ProtocolVersion 1
        , ProtocolVersion 0
@@ -113,6 +114,7 @@ data Message
        | FAILURE_PLUS [UUID]
        | BYPASS Bypass
        | DATA Len -- followed by bytes of data
+       | DATA_PRESENT
        | VALIDITY Validity
        | TIMESTAMP MonotonicTimestamp
        | ERROR String
@@ -144,6 +146,7 @@ instance Proto.Sendable Message where
        formatMessage (FAILURE_PLUS uuids) = ("FAILURE-PLUS":map Proto.serialize uuids)
        formatMessage (BYPASS (Bypass uuids)) = ("BYPASS":map Proto.serialize (S.toList uuids))
        formatMessage (DATA len) = ["DATA", Proto.serialize len]
+       formatMessage DATA_PRESENT = ["DATA-PRESENT"]
        formatMessage (VALIDITY Valid) = ["VALID"]
        formatMessage (VALIDITY Invalid) = ["INVALID"]
        formatMessage (TIMESTAMP ts) = ["TIMESTAMP", Proto.serialize ts]
@@ -175,6 +178,7 @@ instance Proto.Receivable Message where
        parseCommand "FAILURE-PLUS" = Proto.parseList FAILURE_PLUS
        parseCommand "BYPASS" = Proto.parseList (BYPASS . Bypass . S.fromList)
        parseCommand "DATA" = Proto.parse1 DATA
+       parseCommand "DATA-PRESENT" = Proto.parse0 DATA_PRESENT
        parseCommand "VALID" = Proto.parse0 (VALIDITY Valid)
        parseCommand "INVALID" = Proto.parse0 (VALIDITY Invalid)
        parseCommand "TIMESTAMP" = Proto.parse1 TIMESTAMP
@@ -477,11 +481,12 @@ removeBeforeRemoteEndTime remoteendtime key = do
 
 get :: FilePath -> Key -> Maybe IncrementalVerifier -> AssociatedFile -> Meter -> MeterUpdate -> Proto (Bool, Verification)
 get dest key iv af m p = 
-       receiveContent (Just m) p sizer storer $ \offset ->
+       receiveContent (Just m) p sizer storer noothermessages $ \offset ->
                GET offset (ProtoAssociatedFile af) key
   where
        sizer = fileSize dest
        storer = storeContentTo dest iv
+       noothermessages = const Nothing
 
 put :: Key -> AssociatedFile -> MeterUpdate -> Proto (Maybe [UUID])
 put key af p = put' key af $ \offset ->
@@ -664,7 +669,16 @@ serverHandler servermode myuuid = handler
                        else do
                                let sizer = tmpContentSize key
                                let storer = storeContent key af
-                               v <- receiveContent Nothing nullMeterUpdate sizer storer PUT_FROM
+                               ver <- net getProtocolVersion
+                               let handleothermessages
+                                       | ver >= ProtocolVersion 4 = \case
+                                               DATA_PRESENT -> Just $
+                                                       checkContentPresent key
+                                               _ -> Nothing
+                                       | otherwise = const Nothing
+                               v <- receiveContent Nothing nullMeterUpdate 
+                                       sizer storer handleothermessages 
+                                       PUT_FROM
                                when (observeBool v) $
                                        local $ setPresent key myuuid
                return ServerContinue
@@ -743,9 +757,10 @@ receiveContent
        -> MeterUpdate
        -> Local Len
        -> (Offset -> Len -> Proto L.ByteString -> Proto (Maybe Validity) -> Local t)
+       -> (Message -> Maybe (Local t))
        -> (Offset -> Message)
        -> Proto t
-receiveContent mm p sizer storer mkmsg = do
+receiveContent mm p sizer storer handleothermessages mkmsg = do
        Len n <- local sizer
        let p' = offsetMeterUpdate p (toBytesProcessed n)
        let offset = Offset n
@@ -764,16 +779,23 @@ receiveContent mm p sizer storer mkmsg = do
                                                net $ sendMessage (ERROR "expected VALID or INVALID")
                                                return Nothing
                                else return Nothing
-                       v <- local $ storer offset len
+                       sendresultof $ storer offset len
                                (net (receiveBytes len p'))
                                validitycheck
-                       sendSuccess (observeBool v)
-                       return v
                Just (ERROR _err) ->
                        return observeFailure
-               _ -> do
-                       net $ sendMessage (ERROR "expected DATA")
-                       return observeFailure
+               Just msg -> 
+                       maybe unsupportedmessage sendresultof
+                               (handleothermessages msg)
+               Nothing -> unsupportedmessage
+  where
+       unsupportedmessage = do
+               net $ sendMessage (ERROR "expected DATA")
+               return observeFailure
+       sendresultof a = do
+               v <- local a
+               sendSuccess (observeBool v)
+               return v
 
 checkSuccess :: Proto Bool
 checkSuccess = either (const False) id <$> checkSuccess'