diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs index 1c2241a33b..d565169d96 100644 --- a/Command/P2PHttp.hs +++ b/Command/P2PHttp.hs @@ -73,7 +73,7 @@ seek o = getAnnexWorkerPool $ \workerpool -> do -- XXX remove this when (isNothing (portOption o)) $ do liftIO $ putStrLn "test begins" - testPut + testPutOffset giveup "TEST DONE" withLocalP2PConnections workerpool $ \acquireconn -> liftIO $ do authenv <- getAuthEnv @@ -182,11 +182,23 @@ testPut = do (B64UUID (toUUID ("cu" :: String))) [] Nothing - (Just (Offset 584754208)) + Nothing (AssociatedFile (Just "foo")) - "bigfile3content" - 1048576000 - (liftIO (print "validity check") >> return True) + "emptyfile" + 0 + (liftIO (print "validity check") >> return False) + liftIO $ print res + +testPutOffset = do + mgr <- httpManager <$> getUrlOptions + burl <- liftIO $ parseBaseUrl "http://localhost:8080/" + res <- liftIO $ clientPutOffset (mkClientEnv mgr burl) + (P2P.ProtocolVersion 3) + (B64Key (fromJust $ deserializeKey ("SHA256E-s1048576000--b460ca923520db561d01b99483e9e2fe65ff9dfbdd52c17acba6ac4e874e27d5"))) + (B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String))) + (B64UUID (toUUID ("cu" :: String))) + [] + Nothing liftIO $ print res testRemove = do diff --git a/P2P/Http.hs b/P2P/Http.hs index d6546c11a0..65433439c3 100644 --- a/P2P/Http.hs +++ b/P2P/Http.hs @@ -720,6 +720,8 @@ type PutOffsetAPI result = KeyParam :> CU Required :> BypassUUIDs + :> IsSecure + :> AuthHeader :> Post '[JSON] result servePutOffset @@ -731,29 +733,50 @@ servePutOffset -> B64Key -> B64UUID ClientSide -> [B64UUID Bypass] + -> IsSecure + -> Maybe Auth -> Handler t -servePutOffset st resultmangle su apiver (B64Key k) cu bypass = undefined - +servePutOffset st resultmangle su apiver (B64Key k) cu bypass sec auth = do + res <- withP2PConnection apiver st cu su bypass sec auth WriteAction + (\cst -> cst { connectionWaitVar = False }) $ \conn -> + liftIO $ proxyClientNetProto conn $ getPutOffset k af + case res of + Right offset -> return $ resultmangle $ + PutOffsetResultPlus (Offset offset) + Left plusuuids -> return $ resultmangle $ + PutOffsetResultAlreadyHavePlus (map B64UUID plusuuids) + where + af = AssociatedFile Nothing clientPutOffset - :: B64UUID ServerSide + :: ClientEnv -> ProtocolVersion -> B64Key + -> B64UUID ServerSide -> B64UUID ClientSide -> [B64UUID Bypass] - -> ClientM PutOffsetResultPlus -clientPutOffset su (ProtocolVersion ver) = case ver of - 3 -> v3 su V3 - 2 -> v2 su V2 - _ -> error "unsupported protocol version" + -> Maybe Auth + -> IO PutOffsetResultPlus +clientPutOffset clientenv (ProtocolVersion ver) k su cu bypass auth + | ver == 0 = return (PutOffsetResultPlus (Offset 0)) + | otherwise = + withClientM cli clientenv $ \case + Left err -> throwM err + Right res -> return res where + cli = case ver of + 3 -> v3 su V3 k cu bypass auth + 2 -> v2 su V2 k cu bypass auth + 1 -> plus <$> v1 su V1 k cu bypass auth + _ -> error "unsupported protocol version" + _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> - v3 :<|> v2 :<|> _ = client p2pHttpAPI + v3 :<|> v2 :<|> v1 :<|> _ = client p2pHttpAPI type LockContentAPI = KeyParam diff --git a/P2P/Http/Types.hs b/P2P/Http/Types.hs index ed8f9ad9d7..f5db2089ef 100644 --- a/P2P/Http/Types.hs +++ b/P2P/Http/Types.hs @@ -107,10 +107,14 @@ newtype PutResult = PutResult Bool data PutResultPlus = PutResultPlus Bool [B64UUID Plus] deriving (Show) -newtype PutOffsetResult = PutOffsetResult Offset +data PutOffsetResult + = PutOffsetResult Offset + | PutOffsetResultAlreadyHave deriving (Show) -data PutOffsetResultPlus = PutOffsetResultPlus Offset [B64UUID Plus] +data PutOffsetResultPlus + = PutOffsetResultPlus Offset + | PutOffsetResultAlreadyHavePlus [B64UUID Plus] deriving (Show, Generic, NFData) newtype Offset = Offset P2P.Offset @@ -296,23 +300,37 @@ instance FromJSON GetTimestampResult where instance ToJSON PutOffsetResult where toJSON (PutOffsetResult (Offset (P2P.Offset o))) = object ["offset" .= o] + toJSON PutOffsetResultAlreadyHave = object + ["alreadyhave" .= True] instance FromJSON PutOffsetResult where parseJSON = withObject "PutOffsetResult" $ \v -> - PutOffsetResult - <$> (Offset . P2P.Offset <$> v .: "offset") + (PutOffsetResult + <$> (Offset . P2P.Offset <$> v .: "offset")) + <|> (mkalreadyhave + <$> (v .: "alreadyhave")) + where + mkalreadyhave :: Bool -> PutOffsetResult + mkalreadyhave _ = PutOffsetResultAlreadyHave instance ToJSON PutOffsetResultPlus where - toJSON (PutOffsetResultPlus (Offset (P2P.Offset o)) us) = object - [ "offset" .= o + toJSON (PutOffsetResultPlus (Offset (P2P.Offset o))) = object + [ "offset" .= o ] + toJSON (PutOffsetResultAlreadyHavePlus us) = object + [ "alreadyhave" .= True , "plusuuids" .= plusList us ] instance FromJSON PutOffsetResultPlus where parseJSON = withObject "PutOffsetResultPlus" $ \v -> - PutOffsetResultPlus - <$> (Offset . P2P.Offset <$> v .: "offset") - <*> v .: "plusuuids" + (PutOffsetResultPlus + <$> (Offset . P2P.Offset <$> v .: "offset")) + <|> (mkalreadyhave + <$> (v .: "alreadyhave") + <*> (v .: "plusuuids")) + where + mkalreadyhave :: Bool -> [B64UUID Plus] -> PutOffsetResultPlus + mkalreadyhave _ us = PutOffsetResultAlreadyHavePlus us instance FromJSON (B64UUID t) where parseJSON (String t) = case decodeB64Text t of @@ -358,5 +376,8 @@ instance PlusClass PutResultPlus PutResult where plus (PutResult b) = PutResultPlus b mempty instance PlusClass PutOffsetResultPlus PutOffsetResult where - dePlus (PutOffsetResultPlus o _) = PutOffsetResult o - plus (PutOffsetResult o) = PutOffsetResultPlus o mempty + dePlus (PutOffsetResultPlus o) = PutOffsetResult o + dePlus (PutOffsetResultAlreadyHavePlus _) = PutOffsetResultAlreadyHave + plus (PutOffsetResult o) = PutOffsetResultPlus o + plus PutOffsetResultAlreadyHave = PutOffsetResultAlreadyHavePlus [] + diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs index 12e4a655f9..2bca26c06c 100644 --- a/P2P/Protocol.hs +++ b/P2P/Protocol.hs @@ -482,6 +482,24 @@ put' key af sender = do net $ sendMessage (ERROR "expected PUT_FROM or ALREADY_HAVE") return Nothing +-- The protocol does not have a way to get the PUT offset +-- without sending DATA, so send an empty bytestring and indicate +-- it is not valid. +getPutOffset :: Key -> AssociatedFile -> Proto (Either [UUID] Offset) +getPutOffset key af = do + net $ sendMessage (PUT (ProtoAssociatedFile af) key) + r <- net receiveMessage + case r of + Just (PUT_FROM offset) -> do + void $ sendContent' nullMeterUpdate (Len 0) L.empty $ + return Invalid + return (Right offset) + Just ALREADY_HAVE -> return (Left []) + Just (ALREADY_HAVE_PLUS uuids) -> return (Left uuids) + _ -> do + net $ sendMessage (ERROR "expected PUT_FROM or ALREADY_HAVE") + return (Left []) + data ServerHandler a = ServerGot a | ServerContinue @@ -686,7 +704,7 @@ sendContent key af o offset@(Offset n) p = go =<< local (contentSize key) else local $ readContent key af o offset $ sender (Len len) -- Content not available to send. Indicate this by sending - -- empty data and indlicate it's invalid. + -- empty data and indicate it's invalid. go Nothing = sender (Len 0) L.empty (return Invalid) sender = sendContent' p' diff --git a/doc/design/p2p_protocol_over_http/draft1.mdwn b/doc/design/p2p_protocol_over_http/draft1.mdwn index b0c4c0b7de..988b4c9288 100644 --- a/doc/design/p2p_protocol_over_http/draft1.mdwn +++ b/doc/design/p2p_protocol_over_http/draft1.mdwn @@ -276,7 +276,7 @@ Same as v3, except the JSON will not include "plusuuids". ### POST /git-annex/$uuid/v0/remove -Identival to v1. +Identical to v1. ## POST /git-annex/$uuid/v3/remove-before @@ -389,8 +389,8 @@ The body of the request is empty. The server responds with a JSON object with an "offset" field that is the largest allowable offset. -If the server already has the content of the key, it will respond with a -JSON object with an "alreadyhave" field that is set to true. This JSON +If the server already has the content of the key, it will respond instead +with a JSON object with an "alreadyhave" field that is set to true. This JSON object may also have a field "plusuuids" that lists the UUIDs of other repositories where the content is stored, in addition to the serveruuid. diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn index ade3b8eedd..aca5bb2eb1 100644 --- a/doc/todo/git-annex_proxies.mdwn +++ b/doc/todo/git-annex_proxies.mdwn @@ -28,14 +28,17 @@ Planned schedule of work: ## work notes -* Implement: servePutOffset, serveLockContent +* servePutOffset crashes with "TMVar left full VALIDITY Invalid". + Seems nothing consumes the INVALID sent by the client, but why? + +* Implement serveLockContent * A Locker should expire the lock on its own after 10 minutes initially. * Since each held lock needs a connection to a proxy, the Locker could reference count, and avoid holding more than one lock per key. -* Make Remote.Git use http client when annex.url is configured. +* Make Remote.Git use http client when remote.name.annex-url is configured. * Make http server support proxies and clusters. @@ -51,6 +54,8 @@ Planned schedule of work: * implemented server and client for HTTP P2P protocol +* added git-annex p2phttp command to serve HTTP P2P protocol + ## items deferred until later for [[design/passthrough_proxy]] * Check annex.diskreserve when proxying for special remotes