add lockids to http p2p protocol

diff --git a/P2P/Http.hs b/P2P/Http.hs
index 59dddb1d1b163545dd586441d8099602e78ebdf5..50e7989958c51442aa4070000e39bd75661465ff 100644 (file)
--- a/P2P/Http.hs
+++ b/P2P/Http.hs
@@ -423,7 +423,7 @@ clientLockContent (P2P.ProtocolVersion ver) = case ver of
                v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
 
 type KeepLockedAPI
-       = KeyParam
+       = LockIDParam
        :> ClientUUID Required
        :> ServerUUID Required
        :> BypassUUIDs
@@ -434,7 +434,7 @@ type KeepLockedAPI
 
 serveKeepLocked
        :: P2PHttpServerState
-       -> B64Key
+       -> LockID
        -> B64UUID ClientSide
        -> B64UUID ServerSide
        -> [B64UUID Bypass]
@@ -442,9 +442,9 @@ serveKeepLocked
        -> Maybe KeepAlive
        -> S.SourceT IO UnlockRequest
        -> Handler LockResult
-serveKeepLocked st key cu su _ _ _ unlockrequeststream = do
+serveKeepLocked st lckid cu su _ _ _ unlockrequeststream = do
        _ <- liftIO $ S.unSourceT unlockrequeststream go
-       return (LockResult False)
+       return (LockResult False Nothing)
   where
        go S.Stop = dropLock lckid st
        go (S.Error _err) = dropLock lckid st
@@ -453,11 +453,9 @@ serveKeepLocked st key cu su _ _ _ unlockrequeststream = do
        go (S.Yield (UnlockRequest False) s) = go s
        go (S.Yield (UnlockRequest True) _) = dropLock lckid st
 
-       lckid = undefined -- FIXME
-
 clientKeepLocked
        :: P2P.ProtocolVersion
-       -> B64Key
+       -> LockID
        -> B64UUID ClientSide
        -> B64UUID ServerSide
        -> [B64UUID Bypass]
@@ -485,19 +483,19 @@ clientKeepLocked (P2P.ProtocolVersion ver) = case ver of
 clientKeepLocked'
        :: ClientEnv
        -> P2P.ProtocolVersion
-       -> B64Key
+       -> LockID
        -> B64UUID ClientSide
        -> B64UUID ServerSide
        -> [B64UUID Bypass]
        -> TMVar Bool
        -> IO ()
-clientKeepLocked' clientenv protover key cu su bypass keeplocked = do
-       let cli = clientKeepLocked protover key cu su bypass
+clientKeepLocked' clientenv protover lckid cu su bypass keeplocked = do
+       let cli = clientKeepLocked protover lckid cu su bypass
                (Just connectionKeepAlive) (Just keepAlive)
                (S.fromStepT unlocksender)
        withClientM cli clientenv $ \case
                Left err  -> throwM err
-               Right (LockResult _) ->
+               Right (LockResult _ _) ->
                        liftIO $ print "end of lock connection to server"
   where
        unlocksender =
@@ -521,7 +519,7 @@ testClientLock = do
                atomically $ writeTMVar keeplocked False
        clientKeepLocked' (mkClientEnv mgr burl)
                (P2P.ProtocolVersion 3)
-               (B64Key (fromJust $ deserializeKey "WORM--foo"))
+               (B64UUID (toUUID ("lck" :: String)))
                (B64UUID (toUUID ("cu" :: String)))
                (B64UUID (toUUID ("su" :: String)))
                []
@@ -549,7 +547,6 @@ storeLock lckid st = error "TODO" -- XXX
 dropLock :: LockID -> P2PHttpServerState -> IO ()
 dropLock lckid st = error "TODO" -- XXX
 
-
 type ClientUUID req = QueryParam' '[req] "clientuuid" (B64UUID ClientSide)
 
 type ServerUUID req = QueryParam' '[req] "serveruuid" (B64UUID ServerSide)
@@ -566,6 +563,8 @@ type OffsetParam = QueryParam "offset" Offset
 
 type DataLengthHeader = Header "X-git-annex-data-length" Integer
 
+type LockIDParam = QueryParam' '[Required] "lockid" LockID
+
 -- Phantom types for B64UIID
 data ClientSide
 data ServerSide
@@ -617,7 +616,7 @@ newtype Offset = Offset P2P.Offset
 newtype Timestamp = Timestamp MonotonicTimestamp
        deriving (Show)
 
-newtype LockResult = LockResult Bool
+data LockResult = LockResult Bool (Maybe LockID)
        deriving (Show, Generic, NFData)
 
 newtype UnlockRequest = UnlockRequest Bool
@@ -781,12 +780,18 @@ instance FromJSON (B64UUID t) where
        parseJSON _ = mempty
 
 instance ToJSON LockResult where
-       toJSON (LockResult v) = object
-               ["locked" .= v]
+       toJSON (LockResult v (Just (B64UUID lck))) = object
+               [ "locked" .= v
+               , "lockid" .= TE.decodeUtf8Lenient (toB64 (fromUUID lck))
+               ]
+       toJSON (LockResult v Nothing) = object
+               [ "locked" .= v
+               ]
 
 instance FromJSON LockResult where
        parseJSON = withObject "LockResult" $ \v -> LockResult
                <$> v .: "locked"
+               <*> v .:? "lockid"
 
 instance ToJSON UnlockRequest where
        toJSON (UnlockRequest v) = object

diff --git a/doc/design/p2p_protocol_over_http/draft1.mdwn b/doc/design/p2p_protocol_over_http/draft1.mdwn
index c0096e2e440c43f35adf9cc3a450818b586060a9..a093b1ac67df8608c0bab181f08a330d8bbac58e 100644 (file)
--- a/doc/design/p2p_protocol_over_http/draft1.mdwn
+++ b/doc/design/p2p_protocol_over_http/draft1.mdwn
@@ -14,6 +14,9 @@ where bodies use `Content-Type: application/octet-stream`.
 So, all git-annex keys, uuids, and filenames in this protocol are
 base64 encoded.
 
+Examples in this document use non-base64-encoded values to show that the
+underlying data is.
+
 ## authentication
 
 A git-annex protocol endpoint can optionally operate in readonly mode without
@@ -180,15 +183,16 @@ Locks the content of a key on the server, preventing it from being removed.
 Example:
 
     > POST /git-annex/v3/lockcontent?key=SHA1--foo&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
-    < {"locked": true}
+    < {"locked": true, "lockid": "foo"}
 
 There is one required additional parameter, `key`.
 
-The server will return `{"locked": true}` if it was able to lock the key,
-or `{"locked": false}` if it was not.
+The server will reply with `{"locked": true}` if it was able
+to lock the key, or `{"locked": false}` if it was not.
 
 The key will remain locked for 10 minutes. But, usually `keeplocked`
-is used to control the lifetime of the lock. (See below.)
+is used to control the lifetime of the lock, using the "lockid"
+parameter from the server's reply. (See below.)
 
 ### POST /git-annex/v2/lockcontent
 
@@ -209,14 +213,14 @@ with `lockcontent`.
 
 Example:
 
-    > POST /git-annex/v3/keeplocked?key=SHA1--foo&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
+    > POST /git-annex/v3/keeplocked?lockid=foo&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
     > Connection: Keep-Alive
     > Keep-Alive: timeout=1200
     [some time later]
     > {"unlock": true}
     < {"locked": false}
 
-There is one required additional parameter, `key`.
+There is one required additional parameter, `lockid`.
 
 This uses long polling. So it's important to use 
 Connection and Keep-Alive headers.