implemented serveLockContent (untested)

P2P/Http.hs

@@ -798,6 +798,8 @@ type LockContentAPI
 	= KeyParam
 	:> CU Required
 	:> BypassUUIDs
+	:> IsSecure
+	:> AuthHeader
 	:> Post '[JSON] LockResult
 
 serveLockContent
@@ -808,8 +810,35 @@ serveLockContent
 	-> B64Key
 	-> B64UUID ClientSide
 	-> [B64UUID Bypass]
+	-> IsSecure
+	-> Maybe Auth
 	-> Handler LockResult
-serveLockContent = undefined -- TODO
+serveLockContent st su apiver (B64Key k) cu bypass sec auth = do
+	conn <- getP2PConnection apiver st cu su bypass sec auth WriteAction id
+	let lock = do
+		lockresv <- newEmptyTMVarIO
+		unlockv <- newEmptyTMVarIO
+		annexworker <- async $ inAnnexWorker st $ do
+			lockres <- runFullProto (clientRunState conn) (clientP2PConnection conn) $ do
+				net $ sendMessage (LOCKCONTENT k)
+				checkSuccess
+			liftIO $ atomically $ putTMVar lockresv lockres
+			-- TODO timeout
+			liftIO $ atomically $ takeTMVar unlockv
+			void $ runFullProto (clientRunState conn) (clientP2PConnection conn) $ do
+				net $ sendMessage UNLOCKCONTENT
+		atomically (takeTMVar lockresv) >>= \case
+			Right True -> return (Just (annexworker, unlockv))
+			_ -> return Nothing
+	let unlock (annexworker, unlockv) = do
+		atomically $ putTMVar unlockv ()
+		wait annexworker
+		releaseP2PConnection conn
+	liftIO $ mkLocker lock unlock >>= \case
+		Just (locker, lockid) -> do
+			liftIO $ storeLock lockid locker st
+			return $ LockResult True (Just lockid)
+		Nothing -> return $ LockResult False Nothing
 
 clientLockContent
 	:: B64UUID ServerSide
@@ -817,6 +846,7 @@ clientLockContent
 	-> B64Key
 	-> B64UUID ClientSide
 	-> [B64UUID Bypass]
+	-> Maybe Auth
 	-> ClientM LockResult
 clientLockContent su (ProtocolVersion ver) = case ver of
 	3 -> v3 su V3

P2P/Http/State.hs

@@ -264,23 +264,21 @@ data Locker = Locker
 	-- and setting to False causes the lock to be released.
 	}
 
-mkLocker :: IO () -> IO () -> IO (Maybe (Locker, LockID))
+mkLocker :: IO (Maybe a) -> (a -> IO ()) -> IO (Maybe (Locker, LockID))
 mkLocker lock unlock = do
 	lv <- newEmptyTMVarIO
 	let setlocked = putTMVar lv
-	tid <- async $
-		tryNonAsync lock >>= \case
-			Left _ -> do
+	tid <- async $ lock >>= \case
+		Nothing ->
 			atomically $ setlocked False
-				unlock
-			Right () -> do
+		Just st -> do
 			atomically $ setlocked True
 			atomically $ do
 				v <- takeTMVar lv
 				if v
 					then retry
 					else setlocked False
-				unlock
+			unlock st
 	locksuccess <- atomically $ readTMVar lv
 	if locksuccess
 		then do
@@ -305,7 +303,8 @@ dropLock lckid st = do
 		putTMVar (openLocks st) m'
 		case mlocker of
 			Nothing -> return Nothing
-			-- Signal to the locker's thread that it can release the lock.
+			-- Signal to the locker's thread that it can
+			-- release the lock.
 			Just locker -> do
 				_ <- swapTMVar (lockerVar locker) False
 				return (Just locker)

doc/todo/git-annex_proxies.mdwn

@@ -28,12 +28,12 @@ Planned schedule of work:
 
 ## work notes
 
-* Implement serveLockContent
+* Test 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.
+* serveKeepLocked should check auth just to be safe, although added
+  security is probably minimal.
 
 * Make Remote.Git use http client when remote.name.annex-url is configured.