clientPut seeking to offset

Command/P2PHttp.hs

@@ -177,16 +177,16 @@ testPut = do
 	burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
 	res <- clientPut (mkClientEnv mgr burl)
 		(P2P.ProtocolVersion 3)
-		(B64Key (fromJust $ deserializeKey ("WORM-s30-m1720547401--foo")))
+		(B64Key (fromJust $ deserializeKey ("SHA256E-s1048576000--b460ca923520db561d01b99483e9e2fe65ff9dfbdd52c17acba6ac4e874e27d5")))
 		(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
 		(B64UUID (toUUID ("cu" :: String)))
 		[]
 		Nothing
-		Nothing
+		(Just (Offset 584754208))
 		(AssociatedFile (Just "foo"))
-		"foocontent"
-		30
-		(liftIO (print "validity check") >> return False)
+		"bigfile3content"
+		1048576000
+		(liftIO (print "validity check") >> return True)
 	liftIO $ print res
 
 testRemove = do

P2P/Http.hs

@@ -547,7 +547,7 @@ servePut st resultmangle su apiver (DataLength len) (B64Key k) cu bypass baf mof
 	tooshortv <- liftIO newEmptyTMVarIO
 	content <- liftIO $ S.unSourceT stream (gather validityv tooshortv)
 	res <- withP2PConnection' apiver st cu su bypass sec auth WriteAction
-		(\st -> st { connectionWaitVar = False }) $ \conn ->
+		(\cst -> cst { connectionWaitVar = False }) $ \conn ->
 			liftIO (protoaction conn content validitycheck)
 				`finally` checktooshort conn tooshortv
 	case res of
@@ -645,7 +645,11 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
 		liftIO $ atomically $ takeTMVar checkv
 		validitycheck >>= liftIO . atomically . putTMVar checkresultv
 	checkerthread <- liftIO . async =<< forkState checker
-	liftIO (withClientM (cli (stream checkv checkresultv)) clientenv return) >>= \case
+	v <- liftIO $ withBinaryFile contentfile ReadMode $ \h -> do
+		when (offset /= 0) $
+			hSeek h AbsoluteSeek offset
+		withClientM (cli (stream h checkv checkresultv)) clientenv return
+	case v of
 		Left err -> do
 			void $ liftIO $ atomically $ tryPutTMVar checkv ()
 			join $ liftIO (wait checkerthread)
@@ -654,9 +658,8 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
 			join $ liftIO (wait checkerthread)
 			return res
   where
-	stream checkv checkresultv = S.SourceT $ \a -> do
-		-- TODO seek to offset when requested
-		bl <- L.readFile contentfile
+	stream h checkv checkresultv = S.SourceT $ \a -> do
+		bl <- L.hGetContents h
 		v <- newMVar (0, filter (not . B.null) (L.toChunks bl))
 		a (go v)
 	  where
@@ -692,9 +695,12 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
 		AssociatedFile (Just f) -> Just (B64FilePath f)
 
 	len = DataLength nlen
-	nlen = case moffset of
-		Nothing -> contentfilesize
-		Just (Offset o) -> contentfilesize - fromIntegral o
+
+	nlen = contentfilesize - offset
+
+	offset = case moffset of
+		Nothing -> 0
+		Just (Offset o) -> fromIntegral o
 
 	cli src = case ver of
 		3 -> v3 su V3 len k cu bypass baf moffset src auth

doc/todo/git-annex_proxies.mdwn

@@ -28,8 +28,6 @@ Planned schedule of work:
 
 ## work notes
 
-* clientPut needs to seek to the requested offset in the file.
-
 * Implement: servePutOffset, serveLockContent
 
 * A Locker should expire the lock on its own after 10 minutes initially.