add lockids to http p2p protocol

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
+clientKeepLocked' clientenv protover lckid cu su bypass keeplocked = do
-	let cli = clientKeepLocked protover key cu su bypass
+	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
+	toJSON (LockResult v (Just (B64UUID lck))) = object
-		["locked" .= v]
+		[ "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

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,
+The server will reply with `{"locked": true}` if it was able
-or `{"locked": false}` if it was not.
+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.