{- git-annex command - - Copyright 2024 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE OverloadedStrings #-} module Command.UpdateCluster where import Command import qualified Annex import Types.Cluster import Logs.Cluster import qualified Remote as R import qualified Types.Remote as R import qualified Command.UpdateProxy import Utility.SafeOutput import qualified Data.Map as M import qualified Data.Set as S cmd :: Command cmd = noMessages $ command "updatecluster" SectionSetup "update records of cluster nodes" paramNothing (withParams seek) seek :: CmdParams -> CommandSeek seek = withNothing $ do commandAction start commandAction Command.UpdateProxy.start start :: CommandStart start = startingCustomOutput (ActionItemOther Nothing) $ do rs <- R.remoteList let getnode r = case remoteAnnexClusterNode (R.gitconfig r) of Nothing -> return Nothing Just [] -> return Nothing Just clusternames -> ifM (Command.UpdateProxy.checkCanProxy r "Cannot use this special remote as a cluster node.") ( return $ Just $ M.fromList $ zip clusternames (repeat (S.singleton r)) , return Nothing ) myclusternodes <- M.unionsWith S.union . catMaybes <$> mapM getnode rs myclusters <- annexClusters <$> Annex.getGitConfig recordedclusters <- getClusters descs <- R.uuidDescriptions -- Update the cluster log to list the currently configured nodes -- of each configured cluster. forM_ (M.toList myclusters) $ \(clustername, cu) -> do let mynodesremotes = fromMaybe mempty $ M.lookup clustername myclusternodes let mynodes = S.map (ClusterNodeUUID . R.uuid) mynodesremotes let recordednodes = fromMaybe mempty $ M.lookup cu $ clusterUUIDs recordedclusters proxiednodes <- findProxiedClusterNodes recordednodes let allnodes = S.union mynodes proxiednodes if recordednodes == allnodes then liftIO $ putStrLn $ safeOutput $ "No cluster node changes for cluster: " ++ clustername else do describechanges descs clustername recordednodes allnodes mynodesremotes recordCluster cu allnodes next $ return True where describechanges descs clustername oldnodes allnodes mynodesremotes = do forM_ (S.toList mynodesremotes) $ \r -> unless (S.member (ClusterNodeUUID (R.uuid r)) oldnodes) $ liftIO $ putStrLn $ safeOutput $ "Added node " ++ R.name r ++ " to cluster: " ++ clustername forM_ (S.toList oldnodes) $ \n -> unless (S.member n allnodes) $ do let desc = maybe (fromUUID (fromClusterNodeUUID n)) fromUUIDDesc $ M.lookup (fromClusterNodeUUID n) descs liftIO $ putStrLn $ safeOutput $ "Removed node " ++ desc ++ " from cluster: " ++ clustername -- Finds nodes that are proxied by other cluster gateways. findProxiedClusterNodes :: S.Set ClusterNodeUUID -> Annex (S.Set ClusterNodeUUID) findProxiedClusterNodes recordednodes = (S.fromList . map asclusternode . filter isproxynode) <$> R.remoteList where isproxynode r = asclusternode r `S.member` recordednodes && isJust (remoteAnnexProxiedBy (R.gitconfig r)) asclusternode = ClusterNodeUUID . R.uuid