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