From 41a6ce9f46fcd1e08d4227b5b03fc1eb81427640 Mon Sep 17 00:00:00 2001 From: Robert Hensing Date: Fri, 1 Mar 2024 01:12:05 +0100 Subject: [PATCH] Support relocated store... ... when configured with the NIX_STORE_DIR and NIX_REMOTE environment variables. --- CHANGELOG.md | 5 ++ app/Main.hs | 3 +- nix-diff.cabal | 1 + src/Nix/Diff.hs | 71 ++++++++++++++++---------- src/Nix/Diff/Render/HumanReadable.hs | 7 +-- src/Nix/Diff/Store.hs | 76 ++++++++++++++++++++++++++++ src/Nix/Diff/Types.hs | 17 ++++--- 7 files changed, 140 insertions(+), 40 deletions(-) create mode 100644 src/Nix/Diff/Store.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 7b0bede..84a9ca3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +Unreleased + +* [Support relocated Nix store](https://github.com/Gabriella439/nix-diff/pull/82) + * If configured through `NIX_REMOTE` environment variable. + 1.0.20 * [Bump upper bounds](https://github.com/Gabriella439/nix-diff/pull/79) diff --git a/app/Main.hs b/app/Main.hs index 340e163..e187fde 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -26,6 +26,7 @@ import qualified Data.ByteString.Lazy.Char8 import qualified Data.Text.IO as Text.IO import Nix.Diff +import Nix.Diff.Store (StorePath(StorePath)) import Nix.Diff.Types import Nix.Diff.Render.HumanReadable import Nix.Diff.Transformations @@ -174,7 +175,7 @@ main = do let diffContext = DiffContext {..} let renderContext = RenderContext {..} let status = Status Data.Set.empty - let action = diff True left (Data.Set.singleton "out") right (Data.Set.singleton "out") + let action = diff True (StorePath left) (Data.Set.singleton "out") (StorePath right) (Data.Set.singleton "out") diffTree <- Control.Monad.State.evalStateT (Control.Monad.Reader.runReaderT (unDiff action) diffContext) status let diffTree' = transformDiff transformOptions diffTree diff --git a/nix-diff.cabal b/nix-diff.cabal index faeeb47..57fbfbc 100644 --- a/nix-diff.cabal +++ b/nix-diff.cabal @@ -20,6 +20,7 @@ extra-source-files: README.md library exposed-modules: Nix.Diff + Nix.Diff.Store Nix.Diff.Types Nix.Diff.Transformations Nix.Diff.Render.HumanReadable diff --git a/src/Nix/Diff.hs b/src/Nix/Diff.hs index 19db0ff..a4d5ec2 100644 --- a/src/Nix/Diff.hs +++ b/src/Nix/Diff.hs @@ -13,7 +13,7 @@ import Control.Monad (forM) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Reader (MonadReader, ReaderT, ask) import Control.Monad.State (MonadState, StateT, get, put) -import Data.Attoparsec.Text (IResult(..)) +import Data.Attoparsec.Text (IResult(..), Parser) import Data.List.NonEmpty (NonEmpty(..)) import Data.Map (Map) import Data.Maybe (catMaybes) @@ -37,7 +37,6 @@ import qualified Data.Text.Encoding.Error import qualified Data.Vector import qualified Nix.Derivation import qualified Patience -import qualified System.Directory as Directory import qualified System.FilePath as FilePath import qualified System.Process as Process @@ -46,13 +45,15 @@ import Control.Monad.Fail (MonadFail) #endif import Nix.Diff.Types +import Nix.Diff.Store (StorePath (StorePath, unsafeStorePathFile)) +import qualified Nix.Diff.Store as Store newtype Status = Status { visited :: Set Diffed } data Diffed = Diffed - { leftDerivation :: FilePath + { leftDerivation :: StorePath , leftOutput :: Set Text - , rightDerivation :: FilePath + , rightDerivation :: StorePath , rightOutput :: Set Text } deriving (Eq, Ord) @@ -88,11 +89,11 @@ data Orientation = Character | Word | Line Nix technically does not require that the Nix store is actually stored underneath `/nix/store`, but this is the overwhelmingly common use case -} -derivationName :: FilePath -> Text -derivationName = Text.dropEnd 4 . Text.drop 44 . Text.pack +derivationName :: StorePath -> Text +derivationName = Text.dropEnd 4 . Text.drop 44 . Text.pack . unsafeStorePathFile -- | Group paths by their name -groupByName :: Map FilePath a -> Map Text (Map FilePath a) +groupByName :: Map StorePath a -> Map Text (Map StorePath a) groupByName m = Data.Map.fromList assocs where toAssoc key = (derivationName key, Data.Map.filterWithKey predicate m) @@ -107,11 +108,11 @@ groupByName m = Data.Map.fromList assocs > /nix/store/${32_CHARACTER_HASH}-${NAME}.drv -} -buildProductName :: FilePath -> Text -buildProductName = Text.drop 44 . Text.pack +buildProductName :: StorePath -> Text +buildProductName = Text.drop 44 . Text.pack . unsafeStorePathFile -- | Like `groupByName`, but for `Set`s -groupSetsByName :: Set FilePath -> Map Text (Set FilePath) +groupSetsByName :: Set StorePath -> Map Text (Set StorePath) groupSetsByName s = Data.Map.fromList (fmap toAssoc (Data.Set.toList s)) where toAssoc key = (buildProductName key, Data.Set.filter predicate s) @@ -127,12 +128,26 @@ readFileUtf8Lenient file = Data.Text.Encoding.decodeUtf8With Data.Text.Encoding.Error.lenientDecode <$> Data.ByteString.readFile file +-- TODO: expose in nix-derivation +filepathParser :: Parser FilePath +filepathParser = do + text <- Nix.Derivation.textParser + let str = Text.unpack text + case (Text.uncons text, FilePath.isValid str) of + (Just ('/', _), True) -> do + return str + _ -> do + fail ("bad path ‘" <> Text.unpack text <> "’ in derivation") + + -- | Read and parse a derivation from a file -readDerivation :: FilePath -> Diff (Derivation FilePath Text) -readDerivation path = do +readDerivation :: StorePath -> Diff (Derivation StorePath Text) +readDerivation sp = do + path <- liftIO (Store.toPhysicalPath sp) let string = path text <- liftIO (readFileUtf8Lenient string) - case Data.Attoparsec.Text.parse Nix.Derivation.parseDerivation text of + let parser = Nix.Derivation.parseDerivationWith (StorePath <$> filepathParser) Nix.Derivation.textParser + case Data.Attoparsec.Text.parse parser text of Done _ derivation -> do return derivation _ -> do @@ -141,11 +156,11 @@ readDerivation path = do -- | Read and parse a derivation from a store path that can be a derivation -- (.drv) or a realized path, in which case the corresponding derivation is -- queried. -readInput :: FilePath -> Diff (Derivation FilePath Text) +readInput :: StorePath -> Diff (Derivation StorePath Text) readInput pathAndMaybeOutput = do - let (path, _) = List.break (== '!') pathAndMaybeOutput + let (path, _) = List.break (== '!') (Store.unsafeStorePathFile pathAndMaybeOutput) if FilePath.isExtensionOf ".drv" path - then readDerivation path + then readDerivation (StorePath path) else do let string = path result <- liftIO (Process.readProcess "nix-store" [ "--query", "--deriver", string ] []) @@ -153,7 +168,7 @@ readInput pathAndMaybeOutput = do [] -> fail ("Could not obtain the derivation of " ++ string) l : ls -> do let drv_path = Data.List.NonEmpty.last (l :| ls) - readDerivation drv_path + readDerivation (StorePath drv_path) {-| Join two `Map`s on shared keys, discarding keys which are not present in both `Map`s @@ -206,9 +221,9 @@ getGroupedDiff oldList newList = go $ Patience.diff oldList newList diffOutput :: Text -- ^ Output name - -> (DerivationOutput FilePath Text) + -> (DerivationOutput StorePath Text) -- ^ Left derivation outputs - -> (DerivationOutput FilePath Text) + -> (DerivationOutput StorePath Text) -- ^ Right derivation outputs -> (Maybe OutputDiff) diffOutput outputName leftOutput rightOutput = do @@ -223,9 +238,9 @@ diffOutput outputName leftOutput rightOutput = do -- | Diff two sets of outputs diffOutputs - :: Map Text (DerivationOutput FilePath Text) + :: Map Text (DerivationOutput StorePath Text) -- ^ Left derivation outputs - -> Map Text (DerivationOutput FilePath Text) + -> Map Text (DerivationOutput StorePath Text) -- ^ Right derivation outputs -> OutputsDiff diffOutputs leftOutputs rightOutputs = do @@ -363,9 +378,9 @@ diffEnv leftOutputs rightOutputs leftEnv rightEnv = do -- | Diff input sources diffSrcs - :: Set FilePath + :: Set StorePath -- ^ Left input sources - -> Set FilePath + -> Set StorePath -- ^ Right inputSources -> Diff SourcesDiff diffSrcs leftSrcs rightSrcs = do @@ -390,12 +405,12 @@ diffSrcs leftSrcs rightSrcs = do case (Data.Set.toList leftExtraPaths, Data.Set.toList rightExtraPaths) of ([], []) -> return Nothing ([leftPath], [rightPath]) -> do - leftExists <- liftIO (Directory.doesFileExist leftPath) - rightExists <- liftIO (Directory.doesFileExist rightPath) + leftExists <- liftIO (Store.doesFileExist leftPath) + rightExists <- liftIO (Store.doesFileExist rightPath) srcContentDiff <- if leftExists && rightExists then do - leftText <- liftIO (readFileUtf8Lenient leftPath) - rightText <- liftIO (readFileUtf8Lenient rightPath) + leftText <- liftIO (Store.readFileUtf8Lenient leftPath) + rightText <- liftIO (Store.readFileUtf8Lenient rightPath) text <- diffText leftText rightText return (Just text) @@ -427,7 +442,7 @@ diffArgs leftArgs rightArgs = fmap ArgumentsDiff do let rightList = Data.Vector.toList rightArgs Data.List.NonEmpty.nonEmpty (Patience.diff leftList rightList) -diff :: Bool -> FilePath -> Set Text -> FilePath -> Set Text -> Diff DerivationDiff +diff :: Bool -> StorePath -> Set Text -> StorePath -> Set Text -> Diff DerivationDiff diff topLevel leftPath leftOutputs rightPath rightOutputs = do Status { visited } <- get let diffed = Diffed leftPath leftOutputs rightPath rightOutputs diff --git a/src/Nix/Diff/Render/HumanReadable.hs b/src/Nix/Diff/Render/HumanReadable.hs index 632fe0a..aadb958 100644 --- a/src/Nix/Diff/Render/HumanReadable.hs +++ b/src/Nix/Diff/Render/HumanReadable.hs @@ -29,6 +29,7 @@ import Control.Monad.Fail (MonadFail) import Nix.Diff import Nix.Diff.Types +import qualified Nix.Diff.Store as Store data RenderContext = RenderContext @@ -159,7 +160,7 @@ renderDiffHumanReadable = \case where renderOutputStructure os = renderWith os \(sign, (OutputStructure path outputs)) -> do - echo (sign (Text.pack path <> renderOutputs outputs)) + echo (sign (Store.toText path <> renderOutputs outputs)) renderOutputsDiff OutputsDiff{..} = do ifExist extraOutputs \eo -> do @@ -217,7 +218,7 @@ renderDiffHumanReadable = \case echo (explain ("The input sources named `" <> srcName <> "` differ")) renderWith srcFileDiff \(sign, paths) -> do forM_ paths \path -> do - echo (" " <> sign (Text.pack path)) + echo (" " <> sign (Store.toText path)) renderInputsDiff InputsDiff{..} = do renderInputExtraNames inputExtraNames @@ -237,7 +238,7 @@ renderDiffHumanReadable = \case echo (explain ("The set of input derivations named `" <> drvName <> "` do not match")) renderWith extraPartsDiff \(sign, extraPaths) -> do forM_ (Data.Map.toList extraPaths) \(extraPath, outputs) -> do - echo (" " <> sign (Text.pack extraPath <> renderOutputs outputs)) + echo (" " <> sign (Store.toText extraPath <> renderOutputs outputs)) renderEnvDiff Nothing = echo (explain "Skipping environment comparison") diff --git a/src/Nix/Diff/Store.hs b/src/Nix/Diff/Store.hs new file mode 100644 index 0000000..c3ad18c --- /dev/null +++ b/src/Nix/Diff/Store.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NoImportQualifiedPost #-} + +-- | A crude implementation of the Nix store concept. +-- +-- For anything fancier than this, it would be best to use FFI bindings instead, +-- such as hercules-ci-cnix-store. +module Nix.Diff.Store + ( StorePath (..), + toPhysicalPath, + toText, + doesFileExist, + readFileUtf8Lenient, + ) +where + +import Control.Monad ((<=<)) +import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey) +import qualified Data.ByteString +import Data.Data (Data) +import Data.Functor ((<&>)) +import qualified Data.List as L +import Data.Text (Text) +import qualified Data.Text +import qualified Data.Text.Encoding +import qualified Data.Text.Encoding.Error +import qualified System.Directory as Directory +import System.Environment (lookupEnv) +import Test.QuickCheck (Arbitrary) + +-- | A file path that may not exist on the true file system; +-- needs to be looked up in a store, which may be relocated. +-- +-- Unlike the (C++) Nix StorePath type, subpaths are allowed. +newtype StorePath = StorePath + { -- | If the store is relocated, its physical location is elsewhere, and this 'FilePath' won't resolve. + -- Use 'toPhysicalPath'. + unsafeStorePathFile :: FilePath + } + deriving (Data) + deriving newtype (Show, Eq, Ord, ToJSON, FromJSON, ToJSONKey, FromJSONKey, Arbitrary) + +doesFileExist :: StorePath -> IO Bool +doesFileExist = + Directory.doesFileExist <=< toPhysicalPath + +readFileUtf8Lenient :: StorePath -> IO Text +readFileUtf8Lenient sp = do + file <- toPhysicalPath sp + Data.Text.Encoding.decodeUtf8With Data.Text.Encoding.Error.lenientDecode + <$> Data.ByteString.readFile file + +toPhysicalPath :: StorePath -> IO FilePath +toPhysicalPath (StorePath p) = do + nixStoreDir <- lookupEnv "NIX_STORE_DIR" <&> maybe "/nix/store" stripSlash + nixRemoteMaybe <- lookupEnv "NIX_REMOTE" <&> fmap stripSlash + case nixRemoteMaybe of + Just nixRemote@('/':_) -> + pure $ replaceStart nixStoreDir (nixRemote <> "/" <> nixStoreDir) p + _ -> pure p + +-- | Convert a 'StorePath' to a 'Text' for display purposes. The path may not exist at this physical location. +toText :: StorePath -> Text +toText (StorePath p) = Data.Text.pack p + +stripSlash :: FilePath -> FilePath +stripSlash = reverse . dropWhile (== '/') . reverse + +replaceStart :: String -> String -> String -> String +replaceStart pattern replacement text = + case L.stripPrefix pattern text of + Just rest -> replacement <> rest + Nothing -> text diff --git a/src/Nix/Diff/Types.hs b/src/Nix/Diff/Types.hs index 52e37eb..67b6636 100644 --- a/src/Nix/Diff/Types.hs +++ b/src/Nix/Diff/Types.hs @@ -20,6 +20,7 @@ import qualified Data.Map as Map import Data.Set (Set) import Data.Text (Text) import Nix.Derivation (DerivationOutput (..)) +import Nix.Diff.Store ( StorePath ) import qualified Patience import GHC.Generics (Generic) @@ -105,7 +106,7 @@ data DerivationDiff -- Output structure data OutputStructure = OutputStructure - { derivationPath :: FilePath + { derivationPath :: StorePath , derivationOutputs :: Set Text } deriving stock (Eq, Show, Generic, Data) @@ -115,7 +116,7 @@ data OutputStructure = OutputStructure -- ** Outputs diff data OutputsDiff = OutputsDiff - { extraOutputs :: Maybe (Changed (Map Text (DerivationOutput FilePath Text))) + { extraOutputs :: Maybe (Changed (Map Text (DerivationOutput StorePath Text))) -- ^ Map from derivation name to its outputs. -- Will be Nothing, if `Data.Map.difference` gives -- empty Maps for both new and old outputs @@ -125,7 +126,7 @@ data OutputsDiff = OutputsDiff } deriving stock (Eq, Show, Data) -deriving instance Data (DerivationOutput FilePath Text) +deriving instance Data (DerivationOutput StorePath Text) instance Arbitrary OutputsDiff where arbitrary = OutputsDiff <$> arbitraryExtraOutputs <*> arbitrary @@ -145,10 +146,10 @@ instance ToJSON OutputsDiff where , "outputHashDiff" .= outputHashDiff ] where - extraOutputsToJSON :: Map Text (DerivationOutput FilePath Text) -> Value + extraOutputsToJSON :: Map Text (DerivationOutput StorePath Text) -> Value extraOutputsToJSON = toJSON . fmap derivationOutputToJSON - derivationOutputToJSON :: DerivationOutput FilePath Text -> Value + derivationOutputToJSON :: DerivationOutput StorePath Text -> Value derivationOutputToJSON DerivationOutput{..} = object [ "path" .= path , "hashAlgo" .= hashAlgo @@ -165,7 +166,7 @@ instance FromJSON OutputsDiff where pure $ OutputsDiff eo ohd where - derivationOutputFromJSON :: Value -> Parser (DerivationOutput FilePath Text) + derivationOutputFromJSON :: Value -> Parser (DerivationOutput StorePath Text) derivationOutputFromJSON = withObject "DerivationOutput" \o -> DerivationOutput <$> o .: "path" <*> o .: "hashAlgo" <*> o .: "hash" @@ -212,7 +213,7 @@ data SourceFileDiff } | SomeSourceFileDiff { srcName :: Text - , srcFileDiff :: Changed [FilePath] + , srcFileDiff :: Changed [StorePath] } deriving stock (Eq, Show, Generic, Data) deriving anyclass (ToJSON, FromJSON) @@ -236,7 +237,7 @@ data InputDerivationsDiff } | SomeDerivationsDiff { drvName :: Text - , extraPartsDiff :: Changed (Map FilePath (Set Text)) + , extraPartsDiff :: Changed (Map StorePath (Set Text)) } deriving stock (Eq, Show, Generic, Data) deriving anyclass (ToJSON, FromJSON)