diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,43 @@ +# [0.9.0.0](https://github.com/haskell-nix/hnix-store/compare/core-0.8.0.0...core-0.9.0.0) 2026-10-21 + +Up to date with the latest data structure changes in upstream Nix as of `25405812fc5ce64b719dace172c21d2301829deb.` + +* Additions: + * `outputNameToText` helper in `System.Nix.OutputName` + * `System.Nix.Placeholder` module with `DownstreamPlaceholder`, `createPlaceholder`, and `renderPlaceholder` + * `System.Nix.StorePath.ContentAddressed` module, for creating content-addressed store paths + * `textToMethod`, `methodToText` in `System.Nix.ContentAddress` + * `parseBasePath`, `parseBasePathFromText` in `System.Nix.StorePath` + * `textToBaseEncoding`, `baseEncodingToText` in `System.Nix.Base` + * `outputStoreObjectName` in `System.Nix.OutputName` + * `SingleDerivedPath` type with `parseSingleDerivedPath`, `singleDerivedPathToText` + +* Changes: + * Rename `NarSignature` to `NamedSignature`. + This reflects that various other things are signed like this, not just the NAR + references signature in narinfo. + * Replace `memory` dependency with `ram >= 0.20.1` + * Tighten `crypton >= 1.1` ot make sure it uses `ram` + * `DerivationOutput` was renamed to `BuildTraceKey`. + Firstly, this avoided a conflict of this type used by `Realisation` with the `DerivationOutput` used by `Derivation` --- the latter deserves the name more since it is for `Derivation`. + Secondly, I (@Ericson2314) am also working upstream to rename "realisations" to "build trace entries", and the collection of them to a "build trace", and so this brings the naming in line with that. + * `BuildTraceKey` now uses `StorePath` (`buildTraceKeyDrvPath`) instead of `DSum HashAlgo Digest` (`buildTraceKeyHash`), matching upstream Nix. + `buildTraceKeyParser` and `buildTraceKeyBuilder` updated accordingly and no longer take extra function arguments. + * `Realisation`: removed `realisationDependencies` field; `realisationSignatures` changed from `Set Signature` to `Set NamedSignature` + * `BuildResult` restructured: `BuildStatus` split into `BuildSuccessStatus` and `BuildFailureStatus`; + new `BuildSuccess` and `BuildFailure` types; `buildResultStatus` is now `Either BuildFailure BuildSuccess` + * `BuildSuccess.buildSuccessBuiltOutputs` changed from `Map BuildTraceKey Realisation` to `Map OutputName Realisation` + * `OutputName.unOutputName` now returns `StorePathName` instead of `Text` + * `DerivedPath_Built` constructor now takes `SingleDerivedPath` instead of `StorePath` + +* New type class instances: + * `NFData ContentAddressMethod` + * `NFData (HashAlgo a)` + * `GNFData HashAlgo` + * `NFData OutputName` + * `NFData StorePath` + * `NFData StorePathName` + * `NFData StorePathHashPart` + # [0.8.0.0](https://github.com/haskell-nix/hnix-store/compare/core-0.7.0.0...core-0.8.0.0) 2024-07-31 * Changes: diff --git a/hnix-store-core.cabal b/hnix-store-core.cabal --- a/hnix-store-core.cabal +++ b/hnix-store-core.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hnix-store-core -version: 0.8.0.0 +version: 0.9.0.0 synopsis: Core types used for interacting with the Nix store. description: This package contains types and functions needed to describe @@ -24,33 +24,35 @@ ghc-options: -Wall default-extensions: ConstraintKinds + , BangPatterns , DataKinds - , DeriveGeneric , DeriveDataTypeable - , DeriveFunctor , DeriveFoldable - , DeriveTraversable + , DeriveFunctor + , DeriveGeneric , DeriveLift + , DeriveTraversable , DerivingStrategies , DerivingVia , ExistentialQuantification + , ImportQualifiedPost , FlexibleContexts , FlexibleInstances , GADTs + , ImportQualifiedPost + , InstanceSigs + , KindSignatures + , LambdaCase + , MultiParamTypeClasses + , MultiWayIf + , RecordWildCards , ScopedTypeVariables , StandaloneDeriving - , RecordWildCards + , TupleSections , TypeApplications , TypeFamilies , TypeOperators , TypeSynonymInstances - , InstanceSigs - , KindSignatures - , MultiParamTypeClasses - , MultiWayIf - , TupleSections - , LambdaCase - , BangPatterns , ViewPatterns default-language: Haskell2010 @@ -63,7 +65,9 @@ , System.Nix.ContentAddress , System.Nix.Derivation , System.Nix.DerivedPath + , System.Nix.Placeholder , System.Nix.Fingerprint + , System.Nix.FileContentAddress , System.Nix.Hash , System.Nix.Hash.Truncation , System.Nix.OutputName @@ -71,6 +75,7 @@ , System.Nix.Signature , System.Nix.Store.Types , System.Nix.StorePath + , System.Nix.StorePath.ContentAddressed , System.Nix.StorePath.Metadata build-depends: base >=4.12 && <5 @@ -78,20 +83,23 @@ , base16-bytestring >= 1.0 , base64-bytestring >= 1.2.1 , bytestring - , containers , constraints-extras - , crypton + , containers + , crypton >= 1.1 , data-default-class + , deepseq , dependent-sum > 0.7 , dependent-sum-template >= 0.2.0.1 && < 0.3 + , dependent-monoidal-map , filepath , hashable - -- Required for crypton low-level type convertion - , memory - , nix-derivation >= 1.1.1 && <2 + , monoidal-containers + -- Required for crypton low-level type conversion + , ram >= 0.20.1 , some > 1.0.5 && < 2 - , time + , these , text + , time , unordered-containers , vector hs-source-dirs: src @@ -101,9 +109,10 @@ type: exitcode-stdio-1.0 main-is: Driver.hs other-modules: - Derivation + ContentAddressed Fingerprint Hash + Placeholder Signature StorePath hs-source-dirs: @@ -112,7 +121,6 @@ tasty-discover:tasty-discover build-depends: hnix-store-core - , attoparsec , base , base16-bytestring , base64-bytestring @@ -120,10 +128,10 @@ , containers , crypton , data-default-class + , dependent-sum , hspec , tasty - , tasty-golden - , tasty-hspec + , tasty-hspec >= 1.1 , text , time , unordered-containers diff --git a/src/System/Nix/Base.hs b/src/System/Nix/Base.hs --- a/src/System/Nix/Base.hs +++ b/src/System/Nix/Base.hs @@ -1,5 +1,8 @@ +{-# LANGUAGE OverloadedStrings #-} module System.Nix.Base ( BaseEncoding(Base16,NixBase32,Base64) + , baseEncodingToText + , textToBaseEncoding , encodeWith , decodeWith ) where @@ -8,11 +11,12 @@ import Data.Text (Text) import GHC.Generics (Generic) -import qualified Data.Text.Encoding -import qualified Data.ByteString.Base16 -import qualified Data.ByteString.Base64 +import Data.Text qualified +import Data.Text.Encoding qualified +import Data.ByteString.Base16 qualified +import Data.ByteString.Base64 qualified -import qualified System.Nix.Base32 -- Nix has own Base32 encoding +import System.Nix.Base32 qualified -- Nix has own Base32 encoding -- | Constructors to indicate the base encodings data BaseEncoding @@ -23,6 +27,21 @@ | Base16 | Base64 deriving (Bounded, Eq, Enum, Generic, Ord, Show) + +-- | Convert BaseEncoding to its textual representation +baseEncodingToText :: BaseEncoding -> Text +baseEncodingToText = \case + Base16 -> "base16" + NixBase32 -> "nix32" + Base64 -> "base64" + +-- | Parse BaseEncoding from its textual representation +textToBaseEncoding :: Text -> Either String BaseEncoding +textToBaseEncoding = \case + "base16" -> Right Base16 + "nix32" -> Right NixBase32 + "base64" -> Right Base64 + other -> Left $ "Unknown base encoding: " ++ Data.Text.unpack other -- | Encode @ByteString@ with @Base@ encoding, produce @Text@. encodeWith :: BaseEncoding -> ByteString -> Text diff --git a/src/System/Nix/Base32.hs b/src/System/Nix/Base32.hs --- a/src/System/Nix/Base32.hs +++ b/src/System/Nix/Base32.hs @@ -12,15 +12,15 @@ import Data.Vector (Vector) import Data.Word (Word8) -import qualified Data.Bits -import qualified Data.Bool -import qualified Data.ByteString -import qualified Data.ByteString.Char8 -import qualified Data.List -import qualified Data.Maybe -import qualified Data.Text -import qualified Data.Vector -import qualified Numeric +import Data.Bits qualified +import Data.Bool qualified +import Data.ByteString qualified +import Data.ByteString.Char8 qualified +import Data.List qualified +import Data.Maybe qualified +import Data.Text qualified +import Data.Vector qualified +import Numeric qualified -- omitted: E O U T digits32 :: Vector Char diff --git a/src/System/Nix/Build.hs b/src/System/Nix/Build.hs --- a/src/System/Nix/Build.hs +++ b/src/System/Nix/Build.hs @@ -4,18 +4,21 @@ |-} module System.Nix.Build ( BuildMode(..) - , BuildStatus(..) - , buildSuccess + , BuildSuccessStatus(..) + , BuildFailureStatus(..) , BuildResult(..) + , BuildSuccess(..) + , BuildFailure(..) ) where import Data.Map (Map) import Data.Time (UTCTime) import Data.Text (Text) +import Data.Word (Word64) import GHC.Generics (Generic) import System.Nix.OutputName (OutputName) -import System.Nix.Realisation (DerivationOutput, Realisation) +import System.Nix.Realisation (Realisation) -- | Mode of the build operation -- Keep the order of these Enums to match enums from reference implementations @@ -26,49 +29,66 @@ | BuildMode_Check -- ^ Check if the build is reproducible (rebuild and compare to previous build) deriving (Bounded, Eq, Generic, Ord, Enum, Show) --- | Build result status -data BuildStatus = - BuildStatus_Built -- ^ Build performed successfully - | BuildStatus_Substituted -- ^ Path substituted from cache - | BuildStatus_AlreadyValid -- ^ Path is already valid (available in local store) - | BuildStatus_PermanentFailure - | BuildStatus_InputRejected - | BuildStatus_OutputRejected - | BuildStatus_TransientFailure -- ^ Possibly transient build failure - | BuildStatus_CachedFailure -- ^ Obsolete - | BuildStatus_TimedOut -- ^ Build timed out - | BuildStatus_MiscFailure - | BuildStatus_DependencyFailed -- ^ Build dependency failed to build - | BuildStatus_LogLimitExceeded - | BuildStatus_NotDeterministic - | BuildStatus_ResolvesToAlreadyValid - | BuildStatus_NoSubstituters +-- | Successful build status +-- Keep the order of these Enums to match enums from reference implementations +-- Must be disjoint with BuildFailureStatus +data BuildSuccessStatus + = BuildSuccessStatus_Built -- ^ Build performed successfully + | BuildSuccessStatus_Substituted -- ^ Path substituted from cache + | BuildSuccessStatus_AlreadyValid -- ^ Path is already valid (available in local store) + | BuildSuccessStatus_ResolvesToAlreadyValid deriving (Bounded, Eq, Generic, Ord, Enum, Show) +-- | Failed build status +-- Keep the order of these Enums to match enums from reference implementations +-- Must be disjoint with BuildSuccessStatus +data BuildFailureStatus + = BuildFailureStatus_PermanentFailure + | BuildFailureStatus_InputRejected + | BuildFailureStatus_OutputRejected + | BuildFailureStatus_TransientFailure -- ^ Possibly transient build failure + | BuildFailureStatus_CachedFailure -- ^ Obsolete + | BuildFailureStatus_TimedOut -- ^ Build timed out + | BuildFailureStatus_MiscFailure + | BuildFailureStatus_DependencyFailed -- ^ Build dependency failed to build + | BuildFailureStatus_LogLimitExceeded + | BuildFailureStatus_NotDeterministic + | BuildFailureStatus_NoSubstituters + | BuildFailureStatus_HashMismatch -- ^ A certain type of OutputRejected + deriving (Bounded, Eq, Generic, Ord, Enum, Show) + +-- | Successful build result +data BuildSuccess = BuildSuccess + { buildSuccessStatus :: BuildSuccessStatus + , buildSuccessBuiltOutputs :: Map OutputName Realisation + -- ^ Mapping of the output names to Realisations + } + deriving (Eq, Generic, Ord, Show) + +-- | Failed build result +data BuildFailure = BuildFailure + { buildFailureStatus :: BuildFailureStatus + -- ^ Failure status code + , buildFailureErrorMsg :: Text + -- ^ Error message describing the failure + , buildFailureIsNonDeterministic :: Bool + -- ^ Whether the build was non-deterministic + } + deriving (Eq, Generic, Ord, Show) + -- | Result of the build data BuildResult = BuildResult - { buildResultStatus :: BuildStatus - -- ^ Build status, MiscFailure should be the default - , buildResultErrorMessage :: Maybe Text - -- ^ Possible build error message - , buildResultTimesBuilt :: Maybe Int - -- ^ How many times this build was performed (since 1.29) - , buildResultIsNonDeterministic :: Maybe Bool - -- ^ If timesBuilt > 1, whether some builds did not produce the same result (since 1.29) - , buildResultStartTime :: Maybe UTCTime - -- ^ Start time of this build (since 1.29) - , buildResultStopTime :: Maybe UTCTime - -- ^ Stop time of this build (since 1.29) - , buildResultBuiltOutputs :: Maybe (Map (DerivationOutput OutputName) Realisation) - -- ^ Mapping of the output names to @Realisation@s (since 1.28) - -- (paths with additional info and their dependencies) + { buildResultStatus :: Either BuildFailure BuildSuccess + -- ^ Success or failure with associated data + , buildResultTimesBuilt :: Word64 + -- ^ How many times this build was performed + , buildResultStartTime :: UTCTime + -- ^ Start time of this build + , buildResultStopTime :: UTCTime + -- ^ Stop time of this build + , buildResultCpuUser :: Maybe Word64 + -- ^ User CPU time in microseconds + , buildResultCpuSystem :: Maybe Word64 + -- ^ System CPU time in microseconds } deriving (Eq, Generic, Ord, Show) - -buildSuccess :: BuildStatus -> Bool -buildSuccess x = - x `elem` - [ BuildStatus_Built - , BuildStatus_Substituted - , BuildStatus_AlreadyValid - ] diff --git a/src/System/Nix/ContentAddress.hs b/src/System/Nix/ContentAddress.hs --- a/src/System/Nix/ContentAddress.hs +++ b/src/System/Nix/ContentAddress.hs @@ -1,9 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module System.Nix.ContentAddress ( - ContentAddress - , ContentAddressMethod - , FileIngestionMethod + ContentAddress (..) + , methodToText + , textToMethod + , ContentAddressMethod (..) + , methodAlgoBuilder + , methodAlgoParser , contentAddressBuilder , contentAddressParser , buildContentAddress @@ -11,31 +14,46 @@ ) where import Control.Applicative +import Control.DeepSeq (NFData) import Crypto.Hash (Digest) import Data.Attoparsec.Text (Parser) +import Data.Attoparsec.Text qualified import Data.Dependent.Sum (DSum) +import Data.Some (Some(..)) import Data.Text (Text) +import Data.Text qualified +import Data.Text.Lazy qualified import Data.Text.Lazy.Builder (Builder) +import Data.Text.Lazy.Builder qualified import GHC.Generics (Generic) -import System.Nix.Hash (HashAlgo) -import System.Nix.Store.Types (FileIngestionMethod(..)) -import qualified Data.Attoparsec.Text -import qualified Data.Text.Lazy -import qualified Data.Text.Lazy.Builder -import qualified System.Nix.Hash +import System.Nix.Hash (HashAlgo) +import System.Nix.Hash qualified data ContentAddressMethod - = FileIngestionMethod !FileIngestionMethod - -- ^ The path was added to the store via makeFixedOutputPath or - -- addToStore. It is addressed according to some hash algorithm - -- applied to the nar serialization via some 'NarHashMode'. - | TextIngestionMethod + = ContentAddressMethod_Flat + | ContentAddressMethod_NixArchive + | ContentAddressMethod_Text -- ^ The path is a plain file added via makeTextPath or -- addTextToStore. It is addressed according to a sha256sum of the -- file contents. deriving (Eq, Generic, Ord, Show) +methodToText :: ContentAddressMethod -> Text +methodToText = \case + ContentAddressMethod_Flat -> "flat" + ContentAddressMethod_NixArchive -> "nar" + ContentAddressMethod_Text -> "text" + +textToMethod :: Text -> Either String ContentAddressMethod +textToMethod = \case + "flat" -> Right ContentAddressMethod_Flat + "nar" -> Right ContentAddressMethod_NixArchive + "text" -> Right ContentAddressMethod_Text + name -> Left $ "Unknown store object content-addressing method " <> Data.Text.unpack name + +instance NFData ContentAddressMethod + -- | An address for a content-addressable store path, i.e. one whose -- store path hash is purely a function of its contents (as opposed to -- paths that are derivation outputs, whose hashes are a function of @@ -58,21 +76,36 @@ . Data.Text.Lazy.Builder.toLazyText . contentAddressBuilder -contentAddressBuilder :: ContentAddress -> Builder -contentAddressBuilder (ContentAddress method digest) = case method of - TextIngestionMethod -> - "text:" - <> System.Nix.Hash.algoDigestBuilder digest - FileIngestionMethod r -> - "fixed:" - <> fileIngestionMethodBuilder r - <> System.Nix.Hash.algoDigestBuilder digest +-- | Render the method prefix used in content address strings. +-- +-- @"text:"@, @"fixed:"@ (flat), @"fixed:r:"@ (nar) +methodPrefix :: ContentAddressMethod -> Builder +methodPrefix = \case + ContentAddressMethod_Text -> "text:" + ContentAddressMethod_Flat -> "fixed:" + ContentAddressMethod_NixArchive -> "fixed:r:" -fileIngestionMethodBuilder :: FileIngestionMethod -> Builder -fileIngestionMethodBuilder = \case - FileIngestionMethod_Flat -> "" - FileIngestionMethod_FileRecursive -> "r:" +-- | Render method and hash algorithm, e.g. @"fixed:r:sha256"@. +-- +-- Used in the daemon wire protocol for @AddToStore@ (>= 1.25). +methodAlgoBuilder :: ContentAddressMethod -> Some HashAlgo -> Builder +methodAlgoBuilder method (Some hashAlgo) = + methodPrefix method <> Data.Text.Lazy.Builder.fromText (System.Nix.Hash.algoToText hashAlgo) +-- | Parse method and hash algorithm from wire format. +methodAlgoParser :: Parser (ContentAddressMethod, Some HashAlgo) +methodAlgoParser = do + method <- parseContentAddressMethod + _ <- ":" + hashAlgoText <- "sha256" <|> "sha512" <|> "sha1" <|> "md5" + case System.Nix.Hash.textToAlgo hashAlgoText of + Left e -> fail e + Right algo -> pure (method, algo) + +contentAddressBuilder :: ContentAddress -> Builder +contentAddressBuilder (ContentAddress method digest) = + methodPrefix method <> System.Nix.Hash.algoDigestBuilder digest + -- | Parse `ContentAddressableAddress` from `ByteString` parseContentAddress :: Text -> Either String ContentAddress @@ -83,6 +116,7 @@ contentAddressParser :: Parser ContentAddress contentAddressParser = do method <- parseContentAddressMethod + _ <- ":" digest <- parseTypedDigest case digest of Left e -> fail e @@ -90,10 +124,9 @@ parseContentAddressMethod :: Parser ContentAddressMethod parseContentAddressMethod = - TextIngestionMethod <$ "text:" - <|> FileIngestionMethod <$ "fixed:" - <*> (FileIngestionMethod_FileRecursive <$ "r:" - <|> pure FileIngestionMethod_Flat) + (ContentAddressMethod_Text <$ "text") + <|> (ContentAddressMethod_NixArchive <$ "fixed:r") + <|> (ContentAddressMethod_Flat <$ "fixed") parseTypedDigest :: Parser (Either String (DSum HashAlgo Digest)) parseTypedDigest = System.Nix.Hash.mkNamedDigest <$> parseHashType <*> parseHash diff --git a/src/System/Nix/Derivation.hs b/src/System/Nix/Derivation.hs --- a/src/System/Nix/Derivation.hs +++ b/src/System/Nix/Derivation.hs @@ -1,45 +1,366 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} +-- See TODOs bellow +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | Shared types + module System.Nix.Derivation - ( parseDerivation - , buildDerivation - -- Re-exports - , Derivation(..) - , DerivationOutput(..) - ) where + ( -- * Types + Derivation'(..) + , Derivation + , BasicDerivation -import Data.Attoparsec.Text.Lazy (Parser) + , DerivationType(..) + , DerivationOutputs + , InputAddressedDerivationOutput(..) + , FixedDerivationOutput(..) + , ContentAddressedDerivationOutput(..) + + , FreeformDerivationOutput(..) + , FreeformDerivationOutputs + , toSpecificOutput + , fromSpecificOutput + , toSpecificOutputs + , fromSpecificOutputs + + , DerivationInputs(..) + , derivationInputsFromSingleDerivedPath + , derivationInputsToDerivedPaths + + , DerivedPathMap(..) + , ChildNode(..) + , derivedPathMapFromSingleDerivedPathBuilt + , derivedPathMapToSet + ) where + +import Control.Monad (when) +import Control.DeepSeq (NFData(..)) +import Crypto.Hash (Digest) +import Data.Constraint.Extras +import Data.Constraint.Extras.TH (deriveArgDict) +import Data.Dependent.Map.Monoidal qualified as MonoidalDMap +import Data.Dependent.Sum (DSum(..)) +import Data.Functor.Identity +import Data.GADT.Compare.TH +import Data.GADT.Show.TH +import Data.GADT.DeepSeq (GNFData(..)) +import Data.Kind +import Data.Map (Map) +import Data.Map qualified +import Data.Map.Monoidal (MonoidalMap) +import Data.Map.Monoidal qualified +import Data.Set (Set) +import Data.Set qualified +import Data.Some (Some(..)) import Data.Text (Text) -import Data.Text.Lazy.Builder (Builder) +import Data.These (These(..), fromThese) +import Data.Vector (Vector) +import GHC.Generics (Generic, (:.:)(..)) -import Nix.Derivation (Derivation(..), DerivationOutput(..)) -import System.Nix.StorePath (StoreDir, StorePath) +import System.Nix.ContentAddress (ContentAddressMethod) +import System.Nix.DerivedPath (SingleDerivedPath(..)) +import System.Nix.Hash (HashAlgo) +import System.Nix.OutputName (OutputName, outputStoreObjectName) +import System.Nix.StorePath (StoreDir, StorePath, StorePathName) +import System.Nix.StorePath.ContentAddressed -import qualified Data.Attoparsec.Text.Lazy -import qualified Data.Text -import qualified Data.Text.Lazy -import qualified Data.Text.Lazy.Builder +-- | The type of the derivation +data DerivationType :: Type -> Type where -import qualified Nix.Derivation -import qualified System.Nix.StorePath + -- | The outputs are input-addressed. + DerivationType_InputAddressing :: DerivationType InputAddressedDerivationOutput -parseDerivation :: StoreDir -> Parser (Derivation StorePath Text) -parseDerivation expectedRoot = - Nix.Derivation.parseDerivationWith - pathParser - Nix.Derivation.textParser - where - pathParser = do - text <- Nix.Derivation.textParser - case Data.Attoparsec.Text.Lazy.parseOnly - (System.Nix.StorePath.pathParser expectedRoot) - (Data.Text.Lazy.fromStrict text) - of - Right p -> pure p - Left e -> fail e + -- | The outputs are content-addressed, and the content addresses are + -- "fixed", i.e. required to be specific values (or the build fails) + -- by the derivation itself. + DerivationType_Fixed :: DerivationType FixedDerivationOutput -buildDerivation :: StoreDir -> Derivation StorePath Text -> Builder -buildDerivation storeDir = - Nix.Derivation.buildDerivationWith - (string . System.Nix.StorePath.storePathToText storeDir) - string - where - string = Data.Text.Lazy.Builder.fromText . Data.Text.pack . show + -- | The outputs are content-addressed, and the content addresses are + -- "floating", i.e. they are not required to be a specific value like + -- in the "fixed" case. + DerivationType_ContentAddressing :: DerivationType ContentAddressedDerivationOutput + +---------------- + +type DerivationOutputs = DSum DerivationType (Map OutputName) + +-- | An output of a Nix derivation +data InputAddressedDerivationOutput = InputAddressedDerivationOutput + { iaPath :: StorePath + -- ^ Path where the output will be saved + } + deriving (Eq, Generic, Ord, Show) + +instance NFData InputAddressedDerivationOutput + +data FixedDerivationOutput = FixedDerivationOutput + { fMethod :: ContentAddressMethod + -- ^ How this output is serialized into a hash / what sort of CA + -- store path is used. + , fHash :: DSum HashAlgo Digest + -- ^ Expected hash of this output + } + deriving (Eq, Generic, Ord, Show) + +instance NFData FixedDerivationOutput + +data ContentAddressedDerivationOutput = ContentAddressedDerivationOutput + { caMethod :: ContentAddressMethod + -- ^ How this output is serialized into a hash / what sort of CA + -- store path is used. + , caHashAlgo :: Some HashAlgo + -- ^ What sort of hash function is used with the above + -- content-addressing method to produce the (content-addressed) + -- store path we'll use for the output. + } + deriving (Eq, Generic, Ord, Show) + +instance NFData ContentAddressedDerivationOutput + +---------------- + +-- | TODO this should go in `dependent-sum` +instance (GNFData k, Has' NFData k v) => NFData (DSum k v) where + rnf (x :=> y) = grnf x `seq` has' @NFData @v x (rnf y) + +-- | TODO this needs a home +instance GNFData Digest where + grnf = rnf + +---------------- + +deriveGEq ''DerivationType +deriveGCompare ''DerivationType +deriveGShow ''DerivationType +deriveArgDict ''DerivationType + +---------------- + +data Derivation' inputs outputs = Derivation + { name :: StorePathName + -- ^ Name of the derivation, needed for calculating output paths + , outputs :: outputs + -- ^ Outputs produced by this derivation where keys are output names + , inputs :: inputs + -- ^ Inputs (sources and derivations) + , platform :: Text + -- ^ Platform required for this derivation + , builder :: Text + -- ^ Code to build the derivation, which can be a path or a builtin function + , args :: Vector Text + -- ^ Arguments passed to the executable used to build to derivation + , env :: Map Text Text + -- ^ Environment variables provided to the executable used to build the + -- derivation + } deriving (Eq, Generic, Ord, Show) + +instance (NFData inputs, NFData output) => NFData (Derivation' inputs output) + +-- | A regular Nix derivation +type Derivation = Derivation' DerivationInputs DerivationOutputs + +-- | A Nix derivation that only depends on other store objects directly, +-- not (the outputs of) other derivations +type BasicDerivation = Derivation' (Set StorePath) DerivationOutputs + +---------------- + +data DerivationInputs = DerivationInputs + { srcs :: Set StorePath + -- ^ Inputs that are sources + , drvs :: DerivedPathMap + -- ^ Inputs that are derivations where keys specify derivation paths and + -- values specify which output names are used by this derivation + } deriving (Eq, Generic, Ord, Show) + +instance NFData DerivationInputs + +instance Semigroup DerivationInputs where + DerivationInputs x0 x1 <> DerivationInputs y0 y1 = DerivationInputs + (x0 <> y0) + (x1 <> y1) + +instance Monoid DerivationInputs where + mempty = DerivationInputs mempty mempty + +derivationInputsFromSingleDerivedPath :: SingleDerivedPath -> DerivationInputs +derivationInputsFromSingleDerivedPath = \case + SingleDerivedPath_Opaque storePath -> DerivationInputs + { srcs = Data.Set.singleton storePath + , drvs = mempty + } + SingleDerivedPath_Built drvDPath outputName -> DerivationInputs + { srcs = mempty + , drvs = derivedPathMapFromSingleDerivedPathBuilt drvDPath outputName + } + +derivationInputsToDerivedPaths :: DerivationInputs -> Set SingleDerivedPath +derivationInputsToDerivedPaths inputs = + Data.Set.mapMonotonic SingleDerivedPath_Opaque (srcs inputs) + <> + derivedPathMapToSet (drvs inputs) + +-- | A recursive map to handle dependencies on dynamic derivations in +-- addition to static ones +newtype DerivedPathMap = DerivedPathMap + { unDerivedPathMap :: MonoidalMap StorePath ChildNode + } deriving (Eq, Generic, Ord, Show) + deriving newtype (Semigroup, Monoid) + +instance NFData DerivedPathMap + +newtype ChildNode = ChildNode + { unChildNode :: These (Set OutputName) (MonoidalMap OutputName ChildNode) + } deriving (Eq, Generic, Ord, Show) + deriving newtype (Semigroup) + +instance NFData ChildNode + +derivedPathMapFromSingleDerivedPathBuilt :: SingleDerivedPath -> OutputName -> DerivedPathMap +derivedPathMapFromSingleDerivedPathBuilt drvDPath outputName0 = go drvDPath $ ChildNode $ This $ Data.Set.singleton outputName0 + where + go :: SingleDerivedPath -> ChildNode -> DerivedPathMap + go d child = case d of + SingleDerivedPath_Opaque drvPath -> DerivedPathMap $ Data.Map.Monoidal.singleton drvPath child + SingleDerivedPath_Built nestedPath nestedOutputName -> go nestedPath $ ChildNode $ That $ Data.Map.Monoidal.singleton nestedOutputName child + +derivedPathMapToSet :: DerivedPathMap -> Set SingleDerivedPath +derivedPathMapToSet (DerivedPathMap m) = Data.Set.unions $ fmap + (\(p, c) -> go (SingleDerivedPath_Opaque p) c) + (Data.Map.Monoidal.toList m) + where + go :: SingleDerivedPath -> ChildNode -> Set SingleDerivedPath + go accum (ChildNode child) = + Data.Set.mapMonotonic (SingleDerivedPath_Built accum) shallows + <> + Data.Set.unions (fmap + (\(outputName, child') -> go (SingleDerivedPath_Built accum outputName) child') + $ Data.Map.Monoidal.toList deeps) + where (shallows, deeps) = fromThese mempty mempty child + +---------------- + +-- | This single data type can represent all types of derivation +-- outputs, but allows for many illegal states. This is here as a +-- simpler intermediate data type to aid with derivation parsing (both +-- JSON and ATerm). +data FreeformDerivationOutput + = FreeformDerivationOutput + { mPath :: Maybe StorePath + -- ^ Optional: Path where the output will be saved + , mContentAddressing :: Maybe (ContentAddressMethod, DSum HashAlgo (Maybe :.: Digest)) + -- ^ Optional: How this output is serialized into a hash / what sort of CA + -- store path is used. + -- + -- Inner Optional: Expected hash algorithm and also possibly hash + -- for this output. + } + deriving (Eq, Generic, Ord, Show) + +instance NFData FreeformDerivationOutput + +-- | TODO upstream +instance NFData (f (g a)) => NFData ((f :.: g) a) where + rnf (Comp1 x) = rnf x + +type FreeformDerivationOutputs = Map OutputName FreeformDerivationOutput + +-- | Convert a 'FreeformDerivationOutput' to a derivation type and +-- output +toSpecificOutput + :: forall m + . MonadFail m + => StoreDir + -> StorePathName + -> OutputName + -> FreeformDerivationOutput + -> m (DSum DerivationType Identity) +toSpecificOutput storeDir drvName outputName = \case + FreeformDerivationOutput + { mPath = Just path + , mContentAddressing = Nothing + } -> pure $ DerivationType_InputAddressing :=> Identity (InputAddressedDerivationOutput path) + FreeformDerivationOutput + { mPath = Just path + , mContentAddressing = Just (method, algo :=> Comp1 (Just hash)) + } -> do + fullOutputName <- either (fail . show) pure $ + outputStoreObjectName drvName outputName + let hash' = algo :=> hash + let expectedPath = makeFixedOutputPath storeDir method hash' mempty fullOutputName + when (path /= expectedPath) $ + fail "fixed output path does not match info" + pure $ DerivationType_Fixed :=> Identity (FixedDerivationOutput method hash') + FreeformDerivationOutput + { mPath = Nothing + , mContentAddressing = Just (method, algo :=> Comp1 Nothing) + } -> pure $ DerivationType_ContentAddressing :=> Identity (ContentAddressedDerivationOutput method (Some algo)) + _ -> fail "Invalid combination of path/method/hash being present or absent" + +-- | Convert a derivation type and output to a 'FreeformDerivationOutput' +fromSpecificOutput + :: StoreDir + -> StorePathName + -> OutputName + -> DSum DerivationType Identity + -> FreeformDerivationOutput +fromSpecificOutput storeDir drvName outputName (ty :=> Identity output) = case ty of + DerivationType_InputAddressing -> + case output of + InputAddressedDerivationOutput { iaPath } -> + FreeformDerivationOutput + { mPath = Just iaPath + , mContentAddressing = Nothing + } + DerivationType_Fixed -> + case output of + FixedDerivationOutput { fMethod, fHash = hash'@(algo :=> hash) } -> + FreeformDerivationOutput + { mPath = Just $ makeFixedOutputPath storeDir fMethod hash' mempty + $ either (error . show) id -- TODO do better + $ outputStoreObjectName drvName outputName + , mContentAddressing = Just (fMethod, algo :=> Comp1 (Just hash)) + } + DerivationType_ContentAddressing -> + case output of + ContentAddressedDerivationOutput { caMethod, caHashAlgo = Some algo } -> + FreeformDerivationOutput + { mPath = Nothing + , mContentAddressing = Just (caMethod, algo :=> Comp1 Nothing) + } + +-- | Convert a map of 'FreeformDerivationOutput' to 'DerivationOutputs' +toSpecificOutputs + :: forall m + . MonadFail m + => StoreDir + -> StorePathName + -> FreeformDerivationOutputs + -> m DerivationOutputs +toSpecificOutputs storeDir drvName outputs = do + -- Traverse and convert each output + converted <- Data.Map.traverseWithKey (toSpecificOutput storeDir drvName) outputs + -- Group outputs by their derivation type + let grouped = foldMap + (\(name, ty :=> Identity output) -> MonoidalDMap.singleton ty $ Data.Map.singleton name output) + (Data.Map.toList converted) + case MonoidalDMap.toList grouped of + [res] -> pure res + _ -> fail "derivation outputs did not agree on derivation type" + +-- | Convert a map of specific derivation outputs to a 'FreeformDerivationOutputs' +fromSpecificOutputs + :: StoreDir + -> StorePathName + -> DerivationOutputs + -> FreeformDerivationOutputs +fromSpecificOutputs storeDir drvName (drvType :=> outputs) = + flip Data.Map.mapWithKey outputs $ \outputName output -> + fromSpecificOutput storeDir drvName outputName $ drvType :=> Identity output diff --git a/src/System/Nix/DerivedPath.hs b/src/System/Nix/DerivedPath.hs --- a/src/System/Nix/DerivedPath.hs +++ b/src/System/Nix/DerivedPath.hs @@ -2,6 +2,9 @@ module System.Nix.DerivedPath ( OutputsSpec(..) + , SingleDerivedPath(..) + , parseSingleDerivedPath + , singleDerivedPathToText , DerivedPath(..) , ParseOutputsError(..) , parseOutputsSpec @@ -16,12 +19,13 @@ import System.Nix.OutputName (OutputName, InvalidNameError) import System.Nix.StorePath (StoreDir(..), StorePath, InvalidPathError) -import qualified Data.Bifunctor -import qualified Data.ByteString.Char8 -import qualified Data.Set -import qualified Data.Text -import qualified System.Nix.OutputName -import qualified System.Nix.StorePath +import Data.Bifunctor qualified +import Data.ByteString.Char8 qualified +import Data.Set qualified +import Data.List qualified +import Data.Text qualified +import System.Nix.OutputName qualified +import System.Nix.StorePath qualified data OutputsSpec = OutputsSpec_All @@ -30,11 +34,19 @@ -- ^ Set of specific outputs deriving (Eq, Generic, Ord, Show) +data SingleDerivedPath = + SingleDerivedPath_Opaque StorePath + -- ^ Fully evaluated store path that can't be built + -- but can be fetched + | SingleDerivedPath_Built SingleDerivedPath OutputName + -- ^ Derivation path and the output built from it + deriving (Eq, Generic, Ord, Show) + data DerivedPath = DerivedPath_Opaque StorePath -- ^ Fully evaluated store path that can't be built -- but can be fetched - | DerivedPath_Built StorePath OutputsSpec + | DerivedPath_Built SingleDerivedPath OutputsSpec -- ^ Derivation path and the outputs built from it deriving (Eq, Generic, Ord, Show) @@ -45,15 +57,19 @@ | ParseOutputsError_NoPrefix StoreDir Text deriving (Eq, Ord, Show) +parseOutputName :: Text -> Either ParseOutputsError OutputName +parseOutputName = + ( Data.Bifunctor.first + ParseOutputsError_InvalidName + . System.Nix.OutputName.mkOutputName + ) + parseOutputsSpec :: Text -> Either ParseOutputsError OutputsSpec parseOutputsSpec t | t == "*" = Right OutputsSpec_All | otherwise = do names <- mapM - ( Data.Bifunctor.first - ParseOutputsError_InvalidName - . System.Nix.OutputName.mkOutputName - ) + parseOutputName (Data.Text.splitOn "," t) if null names then Left ParseOutputsError_NoNames @@ -65,26 +81,54 @@ OutputsSpec_Names ns -> Data.Text.intercalate "," - (fmap System.Nix.OutputName.unOutputName + (fmap System.Nix.OutputName.outputNameToText (Data.Set.toList ns) ) +parseSingleDerivedPath + :: StoreDir + -> Text + -> Either ParseOutputsError SingleDerivedPath +parseSingleDerivedPath root@(StoreDir sd) path = + let -- We need to do a bit more legwork for case + -- when StoreDir contains '!', which is the delimiter + -- between store path and output name(s). + -- (The Arbitrary instance can generate such paths.) + textRoot = Data.Text.pack + $ Data.ByteString.Char8.unpack sd + + in case Data.Text.stripPrefix textRoot path of + Nothing -> Left $ ParseOutputsError_NoPrefix root path + Just woRoot -> + case Data.Text.splitOn "!" woRoot of + [] -> error "internal error, this function should return NonEmpty" + (pathNoPrefix : outputs) -> Data.List.foldl' + (liftA2 SingleDerivedPath_Built) + (SingleDerivedPath_Opaque + <$> (convertError + $ System.Nix.StorePath.parsePathFromText + root + (textRoot <> pathNoPrefix) + )) + (parseOutputName <$> outputs) + parseDerivedPath :: StoreDir -> Text -> Either ParseOutputsError DerivedPath parseDerivedPath root@(StoreDir sd) path = let -- We need to do a bit more legwork for case - -- when StoreDir contains '!' - -- which is generated by its Arbitrary instance + -- when StoreDir contains '!', which is the delimiter + -- between store path and output name(s). + -- (The Arbitrary instance can generate such paths.) textRoot = Data.Text.pack $ Data.ByteString.Char8.unpack sd in case Data.Text.stripPrefix textRoot path of Nothing -> Left $ ParseOutputsError_NoPrefix root path Just woRoot -> - case Data.Text.breakOn "!" woRoot of - (pathNoPrefix, r) -> + case Data.Text.breakOnEnd "!" woRoot of + (r, suffix) -> if Data.Text.null r then DerivedPath_Opaque <$> (convertError @@ -93,23 +137,30 @@ path ) else DerivedPath_Built - <$> (convertError - $ System.Nix.StorePath.parsePathFromText - root - (textRoot <> pathNoPrefix) - ) - <*> parseOutputsSpec (Data.Text.drop (Data.Text.length "!") r) - where - convertError - :: Either InvalidPathError a - -> Either ParseOutputsError a - convertError = Data.Bifunctor.first ParseOutputsError_InvalidPath + <$> parseSingleDerivedPath + root + (textRoot <> Data.Text.dropEnd (Data.Text.length "!") r) + <*> parseOutputsSpec suffix +convertError + :: Either InvalidPathError a + -> Either ParseOutputsError a +convertError = Data.Bifunctor.first ParseOutputsError_InvalidPath + +singleDerivedPathToText :: StoreDir -> SingleDerivedPath -> Text +singleDerivedPathToText root = \case + SingleDerivedPath_Opaque p -> + System.Nix.StorePath.storePathToText root p + SingleDerivedPath_Built p o -> + singleDerivedPathToText root p + <> "!" + <> System.Nix.OutputName.outputNameToText o + derivedPathToText :: StoreDir -> DerivedPath -> Text derivedPathToText root = \case DerivedPath_Opaque p -> System.Nix.StorePath.storePathToText root p DerivedPath_Built p os -> - System.Nix.StorePath.storePathToText root p + singleDerivedPathToText root p <> "!" <> outputsSpecToText os diff --git a/src/System/Nix/FileContentAddress.hs b/src/System/Nix/FileContentAddress.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/FileContentAddress.hs @@ -0,0 +1,10 @@ +module System.Nix.FileContentAddress + ( FileIngestionMethod(..) + ) where + +import GHC.Generics (Generic) + +data FileIngestionMethod + = FileIngestionMethod_Flat + | FileIngestionMethod_NixArchive + deriving (Bounded, Eq, Generic, Enum, Ord, Show) diff --git a/src/System/Nix/Fingerprint.hs b/src/System/Nix/Fingerprint.hs --- a/src/System/Nix/Fingerprint.hs +++ b/src/System/Nix/Fingerprint.hs @@ -20,8 +20,8 @@ import System.Nix.StorePath import System.Nix.StorePath.Metadata (Metadata(..)) -import qualified Data.HashSet as HashSet -import qualified Data.Text as Text +import Data.HashSet qualified as HashSet +import Data.Text qualified as Text -- | Produce the message signed by a NAR signature metadataFingerprint :: StoreDir -> StorePath -> Metadata StorePath -> Text diff --git a/src/System/Nix/Hash.hs b/src/System/Nix/Hash.hs --- a/src/System/Nix/Hash.hs +++ b/src/System/Nix/Hash.hs @@ -25,12 +25,14 @@ , digestBuilder ) where +import Control.DeepSeq (NFData(..)) import Crypto.Hash (Digest, HashAlgorithm, MD5(..), SHA1(..), SHA256(..), SHA512(..)) import Data.ByteString (ByteString) import Data.Constraint.Extras (Has(has)) import Data.Constraint.Extras.TH (deriveArgDict) import Data.Dependent.Sum (DSum((:=>))) import Data.GADT.Compare.TH (deriveGEq, deriveGCompare) +import Data.GADT.DeepSeq (GNFData(..)) import Data.GADT.Show.TH (deriveGShow) import Data.Kind (Type) import Data.Some (Some(Some)) @@ -38,12 +40,12 @@ import Data.Text.Lazy.Builder (Builder) import System.Nix.Base (BaseEncoding(..)) -import qualified Crypto.Hash -import qualified Data.ByteArray -import qualified Data.Text -import qualified Data.Text.Lazy.Builder -import qualified System.Nix.Base -import qualified System.Nix.Hash.Truncation +import Crypto.Hash qualified +import Data.ByteArray qualified +import Data.Text qualified +import Data.Text.Lazy.Builder qualified +import System.Nix.Base qualified +import System.Nix.Hash.Truncation qualified -- | A 'HashAlgorithm' with a canonical name, for serialization -- purposes (e.g. SRI hashes) @@ -73,6 +75,16 @@ deriveGShow ''HashAlgo deriveArgDict ''HashAlgo +instance NFData (HashAlgo a) where + rnf = \case + HashAlgo_MD5 -> () + HashAlgo_SHA1 -> () + HashAlgo_SHA256 -> () + HashAlgo_SHA512 -> () + +instance GNFData HashAlgo where + grnf = rnf + algoToText :: forall t. HashAlgo t -> Text algoToText x = has @NamedAlgo x (algoName @t) @@ -185,7 +197,4 @@ -- | Builder for @DSum HashAlgo Digest@s algoDigestBuilder :: DSum HashAlgo Digest -> Builder -algoDigestBuilder (a :=> d) = - Data.Text.Lazy.Builder.fromText (System.Nix.Hash.algoToText a) - <> ":" - <> Data.Text.Lazy.Builder.fromText (encodeDigestWith NixBase32 d) +algoDigestBuilder (a :=> d) = has @NamedAlgo a $ digestBuilder d diff --git a/src/System/Nix/Hash/Truncation.hs b/src/System/Nix/Hash/Truncation.hs --- a/src/System/Nix/Hash/Truncation.hs +++ b/src/System/Nix/Hash/Truncation.hs @@ -5,10 +5,10 @@ import Data.Word (Word8) import Data.ByteString (ByteString) -import qualified Data.ByteString -import qualified Data.Bits -import qualified Data.Bool -import qualified Data.List +import Data.ByteString qualified +import Data.Bits qualified +import Data.Bool qualified +import Data.List qualified -- | Bytewise truncation of a 'Digest'. -- diff --git a/src/System/Nix/OutputName.hs b/src/System/Nix/OutputName.hs --- a/src/System/Nix/OutputName.hs +++ b/src/System/Nix/OutputName.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveAnyClass #-} {-| Description : Derived path output names @@ -6,24 +7,48 @@ module System.Nix.OutputName ( OutputName(..) , mkOutputName + , outputNameToText + , outputStoreObjectName -- * Re-exports , System.Nix.StorePath.InvalidNameError(..) - , System.Nix.StorePath.parseNameText ) where +import Control.DeepSeq (NFData) import Data.Hashable (Hashable) import Data.Text (Text) import GHC.Generics (Generic) -import System.Nix.StorePath (InvalidNameError) - -import qualified System.Nix.StorePath +import System.Nix.StorePath + ( StorePathName + , InvalidNameError(..) + , mkStorePathName + , unStorePathName + ) -- | Name of the derived path output -- Typically used for "dev", "doc" sub-outputs newtype OutputName = OutputName { -- | Extract the contents of the name. - unOutputName :: Text + unOutputName :: StorePathName } deriving (Eq, Generic, Hashable, Ord, Show) +instance NFData OutputName + mkOutputName :: Text -> Either InvalidNameError OutputName -mkOutputName = fmap OutputName . System.Nix.StorePath.parseNameText +mkOutputName = fmap OutputName . System.Nix.StorePath.mkStorePathName + +outputNameToText :: OutputName -> Text +outputNameToText = unStorePathName . unOutputName + +-- | Compute the name of an output (store object) from the output name +-- and the derivation name +-- +-- Invalid character errors are not possible, but total length errors are +outputStoreObjectName :: StorePathName -> OutputName -> Either InvalidNameError StorePathName +outputStoreObjectName drvName outputName = case outputNameS of + "out" -> Right drvName + _ -> System.Nix.StorePath.mkStorePathName $ + unStorePathName drvName + <> "-" + <> outputNameS + where + outputNameS = outputNameToText outputName diff --git a/src/System/Nix/Placeholder.hs b/src/System/Nix/Placeholder.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Placeholder.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE OverloadedStrings #-} + +module System.Nix.Placeholder + ( Placeholder + , createPlaceholder + , renderPlaceholder + + , DownstreamPlaceholder + , renderDownstreamPlaceholder + , unknownCaOutput + , unknownDerivation + , downstreamPlaceholderFromSingleDerivedPathBuilt + , pathOrPlaceholderFromSingleDerivedPath + ) where + +import Data.ByteArray qualified +import Crypto.Hash (Digest, SHA256) +import Crypto.Hash qualified +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T + +import System.Nix.Base +import System.Nix.Hash +import System.Nix.StorePath +import System.Nix.DerivedPath +import System.Nix.OutputName +import System.Nix.Hash.Truncation + +-- | For a derivation's own outputs +newtype Placeholder = Placeholder + { placeholder_hash :: Digest SHA256 + } deriving (Show, Eq) + +-- | Given an output name, make a placeholder +createPlaceholder :: OutputName -> Placeholder +createPlaceholder outputName = + let + clearText = T.intercalate ":" + [ "nix-output" + , outputNameToText outputName + ] + in Placeholder (Crypto.Hash.hash $ T.encodeUtf8 clearText) + +-- | This creates an opaque and almost certainly unique string +-- deterministically from the placeholder. +renderPlaceholder :: Placeholder -> Text +renderPlaceholder (Placeholder h) = T.cons '/' (encodeDigestWith NixBase32 h) + +-- | Downstream Placeholders are opaque and almost certainly unique +-- values used to allow derivations to refer to store objects which are +-- yet to be built and for which we do not yet have store paths. +-- +-- They correspond to `SingleDerivedPath`s that are not +-- `SingleDerivedPath_Opaque`, except for the cases involving input +-- addressing or fixed outputs where we do know a store path for the +-- derivation output in advance. +-- +-- Unlike `SingleDerivedPath`, however, `DownstreamPlaceholder` is +-- purposefully opaque and obfuscated. This is so they are hard to +-- create by accident, and so substituting them (once we know what the +-- path to store object is) is unlikely to capture other stuff it +-- shouldn't. +-- +-- We use them with `Derivation`: the `render()` method is called to +-- render an opaque string which can be used in the derivation, and the +-- resolving logic can substitute those strings for store paths when +-- resolving `Derivation.inputs.drvs` to `BasicDerivation.input.srcs`. +newtype DownstreamPlaceholder = DownstreamPlaceholder + { downstreamPlaceholder_hash :: Digest SHA256 + } deriving (Show, Eq) + +-- | This creates an opaque and almost certainly unique string +-- deterministically from the placeholder. +renderDownstreamPlaceholder :: DownstreamPlaceholder -> Text +renderDownstreamPlaceholder (DownstreamPlaceholder h) = T.cons '/' (encodeDigestWith NixBase32 h) + +-- | Create a placeholder for an unknown output of a content-addressed +-- derivation. +-- +-- The derivation itself is known (we have a store path for it), but +-- the output doesn't yet have a known store path. +-- +-- The store path must end in `.drv` +unknownCaOutput :: StorePath -> OutputName -> DownstreamPlaceholder +unknownCaOutput drvPath outputName = + let + clearText = T.intercalate ":" + [ "nix-upstream-output" + , storePathHashPartToText $ storePathHash drvPath + , either (error . show) unStorePathName $ do + let drvName = unStorePathName $ storePathName drvPath + baseName <- maybe (Left $ error "derivation path must end in .drv") Right + $ T.stripSuffix ".drv" drvName + name <- mkStorePathName baseName + outputStoreObjectName name outputName + ] + in DownstreamPlaceholder (Crypto.Hash.hash $ T.encodeUtf8 clearText) + +-- | Create a placeholder for the output of an unknown derivation. +-- +-- The derivation is not yet known because it is a dynamic +-- derivation --- it is itself an output of another derivation --- +-- and we just have (another) placeholder for it. +unknownDerivation :: DownstreamPlaceholder -> OutputName -> DownstreamPlaceholder +unknownDerivation (DownstreamPlaceholder h) outputName = + let + clearText = T.intercalate ":" + [ "nix-computed-output" + , encodeWith NixBase32 $ System.Nix.Hash.Truncation.truncateInNixWay 20 $ Data.ByteArray.convert h + , outputNameToText outputName + ] + in DownstreamPlaceholder (Crypto.Hash.hash $ T.encodeUtf8 clearText) + +-- | Convenience constructor that handles both cases (unknown +-- content-addressed output and unknown derivation), delegating as +-- needed to `unknownCaOutput` and `unknownDerivation`. +-- +-- Recursively constructs a placeholder from a `SingleDerivedPath` chain. The +-- two arguments taken are isomorphic to the `Built` constructor of +-- `SingleDerivedPath`, hence the name. +-- +-- The base case for the derivation path is `SingleDerivedPath_Opaque` (a known +-- derivation with unknown CA output), and the recursive case is +-- `SingleDerivedPath_Built` (an unknown derivation that is itself an output of +-- another derivation). +downstreamPlaceholderFromSingleDerivedPathBuilt :: SingleDerivedPath -> OutputName -> DownstreamPlaceholder +downstreamPlaceholderFromSingleDerivedPathBuilt drvPath outputName = case drvPath of + SingleDerivedPath_Opaque drvPath' -> + unknownCaOutput drvPath' outputName + SingleDerivedPath_Built drvPath' outputName' -> + unknownDerivation (downstreamPlaceholderFromSingleDerivedPathBuilt drvPath' outputName') outputName + +-- | Convenience function which makes a string, using the store path if +-- opaque, or placeholder if built. +pathOrPlaceholderFromSingleDerivedPath :: StoreDir -> SingleDerivedPath -> Text +pathOrPlaceholderFromSingleDerivedPath storeDir = \case + SingleDerivedPath_Opaque path -> storePathToText storeDir path + SingleDerivedPath_Built drvPath outputName -> renderDownstreamPlaceholder + $ downstreamPlaceholderFromSingleDerivedPathBuilt drvPath outputName diff --git a/src/System/Nix/Realisation.hs b/src/System/Nix/Realisation.hs --- a/src/System/Nix/Realisation.hs +++ b/src/System/Nix/Realisation.hs @@ -3,101 +3,90 @@ -} module System.Nix.Realisation ( - DerivationOutput(..) - , DerivationOutputError(..) - , derivationOutputBuilder - , derivationOutputParser + BuildTraceKey(..) + , BuildTraceKeyError(..) + , buildTraceKeyBuilder + , buildTraceKeyParser , Realisation(..) , RealisationWithId(..) ) where -import Crypto.Hash (Digest) -import Data.Map (Map) import Data.Set (Set) import Data.Text (Text) import Data.Text.Lazy.Builder (Builder) -import Data.Dependent.Sum (DSum) import GHC.Generics (Generic) -import System.Nix.Hash (HashAlgo) import System.Nix.OutputName (OutputName, InvalidNameError) -import System.Nix.Signature (Signature) -import System.Nix.StorePath (StorePath) +import System.Nix.Signature (NamedSignature) +import System.Nix.StorePath (StorePath, InvalidPathError) -import qualified Data.Bifunctor -import qualified Data.Text -import qualified Data.Text.Lazy.Builder -import qualified System.Nix.Hash +import Data.Bifunctor qualified +import Data.Text qualified +import Data.Text.Lazy.Builder qualified +import System.Nix.OutputName qualified +import System.Nix.StorePath qualified -- | Output of the derivation -data DerivationOutput a = DerivationOutput - { derivationOutputHash :: DSum HashAlgo Digest - -- ^ Hash modulo of the derivation - , derivationOutputOutput :: a - -- ^ Output (either a OutputName or StorePatH) +data BuildTraceKey = BuildTraceKey + { buildTraceKeyDrvPath :: StorePath + -- ^ Store path of the derivation + , buildTraceKeyOutput :: OutputName + -- ^ Output name } deriving (Eq, Generic, Ord, Show) -data DerivationOutputError - = DerivationOutputError_Digest String - | DerivationOutputError_Name InvalidNameError - | DerivationOutputError_NoExclamationMark - | DerivationOutputError_NoColon - | DerivationOutputError_TooManyParts [Text] +data BuildTraceKeyError + = BuildTraceKeyError_Path InvalidPathError + | BuildTraceKeyError_Name InvalidNameError + | BuildTraceKeyError_NoCaret + | BuildTraceKeyError_TooManyParts [Text] deriving (Eq, Ord, Show) -derivationOutputParser - :: (Text -> Either InvalidNameError outputName) - -> Text - -> Either DerivationOutputError (DerivationOutput outputName) -derivationOutputParser outputName dOut = - case Data.Text.splitOn (Data.Text.singleton '!') dOut of - [] -> Left DerivationOutputError_NoColon - [sriHash, oName] -> do - hash <- - case Data.Text.splitOn (Data.Text.singleton ':') sriHash of - [] -> Left DerivationOutputError_NoColon - [hashName, digest] -> - Data.Bifunctor.first - DerivationOutputError_Digest - $ System.Nix.Hash.mkNamedDigest hashName digest - x -> Left $ DerivationOutputError_TooManyParts x +buildTraceKeyParser + :: Text + -> Either BuildTraceKeyError BuildTraceKey +buildTraceKeyParser dOut = + case Data.Text.splitOn (Data.Text.singleton '^') dOut of + [pathText, oName] -> do + path <- + Data.Bifunctor.first + BuildTraceKeyError_Path + $ System.Nix.StorePath.parseBasePathFromText pathText name <- Data.Bifunctor.first - DerivationOutputError_Name - $ outputName oName - - pure $ DerivationOutput hash name - x -> Left $ DerivationOutputError_TooManyParts x + BuildTraceKeyError_Name + $ System.Nix.OutputName.mkOutputName oName + pure $ BuildTraceKey path name + [_] -> Left BuildTraceKeyError_NoCaret + x -> Left $ BuildTraceKeyError_TooManyParts x -derivationOutputBuilder - :: (outputName -> Text) - -> DerivationOutput outputName +buildTraceKeyBuilder + :: BuildTraceKey -> Builder -derivationOutputBuilder outputName DerivationOutput{..} = - System.Nix.Hash.algoDigestBuilder derivationOutputHash - <> Data.Text.Lazy.Builder.singleton '!' - <> Data.Text.Lazy.Builder.fromText (outputName derivationOutputOutput) +buildTraceKeyBuilder BuildTraceKey{..} = + Data.Text.Lazy.Builder.fromText + (System.Nix.StorePath.storePathBaseToText buildTraceKeyDrvPath) + <> Data.Text.Lazy.Builder.singleton '^' + <> Data.Text.Lazy.Builder.fromText + (System.Nix.OutputName.outputNameToText buildTraceKeyOutput) -- | Build realisation context -- -- realisationId is ommited since it is a key --- of type @DerivationOutput OutputName@ so +-- of type @BuildTraceKey OutputName@ so -- we will use @RealisationWithId@ newtype data Realisation = Realisation { realisationOutPath :: StorePath -- ^ Output path - , realisationSignatures :: Set Signature + , realisationSignatures :: Set NamedSignature -- ^ Signatures - , realisationDependencies :: Map (DerivationOutput OutputName) StorePath - -- ^ Dependent realisations required for this one to be valid } deriving (Eq, Generic, Ord, Show) -- | For wire protocol -- -- We store this normalized in @Build.buildResultBuiltOutputs@ --- as @Map (DerivationOutput OutputName) Realisation@ +-- as @Map BuildTraceKey Realisation@ -- but wire protocol needs it de-normalized so we -- need a special (From|To)JSON instances for it newtype RealisationWithId = RealisationWithId - { unRealisationWithId :: (DerivationOutput OutputName, Realisation) + { unRealisationWithId :: (BuildTraceKey, Realisation) } deriving (Eq, Generic, Ord, Show) diff --git a/src/System/Nix/Signature.hs b/src/System/Nix/Signature.hs --- a/src/System/Nix/Signature.hs +++ b/src/System/Nix/Signature.hs @@ -9,9 +9,9 @@ , signatureParser , parseSignature , signatureToText - , NarSignature(..) + , NamedSignature(..) , narSignatureParser - , parseNarSignature + , parseNamedSignature , narSignatureToText ) where @@ -22,11 +22,11 @@ import GHC.Generics (Generic) import System.Nix.Base (decodeWith, encodeWith, BaseEncoding(Base64)) -import qualified Crypto.PubKey.Ed25519 as Ed25519 -import qualified Data.Attoparsec.Text -import qualified Data.ByteArray -import qualified Data.Char -import qualified Data.Text +import Crypto.PubKey.Ed25519 qualified as Ed25519 +import Data.Attoparsec.Text qualified +import Data.ByteArray qualified +import Data.Char qualified +import Data.Text qualified -- | An ed25519 signature. newtype Signature = Signature Ed25519.Signature @@ -53,7 +53,7 @@ encodeWith Base64 (Data.ByteArray.convert sig :: ByteString) -- | A detached signature attesting to a nix archive's validity. -data NarSignature = NarSignature +data NamedSignature = NamedSignature { -- | The name of the public key used to sign the archive. publicKey :: !Text , -- | The archive's signature. @@ -67,19 +67,19 @@ yBS = Data.ByteArray.convert y :: ByteString in compare xBS yBS -narSignatureParser :: Parser NarSignature +narSignatureParser :: Parser NamedSignature narSignatureParser = do publicKey <- Data.Attoparsec.Text.takeWhile1 (/= ':') _ <- Data.Attoparsec.Text.string ":" sig <- signatureParser - pure $ NarSignature {..} + pure $ NamedSignature {..} -parseNarSignature :: Text -> Either String NarSignature -parseNarSignature = Data.Attoparsec.Text.parseOnly narSignatureParser +parseNamedSignature :: Text -> Either String NamedSignature +parseNamedSignature = Data.Attoparsec.Text.parseOnly narSignatureParser -narSignatureToText :: NarSignature -> Text -narSignatureToText NarSignature {..} = +narSignatureToText :: NamedSignature -> Text +narSignatureToText NamedSignature {..} = mconcat [ publicKey, ":", signatureToText sig ] -instance Show NarSignature where +instance Show NamedSignature where show narSig = Data.Text.unpack (narSignatureToText narSig) diff --git a/src/System/Nix/Store/Types.hs b/src/System/Nix/Store/Types.hs --- a/src/System/Nix/Store/Types.hs +++ b/src/System/Nix/Store/Types.hs @@ -1,16 +1,10 @@ +-- | TODO rename module module System.Nix.Store.Types - ( FileIngestionMethod(..) - , PathFilter(..) + ( PathFilter(..) , RepairMode(..) ) where import GHC.Generics (Generic) - --- | Add path recursively or not -data FileIngestionMethod - = FileIngestionMethod_Flat - | FileIngestionMethod_FileRecursive - deriving (Bounded, Eq, Generic, Enum, Ord, Show) -- | Path filtering function newtype PathFilter = PathFilter diff --git a/src/System/Nix/StorePath.hs b/src/System/Nix/StorePath.hs --- a/src/System/Nix/StorePath.hs +++ b/src/System/Nix/StorePath.hs @@ -27,10 +27,14 @@ storePathToFilePath , storePathToRawFilePath , storePathToText + , storePathBaseToText + , storePathBaseToRawFilePath , storePathToNarInfo , storePathHashPartToText , -- * Parsing 'StorePath's - parsePath + parseBasePath + , parseBasePathFromText + , parsePath , parsePathFromText , pathParser -- * Utilities for tests @@ -38,6 +42,7 @@ , unsafeMakeStorePathHashPart ) where +import Control.DeepSeq (NFData) import Crypto.Hash (HashAlgorithm) import Data.Attoparsec.Text.Lazy (Parser, ()) import Data.ByteString (ByteString) @@ -47,17 +52,17 @@ import GHC.Generics (Generic) import System.Nix.Base (BaseEncoding(NixBase32)) -import qualified Data.Bifunctor -import qualified Data.ByteString.Char8 -import qualified Data.Char -import qualified Data.Text -import qualified Data.Text.Encoding -import qualified Data.Attoparsec.Text.Lazy -import qualified System.FilePath +import Data.Bifunctor qualified +import Data.ByteString.Char8 qualified +import Data.Char qualified +import Data.Text qualified +import Data.Text.Encoding qualified +import Data.Attoparsec.Text.Lazy qualified +import System.FilePath qualified -import qualified System.Nix.Base -import qualified System.Nix.Hash -import qualified System.Nix.Base32 +import System.Nix.Base qualified +import System.Nix.Hash qualified +import System.Nix.Base32 qualified -- | A path in a Nix store. -- @@ -78,6 +83,8 @@ } deriving (Eq, Generic, Ord) +instance NFData StorePath + instance Hashable StorePath where hashWithSalt s StorePath{..} = s `hashWithSalt` storePathHash `hashWithSalt` storePathName @@ -98,6 +105,8 @@ unStorePathName :: Text } deriving (Eq, Generic, Hashable, Ord, Show) +instance NFData StorePathName + -- | The hash algorithm used for store path hashes. newtype StorePathHashPart = StorePathHashPart { -- | Extract the contents of the hash. @@ -105,6 +114,8 @@ } deriving (Eq, Generic, Hashable, Ord, Show) +instance NFData StorePathHashPart + -- | Make @StorePathHashPart@ from @ByteString@ (hash part of the @StorePath@) -- using specific @HashAlgorithm@ mkStorePathHashPart @@ -144,19 +155,16 @@ parseNameText n | n == "" = Left EmptyName - | Data.Text.length n > 211 - = Left $ NameTooLong (Data.Text.length n) | Data.Text.head n == '.' - = Left $ LeadingDot - | not - $ Data.Text.null - $ Data.Text.filter - (not . validStorePathNameChar) - n - = Left - $ InvalidCharacters - $ Data.Text.filter (not . validStorePathNameChar) n + = Left LeadingDot + | nLength > 211 + = Left $ NameTooLong nLength + | not $ Data.Text.null invalidCharacters + = Left $ InvalidCharacters invalidCharacters | otherwise = pure n + where + invalidCharacters = Data.Text.filter (not . validStorePathNameChar) n + nLength = Data.Text.length n validStorePathNameChar :: Char -> Bool validStorePathNameChar c = @@ -185,14 +193,25 @@ class HasStoreDir r where hasStoreDir :: r -> StoreDir --- | Render a 'StorePath' as a 'RawFilePath'. -storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath -storePathToRawFilePath storeDir StorePath{..} = - unStoreDir storeDir <> "/" <> hashPart <> "-" <> name +-- | Render a 'StorePath' as a base path (without store directory). +-- This is the relative path format: @hashPart-name@ +storePathBaseToRawFilePath :: StorePath -> RawFilePath +storePathBaseToRawFilePath StorePath{..} = + hashPart <> "-" <> name where hashPart = Data.Text.Encoding.encodeUtf8 $ storePathHashPartToText storePathHash name = Data.Text.Encoding.encodeUtf8 $ unStorePathName storePathName +-- | Render a 'StorePath' as a base path 'Text' (without store directory). +-- This is the relative path format: @hashPart-name@ +storePathBaseToText :: StorePath -> Text +storePathBaseToText = Data.Text.Encoding.decodeUtf8 . storePathBaseToRawFilePath + +-- | Render a 'StorePath' as a 'RawFilePath'. +storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath +storePathToRawFilePath storeDir sp = + unStoreDir storeDir <> "/" <> storePathBaseToRawFilePath sp + -- | Render a 'StorePath' as a 'FilePath'. storePathToFilePath :: StoreDir -> StorePath -> FilePath storePathToFilePath storeDir = Data.ByteString.Char8.unpack . storePathToRawFilePath storeDir @@ -219,14 +238,14 @@ storePathHashPartToText = System.Nix.Base.encodeWith NixBase32 . unStorePathHashPart --- | Parse `StorePath` from `String`, internal -parsePath' - :: StoreDir - -> String +-- | Parse a base name store path --- no store dir prefix. +-- +-- Internal +parseBasePath' + :: String -> Either InvalidPathError StorePath -parsePath' expectedRoot stringyPath = +parseBasePath' fname = let - (rootDir, fname) = System.FilePath.splitFileName stringyPath (storeBasedHashPart, namePart) = Data.Text.breakOn "-" $ Data.Text.pack fname hashPart = Data.Bifunctor.bimap @@ -237,6 +256,18 @@ Data.Bifunctor.first PathNameInvalid $ mkStorePathName . Data.Text.drop 1 $ namePart + in + StorePath <$> hashPart <*> name + + +-- | Parse `StorePath` from `String`, internal +parsePath' + :: StoreDir + -> String + -> Either InvalidPathError StorePath +parsePath' expectedRoot stringyPath = + let + (rootDir, fname) = System.FilePath.splitFileName stringyPath --rootDir' = dropTrailingPathSeparator rootDir -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b rootDir' = init rootDir @@ -249,8 +280,15 @@ , rdMismatchGot = StoreDir $ Data.ByteString.Char8.pack rootDir } in - either Left (pure $ StorePath <$> hashPart <*> name) storeDir + either Left (pure $ parseBasePath' fname) storeDir +-- | Parse `StorePath` from `ByteString`. +-- This parses a base path (without store directory prefix). +parseBasePath + :: ByteString + -> Either InvalidPathError StorePath +parseBasePath = parseBasePath' . Data.ByteString.Char8.unpack + -- | Parse `StorePath` from `ByteString`, checking -- that store directory matches `expectedRoot`. parsePath @@ -258,6 +296,13 @@ -> ByteString -> Either InvalidPathError StorePath parsePath sd = parsePath' sd . Data.ByteString.Char8.unpack + +-- | Parse `StorePath` from `Text`. +-- This parses a base path (without store directory prefix). +parseBasePathFromText + :: Text + -> Either InvalidPathError StorePath +parseBasePathFromText = parseBasePath' . Data.Text.unpack -- | Parse `StorePath` from `Text`, checking -- that store directory matches `expectedRoot`. diff --git a/src/System/Nix/StorePath/ContentAddressed.hs b/src/System/Nix/StorePath/ContentAddressed.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/StorePath/ContentAddressed.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} + +module System.Nix.StorePath.ContentAddressed + ( References(..) + , makeStorePath + , makeFixedOutputPath + ) where + +import Crypto.Hash (Digest, SHA256, HashAlgorithm) +import Data.ByteString (ByteString) +import Data.Constraint.Extras (Has(has)) +import Data.Dependent.Sum (DSum((:=>))) +import Data.HashSet (HashSet) +import Data.Some (Some(Some)) +import System.Nix.ContentAddress (ContentAddressMethod (..)) +import System.Nix.Hash (BaseEncoding(Base16), HashAlgo(..)) +import System.Nix.StorePath (StoreDir, StorePath, StorePathName) + +import Crypto.Hash qualified +import Data.ByteString.Char8 qualified +import Data.ByteString qualified +import Data.HashSet qualified +import Data.List qualified +import Data.Text qualified +import Data.Text.Encoding qualified +import System.Nix.Hash qualified +import System.Nix.StorePath qualified + +data References = References + { references_others :: HashSet StorePath + , references_self :: Bool + } + +instance Semigroup References where + a <> b = References + { references_others = references_others a <> references_others b + , references_self = references_self a || references_self b + } + +instance Monoid References where + mempty = References + { references_others = mempty + , references_self = False + } + +-- | TODO this isn't just for content-addressed paths, move elsewhere +makeStorePath + :: StoreDir + -> ByteString + -> DSum HashAlgo Digest + -> StorePathName + -> StorePath +makeStorePath storeDir ty (hashAlgo :=> (digest :: Digest a)) nm = + System.Nix.StorePath.unsafeMakeStorePath storeHash nm + where + storeHash = has @HashAlgorithm hashAlgo $ System.Nix.StorePath.mkStorePathHashPart @a s + s = + Data.ByteString.intercalate ":" $ + ty:fmap Data.Text.Encoding.encodeUtf8 + [ System.Nix.Hash.algoToText hashAlgo + , System.Nix.Hash.encodeDigestWith Base16 digest + , Data.Text.pack . Data.ByteString.Char8.unpack $ System.Nix.StorePath.unStoreDir storeDir + , System.Nix.StorePath.unStorePathName nm + ] + +makeType + :: StoreDir + -> ByteString + -> References + -> ByteString +makeType storeDir ty refs = + Data.ByteString.intercalate ":" $ ty : (others ++ self) + where + others = Data.List.sort + $ fmap (System.Nix.StorePath.storePathToRawFilePath storeDir) + $ Data.HashSet.toList + $ references_others refs + self = ["self" | references_self refs] + +makeFixedOutputPath + :: StoreDir + -> ContentAddressMethod + -> DSum HashAlgo Digest + -> References + -> StorePathName + -> StorePath +makeFixedOutputPath storeDir method digest@(hashAlgo :=> h) refs = + makeStorePath storeDir ty digest' + where + (ty, digest') = case method of + ContentAddressMethod_Text -> + case hashAlgo of + HashAlgo_SHA256 + | references_self refs == False -> (makeType storeDir "text" refs, digest) + _ -> error "unsupported" -- TODO do better; maybe we'll just remove this restriction too? + _ -> + if method == ContentAddressMethod_NixArchive + && Some hashAlgo == Some HashAlgo_SHA256 + then (makeType storeDir "source" refs, digest) + else let + h' = + Crypto.Hash.hash @ByteString @SHA256 + $ "fixed:out:" + <> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.algoToText hashAlgo) + <> (if method == ContentAddressMethod_NixArchive then ":r:" else ":") + <> Data.Text.Encoding.encodeUtf8 (System.Nix.Hash.encodeDigestWith Base16 h) + <> ":" + in ("output:out", HashAlgo_SHA256 :=> h') diff --git a/src/System/Nix/StorePath/Metadata.hs b/src/System/Nix/StorePath/Metadata.hs --- a/src/System/Nix/StorePath/Metadata.hs +++ b/src/System/Nix/StorePath/Metadata.hs @@ -15,7 +15,7 @@ import GHC.Generics (Generic) import System.Nix.Hash (HashAlgo) -import System.Nix.Signature (NarSignature) +import System.Nix.Signature (NamedSignature) import System.Nix.ContentAddress (ContentAddress) -- | How much do we trust the path, based on its provenance? @@ -50,7 +50,7 @@ -- -- There is no guarantee from this type alone that these -- signatures are valid. - metadataSigs :: !(Set NarSignature) + metadataSigs :: !(Set NamedSignature) , -- | Whether and how this store path is content-addressable. -- -- There is no guarantee from this type alone that this address diff --git a/tests/ContentAddressed.hs b/tests/ContentAddressed.hs new file mode 100644 --- /dev/null +++ b/tests/ContentAddressed.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ContentAddressed where + +import Data.Default.Class (Default(def)) +import Test.Hspec (Spec, describe, it, shouldBe) + +import Crypto.Hash (hash, Digest) +import Data.ByteString (ByteString) +import Data.Dependent.Sum (DSum(..)) +import System.Nix.Hash (HashAlgo(..)) +import System.Nix.StorePath (StorePath, StorePathName) +import System.Nix.StorePath.ContentAddressed +import System.Nix.ContentAddress (ContentAddressMethod(..)) + +import Data.HashSet qualified +import System.Nix.StorePath qualified + +testDigest :: DSum HashAlgo Digest +testDigest = HashAlgo_SHA256 :=> Crypto.Hash.hash @ByteString "testDigest" + +testName :: StorePathName +testName = + either undefined id + $ System.Nix.StorePath.mkStorePathName "testFixed" + +testPath :: StorePath +testPath = + either undefined id + $ System.Nix.StorePath.parsePathFromText + def + "/nix/store/9472ijanf79nlkb5n1yh57s7867p1930-testFixed" + +testPath2 :: StorePath +testPath2 = + either undefined id + $ System.Nix.StorePath.parsePathFromText + def + "/nix/store/iali40m5597kikibjxw8cx1ssxlqnii3-testFixed" + +spec_contentAddressed :: Spec +spec_contentAddressed = do + describe "ContentAddressed" $ do + it "makeStorePath computes correct StorePath" $ + (pure + $ makeStorePath + def + "test" + testDigest + testName + ) + `shouldBe` + System.Nix.StorePath.parsePathFromText + def + "/nix/store/iali40m5597kikibjxw8cx1ssxlqnii3-testFixed" + + describe "makeTextPath" $ do + it "computes correct StorePath for empty refs" $ + (pure + $ makeFixedOutputPath + def + ContentAddressMethod_Text + testDigest + mempty + testName + ) + `shouldBe` + System.Nix.StorePath.parsePathFromText + def + "/nix/store/ync87sfmahhaqwnykzwbk31q96drm9vn-testFixed" + + it "computes correct StorePath for nonempty refs" $ + (pure + $ makeFixedOutputPath + def + ContentAddressMethod_Text + testDigest + (References + { references_others = Data.HashSet.fromList [ testPath, testPath2 ] + , references_self = False + }) + testName + ) + `shouldBe` + System.Nix.StorePath.parsePathFromText + def + "/nix/store/jcvh84zapqndh8hva515d4y41s07n2g8-testFixed" + + describe "makeFixedOutputPath" $ do + it "computes correct StorePath, recursive" $ + (pure + $ makeFixedOutputPath + def + ContentAddressMethod_NixArchive + testDigest + mempty + testName + ) + `shouldBe` + System.Nix.StorePath.parsePathFromText + def + "/nix/store/c0cgdqy9i3smyh3as8c4s6fg6nvwdpzy-testFixed" + + it "computes correct StorePath, non-recursive" $ + (pure + $ makeFixedOutputPath + def + ContentAddressMethod_Flat + testDigest + mempty + testName + ) + `shouldBe` + System.Nix.StorePath.parsePathFromText + def + "/nix/store/9472ijanf79nlkb5n1yh57s7867p1930-testFixed" + + it "computeStorePathForText computes correct StorePath" $ + (pure + $ makeFixedOutputPath + def + ContentAddressMethod_Text + (HashAlgo_SHA256 :=> Crypto.Hash.hash ("test" :: ByteString)) + (References + { references_others = Data.HashSet.fromList [ testPath ] + , references_self = False + }) + testName + ) + `shouldBe` + System.Nix.StorePath.parsePathFromText + def + "/nix/store/838lq5qh5a88wsalcjpmj33bcnmpz3pc-testFixed" diff --git a/tests/Derivation.hs b/tests/Derivation.hs deleted file mode 100644 --- a/tests/Derivation.hs +++ /dev/null @@ -1,42 +0,0 @@ - -module Derivation where - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Golden (goldenVsFile) - -import System.Nix.Derivation (parseDerivation, buildDerivation) - -import Data.Default.Class (Default(def)) -import qualified Data.Attoparsec.Text.Lazy -import qualified Data.Text.Lazy.IO -import qualified Data.Text.Lazy.Builder - -processDerivation :: FilePath -> FilePath -> IO () -processDerivation source dest = do - contents <- Data.Text.Lazy.IO.readFile source - either - fail - (Data.Text.Lazy.IO.writeFile dest - . Data.Text.Lazy.Builder.toLazyText - . buildDerivation def - ) - (Data.Attoparsec.Text.Lazy.parseOnly - (parseDerivation def) - contents - ) - -test_derivation :: TestTree -test_derivation = - testGroup "golden" $ fmap mk [0 .. 1] - where - mk :: Int -> TestTree - mk n = - goldenVsFile - ("derivation roundtrip of " <> drv) - drv - act - (processDerivation drv act) - where - drv = fp <> show n <> ".drv" - act = fp <> show n <> ".actual" - fp = "tests/samples/example" diff --git a/tests/Fingerprint.hs b/tests/Fingerprint.hs --- a/tests/Fingerprint.hs +++ b/tests/Fingerprint.hs @@ -16,10 +16,10 @@ import Data.Time.Calendar.OrdinalDate (fromOrdinalDate) import Test.Hspec -import qualified Crypto.PubKey.Ed25519 as Ed25519 -import qualified Data.HashSet as HashSet -import qualified Data.Set as Set -import qualified Data.Text.Encoding as Text +import Crypto.PubKey.Ed25519 qualified as Ed25519 +import Data.HashSet qualified as HashSet +import Data.Set qualified as Set +import Data.Text.Encoding qualified as Text spec_fingerprint :: Spec spec_fingerprint = do @@ -34,7 +34,7 @@ Signature sig' = case sig - <$> filter (\(NarSignature publicKey _) -> publicKey == "cache.nixos.org-1") + <$> filter (\(NamedSignature publicKey _) -> publicKey == "cache.nixos.org-1") (Set.toList (metadataSigs exampleMetadata)) of (x:_) -> x @@ -55,7 +55,7 @@ , metadataRegistrationTime = UTCTime (fromOrdinalDate 0 0) 0 , metadataNarBytes = Just 196040 , metadataTrust = BuiltElsewhere - , metadataSigs = Set.fromList $ forceRight . parseNarSignature <$> ["cache.nixos.org-1:TsTTb3WGTZKphvYdBHXwo6weVILmTytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==", "test1:519iiVLx/c4Rdt5DNt6Y2Jm6hcWE9+XY69ygiWSZCNGVcmOcyL64uVAJ3cV8vaTusIZdbTnYo9Y7vDNeTmmMBQ=="] + , metadataSigs = Set.fromList $ forceRight . parseNamedSignature <$> ["cache.nixos.org-1:TsTTb3WGTZKphvYdBHXwo6weVILmTytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==", "test1:519iiVLx/c4Rdt5DNt6Y2Jm6hcWE9+XY69ygiWSZCNGVcmOcyL64uVAJ3cV8vaTusIZdbTnYo9Y7vDNeTmmMBQ=="] , metadataContentAddress = Nothing } diff --git a/tests/Hash.hs b/tests/Hash.hs --- a/tests/Hash.hs +++ b/tests/Hash.hs @@ -7,10 +7,10 @@ import Control.Monad (forM_) import Crypto.Hash (MD5, SHA1, SHA256, hash) -import qualified Data.ByteString.Base16 as B16 -import qualified System.Nix.Base32 as B32 -import qualified Data.ByteString.Base64.Lazy as B64 -import qualified Data.ByteString.Lazy as BSL +import Data.ByteString.Base16 qualified as B16 +import System.Nix.Base32 qualified as B32 +import Data.ByteString.Base64.Lazy qualified as B64 +import Data.ByteString.Lazy qualified as BSL import System.Nix.Base diff --git a/tests/Placeholder.hs b/tests/Placeholder.hs new file mode 100644 --- /dev/null +++ b/tests/Placeholder.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Placeholder where + +import Data.Text (Text) + +import System.Nix.OutputName +import System.Nix.Placeholder +import System.Nix.StorePath +import Test.Hspec + +spec_hash :: Spec +spec_hash = + describe "placeholder" $ do + it "output called 'object'" $ do + let objectPlaceholder = "/07fvp8gkd5mhhfi1lqjfwq7sxnpmdfczz27lizfxiz6fpwad8sy4" + shouldBe (renderPlaceholder $ createPlaceholder (OutputName $ unsafeName "object")) + objectPlaceholder + it "output called 'interface'" $ do + let interfacePlaceholder = "/1ang7n5l91vn079693l42ahmcxgf34r0qad1l01y4lf7d3cwm5lg" + shouldBe (renderPlaceholder $ createPlaceholder (OutputName $ unsafeName "interface")) + interfacePlaceholder + +-- | Unsafely create a StorePathName, erroring on invalid input. +-- Only use in tests with known-good literals. +unsafeName :: Text -> StorePathName +unsafeName = either (error . show) id . mkStorePathName + +spec_nixhash :: Spec +spec_nixhash = + describe "downstream placeholder" $ do + it "known derivation, unknown output store path (CA)" $ do + Right p <- pure $ parsePathFromText (StoreDir "/nix/store") "/nix/store/g1w7hy3qg1w7hy3qg1w7hy3qg1w7hy3q-foo.drv" + let dp = renderDownstreamPlaceholder $ unknownCaOutput p (OutputName $ unsafeName "out") + shouldBe dp "/0c6rn30q4frawknapgwq386zq358m8r6msvywcvc89n6m5p2dgbz" + + it "unknown derivation" $ do + Right p <- pure $ parsePathFromText (StoreDir "/nix/store") "/nix/store/g1w7hy3qg1w7hy3qg1w7hy3qg1w7hy3q-foo.drv.drv" + let dp = renderDownstreamPlaceholder $ unknownDerivation (unknownCaOutput p (OutputName $ unsafeName "out")) (OutputName $ unsafeName "out") + shouldBe dp "/0gn6agqxjyyalf0dpihgyf49xq5hqxgw100f0wydnj6yqrhqsb3w" + diff --git a/tests/Signature.hs b/tests/Signature.hs --- a/tests/Signature.hs +++ b/tests/Signature.hs @@ -5,11 +5,11 @@ module Signature where -import qualified Data.ByteString as BS +import Data.ByteString qualified as BS import Test.Hspec import Data.Text (Text) -import qualified Crypto.PubKey.Ed25519 -import qualified System.Nix.Base +import Crypto.PubKey.Ed25519 qualified +import System.Nix.Base qualified import System.Nix.Base (BaseEncoding(Base64)) import Crypto.Error (CryptoFailable(..)) @@ -54,24 +54,24 @@ pubkeyNixosOrg = forceDecodeB64Pubkey "6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=" shouldNotParse :: Text -> Expectation -shouldNotParse encoded = case parseNarSignature encoded of +shouldNotParse encoded = case parseNamedSignature encoded of Left _ -> pure () Right _ -> expectationFailure "should not have parsed" shouldParseName :: Text -> Text -> Expectation -shouldParseName encoded name = case parseNarSignature encoded of +shouldParseName encoded name = case parseNamedSignature encoded of Left err -> expectationFailure err Right narSig -> shouldBe name (publicKey narSig) shouldVerify :: Text -> Crypto.PubKey.Ed25519.PublicKey -> BS.ByteString -> Expectation -shouldVerify encoded pubkey msg = case parseNarSignature encoded of +shouldVerify encoded pubkey msg = case parseNamedSignature encoded of Left err -> expectationFailure err Right narSig -> let (Signature sig') = sig narSig in sig' `shouldSatisfy` Crypto.PubKey.Ed25519.verify pubkey msg shouldNotVerify :: Text -> Crypto.PubKey.Ed25519.PublicKey -> BS.ByteString -> Expectation -shouldNotVerify encoded pubkey msg = case parseNarSignature encoded of +shouldNotVerify encoded pubkey msg = case parseNamedSignature encoded of Left err -> expectationFailure err Right narSig -> let (Signature sig') = sig narSig diff --git a/tests/StorePath.hs b/tests/StorePath.hs --- a/tests/StorePath.hs +++ b/tests/StorePath.hs @@ -4,7 +4,7 @@ module StorePath where import Test.Hspec (Spec, describe, it, shouldBe) -import qualified Data.Text +import Data.Text qualified import System.Nix.StorePath (parseNameText, InvalidNameError(..))