Avoid loading cluster log at startup
This fixes a problem with datalad's test suite, where loading the cluster log happened to cause the git-annex branch commits to take a different shape, with an additional commit. It's also faster though, since many commands don't need the cluster log. Just fill Annex.clusters with a thunk. Sponsored-by: the NIH-funded NICEMAN (ReproNim TR&D3) project
This commit is contained in:
		
					parent
					
						
							
								7c6c3e703b
							
						
					
				
			
			
				commit
				
					
						3a1f39fbdf
					
				
			
		
					 7 changed files with 30 additions and 7 deletions
				
			
		
							
								
								
									
										2
									
								
								Annex.hs
									
										
									
									
									
								
							
							
						
						
									
										2
									
								
								Annex.hs
									
										
									
									
									
								
							|  | @ -197,7 +197,7 @@ data AnnexState = AnnexState | ||||||
| 	, preferredcontentmap :: Maybe (FileMatcherMap Annex) | 	, preferredcontentmap :: Maybe (FileMatcherMap Annex) | ||||||
| 	, requiredcontentmap :: Maybe (FileMatcherMap Annex) | 	, requiredcontentmap :: Maybe (FileMatcherMap Annex) | ||||||
| 	, remoteconfigmap :: Maybe (M.Map UUID RemoteConfig) | 	, remoteconfigmap :: Maybe (M.Map UUID RemoteConfig) | ||||||
| 	, clusters :: Maybe Clusters | 	, clusters :: Maybe (Annex Clusters) | ||||||
| 	, forcetrust :: TrustMap | 	, forcetrust :: TrustMap | ||||||
| 	, trustmap :: Maybe TrustMap | 	, trustmap :: Maybe TrustMap | ||||||
| 	, groupmap :: Maybe GroupMap | 	, groupmap :: Maybe GroupMap | ||||||
|  |  | ||||||
|  | @ -35,10 +35,10 @@ startup = do | ||||||
|  -} |  -} | ||||||
| startupAnnex :: Annex () | startupAnnex :: Annex () | ||||||
| startupAnnex = doQuietAction $ | startupAnnex = doQuietAction $ | ||||||
| 	-- Logs.Location needs clusters to be loaded before it is used, | 	-- Logs.Location needs this before it is used, in order for a | ||||||
| 	-- in order for a cluster to be treated as the location of keys | 	-- cluster to be treated as the location of keys | ||||||
| 	-- that are located in any of its nodes. | 	-- that are located in any of its nodes. | ||||||
| 	void loadClusters | 	preLoadClusters | ||||||
| 
 | 
 | ||||||
| startupSignals :: Annex () | startupSignals :: Annex () | ||||||
| startupSignals = do | startupSignals = do | ||||||
|  |  | ||||||
|  | @ -1,3 +1,9 @@ | ||||||
|  | git-annex (10.20240732) UNRELEASED; urgency=medium | ||||||
|  | 
 | ||||||
|  |   * Avoid loading cluster log at startup. | ||||||
|  | 
 | ||||||
|  |  -- Joey Hess <id@joeyh.name>  Wed, 31 Jul 2024 15:52:03 -0400 | ||||||
|  | 
 | ||||||
| git-annex (10.20240731) upstream; urgency=medium | git-annex (10.20240731) upstream; urgency=medium | ||||||
| 
 | 
 | ||||||
|   * New HTTP API that is equivilant to the P2P protocol. |   * New HTTP API that is equivilant to the P2P protocol. | ||||||
|  |  | ||||||
|  | @ -11,6 +11,7 @@ module Logs.Cluster ( | ||||||
| 	module Types.Cluster, | 	module Types.Cluster, | ||||||
| 	getClusters, | 	getClusters, | ||||||
| 	loadClusters, | 	loadClusters, | ||||||
|  | 	preLoadClusters, | ||||||
| 	recordCluster, | 	recordCluster, | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
|  | @ -24,7 +25,12 @@ import qualified Data.Map as M | ||||||
| import qualified Data.Set as S | import qualified Data.Set as S | ||||||
| 
 | 
 | ||||||
| getClusters :: Annex Clusters | getClusters :: Annex Clusters | ||||||
| getClusters = maybe loadClusters return	=<< Annex.getState Annex.clusters | getClusters = maybe loadClusters id =<< Annex.getState Annex.clusters | ||||||
|  | 
 | ||||||
|  | {- This works around a module dependency loop. -} | ||||||
|  | preLoadClusters :: Annex () | ||||||
|  | preLoadClusters = Annex.changeState $ \s -> | ||||||
|  | 	s { Annex.clusters = Just loadClusters } | ||||||
| 
 | 
 | ||||||
| {- Loads the clusters and caches it for later. | {- Loads the clusters and caches it for later. | ||||||
|  - |  - | ||||||
|  | @ -37,5 +43,5 @@ loadClusters = do | ||||||
| 	dead <- (S.fromList . map ClusterNodeUUID) | 	dead <- (S.fromList . map ClusterNodeUUID) | ||||||
| 		<$> trustGet DeadTrusted | 		<$> trustGet DeadTrusted | ||||||
| 	clusters <- getClustersWith (M.map (`S.difference` dead)) | 	clusters <- getClustersWith (M.map (`S.difference` dead)) | ||||||
| 	Annex.changeState $ \s -> s { Annex.clusters = Just clusters } | 	Annex.changeState $ \s -> s { Annex.clusters = Just (pure clusters) } | ||||||
| 	return clusters | 	return clusters | ||||||
|  |  | ||||||
|  | @ -252,4 +252,4 @@ overLocationLogs' iv discarder keyaction = do | ||||||
| -- Cannot import Logs.Cluster due to a cycle. | -- Cannot import Logs.Cluster due to a cycle. | ||||||
| -- Annex.clusters gets populated when starting up git-annex. | -- Annex.clusters gets populated when starting up git-annex. | ||||||
| getClusters :: Annex Clusters | getClusters :: Annex Clusters | ||||||
| getClusters = fromMaybe noClusters <$> Annex.getState Annex.clusters | getClusters = maybe (pure noClusters) id =<< Annex.getState Annex.clusters | ||||||
|  |  | ||||||
|  | @ -186,3 +186,5 @@ add-archive-content(ok): /home/yoh/.tmp/datalad_temp_tree_rsua9kmg (dataset) | ||||||
| 
 | 
 | ||||||
| [[!meta author=yoh]] | [[!meta author=yoh]] | ||||||
| [[!tag projects/repronim]] | [[!tag projects/repronim]] | ||||||
|  | 
 | ||||||
|  | > [[fixed|done]] --[[Joey]] | ||||||
|  |  | ||||||
|  | @ -0,0 +1,9 @@ | ||||||
|  | [[!comment format=mdwn | ||||||
|  |  username="joey" | ||||||
|  |  subject="""comment 3""" | ||||||
|  |  date="2024-07-31T19:50:38Z" | ||||||
|  |  content=""" | ||||||
|  | Aha! I found a way around the dependency loop. | ||||||
|  | 
 | ||||||
|  | This is fixed. | ||||||
|  | """]] | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Joey Hess
				Joey Hess