diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,23 @@ ## [Unreleased] +## [1.13.0] - 2026-10-21 + +### Added + +- `cachix list`: list Cachix caches configured in nix.conf (`--all` also shows non-Cachix substituters) + +### Changed + +- deps: support crypton >= 1.1 with ram while retaining support for older crypton versions with memory + +### Fixed + +- client: retry HTTP 408 request timeouts +- client: detect interactive terminals correctly and disable interactive progress when `CI=true` or `CI=1` +- deploy: ignore duplicate deployment commands +- deploy: retry deployments skipped because another deployment holds the lock + ## [1.12.1] - 2026-08-31 ### Fixed diff --git a/cachix-deployment/Main.hs b/cachix-deployment/Main.hs --- a/cachix-deployment/Main.hs +++ b/cachix-deployment/Main.hs @@ -12,7 +12,7 @@ import Cachix.Client.URI qualified as URI import Cachix.Deploy.Activate qualified as Activate import Cachix.Deploy.Agent qualified as Agent -import Cachix.Deploy.Deployment (Deployment (..)) +import Cachix.Deploy.Deployment (Deployment (..), lockContentionExitCode) import Cachix.Deploy.Lock qualified as Lock import Cachix.Deploy.Log qualified as Log import Cachix.Deploy.Websocket qualified as WebSocket @@ -78,8 +78,8 @@ lockFilePath <- Lock.newLockFilePath (lockFilenameFrom agentName) - Log.withLog logOptions $ \withLog -> - void . Lock.withTryLock lockFilePath $ do + deploymentResult <- Log.withLog logOptions $ \withLog -> + Lock.withTryLock lockFilePath $ do -- Open a connection to logging stream (logQueue, loggingThread) <- runLogStream withLog logWebsocketOptions @@ -93,6 +93,12 @@ atomically $ TMQueue.closeTMQueue logQueue shutdownService Async.wait loggingThread + + -- A lock holder is still deploying, so no deployment status was reported. + -- Return a non-success exit code so the agent keeps this delivery retryable + -- while the backend reschedules it. + when (isNothing deploymentResult) $ + exitWith lockContentionExitCode -- | Run the deployment commands deploy :: diff --git a/cachix.cabal b/cachix.cabal --- a/cachix.cabal +++ b/cachix.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: cachix -version: 1.12.1 +version: 1.13.0 synopsis: Command-line client for Nix binary cache hosting https://cachix.org @@ -26,6 +26,14 @@ location: https://github.com/cachix/cachix subdir: cachix +flag ram + description: + Use ram instead of memory for Data.ByteArray, matching crypton >= 1.1. + The solver picks this automatically. + + default: True + manual: False + common defaults build-depends: base >=4.7 && <5 default-extensions: @@ -62,6 +70,7 @@ Cachix.Client.Command.Config Cachix.Client.Command.Doctor Cachix.Client.Command.Import + Cachix.Client.Command.List Cachix.Client.Command.Pin Cachix.Client.Command.Push Cachix.Client.Command.Watch @@ -81,6 +90,7 @@ Cachix.Client.Retry Cachix.Client.Secrets Cachix.Client.Servant + Cachix.Client.Terminal Cachix.Client.URI Cachix.Client.Version Cachix.Client.WatchStore @@ -143,7 +153,6 @@ , conduit-extra , conduit-zstd , containers - , crypton , deepseq , dhall >=1.28.0 , directory @@ -169,7 +178,6 @@ , lukko , lzma-conduit , megaparsec >=7.0.0 - , memory , microlens , netrc , network @@ -207,6 +215,16 @@ , websockets , wuss + if flag(ram) + build-depends: + , crypton >=1.1 + , ram + + else + build-depends: + , crypton <1.1 + , memory + -- These versions are pinned in hercules-ci-cnix-store pkgconfig-depends: nix-store @@ -250,6 +268,7 @@ hs-source-dirs: test other-modules: CommandConfigSpec + CommandListSpec Daemon.NarinfoQuerySpec Daemon.PostBuildHookSpec Daemon.ProtocolSpec @@ -261,7 +280,9 @@ NetRcSpec NixConfSpec NixVersionSpec + RetrySpec Spec + TerminalSpec URISpec build-depends: @@ -278,6 +299,7 @@ , hercules-ci-cnix-store , here , hspec + , http-types , katip , protolude , retry @@ -287,6 +309,7 @@ , temporary , time , unliftio + , uuid , versions build-tool-depends: hspec-discover:hspec-discover diff --git a/src/Cachix/Client.hs b/src/Cachix/Client.hs --- a/src/Cachix/Client.hs +++ b/src/Cachix/Client.hs @@ -51,6 +51,7 @@ Push (PushPaths opts name cliPaths) -> Command.push env opts name cliPaths Push (PushWatchStore _ _) -> throwIO $ DeprecatedCommand "DEPRECATED: cachix watch-store has replaced cachix push --watch-store." + List listOptions -> Command.list env listOptions Remove name -> Command.remove env name Use name useOptions -> Command.use env name useOptions Version -> putText cachixVersion diff --git a/src/Cachix/Client/Command.hs b/src/Cachix/Client/Command.hs --- a/src/Cachix/Client/Command.hs +++ b/src/Cachix/Client/Command.hs @@ -6,6 +6,7 @@ Doctor.daemonDoctor, Doctor.doctor, Import.import', + List.list, Pin.pin, Push.push, Watch.watchExec, @@ -19,6 +20,7 @@ import Cachix.Client.Command.Config qualified as Config import Cachix.Client.Command.Doctor qualified as Doctor import Cachix.Client.Command.Import qualified as Import +import Cachix.Client.Command.List qualified as List import Cachix.Client.Command.Pin qualified as Pin import Cachix.Client.Command.Push qualified as Push import Cachix.Client.Command.Watch qualified as Watch diff --git a/src/Cachix/Client/Command/List.hs b/src/Cachix/Client/Command/List.hs new file mode 100644 --- /dev/null +++ b/src/Cachix/Client/Command/List.hs @@ -0,0 +1,122 @@ +module Cachix.Client.Command.List (list, cachixCacheName, Entry (..), configuredEntries) where + +import Cachix.Client.Env (Env, effectiveHost) +import Cachix.Client.Exception (CachixException) +import Cachix.Client.NixConf qualified as NixConf +import Cachix.Client.OptionsParser (ListOptions (..)) +import Cachix.Client.URI (URI) +import Cachix.Client.URI qualified as URI +import Control.Exception.Safe qualified as Safe +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text qualified as T +import Protolude hiding (hPutStrLn, list, toS) +import Protolude.Conv (toS) +import System.IO (hPutStrLn) + +data Entry = Entry + { entrySource :: FilePath, + entryUri :: Text, + entryKey :: Text, + entryCacheName :: Maybe Text + } + +list :: Env -> ListOptions -> IO () +list env ListOptions {listAll} = do + let cachixHost = effectiveHost env + globalSources <- readSources NixConf.Global + localSources <- readSources NixConf.Local + let filtered = configuredEntries cachixHost ListOptions {listAll} (globalSources <> localSources) + if null filtered + then + if listAll + then putStrLn ("No substituters configured in nix.conf." :: Text) + else putStrLn ("No Cachix caches configured. Try `cachix use ` first." :: Text) + else printEntries filtered + +-- | Select and deduplicate entries before rendering, retaining their source. +configuredEntries :: URI -> ListOptions -> [NixConf.NixConfSource] -> [Entry] +configuredEntries cachixHost ListOptions {listAll} sources = + let allSources = dedupBy NixConf.nixConfPath sources + entries = dedupBy entryKey (concatMap (toEntries cachixHost) allSources) + in if listAll then entries else filter (isJust . entryCacheName) entries + +readSources :: NixConf.NixConfLoc -> IO [NixConf.NixConfSource] +readSources loc = + NixConf.read loc >>= \case + Nothing -> pure [] + Just s -> + Safe.catch (NixConf.resolveIncludes s) $ \(e :: CachixException) -> do + hPutStrLn stderr $ + "Warning: skipping includes from " + <> NixConf.nixConfPath s + <> ": " + <> show e + pure [s] + +toEntries :: URI -> NixConf.NixConfSource -> [Entry] +toEntries cachixHost src = + [ Entry + { entrySource = NixConf.nixConfPath src, + entryUri = u, + entryKey = canonicalKey u, + entryCacheName = cachixCacheName cachixHost u + } + | u <- NixConf.readLines NixConf.isAnySubstituter src + ] + +-- | Keep the first occurrence of each @key x@, preserving input order. +dedupBy :: (Ord k) => (a -> k) -> [a] -> [a] +dedupBy key = go Set.empty + where + go _ [] = [] + go seen (x : xs) + | Set.member (key x) seen = go seen xs + | otherwise = x : go (Set.insert (key x) seen) xs + +-- | Canonical form used only for deduplication (lowercased scheme + host, +-- default ports dropped). The original +-- substituter text is preserved for display. +canonicalKey :: Text -> Text +canonicalKey raw = + case URI.parseURI (toS raw) of + Right parsed | Just k <- URI.canonicalForm parsed -> k + _ -> raw + +cachixCacheName :: URI -> Text -> Maybe Text +cachixCacheName cachixHost rawUri = do + parsed <- rightToMaybe $ URI.parseURI (toS rawUri) + cHost <- hostText cachixHost + sHost <- hostText parsed + let suffix = "." <> cHost + guard (suffix `T.isSuffixOf` sHost && T.length sHost > T.length suffix) + pure $ T.dropEnd (T.length suffix) sHost + where + hostText u = T.toLower . toS . URI.hostBS <$> URI.getHostnameMay u + +printEntries :: [Entry] -> IO () +printEntries entries = + sequence_ $ intersperse (putStrLn ("" :: Text)) (map printGroup grouped) + where + grouped :: [(FilePath, [Entry])] + grouped = + let bucket = + foldl' + (\m e -> Map.insertWith (flip (<>)) (entrySource e) [e] m) + Map.empty + entries + order = dedupBy identity (map entrySource entries) + in [(p, Map.findWithDefault [] p bucket) | p <- order] + + nameWidth = maximum (0 : [T.length n | e <- entries, Just n <- [entryCacheName e]]) + + printGroup (path, es) = do + putStrLn $ (toS path :: Text) <> ":" + forM_ es printEntry + + printEntry e = + case entryCacheName e of + Just name -> + putStrLn $ " " <> T.justifyLeft nameWidth ' ' name <> " " <> entryUri e + Nothing -> + putStrLn $ " " <> T.justifyLeft nameWidth ' ' "-" <> " " <> entryUri e diff --git a/src/Cachix/Client/Command/Push.hs b/src/Cachix/Client/Command/Push.hs --- a/src/Cachix/Client/Command/Push.hs +++ b/src/Cachix/Client/Command/Push.hs @@ -22,6 +22,7 @@ import Cachix.Client.Retry (retryClientM) import Cachix.Client.Secrets import Cachix.Client.Servant +import Cachix.Client.Terminal (useInteractiveProgress) import Cachix.Types.BinaryCache (BinaryCacheName) import Cachix.Types.BinaryCache qualified as BinaryCache import Control.Exception.Safe (throwM) @@ -96,10 +97,9 @@ let hSize = toS $ humanSize $ fromIntegral size path <- liftIO $ decodeUtf8With lenientDecode <$> storePathToPath store storePath - isTerminal <- liftIO $ hIsTerminalDevice stderr - isCI <- liftIO $ (== Just "true") <$> lookupEnv "CI" + interactiveProgress <- liftIO $ useInteractiveProgress stderr onTick <- - if isTerminal && not isCI + if interactiveProgress then do let bar = color Blue "[:bar] " <> toS (retryText retryStatus) <> toS path <> " (:percent of " <> hSize <> ")" barLength = T.length $ T.replace ":percent" " 0%" (T.replace "[:bar]" "" (toS bar)) diff --git a/src/Cachix/Client/Env.hs b/src/Cachix/Client/Env.hs --- a/src/Cachix/Client/Env.hs +++ b/src/Cachix/Client/Env.hs @@ -1,6 +1,7 @@ module Cachix.Client.Env ( Env (..), mkEnv, + effectiveHost, createClientEnv, customManagerSettings, Config.defaultCachixOptions, @@ -10,7 +11,7 @@ import Cachix.Client.Config (Config) import Cachix.Client.Config qualified as Config import Cachix.Client.OptionsParser qualified as Options -import Cachix.Client.URI (getBaseUrl) +import Cachix.Client.URI (URI, getBaseUrl) import Cachix.Client.Version (cachixVersion) import Network.HTTP.Client ( ManagerSettings, @@ -49,6 +50,12 @@ clientenv = clientEnv, config = cfg } + +-- | The Cachix host this process is actually talking to: the value from +-- @--host@ when supplied, otherwise @hostname@ from cachix.dhall. Use this +-- instead of @Config.hostname (config env)@ in commands, which ignores @--host@. +effectiveHost :: Env -> URI +effectiveHost = Config.host . cachixoptions customManagerSettings :: ManagerSettings customManagerSettings = diff --git a/src/Cachix/Client/NixConf.hs b/src/Cachix/Client/NixConf.hs --- a/src/Cachix/Client/NixConf.hs +++ b/src/Cachix/Client/NixConf.hs @@ -30,6 +30,8 @@ parse, readLines, writeLines, + isSubstituter, + isAnySubstituter, isTrustedUsers, defaultPublicURI, defaultSigningKey, @@ -169,6 +171,35 @@ isSubstituter :: NixConfLine -> Maybe [Text] isSubstituter (Substituters xs) = Just xs isSubstituter _ = Nothing + +-- | Read active substituters, including @extra-substituters@. Trusted +-- substituters only grant permission to enable a cache and are not active. +-- Strip comments only when reading, preserving the parsed lines for writers. +isAnySubstituter :: NixConfLine -> Maybe [Text] +isAnySubstituter (Substituters xs) = Just (substituterValues (T.unwords xs)) +isAnySubstituter (Other raw) = parseSubstitutersLine raw +isAnySubstituter _ = Nothing + +substituterValues :: Text -> [Text] +substituterValues = T.words . T.takeWhile (/= '#') + +parseSubstitutersLine :: Text -> Maybe [Text] +parseSubstitutersLine raw = do + let stripped = T.stripStart raw + key <- find (`matchesDirective` stripped) substituterKeys + let afterKey = T.stripStart (T.drop (T.length key) stripped) + rest <- T.stripPrefix "=" afterKey + pure (substituterValues rest) + where + substituterKeys :: [Text] + substituterKeys = ["extra-substituters", "substituters", "binary-caches"] + + matchesDirective :: Text -> Text -> Bool + matchesDirective k s = case T.stripPrefix k s of + Nothing -> False + Just rest -> case T.uncons rest of + Just (c, _) -> c == ' ' || c == '\t' || c == '=' + Nothing -> False isPublicKey :: NixConfLine -> Maybe [Text] isPublicKey (TrustedPublicKeys xs) = Just xs diff --git a/src/Cachix/Client/OptionsParser.hs b/src/Cachix/Client/OptionsParser.hs --- a/src/Cachix/Client/OptionsParser.hs +++ b/src/Cachix/Client/OptionsParser.hs @@ -26,6 +26,9 @@ -- * Doctor options DoctorOptions (..), + -- * List options + ListOptions (..), + -- * Global options Flags (..), @@ -92,6 +95,7 @@ | WatchStore PushOptions Text | WatchExec WatchExecMode PushOptions NarinfoQueryOptions Text Text [Text] | Use BinaryCacheName InstallationMode.UseOptions + | List ListOptions | Remove BinaryCacheName | DeployCommand DeployOptions.DeployCommand | Version @@ -203,6 +207,11 @@ } deriving (Show) +data ListOptions = ListOptions + { listAll :: Bool + } + deriving (Show) + -- | CLI parser entry point getOpts :: IO (Flags, CachixCommand) getOpts = do @@ -245,6 +254,7 @@ hidden, command "generate-keypair" $ infoH generateKeypairCommand $ progDesc "Generate a signing key pair for a binary cache", command "use" $ infoH useCommand $ progDesc "Configure a binary cache in nix.conf", + command "list" $ infoH listCommand $ progDesc "List Cachix caches configured in nix.conf", command "remove" $ infoH removeCommand $ progDesc "Remove a binary cache from nix.conf" ] @@ -712,6 +722,17 @@ removeCommand :: Parser CachixCommand removeCommand = Remove <$> cacheNameParser + +listCommand :: Parser CachixCommand +listCommand = List <$> listOptionsParser + +listOptionsParser :: Parser ListOptions +listOptionsParser = + ListOptions + <$> switch + ( long "all" + <> help "Also show non-Cachix substituters" + ) useCommand :: Parser CachixCommand useCommand = Use <$> cacheNameParser <*> installationMode diff --git a/src/Cachix/Client/Retry.hs b/src/Cachix/Client/Retry.hs --- a/src/Cachix/Client/Retry.hs +++ b/src/Cachix/Client/Retry.hs @@ -5,6 +5,7 @@ -- * HTTP retry retryHttp, retryClientM, + shouldRetryHttpStatusCode, -- * Policies endlessConstantRetryPolicy, @@ -145,9 +146,10 @@ HTTP.HttpZlibException _ -> True _ -> False --- | Whether an HTTP status code is worth retrying. 429 and any 5xx. +-- | Whether an HTTP status code is worth retrying. 408, 429 and any 5xx. shouldRetryHttpStatusCode :: HTTP.Status -> Bool shouldRetryHttpStatusCode code + | code == HTTP.requestTimeout408 = True | code == HTTP.tooManyRequests429 = True | HTTP.statusIsServerError code = True | otherwise = False diff --git a/src/Cachix/Client/Terminal.hs b/src/Cachix/Client/Terminal.hs new file mode 100644 --- /dev/null +++ b/src/Cachix/Client/Terminal.hs @@ -0,0 +1,20 @@ +module Cachix.Client.Terminal + ( isCI, + useInteractiveProgress, + ) +where + +import Data.Char qualified as Char +import Protolude +import System.Environment (lookupEnv) +import System.IO (hIsTerminalDevice) +import Prelude (String) + +isCI :: Maybe String -> Bool +isCI = maybe False $ \value -> fmap Char.toLower value `elem` ["true", "1"] + +useInteractiveProgress :: Handle -> IO Bool +useInteractiveProgress hdl = do + isTerminal <- hIsTerminalDevice hdl + runningInCI <- isCI <$> lookupEnv "CI" + return $ isTerminal && not runningInCI diff --git a/src/Cachix/Client/URI.hs b/src/Cachix/Client/URI.hs --- a/src/Cachix/Client/URI.hs +++ b/src/Cachix/Client/URI.hs @@ -7,6 +7,7 @@ fromURIRef, getScheme, getHostname, + getHostnameMay, appendSubdomain, getPortFor, getPath, @@ -16,6 +17,7 @@ serialize, toByteString, getBaseUrl, + canonicalForm, defaultCachixURI, defaultCachixBaseUrl, UBS.Host (..), @@ -62,6 +64,25 @@ getHostname :: URI -> UBS.Host getHostname = UBS.authorityHost . fromJust . UBS.uriAuthority . getUri + +-- | Like 'getHostname', but returns 'Nothing' if the URI has no authority +-- (e.g. @urn:…@, @mailto:…@, scheme-only forms) instead of throwing. +getHostnameMay :: URI -> Maybe UBS.Host +getHostnameMay = fmap UBS.authorityHost . UBS.uriAuthority . getUri + +-- | Normalize scheme, hostname and default ports for deduplication, +-- preserving paths, credentials, query parameters and fragments. +-- Returns 'Nothing' for URIs without an authority. +canonicalForm :: URI -> Maybe Text +canonicalForm (URI u) = do + authority <- UBS.uriAuthority u + let scheme = UBS.Scheme (Char8.map toLower (UBS.schemeBS (UBS.uriScheme u))) + host = UBS.Host (Char8.map toLower (UBS.hostBS (UBS.authorityHost authority))) + port = case UBS.authorityPort authority of + Just p | Just p == getPortFor scheme -> Nothing + p -> p + normalizedAuthority = authority {UBS.authorityHost = host, UBS.authorityPort = port} + pure $ toS $ UBS.serializeURIRef' $ u {UBS.uriScheme = scheme, UBS.uriAuthority = Just normalizedAuthority} -- TODO: lenses? appendSubdomain :: Text -> URI -> URI diff --git a/src/Cachix/Daemon/Progress.hs b/src/Cachix/Daemon/Progress.hs --- a/src/Cachix/Daemon/Progress.hs +++ b/src/Cachix/Daemon/Progress.hs @@ -12,6 +12,7 @@ where import Cachix.Client.HumanSize (humanSize) +import Cachix.Client.Terminal (useInteractiveProgress) import Cachix.Daemon.Types (PushRetryStatus (..)) import Cachix.Daemon.Types.PushEvent (PushEvent (..), PushEventMessage (..)) import Control.Concurrent.Async qualified as Async @@ -24,8 +25,6 @@ import System.Console.AsciiProgress qualified as Ascii import System.Console.AsciiProgress.Internal qualified as Ascii.Internal import System.Console.Pretty -import System.Environment (lookupEnv) -import System.IO (hIsTerminalDevice) data UploadProgress = ProgressBar @@ -50,9 +49,8 @@ new :: Handle -> String -> Int64 -> PushRetryStatus -> IO UploadProgress new hdl path size retryStatus = do lastBytesRef <- newIORef 0 - isCI <- liftIO $ (== Just "true") <$> lookupEnv "CI" - isTerminal <- liftIO $ hIsTerminalDevice hdl - if isTerminal && not isCI + interactiveProgress <- useInteractiveProgress hdl + if interactiveProgress then do progressBar <- newProgressBar path size retryStatus return $ ProgressBar {..} diff --git a/src/Cachix/Deploy/Agent.hs b/src/Cachix/Deploy/Agent.hs --- a/src/Cachix/Deploy/Agent.hs +++ b/src/Cachix/Deploy/Agent.hs @@ -3,6 +3,7 @@ module Cachix.Deploy.Agent where +import Cachix.API.WebSocketSubprotocol qualified as DeploymentDetails (DeploymentDetails (..)) import Cachix.API.WebSocketSubprotocol qualified as WSS import Cachix.Client.Config qualified as Config import Cachix.Client.URI (URI) @@ -22,7 +23,10 @@ import Control.Retry qualified as Retry import Data.Aeson qualified as Aeson import Data.IORef +import Data.Set qualified as Set import Data.String (String) +import Data.UUID (UUID) +import Data.UUID qualified as UUID import Katip qualified as K import Paths_cachix (getBinDir) import Protolude hiding (onException, toS, (<.>)) @@ -47,6 +51,7 @@ host :: URI, websocket :: ServiceWebSocket, agentState :: IORef (Maybe WSS.AgentInformation), + seenDeployments :: IORef (Set.Set UUID), logOptions :: Log.Options, withLog :: Log.WithLog, lockFile :: FilePath, @@ -57,6 +62,7 @@ mkAgent :: Log.WithLog -> Log.Options -> Maybe FilePath -> Config.CachixOptions -> CLI.AgentOptions -> Text -> IO Agent mkAgent withLog logOptions mlockDirectory cachixOptions agentOptions agentToken = do agentState <- newIORef Nothing + seenDeployments <- newIORef Set.empty pid <- Posix.getProcessID lockDirectory <- maybe Lock.getLockDirectory return mlockDirectory @@ -93,6 +99,7 @@ profileName = profileName, bootstrap = CLI.bootstrap agentOptions, agentState = agentState, + seenDeployments = seenDeployments, pid = pid, pidFile = lockDirectory lockFilename <.> Lock.pidExtension, lockFile = lockDirectory lockFilename <.> Lock.lockExtension, @@ -225,7 +232,16 @@ atomicWriteIORef agentState (Just agentInformation) launchDeployment :: Agent -> WSS.DeploymentDetails -> IO () -launchDeployment agent@Agent {..} deploymentDetails = do +launchDeployment = launchDeploymentWith runDeployment + where + runDeployment deployment = do + binDir <- toS <$> getBinDir + StdinProcess.readProcess (binDir <> "/.cachix-deployment") [] $ + toS $ + Aeson.encode deployment + +launchDeploymentWith :: (Deployment.Deployment -> IO ExitCode) -> Agent -> WSS.DeploymentDetails -> IO () +launchDeploymentWith runDeployment agent@Agent {..} deploymentDetails = do agentRegistered <- readIORef agentState case agentRegistered of @@ -233,23 +249,42 @@ -- we should re-register here as a precaution. Nothing -> pure () Just agentInformation -> do - binDir <- toS <$> getBinDir - exitCode <- - StdinProcess.readProcess (binDir <> "/.cachix-deployment") [] $ - toS . Aeson.encode $ - Deployment.Deployment - { Deployment.agentName = name, - Deployment.agentToken = token, - Deployment.profileName = profileName, - Deployment.host = host, - Deployment.deploymentDetails = deploymentDetails, - Deployment.agentInformation = agentInformation, - Deployment.logOptions = logOptions - } + let deploymentID = DeploymentDetails.id deploymentDetails + isNewDeployment <- + atomicModifyIORef' seenDeployments $ \deploymentIDs -> + if Set.member deploymentID deploymentIDs + then (deploymentIDs, False) + else (Set.insert deploymentID deploymentIDs, True) - when - (bootstrap && exitCode == ExitSuccess) - (verifyBootstrapSuccess agent) + if isNewDeployment + then do + exitCode <- + runDeployment $ + Deployment.Deployment + { Deployment.agentName = name, + Deployment.agentToken = token, + Deployment.profileName = profileName, + Deployment.host = host, + Deployment.deploymentDetails = deploymentDetails, + Deployment.agentInformation = agentInformation, + Deployment.logOptions = logOptions + } + + -- A process failure can happen before the deployment reports a status. + -- Let a subsequent backend delivery retry it. + when (exitCode /= ExitSuccess) $ + atomicModifyIORef' seenDeployments $ \deploymentIDs -> + (Set.delete deploymentID deploymentIDs, ()) + + when + (bootstrap && exitCode == ExitSuccess) + (verifyBootstrapSuccess agent) + else + withLog . K.logLocM K.InfoS . K.ls $ + unwords + [ "Ignoring duplicate deployment", + UUID.toText deploymentID <> "." + ] verifyBootstrapSuccess :: Agent -> IO () verifyBootstrapSuccess agent@(Agent {name, withLog}) = do diff --git a/src/Cachix/Deploy/Deployment.hs b/src/Cachix/Deploy/Deployment.hs --- a/src/Cachix/Deploy/Deployment.hs +++ b/src/Cachix/Deploy/Deployment.hs @@ -6,6 +6,12 @@ import Data.Aeson qualified as Aeson import Protolude +-- | The deployment helper could not acquire the profile lock and did not +-- deploy. The agent must keep the delivery retryable while the backend +-- reschedules it. +lockContentionExitCode :: ExitCode +lockContentionExitCode = ExitFailure 75 + -- | Everything required for the standalone deployment binary to complete a -- deployment. data Deployment = Deployment diff --git a/test/CommandListSpec.hs b/test/CommandListSpec.hs new file mode 100644 --- /dev/null +++ b/test/CommandListSpec.hs @@ -0,0 +1,83 @@ +module CommandListSpec (spec) where + +import Cachix.Client.Command.List (Entry (..), cachixCacheName, configuredEntries) +import Cachix.Client.NixConf qualified as NixConf +import Cachix.Client.OptionsParser (ListOptions (..)) +import Cachix.Client.URI (URI) +import Protolude +import Test.Hspec + +spec :: Spec +spec = do + describe "cachixCacheName" $ do + it "extracts the cache name from a subdomain of the default Cachix host" $ + cachixCacheName defaultHost "https://corestory.cachix.org" `shouldBe` Just "corestory" + + it "ignores a trailing path on the substituter URI" $ + cachixCacheName defaultHost "https://corestory.cachix.org/" `shouldBe` Just "corestory" + + it "returns Nothing for a non-Cachix substituter" $ + cachixCacheName defaultHost "https://cache.nixos.org" `shouldBe` Nothing + + it "returns Nothing for the bare Cachix host (no subdomain)" $ + cachixCacheName defaultHost "https://cachix.org" `shouldBe` Nothing + + it "matches a cache on a self-hosted Cachix instance" $ + cachixCacheName selfHosted "https://foo.cachix.example.com" `shouldBe` Just "foo" + + it "does not match a cache on the default host when using a self-hosted instance" $ + cachixCacheName selfHosted "https://foo.cachix.org" `shouldBe` Nothing + + it "returns Nothing for an unparseable URI" $ + cachixCacheName defaultHost "not a url" `shouldBe` Nothing + + it "matches case-insensitively on the substituter host" $ + cachixCacheName defaultHost "https://FOO.Cachix.Org" `shouldBe` Just "foo" + + it "matches case-insensitively on the Cachix host" $ + cachixCacheName "https://Cachix.Org" "https://foo.cachix.org" `shouldBe` Just "foo" + + it "returns Nothing for a URI with no authority (urn:…) instead of throwing" $ + cachixCacheName defaultHost "urn:isbn:0451450523" `shouldBe` Nothing + + it "returns Nothing for a mailto: URI instead of throwing" $ + cachixCacheName defaultHost "mailto:ops@example.com" `shouldBe` Nothing + + it "ignores an explicit default port on the substituter URI" $ + cachixCacheName defaultHost "https://foo.cachix.org:443" `shouldBe` Just "foo" + + describe "configuredEntries" $ do + it "lists active caches but excludes trusted-only and commented caches" $ do + let source = parsedSource "nix.conf" "substituters = https://live.cachix.org # https://disabled.cachix.org\nextra-substituters = https://extra.cachix.org # https://comment.cachix.org\ntrusted-substituters = https://allowed.cachix.org\nextra-trusted-substituters = https://also-allowed.cachix.org\n" + map entryUri (configuredEntries defaultHost (ListOptions False) [source]) + `shouldBe` ["https://live.cachix.org", "https://extra.cachix.org"] + + it "includes non-Cachix caches only with --all" $ do + let source = parsedSource "nix.conf" "substituters = https://foo.cachix.org https://cache.nixos.org\n" + map entryUri (configuredEntries defaultHost (ListOptions False) [source]) + `shouldBe` ["https://foo.cachix.org"] + map entryUri (configuredEntries defaultHost (ListOptions True) [source]) + `shouldBe` ["https://foo.cachix.org", "https://cache.nixos.org"] + + it "retains distinct S3 endpoints" $ do + let urls = ["s3://cache?endpoint=minio-a.example.com", "s3://cache?endpoint=minio-b.example.com"] + source = NixConf.NixConfSource "nix.conf" (NixConf.NixConf [NixConf.Substituters urls]) + map entryUri (configuredEntries defaultHost (ListOptions True) [source]) `shouldBe` urls + + it "deduplicates equivalent hosts and ports while retaining the first source and spelling" $ do + let first = parsedSource "global.conf" "substituters = https://FOO.Cachix.Org:443\n" + second = parsedSource "local.conf" "extra-substituters = https://foo.cachix.org\n" + map (\entry -> (entrySource entry, entryUri entry)) (configuredEntries defaultHost (ListOptions False) [first, second]) + `shouldBe` [("global.conf", "https://FOO.Cachix.Org:443")] + +parsedSource :: FilePath -> Text -> NixConf.NixConfSource +parsedSource path contents = + case NixConf.parse contents of + Right conf -> NixConf.NixConfSource path conf + Left err -> panic (show err) + +defaultHost :: URI +defaultHost = "https://cachix.org" + +selfHosted :: URI +selfHosted = "https://cachix.example.com" diff --git a/test/DeploySpec.hs b/test/DeploySpec.hs --- a/test/DeploySpec.hs +++ b/test/DeploySpec.hs @@ -1,13 +1,18 @@ module DeploySpec where +import Cachix.API.WebSocketSubprotocol qualified as DeploymentDetails (DeploymentDetails (..)) +import Cachix.API.WebSocketSubprotocol qualified as WSS import Cachix.Client.Config qualified as Config -import Cachix.Deploy.Agent (Agent (..), mkAgent, waitForAgent) +import Cachix.Deploy.Agent (Agent (..), launchDeploymentWith, mkAgent, registerAgent, waitForAgent) +import Cachix.Deploy.Deployment (lockContentionExitCode) import Cachix.Deploy.Lock (withTryLock, withTryLockAndPid) import Cachix.Deploy.Log qualified as Log import Cachix.Deploy.OptionsParser qualified as CLI import Cachix.Deploy.Websocket qualified as WebSocket import Control.Concurrent.MVar qualified as MVar import Control.Retry qualified as Retry +import Data.IORef +import Data.UUID qualified as UUID import Protolude import System.IO.Temp (withSystemTempDirectory) import Test.Hspec @@ -49,6 +54,62 @@ WebSocket.withConnectionTimeout (10 * 1000) (pure ((), MVar.putMVar closed ())) pure MVar.tryTakeMVar closed `shouldReturn` Just () + describe "deployment commands" $ do + it "runs a deployment ID only once" $ + withSystemTempDirectory "cachix-deploy-test" $ \tempDir -> + withTestAgent tempDir $ \agent -> do + registerTestAgent agent + launches <- newIORef (0 :: Int) + let runDeployment _ = modifyIORef' launches (+ 1) $> ExitSuccess + deployment = testDeployment UUID.nil + + launchDeploymentWith runDeployment agent deployment + launchDeploymentWith runDeployment agent deployment + + readIORef launches `shouldReturn` 1 + + it "runs a new deployment ID" $ + withSystemTempDirectory "cachix-deploy-test" $ \tempDir -> + withTestAgent tempDir $ \agent -> do + registerTestAgent agent + launches <- newIORef (0 :: Int) + let runDeployment _ = modifyIORef' launches (+ 1) $> ExitSuccess + + launchDeploymentWith runDeployment agent (testDeployment UUID.nil) + launchDeploymentWith runDeployment agent (testDeployment (UUID.fromWords 0 0 0 1)) + + readIORef launches `shouldReturn` 2 + + it "ignores an older deployment ID after a newer deployment" $ + withSystemTempDirectory "cachix-deploy-test" $ \tempDir -> + withTestAgent tempDir $ \agent -> do + registerTestAgent agent + launches <- newIORef (0 :: Int) + let runDeployment _ = modifyIORef' launches (+ 1) $> ExitSuccess + firstDeployment = testDeployment UUID.nil + secondDeployment = testDeployment (UUID.fromWords 0 0 0 1) + + launchDeploymentWith runDeployment agent firstDeployment + launchDeploymentWith runDeployment agent secondDeployment + launchDeploymentWith runDeployment agent firstDeployment + + readIORef launches `shouldReturn` 2 + + it "retries a deployment after the child process skips on lock contention" $ + withSystemTempDirectory "cachix-deploy-test" $ \tempDir -> + withTestAgent tempDir $ \agent -> do + registerTestAgent agent + results <- newIORef [lockContentionExitCode, ExitSuccess] + let runDeployment _ = atomicModifyIORef' results $ \case + result : remaining -> (remaining, result) + [] -> ([], ExitSuccess) + deployment = testDeployment UUID.nil + + launchDeploymentWith runDeployment agent deployment + launchDeploymentWith runDeployment agent deployment + + readIORef results `shouldReturn` [] + withTestAgent :: FilePath -> (Agent -> IO ()) -> IO () withTestAgent tempDir action = do let logOptions = @@ -73,3 +134,16 @@ retryPolicy :: Retry.RetryPolicyM IO retryPolicy = Retry.limitRetries 1 <> Retry.constantDelay 10 + +registerTestAgent :: Agent -> IO () +registerTestAgent agent = + registerAgent agent WSS.AgentInformation {WSS.cache = Nothing, WSS.id = UUID.nil} + +testDeployment :: UUID.UUID -> WSS.DeploymentDetails +testDeployment deploymentID = + DeploymentDetails.DeploymentDetails + { DeploymentDetails.storePath = "/nix/store/test", + DeploymentDetails.id = deploymentID, + DeploymentDetails.index = 1, + DeploymentDetails.rollbackScript = Nothing + } diff --git a/test/NixConfSpec.hs b/test/NixConfSpec.hs --- a/test/NixConfSpec.hs +++ b/test/NixConfSpec.hs @@ -41,6 +41,27 @@ it "random content" $ property "blabla = foobar\nfoo = bar\n" + describe "reading active substituters" $ do + it "preserves inline comments when rendering" $ do + let contents = "extra-substituters = https://live.cachix.org # https://disabled.cachix.org\n" + property contents + (NixConf.readLines NixConf.isAnySubstituter <$> parse contents) + `shouldBe` Right ["https://live.cachix.org"] + + it "strips comments from regular substituters without changing rendering" $ do + let contents = "substituters = https://live.cachix.org # https://disabled.cachix.org\n" + property contents + (NixConf.readLines NixConf.isAnySubstituter <$> parse contents) + `shouldBe` Right ["https://live.cachix.org"] + + it "excludes trusted-only caches" $ + (NixConf.readLines NixConf.isAnySubstituter <$> parse "trusted-substituters = https://allowed.cachix.org\nextra-trusted-substituters = https://also-allowed.cachix.org\n") + `shouldBe` Right [] + + it "handles tabs and adjacent comment markers" $ + (NixConf.readLines NixConf.isAnySubstituter <$> parse "extra-substituters\t=\thttps://live.cachix.org#comment\n") + `shouldBe` Right ["https://live.cachix.org"] + describe "add" $ do it "merges binary caches from both files" $ let globalConf = diff --git a/test/RetrySpec.hs b/test/RetrySpec.hs new file mode 100644 --- /dev/null +++ b/test/RetrySpec.hs @@ -0,0 +1,14 @@ +module RetrySpec where + +import Cachix.Client.Retry (shouldRetryHttpStatusCode) +import Network.HTTP.Types.Status qualified as HTTP +import Protolude +import Test.Hspec + +spec :: Spec +spec = describe "HTTP retry status selection" $ + it "retries timeouts, rate limits and server errors, but not other client errors" $ do + forM_ [408, 429, 500, 502, 503, 504, 520, 524] $ \code -> + shouldRetryHttpStatusCode (HTTP.mkStatus code "") `shouldBe` True + forM_ [400, 401, 403, 404, 409, 413, 421, 425] $ \code -> + shouldRetryHttpStatusCode (HTTP.mkStatus code "") `shouldBe` False diff --git a/test/TerminalSpec.hs b/test/TerminalSpec.hs new file mode 100644 --- /dev/null +++ b/test/TerminalSpec.hs @@ -0,0 +1,19 @@ +module TerminalSpec (spec) where + +import Cachix.Client.Terminal (isCI, useInteractiveProgress) +import Protolude +import Test.Hspec + +spec :: Spec +spec = do + describe "isCI" $ do + it "recognizes supported CI values" $ do + fmap isCI [Just "true", Just "1", Just "TRUE"] `shouldBe` [True, True, True] + + it "does not treat other values as CI" $ do + fmap isCI [Nothing, Just "false", Just "0", Just ""] `shouldBe` [False, False, False, False] + + describe "useInteractiveProgress" $ do + it "rejects non-terminal handles" $ do + withFile "/dev/null" WriteMode $ \hdl -> + useInteractiveProgress hdl `shouldReturn` False diff --git a/test/URISpec.hs b/test/URISpec.hs --- a/test/URISpec.hs +++ b/test/URISpec.hs @@ -38,6 +38,23 @@ spec :: Spec spec = describe "URI" $ do + describe "canonicalForm" $ do + it "normalizes scheme, hostname and default port" $ + URI.canonicalForm "HTTPS://FOO.Cachix.Org:443" `shouldBe` Just "https://foo.cachix.org" + + it "preserves credentials, path, query parameters and fragment" $ + URI.canonicalForm "https://user:pass@FOO.cachix.org:443/cache/?priority=10#fragment" + `shouldBe` Just "https://user:pass@foo.cachix.org/cache/?priority=10#fragment" + + it "preserves non-default ports" $ + URI.canonicalForm "https://foo.cachix.org:8443" `shouldBe` Just "https://foo.cachix.org:8443" + + it "preserves the trailing slash on a nonempty path" $ + URI.canonicalForm "https://foo.cachix.org/cache/" `shouldNotBe` URI.canonicalForm "https://foo.cachix.org/cache" + + it "returns Nothing without an authority" $ + URI.canonicalForm "urn:isbn:0451450523" `shouldBe` Nothing + it "parses a URI" $ URI.parseURI secureUri `shouldSatisfy` isRight