diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,207 @@ +# [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: + * `System.Nix.StorePath.makeStorePathName` renamed to `System.Nix.StorePath.mkStorePathName` + * `System.Nix.ReadOnlyStore` moved to `hnix-store-readonly` package + and renamed to `System.Nix.Store.ReadOnly` [#247](https://github.com/haskell-nix/hnix-store/pull/247) + * `System.Nix.Nar*` moved to `hnix-store-nar` package [#247](https://github.com/haskell-nix/hnix-store/pull/247) + * `Arbitrary` instances moved to `hnix-store-tests` package [#241](https://github.com/haskell-nix/hnix-store/pull/241) + * `System.Nix.Internal` namespace was removed [#236](https://github.com/haskell-nix/hnix-store/pull/236) + * `StorePathMetadata` converted to `Metadata a` [#231](https://github.com/haskell-nix/hnix-store/pull/231) + * Moved to `System.Nix.StorePath.Metadata` [#236](https://github.com/haskell-nix/hnix-store/pull/236) + * Constructors of `StorePathName` and `StorePathHashPart` are no longer + exported. Use respective `mkStorePath..` functions. [#230](https://github.com/haskell-nix/hnix-store/pull/230) + * `StorePath` constructor is no longer exported. + Prefer `parsePath` or `parsePathFromText`. + If needed to construct a path directly, use `unsafeMakeStorePath` [#247](https://github.com/haskell-nix/hnix-store/pull/247) + * `StorePathSet` type alias is no more, use `HashSet StorePath` [#230](https://github.com/haskell-nix/hnix-store/pull/230) + * `makeStorePath` and `parsePath` now returns `Either InvalidPathError StorePath` [#231](https://github.com/haskell-nix/hnix-store/pull/231) + * `BuildResult`s `timesBuild` field changes type from `Integer` to `Int` [#231](https://github.com/haskell-nix/hnix-store/pull/231) + +* Additions: + * `System.Nix.Store.Types` with `FileIngestionMethod`, `PathFilter`, `RepairMode` types [#247](https://github.com/haskell-nix/hnix-store/pull/247) + `FileIngestionMethod` was previously called `NarHashMode` + * `System.Nix.StorePath.parsePathFromText` [#236](https://github.com/haskell-nix/hnix-store/pull/236) + * `Default StoreDir` instance [#231](https://github.com/haskell-nix/hnix-store/pull/231) + * `System.Nix.StorePath.storePathHashPartToText` [#231](https://github.com/haskell-nix/hnix-store/pull/231) + * Added `Generic` and `Show` instances for + `Signature` and `NarSignature` [#231](https://github.com/haskell-nix/hnix-store/pull/231) + * Added `Eq` and `Ord` instances for `SomeNamedDigest` [#231](https://github.com/haskell-nix/hnix-store/pull/231) + * `BuildStatus` grows `NoSubstituters` and `ResolvesToAlreadyValid` constructors [#231](https://github.com/haskell-nix/hnix-store/pull/231) + * `InvalidPathError` replacing previous stringy error [#231](https://github.com/haskell-nix/hnix-store/pull/231) + * Added `Arbitrary` instances for (exported by default) [#230](https://github.com/haskell-nix/hnix-store/pull/230) + * `StorePath` + * `StorePathName` + * `StorePathHashPart` + * `StoreDir` + * Added `Arbitrary` instances for [#231](https://github.com/haskell-nix/hnix-store/pull/231) + * `BuildMode` + * `BuildStatus` + * `BuildResult` + * `Derivation StorePath Text` + * `DerivationOutput StorePath Text` + +# [0.7.0.0](https://github.com/haskell-nix/hnix-store/compare/core-0.6.1.0...core-0.7.0.0) 2023-11-15 + +* Changes: + * `StorePath` no longer carries `storePathRoot` field and we + have a stand-alone `StoreDir` type instead to be used instead of `FilePath` + when store root directory is needed as a context [#216](https://github.com/haskell-nix/hnix-store/pull/216) + +* Fixes: + * NAR encoding and decoding now supports case-insensitive filesystems [#218](https://github.com/haskell-nix/hnix-store/pull/218) + * The "case hack" replicates the behavior of the `use-case-hack` option in Nix, which adds a suffix to conflicting filenames. + This feature is enabled by default on macOS (darwin). + +* Additions: + * `data NarOptions` has been added to configure NAR encoding and decoding. The `optUseCaseHack` field can be used to enable or disable the case hack [#218](https://github.com/haskell-nix/hnix-store/pull/218) + * New `streamNarIOWithOptions` and `runParserWithOptions` functions have been added to `System.Nix.Nar` to support the new configurable options [#218](https://github.com/haskell-nix/hnix-store/pull/218) + +# [0.6.1.0](https://github.com/haskell-nix/hnix-store/compare/core-0.6.0.0...core-0.6.1.0) 2023-01-02 + +* Fixes: + + * NAR serialization compatibility (symlinks, directory symlinks, UTF-8 handling) [#201](https://github.com/haskell-nix/hnix-store/pull/201) [#203](https://github.com/haskell-nix/hnix-store/pull/203) + +# [0.6.0.0](https://github.com/haskell-nix/hnix-store/compare/core-0.5.0.0...core-0.6.0.0) 2022-06-06 + +* Breaking: + + * `streamNarIO` changes type and returns `NarSource m` [#177](https://github.com/haskell-nix/hnix-store/pull/177) + * `FilePath` can turn to `NarSource m` using `dumpPath` + * `ByteString` can turn to `NarSource m` using `dumpString` + +# [0.5.0.0](https://github.com/haskell-nix/hnix-store/compare/0.4.3.0...core-0.5.0.0) 2021-06-10 + +* Breaking: + + * `System.Nix.Hash`: + * Migration from packages `cryptohash-` -> `cryptonite` [#157](https://github.com/haskell-nix/hnix-store/pull/157/commits/97146b41cc87327625e02b81971aeb2fd7d66a3f) + * rm `newtype Digest` in favour of `cryptonite: newtype Digest` + * rm `data HashAlgorithm` in favour of `cryptonite: class HashAlgorithm` + * rm `class ValidAlgo` in favour of `cryptonite: class HashAlgorithm`. + * `class NamedAlgo` removed `hashSize` in favour of `cryptonite: class HashAlgorithm: hashDigestSize`. Former became a subclass of the latter. + * rm `hash` in favour of `cryptonite: hash` + * rm `hashLazy` in favour of `cryptonite: hashlazy` + * Base encoding/decoding function for hashes (digests) changed (due to changes in type system & separation of specially truncated Nix Store hasing) [#157](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) + * `encode(InBase -> DigestWith)` + * `decode(Base -> DigestWith)` + * `System.Nix.StorePath` [#157](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) + * rm `type StorePathHashAlgo = 'Truncated 20 'SHA256` in favour of `StorePathHashPart` & `mkStorePathHashPart`. + * rm `unStorePathName`, please use `GHC: coerce` for `StorePathName <-> Text`, `StorePathName` data constructor is provided. + * `Internal` modules now have export lists, if something, please contact. + +* Additional: + + * Support of GHC 9.0 [#157](https://github.com/haskell-nix/hnix-store/pull/157/commits/97146b41cc87327625e02b81971aeb2fd7d66a3f) + * `System.Nix.StorePath` [#157](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) + * exposed `StorePathName` data constructor to API. + * added `newtype StorePathHashPart = StorePathHashPart ByteString`. + * added builder `mkStorePathHashPart :: ByteString -> StorePathHashPart` + * `System.Nix.Hash` [#157](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) + * Nix store (which are specially truncated) hashes are now handled separately from other hashes: + * add `mkStorePathHash` - a function to create a content into Nix storepath-style hash: + `mkStorePathHash :: HashAlgorithm a => ByteString -> ByteString` + but recommend to at once use `mkStorePathHashPart`. + +# [0.4.3.0](https://github.com/haskell-nix/hnix-store/compare/0.4.2.0...0.4.3.0) 2021-05-30 + +* Additional: + * `System.Nix.ReadonlyStore`: add a readonly `computeStorePathForPath` [b85f7c8](https://github.com/haskell-nix/hnix-store/commit/b85f7c875fe6b0bca939ffbcd8b9bd0ab1598aa0) + * `System.Nix.ReadonlyStore`: `computeStorePathForPath`: force SHA256 as it's the only valid choice [db71ece](https://github.com/haskell-nix/hnix-store/commit/db71ecea3109c0ba270fa98a9041a8556e35217f) + * `makeTextPath`: order the references [5fddf3c](https://github.com/haskell-nix/hnix-store/commit/5fddf3c66ba1bcabb72c4d6b6e09fb41a7acd62c) + +# [0.4.2.0](https://github.com/haskell-nix/hnix-store/compare/0.4.1.0...0.4.2.0) 2021-03-12 + +* Additional: + * Cabal now properly states `tasty-discover` as `build-tool-depends` [5d03ffc](https://github.com/haskell-nix/hnix-store/commit/5d03ffc4cde9448df05e84838ece70cc83b1b6c) + * Added explicit `hie.yml` cradle description for `cabal` to help Haskell Language Server to work with monorepo [5bad385](https://github.com/haskell-nix/hnix-store/commit/b5ad38573d27e0732d0fadfebd98de1f753b4f07) + * Removed vacuous `Setup.hs`, it was throwing-off HLS, and anyway file is vacuous and gets deprecated by Cabal itself [a5b7a61](https://github.com/haskell-nix/hnix-store/commit/a5b7a614c0e0e11147a93b9a197c2a443afa3244) + * Nix dev env: removed GHC 8.6.5 support, afaik it is not even in Nixpkgs anymore [cf04083](https://github.com/haskell-nix/hnix-store/commit/cf04083aba98ad40d183d1e26251101816cc07ae) + * Test suite: fixed nar test for the envs without `/proc` (test suite now works on `macOS`) [2a897ab](https://github.com/haskell-nix/hnix-store/commit/2a897ab581c0501587ce04da6d6e3a6f543b1d72) + + +# [0.4.1.0](https://github.com/haskell-nix/hnix-store/compare/0.4.0.0...0.4.1.0) 2021-01-16 + +* Big clean-up of dependencies. + +# [0.4.0.0](https://github.com/haskell-nix/hnix-store/compare/0.3.0.0...0.4.0.0) 2020-12-30 + +* `System.Nix.Hash` no longer exports `encodeBase16, decodeBase16` and their `Base32` counterparts. + These were replaced by `encodeInBase` and `decodeBase` functions + accepting `BaseEncoding` data type [#87](https://github.com/haskell-nix/hnix-store/pull/87) +* Support `base16-bytestring >= 1` [#86](https://github.com/haskell-nix/hnix-store/pull/86) [#100](https://github.com/haskell-nix/hnix-store/pull/100) + +# 0.3.0.0 -- 2020-11-29 + +* `System.Nix.Nar` changes API to support NAR format streaming: + * `buildNarIO :: FilePath -> Handle -> IO ()` - Create a NAR from a regular filesystem object, stream it out on the Handle + * `unpackNarIO :: Handle -> FilePath -> IO ()` - Recreate filesystem object from a NAR file accessed by the Handle +* `StorePath` type changed to simple variant without type level +symbolic store path root. +* Added `makeFixedOutputPath` to `System.Nix.ReadonlyStore` +* Added `decodeBase16` and `decodeBase32` to `System.Nix.Hash` +* `System.Nix.StorePath` module now provides + * `storePathToFilePath` and `storePathToText` helpers + * `storePathToNarInfo` for converting paths to `narinfo` URLs + * `parsePath` function + * `pathParser` Attoparsec parser +* Added `System.Nix.Build` module +* Added `System.Nix.Derivation` module +* Removed `System.Nix.Util` module, moved to `hnix-store-remote` +* Added base64 and SHA512 hash support + +# 0.2.0.0 -- 2020-03-12 + +Removed `System.Nix.Store`. We may reintroduce it later when multiple backends +exist and we can tell what common effects they should share. + +# 0.1.0.0 -- 2019-03-18 + +* First version. + +--- + +`hnix-store-core` uses [PVP Versioning][1]. + +[1]: https://pvp.haskell.org diff --git a/ChangeLog.md b/ChangeLog.md deleted file mode 100644 --- a/ChangeLog.md +++ /dev/null @@ -1,98 +0,0 @@ -# ChangeLog - -## [0.5.0.0](https://github.com/haskell-nix/hnix-store/compare/0.4.3.0...core-0.5.0.0) 2021-06-10 - -* Breaking: - - * `System.Nix.Hash`: - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/97146b41cc87327625e02b81971aeb2fd7d66a3f) Migration from packages `cryptohash-` -> `cryptonite`: - * rm `newtype Digest` in favour of `cryptonite: newtype Digest` - * rm `data HashAlgorithm` in favour of `cryptonite: class HashAlgorithm` - * rm `class ValidAlgo` in favour of `cryptonite: class HashAlgorithm`. - * `class NamedAlgo` removed `hashSize` in favour of `cryptonite: class HashAlgorithm: hashDigestSize`. Former became a subclass of the latter. - * rm `hash` in favour of `cryptonite: hash` - * rm `hashLazy` in favour of `cryptonite: hashlazy` - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) Base encoding/decoding function for hashes (digests) changed (due to changes in type system & separation of specially truncated Nix Store hasing): - * `encode(InBase -> DigestWith)` - * `decode(Base -> DigestWith)` - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.StorePath`: - * rm `type StorePathHashAlgo = 'Truncated 20 'SHA256` in favour of `StorePathHashPart` & `mkStorePathHashPart`. - * rm `unStorePathName`, please use `GHC: coerce` for `StorePathName <-> Text`, `StorePathName` data constructor is provided. - * `Internal` modules now have export lists, if something, please contact. - - -* Additional: - - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/97146b41cc87327625e02b81971aeb2fd7d66a3f) Support of GHC 9.0. - - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.StorePath`: - * exposed `StorePathName` data constructor to API. - * added `newtype StorePathHashPart = StorePathHashPart ByteString`. - * added builder `mkStorePathHashPart :: ByteString -> StorePathHashPart` - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.Hash`: - * Nix store (which are specially truncated) hashes are now handled separately from other hashes: - * add `mkStorePathHash` - a function to create a content into Nix storepath-style hash: - `mkStorePathHash :: HashAlgorithm a => ByteString -> ByteString` - but recommend to at once use `mkStorePathHashPart`. - - -## [0.4.3.0](https://github.com/haskell-nix/hnix-store/compare/0.4.2.0...0.4.3.0) 2021-05-30 - -* Additional: - * [(link)](https://github.com/haskell-nix/hnix-store/commit/b85f7c875fe6b0bca939ffbcd8b9bd0ab1598aa0) `System.Nix.ReadonlyStore`: add a readonly `computeStorePathForPath` - * [(link)](https://github.com/haskell-nix/hnix-store/commit/db71ecea3109c0ba270fa98a9041a8556e35217f) `System.Nix.ReadonlyStore`: `computeStorePathForPath`: force SHA256 as it's the only valid choice - * [(link)](https://github.com/haskell-nix/hnix-store/commit/5fddf3c66ba1bcabb72c4d6b6e09fb41a7acd62c): `makeTextPath`: order the references - -## [0.4.2.0](https://github.com/haskell-nix/hnix-store/compare/0.4.1.0...0.4.2.0) 2021-03-12 - -* Additional: - - * [(link)](https://github.com/haskell-nix/hnix-store/commit/5d03ffc43cde9448df05e84838ece70cc83b1b6c) Cabal now properly states `tasty-discover` as `build-tool-depends`. - - * [(link)](https://github.com/haskell-nix/hnix-store/commit/b5ad38573d27e0732d0fadfebd98de1f753b4f07) added explicit `hie.yml` cradle description for `cabal` to help Haskell Language Server to work with monorepo. - - * [(link)](https://github.com/haskell-nix/hnix-store/commit/a5b7a614c0e0e11147a93b9a197c2a443afa3244) rm vacuous `Setup.hs`, it was throwing-off HLS, and anyway file is vacuous and gets deprecated by Cabal itself. - - * [(link)](https://github.com/haskell-nix/hnix-store/commit/cf04083aba98ad40d183d1e26251101816cc07ae) Nix dev env: removed GHC 8.6.5 support, afaik it is not even in Nixpkgs anymore. - - * [(link)](https://github.com/haskell-nix/hnix-store/commit/2a897ab581c0501587ce04da6d6e3a6f543b1d72) Test suite: fixed nar test for the envs without `/proc` (test suite now works on `macOS`). - - -## [0.4.1.0](https://github.com/haskell-nix/hnix-store/compare/0.4.0.0...0.4.1.0) 2021-01-16 - -* Big clean-up of dependencies. - -## [0.4.0.0](https://github.com/haskell-nix/hnix-store/compare/0.3.0.0...0.4.0.0) 2020-12-30 - -* `System.Nix.Hash` no longer exports `encodeBase16, decodeBase16` and their `Base32` counterparts. - These were replaced by `encodeInBase` and `decodeBase` functions - accepting `BaseEncoding` data type [#87](https://github.com/haskell-nix/hnix-store/pull/87) -* Support `base16-bytestring >= 1` [#86](https://github.com/haskell-nix/hnix-store/pull/86) [#100](https://github.com/haskell-nix/hnix-store/pull/100) - -## 0.3.0.0 -- 2020-11-29 - -* `System.Nix.Nar` changes API to support NAR format streaming: - * `buildNarIO :: FilePath -> Handle -> IO ()` - Create a NAR from a regular filesystem object, stream it out on the Handle - * `unpackNarIO :: Handle -> FilePath -> IO ()` - Recreate filesystem object from a NAR file accessed by the Handle -* `StorePath` type changed to simple variant without type level -symbolic store path root. -* Added `makeFixedOutputPath` to `System.Nix.ReadonlyStore` -* Added `decodeBase16` and `decodeBase32` to `System.Nix.Hash` -* `System.Nix.StorePath` module now provides - * `storePathToFilePath` and `storePathToText` helpers - * `storePathToNarInfo` for converting paths to `narinfo` URLs - * `parsePath` function - * `pathParser` Attoparsec parser -* Added `System.Nix.Build` module -* Added `System.Nix.Derivation` module -* Removed `System.Nix.Util` module, moved to `hnix-store-remote` -* Added base64 and SHA512 hash support - -## 0.2.0.0 -- 2020-03-12 - -Removed `System.Nix.Store`. We may reintroduce it later when multiple backends -exist and we can tell what common effects they should share. - -## 0.1.0.0 -- 2019-03-18 - -* First version. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,14 +1,5 @@ # hnix-store-core -Core effects for interacting with the Nix store. - -See `NarEffects` in [System.Nix.Internal.Nar.Effects] and the [System.Nix.StorePath] for the available operations -on the store. +Core types and functions for interacting with the Nix store. -[System.Nix.Internal.Nar.Effects]: ./src/System/Nix/Internal/Nar/Effects.hs [System.Nix.StorePath]: ./src/System/Nix/StorePath.hs - - -# Tests - - - `ghcid --command "cabal repl test-suite:format-tests" --test="Main.main"` diff --git a/hnix-store-core.cabal b/hnix-store-core.cabal --- a/hnix-store-core.cabal +++ b/hnix-store-core.cabal @@ -1,96 +1,119 @@ cabal-version: 2.2 name: hnix-store-core -version: 0.5.0.0 -synopsis: Core effects for interacting with the Nix store. +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 - interactions with the Nix store abstracted away from - specific effectful context. + interactions with the Nix store. homepage: https://github.com/haskell-nix/hnix-store license: Apache-2.0 license-file: LICENSE author: Shea Levy -maintainer: shea@shealevy.com +maintainer: srk@48.io copyright: 2018 Shea Levy category: Nix build-type: Simple +extra-doc-files: + CHANGELOG.md extra-source-files: - ChangeLog.md - , README.md + README.md , tests/samples/example0.drv , tests/samples/example1.drv -Common commons - if impl(ghc >= 8.10) - ghc-options: -Wall -Wunused-packages - else - ghc-options: -Wall +common commons + ghc-options: -Wall + default-extensions: + ConstraintKinds + , BangPatterns + , DataKinds + , DeriveDataTypeable + , DeriveFoldable + , DeriveFunctor + , DeriveGeneric + , DeriveLift + , DeriveTraversable + , DerivingStrategies + , DerivingVia + , ExistentialQuantification + , ImportQualifiedPost + , FlexibleContexts + , FlexibleInstances + , GADTs + , ImportQualifiedPost + , InstanceSigs + , KindSignatures + , LambdaCase + , MultiParamTypeClasses + , MultiWayIf + , RecordWildCards + , ScopedTypeVariables + , StandaloneDeriving + , TupleSections + , TypeApplications + , TypeFamilies + , TypeOperators + , TypeSynonymInstances + , ViewPatterns + default-language: Haskell2010 library import: commons exposed-modules: - System.Nix.Base32 + System.Nix.Base + , System.Nix.Base32 , System.Nix.Build + , System.Nix.ContentAddress , System.Nix.Derivation + , System.Nix.DerivedPath + , System.Nix.Placeholder + , System.Nix.Fingerprint + , System.Nix.FileContentAddress , System.Nix.Hash - , System.Nix.Internal.Base - , System.Nix.Internal.Base32 - , System.Nix.Internal.Truncation - , System.Nix.Internal.Hash - , System.Nix.Internal.Nar.Parser - , System.Nix.Internal.Nar.Streamer - , System.Nix.Internal.Nar.Effects - , System.Nix.Internal.Signature - , System.Nix.Internal.StorePath - , System.Nix.Nar - , System.Nix.ReadonlyStore + , System.Nix.Hash.Truncation + , System.Nix.OutputName + , System.Nix.Realisation , System.Nix.Signature + , System.Nix.Store.Types , System.Nix.StorePath - , System.Nix.StorePathMetadata + , System.Nix.StorePath.ContentAddressed + , System.Nix.StorePath.Metadata build-depends: - base >=4.10 && <5 + base >=4.12 && <5 , attoparsec - , algebraic-graphs >= 0.5 && < 0.6 - , base16-bytestring - , base64-bytestring + , base16-bytestring >= 1.0 + , base64-bytestring >= 1.2.1 , bytestring - , cereal + , constraints-extras , containers - -- Required for cryptonite low-level type convertion - , memory - , cryptonite - , directory + , 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 - , lifted-base - , monad-control - , mtl - , nix-derivation >= 1.1.1 && <2 - , saltine - , time + , monoidal-containers + -- Required for crypton low-level type conversion + , ram >= 0.20.1 + , some > 1.0.5 && < 2 + , these , text - , unix + , time , unordered-containers , vector hs-source-dirs: src - default-language: Haskell2010 -Flag bounded_memory - description: Run tests of constant memory use (requires +RTS -T) - default: False - -test-suite format-tests +test-suite core import: commons - if flag(bounded_memory) - cpp-options: -DBOUNDED_MEMORY - ghc-options: -rtsopts -fprof-auto type: exitcode-stdio-1.0 main-is: Driver.hs other-modules: - Arbitrary - Derivation - NarFormat + ContentAddressed + Fingerprint Hash + Placeholder + Signature StorePath hs-source-dirs: tests @@ -98,24 +121,17 @@ tasty-discover:tasty-discover build-depends: hnix-store-core - , attoparsec , base , base16-bytestring , base64-bytestring - , binary , bytestring , containers - , cryptonite - , directory - , filepath - , process - , tasty - , tasty-golden + , crypton + , data-default-class + , dependent-sum , hspec - , tasty-hspec - , tasty-hunit - , tasty-quickcheck - , temporary + , tasty + , tasty-hspec >= 1.1 , text - , unix - default-language: Haskell2010 + , time + , unordered-containers diff --git a/src/System/Nix/Base.hs b/src/System/Nix/Base.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Base.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE OverloadedStrings #-} +module System.Nix.Base + ( BaseEncoding(Base16,NixBase32,Base64) + , baseEncodingToText + , textToBaseEncoding + , encodeWith + , decodeWith + ) where + +import Data.ByteString (ByteString) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Data.Text qualified +import Data.Text.Encoding qualified +import Data.ByteString.Base16 qualified +import Data.ByteString.Base64 qualified + +import System.Nix.Base32 qualified -- Nix has own Base32 encoding + +-- | Constructors to indicate the base encodings +data BaseEncoding + = NixBase32 + -- | ^ Nix has a special map of Base32 encoding + -- Placed first, since it determines Haskell optimizations of pattern matches, + -- & NixBase seems be the most widely used in Nix. + | 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 +encodeWith Base16 = + Data.Text.Encoding.decodeUtf8 + . Data.ByteString.Base16.encode +encodeWith NixBase32 = System.Nix.Base32.encode +encodeWith Base64 = + Data.Text.Encoding.decodeUtf8 + . Data.ByteString.Base64.encode + +-- | Take the input & @Base@ encoding witness -> decode into @Text@. +decodeWith :: BaseEncoding -> Text -> Either String ByteString +decodeWith Base16 = + Data.ByteString.Base16.decode + . Data.Text.Encoding.encodeUtf8 +decodeWith NixBase32 = System.Nix.Base32.decode +decodeWith Base64 = + Data.ByteString.Base64.decode + . Data.Text.Encoding.encodeUtf8 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 @@ -4,7 +4,97 @@ module System.Nix.Base32 ( encode , decode - ) -where + , digits32 + ) where -import System.Nix.Internal.Base32 +import Data.ByteString (ByteString) +import Data.Text (Text) +import Data.Vector (Vector) +import Data.Word (Word8) + +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 +digits32 = Data.Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz" + +-- | Encode a 'BS.ByteString' in Nix's base32 encoding +encode :: ByteString -> Text +encode c = Data.Text.pack $ takeCharPosFromDict <$> [nChar - 1, nChar - 2 .. 0] + where + -- Each base32 character gives us 5 bits of information, while + -- each byte gives is 8. Because 'div' rounds down, we need to add + -- one extra character to the result, and because of that extra 1 + -- we need to subtract one from the number of bits in the + -- bytestring to cover for the case where the number of bits is + -- already a factor of 5. Thus, the + 1 outside of the 'div' and + -- the - 1 inside of it. + nChar = fromIntegral $ ((Data.ByteString.length c * 8 - 1) `div` 5) + 1 + + byte = Data.ByteString.index c . fromIntegral + + -- May need to switch to a more efficient calculation at some + -- point. + bAsInteger :: Integer + bAsInteger = + sum + [ fromIntegral (byte j) * (256 ^ j) + | j <- [0 .. Data.ByteString.length c - 1] ] + + takeCharPosFromDict :: Integer -> Char + takeCharPosFromDict i = digits32 Data.Vector.! digitInd + where + digitInd = + fromIntegral $ + bAsInteger `div` (32^i) `mod` 32 + +-- | Decode Nix's base32 encoded text +decode :: Text -> Either String ByteString +decode what = + Data.Bool.bool + (Left "Invalid NixBase32 string") + (unsafeDecode what) + (Data.Text.all (`elem` digits32) what) + +-- | Decode Nix's base32 encoded text +-- Doesn't check if all elements match `digits32` +unsafeDecode :: Text -> Either String ByteString +unsafeDecode what = + case + Numeric.readInt + 32 + (`elem` digits32) + (\c -> Data.Maybe.fromMaybe (error "character not in digits32") + $ Data.Vector.findIndex (== c) digits32 + ) + (Data.Text.unpack what) + of + [(i, _)] -> pure $ padded $ integerToBS i + x -> Left $ "Can't decode: readInt returned " <> show x + where + padded x + | Data.ByteString.length x < decLen = x `Data.ByteString.append` bstr + | otherwise = x + where + bstr = Data.ByteString.Char8.pack $ take (decLen - Data.ByteString.length x) (cycle "\NUL") + + decLen = Data.Text.length what * 5 `div` 8 + +-- | Encode an Integer to a bytestring +-- Similar to Data.Base32String (integerToBS) without `reverse` +integerToBS :: Integer -> ByteString +integerToBS 0 = Data.ByteString.pack [0] +integerToBS i + | i > 0 = Data.ByteString.pack $ Data.List.unfoldr f i + | otherwise = error "integerToBS not defined for negative values" + where + f 0 = Nothing + f x = Just (fromInteger x :: Word8, x `Data.Bits.shiftR` 8) 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 @@ -1,58 +1,94 @@ -{-# LANGUAGE RecordWildCards #-} {-| Description : Build related types Maintainer : srk |-} module System.Nix.Build ( BuildMode(..) - , BuildStatus(..) + , BuildSuccessStatus(..) + , BuildFailureStatus(..) , BuildResult(..) - , buildSuccess - ) -where + , BuildSuccess(..) + , BuildFailure(..) + ) where -import Data.Time ( UTCTime ) -import Data.Text ( Text ) +import Data.Map (Map) +import Data.Time (UTCTime) +import Data.Text (Text) +import Data.Word (Word64) +import GHC.Generics (Generic) --- keep the order of these Enums to match enums from reference implementations +import System.Nix.OutputName (OutputName) +import System.Nix.Realisation (Realisation) + +-- | Mode of the build operation +-- Keep the order of these Enums to match enums from reference implementations -- src/libstore/store-api.hh -data BuildMode = Normal | Repair | Check - deriving (Eq, Ord, Enum, Show) +data BuildMode + = BuildMode_Normal -- ^ Perform normal build + | BuildMode_Repair -- ^ Try to repair corrupted or missing paths by re-building or re-downloading them + | BuildMode_Check -- ^ Check if the build is reproducible (rebuild and compare to previous build) + deriving (Bounded, Eq, Generic, Ord, Enum, Show) -data BuildStatus = - Built - | Substituted - | AlreadyValid - | PermanentFailure - | InputRejected - | OutputRejected - | TransientFailure -- possibly transient - | CachedFailure -- no longer used - | TimedOut - | MiscFailure - | DependencyFailed - | LogLimitExceeded - | NotDeterministic - deriving (Eq, Ord, Enum, Show) +-- | 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 - { -- | build status, MiscFailure should be default - status :: !BuildStatus - , -- | possible build error message - errorMessage :: !(Maybe Text) - , -- | How many times this build was performed - timesBuilt :: !Integer - , -- | If timesBuilt > 1, whether some builds did not produce the same result - isNonDeterministic :: !Bool - , -- Start time of this build - startTime :: !UTCTime - , -- Stop time of this build - stopTime :: !UTCTime + { 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, Ord, Show) - -buildSuccess :: BuildResult -> Bool -buildSuccess BuildResult {..} = - status `elem` [Built, Substituted, AlreadyValid] + deriving (Eq, Generic, Ord, Show) diff --git a/src/System/Nix/ContentAddress.hs b/src/System/Nix/ContentAddress.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/ContentAddress.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE OverloadedStrings #-} + +module System.Nix.ContentAddress ( + ContentAddress (..) + , methodToText + , textToMethod + , ContentAddressMethod (..) + , methodAlgoBuilder + , methodAlgoParser + , contentAddressBuilder + , contentAddressParser + , buildContentAddress + , parseContentAddress + ) 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.Hash qualified + +data ContentAddressMethod + = 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 +-- the contents of the derivation file instead). +-- +-- For backwards-compatibility reasons, the same information is +-- encodable in multiple ways, depending on the method used to add the +-- path to the store. These unfortunately result in separate store +-- paths. +data ContentAddress = ContentAddress + ContentAddressMethod + (DSum HashAlgo Digest) + deriving (Eq, Generic, Ord, Show) + +-- | Marshall `ContentAddressableAddress` to `Text` +-- in form suitable for remote protocol usage. +buildContentAddress :: ContentAddress -> Text +buildContentAddress = + Data.Text.Lazy.toStrict + . Data.Text.Lazy.Builder.toLazyText + . contentAddressBuilder + +-- | 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:" + +-- | 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 +parseContentAddress = + Data.Attoparsec.Text.parseOnly contentAddressParser + +-- | Parser for content addressable field +contentAddressParser :: Parser ContentAddress +contentAddressParser = do + method <- parseContentAddressMethod + _ <- ":" + digest <- parseTypedDigest + case digest of + Left e -> fail e + Right x -> return $ ContentAddress method x + +parseContentAddressMethod :: Parser ContentAddressMethod +parseContentAddressMethod = + (ContentAddressMethod_Text <$ "text") + <|> (ContentAddressMethod_NixArchive <$ "fixed:r") + <|> (ContentAddressMethod_Flat <$ "fixed") + +parseTypedDigest :: Parser (Either String (DSum HashAlgo Digest)) +parseTypedDigest = System.Nix.Hash.mkNamedDigest <$> parseHashType <*> parseHash + where + parseHashType :: Parser Text + parseHashType = + ("sha256" <|> "sha512" <|> "sha1" <|> "md5") <* (":" <|> "-") + + parseHash :: Parser Text + parseHash = Data.Attoparsec.Text.takeWhile1 (/= ':') 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,35 +1,366 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# 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 - ) -where + ( -- * Types + Derivation'(..) + , Derivation + , BasicDerivation -import Data.Text ( Text ) -import qualified Data.Text as Text -import qualified Data.Text.Lazy.Builder as Text.Lazy - ( Builder ) -import qualified Data.Text.Lazy.Builder as Text.Lazy.Builder -import qualified Data.Attoparsec.Text.Lazy as Text.Lazy - ( Parser ) -import Nix.Derivation ( Derivation ) -import qualified Nix.Derivation as Derivation -import System.Nix.StorePath ( StorePath ) -import qualified System.Nix.StorePath as StorePath + , DerivationType(..) + , DerivationOutputs + , InputAddressedDerivationOutput(..) + , FixedDerivationOutput(..) + , ContentAddressedDerivationOutput(..) + , FreeformDerivationOutput(..) + , FreeformDerivationOutputs + , toSpecificOutput + , fromSpecificOutput + , toSpecificOutputs + , fromSpecificOutputs + , DerivationInputs(..) + , derivationInputsFromSingleDerivedPath + , derivationInputsToDerivedPaths -parseDerivation :: FilePath -> Text.Lazy.Parser (Derivation StorePath Text) -parseDerivation expectedRoot = - Derivation.parseDerivationWith - ("\"" *> StorePath.pathParser expectedRoot <* "\"") - Derivation.textParser + , DerivedPathMap(..) + , ChildNode(..) + , derivedPathMapFromSingleDerivedPathBuilt + , derivedPathMapToSet + ) where -buildDerivation :: Derivation StorePath Text -> Text.Lazy.Builder -buildDerivation = - Derivation.buildDerivationWith - (string . Text.pack . show) - string - where - string = Text.Lazy.Builder.fromText . Text.pack . show +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.These (These(..), fromThese) +import Data.Vector (Vector) +import GHC.Generics (Generic, (:.:)(..)) + +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 + +-- | The type of the derivation +data DerivationType :: Type -> Type where + + -- | The outputs are input-addressed. + DerivationType_InputAddressing :: DerivationType InputAddressedDerivationOutput + + -- | 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 + + -- | 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 new file mode 100644 --- /dev/null +++ b/src/System/Nix/DerivedPath.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE OverloadedStrings #-} + +module System.Nix.DerivedPath ( + OutputsSpec(..) + , SingleDerivedPath(..) + , parseSingleDerivedPath + , singleDerivedPathToText + , DerivedPath(..) + , ParseOutputsError(..) + , parseOutputsSpec + , outputsSpecToText + , parseDerivedPath + , derivedPathToText + ) where + +import GHC.Generics (Generic) +import Data.Set (Set) +import Data.Text (Text) +import System.Nix.OutputName (OutputName, InvalidNameError) +import System.Nix.StorePath (StoreDir(..), StorePath, InvalidPathError) + +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 + -- ^ Wildcard spec (^*) meaning all outputs + | OutputsSpec_Names (Set OutputName) + -- ^ 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 SingleDerivedPath OutputsSpec + -- ^ Derivation path and the outputs built from it + deriving (Eq, Generic, Ord, Show) + +data ParseOutputsError = + ParseOutputsError_InvalidPath InvalidPathError + | ParseOutputsError_InvalidName InvalidNameError + | ParseOutputsError_NoNames + | 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 + parseOutputName + (Data.Text.splitOn "," t) + if null names + then Left ParseOutputsError_NoNames + else Right $ OutputsSpec_Names (Data.Set.fromList names) + +outputsSpecToText :: OutputsSpec -> Text +outputsSpecToText = \case + OutputsSpec_All -> "*" + OutputsSpec_Names ns -> + Data.Text.intercalate + "," + (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 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.breakOnEnd "!" woRoot of + (r, suffix) -> + if Data.Text.null r + then DerivedPath_Opaque + <$> (convertError + $ System.Nix.StorePath.parsePathFromText + root + path + ) + else DerivedPath_Built + <$> 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 -> + 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 new file mode 100644 --- /dev/null +++ b/src/System/Nix/Fingerprint.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Description : Fingerprint of Nix store path metadata used for signature verification +-} +module System.Nix.Fingerprint + ( fingerprint + , metadataFingerprint + ) where + +import Crypto.Hash (Digest) +import Data.Dependent.Sum (DSum) +import Data.List (sort) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Text.Lazy (toStrict) +import Data.Text.Lazy.Builder (toLazyText) +import Data.Word (Word64) +import System.Nix.Hash (HashAlgo, algoDigestBuilder) +import System.Nix.StorePath +import System.Nix.StorePath.Metadata (Metadata(..)) + +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 +metadataFingerprint storeDir storePath Metadata{..} = let + narSize = fromMaybe 0 metadataNarBytes + in fingerprint + storeDir + storePath + metadataNarHash + narSize + (HashSet.toList metadataReferences) + +-- | Produce the message signed by a NAR signature +fingerprint :: StoreDir + -> StorePath + -> DSum HashAlgo Digest -- ^ NAR hash + -> Word64 -- ^ NAR size, in bytes + -> [StorePath] -- ^ References + -> Text +fingerprint storeDir storePath narHash narSize refs = let + encodedStorePath = storePathToText storeDir storePath + encodedNarHash = (toStrict . toLazyText . algoDigestBuilder) narHash + encodedNarSize = (Text.pack . show) narSize + sortedRefs = sort (storePathToText storeDir <$> refs) + encodedRefs = Text.intercalate "," sortedRefs + in Text.intercalate ";" [ "1", encodedStorePath, encodedNarHash, encodedNarSize, encodedRefs] + 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 @@ -1,18 +1,200 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| -Description : Cryptographic hashes for hnix-store. +Description : Cryptographic hashing interface for hnix-store, on top + of the cryptohash family of libraries. -} + module System.Nix.Hash - ( Hash.mkStorePathHash - , Hash.NamedAlgo(..) - , Hash.SomeNamedDigest(..) + ( HashAlgo(..) + , NamedAlgo(..) + , algoToText + , textToAlgo + , mkNamedDigest - , Hash.mkNamedDigest + , mkStorePathHash - , Base.BaseEncoding(..) - , Hash.encodeDigestWith - , Hash.decodeDigestWith - ) -where + , System.Nix.Base.BaseEncoding(..) + , encodeDigestWith + , decodeDigestWith -import qualified System.Nix.Internal.Hash as Hash -import qualified System.Nix.Internal.Base as Base + , algoDigestBuilder + , 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)) +import Data.Text (Text) +import Data.Text.Lazy.Builder (Builder) +import System.Nix.Base (BaseEncoding(..)) + +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) +class HashAlgorithm a => NamedAlgo a where + algoName :: Text + +instance NamedAlgo MD5 where + algoName = "md5" + +instance NamedAlgo SHA1 where + algoName = "sha1" + +instance NamedAlgo SHA256 where + algoName = "sha256" + +instance NamedAlgo SHA512 where + algoName = "sha512" + +data HashAlgo :: Type -> Type where + HashAlgo_MD5 :: HashAlgo MD5 + HashAlgo_SHA1 :: HashAlgo SHA1 + HashAlgo_SHA256 :: HashAlgo SHA256 + HashAlgo_SHA512 :: HashAlgo SHA512 + +deriveGEq ''HashAlgo +deriveGCompare ''HashAlgo +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) + +hashAlgoValue :: HashAlgo a -> a +hashAlgoValue = \case + HashAlgo_MD5 -> MD5 + HashAlgo_SHA1 -> SHA1 + HashAlgo_SHA256 -> SHA256 + HashAlgo_SHA512 -> SHA512 + +textToAlgo :: Text -> Either String (Some HashAlgo) +textToAlgo = \case + "md5" -> Right $ Some HashAlgo_MD5 + "sha1" -> Right $ Some HashAlgo_SHA1 + "sha256" -> Right $ Some HashAlgo_SHA256 + "sha512" -> Right $ Some HashAlgo_SHA512 + name -> Left $ "Unknown hash name: " <> Data.Text.unpack name + +-- | Make @DSum HashAlgo Digest@ based on provided SRI hash name +-- and its encoded form +mkNamedDigest + :: Text -- ^ SRI name + -> Text -- ^ base encoded hash + -> Either String (DSum HashAlgo Digest) +mkNamedDigest name sriHash = + let (sriName, h) = Data.Text.breakOnEnd "-" sriHash in + if sriName == "" || sriName == name <> "-" + then mkDigest h + else + Left + $ Data.Text.unpack + $ "Sri hash method" + <> " " + <> sriName + <> " " + <> "does not match the required hash type" + <> " " + <> name + where + mkDigest h = + textToAlgo name + >>= \(Some a) -> has @HashAlgorithm a $ fmap (a :=>) $ decodeGo a h + decodeGo :: HashAlgorithm a => HashAlgo a -> Text -> Either String (Digest a) + decodeGo a h + | size == base16Len = decodeDigestWith Base16 h + | size == base32Len = decodeDigestWith NixBase32 h + | size == base64Len = decodeDigestWith Base64 h + | otherwise = + Left + $ Data.Text.unpack + $ sriHash + <> " " + <> "is not a valid" + <> " " + <> name + <> " " + <> "hash. Its length (" + <> Data.Text.pack (show size) + <> ") does not match any of" + <> " " + <> Data.Text.pack (show [base16Len, base32Len, base64Len]) + where + size = Data.Text.length h + hsize = Crypto.Hash.hashDigestSize (hashAlgoValue a) + base16Len = hsize * 2 + base32Len = ((hsize * 8 - 1) `div` 5) + 1; + base64Len = ((4 * hsize `div` 3) + 3) `div` 4 * 4; + +mkStorePathHash + :: forall a + . HashAlgorithm a + => ByteString + -> ByteString +mkStorePathHash bs = + System.Nix.Hash.Truncation.truncateInNixWay 20 + $ Data.ByteArray.convert + $ Crypto.Hash.hash @ByteString @a bs + +-- | Take BaseEncoding type of the output -> take the Digeest as input -> encode Digest +encodeDigestWith :: BaseEncoding -> Digest a -> Text +encodeDigestWith b = System.Nix.Base.encodeWith b . Data.ByteArray.convert + +-- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into Digest +decodeDigestWith + :: HashAlgorithm a + => BaseEncoding + -> Text + -> Either String (Digest a) +decodeDigestWith b x = + do + bs <- System.Nix.Base.decodeWith b x + let + toEither = + maybeToRight + ("Crypton was not able to convert '(ByteString -> Digest a)' for: '" <> show bs <>"'.") + (toEither . Crypto.Hash.digestFromByteString) bs + where + -- To not depend on @extra@ + maybeToRight :: b -> Maybe a -> Either b a + maybeToRight _ (Just r) = pure r + maybeToRight y Nothing = Left y + +-- | Builder for @Digest@s +digestBuilder :: forall hashAlgo . (NamedAlgo hashAlgo) => Digest hashAlgo -> Builder +digestBuilder digest = + Data.Text.Lazy.Builder.fromText (System.Nix.Hash.algoName @hashAlgo) + <> ":" + <> Data.Text.Lazy.Builder.fromText + (System.Nix.Hash.encodeDigestWith NixBase32 digest) + +-- | Builder for @DSum HashAlgo Digest@s +algoDigestBuilder :: DSum HashAlgo Digest -> Builder +algoDigestBuilder (a :=> d) = has @NamedAlgo a $ digestBuilder d diff --git a/src/System/Nix/Hash/Truncation.hs b/src/System/Nix/Hash/Truncation.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Hash/Truncation.hs @@ -0,0 +1,41 @@ +module System.Nix.Hash.Truncation + ( truncateInNixWay + ) where + +import Data.Word (Word8) +import Data.ByteString (ByteString) + +import Data.ByteString qualified +import Data.Bits qualified +import Data.Bool qualified +import Data.List qualified + +-- | Bytewise truncation of a 'Digest'. +-- +-- When truncation length is greater than the length of the bytestring +-- but less than twice the bytestring length, truncation splits the +-- bytestring into a head part (truncation length) and tail part +-- (leftover part), right-pads the leftovers with 0 to the truncation +-- length, and combines the two strings bytewise with 'xor'. +truncateInNixWay + :: Int -> ByteString -> ByteString +-- 2021-06-07: NOTE: Renamed function, since truncation can be done in a lot of ways, there is no practice of truncting hashes this way, moreover: +-- 1. +-- 2. +truncateInNixWay n c = + Data.ByteString.pack $ fmap truncOutputByte [0 .. n-1] + where + + truncOutputByte :: Int -> Word8 + truncOutputByte i = Data.List.foldl' (aux i) 0 [0 .. Data.ByteString.length c - 1] + + inputByte :: Int -> Word8 + inputByte j = Data.ByteString.index c j + + aux :: Int -> Word8 -> Int -> Word8 + aux i x j = + Data.Bool.bool + id + (`Data.Bits.xor` inputByte j) + (j `mod` n == i) + x diff --git a/src/System/Nix/Internal/Base.hs b/src/System/Nix/Internal/Base.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Base.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE CPP #-} - -module System.Nix.Internal.Base - ( BaseEncoding(Base16,NixBase32,Base64) - , encodeWith - , decodeWith - ) -where - -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Base16 as Base16 -import qualified System.Nix.Base32 as Base32 -- Nix has own Base32 encoding -import qualified Data.ByteString.Base64 as Base64 - --- | Constructors to indicate the base encodings -data BaseEncoding - = NixBase32 - -- | ^ Nix has a special map of Base32 encoding - -- Placed first, since it determines Haskell optimizations of pattern matches, & NixBase seems be the most widely used in Nix. - | Base16 - | Base64 - - --- | Encode @ByteString@ with @Base@ encoding, produce @Text@. -encodeWith :: BaseEncoding -> Bytes.ByteString -> T.Text -encodeWith Base16 = T.decodeUtf8 . Base16.encode -encodeWith NixBase32 = Base32.encode -encodeWith Base64 = T.decodeUtf8 . Base64.encode - --- | Take the input & @Base@ encoding witness -> decode into @Text@. -decodeWith :: BaseEncoding -> T.Text -> Either String Bytes.ByteString -#if MIN_VERSION_base16_bytestring(1,0,0) -decodeWith Base16 = Base16.decode . T.encodeUtf8 -#else -decodeWith Base16 = lDecode -- this tacit sugar simply makes GHC pleased with number of args - where - lDecode t = - case Base16.decode (T.encodeUtf8 t) of - (x, "") -> pure $ x - _ -> Left $ "Unable to decode base16 string" <> T.unpack t -#endif -decodeWith NixBase32 = Base32.decode -decodeWith Base64 = Base64.decode . T.encodeUtf8 diff --git a/src/System/Nix/Internal/Base32.hs b/src/System/Nix/Internal/Base32.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Base32.hs +++ /dev/null @@ -1,99 +0,0 @@ -module System.Nix.Internal.Base32 - ( encode - , decode - , digits32 - ) -where - - -import Data.Bool ( bool ) -import Data.Maybe ( fromMaybe ) -import Data.ByteString ( ByteString ) -import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Char8 as Bytes.Char8 -import qualified Data.Text -import Data.Vector ( Vector ) -import qualified Data.Vector as Vector -import Data.Text ( Text ) -import Data.Bits ( shiftR ) -import Data.Word ( Word8 ) -import Data.List ( unfoldr ) -import Numeric ( readInt ) - - --- omitted: E O U T -digits32 :: Vector Char -digits32 = Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz" - --- | Encode a 'BS.ByteString' in Nix's base32 encoding -encode :: ByteString -> Text -encode c = Data.Text.pack $ takeCharPosFromDict <$> [nChar - 1, nChar - 2 .. 0] - where - -- Each base32 character gives us 5 bits of information, while - -- each byte gives is 8. Because 'div' rounds down, we need to add - -- one extra character to the result, and because of that extra 1 - -- we need to subtract one from the number of bits in the - -- bytestring to cover for the case where the number of bits is - -- already a factor of 5. Thus, the + 1 outside of the 'div' and - -- the - 1 inside of it. - nChar = fromIntegral $ ((Bytes.length c * 8 - 1) `div` 5) + 1 - - byte = Bytes.index c . fromIntegral - - -- May need to switch to a more efficient calculation at some - -- point. - bAsInteger :: Integer - bAsInteger = - sum - [ fromIntegral (byte j) * (256 ^ j) - | j <- [0 .. Bytes.length c - 1] ] - - takeCharPosFromDict :: Integer -> Char - takeCharPosFromDict i = digits32 Vector.! digitInd - where - digitInd = - fromIntegral $ - bAsInteger `div` (32^i) `mod` 32 - --- | Decode Nix's base32 encoded text -decode :: Text -> Either String ByteString -decode what = - bool - (Left "Invalid NixBase32 string") - (unsafeDecode what) - (Data.Text.all (`elem` digits32) what) - --- | Decode Nix's base32 encoded text --- Doesn't check if all elements match `digits32` -unsafeDecode :: Text -> Either String ByteString -unsafeDecode what = - case - readInt - 32 - (`elem` digits32) - (\c -> fromMaybe (error "character not in digits32") - $ Vector.findIndex (== c) digits32 - ) - (Data.Text.unpack what) - of - [(i, _)] -> Right $ padded $ integerToBS i - x -> Left $ "Can't decode: readInt returned " <> show x - where - padded x - | Bytes.length x < decLen = x `Bytes.append` bstr - | otherwise = x - where - bstr = Bytes.Char8.pack $ take (decLen - Bytes.length x) (cycle "\NUL") - - decLen = Data.Text.length what * 5 `div` 8 - --- | Encode an Integer to a bytestring --- Similar to Data.Base32String (integerToBS) without `reverse` -integerToBS :: Integer -> ByteString -integerToBS 0 = Bytes.pack [0] -integerToBS i - | i > 0 = Bytes.pack $ unfoldr f i - | otherwise = error "integerToBS not defined for negative values" - where - f 0 = Nothing - f x = Just (fromInteger x :: Word8, x `shiftR` 8) diff --git a/src/System/Nix/Internal/Hash.hs b/src/System/Nix/Internal/Hash.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Hash.hs +++ /dev/null @@ -1,107 +0,0 @@ -{-| -Description : Cryptographic hashing interface for hnix-store, on top - of the cryptohash family of libraries. --} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE CPP #-} - -module System.Nix.Internal.Hash - ( NamedAlgo(..) - , SomeNamedDigest(..) - , mkNamedDigest - , encodeDigestWith - , decodeDigestWith - , mkStorePathHash - ) -where - -import qualified Crypto.Hash as C -import qualified Data.ByteString as BS -import Data.Text (Text) -import qualified Data.Text as T -import System.Nix.Internal.Base -import Data.ByteArray -import System.Nix.Internal.Truncation - --- | A 'HashAlgorithm' with a canonical name, for serialization --- purposes (e.g. SRI hashes) -class C.HashAlgorithm a => NamedAlgo a where - algoName :: Text - -instance NamedAlgo C.MD5 where - algoName = "md5" - -instance NamedAlgo C.SHA1 where - algoName = "sha1" - -instance NamedAlgo C.SHA256 where - algoName = "sha256" - -instance NamedAlgo C.SHA512 where - algoName = "sha512" - --- | A digest whose 'NamedAlgo' is not known at compile time. -data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (C.Digest a) - -instance Show SomeNamedDigest where - show sd = case sd of - SomeDigest (digest :: C.Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest - -mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest -mkNamedDigest name sriHash = - let (sriName, h) = T.breakOnEnd "-" sriHash in - if sriName == "" || sriName == name <> "-" - then mkDigest h - else Left $ T.unpack $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name - where - mkDigest h = case name of - "md5" -> SomeDigest <$> decodeGo C.MD5 h - "sha1" -> SomeDigest <$> decodeGo C.SHA1 h - "sha256" -> SomeDigest <$> decodeGo C.SHA256 h - "sha512" -> SomeDigest <$> decodeGo C.SHA512 h - _ -> Left $ "Unknown hash name: " <> T.unpack name - decodeGo :: forall a . NamedAlgo a => a -> Text -> Either String (C.Digest a) - decodeGo a h - | size == base16Len = decodeDigestWith Base16 h - | size == base32Len = decodeDigestWith NixBase32 h - | size == base64Len = decodeDigestWith Base64 h - | otherwise = Left $ T.unpack sriHash <> " is not a valid " <> T.unpack name <> " hash. Its length (" <> show size <> ") does not match any of " <> show [base16Len, base32Len, base64Len] - where - size = T.length h - hsize = C.hashDigestSize a - base16Len = hsize * 2 - base32Len = ((hsize * 8 - 1) `div` 5) + 1; - base64Len = ((4 * hsize `div` 3) + 3) `div` 4 * 4; - - -mkStorePathHash :: forall a . C.HashAlgorithm a => BS.ByteString -> BS.ByteString -mkStorePathHash bs = - truncateInNixWay 20 $ convert $ C.hash @BS.ByteString @a bs - --- | Take BaseEncoding type of the output -> take the Digeest as input -> encode Digest -encodeDigestWith :: BaseEncoding -> C.Digest a -> T.Text -encodeDigestWith b = encodeWith b . convert - - --- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into Digest -decodeDigestWith :: C.HashAlgorithm a => BaseEncoding -> T.Text -> Either String (C.Digest a) -decodeDigestWith b x = - do - bs <- decodeWith b x - let - toEither = - maybeToRight - ("Cryptonite was not able to convert '(ByteString -> Digest a)' for: '" <> show bs <>"'.") - (toEither . C.digestFromByteString) bs - where - -- To not depend on @extra@ - maybeToRight :: b -> Maybe a -> Either b a - maybeToRight _ (Just r) = pure r - maybeToRight y Nothing = Left y diff --git a/src/System/Nix/Internal/Nar/Effects.hs b/src/System/Nix/Internal/Nar/Effects.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Nar/Effects.hs +++ /dev/null @@ -1,99 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module System.Nix.Internal.Nar.Effects - ( NarEffects(..) - , narEffectsIO - ) where - -import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Lazy as Bytes.Lazy -import Data.Int (Int64) -import qualified System.Directory as Directory -import System.Posix.Files ( createSymbolicLink - , fileSize - , getFileStatus - , isDirectory - , readSymbolicLink - ) -import qualified System.IO as IO -import qualified Control.Monad.IO.Class as IO -import Control.Monad.Trans.Control (MonadBaseControl) -import qualified Control.Exception.Lifted as Exception.Lifted -import qualified Control.Monad.Fail as MonadFail - -data NarEffects (m :: * -> *) = NarEffects { - narReadFile :: FilePath -> m Bytes.Lazy.ByteString - , narWriteFile :: FilePath -> Bytes.Lazy.ByteString -> m () - , narStreamFile :: FilePath -> m (Maybe Bytes.ByteString) -> m () - , narListDir :: FilePath -> m [FilePath] - , narCreateDir :: FilePath -> m () - , narCreateLink :: FilePath -> FilePath -> m () - , narGetPerms :: FilePath -> m Directory.Permissions - , narSetPerms :: FilePath -> Directory.Permissions -> m () - , narIsDir :: FilePath -> m Bool - , narIsSymLink :: FilePath -> m Bool - , narFileSize :: FilePath -> m Int64 - , narReadLink :: FilePath -> m FilePath - , narDeleteDir :: FilePath -> m () - , narDeleteFile :: FilePath -> m () -} - - --- | A particular @NarEffects@ that uses regular POSIX for file manipulation --- You would replace this with your own @NarEffects@ if you wanted a --- different backend -narEffectsIO - :: (IO.MonadIO m, - MonadFail.MonadFail m, - MonadBaseControl IO m - ) => NarEffects m -narEffectsIO = NarEffects { - narReadFile = IO.liftIO . Bytes.Lazy.readFile - , narWriteFile = \a -> IO.liftIO . Bytes.Lazy.writeFile a - , narStreamFile = streamStringOutIO - , narListDir = IO.liftIO . Directory.listDirectory - , narCreateDir = IO.liftIO . Directory.createDirectory - , narCreateLink = \f -> IO.liftIO . createSymbolicLink f - , narGetPerms = IO.liftIO . Directory.getPermissions - , narSetPerms = \f -> IO.liftIO . Directory.setPermissions f - , narIsDir = fmap isDirectory . IO.liftIO . getFileStatus - , narIsSymLink = IO.liftIO . Directory.pathIsSymbolicLink - , narFileSize = fmap (fromIntegral . fileSize) . IO.liftIO . getFileStatus - , narReadLink = IO.liftIO . readSymbolicLink - , narDeleteDir = IO.liftIO . Directory.removeDirectoryRecursive - , narDeleteFile = IO.liftIO . Directory.removeFile - } - - --- | This default implementation for @narStreamFile@ requires @IO.MonadIO@ -streamStringOutIO - :: forall m - .(IO.MonadIO m, - MonadFail.MonadFail m, - MonadBaseControl IO m - ) => FilePath - -> m (Maybe Bytes.ByteString) - -> m () -streamStringOutIO f getChunk = - Exception.Lifted.bracket - (IO.liftIO $ IO.openFile f IO.WriteMode) - (IO.liftIO . IO.hClose) - go - `Exception.Lifted.catch` - cleanupException - where - go :: IO.Handle -> m () - go handle = do - chunk <- getChunk - case chunk of - Nothing -> pure () - Just c -> do - IO.liftIO $ Bytes.hPut handle c - go handle - cleanupException (e :: Exception.Lifted.SomeException) = do - IO.liftIO $ Directory.removeFile f - MonadFail.fail $ - "Failed to stream string to " <> f <> ": " <> show e diff --git a/src/System/Nix/Internal/Nar/Parser.hs b/src/System/Nix/Internal/Nar/Parser.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Nar/Parser.hs +++ /dev/null @@ -1,515 +0,0 @@ --- | A streaming parser for the NAR format - -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeFamilies #-} - -module System.Nix.Internal.Nar.Parser - ( runParser - , parseNar - , testParser - , testParser' - ) -where - -import qualified Algebra.Graph as Graph -import qualified Algebra.Graph.ToGraph as Graph -import qualified Control.Concurrent as Concurrent -import qualified Control.Exception.Lifted as Exception.Lifted -import Control.Monad ( forM - , when - , forM_ - ) -import qualified Control.Monad.Except as Except -import qualified Control.Monad.Fail as Fail -import qualified Control.Monad.IO.Class as IO -import qualified Control.Monad.Reader as Reader -import qualified Control.Monad.State as State -import qualified Control.Monad.Trans as Trans -import qualified Control.Monad.Trans.Control as Base -import Data.ByteString ( ByteString ) -import qualified Data.ByteString as Bytes -import Data.Bool ( bool ) -import qualified Data.Either as Either -import Data.Int ( Int64 ) -import qualified Data.IORef as IORef -import qualified Data.List as List -import qualified Data.Map as Map -import Data.Maybe ( catMaybes ) -import qualified Data.Serialize as Serialize -import Data.Text ( Text ) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import qualified System.Directory as Directory -import System.FilePath as FilePath -import qualified System.IO as IO - -import qualified System.Nix.Internal.Nar.Effects as Nar - - --- | NarParser is a monad for parsing a Nar file as a byte stream --- and reconstructing the file system objects inside --- See the definitions of @NarEffects@ for a description --- of the actions the parser can take, and @ParserState@ for the --- internals of the parser -newtype NarParser m a = NarParser - { runNarParser :: - State.StateT - ParserState - (Except.ExceptT - String - (Reader.ReaderT - (Nar.NarEffects m) - m - ) - ) - a - } - deriving ( Functor, Applicative, Monad, Fail.MonadFail - , Trans.MonadIO, State.MonadState ParserState - , Except.MonadError String - , Reader.MonadReader (Nar.NarEffects m) - ) - --- | Run a @NarParser@ over a byte stream --- This is suitable for testing the top-level NAR parser, or any of the --- smaller utilities parsers, if you have bytes appropriate for them -runParser - :: forall m a - . (IO.MonadIO m, Base.MonadBaseControl IO m) - => Nar.NarEffects m - -- ^ Provide the effects set, usually @narEffectsIO@ - -> NarParser m a - -- ^ A parser to run, such as @parseNar@ - -> IO.Handle - -- ^ A handle the stream containg the NAR. It should already be - -- open and in @IO.ReadMode@ - -> FilePath - -- ^ The root file system object to be created by the NAR - -> m (Either String a) -runParser effs (NarParser action) h target = do - unpackResult <- - Reader.runReaderT (Except.runExceptT $ State.evalStateT action state0) effs - `Exception.Lifted.catch` exceptionHandler - when (Either.isLeft unpackResult) cleanup - pure unpackResult - - where - state0 :: ParserState - state0 = - ParserState - { tokenStack = [] - , handle = h - , directoryStack = [target] - , links = [] - } - - exceptionHandler :: Exception.Lifted.SomeException -> m (Either String a) - exceptionHandler e = - pure $ Left $ "Exception while unpacking NAR file: " <> show e - - cleanup :: m () - cleanup = - (\ef trg -> do - isDir <- Nar.narIsDir ef trg - bool - (Nar.narDeleteFile ef trg) - (Nar.narDeleteDir ef trg) - isDir - ) effs target - - -instance Trans.MonadTrans NarParser where - lift act = NarParser $ (Trans.lift . Trans.lift . Trans.lift) act - - -data ParserState = ParserState - { tokenStack :: ![Text] - -- ^ The parser can push tokens (words or punctuation) - -- onto this stack. We use this for a very limited backtracking - -- where the Nar format requires it - , directoryStack :: ![String] - -- ^ The parser knows the name of the current FSO it's targeting, - -- and the relative directory path leading there - , handle :: IO.Handle - -- ^ Handle of the input byte stream - , links :: [LinkInfo] - -- ^ Unlike with files and directories, we collect symlinks - -- from the NAR on - } - - ------------------------------------------------------------------------------- --- * Parsers for NAR components - --- | Parse a NAR byte string, producing @()@. --- Parsing a NAR is mostly used for its side-effect: producing --- the file system objects packed in the NAR. That's why we pure @()@ -parseNar :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () -parseNar = do - expectStr "nix-archive-1" - parens parseFSO - createLinks - - -parseFSO :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () -parseFSO = do - expectStr "type" - matchStr - [ ("symlink" , parseSymlink ) - , ("regular" , parseFile ) - , ("directory", parseDirectory) - ] - - --- | Parse a symlink from a NAR, storing the link details in the parser state --- We remember links rather than immediately creating file system objects --- from them, because we might encounter a link in the NAR before we --- encountered its target, and in this case, creating the link will fail --- The final step of creating links is handle by @createLinks@ -parseSymlink :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () -parseSymlink = do - expectStr "target" - target <- parseStr - (dir, file) <- currentDirectoryAndFile - pushLink $ - LinkInfo - { linkTarget = Text.unpack target - , linkFile = file - , linkPWD = dir - } - where - currentDirectoryAndFile :: Monad m => NarParser m (FilePath, FilePath) - currentDirectoryAndFile = do - dirStack <- State.gets directoryStack - pure (List.foldr1 () (List.reverse $ drop 1 dirStack), head dirStack) - - --- | Internal data type representing symlinks encountered in the NAR -data LinkInfo = LinkInfo - { linkTarget :: String - -- ^ path to the symlink target, relative to the root of the unpacking NAR - , linkFile :: String - -- ^ file name of the link being created - , linkPWD :: String - -- ^ directory in which to create the link (relative to unpacking root) - } - deriving Show - - --- | When the NAR includes a file, we read from the NAR handle in chunks and --- write the target in chunks. This lets us avoid reading the full contents --- of the encoded file into memory -parseFile :: forall m . (IO.MonadIO m, Fail.MonadFail m) => NarParser m () -parseFile = do - - s <- parseStr - when (s `notElem` ["executable", "contents"]) $ - Fail.fail - $ "Parser found " <> show s - <> " when expecting element from " - <> (show :: [String] -> String) ["executable", "contents"] - when (s == "executable") $ do - expectStr "" - expectStr "contents" - - fSize <- parseLength - - -- Set up for defining `getChunk` - narHandle <- State.gets handle - bytesLeftVar <- IO.liftIO $ IORef.newIORef fSize - - let - -- getChunk tracks the number of total bytes we still need to get from the - -- file (starting at the file size, and decrementing by the size of the - -- chunk we read) - getChunk :: m (Maybe ByteString) - getChunk = do - bytesLeft <- IO.liftIO $ IORef.readIORef bytesLeftVar - if bytesLeft == 0 - then pure Nothing - else do - chunk <- IO.liftIO $ Bytes.hGetSome narHandle $ fromIntegral $ min 10000 bytesLeft - when (Bytes.null chunk) (Fail.fail "ZERO BYTES") - IO.liftIO $ IORef.modifyIORef bytesLeftVar $ \n -> n - fromIntegral (Bytes.length chunk) - - -- This short pause is necessary for letting the garbage collector - -- clean up chunks from previous runs. Without it, heap memory usage can - -- quickly spike - IO.liftIO $ Concurrent.threadDelay 10 - pure $ Just chunk - - target <- currentFile - streamFile <- Reader.asks Nar.narStreamFile - Trans.lift (streamFile target getChunk) - - when (s == "executable") $ do - effs :: Nar.NarEffects m <- Reader.ask - Trans.lift $ do - p <- Nar.narGetPerms effs target - Nar.narSetPerms effs target (p { Directory.executable = True }) - - expectRawString (Bytes.replicate (padLen $ fromIntegral fSize) 0) - - --- | Parse a NAR encoded directory, being careful not to hold onto file --- handles for target files longer than needed -parseDirectory :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () -parseDirectory = do - createDirectory <- Reader.asks Nar.narCreateDir - target <- currentFile - Trans.lift $ createDirectory target - parseEntryOrFinish - - where - - parseEntryOrFinish :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () - parseEntryOrFinish = - -- If we reach a ")", we finished the directory's entries, and we have - -- to put ")" back into the stream, because the outer call to @parens@ - -- expects to consume it. - -- Otherwise, parse an entry as a fresh file system object - matchStr - [ ( ")" , pushStr ")" ) - , ("entry", parseEntry ) - ] - - parseEntry :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () - parseEntry = do - parens $ do - expectStr "name" - fName <- parseStr - pushFileName (Text.unpack fName) - expectStr "node" - parens parseFSO - popFileName - parseEntryOrFinish - - - ------------------------------------------------------------------------------- --- * Utility parsers - - --- | Short strings guiding the NAR parsing are prefixed with their --- length, then encoded in ASCII, and padded to 8 bytes. @parseStr@ --- captures this logic -parseStr :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m Text -parseStr = do - cachedStr <- popStr - case cachedStr of - Just str -> pure str - Nothing -> do - len <- parseLength - strBytes <- consume $ fromIntegral len - expectRawString - (Bytes.replicate (fromIntegral $ padLen $ fromIntegral len) 0) - pure $ Text.decodeUtf8 strBytes - - --- | Get an Int64 describing the length of the upcoming string, --- according to NAR's encoding of ints -parseLength :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m Int64 -parseLength = do - eightBytes <- consume 8 - either - (\e -> Fail.fail $ "parseLength failed to decode int64: " <> e) - pure - (Serialize.runGet Serialize.getInt64le eightBytes) - - --- | Consume a NAR string and assert that it matches an expectation -expectStr :: (IO.MonadIO m, Fail.MonadFail m) => Text -> NarParser m () -expectStr expected = do - actual <- parseStr - when (actual /= expected) $ - Fail.fail $ "Expected " <> err expected <> ", got " <> err actual - where - err t = - show $ - bool - t - (Text.take 10 t <> "...") - (Text.length t > 10) - - --- | Consume a raw string and assert that it equals some expectation. --- This is usually used when consuming padding 0's -expectRawString - :: (IO.MonadIO m, Fail.MonadFail m) => ByteString -> NarParser m () -expectRawString expected = do - actual <- consume $ Bytes.length expected - when (actual /= expected) - $ Fail.fail - $ "Expected " - <> err expected - <> ", got " - <> err actual - where - err bs = - show $ - bool - bs - (Bytes.take 10 bs <> "...") - (Bytes.length bs > 10) - - --- | Consume a NAR string, and dispatch to a parser depending on which string --- matched -matchStr - :: (IO.MonadIO m, Fail.MonadFail m) - => [(Text, NarParser m a)] - -- ^ List of expected possible strings and the parsers they should run - -> NarParser m a -matchStr parsers = do - str <- parseStr - case List.lookup str parsers of - Just p -> p - Nothing -> - Fail.fail $ "Expected one of " <> show (fst <$> parsers) <> " found " <> show str - - --- | Wrap any parser in NAR formatted parentheses --- (a parenthesis is a NAR string, so it needs length encoding and padding) -parens :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m a -> NarParser m a -parens act = do - expectStr "(" - r <- act - expectStr ")" - pure r - - --- | Sort links in the symlink stack according to their connectivity --- (Targets must be created before the links that target them) -createLinks :: IO.MonadIO m => NarParser m () -createLinks = do - createLink <- Reader.asks Nar.narCreateLink - allLinks <- State.gets links - sortedLinks <- IO.liftIO $ sortLinksIO allLinks - forM_ sortedLinks $ \li -> do - pwd <- IO.liftIO Directory.getCurrentDirectory - IO.liftIO $ Directory.setCurrentDirectory (linkPWD li) - Trans.lift $ createLink (linkTarget li) (linkFile li) - IO.liftIO $ Directory.setCurrentDirectory pwd - - where - - -- Convert every target and link file to a filepath relative - -- to NAR root, then @Graph.topSort@ it, and map from the - -- relative filepaths back to the original @LinkInfo@. - -- Relative paths are needed for sorting, but @LinkInfo@s - -- are needed for creating the link files - sortLinksIO :: [LinkInfo] -> IO [LinkInfo] - sortLinksIO ls = do - linkLocations <- fmap Map.fromList $ - forM ls $ \li-> - (,li) <$> Directory.canonicalizePath (linkFile li) - canonicalLinks <- forM ls $ \l -> do - targetAbsPath <- Directory.canonicalizePath - (linkPWD l linkTarget l) - fileAbsPath <- Directory.canonicalizePath - (linkFile l) - pure (fileAbsPath, targetAbsPath) - let linkGraph = Graph.edges canonicalLinks - case Graph.topSort linkGraph of - Left _ -> error "Symlinks form a loop" - Right sortedNodes -> - let - sortedLinks = flip Map.lookup linkLocations <$> sortedNodes - in - pure $ catMaybes sortedLinks - - ------------------------------------------------------------------------------- --- * State manipulation - --- | Pull n bytes from the underlying handle, failing if fewer bytes --- are available -consume - :: (IO.MonadIO m, Fail.MonadFail m) - => Int - -> NarParser m ByteString -consume 0 = pure "" -consume n = do - state0 <- State.get - newBytes <- IO.liftIO $ Bytes.hGetSome (handle state0) (max 0 n) - when (Bytes.length newBytes < n) $ - Fail.fail $ - "consume: Not enough bytes in handle. Wanted " - <> show n <> " got " <> show (Bytes.length newBytes) - pure newBytes - - --- | Pop a string off the token stack -popStr :: Monad m => NarParser m (Maybe Text) -popStr = do - s <- State.get - case List.uncons (tokenStack s) of - Nothing -> pure Nothing - Just (x, xs) -> do - State.put $ s { tokenStack = xs } - pure $ Just x - - --- | Push a string onto the token stack -pushStr :: Monad m => Text -> NarParser m () -pushStr str = - State.modify $ \s -> -- s { loadedBytes = strBytes <> loadedBytes s } - s { tokenStack = str : tokenStack s } - - --- | Push a level onto the directory stack -pushFileName :: Monad m => FilePath -> NarParser m () -pushFileName fName = - State.modify (\s -> s { directoryStack = fName : directoryStack s }) - - --- | Go to the parent level in the directory stack -popFileName :: Monad m => NarParser m () -popFileName = - State.modify (\s -> s { directoryStack = List.drop 1 (directoryStack s )}) - - --- | Convert the current directory stack into a filepath by interspersing --- the path components with "/" -currentFile :: Monad m => NarParser m FilePath -currentFile = do - dirStack <- State.gets directoryStack - pure $ List.foldr1 () $ List.reverse dirStack - - --- | Add a link to the collection of encountered symlinks -pushLink :: Monad m => LinkInfo -> NarParser m () -pushLink linkInfo = State.modify (\s -> s { links = linkInfo : links s }) - - ------------------------------------------------------------------------------- --- * Utilities - -testParser :: (m ~ IO) => NarParser m a -> ByteString -> m (Either String a) -testParser p b = do - Bytes.writeFile tmpFileName b - IO.withFile tmpFileName IO.ReadMode $ \h -> - runParser Nar.narEffectsIO p h tmpFileName - where - tmpFileName = "tmp" - -testParser' :: (m ~ IO) => FilePath -> IO (Either String ()) -testParser' fp = - IO.withFile fp IO.ReadMode $ \h -> runParser Nar.narEffectsIO parseNar h "tmp" - - - - --- | Distance to the next multiple of 8 -padLen :: Int -> Int -padLen n = (8 - n) `mod` 8 - - -dbgState :: IO.MonadIO m => NarParser m () -dbgState = do - s <- State.get - IO.liftIO $ print (tokenStack s, directoryStack s) diff --git a/src/System/Nix/Internal/Nar/Streamer.hs b/src/System/Nix/Internal/Nar/Streamer.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Nar/Streamer.hs +++ /dev/null @@ -1,117 +0,0 @@ --- | Stream out a NAR file from a regular file - -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module System.Nix.Internal.Nar.Streamer - ( streamNarIO - , IsExecutable(..) - ) -where - -import Control.Monad ( forM_ - , when - ) -import qualified Control.Monad.IO.Class as IO -import Data.Bool ( bool ) -import Data.ByteString ( ByteString ) -import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Char8 as Bytes.Char8 -import qualified Data.ByteString.Lazy as Bytes.Lazy -import qualified Data.List as List -import qualified Data.Serialize as Serial -import GHC.Int ( Int64 ) -import qualified System.Directory as Directory -import System.FilePath ( () ) - -import qualified System.Nix.Internal.Nar.Effects as Nar - - --- | This implementation of Nar encoding takes an arbitrary @yield@ --- function from any streaming library, and repeatedly calls --- it while traversing the filesystem object to Nar encode -streamNarIO - :: forall m - . (IO.MonadIO m) - => (ByteString -> m ()) - -> Nar.NarEffects IO - -> FilePath - -> m () -streamNarIO yield effs basePath = do - yield $ str "nix-archive-1" - parens $ go basePath - - where - - go :: FilePath -> m () - go path = do - isDir <- IO.liftIO $ Nar.narIsDir effs path - isSymLink <- IO.liftIO $ Nar.narIsSymLink effs path - let isRegular = not $ isDir || isSymLink - - when isSymLink $ do - target <- IO.liftIO $ Nar.narReadLink effs path - yield $ - strs ["type", "symlink", "target", Bytes.Char8.pack target] - - when isRegular $ do - isExec <- IO.liftIO $ isExecutable effs path - yield $ strs ["type", "regular"] - when (isExec == Executable) $ yield $ strs ["executable", ""] - fSize <- IO.liftIO $ Nar.narFileSize effs path - yield $ str "contents" - yield $ int fSize - yieldFile path fSize - - when isDir $ do - fs <- IO.liftIO (Nar.narListDir effs path) - yield $ strs ["type", "directory"] - forM_ (List.sort fs) $ \f -> do - yield $ str "entry" - parens $ do - let fullName = path f - yield $ strs ["name", Bytes.Char8.pack f, "node"] - parens $ go fullName - - str :: ByteString -> ByteString - str t = - let - len = Bytes.length t - in - int len <> padBS len t - - padBS :: Int -> ByteString -> ByteString - padBS strSize bs = bs <> Bytes.replicate (padLen strSize) 0 - - parens act = do - yield $ str "(" - r <- act - yield $ str ")" - pure r - - -- Read, yield, and pad the file - yieldFile :: FilePath -> Int64 -> m () - yieldFile path fsize = do - mapM_ yield . Bytes.Lazy.toChunks =<< IO.liftIO (Bytes.Lazy.readFile path) - yield $ Bytes.replicate (padLen $ fromIntegral fsize) 0 - - strs :: [ByteString] -> ByteString - strs xs = Bytes.concat $ str <$> xs - - int :: Integral a => a -> ByteString - int n = Serial.runPut $ Serial.putInt64le $ fromIntegral n - - -data IsExecutable = NonExecutable | Executable - deriving (Eq, Show) - -isExecutable :: Functor m => Nar.NarEffects m -> FilePath -> m IsExecutable -isExecutable effs fp = - bool - NonExecutable - Executable - . Directory.executable <$> Nar.narGetPerms effs fp - --- | Distance to the next multiple of 8 -padLen :: Int -> Int -padLen n = (8 - n) `mod` 8 diff --git a/src/System/Nix/Internal/Signature.hs b/src/System/Nix/Internal/Signature.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Signature.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-| -Description : Nix-relevant interfaces to NaCl signatures. --} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE CPP #-} - -module System.Nix.Internal.Signature - ( Signature - , NarSignature(..) - ) -where - - -import Data.ByteString ( ByteString ) -import qualified Data.ByteString as Bytes -import Data.Coerce ( coerce ) -import Crypto.Saltine.Core.Sign ( PublicKey ) -import Crypto.Saltine.Class ( IsEncoding(..) ) - --- 2021-05-30: NOTE: Please, clean-up these overloads in ~2022 -#if MIN_VERSION_saltine(0,2,0) -import qualified Crypto.Saltine.Internal.Sign as NaClSizes -#else -import qualified Crypto.Saltine.Internal.ByteSizes as NaClSizes -#endif - --- | A NaCl signature. -newtype Signature = Signature ByteString - deriving (Eq, Ord) - -instance IsEncoding Signature where - decode s -#if MIN_VERSION_saltine(0,2,0) - | Bytes.length s == NaClSizes.sign_bytes = Just $ Signature s -#else - | Bytes.length s == NaClSizes.sign = Just $ Signature s -#endif - | otherwise = Nothing - encode = coerce - --- | A detached NaCl signature attesting to a nix archive's validity. -data NarSignature = NarSignature - { -- | The public key used to sign the archive. - publicKey :: PublicKey - , -- | The archive's signature. - sig :: Signature - } - deriving (Eq, Ord) diff --git a/src/System/Nix/Internal/StorePath.hs b/src/System/Nix/Internal/StorePath.hs deleted file mode 100644 --- a/src/System/Nix/Internal/StorePath.hs +++ /dev/null @@ -1,241 +0,0 @@ -{-| -Description : Representation of Nix store paths. --} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DataKinds #-} - -module System.Nix.Internal.StorePath - ( -- * Basic store path types - StorePath(..) - , StorePathName(..) - , StorePathSet - , mkStorePathHashPart - , StorePathHashPart(..) - , ContentAddressableAddress(..) - , NarHashMode(..) - , -- * Manipulating 'StorePathName' - makeStorePathName - , validStorePathName - , -- * Rendering out 'StorePath's - storePathToFilePath - , storePathToRawFilePath - , storePathToText - , storePathToNarInfo - , -- * Parsing 'StorePath's - parsePath - , pathParser - ) -where -import System.Nix.Internal.Hash -import System.Nix.Internal.Base -import qualified System.Nix.Internal.Base32 as Nix.Base32 - -import Data.ByteString ( ByteString ) -import qualified Data.ByteString.Char8 as Bytes.Char8 -import qualified Data.Char as Char -import Data.Text ( Text ) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text - ( encodeUtf8 ) -import Data.Attoparsec.Text.Lazy ( Parser - , () - ) -import qualified Data.Attoparsec.Text.Lazy as Parser.Text.Lazy -import qualified System.FilePath as FilePath -import Data.Hashable ( Hashable(..) ) -import Data.HashSet ( HashSet ) -import Data.Coerce ( coerce ) -import Crypto.Hash ( SHA256 - , Digest - ) - --- | A path in a Nix store. --- --- From the Nix thesis: A store path is the full path of a store --- object. It has the following anatomy: storeDir/hashPart-name. --- --- @storeDir@: The root of the Nix store (e.g. \/nix\/store). --- --- See the 'StoreDir' haddocks for details on why we represent this at --- the type level. -data StorePath = StorePath - { -- | The 160-bit hash digest reflecting the "address" of the name. - -- Currently, this is a truncated SHA256 hash. - storePathHash :: !StorePathHashPart - , -- | The (typically human readable) name of the path. For packages - -- this is typically the package name and version (e.g. - -- hello-1.2.3). - storePathName :: !StorePathName - , -- | Root of the store - storePathRoot :: !FilePath - } - deriving (Eq, Ord) - -instance Hashable StorePath where - hashWithSalt s StorePath{..} = - s `hashWithSalt` storePathHash `hashWithSalt` storePathName - -instance Show StorePath where - show p = Bytes.Char8.unpack $ storePathToRawFilePath p - --- | The name portion of a Nix path. --- --- 'unStorePathName' must only contain a-zA-Z0-9+._?=-, can't start --- with a -, and must have at least one character (i.e. it must match --- 'storePathNameRegex'). -newtype StorePathName = StorePathName - { -- | Extract the contents of the name. - unStorePathName :: Text - } deriving (Eq, Hashable, Ord) - --- | The hash algorithm used for store path hashes. -newtype StorePathHashPart = StorePathHashPart ByteString - deriving (Eq, Hashable, Ord, Show) - -mkStorePathHashPart :: ByteString -> StorePathHashPart -mkStorePathHashPart = coerce . mkStorePathHash @SHA256 - --- | A set of 'StorePath's. -type StorePathSet = HashSet StorePath - --- | 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 --- the contents of the derivation file instead). --- --- For backwards-compatibility reasons, the same information is --- encodable in multiple ways, depending on the method used to add the --- path to the store. These unfortunately result in separate store --- paths. -data ContentAddressableAddress - = -- | The path is a plain file added via makeTextPath or - -- addTextToStore. It is addressed according to a sha256sum of the - -- file contents. - Text !(Digest SHA256) - | -- | 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'. - Fixed !NarHashMode !SomeNamedDigest - --- | Schemes for hashing a Nix archive. --- --- For backwards-compatibility reasons, there are two different modes --- here, even though 'Recursive' should be able to cover both. -data NarHashMode - = -- | Require the nar to represent a non-executable regular file. - RegularFile - | -- | Hash an arbitrary nar, including a non-executable regular - -- file if so desired. - Recursive - -makeStorePathName :: Text -> Either String StorePathName -makeStorePathName n = - if validStorePathName n - then pure $ StorePathName n - else Left $ reasonInvalid n - -reasonInvalid :: Text -> String -reasonInvalid n - | n == "" = "Empty name" - | Text.length n > 211 = "Path too long" - | Text.head n == '.' = "Leading dot" - | otherwise = "Invalid character" - -validStorePathName :: Text -> Bool -validStorePathName n = - n /= "" - && Text.length n <= 211 - && Text.head n /= '.' - && Text.all validStorePathNameChar n - -validStorePathNameChar :: Char -> Bool -validStorePathNameChar c = - any ($ c) - [ Char.isAsciiLower -- 'a'..'z', isAscii..er probably faster then putting it out - , Char.isAsciiUpper -- 'A'..'Z' - , Char.isDigit - , (`elem` ("+-._?=" :: String)) - ] - --- | Copied from @RawFilePath@ in the @unix@ package, duplicated here --- to avoid the dependency. -type RawFilePath = ByteString - --- | Render a 'StorePath' as a 'RawFilePath'. -storePathToRawFilePath :: StorePath -> RawFilePath -storePathToRawFilePath StorePath{..} = - root <> "/" <> hashPart <> "-" <> name - where - root = Bytes.Char8.pack storePathRoot - hashPart = Text.encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash - name = Text.encodeUtf8 $ unStorePathName storePathName - --- | Render a 'StorePath' as a 'FilePath'. -storePathToFilePath :: StorePath -> FilePath -storePathToFilePath = Bytes.Char8.unpack . storePathToRawFilePath - --- | Render a 'StorePath' as a 'Text'. -storePathToText :: StorePath -> Text -storePathToText = Text.pack . Bytes.Char8.unpack . storePathToRawFilePath - --- | Build `narinfo` suffix from `StorePath` which --- can be used to query binary caches. -storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString -storePathToNarInfo StorePath{..} = - Text.encodeUtf8 $ encodeWith NixBase32 (coerce storePathHash) <> ".narinfo" - --- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking --- that store directory matches `expectedRoot`. -parsePath :: FilePath -> Bytes.Char8.ByteString -> Either String StorePath -parsePath expectedRoot x = - let - (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x - (storeBasedHashPart, namePart) = Text.breakOn "-" $ Text.pack fname - storeHash = decodeWith NixBase32 storeBasedHashPart - name = makeStorePathName . Text.drop 1 $ namePart - --rootDir' = dropTrailingPathSeparator rootDir - -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b - rootDir' = init rootDir - storeDir = - if expectedRoot == rootDir' - then Right rootDir' - else Left $ "Root store dir mismatch, expected" <> expectedRoot <> "got" <> rootDir' - in - StorePath <$> coerce storeHash <*> name <*> storeDir - -pathParser :: FilePath -> Parser StorePath -pathParser expectedRoot = do - _ <- - Parser.Text.Lazy.string (Text.pack expectedRoot) - "Store root mismatch" -- e.g. /nix/store - - _ <- Parser.Text.Lazy.char '/' - "Expecting path separator" - - digest <- - decodeWith NixBase32 - <$> Parser.Text.Lazy.takeWhile1 (`elem` Nix.Base32.digits32) - "Invalid Base32 part" - - _ <- Parser.Text.Lazy.char '-' "Expecting dash (path name separator)" - - c0 <- - Parser.Text.Lazy.satisfy (\c -> c /= '.' && validStorePathNameChar c) - "Leading path name character is a dot or invalid character" - - rest <- - Parser.Text.Lazy.takeWhile validStorePathNameChar - "Path name contains invalid character" - - let name = makeStorePathName $ Text.cons c0 rest - - either - fail - pure - (StorePath <$> coerce digest <*> name <*> pure expectedRoot) diff --git a/src/System/Nix/Internal/Truncation.hs b/src/System/Nix/Internal/Truncation.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Truncation.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE DataKinds #-} - -module System.Nix.Internal.Truncation - ( truncateInNixWay - ) -where - -import qualified Data.ByteString as Bytes -import Data.Bits (xor) -import Data.List (foldl') -import Data.Word (Word8) -import Data.Bool (bool) - --- | Bytewise truncation of a 'Digest'. --- --- When truncation length is greater than the length of the bytestring --- but less than twice the bytestring length, truncation splits the --- bytestring into a head part (truncation length) and tail part --- (leftover part), right-pads the leftovers with 0 to the truncation --- length, and combines the two strings bytewise with 'xor'. -truncateInNixWay - :: Int -> Bytes.ByteString -> Bytes.ByteString --- 2021-06-07: NOTE: Renamed function, since truncation can be done in a lot of ways, there is no practice of truncting hashes this way, moreover: --- 1. --- 2. -truncateInNixWay n c = - Bytes.pack $ fmap truncOutputByte [0 .. n-1] - where - - truncOutputByte :: Int -> Word8 - truncOutputByte i = foldl' (aux i) 0 [0 .. Bytes.length c - 1] - - inputByte :: Int -> Word8 - inputByte j = Bytes.index c j - - aux :: Int -> Word8 -> Int -> Word8 - aux i x j = - bool - id - (`xor` inputByte j) - (j `mod` n == i) - x diff --git a/src/System/Nix/Nar.hs b/src/System/Nix/Nar.hs deleted file mode 100644 --- a/src/System/Nix/Nar.hs +++ /dev/null @@ -1,69 +0,0 @@ -{- -Description : Generating and consuming NAR files -Maintainer : Shea Levy --} - -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} - - -module System.Nix.Nar - ( - - -- * Encoding and Decoding NAR archives - buildNarIO - , unpackNarIO - - -- * Experimental - , Nar.parseNar - , Nar.testParser - , Nar.testParser' - - -- * Filesystem capabilities used by NAR encoder/decoder - , Nar.NarEffects(..) - , Nar.narEffectsIO - - -- * Internal - , Nar.streamNarIO - , Nar.runParser - ) -where - -import qualified Control.Concurrent as Concurrent -import qualified Data.ByteString as BS -import qualified System.IO as IO - -import qualified System.Nix.Internal.Nar.Effects as Nar -import qualified System.Nix.Internal.Nar.Parser as Nar -import qualified System.Nix.Internal.Nar.Streamer as Nar - - --- For a description of the NAR format, see Eelco's thesis --- https://nixos.org/%7Eeelco/pubs/phd-thesis.pdf - - --- | Pack the filesystem object at @FilePath@ into a NAR and stream it into the --- @IO.Handle@ --- The handle should aleady be open and in @IO.WriteMode@. -buildNarIO - :: Nar.NarEffects IO - -> FilePath - -> IO.Handle - -> IO () -buildNarIO effs basePath outHandle = - Nar.streamNarIO - (\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10) - effs - basePath - - --- | Read NAR formatted bytes from the @IO.Handle@ and unpack them into --- file system object(s) at the supplied @FilePath@ -unpackNarIO - :: Nar.NarEffects IO - -> IO.Handle - -> FilePath - -> IO (Either String ()) -unpackNarIO effs = Nar.runParser effs Nar.parseNar diff --git a/src/System/Nix/OutputName.hs b/src/System/Nix/OutputName.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/OutputName.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveAnyClass #-} +{-| +Description : Derived path output names +-} + +module System.Nix.OutputName + ( OutputName(..) + , mkOutputName + , outputNameToText + , outputStoreObjectName + -- * Re-exports + , System.Nix.StorePath.InvalidNameError(..) + ) where + +import Control.DeepSeq (NFData) +import Data.Hashable (Hashable) +import Data.Text (Text) +import GHC.Generics (Generic) +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 :: StorePathName + } deriving (Eq, Generic, Hashable, Ord, Show) + +instance NFData OutputName + +mkOutputName :: Text -> Either InvalidNameError OutputName +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/ReadonlyStore.hs b/src/System/Nix/ReadonlyStore.hs deleted file mode 100644 --- a/src/System/Nix/ReadonlyStore.hs +++ /dev/null @@ -1,101 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module System.Nix.ReadonlyStore where - - -import Data.ByteString ( ByteString ) -import qualified Data.ByteString as BS -import Data.List ( sort ) -import qualified Data.Text as T -import qualified Data.HashSet as HS -import Data.Text.Encoding -import System.Nix.Hash -import System.Nix.Nar -import System.Nix.StorePath -import Control.Monad.State.Strict -import Data.Coerce ( coerce ) -import Crypto.Hash ( Context - , Digest - , hash - , hashlazy - , hashInit - , hashUpdate - , hashFinalize - , SHA256 - ) - - -makeStorePath - :: forall h - . (NamedAlgo h) - => FilePath - -> ByteString - -> Digest h - -> StorePathName - -> StorePath -makeStorePath fp ty h nm = StorePath (coerce storeHash) nm fp - where - storeHash = mkStorePathHash @h s - - s = - BS.intercalate ":" $ - ty:fmap encodeUtf8 - [ algoName @h - , encodeDigestWith Base16 h - , T.pack fp - , coerce nm - ] - -makeTextPath - :: FilePath -> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath -makeTextPath fp nm h refs = makeStorePath fp ty h nm - where - ty = - BS.intercalate ":" $ "text" : sort (storePathToRawFilePath <$> HS.toList refs) - -makeFixedOutputPath - :: forall hashAlgo - . NamedAlgo hashAlgo - => FilePath - -> Bool - -> Digest hashAlgo - -> StorePathName - -> StorePath -makeFixedOutputPath fp recursive h = - if recursive && (algoName @hashAlgo) == "sha256" - then makeStorePath fp "source" h - else makeStorePath fp "output:out" h' - where - h' = - hash @ByteString @SHA256 - $ "fixed:out:" - <> encodeUtf8 (algoName @hashAlgo) - <> (if recursive then ":r:" else ":") - <> encodeUtf8 (encodeDigestWith Base16 h) - <> ":" - -computeStorePathForText - :: FilePath -> StorePathName -> ByteString -> (StorePathSet -> StorePath) -computeStorePathForText fp nm = makeTextPath fp nm . hash - -computeStorePathForPath - :: StorePathName -- ^ Name part of the newly created `StorePath` - -> FilePath -- ^ Local `FilePath` to add - -> Bool -- ^ Add target directory recursively - -> (FilePath -> Bool) -- ^ Path filter function - -> Bool -- ^ Only used by local store backend - -> IO StorePath -computeStorePathForPath name pth recursive _pathFilter _repair = do - selectedHash <- if recursive then recursiveContentHash else flatContentHash - pure $ makeFixedOutputPath "/nix/store" recursive selectedHash name - where - recursiveContentHash :: IO (Digest SHA256) - recursiveContentHash = hashFinalize <$> execStateT streamNarUpdate (hashInit @SHA256) - streamNarUpdate :: StateT (Context SHA256) IO () - streamNarUpdate = streamNarIO (modify . flip (hashUpdate @ByteString @SHA256)) narEffectsIO pth - - flatContentHash :: IO (Digest SHA256) - flatContentHash = hashlazy <$> narReadFile narEffectsIO pth diff --git a/src/System/Nix/Realisation.hs b/src/System/Nix/Realisation.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Realisation.hs @@ -0,0 +1,92 @@ +{-| +Description : Derivation realisations +-} + +module System.Nix.Realisation ( + BuildTraceKey(..) + , BuildTraceKeyError(..) + , buildTraceKeyBuilder + , buildTraceKeyParser + , Realisation(..) + , RealisationWithId(..) + ) where + +import Data.Set (Set) +import Data.Text (Text) +import Data.Text.Lazy.Builder (Builder) +import GHC.Generics (Generic) +import System.Nix.OutputName (OutputName, InvalidNameError) +import System.Nix.Signature (NamedSignature) +import System.Nix.StorePath (StorePath, InvalidPathError) + +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 BuildTraceKey = BuildTraceKey + { buildTraceKeyDrvPath :: StorePath + -- ^ Store path of the derivation + , buildTraceKeyOutput :: OutputName + -- ^ Output name + } deriving (Eq, Generic, Ord, Show) + +data BuildTraceKeyError + = BuildTraceKeyError_Path InvalidPathError + | BuildTraceKeyError_Name InvalidNameError + | BuildTraceKeyError_NoCaret + | BuildTraceKeyError_TooManyParts [Text] + deriving (Eq, Ord, Show) + +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 + BuildTraceKeyError_Name + $ System.Nix.OutputName.mkOutputName oName + pure $ BuildTraceKey path name + [_] -> Left BuildTraceKeyError_NoCaret + x -> Left $ BuildTraceKeyError_TooManyParts x + +buildTraceKeyBuilder + :: BuildTraceKey + -> Builder +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 @BuildTraceKey OutputName@ so +-- we will use @RealisationWithId@ newtype +data Realisation = Realisation + { realisationOutPath :: StorePath + -- ^ Output path + , realisationSignatures :: Set NamedSignature + -- ^ Signatures + } deriving (Eq, Generic, Ord, Show) + +-- | For wire protocol +-- +-- We store this normalized in @Build.buildResultBuiltOutputs@ +-- 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 :: (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 @@ -1,10 +1,85 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} {-| Description : Nix-relevant interfaces to NaCl signatures. -} + module System.Nix.Signature - ( Signature - , NarSignature(..) - ) -where + ( Signature(..) + , signatureParser + , parseSignature + , signatureToText + , NamedSignature(..) + , narSignatureParser + , parseNamedSignature + , narSignatureToText + ) where -import System.Nix.Internal.Signature +import Crypto.Error (CryptoFailable(..)) +import Data.Attoparsec.Text (Parser) +import Data.ByteString (ByteString) +import Data.Text (Text) +import GHC.Generics (Generic) +import System.Nix.Base (decodeWith, encodeWith, BaseEncoding(Base64)) + +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 + deriving (Eq, Generic, Show) + +signatureParser :: Parser Signature +signatureParser = do + encodedSig <- + Data.Attoparsec.Text.takeWhile1 + (\c -> Data.Char.isAlphaNum c || c == '+' || c == '/' || c == '=') + decodedSig <- case decodeWith Base64 encodedSig of + Left e -> fail e + Right decodedSig -> pure decodedSig + sig <- case Ed25519.signature decodedSig of + CryptoFailed e -> (fail . show) e + CryptoPassed sig -> pure sig + pure $ Signature sig + +parseSignature :: Text -> Either String Signature +parseSignature = Data.Attoparsec.Text.parseOnly signatureParser + +signatureToText :: Signature -> Text +signatureToText (Signature sig) = + encodeWith Base64 (Data.ByteArray.convert sig :: ByteString) + +-- | A detached signature attesting to a nix archive's validity. +data NamedSignature = NamedSignature + { -- | The name of the public key used to sign the archive. + publicKey :: !Text + , -- | The archive's signature. + sig :: !Signature + } + deriving (Eq, Generic, Ord) + +instance Ord Signature where + compare (Signature x) (Signature y) = let + xBS = Data.ByteArray.convert x :: ByteString + yBS = Data.ByteArray.convert y :: ByteString + in compare xBS yBS + +narSignatureParser :: Parser NamedSignature +narSignatureParser = do + publicKey <- Data.Attoparsec.Text.takeWhile1 (/= ':') + _ <- Data.Attoparsec.Text.string ":" + sig <- signatureParser + pure $ NamedSignature {..} + +parseNamedSignature :: Text -> Either String NamedSignature +parseNamedSignature = Data.Attoparsec.Text.parseOnly narSignatureParser + +narSignatureToText :: NamedSignature -> Text +narSignatureToText NamedSignature {..} = + mconcat [ publicKey, ":", signatureToText sig ] + +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 new file mode 100644 --- /dev/null +++ b/src/System/Nix/Store/Types.hs @@ -0,0 +1,18 @@ +-- | TODO rename module +module System.Nix.Store.Types + ( PathFilter(..) + , RepairMode(..) + ) where + +import GHC.Generics (Generic) + +-- | Path filtering function +newtype PathFilter = PathFilter + { pathFilterFunction :: FilePath -> Bool + } + +-- | Repair mode +data RepairMode + = RepairMode_DoRepair + | RepairMode_DontRepair + deriving (Bounded, Eq, Generic, Enum, Ord, Show) 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 @@ -1,27 +1,379 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} {-| Description : Representation of Nix store paths. -} + module System.Nix.StorePath ( -- * Basic store path types - StorePath(..) - , StorePathName(..) - , StorePathSet + StoreDir(..) + , HasStoreDir(..) + , StorePath + , storePathHash + , storePathName + , StorePathName + , unStorePathName + , StorePathHashPart , mkStorePathHashPart - , StorePathHashPart(..) - , ContentAddressableAddress(..) - , NarHashMode(..) - , -- * Manipulating 'StorePathName' - makeStorePathName - , validStorePathName + , unStorePathHashPart + -- * Manipulating 'StorePathName' + , InvalidNameError(..) + , mkStorePathName + , parseNameText + -- * Reason why a path is not valid + , InvalidPathError(..) , -- * Rendering out 'StorePath's storePathToFilePath , storePathToRawFilePath , storePathToText + , storePathBaseToText + , storePathBaseToRawFilePath , storePathToNarInfo + , storePathHashPartToText , -- * Parsing 'StorePath's - parsePath + parseBasePath + , parseBasePathFromText + , parsePath + , parsePathFromText , pathParser - ) -where + -- * Utilities for tests + , unsafeMakeStorePath + , unsafeMakeStorePathHashPart + ) where -import System.Nix.Internal.StorePath +import Control.DeepSeq (NFData) +import Crypto.Hash (HashAlgorithm) +import Data.Attoparsec.Text.Lazy (Parser, ()) +import Data.ByteString (ByteString) +import Data.Default.Class (Default(def)) +import Data.Hashable (Hashable(hashWithSalt)) +import Data.Text (Text) +import GHC.Generics (Generic) +import System.Nix.Base (BaseEncoding(NixBase32)) + +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 System.Nix.Base qualified +import System.Nix.Hash qualified +import System.Nix.Base32 qualified + +-- | A path in a Nix store. +-- +-- From the Nix thesis: A store path is the full path of a store +-- object. It has the following anatomy: storeDir/hashPart-name. +-- +-- The store directory is *not* included, and must be known from the +-- context. This matches modern C++ Nix, and also represents the fact +-- that store paths for different store directories cannot be mixed. +data StorePath = StorePath + { -- | The 160-bit hash digest reflecting the "address" of the name. + -- Currently, this is a truncated SHA256 hash. + storePathHash :: !StorePathHashPart + , -- | The (typically human readable) name of the path. For packages + -- this is typically the package name and version (e.g. + -- hello-1.2.3). + storePathName :: !StorePathName + } + deriving (Eq, Generic, Ord) + +instance NFData StorePath + +instance Hashable StorePath where + hashWithSalt s StorePath{..} = + s `hashWithSalt` storePathHash `hashWithSalt` storePathName + +instance Show StorePath where + show s = + "StorePath" + <> " " + <> storePathToFilePath (StoreDir mempty) s + +-- | The name portion of a Nix path. +-- +-- 'unStorePathName' must only contain a-zA-Z0-9+._?=-, can't start +-- with a -, and must have at least one character (i.e. it must match +-- 'storePathNameRegex'). +newtype StorePathName = StorePathName + { -- | Extract the contents of the name. + 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. + unStorePathHashPart :: ByteString + } + deriving (Eq, Generic, Hashable, Ord, Show) + +instance NFData StorePathHashPart + +-- | Make @StorePathHashPart@ from @ByteString@ (hash part of the @StorePath@) +-- using specific @HashAlgorithm@ +mkStorePathHashPart + :: forall hashAlgo + . HashAlgorithm hashAlgo + => ByteString + -> StorePathHashPart +mkStorePathHashPart = + StorePathHashPart + . System.Nix.Hash.mkStorePathHash @hashAlgo + +-- | Reason why a path name or output name is not valid +data InvalidNameError + = EmptyName + | NameTooLong Int + | LeadingDot + | InvalidCharacters Text + deriving (Eq, Generic, Hashable, Ord, Show) + +-- | Reason why a path is not valid +data InvalidPathError + = PathNameInvalid InvalidNameError + | HashDecodingFailure String + | RootDirMismatch + { rdMismatchExpected :: StoreDir + , rdMismatchGot :: StoreDir + } + deriving (Eq, Generic, Hashable, Ord, Show) + +-- | Make @StorePathName@ from @Text@ (name part of the @StorePath@) +-- or fail with @InvalidNameError@ if it isn't valid +mkStorePathName :: Text -> Either InvalidNameError StorePathName +mkStorePathName = fmap StorePathName . parseNameText + +-- | Parse name (either @StorePathName@ or @OutputName@) +parseNameText :: Text -> Either InvalidNameError Text +parseNameText n + | n == "" + = Left EmptyName + | Data.Text.head 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 = + any ($ c) + [ Data.Char.isAsciiLower -- 'a'..'z', isAscii..er probably faster then putting it out + , Data.Char.isAsciiUpper -- 'A'..'Z' + , Data.Char.isDigit + , (`elem` ("+-._?=" :: String)) + ] + +-- | Copied from @RawFilePath@ in the @unix@ package, duplicated here +-- to avoid the dependency. +type RawFilePath = ByteString + +-- | The path to the store dir +-- +-- Many operations need to be parameterized with this, since store paths +-- do not know their own store dir by design. +newtype StoreDir = StoreDir { + unStoreDir :: RawFilePath + } deriving (Eq, Generic, Hashable, Ord, Show) + +instance Default StoreDir where + def = StoreDir "/nix/store" + +class HasStoreDir r where + hasStoreDir :: r -> StoreDir + +-- | 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 + +-- | Render a 'StorePath' as a 'Text'. +storePathToText :: StoreDir -> StorePath -> Text +storePathToText storeDir = + Data.Text.pack + . Data.ByteString.Char8.unpack + . storePathToRawFilePath storeDir + +-- | Build `narinfo` suffix from `StorePath` which +-- can be used to query binary caches. +storePathToNarInfo :: StorePath -> ByteString +storePathToNarInfo StorePath{..} = + Data.Text.Encoding.encodeUtf8 + $ System.Nix.Base.encodeWith NixBase32 + (unStorePathHashPart storePathHash) <> ".narinfo" + +-- | Render a 'StorePathHashPart' as a 'Text'. +-- This is used by remote store / database +-- via queryPathFromHashPart +storePathHashPartToText :: StorePathHashPart -> Text +storePathHashPartToText = + System.Nix.Base.encodeWith NixBase32 . unStorePathHashPart + +-- | Parse a base name store path --- no store dir prefix. +-- +-- Internal +parseBasePath' + :: String + -> Either InvalidPathError StorePath +parseBasePath' fname = + let + (storeBasedHashPart, namePart) = Data.Text.breakOn "-" $ Data.Text.pack fname + hashPart = + Data.Bifunctor.bimap + HashDecodingFailure + StorePathHashPart + $ System.Nix.Base.decodeWith NixBase32 storeBasedHashPart + name = + 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 + expectedRootS = Data.ByteString.Char8.unpack (unStoreDir expectedRoot) + storeDir = + if expectedRootS == rootDir' + then pure rootDir' + else Left $ RootDirMismatch + { rdMismatchExpected = expectedRoot + , rdMismatchGot = StoreDir $ Data.ByteString.Char8.pack rootDir + } + in + 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 + :: StoreDir -- ^ expected @StoreDir@ + -> 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`. +parsePathFromText + :: StoreDir -- ^ expected @StoreDir@ + -> Text + -> Either InvalidPathError StorePath +parsePathFromText sd = parsePath' sd . Data.Text.unpack + +-- | Attoparsec @StorePath@ @Parser@ +pathParser :: StoreDir -> Parser StorePath +pathParser expectedRoot = do + let expectedRootT = + Data.Text.pack + . Data.ByteString.Char8.unpack + $ unStoreDir expectedRoot + + _ <- Data.Attoparsec.Text.Lazy.string expectedRootT + "Store root mismatch" -- e.g. /nix/store + + _ <- Data.Attoparsec.Text.Lazy.char '/' + "Expecting path separator" + + digest <- + System.Nix.Base.decodeWith NixBase32 + <$> Data.Attoparsec.Text.Lazy.takeWhile1 + (`elem` System.Nix.Base32.digits32) + "Invalid Base32 part" + + _ <- Data.Attoparsec.Text.Lazy.char '-' + "Expecting dash (path name separator)" + + c0 <- + Data.Attoparsec.Text.Lazy.satisfy + (\c -> c /= '.' && validStorePathNameChar c) + "Leading path name character is a dot or invalid character" + + rest <- + Data.Attoparsec.Text.Lazy.takeWhile + validStorePathNameChar + "Path name contains invalid character" + + let name = + Data.Bifunctor.first + PathNameInvalid + $ mkStorePathName $ Data.Text.cons c0 rest + hashPart = + Data.Bifunctor.bimap + HashDecodingFailure + StorePathHashPart + digest + + either + (fail . show) + pure + (StorePath <$> hashPart <*> name) + +-- * Utilities for tests + +-- | Paths rarely need to be constructed directly. +-- Prefer @parsePath@ or @parsePathFromText@ +unsafeMakeStorePath + :: StorePathHashPart + -> StorePathName + -> StorePath +unsafeMakeStorePath = StorePath + +-- | Path hash parts rarely need to be constructed directly. +-- Prefer @mkStorePathHashPart@ +-- Used by remote store in wire protocol +unsafeMakeStorePathHashPart + :: ByteString + -> StorePathHashPart +unsafeMakeStorePathHashPart = StorePathHashPart 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 new file mode 100644 --- /dev/null +++ b/src/System/Nix/StorePath/Metadata.hs @@ -0,0 +1,59 @@ +{-| +Description : Metadata about Nix store paths. +-} +module System.Nix.StorePath.Metadata + ( Metadata(..) + , StorePathTrust(..) + ) where + +import Crypto.Hash (Digest) +import Data.Dependent.Sum (DSum) +import Data.HashSet (HashSet) +import Data.Set (Set) +import Data.Time (UTCTime) +import Data.Word (Word64) +import GHC.Generics (Generic) + +import System.Nix.Hash (HashAlgo) +import System.Nix.Signature (NamedSignature) +import System.Nix.ContentAddress (ContentAddress) + +-- | How much do we trust the path, based on its provenance? +-- This is called `Ultimate` in Nix, where Ultimate = True +-- means that the path is ultimately trusted, which +-- corresponds to our @BuiltLocally@ +data StorePathTrust + = -- | It was built locally and thus ultimately trusted + BuiltLocally + | -- | It was built elsewhere (and substituted or similar) and so + -- is less trusted + BuiltElsewhere + deriving (Eq, Enum, Generic, Ord, Show) + +-- | Metadata (typically about a 'StorePath') +-- This type corresponds to Nix-es `ValidPathInfo` +data Metadata a = Metadata + { -- | The path to the derivation file that built this path, if any + -- and known. + metadataDeriverPath :: !(Maybe a) + , -- | The hash of the nar serialization of the path. + metadataNarHash :: !(DSum HashAlgo Digest) + , -- | The paths that this path directly references + metadataReferences :: !(HashSet a) + , -- | When was this path registered valid in the store? + metadataRegistrationTime :: !UTCTime + , -- | The size of the nar serialization of the path, in bytes. + metadataNarBytes :: !(Maybe Word64) + , -- | How much we trust this path. Nix-es ultimate + metadataTrust :: !StorePathTrust + , -- | A set of cryptographic attestations of this path's validity. + -- + -- There is no guarantee from this type alone that these + -- signatures are valid. + metadataSigs :: !(Set NamedSignature) + , -- | Whether and how this store path is content-addressable. + -- + -- There is no guarantee from this type alone that this address + -- is actually correct for this store path. + metadataContentAddress :: !(Maybe ContentAddress) + } deriving (Eq, Generic, Ord, Show) diff --git a/src/System/Nix/StorePathMetadata.hs b/src/System/Nix/StorePathMetadata.hs deleted file mode 100644 --- a/src/System/Nix/StorePathMetadata.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-| -Description : Metadata about Nix store paths. --} -module System.Nix.StorePathMetadata where - -import System.Nix.StorePath ( StorePath - , StorePathSet - , ContentAddressableAddress - ) -import System.Nix.Hash ( SomeNamedDigest ) -import Data.Set ( Set ) -import Data.Time ( UTCTime ) -import Data.Word ( Word64 ) -import System.Nix.Signature ( NarSignature ) - --- | Metadata about a 'StorePath' -data StorePathMetadata = StorePathMetadata - { -- | The path this metadata is about - path :: !StorePath - , -- | The path to the derivation file that built this path, if any - -- and known. - deriverPath :: !(Maybe StorePath) - , -- TODO should this be optional? - -- | The hash of the nar serialization of the path. - narHash :: !SomeNamedDigest - , -- | The paths that this path directly references - references :: !StorePathSet - , -- | When was this path registered valid in the store? - registrationTime :: !UTCTime - , -- | The size of the nar serialization of the path, in bytes. - narBytes :: !(Maybe Word64) - , -- | How much we trust this path. - trust :: !StorePathTrust - , -- | A set of cryptographic attestations of this path's validity. - -- - -- There is no guarantee from this type alone that these - -- signatures are valid. - sigs :: !(Set NarSignature) - , -- | Whether and how this store path is content-addressable. - -- - -- There is no guarantee from this type alone that this address - -- is actually correct for this store path. - contentAddressableAddress :: !(Maybe ContentAddressableAddress) - } - --- | How much do we trust the path, based on its provenance? -data StorePathTrust - = -- | It was built locally and thus ultimately trusted - BuiltLocally - | -- | It was built elsewhere (and substituted or similar) and so - -- is less trusted - BuiltElsewhere - deriving (Show, Eq, Ord) diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs deleted file mode 100644 --- a/tests/Arbitrary.hs +++ /dev/null @@ -1,64 +0,0 @@ -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DataKinds #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -module Arbitrary where - -import Control.Monad ( replicateM ) -import qualified Data.ByteString.Char8 as BSC -import qualified Data.Text as T - -import Test.Tasty.QuickCheck - -import System.Nix.Internal.StorePath -import Control.Applicative ( liftA3 ) -import Data.Coerce ( coerce ) -import Crypto.Hash ( SHA256 - , Digest - , hash - ) - -genSafeChar :: Gen Char -genSafeChar = choose ('\1', '\127') -- ASCII without \NUL - -nonEmptyString :: Gen String -nonEmptyString = listOf1 genSafeChar - -dir :: Gen String -dir = ('/':) <$> listOf1 (elements $ '/':['a'..'z']) - -instance Arbitrary StorePathName where - arbitrary = StorePathName . T.pack <$> ((:) <$> s1 <*> listOf sn) - where - alphanum = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'] - s1 = elements $ alphanum <> "+-_?=" - sn = elements $ alphanum <> "+-._?=" - -instance Arbitrary StorePathHashPart where - arbitrary = mkStorePathHashPart . BSC.pack <$> arbitrary - -instance Arbitrary (Digest SHA256) where - arbitrary = hash . BSC.pack <$> arbitrary - -newtype NixLike = NixLike {getNixLike :: StorePath} - deriving (Eq, Ord, Show) - -instance Arbitrary NixLike where - arbitrary = - NixLike <$> - (liftA3 StorePath - arbitraryTruncatedDigest - arbitrary - (pure "/nix/store") - ) - where - -- 160-bit hash, 20 bytes, 32 chars in base32 - arbitraryTruncatedDigest = coerce . BSC.pack <$> replicateM 20 genSafeChar - -instance Arbitrary StorePath where - arbitrary = - liftA3 StorePath - arbitrary - arbitrary - dir 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,48 +0,0 @@ - -module Derivation where - -import Test.Tasty ( TestTree - , testGroup - ) -import Test.Tasty.Golden ( goldenVsFile ) - -import System.Nix.Derivation ( parseDerivation - , buildDerivation - ) - -import qualified Data.Attoparsec.Text -import qualified Data.Text.IO -import qualified Data.Text.Lazy -import qualified Data.Text.Lazy.Builder - -processDerivation :: FilePath -> FilePath -> IO () -processDerivation source dest = do - contents <- Data.Text.IO.readFile source - either - fail - -- It seems to be derivation. - (Data.Text.IO.writeFile dest - . Data.Text.Lazy.toStrict - . Data.Text.Lazy.Builder.toLazyText - . buildDerivation - ) - (Data.Attoparsec.Text.parseOnly - (parseDerivation "/nix/store") - 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 new file mode 100644 --- /dev/null +++ b/tests/Fingerprint.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} +-- Test case from https://code.tvl.fyi/commit/tvix/nix-compat/src/narinfo/fingerprint.rs?id=a834966efd64c1b2306241c3ef20f4258f6b9c4e + +module Fingerprint where + +import Crypto.Error (CryptoFailable(..)) +import Data.Default.Class +import System.Nix.Base (decodeWith, BaseEncoding(Base64)) +import System.Nix.Fingerprint +import System.Nix.Signature +import System.Nix.StorePath +import System.Nix.StorePath.Metadata +import System.Nix.Hash (mkNamedDigest) +import Data.Text (Text) +import Data.Time.Clock (UTCTime(..)) +import Data.Time.Calendar.OrdinalDate (fromOrdinalDate) +import Test.Hspec + +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 + + describe "fingerprint" $ do + + it "is valid for example metadata" $ + metadataFingerprint def exampleStorePath exampleMetadata `shouldBe` exampleFingerprint + + it "allows a successful signature verification" $ do + let msg = Text.encodeUtf8 $ metadataFingerprint def exampleStorePath exampleMetadata + Signature sig' = + case + sig + <$> filter (\(NamedSignature publicKey _) -> publicKey == "cache.nixos.org-1") + (Set.toList (metadataSigs exampleMetadata)) + of + (x:_) -> x + _ -> error "impossible" + sig' `shouldSatisfy` Ed25519.verify pubkey msg + +exampleFingerprint :: Text +exampleFingerprint = "1;/nix/store/syd87l2rxw8cbsxmxl853h0r6pdwhwjr-curl-7.82.0-bin;sha256:1b4sb93wp679q4zx9k1ignby1yna3z7c4c2ri3wphylbc2dwsys0;196040;/nix/store/0jqd0rlxzra1rs38rdxl43yh6rxchgc6-curl-7.82.0,/nix/store/6w8g7njm4mck5dmjxws0z1xnrxvl81xa-glibc-2.34-115,/nix/store/j5jxw3iy7bbz4a57fh9g2xm2gxmyal8h-zlib-1.2.12,/nix/store/yxvjs9drzsphm9pcf42a4byzj1kb9m7k-openssl-1.1.1n"; + +exampleStorePath :: StorePath +exampleStorePath = forceRight $ parsePath def "/nix/store/syd87l2rxw8cbsxmxl853h0r6pdwhwjr-curl-7.82.0-bin" + +exampleMetadata :: Metadata StorePath +exampleMetadata = Metadata + { metadataDeriverPath = Just $ forceRight $ parsePath def "/nix/store/5rwxzi7pal3qhpsyfc16gzkh939q1np6-curl-7.82.0.drv" + , metadataNarHash = forceRight $ mkNamedDigest "sha256" "1b4sb93wp679q4zx9k1ignby1yna3z7c4c2ri3wphylbc2dwsys0" + , metadataReferences = HashSet.fromList $ forceRight . parsePath def <$> ["/nix/store/0jqd0rlxzra1rs38rdxl43yh6rxchgc6-curl-7.82.0","/nix/store/6w8g7njm4mck5dmjxws0z1xnrxvl81xa-glibc-2.34-115","/nix/store/j5jxw3iy7bbz4a57fh9g2xm2gxmyal8h-zlib-1.2.12","/nix/store/yxvjs9drzsphm9pcf42a4byzj1kb9m7k-openssl-1.1.1n"] + , metadataRegistrationTime = UTCTime (fromOrdinalDate 0 0) 0 + , metadataNarBytes = Just 196040 + , metadataTrust = BuiltElsewhere + , metadataSigs = Set.fromList $ forceRight . parseNamedSignature <$> ["cache.nixos.org-1:TsTTb3WGTZKphvYdBHXwo6weVILmTytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==", "test1:519iiVLx/c4Rdt5DNt6Y2Jm6hcWE9+XY69ygiWSZCNGVcmOcyL64uVAJ3cV8vaTusIZdbTnYo9Y7vDNeTmmMBQ=="] + , metadataContentAddress = Nothing + } + +pubkey :: Ed25519.PublicKey +pubkey = forceDecodeB64Pubkey "6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=" + +forceDecodeB64Pubkey :: Text -> Ed25519.PublicKey +forceDecodeB64Pubkey b64EncodedPubkey = let + decoded = forceRight $ decodeWith Base64 b64EncodedPubkey + in case Ed25519.publicKey decoded of + CryptoFailed err -> (error . show) err + CryptoPassed x -> x + +forceRight :: Either a b -> b +forceRight = \case + Right x -> x + _ -> error "forceRight failed" + diff --git a/tests/Hash.hs b/tests/Hash.hs --- a/tests/Hash.hs +++ b/tests/Hash.hs @@ -1,33 +1,23 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Hash where -import Control.Monad ( forM_ ) -import Data.ByteString ( ByteString ) -import qualified Data.ByteString.Char8 as BSC -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 (ByteString) -import Test.Hspec -import Test.Tasty.QuickCheck +import Control.Monad (forM_) +import Crypto.Hash (MD5, SHA1, SHA256, hash) +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.Hash -import System.Nix.StorePath -import Arbitrary -import System.Nix.Internal.Base -import Data.Coerce ( coerce ) -import Crypto.Hash ( MD5 - , SHA1 - , SHA256 - , hash - ) +import System.Nix.Base +import System.Nix.Hash +import System.Nix.StorePath +import Test.Hspec + spec_hash :: Spec spec_hash = do @@ -46,21 +36,9 @@ -- The example in question: -- https://nixos.org/nixos/nix-pills/nix-store-paths.html it "produces same base32 as nix pill flat file example" $ do - let exampleStr = - "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3" - <> "c0d7b98883f9ee3:/nix/store:myfile" - shouldBe (encodeWith NixBase32 $ coerce $ mkStorePathHashPart exampleStr) + shouldBe (encodeWith NixBase32 $ unStorePathHashPart $ mkStorePathHashPart @SHA256 "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3c0d7b98883f9ee3:/nix/store:myfile") "xv2iccirbrvklck36f1g7vldn5v58vck" --- | Test that Nix-like base32 encoding roundtrips -prop_nixBase32Roundtrip :: Property -prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $ - \x -> pure (BSC.pack x) === (B32.decode . B32.encode . BSC.pack $ x) - --- | API variants -prop_nixBase16Roundtrip :: StorePathHashPart -> Property -prop_nixBase16Roundtrip x = pure (coerce x) === decodeWith Base16 (encodeWith Base16 $ coerce x) - -- | Hash encoding conversion ground-truth. -- Similiar to nix/tests/hash.sh spec_nixhash :: Spec @@ -85,30 +63,29 @@ ] it "b16 encoded . b32 decoded should equal original b16" $ - forM_ samples $ \(b16, b32, _b64) -> shouldBe (B16.encode <$> B32.decode b32) (Right b16) + forM_ samples $ \(b16, b32, _b64) -> shouldBe (B16.encode <$> B32.decode b32) (pure b16) it "b64 encoded . b32 decoded should equal original b64" $ - forM_ samples $ \(_b16, b32, b64) -> shouldBe (B64.encode . BSL.fromStrict <$> B32.decode b32) (Right b64) + forM_ samples $ \(_b16, b32, b64) -> shouldBe (B64.encode . BSL.fromStrict <$> B32.decode b32) (pure b64) it "b32 encoded . b64 decoded should equal original b32" $ - forM_ samples $ \(_b16, b32, b64) -> shouldBe (B32.encode . BSL.toStrict <$> B64.decode b64 ) (Right b32) + forM_ samples $ \(_b16, b32, b64) -> shouldBe (B32.encode . BSL.toStrict <$> B64.decode b64 ) (pure b32) it "b16 encoded . b64 decoded should equal original b16" $ - forM_ samples $ \(b16, _b32, b64) -> shouldBe (B16.encode . BSL.toStrict <$> B64.decode b64 ) (Right b16) + forM_ samples $ \(b16, _b32, b64) -> shouldBe (B16.encode . BSL.toStrict <$> B64.decode b64 ) (pure b16) it "b32 encoded . b16 decoded should equal original b32" $ forM_ samples $ \(b16, b32, _b64) -> shouldBe (B32.encode #if MIN_VERSION_base16_bytestring(1,0,0) - <$> B16.decode b16) (Right b32) + <$> B16.decode b16) (pure b32) #else $ fst $ B16.decode b16) (b32) - #endif it "b64 encoded . b16 decoded should equal original b64" $ forM_ samples $ \(b16, _b32, b64) -> shouldBe (B64.encode . BSL.fromStrict #if MIN_VERSION_base16_bytestring(1,0,0) - <$> B16.decode b16) (Right b64) + <$> B16.decode b16) (pure b64) #else $ fst $ B16.decode b16 ) (b64) #endif diff --git a/tests/NarFormat.hs b/tests/NarFormat.hs deleted file mode 100644 --- a/tests/NarFormat.hs +++ /dev/null @@ -1,730 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} - -module NarFormat where - -import Control.Applicative (many, optional, (<|>)) -import qualified Control.Concurrent as Concurrent -import Control.Exception (SomeException, try) -import Control.Monad (replicateM, void, - when) -import Data.Binary.Get (Get, getByteString, - getInt64le, - getLazyByteString, runGet) -import Data.Binary.Put (Put, putInt64le, - putLazyByteString, runPut) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base64.Lazy as B64 -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Lazy as BSL -import qualified Data.ByteString.Lazy.Char8 as BSLC -import Data.Int -import qualified Data.Map as Map -import Data.Maybe (fromMaybe) -import qualified Data.Text as T -import qualified Data.Text.Encoding as E -import System.Directory ( doesDirectoryExist - , doesPathExist - , removeDirectoryRecursive - , removeFile - ) -import qualified System.Directory as Directory -import System.Environment (getEnv) -import System.FilePath ((<.>), ()) -import qualified System.IO as IO -import qualified System.IO.Temp as Temp -import qualified System.Posix.Process as Unix -import qualified System.Process as P -import Test.Tasty as T -import Test.Hspec -import qualified Test.Tasty.HUnit as HU -import Test.Tasty.QuickCheck -import qualified Text.Printf as Printf -import Text.Read (readMaybe) - -import qualified System.Nix.Internal.Nar.Streamer as Nar -import System.Nix.Nar - - - -withBytesAsHandle :: BSLC.ByteString -> (IO.Handle -> IO a) -> IO a -withBytesAsHandle bytes act = do - Temp.withSystemTempFile "nar-test-file-XXXXX" $ \tmpFile h -> do - IO.hClose h - BSL.writeFile tmpFile bytes - IO.withFile tmpFile IO.ReadMode act - -spec_narEncoding :: Spec -spec_narEncoding = do - - -- For a Haskell embedded Nar, check that (decode . encode === id) - let - withTempDir act = Temp.withSystemTempDirectory "nar-test" act - - - roundTrip :: String -> Nar -> IO () - roundTrip narFileName n = withTempDir $ \tmpDir -> do - let packageFilePath = tmpDir narFileName - - e <- doesPathExist packageFilePath - e `shouldBe` False - - res <- withBytesAsHandle (runPut (putNar n)) $ \h -> do - unpackNarIO narEffectsIO h packageFilePath - res `shouldBe` Right () - - e' <- doesPathExist packageFilePath - e' `shouldBe` True - - res' <- Temp.withSystemTempFile "nar-test-file-hnix" $ \tmpFile h -> do - buildNarIO narEffectsIO packageFilePath h - IO.hClose h - BSL.readFile tmpFile - - res' `shouldBe` (runPut $ putNar n) - - -- For a Haskell embedded Nar, check that encoding it gives - -- the same bytestring as `nix-store --dump` - let - encEqualsNixStore :: Nar -> BSL.ByteString -> IO () - encEqualsNixStore n b = runPut (putNar n) `shouldBe` b - - - describe "parser-roundtrip" $ do - it "roundtrips regular" $ do - roundTrip "sampleRegular" (Nar sampleRegular) - - it "roundtrips regular 2" $ do - roundTrip "sampleRegular'" (Nar sampleRegular') - - it "roundtrips executable" $ do - roundTrip "sampleExecutable" (Nar sampleExecutable) - - it "roundtrips directory" $ do - roundTrip "sampleDirectory" (Nar sampleDirectory) - - describe "matches-nix-store fixture" $ do - it "matches regular" $ do - encEqualsNixStore (Nar sampleRegular) sampleRegularBaseline - - it "matches regular'" $ - encEqualsNixStore (Nar sampleRegular') sampleRegular'Baseline - - it "matches executable" $ - encEqualsNixStore (Nar sampleExecutable) sampleExecutableBaseline - - it "matches symlink" $ - encEqualsNixStore (Nar sampleSymLink) sampleSymLinkBaseline - - it "matches directory" $ do - encEqualsNixStore (Nar sampleDirectory) sampleDirectoryBaseline - - -unit_nixStoreRegular :: HU.Assertion -unit_nixStoreRegular = filesystemNixStore "regular" (Nar sampleRegular) - -unit_nixStoreDirectory :: HU.Assertion -unit_nixStoreDirectory = filesystemNixStore "directory" (Nar sampleDirectory) - -unit_nixStoreDirectory' :: HU.Assertion -unit_nixStoreDirectory' = filesystemNixStore "directory'" (Nar sampleDirectory') - -test_nixStoreBigFile :: TestTree -test_nixStoreBigFile = packThenExtract "bigfile" $ \baseDir -> do - mkBigFile (baseDir "bigfile") - - -test_nixStoreBigDir :: TestTree -test_nixStoreBigDir = packThenExtract "bigdir" $ \baseDir -> do - let testDir = baseDir "bigdir" - Directory.createDirectory testDir - mkBigFile (testDir "bf1") - mkBigFile (testDir "bf2") - -- flip mapM_ [1..100] $ \i -> - -- mkBigFile (testDir ('f': show i)) - -- -- Directory.createDirectory (testDir "") - - -prop_narEncodingArbitrary :: Nar -> Property -prop_narEncodingArbitrary n = runGet getNar (runPut $ putNar n) === n - -unit_packSelfSrcDir :: HU.Assertion -unit_packSelfSrcDir = Temp.withSystemTempDirectory "nar-test" $ \tmpDir -> do - ver <- try (P.readProcess "nix-store" ["--version"] "") - let narFilePath = tmpDir "src.nar" - case ver of - Left (_ :: SomeException) -> print ("No nix-store on system" :: String) - Right _ -> do - let go dir = do - srcHere <- doesDirectoryExist dir - case srcHere of - False -> pure () - True -> do - IO.withFile narFilePath IO.WriteMode $ \h -> - buildNarIO narEffectsIO "src" h - hnixNar <- BSL.readFile narFilePath - nixStoreNar <- getNixStoreDump "src" - HU.assertEqual - "src dir serializes the same between hnix-store and nix-store" - hnixNar - nixStoreNar - go "src" - go "hnix-store-core/src" --- ||||||| merged common ancestors --- hnixNar <- runPut . put <$> localPackNar narEffectsIO "src" --- nixStoreNar <- getNixStoreDump "src" --- HU.assertEqual --- "src dir serializes the same between hnix-store and nix-store" --- hnixNar --- nixStoreNar --- ======= --- let narFile = tmpDir "src.nar" --- IO.withFile narFile IO.WriteMode $ \h -> --- buildNarIO narEffectsIO "src" h --- hnixNar <- BSL.readFile narFile --- nixStoreNar <- getNixStoreDump "src" --- HU.assertEqual --- "src dir serializes the same between hnix-store and nix-store" --- hnixNar --- nixStoreNar --- >>>>>>> Use streaming to consume and produce NARs - --- passes -test_streamLargeFileToNar :: TestTree -test_streamLargeFileToNar = HU.testCaseSteps "streamLargeFileToNar" $ \step -> do - - step "create test file" - mkBigFile bigFileName - -- BSL.writeFile narFileName =<< buildNarIO narEffectsIO bigFileName - -- - step "create nar file" - IO.withFile narFileName IO.WriteMode $ \h -> - buildNarIO narEffectsIO bigFileName h - - step "assert bounded memory" - assertBoundedMemory - rmFiles - where - bigFileName = "bigFile.bin" - narFileName = "bigFile.nar" - rmFiles = removeFile bigFileName >> removeFile narFileName - - --------------------------------------------------------------------------------- -test_streamManyFilesToNar :: TestTree -test_streamManyFilesToNar = HU.testCaseSteps "streamManyFilesToNar" $ \step -> - Temp.withSystemTempDirectory "hnix-store" $ \baseDir -> do - let - - packagePath = baseDir "package_with_many_files" - packagePath' = baseDir "package_with_many_files2" - narFilePath = packagePath <.> "nar" - - -- unused, see `step "check file exists"` bellow - _rmFiles = try @SomeException @() $ do - e <- doesPathExist narFilePath - when e $ removeDirectoryRecursive narFilePath - - _run = do - filesPrecount <- countProcessFiles - IO.withFile "hnar" IO.WriteMode $ \h -> - buildNarIO narEffectsIO narFilePath h - filesPostcount <- countProcessFiles - pure $ (-) <$> filesPostcount <*> filesPrecount - - step "create test files" - Directory.createDirectory packagePath - flip mapM_ [0..1000] $ \i -> do - BSL.writeFile (Printf.printf (packagePath "%08d") (i :: Int)) "hi\n" - Concurrent.threadDelay 50 - - filesPrecount <- countProcessFiles - - step "pack nar" - IO.withFile narFilePath IO.WriteMode $ \h -> - buildNarIO narEffectsIO packagePath h - - step "unpack nar" - r <- IO.withFile narFilePath IO.ReadMode $ \h -> - unpackNarIO narEffectsIO h packagePath' - r `shouldBe` Right () - - step "check constant file usage" - filesPostcount <- countProcessFiles - case ((-) <$> filesPostcount <*> filesPrecount) of - Nothing -> pure () - Just c -> c `shouldSatisfy` (< 50) - - -- step "check file exists" - -- e <- doesPathExist packagePath' - -- e `shouldBe` True - - -- step "read the NAR back in" - -- filesCreated <- run `finally` rmFiles - -- filesCreated `shouldSatisfy` (< 50) - - - --- **************** Utilities ************************ - --- | Generate the ground-truth encoding on the fly with --- `nix-store --dump`, rather than generating fixtures --- beforehand -filesystemNixStore :: String -> Nar -> IO () -filesystemNixStore testErrorName n = do - - ver <- try (P.readProcess "nix-store" ["--version"] "") - case ver of - -- Left is not an error - testing machine simply doesn't have - -- `nix-store` executable, so pass - Left (_ :: SomeException) -> print ("No nix-store on system" :: String) - Right _ -> Temp.withSystemTempDirectory "hnix-store" $ \baseDir -> do - - let - testFile = baseDir "testfile" - nixNarFile = baseDir "nixstorenar.nar" - hnixNarFile = baseDir "hnix.nar" - - assertExists f = do - e <- doesPathExist f - e `shouldBe` True - - -- stream nar contents to unpacked file(s) - void $ withBytesAsHandle (runPut $ putNar n) $ \h -> - unpackNarIO narEffectsIO h testFile - - assertExists testFile - - -- nix-store converts those files to nar - getNixStoreDump testFile >>= BSL.writeFile nixNarFile - assertExists nixNarFile - - -- hnix converts those files to nar - IO.withFile hnixNarFile IO.WriteMode $ \h -> - buildNarIO narEffectsIO testFile h - assertExists hnixNarFile - - diffResult <- P.readProcess "diff" [nixNarFile, hnixNarFile] "" - - assertBoundedMemory - HU.assertEqual testErrorName diffResult "" - - --- | Assert that GHC uses less than 100M memory at peak -assertBoundedMemory :: IO () -assertBoundedMemory = do -#ifdef BOUNDED_MEMORY - bytes <- max_live_bytes <$> getRTSStats - bytes < 100 * 1000 * 1000 `shouldBe` True -#else - pure () -#endif - - -packThenExtract - :: String - -- ^ Test name (will also be used for file name) - -> (String -> IO ()) - -- ^ Action to create some files that we will - -- pack into a NAR - -> TestTree -packThenExtract testName setup = - HU.testCaseSteps testName $ \step -> - Temp.withSystemTempDirectory "hnix-store" $ \baseDir -> do - setup baseDir - - let narFilePath = baseDir testName - - ver <- try (P.readProcess "nix-store" ["--version"] "") - case ver of - Left (_ :: SomeException) -> print ("No nix-store on system" :: String) - Right _ -> do - let - nixNarFile = narFilePath <> ".nix" - hnixNarFile = narFilePath <> ".hnix" - outputFile = narFilePath <> ".out" - - step $ "Produce nix-store nar to " <> nixNarFile - (_,_,_,handle) <- P.createProcess (P.shell $ "nix-store --dump " <> narFilePath <> " > " <> nixNarFile) - void $ P.waitForProcess handle - - step $ "Build NAR from " <> narFilePath <> " to " <> hnixNarFile - -- narBS <- buildNarIO narEffectsIO narFile - IO.withFile hnixNarFile IO.WriteMode $ \h -> - buildNarIO narEffectsIO narFilePath h - - -- BSL.writeFile hnixNarFile narBS - - step $ "Unpack NAR to " <> outputFile - _narHandle <- IO.withFile nixNarFile IO.ReadMode $ \h -> - unpackNarIO narEffectsIO h outputFile - - pure () - --- | Count file descriptors owned by the current process -countProcessFiles :: IO (Maybe Int) -countProcessFiles = do - pid <- Unix.getProcessID - hasProc <- doesDirectoryExist "/proc" - if not hasProc - then pure Nothing - else do - let fdDir = "/proc/" <> show pid <> "/fd" - fds <- P.readProcess "ls" [fdDir] "" - pure $ pure $ length $ words fds - - --- | Read the binary output of `nix-store --dump` for a filepath -getNixStoreDump :: String -> IO BSL.ByteString -getNixStoreDump fp = do - (_,Just h, _, _) <- P.createProcess - (P.proc "nix-store" ["--dump", fp]) - {P.std_out = P.CreatePipe} - BSL.hGetContents h - - --- * Several sample FSOs defined in Haskell, for use in encoding/decoding - --- | Simple regular text file with contents 'hi' -sampleRegular :: FileSystemObject -sampleRegular = Regular Nar.NonExecutable 3 "hi\n" - --- | Simple text file with some c code -sampleRegular' :: FileSystemObject -sampleRegular' = Regular Nar.NonExecutable (BSL.length str) str - where str = - "#include \n\nint main(int argc, char *argv[]){ exit 0; }\n" - --- | Executable file -sampleExecutable :: FileSystemObject -sampleExecutable = Regular Nar.Executable (BSL.length str) str - where str = "#!/bin/bash\n\ngcc -o hello hello.c\n" - --- | A simple symlink -sampleSymLink :: FileSystemObject -sampleSymLink = SymLink "hello.c" - - --- | A directory that includes some of the above sample files -sampleDirectory :: FileSystemObject -sampleDirectory = Directory $ Map.fromList - [(FilePathPart "hello.c", sampleRegular') - ,(FilePathPart "build.sh", sampleExecutable) - ,(FilePathPart "hi.c", sampleSymLink) - ] - --- | A deeper directory tree with crossing links -sampleDirectory' :: FileSystemObject -sampleDirectory' = Directory $ Map.fromList [ - - (FilePathPart "foo", Directory $ Map.fromList [ - (FilePathPart "foo.txt", Regular Nar.NonExecutable 8 "foo text") - , (FilePathPart "tobar" , SymLink "../bar/bar.txt") - ]) - - , (FilePathPart "bar", Directory $ Map.fromList [ - (FilePathPart "bar.txt", Regular Nar.NonExecutable 8 "bar text") - , (FilePathPart "tofoo" , SymLink "../foo/foo.txt") - ]) - ] - -sampleLargeFile :: Int64 -> FileSystemObject -sampleLargeFile fSize = - Regular Nar.NonExecutable fSize (BSL.take fSize (BSL.cycle "Lorem ipsum ")) - - -sampleLargeFile' :: Int64 -> FileSystemObject -sampleLargeFile' fSize = - Regular Nar.NonExecutable fSize (BSL.take fSize (BSL.cycle "Lorems ipsums ")) - -sampleLargeDir :: Int64 -> FileSystemObject -sampleLargeDir fSize = Directory $ Map.fromList $ [ - (FilePathPart "bf1", sampleLargeFile fSize) - , (FilePathPart "bf2", sampleLargeFile' fSize) - ] - <> [ (FilePathPart (BSC.pack $ 'f' : show n), - Regular Nar.NonExecutable 10000 (BSL.take 10000 (BSL.cycle "hi "))) - | n <- [1..100 :: Int]] - <> [ - (FilePathPart "d", Directory $ Map.fromList - [ (FilePathPart (BSC.pack $ "df" <> show n) - , Regular Nar.NonExecutable 10000 (BSL.take 10000 (BSL.cycle "subhi "))) - | n <- [1..100 :: Int]] - ) - ] - --------------------------------------------------------------------------------- -sampleDirWithManyFiles :: Int -> FileSystemObject -sampleDirWithManyFiles nFiles = - Directory $ Map.fromList $ mkFile <$> take nFiles [0..] - where - mkFile :: Int -> (FilePathPart, FileSystemObject) - mkFile i = (FilePathPart (BSC.pack (Printf.printf "%08d" i)), - sampleRegular) - --- * For each sample above, feed it into `nix-store --dump`, --- and base64 encode the resulting NAR binary. This lets us --- check our Haskell NAR generator against `nix-store` - --- "hi" file turned to a NAR with `nix-store --dump`, Base64 encoded -sampleRegularBaseline :: BSL.ByteString -sampleRegularBaseline = B64.decodeLenient $ BSL.concat - ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA" - ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHJlZ3VsYXIACAAAAA" - ,"AAAABjb250ZW50cwMAAAAAAAAAaGkKAAAAAAABAAAAAAAAACkAA" - ,"AAAAAAA" - ] - -sampleRegular'Baseline :: BSL.ByteString -sampleRegular'Baseline = B64.decodeLenient $ BSL.concat - ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA" - ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHJlZ3VsYXIACAAAAA" - ,"AAAABjb250ZW50c0AAAAAAAAAAI2luY2x1ZGUgPHN0ZGlvLmg+C" - ,"gppbnQgbWFpbihpbnQgYXJnYywgY2hhciAqYXJndltdKXsgZXhp" - ,"dCAwOyB9CgEAAAAAAAAAKQAAAAAAAAA=" - ] - -sampleExecutableBaseline :: BSL.ByteString -sampleExecutableBaseline = B64.decodeLenient $ BSL.concat - ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA" - ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHJlZ3VsYXIACgAAAA" - ,"AAAABleGVjdXRhYmxlAAAAAAAAAAAAAAAAAAAIAAAAAAAAAGNvb" - ,"nRlbnRzIgAAAAAAAAAjIS9iaW4vYmFzaAoKZ2NjIC1vIGhlbGxv" - ,"IGhlbGxvLmMKAAAAAAAAAQAAAAAAAAApAAAAAAAAAA==" - ] - -sampleSymLinkBaseline :: BSL.ByteString -sampleSymLinkBaseline = B64.decodeLenient $ BSL.concat - ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA" - ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHN5bWxpbmsABgAAAA" - ,"AAAAB0YXJnZXQAAAcAAAAAAAAAaGVsbG8uYwABAAAAAAAAACkAA" - ,"AAAAAAA" - ] - -sampleDirectoryBaseline :: BSL.ByteString -sampleDirectoryBaseline = B64.decodeLenient $ BSL.concat - ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA" - ,"AAAQAAAAAAAAAdHlwZQAAAAAJAAAAAAAAAGRpcmVjdG9yeQAAAA" - ,"AAAAAFAAAAAAAAAGVudHJ5AAAAAQAAAAAAAAAoAAAAAAAAAAQAA" - ,"AAAAAAAbmFtZQAAAAAIAAAAAAAAAGJ1aWxkLnNoBAAAAAAAAABu" - ,"b2RlAAAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAHR5cGUAAAA" - ,"ABwAAAAAAAAByZWd1bGFyAAoAAAAAAAAAZXhlY3V0YWJsZQAAAA" - ,"AAAAAAAAAAAAAACAAAAAAAAABjb250ZW50cyIAAAAAAAAAIyEvY" - ,"mluL2Jhc2gKCmdjYyAtbyBoZWxsbyBoZWxsby5jCgAAAAAAAAEA" - ,"AAAAAAAAKQAAAAAAAAABAAAAAAAAACkAAAAAAAAABQAAAAAAAAB" - ,"lbnRyeQAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAG5hbWUAAA" - ,"AABwAAAAAAAABoZWxsby5jAAQAAAAAAAAAbm9kZQAAAAABAAAAA" - ,"AAAACgAAAAAAAAABAAAAAAAAAB0eXBlAAAAAAcAAAAAAAAAcmVn" - ,"dWxhcgAIAAAAAAAAAGNvbnRlbnRzQAAAAAAAAAAjaW5jbHVkZSA" - ,"8c3RkaW8uaD4KCmludCBtYWluKGludCBhcmdjLCBjaGFyICphcm" - ,"d2W10peyBleGl0IDA7IH0KAQAAAAAAAAApAAAAAAAAAAEAAAAAA" - ,"AAAKQAAAAAAAAAFAAAAAAAAAGVudHJ5AAAAAQAAAAAAAAAoAAAA" - ,"AAAAAAQAAAAAAAAAbmFtZQAAAAAEAAAAAAAAAGhpLmMAAAAABAA" - ,"AAAAAAABub2RlAAAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAH" - ,"R5cGUAAAAABwAAAAAAAABzeW1saW5rAAYAAAAAAAAAdGFyZ2V0A" - ,"AAHAAAAAAAAAGhlbGxvLmMAAQAAAAAAAAApAAAAAAAAAAEAAAAA" - ,"AAAAKQAAAAAAAAABAAAAAAAAACkAAAAAAAAA" - ] - - --- | Control testcase sizes (bytes) by env variable -getBigFileSize :: IO Int64 -getBigFileSize = fromMaybe 5000000 . readMaybe <$> (getEnv "HNIX_BIG_FILE_SIZE" <|> pure "") - - --- | Add a link to a FileSystemObject. This is useful --- when creating Arbitrary FileSystemObjects. It --- isn't implemented yet -mkLink :: - FilePath -- ^ Target - -> FilePath -- ^ Link - -> FileSystemObject -- ^ FileSystemObject to add link to - -> FileSystemObject -mkLink = undefined -- TODO - -mkBigFile :: FilePath -> IO () -mkBigFile path = do - fsize <- getBigFileSize - BSL.writeFile path (BSL.take fsize $ BSL.cycle "Lorem ipsum") - - --- | Construct FilePathPart from Text by checking that there --- are no '/' or '\\NUL' characters -filePathPart :: BSC.ByteString -> Maybe FilePathPart -filePathPart p = case BSC.any (`elem` ['/', '\NUL']) p of - False -> Just $ FilePathPart p - True -> Nothing - -data Nar = Nar { narFile :: FileSystemObject } - deriving (Eq, Show) - --- | A FileSystemObject (FSO) is an anonymous entity that can be NAR archived -data FileSystemObject = - Regular Nar.IsExecutable Int64 BSL.ByteString - -- ^ Reguar file, with its executable state, size (bytes) and contents - | Directory (Map.Map FilePathPart FileSystemObject) - -- ^ Directory with mapping of filenames to sub-FSOs - | SymLink T.Text - -- ^ Symbolic link target - deriving (Eq, Show) - --- | A valid filename or directory name -newtype FilePathPart = FilePathPart { unFilePathPart :: BSC.ByteString } - deriving (Eq, Ord, Show) - - -instance Arbitrary Nar where - arbitrary = Nar <$> resize 10 arbitrary - -instance Arbitrary FileSystemObject where - -- To build an arbitrary Nar, - arbitrary = do - n <- getSize - if n < 2 - then arbFile - else arbDirectory n - - where - - arbFile :: Gen FileSystemObject - arbFile = do - Positive fSize <- arbitrary - Regular - <$> elements [Nar.NonExecutable, Nar.Executable] - <*> pure (fromIntegral fSize) - <*> oneof [ - fmap (BSL.take fSize . BSL.cycle . BSL.pack . getNonEmpty) arbitrary , -- Binary File - fmap (BSL.take fSize . BSL.cycle . BSLC.pack . getNonEmpty) arbitrary -- ASCII File - ] - - arbName :: Gen FilePathPart - arbName = fmap (FilePathPart . BS.pack . fmap (fromIntegral . fromEnum)) $ do - Positive n <- arbitrary - replicateM n (elements $ ['a'..'z'] <> ['0'..'9']) - - arbDirectory :: Int -> Gen FileSystemObject - arbDirectory n = fmap (Directory . Map.fromList) $ replicateM n $ do - nm <- arbName - f <- oneof [arbFile, arbDirectory (n `div` 2)] - pure (nm,f) - ------------------------------------------------------------------------------- --- | Serialize Nar to lazy ByteString -putNar :: Nar -> Put -putNar (Nar file) = header <> parens (putFile file) - where - - header = str "nix-archive-1" - - putFile (Regular isExec fSize contents) = - strs ["type", "regular"] - >> (if isExec == Nar.Executable - then strs ["executable", ""] - else pure ()) - >> putContents fSize contents - - putFile (SymLink target) = - strs ["type", "symlink", "target", BSL.fromStrict $ E.encodeUtf8 target] - - -- toList sorts the entries by FilePathPart before serializing - putFile (Directory entries) = - strs ["type", "directory"] - <> mapM_ putEntry (Map.toList entries) - - putEntry (FilePathPart name, fso) = do - str "entry" - parens $ do - str "name" - str (BSL.fromStrict name) - str "node" - parens (putFile fso) - - parens m = str "(" >> m >> str ")" - - -- Do not use this for file contents - str :: BSL.ByteString -> Put - str t = let len = BSL.length t - in int len <> pad len t - - putContents :: Int64 -> BSL.ByteString -> Put - putContents fSize bs = str "contents" <> int fSize <> (pad fSize bs) - - int :: Integral a => a -> Put - int n = putInt64le $ fromIntegral n - - pad :: Int64 -> BSL.ByteString -> Put - pad strSize bs = do - putLazyByteString bs - putLazyByteString (BSL.replicate (padLen strSize) 0) - - strs :: [BSL.ByteString] -> Put - strs = mapM_ str - --- | Distance to the next multiple of 8 -padLen :: Int64 -> Int64 -padLen n = (8 - n) `mod` 8 - - ------------------------------------------------------------------------------- --- | Deserialize a Nar from lazy ByteString -getNar :: Get Nar -getNar = fmap Nar $ header >> parens getFile - where - - header = assertStr "nix-archive-1" - - -- Fetch a FileSystemObject - getFile = getRegularFile <|> getDirectory <|> getSymLink - - getRegularFile = do - assertStr_ "type" - assertStr_ "regular" - mExecutable <- optional $ Nar.Executable <$ (assertStr "executable" - >> assertStr "") - assertStr_ "contents" - (fSize, contents) <- sizedStr - pure $ Regular (fromMaybe Nar.NonExecutable mExecutable) fSize contents - - getDirectory = do - assertStr_ "type" - assertStr_ "directory" - fs <- many getEntry - pure $ Directory (Map.fromList fs) - - getSymLink = do - assertStr_ "type" - assertStr_ "symlink" - assertStr_ "target" - fmap (SymLink . E.decodeUtf8 . BSL.toStrict) str - - getEntry = do - assertStr_ "entry" - parens $ do - assertStr_ "name" - name <- E.decodeUtf8 . BSL.toStrict <$> str - assertStr_ "node" - file <- parens getFile - maybe (fail $ "Bad FilePathPart: " <> show name) - (pure . (,file)) - (filePathPart $ E.encodeUtf8 name) - - -- Fetch a length-prefixed, null-padded string - str = fmap snd sizedStr - - sizedStr = do - n <- getInt64le - s <- getLazyByteString n - _ <- getByteString . fromIntegral $ padLen n - pure (n,s) - - parens m = assertStr "(" *> m <* assertStr ")" - - assertStr_ = void . assertStr - assertStr s = do - s' <- str - if s == s' - then pure s - else fail "No" 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 new file mode 100644 --- /dev/null +++ b/tests/Signature.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings #-} +-- Inspired by https://cl.tvl.fyi/c/depot/+/10081/1/tvix/nix-compat/src/narinfo/signature.rs +-- and https://github.com/nix-community/go-nix/pull/93 +-- by @flokli and @zimbatm + +module Signature where + +import Data.ByteString qualified as BS +import Test.Hspec +import Data.Text (Text) +import Crypto.PubKey.Ed25519 qualified +import System.Nix.Base qualified +import System.Nix.Base (BaseEncoding(Base64)) +import Crypto.Error (CryptoFailable(..)) + +import System.Nix.Signature + +spec_signature :: Spec +spec_signature = do + + describe "signature parser" $ do + + it "parses names" $ do + shouldParseName "cache.nixos.org-1:TsTTb3WGTZKphvYdBHXwo6weVILmTytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==" "cache.nixos.org-1" + + it "fails on invalid signatures" $ do + shouldNotParse "" + shouldNotParse "asdf" + shouldNotParse "cache.nixos.org-1:" + shouldNotParse ":TsTTb3WGTZKphvYdBHXwo6weVILmTytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==" + shouldNotParse "cache.nixos.org-1TsTTb3WGTZKphvYdBHXwo6weVILmTytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==" + shouldNotParse "cache.nixos.org-1:sTTb3WGTZKphvYdBHXwo6weVILmTytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==" + + it "parses verifying signatures" $ do + shouldVerify "cache.nixos.org-1:TsTTb3WGTZKphvYdBHXwo6weVILmTytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==" pubkeyNixosOrg fingerprint + shouldVerify "cache.nixos.org-2:TsTTb3WGTZKphvYdBHXwo6weVILmTytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==" pubkeyNixosOrg fingerprint + + it "parses non-verifying signatures" $ do + shouldNotVerify "cache.nixos.org-1:TsTTb000000000000000000000000ytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==" pubkeyNixosOrg fingerprint + +fingerprint :: BS.ByteString +fingerprint = "1;/nix/store/syd87l2rxw8cbsxmxl853h0r6pdwhwjr-curl-7.82.0-bin;sha256:1b4sb93wp679q4zx9k1ignby1yna3z7c4c2ri3wphylbc2dwsys0;196040;/nix/store/0jqd0rlxzra1rs38rdxl43yh6rxchgc6-curl-7.82.0,/nix/store/6w8g7njm4mck5dmjxws0z1xnrxvl81xa-glibc-2.34-115,/nix/store/j5jxw3iy7bbz4a57fh9g2xm2gxmyal8h-zlib-1.2.12,/nix/store/yxvjs9drzsphm9pcf42a4byzj1kb9m7k-openssl-1.1.1n"; + +forceDecodeB64Pubkey :: Text -> Crypto.PubKey.Ed25519.PublicKey +forceDecodeB64Pubkey b64EncodedPubkey = let + decoded = case System.Nix.Base.decodeWith Base64 b64EncodedPubkey of + Left err -> error err + Right x -> x + in case Crypto.PubKey.Ed25519.publicKey decoded of + CryptoFailed err -> (error . show) err + CryptoPassed x -> x + +pubkeyNixosOrg :: Crypto.PubKey.Ed25519.PublicKey +pubkeyNixosOrg = forceDecodeB64Pubkey "6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=" + +shouldNotParse :: Text -> Expectation +shouldNotParse encoded = case parseNamedSignature encoded of + Left _ -> pure () + Right _ -> expectationFailure "should not have parsed" + +shouldParseName :: Text -> Text -> Expectation +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 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 parseNamedSignature encoded of + Left err -> expectationFailure err + Right narSig -> let + (Signature sig') = sig narSig + in sig' `shouldNotSatisfy` Crypto.PubKey.Ed25519.verify pubkey msg diff --git a/tests/StorePath.hs b/tests/StorePath.hs --- a/tests/StorePath.hs +++ b/tests/StorePath.hs @@ -1,31 +1,37 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module StorePath where -import qualified Data.Attoparsec.Text +import Test.Hspec (Spec, describe, it, shouldBe) +import Data.Text qualified -import Test.Tasty.QuickCheck +import System.Nix.StorePath (parseNameText, InvalidNameError(..)) -import System.Nix.StorePath -import Arbitrary +spec_storePath :: Spec +spec_storePath = do + describe "parseNameText" $ do + it "parses valid name" $ + parseNameText "name-dev.dotok" + `shouldBe` + pure "name-dev.dotok" --- | Test that Nix(OS) like paths roundtrip -prop_storePathRoundtrip :: NixLike -> NixLike -> Property -prop_storePathRoundtrip (_ :: NixLike) = \(NixLike x) -> - (parsePath "/nix/store" $ storePathToRawFilePath x) === Right x + it "fails on empty" $ + parseNameText mempty + `shouldBe` + Left EmptyName --- | Test that any `StorePath` roundtrips -prop_storePathRoundtrip' :: StorePath -> Property -prop_storePathRoundtrip' x = - (parsePath (storePathRoot x) $ storePathToRawFilePath x) === Right x + it "fails on too long" $ + parseNameText (Data.Text.replicate 256 "n") + `shouldBe` + Left (NameTooLong 256) -prop_storePathRoundtripParser :: NixLike -> NixLike -> Property -prop_storePathRoundtripParser (_ :: NixLike) = \(NixLike x) -> - (Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) $ storePathToText x) === Right x + it "fails on leading dot" $ + parseNameText ".ab" + `shouldBe` + Left LeadingDot -prop_storePathRoundtripParser' :: StorePath -> Property -prop_storePathRoundtripParser' x = - (Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) $ storePathToText x) === Right x + it "fails on invalid characters" $ + parseNameText "ab!cd#@" + `shouldBe` + Left (InvalidCharacters "!#@")