hnix-store-core 0.7.0.0 → 0.9.0.0
raw patch · 45 files changed
Files
- CHANGELOG.md +207/−0
- ChangeLog.md +0/−125
- README.md +1/−10
- hnix-store-core.cabal +82/−117
- src/System/Nix/Base.hs +64/−0
- src/System/Nix/Base32.hs +93/−3
- src/System/Nix/Build.hs +78/−41
- src/System/Nix/ContentAddress.hs +139/−0
- src/System/Nix/Derivation.hs +359/−25
- src/System/Nix/DerivedPath.hs +166/−0
- src/System/Nix/FileContentAddress.hs +10/−0
- src/System/Nix/Fingerprint.hs +51/−0
- src/System/Nix/Hash.hs +194/−12
- src/System/Nix/Hash/Truncation.hs +41/−0
- src/System/Nix/Internal/Base.hs +0/−42
- src/System/Nix/Internal/Base32.hs +0/−93
- src/System/Nix/Internal/Hash.hs +0/−99
- src/System/Nix/Internal/Nar/Effects.hs +0/−98
- src/System/Nix/Internal/Nar/Options.hs +0/−28
- src/System/Nix/Internal/Nar/Parser.hs +0/−568
- src/System/Nix/Internal/Nar/Streamer.hs +0/−150
- src/System/Nix/Internal/Signature.hs +0/−45
- src/System/Nix/Internal/StorePath.hs +0/−239
- src/System/Nix/Internal/Truncation.hs +0/−39
- src/System/Nix/Nar.hs +0/−78
- src/System/Nix/OutputName.hs +54/−0
- src/System/Nix/Placeholder.hs +140/−0
- src/System/Nix/ReadonlyStore.hs +0/−94
- src/System/Nix/Realisation.hs +92/−0
- src/System/Nix/Signature.hs +80/−5
- src/System/Nix/Store/Types.hs +18/−0
- src/System/Nix/StorePath.hs +364/−13
- src/System/Nix/StorePath/ContentAddressed.hs +109/−0
- src/System/Nix/StorePath/Metadata.hs +59/−0
- src/System/Nix/StorePathMetadata.hs +0/−51
- tests/Arbitrary.hs +0/−58
- tests/ContentAddressed.hs +133/−0
- tests/Derivation.hs +0/−48
- tests/Fingerprint.hs +76/−0
- tests/Hash.hs +58/−94
- tests/NarFormat.hs +0/−758
- tests/Placeholder.hs +41/−0
- tests/Signature.hs +78/−0
- tests/StorePath.hs +28/−21
- tests/fixtures/case-conflict.nar binary
+ CHANGELOG.md view
@@ -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
− ChangeLog.md
@@ -1,125 +0,0 @@-# ChangeLog--## [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--* Breaking:- * [(link)](https://github.com/haskell-nix/hnix-store/pull/216) `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.--* Additional:- * [(link)](https://github.com/haskell-nix/hnix-store/pull/218) NAR encoding and decoding now supports case-insensitive filesystems.- * 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).- * `data NarOptions` has been added to configure NAR encoding and decoding. The `optUseCaseHack` field can be used to enable or disable the case hack.- * New `streamNarIOWithOptions` and `runParserWithOptions` functions have been added to `System.Nix.Nar` to support the new configurable options.--## [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--* Fixed:-- * [(link)](https://github.com/haskell-nix/hnix-store/pull/201) [(link)](https://github.com/haskell-nix/hnix-store/pull/203) NAR serialization compatibility (symlinks, directory symlinks, UTF-8 handling)--## [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:-- * [(link)](https://github.com/haskell-nix/hnix-store/pull/177) `streamNarIO` changes type and returns `NarSource m`- * `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`:- * [(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.
README.md view
@@ -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"`
hnix-store-core.cabal view
@@ -1,123 +1,119 @@ cabal-version: 2.2 name: hnix-store-core-version: 0.7.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- , tests/fixtures/case-conflict.nar -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.Nar.Options- , 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.12 && <5- , relude >= 1.0 , attoparsec- , algebraic-graphs >= 0.5 && < 0.8- , base16-bytestring- , base64-bytestring+ , base16-bytestring >= 1.0+ , base64-bytestring >= 1.2.1 , bytestring- , case-insensitive- , 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- mixins:- base hiding (Prelude)- , relude (Relude as Prelude)- , relude- default-extensions:- OverloadedStrings- , DeriveGeneric- , DeriveDataTypeable- , DeriveFunctor- , DeriveFoldable- , DeriveTraversable- , DeriveLift- , FlexibleContexts- , FlexibleInstances- , StandaloneDeriving- , TypeApplications- , TypeSynonymInstances- , InstanceSigs- , MultiParamTypeClasses- , TupleSections- , LambdaCase- , BangPatterns- , ViewPatterns 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@@ -125,48 +121,17 @@ tasty-discover:tasty-discover build-depends: hnix-store-core- , attoparsec , base- , relude , 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- mixins:- base hiding (Prelude)- , relude (Relude as Prelude)- , relude- default-extensions:- OverloadedStrings- , DeriveGeneric- , DeriveDataTypeable- , DeriveFunctor- , DeriveFoldable- , DeriveTraversable- , DeriveLift- , FlexibleContexts- , FlexibleInstances- , StandaloneDeriving- , TypeApplications- , TypeSynonymInstances- , InstanceSigs- , MultiParamTypeClasses- , TupleSections- , LambdaCase- , BangPatterns- , ViewPatterns- default-language: Haskell2010+ , time+ , unordered-containers
+ src/System/Nix/Base.hs view
@@ -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
src/System/Nix/Base32.hs view
@@ -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)
src/System/Nix/Build.hs view
@@ -1,57 +1,94 @@-{-# language RecordWildCards #-} {-| Description : Build related types Maintainer : srk <srk@48.io> |-} module System.Nix.Build ( BuildMode(..)- , BuildStatus(..)+ , BuildSuccessStatus(..)+ , BuildFailureStatus(..) , BuildResult(..)- , buildSuccess- )-where+ , BuildSuccess(..)+ , BuildFailure(..)+ ) where -import Data.Time ( UTCTime )+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)
+ src/System/Nix/ContentAddress.hs view
@@ -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 (/= ':')
src/System/Nix/Derivation.hs view
@@ -1,32 +1,366 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}+-- See TODOs bellow+{-# OPTIONS_GHC -Wno-orphans #-} +-- | Shared types+ module System.Nix.Derivation- ( parseDerivation- , buildDerivation- )-where+ ( -- * Types+ Derivation'(..)+ , Derivation+ , BasicDerivation -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 ( StoreDir- , StorePath- , storePathToFilePath- )-import qualified System.Nix.StorePath as StorePath+ , DerivationType(..)+ , DerivationOutputs+ , InputAddressedDerivationOutput(..)+ , FixedDerivationOutput(..)+ , ContentAddressedDerivationOutput(..) + , FreeformDerivationOutput(..)+ , FreeformDerivationOutputs+ , toSpecificOutput+ , fromSpecificOutput+ , toSpecificOutputs+ , fromSpecificOutputs + , DerivationInputs(..)+ , derivationInputsFromSingleDerivedPath+ , derivationInputsToDerivedPaths -parseDerivation :: StoreDir -> Text.Lazy.Parser (Derivation StorePath Text)-parseDerivation expectedRoot =- Derivation.parseDerivationWith- ("\"" *> StorePath.pathParser expectedRoot <* "\"")- Derivation.textParser+ , DerivedPathMap(..)+ , ChildNode(..)+ , derivedPathMapFromSingleDerivedPathBuilt+ , derivedPathMapToSet+ ) where -buildDerivation :: StoreDir -> Derivation StorePath Text -> Text.Lazy.Builder-buildDerivation storeDir =- Derivation.buildDerivationWith- (show . storePathToFilePath storeDir)- 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
+ src/System/Nix/DerivedPath.hs view
@@ -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
+ src/System/Nix/FileContentAddress.hs view
@@ -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)
+ src/System/Nix/Fingerprint.hs view
@@ -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]+
src/System/Nix/Hash.hs view
@@ -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
+ src/System/Nix/Hash/Truncation.hs view
@@ -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. <https://crypto.stackexchange.com/questions/56337/strength-of-hash-obtained-by-xor-of-parts-of-sha3>+-- 2. <https://www.reddit.com/r/crypto/comments/6olqfm/ways_to_truncated_hash/>+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
− src/System/Nix/Internal/Base.hs
@@ -1,42 +0,0 @@-{-# language CPP #-}--module System.Nix.Internal.Base- ( BaseEncoding(Base16,NixBase32,Base64)- , encodeWith- , decodeWith- )-where--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 -> ByteString -> Text-encodeWith Base16 = decodeUtf8 . Base16.encode-encodeWith NixBase32 = Base32.encode-encodeWith Base64 = decodeUtf8 . Base64.encode---- | Take the input & @Base@ encoding witness -> decode into @Text@.-decodeWith :: BaseEncoding -> Text -> Either String ByteString-#if MIN_VERSION_base16_bytestring(1,0,0)-decodeWith Base16 = Base16.decode . encodeUtf8-#else-decodeWith Base16 = lDecode -- this tacit sugar simply makes GHC pleased with number of args- where- lDecode t =- case Base16.decode (encodeUtf8 t) of- (x, "") -> pure $ x- _ -> Left $ "Unable to decode base16 string" <> toString t-#endif-decodeWith NixBase32 = Base32.decode-decodeWith Base64 = Base64.decode . encodeUtf8
− src/System/Nix/Internal/Base32.hs
@@ -1,93 +0,0 @@-module System.Nix.Internal.Base32- ( encode- , decode- , digits32- )-where---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.Bits ( shiftR )-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 = toText $ 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- )- (toString what)- of- [(i, _)] -> pure $ 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)
− src/System/Nix/Internal/Hash.hs
@@ -1,99 +0,0 @@-{-|-Description : Cryptographic hashing interface for hnix-store, on top- of the cryptohash family of libraries.--}-{-# language AllowAmbiguousTypes #-}-{-# language TypeFamilies #-}-{-# language ScopedTypeVariables #-}-{-# language DataKinds #-}-{-# language ExistentialQuantification #-}-{-# language CPP #-}--module System.Nix.Internal.Hash- ( NamedAlgo(..)- , SomeNamedDigest(..)- , mkNamedDigest- , encodeDigestWith- , decodeDigestWith- , mkStorePathHash- )-where--import qualified Text.Show-import qualified Crypto.Hash as C-import qualified Data.ByteString as BS-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) -> toString $ "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 $ toString $ "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: " <> toString 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 $ toString sriHash <> " is not a valid " <> toString 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
− src/System/Nix/Internal/Nar/Effects.hs
@@ -1,98 +0,0 @@-{-# language KindSignatures #-}-{-# language RankNTypes #-}-{-# language ScopedTypeVariables #-}--module System.Nix.Internal.Nar.Effects- ( NarEffects(..)- , narEffectsIO- ) where--import Data.Kind ()-import qualified Data.ByteString as Bytes-import qualified Data.ByteString.Lazy as Bytes.Lazy-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 :: Type -> Type) = 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 WriteMode)- (IO.liftIO . IO.hClose)- go- `Exception.Lifted.catch`- cleanupException- where- go :: IO.Handle -> m ()- go handle = do- chunk <- getChunk- case chunk of- Nothing -> pass- 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
− src/System/Nix/Internal/Nar/Options.hs
@@ -1,28 +0,0 @@-module System.Nix.Internal.Nar.Options - ( NarOptions(..)- , defaultNarOptions- , caseHackSuffix- ) where--import qualified System.Info---- | Options for configuring how NAR files are encoded and decoded.-data NarOptions = NarOptions {- optUseCaseHack :: Bool- -- ^ Whether to enable a case hack to support case-insensitive filesystems.- -- Equivalent to the 'use-case-hack' option in the Nix client.- --- -- The case hack rewrites file names to avoid collisions on case-insensitive file systems, e.g. APFS and HFS+ on macOS.- -- Enabled by default on macOS (Darwin).-}--defaultNarOptions :: NarOptions-defaultNarOptions = NarOptions {- optUseCaseHack =- if System.Info.os == "darwin"- then True- else False-}--caseHackSuffix :: Text-caseHackSuffix = "~nix~case~hack~"
− src/System/Nix/Internal/Nar/Parser.hs
@@ -1,568 +0,0 @@--- | A streaming parser for the NAR format--{-# language GeneralizedNewtypeDeriving #-}-{-# language ScopedTypeVariables #-}-{-# language TypeFamilies #-}-{-# language TypeOperators #-}--module System.Nix.Internal.Nar.Parser- ( runParser- , runParserWithOptions- , parseNar- , testParser- , testParser'- )-where--import qualified Relude.Unsafe as Unsafe-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 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 qualified Data.ByteString as Bytes-import qualified Data.CaseInsensitive as CI-import qualified Data.HashMap.Strict as HashMap-import qualified Data.List as List-import qualified Data.Map as Map-import qualified Data.Serialize as Serialize-import qualified Data.Text 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-import qualified System.Nix.Internal.Nar.Options 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 (ParserEnv m) m)- )- a- }- deriving ( Functor, Applicative, Monad, Fail.MonadFail- , Trans.MonadIO, State.MonadState ParserState- , Except.MonadError String- , Reader.MonadReader (ParserEnv m)- )---data ParserEnv m = ParserEnv- { envNarEffects :: Nar.NarEffects m- , envNarOptions :: Nar.NarOptions- }---getNarEffects :: Monad m => NarParser m (Nar.NarEffects m)-getNarEffects = fmap envNarEffects ask---getNarEffect :: Monad m => (Nar.NarEffects m -> a) -> NarParser m a-getNarEffect eff = fmap eff getNarEffects---getNarOptions :: Monad m => NarParser m Nar.NarOptions-getNarOptions = fmap envNarOptions ask---- | 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 @ReadMode@- -> FilePath- -- ^ The root file system object to be created by the NAR- -> m (Either String a)-runParser effs parser h target = do- runParserWithOptions Nar.defaultNarOptions effs parser h target--runParserWithOptions- :: forall m a- . (IO.MonadIO m, Base.MonadBaseControl IO m)- => Nar.NarOptions- -> 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 @ReadMode@- -> FilePath- -- ^ The root file system object to be created by the NAR- -> m (Either String a)-runParserWithOptions opts effs (NarParser action) h target = do- unpackResult <-- runReaderT (runExceptT $ State.evalStateT action state0) (ParserEnv effs opts)- `Exception.Lifted.catch` exceptionHandler- when (isLeft unpackResult) cleanup- pure unpackResult-- where- state0 :: ParserState- state0 =- ParserState- { tokenStack = []- , handle = h- , directoryStack = [target]- , links = []- , filePaths = HashMap.empty- }-- 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 $ (lift . lift . 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- , filePaths :: HashMap.HashMap (CI.CI FilePath) Int- -- ^ A map of case-insensitive files paths to the number of collisions encountered.- -- See @Nar.NarOptions.optUseCaseHack@ for details.- }------------------------------------------------------------------------------------ * 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 = toString 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), Unsafe.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 $ 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 $ 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 $ 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 <- getNarEffect Nar.narStreamFile- lift (streamFile target getChunk)-- when (s == "executable") $ do- effs :: Nar.NarEffects m <- getNarEffects- 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 <- getNarEffect Nar.narCreateDir- target <- currentFile- lift $ createDirectory target- parseEntryOrFinish target-- where-- parseEntryOrFinish :: (IO.MonadIO m, Fail.MonadFail m) => FilePath -> NarParser m ()- parseEntryOrFinish path =- -- 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 path )- ]-- parseEntry :: (IO.MonadIO m, Fail.MonadFail m) => FilePath -> NarParser m ()- parseEntry path = do- opts <- getNarOptions- parens $ do- expectStr "name"- fName <-- if Nar.optUseCaseHack opts then- addCaseHack path =<< parseStr- else- parseStr- pushFileName (toString fName)- expectStr "node"- parens parseFSO- popFileName- parseEntryOrFinish path-- addCaseHack :: (IO.MonadIO m, Fail.MonadFail m) => FilePath -> Text -> NarParser m Text- addCaseHack path fName = do- let key = path </> Text.unpack fName- recordFilePath key- conflictCount <- getFilePathConflictCount key- pure $- if conflictCount > 0 then- fName <> Nar.caseHackSuffix <> show conflictCount- else- fName------------------------------------------------------------------------------------- * 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 $ 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 <- getNarEffect 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)- 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.hGet (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 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 })----- | Add a file path to the collection of encountered file paths-recordFilePath :: Monad m => FilePath -> NarParser m ()-recordFilePath fPath =- State.modify (\s -> s { filePaths = HashMap.insertWith (\_ v -> v + 1) (CI.mk fPath) 0 (filePaths s) })--getFilePathConflictCount :: Monad m => FilePath -> NarParser m Int-getFilePathConflictCount fPath = do- fileMap <- State.gets filePaths- pure $ HashMap.findWithDefault 0 (CI.mk fPath) fileMap----------------------------------------------------------------------------------- * Utilities--testParser :: (m ~ IO) => NarParser m a -> ByteString -> m (Either String a)-testParser p b = do- Bytes.writeFile tmpFileName b- withFile tmpFileName ReadMode $ \h ->- runParser Nar.narEffectsIO p h tmpFileName- where- tmpFileName = "tmp"--testParser' :: (m ~ IO) => FilePath -> IO (Either String ())-testParser' fp =- withFile fp 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)
− src/System/Nix/Internal/Nar/Streamer.hs
@@ -1,150 +0,0 @@--- | Stream out a NAR file from a regular file--{-# LANGUAGE ScopedTypeVariables #-}--module System.Nix.Internal.Nar.Streamer- ( NarSource- , dumpString- , dumpPath- , streamNarIO- , streamNarIOWithOptions- , IsExecutable(..)- )-where--import qualified Control.Monad.IO.Class as IO-import qualified Data.ByteString as Bytes-import qualified Data.ByteString.Lazy as Bytes.Lazy-import qualified Data.Serialize as Serial-import qualified Data.Text as T (pack, breakOn)-import qualified Data.Text.Encoding as TE (encodeUtf8)-import qualified System.Directory as Directory-import System.FilePath ((</>))--import qualified System.Nix.Internal.Nar.Effects as Nar-import qualified System.Nix.Internal.Nar.Options as Nar----- | NarSource--- The source to provide nar to the handler `(ByteString -> m ())`.--- It is isomorphic to ByteString by Yoneda lemma--- if the result is meant to be m ().--- It is done in CPS style so IO can be chunks.-type NarSource m = (ByteString -> m ()) -> m ()----- | dumpString--- dump a string to nar in CPS style. The function takes in a `ByteString`,--- and build a `NarSource m`.-dumpString- :: forall m. IO.MonadIO m- => ByteString -- ^ the string you want to dump- -> NarSource m -- ^ The nar result in CPS style-dumpString text yield = traverse_ (yield . str)- ["nix-archive-1", "(", "type" , "regular", "contents", text, ")"]----- | dumpPath--- shorthand--- build a Source that turn file path to nar using the default narEffectsIO.-dumpPath- :: forall m . IO.MonadIO m- => FilePath -- ^ path for the file you want to dump to nar- -> NarSource m -- ^ the nar result in CPS style-dumpPath = streamNarIO Nar.narEffectsIO----- | 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 => Nar.NarEffects IO -> FilePath -> NarSource m-streamNarIO effs basePath yield =- streamNarIOWithOptions Nar.defaultNarOptions effs basePath yield--streamNarIOWithOptions :: forall m . IO.MonadIO m => Nar.NarOptions -> Nar.NarEffects IO -> FilePath -> NarSource m-streamNarIOWithOptions opts effs basePath yield = do- yield $ str "nix-archive-1"- parens $ go basePath- where- go :: FilePath -> m ()- go path = do- isSymLink <- IO.liftIO $ Nar.narIsSymLink effs path- if isSymLink then do- target <- IO.liftIO $ Nar.narReadLink effs path- yield $- strs ["type", "symlink", "target", filePathToBS target]- else do- isDir <- IO.liftIO $ Nar.narIsDir effs path- if isDir then do- fs <- IO.liftIO (Nar.narListDir effs path)- yield $ strs ["type", "directory"]- forM_ (sort fs) $ \f -> do- yield $ str "entry"- parens $ do- let fullName = path </> f- let serializedPath =- if Nar.optUseCaseHack opts then- filePathToBSWithCaseHack f- else- filePathToBS f- yield $ strs ["name", serializedPath, "node"]- parens $ go fullName- else 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-- 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 (Nar.narReadFile effs path)- yield $ Bytes.replicate (padLen $ fromIntegral fsize) 0--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--int :: Integral a => a -> ByteString-int n = Serial.runPut $ Serial.putInt64le $ fromIntegral n--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--strs :: [ByteString] -> ByteString-strs xs = Bytes.concat $ str <$> xs--filePathToBS :: FilePath -> ByteString-filePathToBS = TE.encodeUtf8 . T.pack--filePathToBSWithCaseHack :: FilePath -> ByteString-filePathToBSWithCaseHack = TE.encodeUtf8 . undoCaseHack . T.pack--undoCaseHack :: Text -> Text-undoCaseHack = fst . T.breakOn Nar.caseHackSuffix
− src/System/Nix/Internal/Signature.hs
@@ -1,45 +0,0 @@-{-|-Description : Nix-relevant interfaces to NaCl signatures.--}-{-# language CPP #-}--module System.Nix.Internal.Signature- ( Signature- , NarSignature(..)- )-where---import qualified Data.ByteString as Bytes-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)
− src/System/Nix/Internal/StorePath.hs
@@ -1,239 +0,0 @@-{-|-Description : Representation of Nix store paths.--}-{-# language ConstraintKinds #-}-{-# language RecordWildCards #-}-{-# language GeneralizedNewtypeDeriving #-}-{-# language ScopedTypeVariables #-}-{-# language AllowAmbiguousTypes #-}-{-# language DataKinds #-}--module System.Nix.Internal.StorePath- ( -- * Basic store path types- StoreDir(..)- , 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 qualified Relude.Unsafe as Unsafe-import System.Nix.Internal.Hash-import System.Nix.Internal.Base-import qualified System.Nix.Internal.Base32 as Nix.Base32--import qualified Data.ByteString.Char8 as Bytes.Char8-import qualified Data.Char as Char-import qualified Data.Text as Text-import Data.Attoparsec.Text.Lazy ( Parser- , (<?>)- )-import qualified Data.Attoparsec.Text.Lazy as Parser.Text.Lazy-import qualified System.FilePath as FilePath-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.------ 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, Ord, Show)--instance Hashable StorePath where- hashWithSalt s StorePath{..} =- s `hashWithSalt` storePathHash `hashWithSalt` storePathName---- | 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, Show)---- | 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---- | 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, Hashable, Ord, Show)---- | Render a 'StorePath' as a 'RawFilePath'.-storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath-storePathToRawFilePath storeDir StorePath{..} =- unStoreDir storeDir <> "/" <> hashPart <> "-" <> name- where- hashPart = encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash- name = encodeUtf8 $ unStorePathName storePathName---- | Render a 'StorePath' as a 'FilePath'.-storePathToFilePath :: StoreDir -> StorePath -> FilePath-storePathToFilePath storeDir = Bytes.Char8.unpack . storePathToRawFilePath storeDir---- | Render a 'StorePath' as a 'Text'.-storePathToText :: StoreDir -> StorePath -> Text-storePathToText storeDir = toText . Bytes.Char8.unpack . storePathToRawFilePath storeDir---- | Build `narinfo` suffix from `StorePath` which--- can be used to query binary caches.-storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString-storePathToNarInfo StorePath{..} =- encodeUtf8 $ encodeWith NixBase32 (coerce storePathHash) <> ".narinfo"---- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking--- that store directory matches `expectedRoot`.-parsePath :: StoreDir -> Bytes.Char8.ByteString -> Either String StorePath-parsePath expectedRoot x =- let- (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x- (storeBasedHashPart, namePart) = Text.breakOn "-" $ toText 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' = Unsafe.init rootDir- expectedRootS = Bytes.Char8.unpack (unStoreDir expectedRoot)- storeDir =- if expectedRootS == rootDir'- then pure rootDir'- else Left $ "Root store dir mismatch, expected" <> expectedRootS <> "got" <> rootDir'- in- either Left (pure $ StorePath <$> coerce storeHash <*> name) storeDir--pathParser :: StoreDir -> Parser StorePath-pathParser expectedRoot = do- let expectedRootS = Bytes.Char8.unpack (unStoreDir expectedRoot)-- _ <-- Parser.Text.Lazy.string (toText expectedRootS)- <?> "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)
− src/System/Nix/Internal/Truncation.hs
@@ -1,39 +0,0 @@-{-# language ScopedTypeVariables #-}-{-# language DataKinds #-}--module System.Nix.Internal.Truncation- ( truncateInNixWay- )-where--import qualified Data.ByteString as Bytes---- | 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. <https://crypto.stackexchange.com/questions/56337/strength-of-hash-obtained-by-xor-of-parts-of-sha3>--- 2. <https://www.reddit.com/r/crypto/comments/6olqfm/ways_to_truncated_hash/>-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
− src/System/Nix/Nar.hs
@@ -1,78 +0,0 @@-{--Description : Generating and consuming NAR files-Maintainer : Shea Levy <shea@shealevy.com>--}--{-# 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-- , Nar.NarOptions(..)- , Nar.defaultNarOptions-- -- * Internal- , Nar.streamNarIO- , Nar.streamNarIOWithOptions- , Nar.runParser- , Nar.runParserWithOptions- , Nar.dumpString- , Nar.dumpPath-- -- * Type- , Nar.NarSource- )-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.Options 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 @WriteMode@.-buildNarIO- :: Nar.NarEffects IO- -> FilePath- -> IO.Handle- -> IO ()-buildNarIO effs basePath outHandle =- Nar.streamNarIO- effs- basePath- (\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10)----- | 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
+ src/System/Nix/OutputName.hs view
@@ -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
+ src/System/Nix/Placeholder.hs view
@@ -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
− src/System/Nix/ReadonlyStore.hs
@@ -1,94 +0,0 @@-{-# language DataKinds #-}-{-# language ScopedTypeVariables #-}--module System.Nix.ReadonlyStore where---import qualified Data.ByteString.Char8 as Bytes.Char8-import qualified Data.ByteString as BS-import qualified Data.HashSet as HS-import System.Nix.Hash-import System.Nix.Nar-import System.Nix.StorePath-import Crypto.Hash ( Context- , Digest- , hash- , hashlazy- , hashInit- , hashUpdate- , hashFinalize- , SHA256- )---makeStorePath- :: forall h- . (NamedAlgo h)- => StoreDir- -> ByteString- -> Digest h- -> StorePathName- -> StorePath-makeStorePath storeDir ty h nm = StorePath (coerce storeHash) nm- where- storeHash = mkStorePathHash @h s- s =- BS.intercalate ":" $- ty:fmap encodeUtf8- [ algoName @h- , encodeDigestWith Base16 h- , toText . Bytes.Char8.unpack $ unStoreDir storeDir- , coerce nm- ]--makeTextPath- :: StoreDir -> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath-makeTextPath storeDir nm h refs = makeStorePath storeDir ty h nm- where- ty =- BS.intercalate ":" $ "text" : sort (storePathToRawFilePath storeDir <$> HS.toList refs)--makeFixedOutputPath- :: forall hashAlgo- . NamedAlgo hashAlgo- => StoreDir- -> Bool- -> Digest hashAlgo- -> StorePathName- -> StorePath-makeFixedOutputPath storeDir recursive h =- if recursive && (algoName @hashAlgo) == "sha256"- then makeStorePath storeDir "source" h- else makeStorePath storeDir "output:out" h'- where- h' =- hash @ByteString @SHA256- $ "fixed:out:"- <> encodeUtf8 (algoName @hashAlgo)- <> (if recursive then ":r:" else ":")- <> encodeUtf8 (encodeDigestWith Base16 h)- <> ":"--computeStorePathForText- :: StoreDir -> StorePathName -> ByteString -> (StorePathSet -> StorePath)-computeStorePathForText storeDir nm = makeTextPath storeDir nm . hash--computeStorePathForPath- :: StoreDir- -> 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 storeDir name pth recursive _pathFilter _repair = do- selectedHash <- if recursive then recursiveContentHash else flatContentHash- pure $ makeFixedOutputPath storeDir recursive selectedHash name- where- recursiveContentHash :: IO (Digest SHA256)- recursiveContentHash = hashFinalize <$> execStateT streamNarUpdate (hashInit @SHA256)- streamNarUpdate :: StateT (Context SHA256) IO ()- streamNarUpdate = streamNarIO narEffectsIO pth (modify . flip (hashUpdate @ByteString @SHA256))-- flatContentHash :: IO (Digest SHA256)- flatContentHash = hashlazy <$> narReadFile narEffectsIO pth
+ src/System/Nix/Realisation.hs view
@@ -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)
src/System/Nix/Signature.hs view
@@ -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)
+ src/System/Nix/Store/Types.hs view
@@ -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)
src/System/Nix/StorePath.hs view
@@ -1,28 +1,379 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-} {-| Description : Representation of Nix store paths. -}+ module System.Nix.StorePath ( -- * Basic store path types StoreDir(..)- , StorePath(..)- , StorePathName(..)- , StorePathSet+ , 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
+ src/System/Nix/StorePath/ContentAddressed.hs view
@@ -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')
+ src/System/Nix/StorePath/Metadata.hs view
@@ -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)
− src/System/Nix/StorePathMetadata.hs
@@ -1,51 +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.Time ( UTCTime )-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)
− tests/Arbitrary.hs
@@ -1,58 +0,0 @@-{-# language DataKinds #-}-{-# OPTIONS_GHC -Wno-orphans #-}--module Arbitrary where--import qualified Data.ByteString.Char8 as BSC--import Test.Tasty.QuickCheck--import System.Nix.Internal.StorePath-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 . toText <$> ((:) <$> 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--instance Arbitrary StoreDir where- arbitrary = StoreDir . ("/" <>) . BSC.pack <$> arbitrary--newtype NixLike = NixLike {getNixLike :: StorePath}- deriving (Eq, Ord, Show)--instance Arbitrary NixLike where- arbitrary =- NixLike <$>- liftA2 StorePath- arbitraryTruncatedDigest- arbitrary- where- -- 160-bit hash, 20 bytes, 32 chars in base32- arbitraryTruncatedDigest = coerce . BSC.pack <$> replicateM 20 genSafeChar--instance Arbitrary StorePath where- arbitrary =- liftA2 StorePath- arbitrary- arbitrary
+ tests/ContentAddressed.hs view
@@ -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"
− tests/Derivation.hs
@@ -1,48 +0,0 @@--module Derivation where--import Test.Tasty ( TestTree- , testGroup- )-import Test.Tasty.Golden ( goldenVsFile )--import System.Nix.StorePath ( StoreDir(..) )-import System.Nix.Derivation ( parseDerivation- , buildDerivation- )--import qualified Data.Attoparsec.Text-import qualified Data.Text.IO-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- . toText- . Data.Text.Lazy.Builder.toLazyText- . buildDerivation (StoreDir "/nix/store")- )- (Data.Attoparsec.Text.parseOnly- (parseDerivation $ StoreDir "/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"
+ tests/Fingerprint.hs view
@@ -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"+
tests/Hash.hs view
@@ -1,59 +1,44 @@-{-# language DataKinds #-}-{-# language ScopedTypeVariables #-}-{-# language CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module Hash where -import qualified Data.ByteString.Base16 as B16-import qualified System.Nix.Base32 as B32-import qualified Data.ByteString.Base64.Lazy as B64+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 Crypto.Hash ( MD5- , SHA1- , SHA256- , hash- , Digest- ) +import System.Nix.Base+import System.Nix.Hash+import System.Nix.StorePath+import Test.Hspec+ spec_hash :: Spec spec_hash = do describe "hashing parity with nix-store" $ do - cmp "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\""- NixBase32 (hash @ByteString @SHA256) "nix-output:foo" "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5"- cmp "produces (base16 . md5) of \"Hello World\" the same as the thesis"- Base16 (hash @ByteString @MD5) "Hello World" "b10a8db164e0754105b7a99be72e3fe5"- cmp "produces (base32 . sha1) of \"Hello World\" the same as the thesis"- NixBase32 (hash @ByteString @SHA1) "Hello World" "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a"+ it "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" $+ shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA256 "nix-output:foo"))+ "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5"+ it "produces (base16 . md5) of \"Hello World\" the same as the thesis" $+ shouldBe (encodeDigestWith Base16 (hash @ByteString @MD5 "Hello World"))+ "b10a8db164e0754105b7a99be72e3fe5"+ it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $+ shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA1 "Hello World"))+ "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" -- 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- shouldBe (encodeWith NixBase32 $ coerce $ mkStorePathHashPart "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3c0d7b98883f9ee3:/nix/store:myfile")+ shouldBe (encodeWith NixBase32 $ unStorePathHashPart $ mkStorePathHashPart @SHA256 "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3c0d7b98883f9ee3:/nix/store:myfile") "xv2iccirbrvklck36f1g7vldn5v58vck"- where- cmp :: String -> BaseEncoding -> (ByteString -> Digest a) -> ByteString -> Text -> SpecWith ()- cmp t b f s h =- it t $- shouldBe (encodeDigestWith b $ f s) h --- | Test that Nix-like base32 encoding roundtrips-prop_nixBase32Roundtrip :: Property-prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $- \x -> pure (encodeUtf8 x) === (B32.decode . B32.encode . encodeUtf8 $ 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@@ -61,68 +46,47 @@ describe "hashing parity with nix-nash" $ do - cmp- "b16 encoded . b32 decoded should equal original b16"- B16.encode B32.decode b32s b16s+ let+ samples = [+ ( "800d59cfcd3c05e900cb4e214be48f6b886a08df"+ , "vw46m23bizj4n8afrc0fj19wrp7mj3c0"+ , "gA1Zz808BekAy04hS+SPa4hqCN8="+ )+ , ( "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"+ , "1b8m03r63zqhnjf7l5wnldhh7c134ap5vpj0850ymkq1iyzicy5s"+ , "ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0="+ )+ , ( "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445"+ , "12k9jiq29iyqm03swfsgiw5mlqs173qazm3n7daz43infy12pyrcdf30fkk3qwv4yl2ick8yipc2mqnlh48xsvvxl60lbx8vp38yji0"+ , "IEqPxt2oLwoM7XvrjgikFlfBbvRosiioJ5vjMacDwzWW/RXBOxsH+aodO+pXeJygMa2Fx6cd1wNU7GMSOMo0RQ=="+ )+ ] - cmp- "b64 encoded . b32 decoded should equal original b64"- (B64.encode . fromStrict) B32.decode b32s b64s+ it "b16 encoded . b32 decoded should equal original b16" $+ forM_ samples $ \(b16, b32, _b64) -> shouldBe (B16.encode <$> B32.decode b32) (pure b16) - cmp- "b32 encoded . b64 decoded should equal original b32"- (B32.encode . toStrict) B64.decode b64s b32s+ it "b64 encoded . b32 decoded should equal original b64" $+ forM_ samples $ \(_b16, b32, b64) -> shouldBe (B64.encode . BSL.fromStrict <$> B32.decode b32) (pure b64) - cmp- "b16 encoded . b64 decoded should equal original b16"- (B16.encode . toStrict) B64.decode b64s b16s+ it "b32 encoded . b64 decoded should equal original b32" $+ forM_ samples $ \(_b16, b32, b64) -> shouldBe (B32.encode . BSL.toStrict <$> B64.decode b64 ) (pure b32) -#if MIN_VERSION_base16_bytestring(1,0,0)- cmp- "b32 encoded . b16 decoded should equal original b32"- B32.encode B16.decode b16s b32s+ it "b16 encoded . b64 decoded should equal original b16" $+ forM_ samples $ \(b16, _b32, b64) -> shouldBe (B16.encode . BSL.toStrict <$> B64.decode b64 ) (pure b16) - cmp- "b64 encoded . b16 decoded should equal original b64"- (B64.encode . fromStrict) B16.decode b16s b64s-#else it "b32 encoded . b16 decoded should equal original b32" $- traverse_ (\ b -> shouldBe (B32.encode $ fst $ B16.decode $ fst b) (snd b)) $ zip b16s b32s+ forM_ samples $ \(b16, b32, _b64) -> shouldBe (B32.encode+#if MIN_VERSION_base16_bytestring(1,0,0)+ <$> B16.decode b16) (pure b32)+#else+ $ fst $ B16.decode b16) (b32)+#endif it "b64 encoded . b16 decoded should equal original b64" $- traverse_ (\ b -> shouldBe (B64.encode . fromStrict $ fst $ B16.decode $ fst b) (snd b)) $ zip b16s b64s+ forM_ samples $ \(b16, _b32, b64) -> shouldBe (B64.encode . BSL.fromStrict+#if MIN_VERSION_base16_bytestring(1,0,0)+ <$> B16.decode b16) (pure b64)+#else+ $ fst $ B16.decode b16 ) (b64) #endif - where- cmp- :: ( Eq b- , Show b- )- => String- -> (a -> b)- -> (c -> Either String a)- -> [c]- -> [b]- -> SpecWith ()- cmp s f1 f2 b1 b2 = it s $ traverse_ (uncurry shouldBe . bimap (fmap f1 . f2) pure) $ zip b1 b2-- b16s = takeAxis (\(a,_,_) -> a)- b32s = takeAxis (\(_,b,_) -> b)- b64s = takeAxis (\(_,_,c) -> c)-- takeAxis f = fmap f samples-- samples =- [ ( "800d59cfcd3c05e900cb4e214be48f6b886a08df"- , "vw46m23bizj4n8afrc0fj19wrp7mj3c0"- , "gA1Zz808BekAy04hS+SPa4hqCN8="- )- , ( "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"- , "1b8m03r63zqhnjf7l5wnldhh7c134ap5vpj0850ymkq1iyzicy5s"- , "ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0="- )- , ( "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445"- , "12k9jiq29iyqm03swfsgiw5mlqs173qazm3n7daz43infy12pyrcdf30fkk3qwv4yl2ick8yipc2mqnlh48xsvvxl60lbx8vp38yji0"- , "IEqPxt2oLwoM7XvrjgikFlfBbvRosiioJ5vjMacDwzWW/RXBOxsH+aodO+pXeJygMa2Fx6cd1wNU7GMSOMo0RQ=="- )- ]
− tests/NarFormat.hs
@@ -1,758 +0,0 @@-{-# language CPP #-}-{-# language ScopedTypeVariables #-}--module NarFormat where--import qualified Control.Concurrent as Concurrent-import Control.Exception (try)-import Data.Binary (Binary(..), decodeFile)-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 qualified Data.Map as Map-import qualified Data.Text as T-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 qualified System.Nix.Internal.Nar.Streamer as Nar-import System.Nix.Nar---- Without the import, `max_live_bytes` and `getRTSStats` are undefined on some setups.-#ifdef BOUNDED_MEMORY-import GHC.Stats-#endif---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- withFile tmpFile 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` pass-- 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)-- it "roundtrips case conflicts" $ do- nar <- decodeFile "tests/fixtures/case-conflict.nar"- roundTrip "caseConflict" nar-- 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-- it "matches symlink to directory" $ do- encEqualsNixStore (Nar sampleLinkToDirectory) sampleLinkToDirectoryBaseline---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- bool- pass- (do- withFile narFilePath 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- )- srcHere- 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"--- withFile narFile 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"- withFile narFileName 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- withFile "hnar" WriteMode $ \h ->- buildNarIO narEffectsIO narFilePath h- filesPostcount <- countProcessFiles- pure $ (-) <$> filesPostcount <*> filesPrecount-- step "create test files"- Directory.createDirectory packagePath- forM_ [0..1000] $ \i -> do- BSL.writeFile (Printf.printf (packagePath </> "%08d") (i :: Int)) "hi\n"- Concurrent.threadDelay 50-- filesPrecount <- countProcessFiles-- step "pack nar"- withFile narFilePath WriteMode $ \h ->- buildNarIO narEffectsIO packagePath h-- step "unpack nar"- r <- withFile narFilePath ReadMode $ \h ->- unpackNarIO narEffectsIO h packagePath'- r `shouldBe` pass-- step "check constant file usage"- filesPostcount <- countProcessFiles- case (-) <$> filesPostcount <*> filesPrecount of- Nothing -> pass- 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- withFile hnixNarFile 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- pass-#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- withFile hnixNarFile WriteMode $ \h ->- buildNarIO narEffectsIO narFilePath h-- -- BSL.writeFile hnixNarFile narBS-- step $ "Unpack NAR to " <> outputFile- _narHandle <- withFile nixNarFile ReadMode $ \h ->- unpackNarIO narEffectsIO h outputFile-- pass---- | 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 <- toText <$> 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 <stdio.h>\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]]- )- ]--sampleLinkToDirectory :: FileSystemObject-sampleLinkToDirectory = Directory $ Map.fromList [- (FilePathPart "foo", Directory $ Map.fromList [- (FilePathPart "file", Regular Nar.NonExecutable 8 "foo text")- ])- , (FilePathPart "linkfoo" , SymLink "foo")- ]-----------------------------------------------------------------------------------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"- ]--sampleLinkToDirectoryBaseline :: BSL.ByteString-sampleLinkToDirectoryBaseline = B64.decodeLenient $ BSL.concat- ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAAAAAQAAAAAAAAAdHlwZQAAAAAJ"- ,"AAAAAAAAAGRpcmVjdG9yeQAAAAAAAAAFAAAAAAAAAGVudHJ5AAAAAQAAAAAAAAAoAAAAAAAAAAQA"- ,"AAAAAAAAbmFtZQAAAAADAAAAAAAAAGZvbwAAAAAABAAAAAAAAABub2RlAAAAAAEAAAAAAAAAKAAA"- ,"AAAAAAAEAAAAAAAAAHR5cGUAAAAACQAAAAAAAABkaXJlY3RvcnkAAAAAAAAABQAAAAAAAABlbnRy"- ,"eQAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAG5hbWUAAAAABAAAAAAAAABmaWxlAAAAAAQAAAAA"- ,"AAAAbm9kZQAAAAABAAAAAAAAACgAAAAAAAAABAAAAAAAAAB0eXBlAAAAAAcAAAAAAAAAcmVndWxh"- ,"cgAIAAAAAAAAAGNvbnRlbnRzCAAAAAAAAABmb28gdGV4dAEAAAAAAAAAKQAAAAAAAAABAAAAAAAA"- ,"ACkAAAAAAAAAAQAAAAAAAAApAAAAAAAAAAEAAAAAAAAAKQAAAAAAAAAFAAAAAAAAAGVudHJ5AAAA"- ,"AQAAAAAAAAAoAAAAAAAAAAQAAAAAAAAAbmFtZQAAAAAHAAAAAAAAAGxpbmtmb28ABAAAAAAAAABu"- ,"b2RlAAAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAHR5cGUAAAAABwAAAAAAAABzeW1saW5rAAYA"- ,"AAAAAAAAdGFyZ2V0AAADAAAAAAAAAGZvbwAAAAAAAQAAAAAAAAApAAAAAAAAAAEAAAAAAAAAKQAA"- ,"AAAAAAABAAAAAAAAACkAAAAAAAAA"- ]---- | 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 = if BSC.any (`elem` ['/', '\NUL']) p then Nothing else Just $ FilePathPart p--newtype Nar = Nar { narFile :: FileSystemObject }- deriving (Eq, Show, Generic)---- | 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 Binary Nar where- get = getNar- put = putNar--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 pass)- >> putContents fSize contents-- putFile (SymLink target) =- strs ["type", "symlink", "target", fromStrict $ 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 (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 . decodeUtf8) str-- getEntry = do- assertStr_ "entry"- parens $ do- assertStr_ "name"- name <- str- assertStr_ "node"- file <- parens getFile- maybe (fail $ "Bad FilePathPart: " <> show name)- (pure . (,file))- (filePathPart $ toStrict 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"
+ tests/Placeholder.hs view
@@ -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"+
+ tests/Signature.hs view
@@ -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
tests/StorePath.hs view
@@ -1,30 +1,37 @@-{-# language DataKinds #-}-{-# language ScopedTypeVariables #-}-{-# language OverloadedStrings #-}+{-# 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 :: StoreDir -> NixLike -> NixLike -> Property-prop_storePathRoundtrip storeDir (_ :: NixLike) (NixLike x) =- parsePath storeDir (storePathToRawFilePath storeDir x) === pure x+ it "fails on empty" $+ parseNameText mempty+ `shouldBe`+ Left EmptyName --- | Test that any `StorePath` roundtrips-prop_storePathRoundtrip' :: StoreDir -> StorePath -> Property-prop_storePathRoundtrip' storeDir x =- parsePath storeDir (storePathToRawFilePath storeDir x) === pure x+ it "fails on too long" $+ parseNameText (Data.Text.replicate 256 "n")+ `shouldBe`+ Left (NameTooLong 256) -prop_storePathRoundtripParser :: StoreDir -> NixLike -> NixLike -> Property-prop_storePathRoundtripParser storeDir (_ :: NixLike) (NixLike x) =- Data.Attoparsec.Text.parseOnly (pathParser storeDir) (storePathToText storeDir x) === pure x+ it "fails on leading dot" $+ parseNameText ".ab"+ `shouldBe`+ Left LeadingDot -prop_storePathRoundtripParser' :: StoreDir -> StorePath -> Property-prop_storePathRoundtripParser' storeDir x =- Data.Attoparsec.Text.parseOnly (pathParser storeDir) (storePathToText storeDir x) === pure x+ it "fails on invalid characters" $+ parseNameText "ab!cd#@"+ `shouldBe`+ Left (InvalidCharacters "!#@")
− tests/fixtures/case-conflict.nar
binary file changed (1000 → absent bytes)