cachix 1.4.1 → 1.4.2
raw patch · 7 files changed
+67/−47 lines, 7 files
Files
- CHANGELOG.md +6/−0
- cachix.cabal +1/−1
- src/Cachix/Client/Commands.hs +20/−15
- src/Cachix/Client/Push.hs +20/−15
- src/Cachix/Client/PushQueue.hs +2/−2
- src/Cachix/Client/Store.hs +13/−9
- src/Cachix/Client/WatchStore.hs +5/−5
CHANGELOG.md view
@@ -5,6 +5,12 @@ 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.4.2] - 2023-04-05++### Fixed++- Fix watch-* command with the new Store implementation by openining a new connection each time.+ ## [1.4.1] - 2023-03-31 ### Fixed
cachix.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: cachix-version: 1.4.1+version: 1.4.2 license: Apache-2.0 license-file: LICENSE copyright: 2018 Domen Kozar
src/Cachix/Client/Commands.hs view
@@ -167,7 +167,7 @@ normalized <- liftIO $ for inputStorePaths $- \path -> Store.followLinksToStorePath (pushParamsStore pushParams) (toS path)+ \path -> Store.followLinksToStorePath (Env.storePrefix env) (toS path) pushedPaths <- pushClosure (mapConcurrentlyBounded (numJobs opts))@@ -187,7 +187,7 @@ watchStore :: Env -> PushOptions -> Text -> IO () watchStore env opts name = do withPushParams env opts name $ \pushParams ->- WatchStore.startWorkers (pushParamsStore pushParams) (numJobs opts) pushParams+ WatchStore.startWorkers (numJobs opts) pushParams watchExec :: Env -> PushOptions -> Text -> Text -> [Text] -> IO () watchExec env pushOpts name cmd args = withPushParams env pushOpts name $ \pushParams -> do@@ -198,7 +198,7 @@ } watch = do hDuplicateTo stderr stdout -- redirect all stdout to stderr- WatchStore.startWorkers (pushParamsStore pushParams) (numJobs pushOpts) pushParams+ WatchStore.startWorkers (numJobs pushOpts) pushParams (_, exitCode) <- Async.concurrently watch $ do@@ -229,8 +229,8 @@ then "" else "(retry #" <> show (rsIterNumber retrystatus) <> ") " -pushStrategy :: Store.Store -> Maybe Token -> PushOptions -> Text -> BinaryCache.CompressionMethod -> Store.StorePath -> PushStrategy IO ()-pushStrategy _ authToken opts name compressionMethod storePath =+pushStrategy :: Maybe Token -> PushOptions -> Text -> BinaryCache.CompressionMethod -> Store.StorePath -> PushStrategy IO ()+pushStrategy authToken opts name compressionMethod storePath = PushStrategy { onAlreadyPresent = pass, on401 = handleCacheResponse name authToken,@@ -246,7 +246,7 @@ } withPushParams :: Env -> PushOptions -> Text -> (PushParams IO () -> IO ()) -> IO ()-withPushParams env pushOpts name m = do+withPushParams env pushOpts name action = do pushSecret <- findPushSecret (config env) name authToken <- Config.getAuthTokenMaybe (config env) compressionMethodBackend <- case pushSecret of@@ -258,12 +258,17 @@ Left err -> handleCacheResponse name authToken err Right binaryCache -> pure (Just $ BinaryCache.preferredCompressionMethod binaryCache) let compressionMethod = fromMaybe BinaryCache.ZSTD (head $ catMaybes [Cachix.Client.OptionsParser.compressionMethod pushOpts, compressionMethodBackend])- Store.withStore (Env.storePrefix env) $ \store ->- m- PushParams- { pushParamsName = name,- pushParamsSecret = pushSecret,- pushParamsClientEnv = clientenv env,- pushParamsStrategy = pushStrategy store authToken pushOpts name compressionMethod,- pushParamsStore = store- }+ wal <- Store.getUseSqliteWAL+ action+ PushParams+ { pushParamsName = name,+ pushParamsSecret = pushSecret,+ pushParamsClientEnv = clientenv env,+ pushParamsStrategy = pushStrategy authToken pushOpts name compressionMethod,+ pushParamsWithStore =+ Store.withLocalStore $+ Store.LocalStoreOptions+ { Store.storePrefix = Env.storePrefix env,+ Store.useSqliteWAL = wal+ }+ }
src/Cachix/Client/Push.hs view
@@ -76,7 +76,7 @@ pushParamsStrategy :: Store.StorePath -> PushStrategy m r, -- | cachix base url, connection manager, see 'Cachix.Client.URI.defaultCachixBaseUrl', 'Servant.Client.mkClientEnv' pushParamsClientEnv :: ClientEnv,- pushParamsStore :: Store.Store+ pushParamsWithStore :: forall a. (Store.Store -> m a) -> m a } data PushStrategy m r = PushStrategy@@ -105,15 +105,17 @@ pushSingleStorePath :: (MonadMask m, MonadIO m) =>+ Maybe Store.Store -> -- | details for pushing to cache PushParams m r -> -- | store path Store.StorePath -> -- | r is determined by the 'PushStrategy' m r-pushSingleStorePath cache storePath = retryAll $ \retrystatus -> do+pushSingleStorePath Nothing cache storePath = pushParamsWithStore cache $ \store ->+ pushSingleStorePath (Just store) cache storePath+pushSingleStorePath (Just store) cache storePath = retryAll $ \retrystatus -> do let name = pushParamsName cache- store = pushParamsStore cache strategy = pushParamsStrategy cache storePath -- Check if narinfo already exists res <-@@ -127,7 +129,7 @@ case res of Right NoContent -> onAlreadyPresent strategy -- we're done as store path is already in the cache Left err- | isErr err status404 -> uploadStorePath cache storePath retrystatus+ | isErr err status404 -> uploadStorePath (Just store) cache storePath retrystatus | isErr err status401 -> on401 strategy err | otherwise -> onError strategy err @@ -137,15 +139,17 @@ uploadStorePath :: (MonadIO m) =>+ Maybe Store.Store -> -- | details for pushing to cache PushParams m r -> Store.StorePath -> RetryStatus -> -- | r is determined by the 'PushStrategy' m r-uploadStorePath cache storePath retrystatus = do- let store = pushParamsStore cache- storePathText = Store.getPath storePath+uploadStorePath Nothing cache storePath retrystatus = pushParamsWithStore cache $ \store ->+ uploadStorePath (Just store) cache storePath retrystatus+uploadStorePath (Just store@(Store.Store storePrefix _)) cache storePath retrystatus = do+ let storePathText = Store.getPath storePath let (storeHash, storeSuffix) = splitStorePath $ toS storePathText cacheName = pushParamsName cache authToken = getCacheAuthToken (pushParamsSecret cache)@@ -164,7 +168,7 @@ narHashRef <- liftIO $ newIORef ("" :: ByteString) fileHashRef <- liftIO $ newIORef ("" :: ByteString) - normalized <- liftIO $ Store.followLinksToStorePath store $ toS storePathText+ normalized <- liftIO $ Store.followLinksToStorePath storePrefix $ toS storePathText pathinfo <- liftIO $ escalateAs FatalError =<< Store.queryPathInfo store (toS normalized) let storePathSize = Store.narSize pathinfo onAttempt strategy retrystatus storePathSize@@ -237,14 +241,15 @@ [Store.StorePath] -> -- | Every @r@ per store path of the entire closure of store paths m [r]-pushClosure traversal pushParams inputStorePaths = do- missingPaths <- getMissingPathsForClosure pushParams inputStorePaths- traversal (\path -> retryAll $ \retrystatus -> uploadStorePath pushParams path retrystatus) missingPaths+pushClosure traversal pushParams inputStorePaths = pushParamsWithStore pushParams $ \store -> do+ missingPaths <- getMissingPathsForClosure (Just store) pushParams inputStorePaths+ traversal (\path -> retryAll $ \retrystatus -> uploadStorePath (Just store) pushParams path retrystatus) missingPaths -getMissingPathsForClosure :: (MonadIO m, MonadMask m) => PushParams m r -> [Store.StorePath] -> m [Store.StorePath]-getMissingPathsForClosure pushParams inputPaths = do- let store = pushParamsStore pushParams- clientEnv = pushParamsClientEnv pushParams+getMissingPathsForClosure :: Maybe Store.Store -> (MonadIO m, MonadMask m) => PushParams m r -> [Store.StorePath] -> m [Store.StorePath]+getMissingPathsForClosure Nothing pushParams inputPaths = pushParamsWithStore pushParams $ \store ->+ getMissingPathsForClosure (Just store) pushParams inputPaths+getMissingPathsForClosure (Just store) pushParams inputPaths = do+ let clientEnv = pushParamsClientEnv pushParams -- Get the transitive closure of dependencies paths <- liftIO $ Store.computeClosure store inputPaths let pathsAndHashes = (\path -> (,) (Store.getStorePathHash store path) path) <$> paths
src/Cachix/Client/PushQueue.hs view
@@ -44,7 +44,7 @@ bracket_ (inProgressModify (+ 1)) (inProgressModify (\x -> x - 1)) $ retryAll $ \retrystatus -> do- Push.uploadStorePath pushParams storePath retrystatus+ Push.uploadStorePath Nothing pushParams storePath retrystatus where inProgressModify f = atomically $ modifyTVar' (inProgress workerState) f@@ -96,7 +96,7 @@ if isEmpty then return S.empty else return $ alreadyQueued workerState- missingStorePaths <- Push.getMissingPathsForClosure pushParams storePaths+ missingStorePaths <- Push.getMissingPathsForClosure Nothing pushParams storePaths let missingStorePathsSet = S.fromList missingStorePaths uncachedMissingStorePaths = S.difference missingStorePathsSet alreadyQueuedSet atomically $ for_ uncachedMissingStorePaths $ TBQueue.writeTBQueue pushqueue
src/Cachix/Client/Store.hs view
@@ -5,11 +5,12 @@ LocalStoreOptions (..), withLocalStore, withStore,- Store,+ Store (..), -- * Working store contents PathInfo (..), StorePath (..),+ getUseSqliteWAL, base16to32, computeClosure, queryPathInfo,@@ -47,8 +48,8 @@ references :: [Text] } -followLinksToStorePath :: Store -> FilePath -> IO FilePath-followLinksToStorePath (Store prefix _) path = do+followLinksToStorePath :: Text -> FilePath -> IO FilePath+followLinksToStorePath prefix path = do storePath <- canonicalizePath path let storePath' = T.drop (T.length prefix) (toS storePath) return $ toS $ prefix <> T.intercalate "/" (take 3 $ T.splitOn "/" storePath')@@ -71,8 +72,8 @@ withLocalStore opts = bracket open close where- uri = toS (storePrefix opts) <> "/var/nix/db/db.sqlite"- flags = [SQLite.SQLOpenReadOnly]+ uri = "file:" <> toS (storePrefix opts) <> "/var/nix/db/db.sqlite?immutable=1"+ flags = [SQLite.SQLOpenReadOnly, SQLite.SQLOpenURI] close (Store _ db) = SQLite.close db vfs = if useSqliteWAL opts@@ -85,15 +86,18 @@ -- | 'withLocalStore' but infers 'useSqliteWAL' from the @nix show-config@ command. withStore :: Text -> (Store -> IO a) -> IO a withStore storePrefix_ f = do- useWAL <- do- (_, out, _) <- readProcessWithExitCode "nix" ["show-config", "--extra-experimental-features", "nix-command"] mempty- pure (not ("use-sqlite-wal = false" `T.isInfixOf` toS out))+ wal <- getUseSqliteWAL withLocalStore LocalStoreOptions { storePrefix = storePrefix_,- useSqliteWAL = useWAL+ useSqliteWAL = wal } f++getUseSqliteWAL :: IO Bool+getUseSqliteWAL = do+ (_, out, _) <- readProcessWithExitCode "nix" ["show-config", "--extra-experimental-features", "nix-command"] mempty+ pure (not ("use-sqlite-wal = false" `T.isInfixOf` toS out)) queryNarinfo :: Text queryNarinfo = "select id, hash, deriver, narSize from ValidPaths where path = :path"
src/Cachix/Client/WatchStore.hs view
@@ -11,13 +11,13 @@ import System.FSNotify import qualified System.Systemd.Daemon as Systemd -startWorkers :: Store.Store -> Int -> PushParams IO () -> IO ()-startWorkers store numWorkers pushParams = do+startWorkers :: Int -> PushParams IO () -> IO ()+startWorkers numWorkers pushParams = do void Systemd.notifyReady- withManager $ \mgr -> PushQueue.startWorkers numWorkers (producer store mgr) pushParams+ withManager $ \mgr -> PushQueue.startWorkers numWorkers (producer mgr) pushParams -producer :: Store.Store -> WatchManager -> PushQueue.Queue -> IO (IO ())-producer _ mgr queue = do+producer :: WatchManager -> PushQueue.Queue -> IO (IO ())+producer mgr queue = do putTextError "Watching /nix/store for new store paths ..." watchDir mgr "/nix/store" filterOnlyStorePaths (queueStorePathAction queue)