proxying to exporttree=yes annexobjects=yes basically working

It works when using git-annex sync/push/assist, or when manually sending
all content to the proxied remote before pushing to the proxy remote.
But when the push comes before the content is sent, sending content does
not update the exported tree.

Command/PostReceive.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2017 Joey Hess <id@joeyh.name>
+ - Copyright 2017-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -11,10 +11,21 @@ module Command.PostReceive where
 
 import Command
 import qualified Annex
-import Git.Types
 import Annex.UpdateInstead
 import Annex.CurrentBranch
 import Command.Sync (mergeLocal, prepMerge, mergeConfig, SyncOptions(..))
+import Annex.Proxy
+import Remote
+import qualified Types.Remote as Remote
+import Config
+import Git.Types
+import Git.Sha
+import qualified Git.Ref
+import Command.Export (filterExport, getExportCommit, seekExport)
+
+import qualified Data.Set as S
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as B8
 
 -- This does not need to modify the git-annex branch to update the 
 -- work tree, but auto-initialization might change the git-annex branch.
@@ -28,9 +39,55 @@ cmd = noCommit $
 		(withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek _ = whenM needUpdateInsteadEmulation $ do
+seek _ = do
 	fixPostReceiveHookEnv
-	commandAction updateInsteadEmulation
+	whenM needUpdateInsteadEmulation $
+		commandAction updateInsteadEmulation
+	proxyExportTree
+
+updateInsteadEmulation :: CommandStart
+updateInsteadEmulation = do
+	prepMerge
+	let o = def { notOnlyAnnexOption = True }
+	mc <- mergeConfig False
+	mergeLocal mc o =<< getCurrentBranch
+
+proxyExportTree :: CommandSeek
+proxyExportTree = do
+	rbs <- catMaybes <$> (mapM canexport =<< proxyForRemotes)
+	unless (null rbs) $ do
+		pushedbranches <- liftIO $ 
+			S.fromList . map snd . parseHookInput
+				<$> B.hGetContents stdin
+		let waspushed = flip S.member pushedbranches
+		case filter (waspushed . Git.Ref.branchRef . fst . snd) rbs of
+			[] -> return ()
+			rbs' -> forM_ rbs' $ \((r, b), _) -> go r b
+  where
+	canexport r = case remoteAnnexTrackingBranch (Remote.gitconfig r) of
+		Nothing -> return Nothing
+		Just branch ->
+			ifM (isExportSupported r)
+				( return (Just ((r, branch), splitRemoteAnnexTrackingBranchSubdir branch))
+				, return Nothing
+				)
+	
+	go r b = inRepo (Git.Ref.tree b) >>= \case
+		Nothing -> return ()
+		Just t -> do
+			tree <- filterExport r t
+			mtbcommitsha <- getExportCommit r b
+			seekExport r tree mtbcommitsha
+
+parseHookInput :: B.ByteString -> [((Sha, Sha), Ref)]
+parseHookInput = mapMaybe parse . B8.lines
+  where
+	parse l = case B8.words l of
+		(oldb:newb:refb:[]) -> do
+			old <- extractSha oldb
+			new <- extractSha newb
+			return ((old, new), Ref refb)
+		_ -> Nothing
 
 {- When run by the post-receive hook, the cwd is the .git directory, 
  - and GIT_DIR=. It's not clear why git does this.
@@ -50,9 +107,3 @@ fixPostReceiveHookEnv = do
 				}
 		_ -> noop
 
-updateInsteadEmulation :: CommandStart
-updateInsteadEmulation = do
-	prepMerge
-	let o = def { notOnlyAnnexOption = True }
-	mc <- mergeConfig False
-	mergeLocal mc o =<< getCurrentBranch