packages feed

cachix 1.9.2 → 1.10.0

raw patch · 12 files changed

+611/−16 lines, 12 files

Files

CHANGELOG.md view
@@ -5,6 +5,17 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## [1.10.0] - 2026-01-06++### Added++- `cachix doctor`: a new command for diagnostics that validates the configuration, auth token, and cache connectivity+- `cachix daemon doctor`: a new command for daemon-specific diagnostics++### Fixed++- Show the actual error message when store path validation fails instead of a generic "is not valid" message+ ## [1.9.2] - 2025-12-11  ### Changes
cachix.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               cachix-version:            1.9.2+version:            1.10.0 synopsis:   Command-line client for Nix binary cache hosting https://cachix.org @@ -60,6 +60,7 @@     Cachix.Client.Command     Cachix.Client.Command.Cache     Cachix.Client.Command.Config+    Cachix.Client.Command.Doctor     Cachix.Client.Command.Import     Cachix.Client.Command.Pin     Cachix.Client.Command.Push
src/Cachix/Client.hs view
@@ -37,12 +37,14 @@   case command of     AuthToken token -> Command.authtoken env token     Config configCommand -> Config.run cachixOptions configCommand+    Daemon (DaemonDoctor daemonOptions) -> Command.daemonDoctor env daemonOptions     Daemon (DaemonRun daemonOptions pushOptions mcacheName) -> Daemon.start env daemonOptions pushOptions mcacheName     Daemon (DaemonStop daemonOptions) -> Daemon.Client.stop env daemonOptions     Daemon (DaemonPushPaths daemonOptions daemonPushOptions storePaths) -> Daemon.Client.push env daemonOptions daemonPushOptions storePaths     Daemon (DaemonWatchExec daemonOptions pushOptions cacheName cmd args) -> Command.watchExecDaemon env pushOptions (daemonNarinfoQueryOptions daemonOptions) cacheName cmd args     DeployCommand (DeployOptions.Agent opts) -> AgentCommand.run cachixOptions opts     DeployCommand (DeployOptions.Activate opts) -> ActivateCommand.run env opts+    Doctor doctorOptions -> Command.doctor env doctorOptions     GenerateKeypair name -> Command.generateKeypair env name     Import pushOptions name uri -> Command.import' env pushOptions name uri     Pin pingArgs -> Command.pin env pingArgs
src/Cachix/Client/CNix.hs view
@@ -15,13 +15,22 @@     else return Nothing  -- | Like 'validateStorePath', but logs a warning when the path is invalid.+--+-- When validation fails due to an error (e.g., permission denied),+-- the actual error message is logged instead of a generic "is not valid" message. filterInvalidStorePath :: Store -> StorePath -> IO (Maybe StorePath) filterInvalidStorePath store storePath = do-  mstorePath <- validateStorePath store storePath--  when (isNothing mstorePath) (logBadStorePath store storePath)--  return mstorePath+  result <- tryValidate+  case result of+    Right True -> return (Just storePath)+    Right False -> do+      logBadStorePath store storePath+      return Nothing+    Left err -> do+      logStorePathError store storePath err+      return Nothing+  where+    tryValidate = (Right <$> Store.isValidPath store storePath) `catchNixError` (return . Left)  filterInvalidStorePaths :: Store -> [StorePath] -> IO [Maybe StorePath] filterInvalidStorePaths store =@@ -70,6 +79,13 @@ logBadStorePath store storePath = do   path <- Store.storePathToPath store storePath   logBadPath path++-- | Print a warning with the actual error when accessing a store path fails.+logStorePathError :: Store -> StorePath -> NixError -> IO ()+logStorePathError store storePath (NixError {..}) = do+  path <- Store.storePathToPath store storePath+  let pathText = decodeUtf8With lenientDecode path+  putErrText $ color Yellow $ "Warning: " <> pathText <> " - " <> msg <> ", skipping"  -- | Print a warning when the path is invalid. --
src/Cachix/Client/Command.hs view
@@ -3,6 +3,8 @@     Cache.remove,     Config.authtoken,     Config.generateKeypair,+    Doctor.daemonDoctor,+    Doctor.doctor,     Import.import',     Pin.pin,     Push.push,@@ -15,6 +17,7 @@  import Cachix.Client.Command.Cache qualified as Cache 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.Pin qualified as Pin import Cachix.Client.Command.Push qualified as Push
+ src/Cachix/Client/Command/Doctor.hs view
@@ -0,0 +1,454 @@+module Cachix.Client.Command.Doctor (daemonDoctor, doctor) where++import Cachix.API qualified as API+import Cachix.Client.Config qualified as Config+import Cachix.Client.Env (Env (..))+import Cachix.Client.OptionsParser (DaemonOptions (..), DoctorOptions (..))+import Cachix.Client.Retry (retryHttp)+import Cachix.Client.Servant (cachixClient, isErr)+import Cachix.Daemon.Listen (getSocketPath)+import Cachix.Daemon.Protocol qualified as Protocol+import Cachix.Types.BinaryCache (BinaryCache (..))+import Cachix.Types.Permission (Permission (..))+import Control.Exception.Safe qualified as Exception+import Data.Aeson qualified as Aeson+import Data.ByteString qualified as BS+import Data.Text qualified as T+import Network.HTTP.Types (status401, status404)+import Network.Socket qualified as Socket+import Network.Socket.ByteString qualified as Socket.BS+import Network.Socket.ByteString.Lazy qualified as Socket.LBS+import Protolude hiding (toS)+import Protolude.Conv+import Servant.Auth.Client+import Servant.Client.Streaming (ClientError, runClientM)+import System.Directory (doesFileExist)+import System.Environment (lookupEnv)+import System.Timeout (timeout)++-- | Result of a single check+data CheckResult+  = CheckOK+  | CheckFailed Text+  | CheckWarning Text+  deriving (Show)++-- | Result of checking a cache+data CacheCheckResult = CacheCheckResult+  { cacheResultName :: Text,+    cacheResultUri :: Maybe Text,+    cacheResultPublic :: Maybe Bool,+    cacheResultPermission :: Maybe Permission,+    cacheResultHasSigningKey :: Bool,+    cacheResultConnectivity :: CheckResult,+    cacheResultAuth :: CheckResult+  }++-- | Result of checking daemon+data DaemonCheckResult+  = DaemonNotRunning+  | DaemonRunning FilePath (Maybe Protocol.DaemonDiagnostics)+  | DaemonConnectionFailed Text+  deriving (Show)++doctor :: Env -> DoctorOptions -> IO ()+doctor env opts = do+  -- Check if CACHIX_DAEMON_SOCKET is set and warn user+  envSocketPath <- lookupEnv "CACHIX_DAEMON_SOCKET"+  case envSocketPath of+    Just _ -> do+      putStrLn ("Note: CACHIX_DAEMON_SOCKET is set. Use 'cachix daemon doctor' for daemon-specific diagnostics." :: Text)+      putStrLn ("" :: Text)+    Nothing -> return ()++  putStrLn ("Cachix Doctor" :: Text)+  putStrLn ("=============" :: Text)+  putStrLn ("" :: Text)++  -- Configuration checks+  configResult <- checkConfiguration env+  printConfigResult configResult++  -- Auth check+  authResult <- checkAuth env+  printAuthResult authResult++  -- Cache checks+  cacheResults <- checkCaches env opts+  printCacheResults cacheResults++  -- Store path check (if provided)+  storePathResult <- case doctorStorePath opts of+    Just storePath -> do+      result <- checkStorePath env opts storePath+      printStorePathResult result+      return (Just result)+    Nothing -> return Nothing++  -- Summary+  let allPassed = configPassed configResult && authPassed authResult && cachesPassed cacheResults && storePathOk storePathResult+  putStrLn ("" :: Text)+  if allPassed+    then putStrLn ("All checks passed." :: Text)+    else do+      putStrLn ("Some checks failed." :: Text)+      exitFailure++-- | Daemon-specific doctor command+daemonDoctor :: Env -> DaemonOptions -> IO ()+daemonDoctor _env opts = do+  -- Resolve socket path: CLI option takes precedence over environment variable+  envSocketPath <- fmap toS <$> lookupEnv "CACHIX_DAEMON_SOCKET"+  let socketPath = daemonSocketPath opts <|> envSocketPath++  putStrLn ("Cachix Daemon Doctor" :: Text)+  putStrLn ("====================" :: Text)+  putStrLn ("" :: Text)++  -- Check daemon status+  daemonResult <- checkDaemon socketPath+  printDaemonResult daemonResult++  -- Summary+  let allPassed = case daemonResult of+        DaemonRunning _ (Just diag) -> Protocol.diagAuthOk diag+        DaemonRunning _ Nothing -> True+        DaemonNotRunning -> False+        DaemonConnectionFailed _ -> False+  putStrLn ("" :: Text)+  if allPassed+    then putStrLn ("All checks passed." :: Text)+    else do+      putStrLn ("Some checks failed." :: Text)+      exitFailure++-- Configuration checks+data ConfigCheckResult = ConfigCheckResult+  { configFileResult :: CheckResult,+    authTokenResult :: CheckResult,+    authTokenSource :: Maybe Text+  }++configPassed :: ConfigCheckResult -> Bool+configPassed ConfigCheckResult {..} =+  case (configFileResult, authTokenResult) of+    (CheckFailed _, _) -> False+    (_, CheckFailed _) -> False+    _ -> True -- Warnings are OK for both config file and auth token++checkConfiguration :: Env -> IO ConfigCheckResult+checkConfiguration env = do+  let configPath = Config.configPath (cachixoptions env)++  -- Check config file+  configExists <- doesFileExist configPath+  let configFileRes =+        if configExists+          then CheckOK+          else CheckWarning "Config file not found (using defaults)"++  -- Check auth token+  maybeToken <- Config.getAuthTokenMaybe (config env)+  let (authRes, authSource) = case maybeToken of+        Just (Token t) | not (T.null (toS t)) -> (CheckOK, Just "from config")+        _ -> (CheckWarning "No auth token configured", Nothing)++  return+    ConfigCheckResult+      { configFileResult = configFileRes,+        authTokenResult = authRes,+        authTokenSource = authSource+      }++printConfigResult :: ConfigCheckResult -> IO ()+printConfigResult ConfigCheckResult {..} = do+  putStrLn ("Configuration" :: Text)+  printCheck "Config file" configFileResult Nothing+  printCheck "Auth token" authTokenResult authTokenSource++-- Auth validation+authPassed :: CheckResult -> Bool+authPassed CheckOK = True+authPassed (CheckWarning _) = True+authPassed (CheckFailed _) = False++checkAuth :: Env -> IO CheckResult+checkAuth _env = do+  -- Auth is validated per-cache, so just return OK here+  -- The actual auth validation happens in checkCaches+  return CheckOK++printAuthResult :: CheckResult -> IO ()+printAuthResult _ = return () -- Auth is shown per-cache++-- Cache checks+cachesPassed :: [CacheCheckResult] -> Bool+cachesPassed = all cacheCheckPassed+  where+    cacheCheckPassed CacheCheckResult {..} =+      case (cacheResultConnectivity, cacheResultAuth) of+        (CheckOK, CheckOK) -> True+        (CheckOK, CheckWarning _) -> True+        _ -> False++checkCaches :: Env -> DoctorOptions -> IO [CacheCheckResult]+checkCaches env opts = do+  let configuredCaches = Config.binaryCaches (config env)++  case doctorCacheName opts of+    Just specificCache -> do+      -- Check specific cache+      result <- checkCache env specificCache configuredCaches+      return [result]+    Nothing ->+      if null configuredCaches+        then do+          putStrLn ("" :: Text)+          putStrLn ("No caches configured." :: Text)+          return []+        else do+          -- Check all configured caches+          forM configuredCaches $ \cacheConfig ->+            checkCache env (Config.name cacheConfig) configuredCaches++checkCache :: Env -> Text -> [Config.BinaryCacheConfig] -> IO CacheCheckResult+checkCache env cacheName configuredCaches = do+  maybeToken <- Config.getAuthTokenMaybe (config env)+  let token = fromMaybe (Token "") maybeToken++  -- Check if we have a signing key for this cache+  let hasSigningKey = any (\c -> Config.name c == cacheName && not (T.null (Config.secretKey c))) configuredCaches++  -- Try to get cache info (validates auth and connectivity)+  cacheRes <- retryHttp $ (`runClientM` clientenv env) $ API.getCache cachixClient token cacheName++  case cacheRes of+    Right bc ->+      return+        CacheCheckResult+          { cacheResultName = cacheName,+            cacheResultUri = Just (uri bc),+            cacheResultPublic = Just (isPublic bc),+            cacheResultPermission = Just (permission bc),+            cacheResultHasSigningKey = hasSigningKey,+            cacheResultConnectivity = CheckOK,+            cacheResultAuth = CheckOK+          }+    Left err ->+      return+        CacheCheckResult+          { cacheResultName = cacheName,+            cacheResultUri = Nothing,+            cacheResultPublic = Nothing,+            cacheResultPermission = Nothing,+            cacheResultHasSigningKey = hasSigningKey,+            cacheResultConnectivity = checkConnectivityError err maybeToken,+            cacheResultAuth = checkAuthError err maybeToken+          }++checkConnectivityError :: ClientError -> Maybe Token -> CheckResult+checkConnectivityError err maybeToken+  | isErr err status404 = CheckFailed "Cache not found"+  | isErr err status401 = case maybeToken of+      Just _ -> CheckOK -- Auth error, not connectivity+      Nothing -> CheckFailed "Authentication required"+  | otherwise = CheckFailed (toS (show err :: [Char]))++checkAuthError :: ClientError -> Maybe Token -> CheckResult+checkAuthError err maybeToken+  | isErr err status401 = case maybeToken of+      Just _ -> CheckFailed "Invalid or expired auth token"+      Nothing -> CheckWarning "Not authenticated (cache may be private)"+  | isErr err status404 = CheckOK -- Not an auth error+  | otherwise = CheckOK++printCacheResults :: [CacheCheckResult] -> IO ()+printCacheResults results = do+  forM_ results $ \result -> do+    putStrLn ("" :: Text)+    putStrLn ("Cache: " <> cacheResultName result)+    case cacheResultUri result of+      Just u -> putStrLn ("  URI: " <> u)+      Nothing -> return ()+    case cacheResultPublic result of+      Just True -> putStrLn ("  Public: yes" :: Text)+      Just False -> putStrLn ("  Public: no" :: Text)+      Nothing -> return ()+    case cacheResultPermission result of+      Just p -> putStrLn ("  Permission: " <> T.toLower (show p))+      Nothing -> return ()+    let signingKeyResult = if cacheResultHasSigningKey result then CheckOK else CheckWarning "not configured"+    printCheck "Signing key" signingKeyResult Nothing+    printCheck "Connectivity" (cacheResultConnectivity result) Nothing+    printCheck "Authentication" (cacheResultAuth result) Nothing++-- Store path checks+data StorePathCheckResult = StorePathCheckResult+  { storePathQuery :: Text,+    storePathHash :: Text,+    storePathCacheName :: Text,+    storePathStatus :: StorePathStatus+  }+  deriving (Show)++data StorePathStatus+  = InCache+  | NotInCache+  | StorePathCheckError Text+  deriving (Show)++storePathOk :: Maybe StorePathCheckResult -> Bool+storePathOk Nothing = True+storePathOk (Just StorePathCheckResult {..}) =+  case storePathStatus of+    InCache -> True+    NotInCache -> True -- Not an error, just informational+    StorePathCheckError _ -> False++-- | Extract the hash from a store path+-- Store paths look like: /nix/store/abc123...-name+-- The hash is the 32-character string after /nix/store/+extractStoreHash :: Text -> Maybe Text+extractStoreHash storePath =+  let path = T.strip storePath+      -- Handle both full paths and just hashes+      normalized =+        if "/nix/store/" `T.isPrefixOf` path+          then T.drop 11 path -- Drop "/nix/store/"+          else path+   in if T.length normalized >= 32+        then Just $ T.take 32 normalized+        else Nothing++checkStorePath :: Env -> DoctorOptions -> Text -> IO StorePathCheckResult+checkStorePath env opts storePath = do+  maybeToken <- Config.getAuthTokenMaybe (config env)+  let token = fromMaybe (Token "") maybeToken+  let configuredCaches = Config.binaryCaches (config env)++  -- Determine which cache to check+  let cacheName = case doctorCacheName opts of+        Just name -> name+        Nothing -> case configuredCaches of+          (first' : _) -> Config.name first'+          [] -> "cachix" -- Default fallback+  case extractStoreHash storePath of+    Nothing ->+      return+        StorePathCheckResult+          { storePathQuery = storePath,+            storePathHash = "",+            storePathCacheName = cacheName,+            storePathStatus = StorePathCheckError "Invalid store path format"+          }+    Just storeHash -> do+      -- Use narinfoBulk to check if the path exists+      result <- retryHttp $ (`runClientM` clientenv env) $ API.narinfoBulk cachixClient token cacheName [storeHash]+      case result of+        Right missingHashes ->+          let status = if storeHash `elem` missingHashes then NotInCache else InCache+           in return+                StorePathCheckResult+                  { storePathQuery = storePath,+                    storePathHash = storeHash,+                    storePathCacheName = cacheName,+                    storePathStatus = status+                  }+        Left err ->+          return+            StorePathCheckResult+              { storePathQuery = storePath,+                storePathHash = storeHash,+                storePathCacheName = cacheName,+                storePathStatus = StorePathCheckError (toS (show err :: [Char]))+              }++printStorePathResult :: StorePathCheckResult -> IO ()+printStorePathResult StorePathCheckResult {..} = do+  putStrLn ("" :: Text)+  putStrLn ("Store Path" :: Text)+  putStrLn ("  Query: " <> storePathQuery)+  putStrLn ("  Hash: " <> storePathHash)+  putStrLn ("  Cache: " <> storePathCacheName)+  case storePathStatus of+    InCache ->+      printCheck "Status" CheckOK (Just "found in cache")+    NotInCache ->+      printCheck "Status" (CheckWarning "not in cache") Nothing+    StorePathCheckError err ->+      printCheck "Status" (CheckFailed err) Nothing++-- Daemon checks++checkDaemon :: Maybe FilePath -> IO DaemonCheckResult+checkDaemon optionalSocketPath = do+  socketPath <- maybe getSocketPath pure optionalSocketPath+  exists <- doesFileExist socketPath++  if not exists+    then return DaemonNotRunning+    else do+      -- Try to connect and get diagnostics+      result <- Exception.try $ queryDaemonDiagnostics socketPath+      case result of+        Right (Just diag) -> return $ DaemonRunning socketPath (Just diag)+        Right Nothing -> return $ DaemonConnectionFailed "No response from daemon"+        Left (e :: SomeException) -> return $ DaemonConnectionFailed (toS $ displayException e)++queryDaemonDiagnostics :: FilePath -> IO (Maybe Protocol.DaemonDiagnostics)+queryDaemonDiagnostics socketPath =+  Exception.bracket+    (Socket.socket Socket.AF_UNIX Socket.Stream Socket.defaultProtocol)+    Socket.close+    ( \sock -> do+        Socket.connect sock (Socket.SockAddrUnix socketPath)+        -- Send diagnostics request+        Socket.LBS.sendAll sock $ Protocol.newMessage Protocol.ClientDiagnosticsRequest+        -- Wait for response with timeout (10 seconds - auth check may take time)+        result <- timeout 10000000 $ receiveResponse sock+        case result of+          Just (Just (Protocol.DaemonDiagnosticsResult diag)) -> return (Just diag)+          _ -> return Nothing+    )++receiveResponse :: Socket.Socket -> IO (Maybe Protocol.DaemonMessage)+receiveResponse sock = do+  bs <- Socket.BS.recv sock 4096+  if BS.null bs+    then return Nothing+    else do+      let (msgs, _) = Protocol.splitMessages bs+      case msgs of+        (msg : _) -> return $ decodeMsg msg+        [] -> return Nothing+  where+    decodeMsg msg = case Aeson.eitherDecodeStrict msg of+      Right m -> Just m+      Left _ -> Nothing++printDaemonResult :: DaemonCheckResult -> IO ()+printDaemonResult result = do+  putStrLn ("" :: Text)+  putStrLn ("Daemon" :: Text)+  case result of+    DaemonNotRunning ->+      printCheck "Status" (CheckWarning "not running") Nothing+    DaemonRunning socketPath _ -> do+      printCheck "Status" CheckOK (Just "running")+      putStrLn ("  Socket: " <> (toS socketPath :: Text))+    DaemonConnectionFailed reason ->+      printCheck "Status" (CheckFailed reason) Nothing++-- Helper to print a check result+printCheck :: Text -> CheckResult -> Maybe Text -> IO ()+printCheck name result extra = do+  let (symbol, status) = case result of+        CheckOK -> ("✓", "")+        CheckWarning msg -> ("!", msg)+        CheckFailed msg -> ("✗", msg)+      extraText = case (extra, status) of+        (Just e, "") -> e+        (Just e, s) -> s <> " (" <> e <> ")"+        (Nothing, s) -> s+      statusText = if T.null extraText then "" else " " <> extraText+  putStrLn $ "  " <> symbol <> " " <> name <> statusText
src/Cachix/Client/OptionsParser.hs view
@@ -21,6 +21,9 @@     -- * Pin options     PinOptions (..), +    -- * Doctor options+    DoctorOptions (..),+     -- * Global options     Flags (..), @@ -79,6 +82,7 @@   = AuthToken (Maybe Text)   | Config Config.Command   | Daemon DaemonCommand+  | Doctor DoctorOptions   | GenerateKeypair BinaryCacheName   | Push PushArguments   | Import PushOptions Text URI@@ -168,6 +172,7 @@   | DaemonRun DaemonOptions PushOptions BinaryCacheName   | DaemonStop DaemonOptions   | DaemonWatchExec DaemonOptions PushOptions BinaryCacheName Text [Text]+  | DaemonDoctor DaemonOptions   deriving (Show)  data DaemonOptions = DaemonOptions@@ -182,6 +187,12 @@   }   deriving (Show) +data DoctorOptions = DoctorOptions+  { doctorCacheName :: Maybe BinaryCacheName,+    doctorStorePath :: Maybe Text+  }+  deriving (Show)+ -- | CLI parser entry point getOpts :: IO (Flags, CachixCommand) getOpts = do@@ -206,6 +217,7 @@     <|> storePathCommands     <|> daemonCommands     <|> deployCommands+    <|> diagnosticCommands   where     configCommands =       subparser $@@ -260,6 +272,14 @@             command "deploy" $ infoH deployCommand $ progDesc "Manage remote Nix-based systems with Cachix Deploy"           ] +    diagnosticCommands =+      subparser $+        fold+          [ commandGroup "Diagnostic commands:",+            hidden,+            command "doctor" $ infoH doctorCommand $ progDesc "Check Cachix configuration and connectivity"+          ]+ flagParser :: Config.ConfigPath -> Parser Flags flagParser defaultConfigPath =   Flags <$> configPath <*> (host <|> hostname) <*> verbose@@ -496,12 +516,16 @@ daemonSubCommand =   subparser $     fold-      [ command "push" $ infoH daemonPush $ progDesc "Push store paths to the daemon",+      [ command "doctor" $ infoH daemonDoctorParser $ progDesc "Check daemon health and connectivity",+        command "push" $ infoH daemonPush $ progDesc "Push store paths to the daemon",         command "run" $ infoH daemonRun $ progDesc "Launch the daemon",         command "stop" $ infoH daemonStop $ progDesc "Stop the daemon and wait for any queued paths to be pushed",         command "watch-exec" $ infoH daemonWatchExec $ progDesc "Run a command and upload any store paths built during its execution"       ] +daemonDoctorParser :: Parser DaemonCommand+daemonDoctorParser = DaemonDoctor <$> daemonOptionsParser+ daemonPush :: Parser DaemonCommand daemonPush =   DaemonPushPaths@@ -594,6 +618,25 @@  deployCommand :: Parser CachixCommand deployCommand = DeployCommand <$> DeployOptions.parser++doctorCommand :: Parser CachixCommand+doctorCommand =+  Doctor+    <$> ( DoctorOptions+            <$> cacheOption+            <*> storePathArg+        )+  where+    cacheOption =+      optional . strOption $+        long "cache"+          <> metavar "CACHE-NAME"+          <> help "Binary cache to check"++    storePathArg =+      optional . strArgument $+        metavar "STORE-PATH"+          <> help "Check if a specific store path or hash exists in the cache"  watchExecCommand :: Parser CachixCommand watchExecCommand =
src/Cachix/Daemon.hs view
@@ -11,6 +11,7 @@   ) where +import Cachix.API qualified as API import Cachix.Client.Command.Push qualified as Command.Push import Cachix.Client.Config qualified as Config import Cachix.Client.Config.Orphans ()@@ -18,6 +19,8 @@ import Cachix.Client.OptionsParser (DaemonOptions, PushOptions, daemonNarinfoQueryOptions) import Cachix.Client.OptionsParser qualified as Options import Cachix.Client.Push+import Cachix.Client.Retry (retryHttp)+import Cachix.Client.Servant (cachixClient) import Cachix.Daemon.EventLoop qualified as EventLoop import Cachix.Daemon.Listen as Listen import Cachix.Daemon.Log qualified as Log@@ -42,6 +45,7 @@ import Network.Socket qualified as Socket import Network.Socket.ByteString qualified as Socket.BS import Protolude hiding (bracket)+import Servant.Client.Streaming (runClientM) import System.Environment (lookupEnv) import System.IO.Error (isResourceVanishedError) import System.Posix.Process (getProcessID)@@ -169,6 +173,32 @@             else do               let errorMsg = "Remote stop is disabled on this daemon"               SocketStore.sendAll socketId (Protocol.newMessage (Protocol.DaemonError (Protocol.UnsupportedCommand errorMsg))) clients+        ClientDiagnosticsRequest -> do+          -- Get push secret to check for signing key and auth token+          let pushParams = PushManager.pmPushParams daemonPushManager+              pushSecret = pushParamsSecret pushParams+              hasSigningKey = case pushSecret of+                PushSigningKey {} -> True+                PushToken {} -> False+              maybeToken = getAuthTokenFromPushSecret pushSecret+          -- Verify auth by making an API call+          authResult <- case maybeToken of+            Nothing -> pure $ Left "No auth token configured"+            Just token -> do+              res <- liftIO $ retryHttp $ (`runClientM` clientenv daemonEnv) $ API.getCache cachixClient token daemonCacheName+              pure $ case res of+                Right _ -> Right ()+                Left err -> Left (show err)+          let diagnostics =+                Protocol.DaemonDiagnostics+                  { Protocol.diagCacheName = daemonCacheName,+                    Protocol.diagCacheUri = BinaryCache.uri daemonBinaryCache,+                    Protocol.diagCachePublic = BinaryCache.isPublic daemonBinaryCache,+                    Protocol.diagHasSigningKey = hasSigningKey,+                    Protocol.diagAuthOk = isRight authResult,+                    Protocol.diagError = either Just (const Nothing) authResult+                  }+          SocketStore.sendAll socketId (Protocol.newMessage (Protocol.DaemonDiagnosticsResult diagnostics)) daemonClients         _ -> return ()     ShutdownGracefully -> do       Katip.logFM Katip.InfoS "Shutting down daemon..."
src/Cachix/Daemon/Client.hs view
@@ -161,6 +161,7 @@                   _ -> loop               Protocol.DaemonError err -> handleDaemonError err               Protocol.DaemonExit exitStatus -> handleDaemonExit exitStatus+              Protocol.DaemonDiagnosticsResult _ -> loop  -- | Tell the daemon to stop and wait for it to gracefully exit stop :: Env -> DaemonOptions -> IO ()@@ -182,6 +183,7 @@               Protocol.DaemonError err -> handleDaemonError err               Protocol.DaemonExit exitStatus -> handleDaemonExit exitStatus               Protocol.DaemonPushEvent _ -> loop+              Protocol.DaemonDiagnosticsResult _ -> loop  withDaemonConn :: Maybe FilePath -> (Socket.Socket -> IO a) -> IO a withDaemonConn optionalSocketPath f = do
src/Cachix/Daemon/Protocol.hs view
@@ -3,6 +3,7 @@     DaemonMessage (..),     DaemonErrorMessage (..),     DaemonExitStatus (..),+    DaemonDiagnostics (..),     PushRequestId,     newPushRequestId,     PushRequest (..),@@ -22,6 +23,7 @@   = ClientPushRequest !PushRequest   | ClientStop   | ClientPing+  | ClientDiagnosticsRequest   deriving stock (Eq, Generic, Show)   deriving anyclass (Aeson.FromJSON, Aeson.ToJSON) @@ -31,6 +33,7 @@   | DaemonExit !DaemonExitStatus   | DaemonPushEvent PushEvent   | DaemonError !DaemonErrorMessage+  | DaemonDiagnosticsResult !DaemonDiagnostics   deriving stock (Eq, Generic, Show)   deriving anyclass (Aeson.FromJSON, Aeson.ToJSON) @@ -43,6 +46,18 @@ data DaemonExitStatus = DaemonExitStatus   { exitCode :: !Int,     exitMessage :: !(Maybe Text)+  }+  deriving stock (Eq, Generic, Show)+  deriving anyclass (Aeson.FromJSON, Aeson.ToJSON)++-- | Diagnostics information about the daemon's cache configuration+data DaemonDiagnostics = DaemonDiagnostics+  { diagCacheName :: !Text,+    diagCacheUri :: !Text,+    diagCachePublic :: !Bool,+    diagHasSigningKey :: !Bool,+    diagAuthOk :: !Bool,+    diagError :: !(Maybe Text)   }   deriving stock (Eq, Generic, Show)   deriving anyclass (Aeson.FromJSON, Aeson.ToJSON)
src/Cachix/Daemon/Types/TaskQueue.hs view
@@ -5,7 +5,6 @@ where  import Control.Concurrent.STM.TVar-import Data.Int (Int32) import Data.PQueue.Max (MaxQueue) import Protolude @@ -26,9 +25,7 @@     where       -- Circular sequence comparison: older (smaller) sequences come first       -- Uses signed arithmetic to handle wraparound (works for sequences up to 2^31 apart)-      compareSeq s1 s2 =-        let diff = s2 - s1-         in compare diff 0+      compareSeq s1 s2 = compare (s2 - s1) 0  -- | A priority queue that maintains TBMQueue-compatible API -- The queue is unbounded and prioritizes items by their Ord instance
test/Daemon/NarinfoQuerySpec.hs view
@@ -14,6 +14,7 @@ import Protolude import Test.Hspec import UnliftIO.Async qualified as Async+import UnliftIO.Timeout (timeout)  -- Create a mock StorePath for testing mockStorePath :: Store -> Int -> IO StorePath@@ -80,11 +81,16 @@ -- Helper to start batch processor asynchronously with its own Katip context startQueryProcessorAsync :: NarinfoQueryManager requestId -> ([StorePath] -> IO ([StorePath], [StorePath])) -> IO () startQueryProcessorAsync manager batchProcessor = do+  started <- newEmptyMVar   void $ Async.async $ do     handleScribe <- Katip.mkHandleScribe Katip.ColorIfTerminal stderr (Katip.permitItem Katip.InfoS) Katip.V0     let makeLogEnv = Katip.registerScribe "stderr" handleScribe Katip.defaultScribeSettings =<< Katip.initLogEnv "test" "test"     bracket makeLogEnv Katip.closeScribes $ \le ->-      Katip.runKatipContextT le () mempty $ NarinfoQuery.start manager (liftIO . batchProcessor)+      Katip.runKatipContextT le () mempty $ do+        liftIO $ putMVar started ()+        NarinfoQuery.start manager (liftIO . batchProcessor)+  -- Wait for the processor to start before returning+  takeMVar started  -- Test setup helper that encapsulates common initialization withTestManager ::@@ -112,6 +118,16 @@    finally (action testContext) (NarinfoQuery.stop manager) +-- | Wait for an STM condition to be satisfied, with a timeout.+-- Fails with an error if the timeout expires before the condition is met.+waitForSTM :: Int -> STM Bool -> IO ()+waitForSTM timeoutMicros condition = do+  result <- timeout timeoutMicros $ atomically $ do+    satisfied <- condition+    unless satisfied retry+  when (isNothing result) $+    expectationFailure "Timeout waiting for STM condition"+ spec :: Spec spec = do   -- Initialize the CNix library@@ -239,19 +255,24 @@       path4 <- mockStorePath store 4       path5 <- mockStorePath store 5       path6 <- mockStorePath store 6-      let config = defaultNarinfoQueryOptions {nqoMaxWaitTime = 0}+      -- Use batch size = 5 (exact unique paths count) so batch triggers on request 2+      -- Request 1 adds 3 paths, request 2 adds 2 more unique (5 total), triggering batch+      let config = defaultNarinfoQueryOptions {nqoMaxBatchSize = 5, nqoMaxWaitTime = 10}       withTestManager config $ \TestContext {..} -> do         -- Setup: path1,3,5 exist; path2,4,6 missing         let existingPaths = Set.fromList [path1, path3, path5]             missingPaths = Set.fromList [path2, path4, path6]         atomically $ writeTVar tcResponsesQueue [(existingPaths, missingPaths)] -        -- Request 1: paths 1,2,3+        -- Request 1: paths 1,2,3 (3 unique paths, below threshold)         NarinfoQuery.submitRequest tcManager (1 :: Int) [path1, path2, path3]-        -- Request 2: paths 3,4,5 (path 3 overlaps)+        -- Request 2: paths 3,4,5 (path 3 overlaps, adds 2 new → 5 total, triggers batch)         NarinfoQuery.submitRequest tcManager (2 :: Int) [path3, path4, path5] -        threadDelay 20_000+        -- Wait until both callbacks are received (deterministic, no timing dependency)+        waitForSTM 5_000_000 $ do+          cbs <- readTVar tcCallbackCalls+          return $ length cbs >= 2          callbacks <- readTVarIO tcCallbackCalls         length callbacks `shouldBe` 2