diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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 diff --git a/ChangeLog.md b/ChangeLog.md deleted file mode 100644 --- a/ChangeLog.md +++ /dev/null @@ -1,125 +0,0 @@ -# ChangeLog - -## [0.7.0.0](https://github.com/haskell-nix/hnix-store/compare/core-0.6.1.0...core-0.7.0.0) 2023-11-15 - -* Breaking: - * [(link)](https://github.com/haskell-nix/hnix-store/pull/216) `StorePath` no longer carries `storePathRoot` field and we - have a stand-alone `StoreDir` type instead to be used instead of `FilePath` - when store root directory is needed as a context. - -* Additional: - * [(link)](https://github.com/haskell-nix/hnix-store/pull/218) NAR encoding and decoding now supports case-insensitive filesystems. - * The "case hack" replicates the behavior of the `use-case-hack` option in Nix, which adds a suffix to conflicting filenames. - This feature is enabled by default on macOS (darwin). - * `data NarOptions` has been added to configure NAR encoding and decoding. The `optUseCaseHack` field can be used to enable or disable the case hack. - * New `streamNarIOWithOptions` and `runParserWithOptions` functions have been added to `System.Nix.Nar` to support the new configurable options. - -## [0.6.1.0](https://github.com/haskell-nix/hnix-store/compare/core-0.6.0.0...core-0.6.1.0) 2023-01-02 - -* Fixed: - - * [(link)](https://github.com/haskell-nix/hnix-store/pull/201) [(link)](https://github.com/haskell-nix/hnix-store/pull/203) NAR serialization compatibility (symlinks, directory symlinks, UTF-8 handling) - -## [0.6.0.0](https://github.com/haskell-nix/hnix-store/compare/core-0.5.0.0...core-0.6.0.0) 2022-06-06 - -* Breaking: - - * [(link)](https://github.com/haskell-nix/hnix-store/pull/177) `streamNarIO` changes type and returns `NarSource m` - * `FilePath` can turn to `NarSource m` using `dumpPath` - * `ByteString` can turn to `NarSource m` using `dumpString` - -## [0.5.0.0](https://github.com/haskell-nix/hnix-store/compare/0.4.3.0...core-0.5.0.0) 2021-06-10 - -* Breaking: - - * `System.Nix.Hash`: - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/97146b41cc87327625e02b81971aeb2fd7d66a3f) Migration from packages `cryptohash-` -> `cryptonite`: - * rm `newtype Digest` in favour of `cryptonite: newtype Digest` - * rm `data HashAlgorithm` in favour of `cryptonite: class HashAlgorithm` - * rm `class ValidAlgo` in favour of `cryptonite: class HashAlgorithm`. - * `class NamedAlgo` removed `hashSize` in favour of `cryptonite: class HashAlgorithm: hashDigestSize`. Former became a subclass of the latter. - * rm `hash` in favour of `cryptonite: hash` - * rm `hashLazy` in favour of `cryptonite: hashlazy` - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) Base encoding/decoding function for hashes (digests) changed (due to changes in type system & separation of specially truncated Nix Store hasing): - * `encode(InBase -> DigestWith)` - * `decode(Base -> DigestWith)` - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.StorePath`: - * rm `type StorePathHashAlgo = 'Truncated 20 'SHA256` in favour of `StorePathHashPart` & `mkStorePathHashPart`. - * rm `unStorePathName`, please use `GHC: coerce` for `StorePathName <-> Text`, `StorePathName` data constructor is provided. - * `Internal` modules now have export lists, if something, please contact. - - -* Additional: - - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/97146b41cc87327625e02b81971aeb2fd7d66a3f) Support of GHC 9.0. - - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.StorePath`: - * exposed `StorePathName` data constructor to API. - * added `newtype StorePathHashPart = StorePathHashPart ByteString`. - * added builder `mkStorePathHashPart :: ByteString -> StorePathHashPart` - * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.Hash`: - * Nix store (which are specially truncated) hashes are now handled separately from other hashes: - * add `mkStorePathHash` - a function to create a content into Nix storepath-style hash: - `mkStorePathHash :: HashAlgorithm a => ByteString -> ByteString` - but recommend to at once use `mkStorePathHashPart`. - -## [0.4.3.0](https://github.com/haskell-nix/hnix-store/compare/0.4.2.0...0.4.3.0) 2021-05-30 - -* Additional: - * [(link)](https://github.com/haskell-nix/hnix-store/commit/b85f7c875fe6b0bca939ffbcd8b9bd0ab1598aa0) `System.Nix.ReadonlyStore`: add a readonly `computeStorePathForPath` - * [(link)](https://github.com/haskell-nix/hnix-store/commit/db71ecea3109c0ba270fa98a9041a8556e35217f) `System.Nix.ReadonlyStore`: `computeStorePathForPath`: force SHA256 as it's the only valid choice - * [(link)](https://github.com/haskell-nix/hnix-store/commit/5fddf3c66ba1bcabb72c4d6b6e09fb41a7acd62c): `makeTextPath`: order the references - -## [0.4.2.0](https://github.com/haskell-nix/hnix-store/compare/0.4.1.0...0.4.2.0) 2021-03-12 - -* Additional: - - * [(link)](https://github.com/haskell-nix/hnix-store/commit/5d03ffc43cde9448df05e84838ece70cc83b1b6c) Cabal now properly states `tasty-discover` as `build-tool-depends`. - - * [(link)](https://github.com/haskell-nix/hnix-store/commit/b5ad38573d27e0732d0fadfebd98de1f753b4f07) added explicit `hie.yml` cradle description for `cabal` to help Haskell Language Server to work with monorepo. - - * [(link)](https://github.com/haskell-nix/hnix-store/commit/a5b7a614c0e0e11147a93b9a197c2a443afa3244) rm vacuous `Setup.hs`, it was throwing-off HLS, and anyway file is vacuous and gets deprecated by Cabal itself. - - * [(link)](https://github.com/haskell-nix/hnix-store/commit/cf04083aba98ad40d183d1e26251101816cc07ae) Nix dev env: removed GHC 8.6.5 support, afaik it is not even in Nixpkgs anymore. - - * [(link)](https://github.com/haskell-nix/hnix-store/commit/2a897ab581c0501587ce04da6d6e3a6f543b1d72) Test suite: fixed nar test for the envs without `/proc` (test suite now works on `macOS`). - - -## [0.4.1.0](https://github.com/haskell-nix/hnix-store/compare/0.4.0.0...0.4.1.0) 2021-01-16 - -* Big clean-up of dependencies. - -## [0.4.0.0](https://github.com/haskell-nix/hnix-store/compare/0.3.0.0...0.4.0.0) 2020-12-30 - -* `System.Nix.Hash` no longer exports `encodeBase16, decodeBase16` and their `Base32` counterparts. - These were replaced by `encodeInBase` and `decodeBase` functions - accepting `BaseEncoding` data type [#87](https://github.com/haskell-nix/hnix-store/pull/87) -* Support `base16-bytestring >= 1` [#86](https://github.com/haskell-nix/hnix-store/pull/86) [#100](https://github.com/haskell-nix/hnix-store/pull/100) - -## 0.3.0.0 -- 2020-11-29 - -* `System.Nix.Nar` changes API to support NAR format streaming: - * `buildNarIO :: FilePath -> Handle -> IO ()` - Create a NAR from a regular filesystem object, stream it out on the Handle - * `unpackNarIO :: Handle -> FilePath -> IO ()` - Recreate filesystem object from a NAR file accessed by the Handle -* `StorePath` type changed to simple variant without type level -symbolic store path root. -* Added `makeFixedOutputPath` to `System.Nix.ReadonlyStore` -* Added `decodeBase16` and `decodeBase32` to `System.Nix.Hash` -* `System.Nix.StorePath` module now provides - * `storePathToFilePath` and `storePathToText` helpers - * `storePathToNarInfo` for converting paths to `narinfo` URLs - * `parsePath` function - * `pathParser` Attoparsec parser -* Added `System.Nix.Build` module -* Added `System.Nix.Derivation` module -* Removed `System.Nix.Util` module, moved to `hnix-store-remote` -* Added base64 and SHA512 hash support - -## 0.2.0.0 -- 2020-03-12 - -Removed `System.Nix.Store`. We may reintroduce it later when multiple backends -exist and we can tell what common effects they should share. - -## 0.1.0.0 -- 2019-03-18 - -* First version. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,14 +1,5 @@ # hnix-store-core -Core effects for interacting with the Nix store. - -See `NarEffects` in [System.Nix.Internal.Nar.Effects] and the [System.Nix.StorePath] for the available operations -on the store. +Core types and functions for interacting with the Nix store. -[System.Nix.Internal.Nar.Effects]: ./src/System/Nix/Internal/Nar/Effects.hs [System.Nix.StorePath]: ./src/System/Nix/StorePath.hs - - -# Tests - - - `ghcid --command "cabal repl test-suite:format-tests" --test="Main.main"` diff --git a/hnix-store-core.cabal b/hnix-store-core.cabal --- a/hnix-store-core.cabal +++ b/hnix-store-core.cabal @@ -1,123 +1,110 @@ cabal-version: 2.2 name: hnix-store-core -version: 0.7.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 - , tests/fixtures/case-conflict.nar -Common commons - if impl(ghc >= 8.10) - ghc-options: -Wall -Wunused-packages - else - ghc-options: -Wall +common commons + ghc-options: -Wall + default-extensions: + ConstraintKinds + , 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.Nar.Options - , System.Nix.Internal.Signature - , System.Nix.Internal.StorePath - , System.Nix.Nar - , System.Nix.ReadonlyStore + , System.Nix.Hash.Truncation + , System.Nix.OutputName + , System.Nix.Realisation , System.Nix.Signature + , System.Nix.Store.Types , System.Nix.StorePath - , System.Nix.StorePathMetadata + , System.Nix.StorePath.Metadata build-depends: base >=4.12 && <5 - , relude >= 1.0 , attoparsec - , algebraic-graphs >= 0.5 && < 0.8 - , base16-bytestring - , base64-bytestring + , base16-bytestring >= 1.0 + , base64-bytestring >= 1.2.1 , bytestring - , case-insensitive - , cereal , 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 - mixins: - base hiding (Prelude) - , relude (Relude as Prelude) - , relude - default-extensions: - OverloadedStrings - , DeriveGeneric - , DeriveDataTypeable - , DeriveFunctor - , DeriveFoldable - , DeriveTraversable - , DeriveLift - , FlexibleContexts - , FlexibleInstances - , StandaloneDeriving - , TypeApplications - , TypeSynonymInstances - , InstanceSigs - , MultiParamTypeClasses - , TupleSections - , LambdaCase - , BangPatterns - , ViewPatterns hs-source-dirs: src - default-language: Haskell2010 -Flag bounded_memory - description: Run tests of constant memory use (requires +RTS -T) - default: False - -test-suite format-tests +test-suite core import: commons - if flag(bounded_memory) - cpp-options: -DBOUNDED_MEMORY - ghc-options: -rtsopts -fprof-auto type: exitcode-stdio-1.0 main-is: Driver.hs other-modules: - Arbitrary Derivation - NarFormat + Fingerprint Hash + Signature StorePath hs-source-dirs: tests @@ -127,46 +114,16 @@ hnix-store-core , attoparsec , base - , relude , 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 - mixins: - base hiding (Prelude) - , relude (Relude as Prelude) - , relude - default-extensions: - OverloadedStrings - , DeriveGeneric - , DeriveDataTypeable - , DeriveFunctor - , DeriveFoldable - , DeriveTraversable - , DeriveLift - , FlexibleContexts - , FlexibleInstances - , StandaloneDeriving - , TypeApplications - , TypeSynonymInstances - , InstanceSigs - , MultiParamTypeClasses - , TupleSections - , LambdaCase - , BangPatterns - , ViewPatterns - default-language: Haskell2010 + , time + , unordered-containers diff --git a/src/System/Nix/Base.hs b/src/System/Nix/Base.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Base.hs @@ -0,0 +1,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 diff --git a/src/System/Nix/Base32.hs b/src/System/Nix/Base32.hs --- a/src/System/Nix/Base32.hs +++ b/src/System/Nix/Base32.hs @@ -4,7 +4,97 @@ module System.Nix.Base32 ( encode , decode - ) -where + , digits32 + ) where -import System.Nix.Internal.Base32 +import Data.ByteString (ByteString) +import Data.Text (Text) +import Data.Vector (Vector) +import Data.Word (Word8) + +import 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) diff --git a/src/System/Nix/Build.hs b/src/System/Nix/Build.hs --- a/src/System/Nix/Build.hs +++ b/src/System/Nix/Build.hs @@ -1,4 +1,3 @@ -{-# language RecordWildCards #-} {-| Description : Build related types Maintainer : srk @@ -6,52 +5,70 @@ module System.Nix.Build ( BuildMode(..) , BuildStatus(..) - , BuildResult(..) , buildSuccess - ) -where + , BuildResult(..) + ) where -import Data.Time ( UTCTime ) +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 + ] diff --git a/src/System/Nix/ContentAddress.hs b/src/System/Nix/ContentAddress.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/ContentAddress.hs @@ -0,0 +1,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 (/= ':') diff --git a/src/System/Nix/Derivation.hs b/src/System/Nix/Derivation.hs --- a/src/System/Nix/Derivation.hs +++ b/src/System/Nix/Derivation.hs @@ -1,32 +1,45 @@ - module System.Nix.Derivation ( parseDerivation , buildDerivation - ) -where + -- Re-exports + , Derivation(..) + , DerivationOutput(..) + ) where -import qualified Data.Text.Lazy.Builder as Text.Lazy - ( Builder ) -import qualified Data.Attoparsec.Text.Lazy as Text.Lazy - ( Parser ) -import Nix.Derivation ( Derivation ) -import qualified Nix.Derivation as Derivation -import System.Nix.StorePath ( StoreDir - , StorePath - , storePathToFilePath - ) -import qualified System.Nix.StorePath as StorePath +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 :: StoreDir -> 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 :: StoreDir -> Derivation StorePath Text -> Text.Lazy.Builder +buildDerivation :: StoreDir -> Derivation StorePath Text -> Builder buildDerivation storeDir = - Derivation.buildDerivationWith - (show . storePathToFilePath storeDir) - show + Nix.Derivation.buildDerivationWith + (string . System.Nix.StorePath.storePathToText storeDir) + string + where + string = Data.Text.Lazy.Builder.fromText . Data.Text.pack . show diff --git a/src/System/Nix/DerivedPath.hs b/src/System/Nix/DerivedPath.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/DerivedPath.hs @@ -0,0 +1,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 diff --git a/src/System/Nix/Fingerprint.hs b/src/System/Nix/Fingerprint.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Fingerprint.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Description : Fingerprint of Nix store path metadata used for signature verification +-} +module System.Nix.Fingerprint + ( fingerprint + , metadataFingerprint + ) where + +import Crypto.Hash (Digest) +import Data.Dependent.Sum (DSum) +import Data.List (sort) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Text.Lazy (toStrict) +import Data.Text.Lazy.Builder (toLazyText) +import Data.Word (Word64) +import System.Nix.Hash (HashAlgo, algoDigestBuilder) +import System.Nix.StorePath +import System.Nix.StorePath.Metadata (Metadata(..)) + +import 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] + diff --git a/src/System/Nix/Hash.hs b/src/System/Nix/Hash.hs --- a/src/System/Nix/Hash.hs +++ b/src/System/Nix/Hash.hs @@ -1,18 +1,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) diff --git a/src/System/Nix/Hash/Truncation.hs b/src/System/Nix/Hash/Truncation.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Hash/Truncation.hs @@ -0,0 +1,41 @@ +module System.Nix.Hash.Truncation + ( truncateInNixWay + ) where + +import Data.Word (Word8) +import Data.ByteString (ByteString) + +import 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. +-- 2. +truncateInNixWay n c = + Data.ByteString.pack $ fmap truncOutputByte [0 .. n-1] + where + + truncOutputByte :: Int -> Word8 + truncOutputByte i = Data.List.foldl' (aux i) 0 [0 .. Data.ByteString.length c - 1] + + inputByte :: Int -> Word8 + inputByte j = Data.ByteString.index c j + + aux :: Int -> Word8 -> Int -> Word8 + aux i x j = + Data.Bool.bool + id + (`Data.Bits.xor` inputByte j) + (j `mod` n == i) + x diff --git a/src/System/Nix/Internal/Base.hs b/src/System/Nix/Internal/Base.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Base.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# language CPP #-} - -module System.Nix.Internal.Base - ( BaseEncoding(Base16,NixBase32,Base64) - , encodeWith - , decodeWith - ) -where - -import qualified Data.ByteString.Base16 as Base16 -import qualified System.Nix.Base32 as Base32 -- Nix has own Base32 encoding -import qualified Data.ByteString.Base64 as Base64 - --- | Constructors to indicate the base encodings -data BaseEncoding - = NixBase32 - -- | ^ Nix has a special map of Base32 encoding - -- Placed first, since it determines Haskell optimizations of pattern matches, & NixBase seems be the most widely used in Nix. - | Base16 - | Base64 - - --- | Encode @ByteString@ with @Base@ encoding, produce @Text@. -encodeWith :: BaseEncoding -> ByteString -> Text -encodeWith Base16 = decodeUtf8 . Base16.encode -encodeWith NixBase32 = Base32.encode -encodeWith Base64 = decodeUtf8 . Base64.encode - --- | Take the input & @Base@ encoding witness -> decode into @Text@. -decodeWith :: BaseEncoding -> Text -> Either String ByteString -#if MIN_VERSION_base16_bytestring(1,0,0) -decodeWith Base16 = Base16.decode . encodeUtf8 -#else -decodeWith Base16 = lDecode -- this tacit sugar simply makes GHC pleased with number of args - where - lDecode t = - case Base16.decode (encodeUtf8 t) of - (x, "") -> pure $ x - _ -> Left $ "Unable to decode base16 string" <> toString t -#endif -decodeWith NixBase32 = Base32.decode -decodeWith Base64 = Base64.decode . encodeUtf8 diff --git a/src/System/Nix/Internal/Base32.hs b/src/System/Nix/Internal/Base32.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Base32.hs +++ /dev/null @@ -1,93 +0,0 @@ -module System.Nix.Internal.Base32 - ( encode - , decode - , digits32 - ) -where - - -import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Char8 as Bytes.Char8 -import qualified Data.Text -import Data.Vector ( Vector ) -import qualified Data.Vector as Vector -import Data.Bits ( shiftR ) -import Numeric ( readInt ) - - --- omitted: E O U T -digits32 :: Vector Char -digits32 = Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz" - --- | Encode a 'BS.ByteString' in Nix's base32 encoding -encode :: ByteString -> Text -encode c = toText $ takeCharPosFromDict <$> [nChar - 1, nChar - 2 .. 0] - where - -- Each base32 character gives us 5 bits of information, while - -- each byte gives is 8. Because 'div' rounds down, we need to add - -- one extra character to the result, and because of that extra 1 - -- we need to subtract one from the number of bits in the - -- bytestring to cover for the case where the number of bits is - -- already a factor of 5. Thus, the + 1 outside of the 'div' and - -- the - 1 inside of it. - nChar = fromIntegral $ ((Bytes.length c * 8 - 1) `div` 5) + 1 - - byte = Bytes.index c . fromIntegral - - -- May need to switch to a more efficient calculation at some - -- point. - bAsInteger :: Integer - bAsInteger = - sum - [ fromIntegral (byte j) * (256 ^ j) - | j <- [0 .. Bytes.length c - 1] ] - - takeCharPosFromDict :: Integer -> Char - takeCharPosFromDict i = digits32 Vector.! digitInd - where - digitInd = - fromIntegral $ - bAsInteger `div` (32^i) `mod` 32 - --- | Decode Nix's base32 encoded text -decode :: Text -> Either String ByteString -decode what = - bool - (Left "Invalid NixBase32 string") - (unsafeDecode what) - (Data.Text.all (`elem` digits32) what) - --- | Decode Nix's base32 encoded text --- Doesn't check if all elements match `digits32` -unsafeDecode :: Text -> Either String ByteString -unsafeDecode what = - case - readInt - 32 - (`elem` digits32) - (\c -> fromMaybe (error "character not in digits32") - $ Vector.findIndex (== c) digits32 - ) - (toString what) - of - [(i, _)] -> pure $ padded $ integerToBS i - x -> Left $ "Can't decode: readInt returned " <> show x - where - padded x - | Bytes.length x < decLen = x `Bytes.append` bstr - | otherwise = x - where - bstr = Bytes.Char8.pack $ take (decLen - Bytes.length x) (cycle "\NUL") - - decLen = Data.Text.length what * 5 `div` 8 - --- | Encode an Integer to a bytestring --- Similar to Data.Base32String (integerToBS) without `reverse` -integerToBS :: Integer -> ByteString -integerToBS 0 = Bytes.pack [0] -integerToBS i - | i > 0 = Bytes.pack $ unfoldr f i - | otherwise = error "integerToBS not defined for negative values" - where - f 0 = Nothing - f x = Just (fromInteger x :: Word8, x `shiftR` 8) diff --git a/src/System/Nix/Internal/Hash.hs b/src/System/Nix/Internal/Hash.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Hash.hs +++ /dev/null @@ -1,99 +0,0 @@ -{-| -Description : Cryptographic hashing interface for hnix-store, on top - of the cryptohash family of libraries. --} -{-# language AllowAmbiguousTypes #-} -{-# language TypeFamilies #-} -{-# language ScopedTypeVariables #-} -{-# language DataKinds #-} -{-# language ExistentialQuantification #-} -{-# language CPP #-} - -module System.Nix.Internal.Hash - ( NamedAlgo(..) - , SomeNamedDigest(..) - , mkNamedDigest - , encodeDigestWith - , decodeDigestWith - , mkStorePathHash - ) -where - -import qualified Text.Show -import qualified Crypto.Hash as C -import qualified Data.ByteString as BS -import qualified Data.Text as T -import System.Nix.Internal.Base -import Data.ByteArray -import System.Nix.Internal.Truncation - --- | A 'HashAlgorithm' with a canonical name, for serialization --- purposes (e.g. SRI hashes) -class C.HashAlgorithm a => NamedAlgo a where - algoName :: Text - -instance NamedAlgo C.MD5 where - algoName = "md5" - -instance NamedAlgo C.SHA1 where - algoName = "sha1" - -instance NamedAlgo C.SHA256 where - algoName = "sha256" - -instance NamedAlgo C.SHA512 where - algoName = "sha512" - --- | A digest whose 'NamedAlgo' is not known at compile time. -data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (C.Digest a) - -instance Show SomeNamedDigest where - show sd = case sd of - SomeDigest (digest :: C.Digest hashType) -> toString $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest - -mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest -mkNamedDigest name sriHash = - let (sriName, h) = T.breakOnEnd "-" sriHash in - if sriName == "" || sriName == name <> "-" - then mkDigest h - else Left $ toString $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name - where - mkDigest h = case name of - "md5" -> SomeDigest <$> decodeGo C.MD5 h - "sha1" -> SomeDigest <$> decodeGo C.SHA1 h - "sha256" -> SomeDigest <$> decodeGo C.SHA256 h - "sha512" -> SomeDigest <$> decodeGo C.SHA512 h - _ -> Left $ "Unknown hash name: " <> toString name - decodeGo :: forall a . NamedAlgo a => a -> Text -> Either String (C.Digest a) - decodeGo a h - | size == base16Len = decodeDigestWith Base16 h - | size == base32Len = decodeDigestWith NixBase32 h - | size == base64Len = decodeDigestWith Base64 h - | otherwise = Left $ toString sriHash <> " is not a valid " <> toString name <> " hash. Its length (" <> show size <> ") does not match any of " <> show [base16Len, base32Len, base64Len] - where - size = T.length h - hsize = C.hashDigestSize a - base16Len = hsize * 2 - base32Len = ((hsize * 8 - 1) `div` 5) + 1; - base64Len = ((4 * hsize `div` 3) + 3) `div` 4 * 4; - - -mkStorePathHash :: forall a . C.HashAlgorithm a => BS.ByteString -> BS.ByteString -mkStorePathHash bs = - truncateInNixWay 20 $ convert $ C.hash @BS.ByteString @a bs - --- | Take BaseEncoding type of the output -> take the Digeest as input -> encode Digest -encodeDigestWith :: BaseEncoding -> C.Digest a -> T.Text -encodeDigestWith b = encodeWith b . convert - - --- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into Digest -decodeDigestWith :: C.HashAlgorithm a => BaseEncoding -> T.Text -> Either String (C.Digest a) -decodeDigestWith b x = - do - bs <- decodeWith b x - let - toEither = - maybeToRight - ("Cryptonite was not able to convert '(ByteString -> Digest a)' for: '" <> show bs <>"'.") - (toEither . C.digestFromByteString) bs diff --git a/src/System/Nix/Internal/Nar/Effects.hs b/src/System/Nix/Internal/Nar/Effects.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Nar/Effects.hs +++ /dev/null @@ -1,98 +0,0 @@ -{-# language KindSignatures #-} -{-# language RankNTypes #-} -{-# language ScopedTypeVariables #-} - -module System.Nix.Internal.Nar.Effects - ( NarEffects(..) - , narEffectsIO - ) where - -import Data.Kind () -import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Lazy as Bytes.Lazy -import qualified System.Directory as Directory -import System.Posix.Files ( createSymbolicLink - , fileSize - , getFileStatus - , isDirectory - , readSymbolicLink - ) -import qualified System.IO as IO -import qualified Control.Monad.IO.Class as IO -import Control.Monad.Trans.Control (MonadBaseControl) -import qualified Control.Exception.Lifted as Exception.Lifted -import qualified Control.Monad.Fail as MonadFail - -data NarEffects (m :: Type -> Type) = NarEffects { - narReadFile :: FilePath -> m Bytes.Lazy.ByteString - , narWriteFile :: FilePath -> Bytes.Lazy.ByteString -> m () - , narStreamFile :: FilePath -> m (Maybe Bytes.ByteString) -> m () - , narListDir :: FilePath -> m [FilePath] - , narCreateDir :: FilePath -> m () - , narCreateLink :: FilePath -> FilePath -> m () - , narGetPerms :: FilePath -> m Directory.Permissions - , narSetPerms :: FilePath -> Directory.Permissions -> m () - , narIsDir :: FilePath -> m Bool - , narIsSymLink :: FilePath -> m Bool - , narFileSize :: FilePath -> m Int64 - , narReadLink :: FilePath -> m FilePath - , narDeleteDir :: FilePath -> m () - , narDeleteFile :: FilePath -> m () -} - - --- | A particular @NarEffects@ that uses regular POSIX for file manipulation --- You would replace this with your own @NarEffects@ if you wanted a --- different backend -narEffectsIO - :: (IO.MonadIO m, - MonadFail.MonadFail m, - MonadBaseControl IO m - ) => NarEffects m -narEffectsIO = NarEffects { - narReadFile = IO.liftIO . Bytes.Lazy.readFile - , narWriteFile = \a -> IO.liftIO . Bytes.Lazy.writeFile a - , narStreamFile = streamStringOutIO - , narListDir = IO.liftIO . Directory.listDirectory - , narCreateDir = IO.liftIO . Directory.createDirectory - , narCreateLink = \f -> IO.liftIO . createSymbolicLink f - , narGetPerms = IO.liftIO . Directory.getPermissions - , narSetPerms = \f -> IO.liftIO . Directory.setPermissions f - , narIsDir = fmap isDirectory . IO.liftIO . getFileStatus - , narIsSymLink = IO.liftIO . Directory.pathIsSymbolicLink - , narFileSize = fmap (fromIntegral . fileSize) . IO.liftIO . getFileStatus - , narReadLink = IO.liftIO . readSymbolicLink - , narDeleteDir = IO.liftIO . Directory.removeDirectoryRecursive - , narDeleteFile = IO.liftIO . Directory.removeFile - } - - --- | This default implementation for @narStreamFile@ requires @IO.MonadIO@ -streamStringOutIO - :: forall m - .(IO.MonadIO m, - MonadFail.MonadFail m, - MonadBaseControl IO m - ) => FilePath - -> m (Maybe Bytes.ByteString) - -> m () -streamStringOutIO f getChunk = - Exception.Lifted.bracket - (IO.liftIO $ IO.openFile f WriteMode) - (IO.liftIO . IO.hClose) - go - `Exception.Lifted.catch` - cleanupException - where - go :: IO.Handle -> m () - go handle = do - chunk <- getChunk - case chunk of - Nothing -> pass - Just c -> do - IO.liftIO $ Bytes.hPut handle c - go handle - cleanupException (e :: Exception.Lifted.SomeException) = do - IO.liftIO $ Directory.removeFile f - MonadFail.fail $ - "Failed to stream string to " <> f <> ": " <> show e diff --git a/src/System/Nix/Internal/Nar/Options.hs b/src/System/Nix/Internal/Nar/Options.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Nar/Options.hs +++ /dev/null @@ -1,28 +0,0 @@ -module System.Nix.Internal.Nar.Options - ( NarOptions(..) - , defaultNarOptions - , caseHackSuffix - ) where - -import qualified System.Info - --- | Options for configuring how NAR files are encoded and decoded. -data NarOptions = NarOptions { - optUseCaseHack :: Bool - -- ^ Whether to enable a case hack to support case-insensitive filesystems. - -- Equivalent to the 'use-case-hack' option in the Nix client. - -- - -- The case hack rewrites file names to avoid collisions on case-insensitive file systems, e.g. APFS and HFS+ on macOS. - -- Enabled by default on macOS (Darwin). -} - -defaultNarOptions :: NarOptions -defaultNarOptions = NarOptions { - optUseCaseHack = - if System.Info.os == "darwin" - then True - else False -} - -caseHackSuffix :: Text -caseHackSuffix = "~nix~case~hack~" diff --git a/src/System/Nix/Internal/Nar/Parser.hs b/src/System/Nix/Internal/Nar/Parser.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Nar/Parser.hs +++ /dev/null @@ -1,568 +0,0 @@ --- | A streaming parser for the NAR format - -{-# language GeneralizedNewtypeDeriving #-} -{-# language ScopedTypeVariables #-} -{-# language TypeFamilies #-} -{-# language TypeOperators #-} - -module System.Nix.Internal.Nar.Parser - ( runParser - , runParserWithOptions - , parseNar - , testParser - , testParser' - ) -where - -import qualified Relude.Unsafe as Unsafe -import qualified Algebra.Graph as Graph -import qualified Algebra.Graph.ToGraph as Graph -import qualified Control.Concurrent as Concurrent -import qualified Control.Exception.Lifted as Exception.Lifted -import qualified Control.Monad.Except as Except -import qualified Control.Monad.Fail as Fail -import qualified Control.Monad.IO.Class as IO -import qualified Control.Monad.Reader as Reader -import qualified Control.Monad.State as State -import qualified Control.Monad.Trans as Trans -import qualified Control.Monad.Trans.Control as Base -import qualified Data.ByteString as Bytes -import qualified Data.CaseInsensitive as CI -import qualified Data.HashMap.Strict as HashMap -import qualified Data.List as List -import qualified Data.Map as Map -import qualified Data.Serialize as Serialize -import qualified Data.Text as Text -import qualified System.Directory as Directory -import System.FilePath as FilePath -import qualified System.IO as IO - -import qualified System.Nix.Internal.Nar.Effects as Nar -import qualified System.Nix.Internal.Nar.Options as Nar - - --- | NarParser is a monad for parsing a Nar file as a byte stream --- and reconstructing the file system objects inside --- See the definitions of @NarEffects@ for a description --- of the actions the parser can take, and @ParserState@ for the --- internals of the parser -newtype NarParser m a = NarParser - { runNarParser :: - State.StateT - ParserState - (Except.ExceptT - String - (Reader.ReaderT (ParserEnv m) m) - ) - a - } - deriving ( Functor, Applicative, Monad, Fail.MonadFail - , Trans.MonadIO, State.MonadState ParserState - , Except.MonadError String - , Reader.MonadReader (ParserEnv m) - ) - - -data ParserEnv m = ParserEnv - { envNarEffects :: Nar.NarEffects m - , envNarOptions :: Nar.NarOptions - } - - -getNarEffects :: Monad m => NarParser m (Nar.NarEffects m) -getNarEffects = fmap envNarEffects ask - - -getNarEffect :: Monad m => (Nar.NarEffects m -> a) -> NarParser m a -getNarEffect eff = fmap eff getNarEffects - - -getNarOptions :: Monad m => NarParser m Nar.NarOptions -getNarOptions = fmap envNarOptions ask - --- | Run a @NarParser@ over a byte stream --- This is suitable for testing the top-level NAR parser, or any of the --- smaller utilities parsers, if you have bytes appropriate for them -runParser - :: forall m a - . (IO.MonadIO m, Base.MonadBaseControl IO m) - => Nar.NarEffects m - -- ^ Provide the effects set, usually @narEffectsIO@ - -> NarParser m a - -- ^ A parser to run, such as @parseNar@ - -> IO.Handle - -- ^ A handle the stream containg the NAR. It should already be - -- open and in @ReadMode@ - -> FilePath - -- ^ The root file system object to be created by the NAR - -> m (Either String a) -runParser effs parser h target = do - runParserWithOptions Nar.defaultNarOptions effs parser h target - -runParserWithOptions - :: forall m a - . (IO.MonadIO m, Base.MonadBaseControl IO m) - => Nar.NarOptions - -> Nar.NarEffects m - -- ^ Provide the effects set, usually @narEffectsIO@ - -> NarParser m a - -- ^ A parser to run, such as @parseNar@ - -> IO.Handle - -- ^ A handle the stream containg the NAR. It should already be - -- open and in @ReadMode@ - -> FilePath - -- ^ The root file system object to be created by the NAR - -> m (Either String a) -runParserWithOptions opts effs (NarParser action) h target = do - unpackResult <- - runReaderT (runExceptT $ State.evalStateT action state0) (ParserEnv effs opts) - `Exception.Lifted.catch` exceptionHandler - when (isLeft unpackResult) cleanup - pure unpackResult - - where - state0 :: ParserState - state0 = - ParserState - { tokenStack = [] - , handle = h - , directoryStack = [target] - , links = [] - , filePaths = HashMap.empty - } - - exceptionHandler :: Exception.Lifted.SomeException -> m (Either String a) - exceptionHandler e = - pure $ Left $ "Exception while unpacking NAR file: " <> show e - - cleanup :: m () - cleanup = - (\ef trg -> do - isDir <- Nar.narIsDir ef trg - bool - (Nar.narDeleteFile ef trg) - (Nar.narDeleteDir ef trg) - isDir - ) effs target - - -instance Trans.MonadTrans NarParser where - lift act = NarParser $ (lift . lift . lift) act - - -data ParserState = ParserState - { tokenStack :: ![Text] - -- ^ The parser can push tokens (words or punctuation) - -- onto this stack. We use this for a very limited backtracking - -- where the Nar format requires it - , directoryStack :: ![String] - -- ^ The parser knows the name of the current FSO it's targeting, - -- and the relative directory path leading there - , handle :: IO.Handle - -- ^ Handle of the input byte stream - , links :: [LinkInfo] - -- ^ Unlike with files and directories, we collect symlinks - -- from the NAR on - , filePaths :: HashMap.HashMap (CI.CI FilePath) Int - -- ^ A map of case-insensitive files paths to the number of collisions encountered. - -- See @Nar.NarOptions.optUseCaseHack@ for details. - } - - ------------------------------------------------------------------------------- --- * Parsers for NAR components - --- | Parse a NAR byte string, producing @()@. --- Parsing a NAR is mostly used for its side-effect: producing --- the file system objects packed in the NAR. That's why we pure @()@ -parseNar :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () -parseNar = do - expectStr "nix-archive-1" - parens parseFSO - createLinks - - -parseFSO :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () -parseFSO = do - expectStr "type" - matchStr - [ ("symlink" , parseSymlink ) - , ("regular" , parseFile ) - , ("directory", parseDirectory) - ] - - --- | Parse a symlink from a NAR, storing the link details in the parser state --- We remember links rather than immediately creating file system objects --- from them, because we might encounter a link in the NAR before we --- encountered its target, and in this case, creating the link will fail --- The final step of creating links is handle by @createLinks@ -parseSymlink :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () -parseSymlink = do - expectStr "target" - target <- parseStr - (dir, file) <- currentDirectoryAndFile - pushLink $ - LinkInfo - { linkTarget = toString target - , linkFile = file - , linkPWD = dir - } - where - currentDirectoryAndFile :: Monad m => NarParser m (FilePath, FilePath) - currentDirectoryAndFile = do - dirStack <- State.gets directoryStack - pure (List.foldr1 () (List.reverse $ drop 1 dirStack), Unsafe.head dirStack) - - --- | Internal data type representing symlinks encountered in the NAR -data LinkInfo = LinkInfo - { linkTarget :: String - -- ^ path to the symlink target, relative to the root of the unpacking NAR - , linkFile :: String - -- ^ file name of the link being created - , linkPWD :: String - -- ^ directory in which to create the link (relative to unpacking root) - } - deriving Show - - --- | When the NAR includes a file, we read from the NAR handle in chunks and --- write the target in chunks. This lets us avoid reading the full contents --- of the encoded file into memory -parseFile :: forall m . (IO.MonadIO m, Fail.MonadFail m) => NarParser m () -parseFile = do - - s <- parseStr - when (s `notElem` ["executable", "contents"]) $ - Fail.fail - $ "Parser found " <> show s - <> " when expecting element from " - <> (show :: [String] -> String) ["executable", "contents"] - when (s == "executable") $ do - expectStr "" - expectStr "contents" - - fSize <- parseLength - - -- Set up for defining `getChunk` - narHandle <- State.gets handle - bytesLeftVar <- IO.liftIO $ newIORef fSize - - let - -- getChunk tracks the number of total bytes we still need to get from the - -- file (starting at the file size, and decrementing by the size of the - -- chunk we read) - getChunk :: m (Maybe ByteString) - getChunk = do - bytesLeft <- IO.liftIO $ readIORef bytesLeftVar - if bytesLeft == 0 - then pure Nothing - else do - chunk <- IO.liftIO $ Bytes.hGetSome narHandle $ fromIntegral $ min 10000 bytesLeft - when (Bytes.null chunk) (Fail.fail "ZERO BYTES") - IO.liftIO $ modifyIORef bytesLeftVar $ \n -> n - fromIntegral (Bytes.length chunk) - - -- This short pause is necessary for letting the garbage collector - -- clean up chunks from previous runs. Without it, heap memory usage can - -- quickly spike - IO.liftIO $ Concurrent.threadDelay 10 - pure $ Just chunk - - target <- currentFile - streamFile <- getNarEffect Nar.narStreamFile - lift (streamFile target getChunk) - - when (s == "executable") $ do - effs :: Nar.NarEffects m <- getNarEffects - lift $ do - p <- Nar.narGetPerms effs target - Nar.narSetPerms effs target (p { Directory.executable = True }) - - expectRawString (Bytes.replicate (padLen $ fromIntegral fSize) 0) - - --- | Parse a NAR encoded directory, being careful not to hold onto file --- handles for target files longer than needed -parseDirectory :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () -parseDirectory = do - createDirectory <- getNarEffect Nar.narCreateDir - target <- currentFile - lift $ createDirectory target - parseEntryOrFinish target - - where - - parseEntryOrFinish :: (IO.MonadIO m, Fail.MonadFail m) => FilePath -> NarParser m () - parseEntryOrFinish path = - -- If we reach a ")", we finished the directory's entries, and we have - -- to put ")" back into the stream, because the outer call to @parens@ - -- expects to consume it. - -- Otherwise, parse an entry as a fresh file system object - matchStr - [ ( ")" , pushStr ")" ) - , ("entry", parseEntry path ) - ] - - parseEntry :: (IO.MonadIO m, Fail.MonadFail m) => FilePath -> NarParser m () - parseEntry path = do - opts <- getNarOptions - parens $ do - expectStr "name" - fName <- - if Nar.optUseCaseHack opts then - addCaseHack path =<< parseStr - else - parseStr - pushFileName (toString fName) - expectStr "node" - parens parseFSO - popFileName - parseEntryOrFinish path - - addCaseHack :: (IO.MonadIO m, Fail.MonadFail m) => FilePath -> Text -> NarParser m Text - addCaseHack path fName = do - let key = path Text.unpack fName - recordFilePath key - conflictCount <- getFilePathConflictCount key - pure $ - if conflictCount > 0 then - fName <> Nar.caseHackSuffix <> show conflictCount - else - fName - - - ------------------------------------------------------------------------------- --- * Utility parsers - - --- | Short strings guiding the NAR parsing are prefixed with their --- length, then encoded in ASCII, and padded to 8 bytes. @parseStr@ --- captures this logic -parseStr :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m Text -parseStr = do - cachedStr <- popStr - case cachedStr of - Just str -> pure str - Nothing -> do - len <- parseLength - strBytes <- consume $ fromIntegral len - expectRawString - (Bytes.replicate (fromIntegral $ padLen $ fromIntegral len) 0) - pure $ decodeUtf8 strBytes - - --- | Get an Int64 describing the length of the upcoming string, --- according to NAR's encoding of ints -parseLength :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m Int64 -parseLength = do - eightBytes <- consume 8 - either - (\e -> Fail.fail $ "parseLength failed to decode int64: " <> e) - pure - (Serialize.runGet Serialize.getInt64le eightBytes) - - --- | Consume a NAR string and assert that it matches an expectation -expectStr :: (IO.MonadIO m, Fail.MonadFail m) => Text -> NarParser m () -expectStr expected = do - actual <- parseStr - when (actual /= expected) $ - Fail.fail $ "Expected " <> err expected <> ", got " <> err actual - where - err t = - show $ - bool - t - (Text.take 10 t <> "...") - (Text.length t > 10) - - --- | Consume a raw string and assert that it equals some expectation. --- This is usually used when consuming padding 0's -expectRawString - :: (IO.MonadIO m, Fail.MonadFail m) => ByteString -> NarParser m () -expectRawString expected = do - actual <- consume $ Bytes.length expected - when (actual /= expected) - $ Fail.fail - $ "Expected " - <> err expected - <> ", got " - <> err actual - where - err bs = - show $ - bool - bs - (Bytes.take 10 bs <> "...") - (Bytes.length bs > 10) - - --- | Consume a NAR string, and dispatch to a parser depending on which string --- matched -matchStr - :: (IO.MonadIO m, Fail.MonadFail m) - => [(Text, NarParser m a)] - -- ^ List of expected possible strings and the parsers they should run - -> NarParser m a -matchStr parsers = do - str <- parseStr - case List.lookup str parsers of - Just p -> p - Nothing -> - Fail.fail $ "Expected one of " <> show (fst <$> parsers) <> " found " <> show str - - --- | Wrap any parser in NAR formatted parentheses --- (a parenthesis is a NAR string, so it needs length encoding and padding) -parens :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m a -> NarParser m a -parens act = do - expectStr "(" - r <- act - expectStr ")" - pure r - - --- | Sort links in the symlink stack according to their connectivity --- (Targets must be created before the links that target them) -createLinks :: IO.MonadIO m => NarParser m () -createLinks = do - createLink <- getNarEffect Nar.narCreateLink - allLinks <- State.gets links - sortedLinks <- IO.liftIO $ sortLinksIO allLinks - forM_ sortedLinks $ \li -> do - pwd <- IO.liftIO Directory.getCurrentDirectory - IO.liftIO $ Directory.setCurrentDirectory (linkPWD li) - lift $ createLink (linkTarget li) (linkFile li) - IO.liftIO $ Directory.setCurrentDirectory pwd - - where - - -- Convert every target and link file to a filepath relative - -- to NAR root, then @Graph.topSort@ it, and map from the - -- relative filepaths back to the original @LinkInfo@. - -- Relative paths are needed for sorting, but @LinkInfo@s - -- are needed for creating the link files - sortLinksIO :: [LinkInfo] -> IO [LinkInfo] - sortLinksIO ls = do - linkLocations <- fmap Map.fromList $ - forM ls $ \li-> - (,li) <$> Directory.canonicalizePath (linkFile li) - canonicalLinks <- forM ls $ \l -> do - targetAbsPath <- Directory.canonicalizePath - (linkPWD l linkTarget l) - fileAbsPath <- Directory.canonicalizePath - (linkFile l) - pure (fileAbsPath, targetAbsPath) - let linkGraph = Graph.edges canonicalLinks - case Graph.topSort linkGraph of - Left _ -> error "Symlinks form a loop" - Right sortedNodes -> - let - sortedLinks = flip Map.lookup linkLocations <$> sortedNodes - in - pure $ catMaybes sortedLinks - - ------------------------------------------------------------------------------- --- * State manipulation - --- | Pull n bytes from the underlying handle, failing if fewer bytes --- are available -consume - :: (IO.MonadIO m, Fail.MonadFail m) - => Int - -> NarParser m ByteString -consume 0 = pure "" -consume n = do - state0 <- State.get - newBytes <- IO.liftIO $ Bytes.hGet (handle state0) (max 0 n) - when (Bytes.length newBytes < n) $ - Fail.fail $ - "consume: Not enough bytes in handle. Wanted " - <> show n <> " got " <> show (Bytes.length newBytes) - pure newBytes - - --- | Pop a string off the token stack -popStr :: Monad m => NarParser m (Maybe Text) -popStr = do - s <- State.get - case uncons (tokenStack s) of - Nothing -> pure Nothing - Just (x, xs) -> do - State.put $ s { tokenStack = xs } - pure $ Just x - - --- | Push a string onto the token stack -pushStr :: Monad m => Text -> NarParser m () -pushStr str = - State.modify $ \s -> -- s { loadedBytes = strBytes <> loadedBytes s } - s { tokenStack = str : tokenStack s } - - --- | Push a level onto the directory stack -pushFileName :: Monad m => FilePath -> NarParser m () -pushFileName fName = - State.modify (\s -> s { directoryStack = fName : directoryStack s }) - - --- | Go to the parent level in the directory stack -popFileName :: Monad m => NarParser m () -popFileName = - State.modify (\s -> s { directoryStack = List.drop 1 (directoryStack s )}) - - --- | Convert the current directory stack into a filepath by interspersing --- the path components with "/" -currentFile :: Monad m => NarParser m FilePath -currentFile = do - dirStack <- State.gets directoryStack - pure $ List.foldr1 () $ List.reverse dirStack - - --- | Add a link to the collection of encountered symlinks -pushLink :: Monad m => LinkInfo -> NarParser m () -pushLink linkInfo = State.modify (\s -> s { links = linkInfo : links s }) - - --- | Add a file path to the collection of encountered file paths -recordFilePath :: Monad m => FilePath -> NarParser m () -recordFilePath fPath = - State.modify (\s -> s { filePaths = HashMap.insertWith (\_ v -> v + 1) (CI.mk fPath) 0 (filePaths s) }) - -getFilePathConflictCount :: Monad m => FilePath -> NarParser m Int -getFilePathConflictCount fPath = do - fileMap <- State.gets filePaths - pure $ HashMap.findWithDefault 0 (CI.mk fPath) fileMap - ------------------------------------------------------------------------------- --- * Utilities - -testParser :: (m ~ IO) => NarParser m a -> ByteString -> m (Either String a) -testParser p b = do - Bytes.writeFile tmpFileName b - withFile tmpFileName ReadMode $ \h -> - runParser Nar.narEffectsIO p h tmpFileName - where - tmpFileName = "tmp" - -testParser' :: (m ~ IO) => FilePath -> IO (Either String ()) -testParser' fp = - withFile fp ReadMode $ \h -> runParser Nar.narEffectsIO parseNar h "tmp" - - - - --- | Distance to the next multiple of 8 -padLen :: Int -> Int -padLen n = (8 - n) `mod` 8 - - -dbgState :: IO.MonadIO m => NarParser m () -dbgState = do - s <- State.get - IO.liftIO $ print (tokenStack s, directoryStack s) diff --git a/src/System/Nix/Internal/Nar/Streamer.hs b/src/System/Nix/Internal/Nar/Streamer.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Nar/Streamer.hs +++ /dev/null @@ -1,150 +0,0 @@ --- | Stream out a NAR file from a regular file - -{-# LANGUAGE ScopedTypeVariables #-} - -module System.Nix.Internal.Nar.Streamer - ( NarSource - , dumpString - , dumpPath - , streamNarIO - , streamNarIOWithOptions - , IsExecutable(..) - ) -where - -import qualified Control.Monad.IO.Class as IO -import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Lazy as Bytes.Lazy -import qualified Data.Serialize as Serial -import qualified Data.Text as T (pack, breakOn) -import qualified Data.Text.Encoding as TE (encodeUtf8) -import qualified System.Directory as Directory -import System.FilePath (()) - -import qualified System.Nix.Internal.Nar.Effects as Nar -import qualified System.Nix.Internal.Nar.Options as Nar - - --- | NarSource --- The source to provide nar to the handler `(ByteString -> m ())`. --- It is isomorphic to ByteString by Yoneda lemma --- if the result is meant to be m (). --- It is done in CPS style so IO can be chunks. -type NarSource m = (ByteString -> m ()) -> m () - - --- | dumpString --- dump a string to nar in CPS style. The function takes in a `ByteString`, --- and build a `NarSource m`. -dumpString - :: forall m. IO.MonadIO m - => ByteString -- ^ the string you want to dump - -> NarSource m -- ^ The nar result in CPS style -dumpString text yield = traverse_ (yield . str) - ["nix-archive-1", "(", "type" , "regular", "contents", text, ")"] - - --- | dumpPath --- shorthand --- build a Source that turn file path to nar using the default narEffectsIO. -dumpPath - :: forall m . IO.MonadIO m - => FilePath -- ^ path for the file you want to dump to nar - -> NarSource m -- ^ the nar result in CPS style -dumpPath = streamNarIO Nar.narEffectsIO - - --- | This implementation of Nar encoding takes an arbitrary @yield@ --- function from any streaming library, and repeatedly calls --- it while traversing the filesystem object to Nar encode -streamNarIO :: forall m . IO.MonadIO m => Nar.NarEffects IO -> FilePath -> NarSource m -streamNarIO effs basePath yield = - streamNarIOWithOptions Nar.defaultNarOptions effs basePath yield - -streamNarIOWithOptions :: forall m . IO.MonadIO m => Nar.NarOptions -> Nar.NarEffects IO -> FilePath -> NarSource m -streamNarIOWithOptions opts effs basePath yield = do - yield $ str "nix-archive-1" - parens $ go basePath - where - go :: FilePath -> m () - go path = do - isSymLink <- IO.liftIO $ Nar.narIsSymLink effs path - if isSymLink then do - target <- IO.liftIO $ Nar.narReadLink effs path - yield $ - strs ["type", "symlink", "target", filePathToBS target] - else do - isDir <- IO.liftIO $ Nar.narIsDir effs path - if isDir then do - fs <- IO.liftIO (Nar.narListDir effs path) - yield $ strs ["type", "directory"] - forM_ (sort fs) $ \f -> do - yield $ str "entry" - parens $ do - let fullName = path f - let serializedPath = - if Nar.optUseCaseHack opts then - filePathToBSWithCaseHack f - else - filePathToBS f - yield $ strs ["name", serializedPath, "node"] - parens $ go fullName - else do - isExec <- IO.liftIO $ isExecutable effs path - yield $ strs ["type", "regular"] - when (isExec == Executable) $ yield $ strs ["executable", ""] - fSize <- IO.liftIO $ Nar.narFileSize effs path - yield $ str "contents" - yield $ int fSize - yieldFile path fSize - - parens act = do - yield $ str "(" - r <- act - yield $ str ")" - pure r - - -- Read, yield, and pad the file - yieldFile :: FilePath -> Int64 -> m () - yieldFile path fsize = do - mapM_ yield . Bytes.Lazy.toChunks =<< IO.liftIO (Nar.narReadFile effs path) - yield $ Bytes.replicate (padLen $ fromIntegral fsize) 0 - -data IsExecutable = NonExecutable | Executable - deriving (Eq, Show) - -isExecutable :: Functor m => Nar.NarEffects m -> FilePath -> m IsExecutable -isExecutable effs fp = - bool - NonExecutable - Executable - . Directory.executable <$> Nar.narGetPerms effs fp - --- | Distance to the next multiple of 8 -padLen :: Int -> Int -padLen n = (8 - n) `mod` 8 - -int :: Integral a => a -> ByteString -int n = Serial.runPut $ Serial.putInt64le $ fromIntegral n - -str :: ByteString -> ByteString -str t = - let - len = Bytes.length t - in - int len <> padBS len t - -padBS :: Int -> ByteString -> ByteString -padBS strSize bs = bs <> Bytes.replicate (padLen strSize) 0 - -strs :: [ByteString] -> ByteString -strs xs = Bytes.concat $ str <$> xs - -filePathToBS :: FilePath -> ByteString -filePathToBS = TE.encodeUtf8 . T.pack - -filePathToBSWithCaseHack :: FilePath -> ByteString -filePathToBSWithCaseHack = TE.encodeUtf8 . undoCaseHack . T.pack - -undoCaseHack :: Text -> Text -undoCaseHack = fst . T.breakOn Nar.caseHackSuffix diff --git a/src/System/Nix/Internal/Signature.hs b/src/System/Nix/Internal/Signature.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Signature.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-| -Description : Nix-relevant interfaces to NaCl signatures. --} -{-# language CPP #-} - -module System.Nix.Internal.Signature - ( Signature - , NarSignature(..) - ) -where - - -import qualified Data.ByteString as Bytes -import Crypto.Saltine.Core.Sign ( PublicKey ) -import Crypto.Saltine.Class ( IsEncoding(..) ) - --- 2021-05-30: NOTE: Please, clean-up these overloads in ~2022 -#if MIN_VERSION_saltine(0,2,0) -import qualified Crypto.Saltine.Internal.Sign as NaClSizes -#else -import qualified Crypto.Saltine.Internal.ByteSizes as NaClSizes -#endif - --- | A NaCl signature. -newtype Signature = Signature ByteString - deriving (Eq, Ord) - -instance IsEncoding Signature where - decode s -#if MIN_VERSION_saltine(0,2,0) - | Bytes.length s == NaClSizes.sign_bytes = Just $ Signature s -#else - | Bytes.length s == NaClSizes.sign = Just $ Signature s -#endif - | otherwise = Nothing - encode = coerce - --- | A detached NaCl signature attesting to a nix archive's validity. -data NarSignature = NarSignature - { -- | The public key used to sign the archive. - publicKey :: PublicKey - , -- | The archive's signature. - sig :: Signature - } - deriving (Eq, Ord) diff --git a/src/System/Nix/Internal/StorePath.hs b/src/System/Nix/Internal/StorePath.hs deleted file mode 100644 --- a/src/System/Nix/Internal/StorePath.hs +++ /dev/null @@ -1,239 +0,0 @@ -{-| -Description : Representation of Nix store paths. --} -{-# language ConstraintKinds #-} -{-# language RecordWildCards #-} -{-# language GeneralizedNewtypeDeriving #-} -{-# language ScopedTypeVariables #-} -{-# language AllowAmbiguousTypes #-} -{-# language DataKinds #-} - -module System.Nix.Internal.StorePath - ( -- * Basic store path types - StoreDir(..) - , StorePath(..) - , StorePathName(..) - , StorePathSet - , mkStorePathHashPart - , StorePathHashPart(..) - , ContentAddressableAddress(..) - , NarHashMode(..) - , -- * Manipulating 'StorePathName' - makeStorePathName - , validStorePathName - , -- * Rendering out 'StorePath's - storePathToFilePath - , storePathToRawFilePath - , storePathToText - , storePathToNarInfo - , -- * Parsing 'StorePath's - parsePath - , pathParser - ) -where - -import qualified Relude.Unsafe as Unsafe -import System.Nix.Internal.Hash -import System.Nix.Internal.Base -import qualified System.Nix.Internal.Base32 as Nix.Base32 - -import qualified Data.ByteString.Char8 as Bytes.Char8 -import qualified Data.Char as Char -import qualified Data.Text as Text -import Data.Attoparsec.Text.Lazy ( Parser - , () - ) -import qualified Data.Attoparsec.Text.Lazy as Parser.Text.Lazy -import qualified System.FilePath as FilePath -import Crypto.Hash ( SHA256 - , Digest - ) - --- | A path in a Nix store. --- --- From the Nix thesis: A store path is the full path of a store --- object. It has the following anatomy: storeDir/hashPart-name. --- --- The store directory is *not* included, and must be known from the --- context. This matches modern C++ Nix, and also represents the fact --- that store paths for different store directories cannot be mixed. -data StorePath = StorePath - { -- | The 160-bit hash digest reflecting the "address" of the name. - -- Currently, this is a truncated SHA256 hash. - storePathHash :: !StorePathHashPart - , -- | The (typically human readable) name of the path. For packages - -- this is typically the package name and version (e.g. - -- hello-1.2.3). - storePathName :: !StorePathName - } - deriving (Eq, Ord, Show) - -instance Hashable StorePath where - hashWithSalt s StorePath{..} = - s `hashWithSalt` storePathHash `hashWithSalt` storePathName - --- | The name portion of a Nix path. --- --- 'unStorePathName' must only contain a-zA-Z0-9+._?=-, can't start --- with a -, and must have at least one character (i.e. it must match --- 'storePathNameRegex'). -newtype StorePathName = StorePathName - { -- | Extract the contents of the name. - unStorePathName :: Text - } deriving (Eq, Hashable, Ord, Show) - --- | The hash algorithm used for store path hashes. -newtype StorePathHashPart = StorePathHashPart ByteString - deriving (Eq, Hashable, Ord, Show) - -mkStorePathHashPart :: ByteString -> StorePathHashPart -mkStorePathHashPart = coerce . mkStorePathHash @SHA256 - --- | A set of 'StorePath's. -type StorePathSet = HashSet StorePath - --- | An address for a content-addressable store path, i.e. one whose --- store path hash is purely a function of its contents (as opposed to --- paths that are derivation outputs, whose hashes are a function of --- the contents of the derivation file instead). --- --- For backwards-compatibility reasons, the same information is --- encodable in multiple ways, depending on the method used to add the --- path to the store. These unfortunately result in separate store --- paths. -data ContentAddressableAddress - = -- | The path is a plain file added via makeTextPath or - -- addTextToStore. It is addressed according to a sha256sum of the - -- file contents. - Text !(Digest SHA256) - | -- | The path was added to the store via makeFixedOutputPath or - -- addToStore. It is addressed according to some hash algorithm - -- applied to the nar serialization via some 'NarHashMode'. - Fixed !NarHashMode !SomeNamedDigest - --- | Schemes for hashing a Nix archive. --- --- For backwards-compatibility reasons, there are two different modes --- here, even though 'Recursive' should be able to cover both. -data NarHashMode - = -- | Require the nar to represent a non-executable regular file. - RegularFile - | -- | Hash an arbitrary nar, including a non-executable regular - -- file if so desired. - Recursive - -makeStorePathName :: Text -> Either String StorePathName -makeStorePathName n = - if validStorePathName n - then pure $ StorePathName n - else Left $ reasonInvalid n - -reasonInvalid :: Text -> String -reasonInvalid n - | n == "" = "Empty name" - | Text.length n > 211 = "Path too long" - | Text.head n == '.' = "Leading dot" - | otherwise = "Invalid character" - -validStorePathName :: Text -> Bool -validStorePathName n = - n /= "" - && Text.length n <= 211 - && Text.head n /= '.' - && Text.all validStorePathNameChar n - -validStorePathNameChar :: Char -> Bool -validStorePathNameChar c = - any ($ c) - [ Char.isAsciiLower -- 'a'..'z', isAscii..er probably faster then putting it out - , Char.isAsciiUpper -- 'A'..'Z' - , Char.isDigit - , (`elem` ("+-._?=" :: String)) - ] - --- | Copied from @RawFilePath@ in the @unix@ package, duplicated here --- to avoid the dependency. -type RawFilePath = ByteString - --- | The path to the store dir --- --- Many operations need to be parameterized with this, since store paths --- do not know their own store dir by design. -newtype StoreDir = StoreDir { - unStoreDir :: RawFilePath - } deriving (Eq, Hashable, Ord, Show) - --- | Render a 'StorePath' as a 'RawFilePath'. -storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath -storePathToRawFilePath storeDir StorePath{..} = - unStoreDir storeDir <> "/" <> hashPart <> "-" <> name - where - hashPart = encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash - name = encodeUtf8 $ unStorePathName storePathName - --- | Render a 'StorePath' as a 'FilePath'. -storePathToFilePath :: StoreDir -> StorePath -> FilePath -storePathToFilePath storeDir = Bytes.Char8.unpack . storePathToRawFilePath storeDir - --- | Render a 'StorePath' as a 'Text'. -storePathToText :: StoreDir -> StorePath -> Text -storePathToText storeDir = toText . Bytes.Char8.unpack . storePathToRawFilePath storeDir - --- | Build `narinfo` suffix from `StorePath` which --- can be used to query binary caches. -storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString -storePathToNarInfo StorePath{..} = - encodeUtf8 $ encodeWith NixBase32 (coerce storePathHash) <> ".narinfo" - --- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking --- that store directory matches `expectedRoot`. -parsePath :: StoreDir -> Bytes.Char8.ByteString -> Either String StorePath -parsePath expectedRoot x = - let - (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x - (storeBasedHashPart, namePart) = Text.breakOn "-" $ toText fname - storeHash = decodeWith NixBase32 storeBasedHashPart - name = makeStorePathName . Text.drop 1 $ namePart - --rootDir' = dropTrailingPathSeparator rootDir - -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b - rootDir' = Unsafe.init rootDir - expectedRootS = Bytes.Char8.unpack (unStoreDir expectedRoot) - storeDir = - if expectedRootS == rootDir' - then pure rootDir' - else Left $ "Root store dir mismatch, expected" <> expectedRootS <> "got" <> rootDir' - in - either Left (pure $ StorePath <$> coerce storeHash <*> name) storeDir - -pathParser :: StoreDir -> Parser StorePath -pathParser expectedRoot = do - let expectedRootS = Bytes.Char8.unpack (unStoreDir expectedRoot) - - _ <- - Parser.Text.Lazy.string (toText expectedRootS) - "Store root mismatch" -- e.g. /nix/store - - _ <- Parser.Text.Lazy.char '/' - "Expecting path separator" - - digest <- - decodeWith NixBase32 - <$> Parser.Text.Lazy.takeWhile1 (`elem` Nix.Base32.digits32) - "Invalid Base32 part" - - _ <- Parser.Text.Lazy.char '-' "Expecting dash (path name separator)" - - c0 <- - Parser.Text.Lazy.satisfy (\c -> c /= '.' && validStorePathNameChar c) - "Leading path name character is a dot or invalid character" - - rest <- - Parser.Text.Lazy.takeWhile validStorePathNameChar - "Path name contains invalid character" - - let name = makeStorePathName $ Text.cons c0 rest - - either - fail - pure - (StorePath <$> coerce digest <*> name) diff --git a/src/System/Nix/Internal/Truncation.hs b/src/System/Nix/Internal/Truncation.hs deleted file mode 100644 --- a/src/System/Nix/Internal/Truncation.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# language ScopedTypeVariables #-} -{-# language DataKinds #-} - -module System.Nix.Internal.Truncation - ( truncateInNixWay - ) -where - -import qualified Data.ByteString as Bytes - --- | Bytewise truncation of a 'Digest'. --- --- When truncation length is greater than the length of the bytestring --- but less than twice the bytestring length, truncation splits the --- bytestring into a head part (truncation length) and tail part --- (leftover part), right-pads the leftovers with 0 to the truncation --- length, and combines the two strings bytewise with 'xor'. -truncateInNixWay - :: Int -> Bytes.ByteString -> Bytes.ByteString --- 2021-06-07: NOTE: Renamed function, since truncation can be done in a lot of ways, there is no practice of truncting hashes this way, moreover: --- 1. --- 2. -truncateInNixWay n c = - Bytes.pack $ fmap truncOutputByte [0 .. n-1] - where - - truncOutputByte :: Int -> Word8 - truncOutputByte i = foldl' (aux i) 0 [0 .. Bytes.length c - 1] - - inputByte :: Int -> Word8 - inputByte j = Bytes.index c j - - aux :: Int -> Word8 -> Int -> Word8 - aux i x j = - bool - id - (`xor` inputByte j) - (j `mod` n == i) - x diff --git a/src/System/Nix/Nar.hs b/src/System/Nix/Nar.hs deleted file mode 100644 --- a/src/System/Nix/Nar.hs +++ /dev/null @@ -1,78 +0,0 @@ -{- -Description : Generating and consuming NAR files -Maintainer : Shea Levy --} - -{-# language ScopedTypeVariables #-} -{-# language TypeFamilies #-} - - -module System.Nix.Nar - ( - - -- * Encoding and Decoding NAR archives - buildNarIO - , unpackNarIO - - -- * Experimental - , Nar.parseNar - , Nar.testParser - , Nar.testParser' - - -- * Filesystem capabilities used by NAR encoder/decoder - , Nar.NarEffects(..) - , Nar.narEffectsIO - - , Nar.NarOptions(..) - , Nar.defaultNarOptions - - -- * Internal - , Nar.streamNarIO - , Nar.streamNarIOWithOptions - , Nar.runParser - , Nar.runParserWithOptions - , Nar.dumpString - , Nar.dumpPath - - -- * Type - , Nar.NarSource - ) -where - -import qualified Control.Concurrent as Concurrent -import qualified Data.ByteString as BS -import qualified System.IO as IO - -import qualified System.Nix.Internal.Nar.Effects as Nar -import qualified System.Nix.Internal.Nar.Options as Nar -import qualified System.Nix.Internal.Nar.Parser as Nar -import qualified System.Nix.Internal.Nar.Streamer as Nar - - --- For a description of the NAR format, see Eelco's thesis --- https://nixos.org/%7Eeelco/pubs/phd-thesis.pdf - - --- | Pack the filesystem object at @FilePath@ into a NAR and stream it into the --- @IO.Handle@ --- The handle should aleady be open and in @WriteMode@. -buildNarIO - :: Nar.NarEffects IO - -> FilePath - -> IO.Handle - -> IO () -buildNarIO effs basePath outHandle = - Nar.streamNarIO - effs - basePath - (\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10) - - --- | Read NAR formatted bytes from the @IO.Handle@ and unpack them into --- file system object(s) at the supplied @FilePath@ -unpackNarIO - :: Nar.NarEffects IO - -> IO.Handle - -> FilePath - -> IO (Either String ()) -unpackNarIO effs = Nar.runParser effs Nar.parseNar diff --git a/src/System/Nix/OutputName.hs b/src/System/Nix/OutputName.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/OutputName.hs @@ -0,0 +1,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 diff --git a/src/System/Nix/ReadonlyStore.hs b/src/System/Nix/ReadonlyStore.hs deleted file mode 100644 --- a/src/System/Nix/ReadonlyStore.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# language DataKinds #-} -{-# language ScopedTypeVariables #-} - -module System.Nix.ReadonlyStore where - - -import qualified Data.ByteString.Char8 as Bytes.Char8 -import qualified Data.ByteString as BS -import qualified Data.HashSet as HS -import System.Nix.Hash -import System.Nix.Nar -import System.Nix.StorePath -import Crypto.Hash ( Context - , Digest - , hash - , hashlazy - , hashInit - , hashUpdate - , hashFinalize - , SHA256 - ) - - -makeStorePath - :: forall h - . (NamedAlgo h) - => StoreDir - -> ByteString - -> Digest h - -> StorePathName - -> StorePath -makeStorePath storeDir ty h nm = StorePath (coerce storeHash) nm - where - storeHash = mkStorePathHash @h s - s = - BS.intercalate ":" $ - ty:fmap encodeUtf8 - [ algoName @h - , encodeDigestWith Base16 h - , toText . Bytes.Char8.unpack $ unStoreDir storeDir - , coerce nm - ] - -makeTextPath - :: StoreDir -> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath -makeTextPath storeDir nm h refs = makeStorePath storeDir ty h nm - where - ty = - BS.intercalate ":" $ "text" : sort (storePathToRawFilePath storeDir <$> HS.toList refs) - -makeFixedOutputPath - :: forall hashAlgo - . NamedAlgo hashAlgo - => StoreDir - -> Bool - -> Digest hashAlgo - -> StorePathName - -> StorePath -makeFixedOutputPath storeDir recursive h = - if recursive && (algoName @hashAlgo) == "sha256" - then makeStorePath storeDir "source" h - else makeStorePath storeDir "output:out" h' - where - h' = - hash @ByteString @SHA256 - $ "fixed:out:" - <> encodeUtf8 (algoName @hashAlgo) - <> (if recursive then ":r:" else ":") - <> encodeUtf8 (encodeDigestWith Base16 h) - <> ":" - -computeStorePathForText - :: StoreDir -> StorePathName -> ByteString -> (StorePathSet -> StorePath) -computeStorePathForText storeDir nm = makeTextPath storeDir nm . hash - -computeStorePathForPath - :: StoreDir - -> StorePathName -- ^ Name part of the newly created `StorePath` - -> FilePath -- ^ Local `FilePath` to add - -> Bool -- ^ Add target directory recursively - -> (FilePath -> Bool) -- ^ Path filter function - -> Bool -- ^ Only used by local store backend - -> IO StorePath -computeStorePathForPath storeDir name pth recursive _pathFilter _repair = do - selectedHash <- if recursive then recursiveContentHash else flatContentHash - pure $ makeFixedOutputPath storeDir recursive selectedHash name - where - recursiveContentHash :: IO (Digest SHA256) - recursiveContentHash = hashFinalize <$> execStateT streamNarUpdate (hashInit @SHA256) - streamNarUpdate :: StateT (Context SHA256) IO () - streamNarUpdate = streamNarIO narEffectsIO pth (modify . flip (hashUpdate @ByteString @SHA256)) - - flatContentHash :: IO (Digest SHA256) - flatContentHash = hashlazy <$> narReadFile narEffectsIO pth diff --git a/src/System/Nix/Realisation.hs b/src/System/Nix/Realisation.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Realisation.hs @@ -0,0 +1,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) diff --git a/src/System/Nix/Signature.hs b/src/System/Nix/Signature.hs --- a/src/System/Nix/Signature.hs +++ b/src/System/Nix/Signature.hs @@ -1,10 +1,85 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} {-| Description : Nix-relevant interfaces to NaCl signatures. -} + module System.Nix.Signature - ( Signature + ( 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) diff --git a/src/System/Nix/Store/Types.hs b/src/System/Nix/Store/Types.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/Store/Types.hs @@ -0,0 +1,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) diff --git a/src/System/Nix/StorePath.hs b/src/System/Nix/StorePath.hs --- a/src/System/Nix/StorePath.hs +++ b/src/System/Nix/StorePath.hs @@ -1,28 +1,334 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} {-| Description : Representation of Nix store paths. -} + module System.Nix.StorePath ( -- * Basic store path types StoreDir(..) - , StorePath(..) - , StorePathName(..) - , StorePathSet + , HasStoreDir(..) + , StorePath + , storePathHash + , storePathName + , StorePathName + , unStorePathName + , StorePathHashPart , mkStorePathHashPart - , StorePathHashPart(..) - , ContentAddressableAddress(..) - , NarHashMode(..) - , -- * Manipulating 'StorePathName' - makeStorePathName - , validStorePathName + , unStorePathHashPart + -- * Manipulating 'StorePathName' + , InvalidNameError(..) + , mkStorePathName + , parseNameText + -- * Reason why a path is not valid + , InvalidPathError(..) , -- * Rendering out 'StorePath's storePathToFilePath , storePathToRawFilePath , storePathToText , 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 diff --git a/src/System/Nix/StorePath/Metadata.hs b/src/System/Nix/StorePath/Metadata.hs new file mode 100644 --- /dev/null +++ b/src/System/Nix/StorePath/Metadata.hs @@ -0,0 +1,59 @@ +{-| +Description : Metadata about Nix store paths. +-} +module System.Nix.StorePath.Metadata + ( Metadata(..) + , StorePathTrust(..) + ) where + +import Crypto.Hash (Digest) +import Data.Dependent.Sum (DSum) +import Data.HashSet (HashSet) +import Data.Set (Set) +import Data.Time (UTCTime) +import Data.Word (Word64) +import GHC.Generics (Generic) + +import System.Nix.Hash (HashAlgo) +import System.Nix.Signature (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) diff --git a/src/System/Nix/StorePathMetadata.hs b/src/System/Nix/StorePathMetadata.hs deleted file mode 100644 --- a/src/System/Nix/StorePathMetadata.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-| -Description : Metadata about Nix store paths. --} -module System.Nix.StorePathMetadata where - -import System.Nix.StorePath ( StorePath - , StorePathSet - , ContentAddressableAddress - ) -import System.Nix.Hash ( SomeNamedDigest ) -import Data.Time ( UTCTime ) -import System.Nix.Signature ( NarSignature ) - --- | Metadata about a 'StorePath' -data StorePathMetadata = StorePathMetadata - { -- | The path this metadata is about - path :: !StorePath - , -- | The path to the derivation file that built this path, if any - -- and known. - deriverPath :: !(Maybe StorePath) - , -- TODO should this be optional? - -- | The hash of the nar serialization of the path. - narHash :: !SomeNamedDigest - , -- | The paths that this path directly references - references :: !StorePathSet - , -- | When was this path registered valid in the store? - registrationTime :: !UTCTime - , -- | The size of the nar serialization of the path, in bytes. - narBytes :: !(Maybe Word64) - , -- | How much we trust this path. - trust :: !StorePathTrust - , -- | A set of cryptographic attestations of this path's validity. - -- - -- There is no guarantee from this type alone that these - -- signatures are valid. - sigs :: !(Set NarSignature) - , -- | Whether and how this store path is content-addressable. - -- - -- There is no guarantee from this type alone that this address - -- is actually correct for this store path. - contentAddressableAddress :: !(Maybe ContentAddressableAddress) - } - --- | How much do we trust the path, based on its provenance? -data StorePathTrust - = -- | It was built locally and thus ultimately trusted - BuiltLocally - | -- | It was built elsewhere (and substituted or similar) and so - -- is less trusted - BuiltElsewhere - deriving (Show, Eq, Ord) diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs deleted file mode 100644 --- a/tests/Arbitrary.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# language DataKinds #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -module Arbitrary where - -import qualified Data.ByteString.Char8 as BSC - -import Test.Tasty.QuickCheck - -import System.Nix.Internal.StorePath -import Crypto.Hash ( SHA256 - , Digest - , hash - ) - -genSafeChar :: Gen Char -genSafeChar = choose ('\1', '\127') -- ASCII without \NUL - -nonEmptyString :: Gen String -nonEmptyString = listOf1 genSafeChar - -dir :: Gen String -dir = ('/':) <$> listOf1 (elements $ '/':['a'..'z']) - -instance Arbitrary StorePathName where - arbitrary = StorePathName . toText <$> ((:) <$> s1 <*> listOf sn) - where - alphanum = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'] - s1 = elements $ alphanum <> "+-_?=" - sn = elements $ alphanum <> "+-._?=" - -instance Arbitrary StorePathHashPart where - arbitrary = mkStorePathHashPart . BSC.pack <$> arbitrary - -instance Arbitrary (Digest SHA256) where - arbitrary = hash . BSC.pack <$> arbitrary - -instance Arbitrary StoreDir where - arbitrary = StoreDir . ("/" <>) . BSC.pack <$> arbitrary - -newtype NixLike = NixLike {getNixLike :: StorePath} - deriving (Eq, Ord, Show) - -instance Arbitrary NixLike where - arbitrary = - NixLike <$> - liftA2 StorePath - arbitraryTruncatedDigest - arbitrary - where - -- 160-bit hash, 20 bytes, 32 chars in base32 - arbitraryTruncatedDigest = coerce . BSC.pack <$> replicateM 20 genSafeChar - -instance Arbitrary StorePath where - arbitrary = - liftA2 StorePath - arbitrary - arbitrary diff --git a/tests/Derivation.hs b/tests/Derivation.hs --- a/tests/Derivation.hs +++ b/tests/Derivation.hs @@ -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.StorePath ( StoreDir(..) ) -import System.Nix.Derivation ( parseDerivation - , buildDerivation - ) +import System.Nix.Derivation (parseDerivation, buildDerivation) -import qualified Data.Attoparsec.Text -import qualified Data.Text.IO +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 - . toText + (Data.Text.Lazy.IO.writeFile dest . Data.Text.Lazy.Builder.toLazyText - . buildDerivation (StoreDir "/nix/store") + . buildDerivation def ) - (Data.Attoparsec.Text.parseOnly - (parseDerivation $ StoreDir "/nix/store") + (Data.Attoparsec.Text.Lazy.parseOnly + (parseDerivation def) contents ) diff --git a/tests/Fingerprint.hs b/tests/Fingerprint.hs new file mode 100644 --- /dev/null +++ b/tests/Fingerprint.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} +-- Test case from https://code.tvl.fyi/commit/tvix/nix-compat/src/narinfo/fingerprint.rs?id=a834966efd64c1b2306241c3ef20f4258f6b9c4e + +module Fingerprint where + +import Crypto.Error (CryptoFailable(..)) +import Data.Default.Class +import System.Nix.Base (decodeWith, BaseEncoding(Base64)) +import System.Nix.Fingerprint +import System.Nix.Signature +import System.Nix.StorePath +import System.Nix.StorePath.Metadata +import System.Nix.Hash (mkNamedDigest) +import Data.Text (Text) +import Data.Time.Clock (UTCTime(..)) +import Data.Time.Calendar.OrdinalDate (fromOrdinalDate) +import Test.Hspec + +import 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" + diff --git a/tests/Hash.hs b/tests/Hash.hs --- a/tests/Hash.hs +++ b/tests/Hash.hs @@ -1,59 +1,44 @@ -{-# language DataKinds #-} -{-# language ScopedTypeVariables #-} -{-# language CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Hash where +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 Crypto.Hash ( MD5 - , SHA1 - , SHA256 - , hash - , Digest - ) +import System.Nix.Base +import System.Nix.Hash +import System.Nix.StorePath +import Test.Hspec spec_hash :: Spec spec_hash = do describe "hashing parity with nix-store" $ do - cmp "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" - NixBase32 (hash @ByteString @SHA256) "nix-output:foo" "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5" - cmp "produces (base16 . md5) of \"Hello World\" the same as the thesis" - Base16 (hash @ByteString @MD5) "Hello World" "b10a8db164e0754105b7a99be72e3fe5" - cmp "produces (base32 . sha1) of \"Hello World\" the same as the thesis" - NixBase32 (hash @ByteString @SHA1) "Hello World" "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" + it "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" $ + shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA256 "nix-output:foo")) + "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5" + it "produces (base16 . md5) of \"Hello World\" the same as the thesis" $ + shouldBe (encodeDigestWith Base16 (hash @ByteString @MD5 "Hello World")) + "b10a8db164e0754105b7a99be72e3fe5" + it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $ + shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA1 "Hello World")) + "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" -- The example in question: -- https://nixos.org/nixos/nix-pills/nix-store-paths.html it "produces same base32 as nix pill flat file example" $ do - shouldBe (encodeWith NixBase32 $ coerce $ mkStorePathHashPart "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3c0d7b98883f9ee3:/nix/store:myfile") + shouldBe (encodeWith NixBase32 $ unStorePathHashPart $ mkStorePathHashPart @SHA256 "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3c0d7b98883f9ee3:/nix/store:myfile") "xv2iccirbrvklck36f1g7vldn5v58vck" - where - cmp :: String -> BaseEncoding -> (ByteString -> Digest a) -> ByteString -> Text -> SpecWith () - cmp t b f s h = - it t $ - shouldBe (encodeDigestWith b $ f s) h --- | Test that Nix-like base32 encoding roundtrips -prop_nixBase32Roundtrip :: Property -prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $ - \x -> pure (encodeUtf8 x) === (B32.decode . B32.encode . encodeUtf8 $ x) - --- | API variants -prop_nixBase16Roundtrip :: StorePathHashPart -> Property -prop_nixBase16Roundtrip x = pure (coerce x) === decodeWith Base16 (encodeWith Base16 $ coerce x) - -- | Hash encoding conversion ground-truth. -- Similiar to nix/tests/hash.sh spec_nixhash :: Spec @@ -61,68 +46,47 @@ describe "hashing parity with nix-nash" $ do - cmp - "b16 encoded . b32 decoded should equal original b16" - B16.encode B32.decode b32s b16s + let + samples = [ + ( "800d59cfcd3c05e900cb4e214be48f6b886a08df" + , "vw46m23bizj4n8afrc0fj19wrp7mj3c0" + , "gA1Zz808BekAy04hS+SPa4hqCN8=" + ) + , ( "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" + , "1b8m03r63zqhnjf7l5wnldhh7c134ap5vpj0850ymkq1iyzicy5s" + , "ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0=" + ) + , ( "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445" + , "12k9jiq29iyqm03swfsgiw5mlqs173qazm3n7daz43infy12pyrcdf30fkk3qwv4yl2ick8yipc2mqnlh48xsvvxl60lbx8vp38yji0" + , "IEqPxt2oLwoM7XvrjgikFlfBbvRosiioJ5vjMacDwzWW/RXBOxsH+aodO+pXeJygMa2Fx6cd1wNU7GMSOMo0RQ==" + ) + ] - cmp - "b64 encoded . b32 decoded should equal original b64" - (B64.encode . fromStrict) B32.decode b32s b64s + it "b16 encoded . b32 decoded should equal original b16" $ + forM_ samples $ \(b16, b32, _b64) -> shouldBe (B16.encode <$> B32.decode b32) (pure b16) - cmp - "b32 encoded . b64 decoded should equal original b32" - (B32.encode . toStrict) B64.decode b64s b32s + it "b64 encoded . b32 decoded should equal original b64" $ + forM_ samples $ \(_b16, b32, b64) -> shouldBe (B64.encode . BSL.fromStrict <$> B32.decode b32) (pure b64) - cmp - "b16 encoded . b64 decoded should equal original b16" - (B16.encode . toStrict) B64.decode b64s b16s + it "b32 encoded . b64 decoded should equal original b32" $ + forM_ samples $ \(_b16, b32, b64) -> shouldBe (B32.encode . BSL.toStrict <$> B64.decode b64 ) (pure b32) -#if MIN_VERSION_base16_bytestring(1,0,0) - cmp - "b32 encoded . b16 decoded should equal original b32" - B32.encode B16.decode b16s b32s + it "b16 encoded . b64 decoded should equal original b16" $ + forM_ samples $ \(b16, _b32, b64) -> shouldBe (B16.encode . BSL.toStrict <$> B64.decode b64 ) (pure b16) - cmp - "b64 encoded . b16 decoded should equal original b64" - (B64.encode . fromStrict) B16.decode b16s b64s -#else it "b32 encoded . b16 decoded should equal original b32" $ - traverse_ (\ b -> shouldBe (B32.encode $ fst $ B16.decode $ fst b) (snd b)) $ zip b16s b32s + forM_ samples $ \(b16, b32, _b64) -> shouldBe (B32.encode +#if MIN_VERSION_base16_bytestring(1,0,0) + <$> B16.decode b16) (pure b32) +#else + $ fst $ B16.decode b16) (b32) +#endif it "b64 encoded . b16 decoded should equal original b64" $ - traverse_ (\ b -> shouldBe (B64.encode . fromStrict $ fst $ B16.decode $ fst b) (snd b)) $ zip b16s b64s + forM_ samples $ \(b16, _b32, b64) -> shouldBe (B64.encode . BSL.fromStrict +#if MIN_VERSION_base16_bytestring(1,0,0) + <$> B16.decode b16) (pure b64) +#else + $ fst $ B16.decode b16 ) (b64) #endif - where - cmp - :: ( Eq b - , Show b - ) - => String - -> (a -> b) - -> (c -> Either String a) - -> [c] - -> [b] - -> SpecWith () - cmp s f1 f2 b1 b2 = it s $ traverse_ (uncurry shouldBe . bimap (fmap f1 . f2) pure) $ zip b1 b2 - - b16s = takeAxis (\(a,_,_) -> a) - b32s = takeAxis (\(_,b,_) -> b) - b64s = takeAxis (\(_,_,c) -> c) - - takeAxis f = fmap f samples - - samples = - [ ( "800d59cfcd3c05e900cb4e214be48f6b886a08df" - , "vw46m23bizj4n8afrc0fj19wrp7mj3c0" - , "gA1Zz808BekAy04hS+SPa4hqCN8=" - ) - , ( "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" - , "1b8m03r63zqhnjf7l5wnldhh7c134ap5vpj0850ymkq1iyzicy5s" - , "ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0=" - ) - , ( "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445" - , "12k9jiq29iyqm03swfsgiw5mlqs173qazm3n7daz43infy12pyrcdf30fkk3qwv4yl2ick8yipc2mqnlh48xsvvxl60lbx8vp38yji0" - , "IEqPxt2oLwoM7XvrjgikFlfBbvRosiioJ5vjMacDwzWW/RXBOxsH+aodO+pXeJygMa2Fx6cd1wNU7GMSOMo0RQ==" - ) - ] diff --git a/tests/NarFormat.hs b/tests/NarFormat.hs deleted file mode 100644 --- a/tests/NarFormat.hs +++ /dev/null @@ -1,758 +0,0 @@ -{-# language CPP #-} -{-# language ScopedTypeVariables #-} - -module NarFormat where - -import qualified Control.Concurrent as Concurrent -import Control.Exception (try) -import Data.Binary (Binary(..), decodeFile) -import Data.Binary.Get (Get, getByteString, - getInt64le, - getLazyByteString, runGet) -import Data.Binary.Put (Put, putInt64le, - putLazyByteString, runPut) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base64.Lazy as B64 -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Lazy as BSL -import qualified Data.ByteString.Lazy.Char8 as BSLC -import qualified Data.Map as Map -import qualified Data.Text as T -import System.Directory ( doesDirectoryExist - , doesPathExist - , removeDirectoryRecursive - , removeFile - ) -import qualified System.Directory as Directory -import System.Environment (getEnv) -import System.FilePath ((<.>), ()) -import qualified System.IO as IO -import qualified System.IO.Temp as Temp -import qualified System.Posix.Process as Unix -import qualified System.Process as P -import Test.Tasty as T -import Test.Hspec -import qualified Test.Tasty.HUnit as HU -import Test.Tasty.QuickCheck -import qualified Text.Printf as Printf - -import qualified System.Nix.Internal.Nar.Streamer as Nar -import System.Nix.Nar - --- Without the import, `max_live_bytes` and `getRTSStats` are undefined on some setups. -#ifdef BOUNDED_MEMORY -import GHC.Stats -#endif - - -withBytesAsHandle :: BSLC.ByteString -> (IO.Handle -> IO a) -> IO a -withBytesAsHandle bytes act = do - Temp.withSystemTempFile "nar-test-file-XXXXX" $ \tmpFile h -> do - IO.hClose h - BSL.writeFile tmpFile bytes - withFile tmpFile ReadMode act - -spec_narEncoding :: Spec -spec_narEncoding = do - - -- For a Haskell embedded Nar, check that (decode . encode === id) - let - withTempDir act = Temp.withSystemTempDirectory "nar-test" act - - - roundTrip :: String -> Nar -> IO () - roundTrip narFileName n = withTempDir $ \tmpDir -> do - let packageFilePath = tmpDir narFileName - - e <- doesPathExist packageFilePath - e `shouldBe` False - - res <- withBytesAsHandle (runPut (putNar n)) $ \h -> do - unpackNarIO narEffectsIO h packageFilePath - res `shouldBe` pass - - e' <- doesPathExist packageFilePath - e' `shouldBe` True - - res' <- Temp.withSystemTempFile "nar-test-file-hnix" $ \tmpFile h -> do - buildNarIO narEffectsIO packageFilePath h - IO.hClose h - BSL.readFile tmpFile - - res' `shouldBe` runPut (putNar n) - - -- For a Haskell embedded Nar, check that encoding it gives - -- the same bytestring as `nix-store --dump` - let - encEqualsNixStore :: Nar -> BSL.ByteString -> IO () - encEqualsNixStore n b = runPut (putNar n) `shouldBe` b - - - describe "parser-roundtrip" $ do - it "roundtrips regular" $ do - roundTrip "sampleRegular" (Nar sampleRegular) - - it "roundtrips regular 2" $ do - roundTrip "sampleRegular'" (Nar sampleRegular') - - it "roundtrips executable" $ do - roundTrip "sampleExecutable" (Nar sampleExecutable) - - it "roundtrips directory" $ do - roundTrip "sampleDirectory" (Nar sampleDirectory) - - it "roundtrips case conflicts" $ do - nar <- decodeFile "tests/fixtures/case-conflict.nar" - roundTrip "caseConflict" nar - - describe "matches-nix-store fixture" $ do - it "matches regular" $ do - encEqualsNixStore (Nar sampleRegular) sampleRegularBaseline - - it "matches regular'" $ - encEqualsNixStore (Nar sampleRegular') sampleRegular'Baseline - - it "matches executable" $ - encEqualsNixStore (Nar sampleExecutable) sampleExecutableBaseline - - it "matches symlink" $ - encEqualsNixStore (Nar sampleSymLink) sampleSymLinkBaseline - - it "matches directory" $ do - encEqualsNixStore (Nar sampleDirectory) sampleDirectoryBaseline - - it "matches symlink to directory" $ do - encEqualsNixStore (Nar sampleLinkToDirectory) sampleLinkToDirectoryBaseline - - -unit_nixStoreRegular :: HU.Assertion -unit_nixStoreRegular = filesystemNixStore "regular" (Nar sampleRegular) - -unit_nixStoreDirectory :: HU.Assertion -unit_nixStoreDirectory = filesystemNixStore "directory" (Nar sampleDirectory) - -unit_nixStoreDirectory' :: HU.Assertion -unit_nixStoreDirectory' = filesystemNixStore "directory'" (Nar sampleDirectory') - -test_nixStoreBigFile :: TestTree -test_nixStoreBigFile = packThenExtract "bigfile" $ \baseDir -> do - mkBigFile (baseDir "bigfile") - - -test_nixStoreBigDir :: TestTree -test_nixStoreBigDir = packThenExtract "bigdir" $ \baseDir -> do - let testDir = baseDir "bigdir" - Directory.createDirectory testDir - mkBigFile (testDir "bf1") - mkBigFile (testDir "bf2") - -- flip mapM_ [1..100] $ \i -> - -- mkBigFile (testDir ('f': show i)) - -- -- Directory.createDirectory (testDir "") - - -prop_narEncodingArbitrary :: Nar -> Property -prop_narEncodingArbitrary n = runGet getNar (runPut $ putNar n) === n - -unit_packSelfSrcDir :: HU.Assertion -unit_packSelfSrcDir = Temp.withSystemTempDirectory "nar-test" $ \tmpDir -> do - ver <- try (P.readProcess "nix-store" ["--version"] "") - let narFilePath = tmpDir "src.nar" - case ver of - Left (_ :: SomeException) -> print ("No nix-store on system" :: String) - Right _ -> do - let go dir = do - srcHere <- doesDirectoryExist dir - bool - pass - (do - withFile narFilePath WriteMode $ \h -> - buildNarIO narEffectsIO "src" h - hnixNar <- BSL.readFile narFilePath - nixStoreNar <- getNixStoreDump "src" - HU.assertEqual - "src dir serializes the same between hnix-store and nix-store" - hnixNar - nixStoreNar - ) - srcHere - go "src" - go "hnix-store-core/src" --- ||||||| merged common ancestors --- hnixNar <- runPut . put <$> localPackNar narEffectsIO "src" --- nixStoreNar <- getNixStoreDump "src" --- HU.assertEqual --- "src dir serializes the same between hnix-store and nix-store" --- hnixNar --- nixStoreNar --- ======= --- let narFile = tmpDir "src.nar" --- withFile narFile WriteMode $ \h -> --- buildNarIO narEffectsIO "src" h --- hnixNar <- BSL.readFile narFile --- nixStoreNar <- getNixStoreDump "src" --- HU.assertEqual --- "src dir serializes the same between hnix-store and nix-store" --- hnixNar --- nixStoreNar --- >>>>>>> Use streaming to consume and produce NARs - --- passes -test_streamLargeFileToNar :: TestTree -test_streamLargeFileToNar = HU.testCaseSteps "streamLargeFileToNar" $ \step -> do - - step "create test file" - mkBigFile bigFileName - -- BSL.writeFile narFileName =<< buildNarIO narEffectsIO bigFileName - -- - step "create nar file" - withFile narFileName WriteMode $ \h -> - buildNarIO narEffectsIO bigFileName h - - step "assert bounded memory" - assertBoundedMemory - rmFiles - where - bigFileName = "bigFile.bin" - narFileName = "bigFile.nar" - rmFiles = removeFile bigFileName >> removeFile narFileName - - --------------------------------------------------------------------------------- -test_streamManyFilesToNar :: TestTree -test_streamManyFilesToNar = HU.testCaseSteps "streamManyFilesToNar" $ \step -> - Temp.withSystemTempDirectory "hnix-store" $ \baseDir -> do - let - - packagePath = baseDir "package_with_many_files" - packagePath' = baseDir "package_with_many_files2" - narFilePath = packagePath <.> "nar" - - -- unused, see `step "check file exists"` bellow - _rmFiles = try @SomeException @() $ do - e <- doesPathExist narFilePath - when e $ removeDirectoryRecursive narFilePath - - _run = do - filesPrecount <- countProcessFiles - withFile "hnar" WriteMode $ \h -> - buildNarIO narEffectsIO narFilePath h - filesPostcount <- countProcessFiles - pure $ (-) <$> filesPostcount <*> filesPrecount - - step "create test files" - Directory.createDirectory packagePath - forM_ [0..1000] $ \i -> do - BSL.writeFile (Printf.printf (packagePath "%08d") (i :: Int)) "hi\n" - Concurrent.threadDelay 50 - - filesPrecount <- countProcessFiles - - step "pack nar" - withFile narFilePath WriteMode $ \h -> - buildNarIO narEffectsIO packagePath h - - step "unpack nar" - r <- withFile narFilePath ReadMode $ \h -> - unpackNarIO narEffectsIO h packagePath' - r `shouldBe` pass - - step "check constant file usage" - filesPostcount <- countProcessFiles - case (-) <$> filesPostcount <*> filesPrecount of - Nothing -> pass - Just c -> c `shouldSatisfy` (< 50) - - -- step "check file exists" - -- e <- doesPathExist packagePath' - -- e `shouldBe` True - - -- step "read the NAR back in" - -- filesCreated <- run `finally` rmFiles - -- filesCreated `shouldSatisfy` (< 50) - - - --- **************** Utilities ************************ - --- | Generate the ground-truth encoding on the fly with --- `nix-store --dump`, rather than generating fixtures --- beforehand -filesystemNixStore :: String -> Nar -> IO () -filesystemNixStore testErrorName n = do - - ver <- try (P.readProcess "nix-store" ["--version"] "") - case ver of - -- Left is not an error - testing machine simply doesn't have - -- `nix-store` executable, so pass - Left (_ :: SomeException) -> print ("No nix-store on system" :: String) - Right _ -> Temp.withSystemTempDirectory "hnix-store" $ \baseDir -> do - - let - testFile = baseDir "testfile" - nixNarFile = baseDir "nixstorenar.nar" - hnixNarFile = baseDir "hnix.nar" - - assertExists f = do - e <- doesPathExist f - e `shouldBe` True - - -- stream nar contents to unpacked file(s) - void $ withBytesAsHandle (runPut $ putNar n) $ \h -> - unpackNarIO narEffectsIO h testFile - - assertExists testFile - - -- nix-store converts those files to nar - getNixStoreDump testFile >>= BSL.writeFile nixNarFile - assertExists nixNarFile - - -- hnix converts those files to nar - withFile hnixNarFile WriteMode $ \h -> - buildNarIO narEffectsIO testFile h - assertExists hnixNarFile - - diffResult <- P.readProcess "diff" [nixNarFile, hnixNarFile] "" - - assertBoundedMemory - HU.assertEqual testErrorName diffResult "" - - --- | Assert that GHC uses less than 100M memory at peak -assertBoundedMemory :: IO () -assertBoundedMemory = do -#ifdef BOUNDED_MEMORY - bytes <- max_live_bytes <$> getRTSStats - bytes < 100 * 1000 * 1000 `shouldBe` True -#else - pass -#endif - - -packThenExtract - :: String - -- ^ Test name (will also be used for file name) - -> (String -> IO ()) - -- ^ Action to create some files that we will - -- pack into a NAR - -> TestTree -packThenExtract testName setup = - HU.testCaseSteps testName $ \step -> - Temp.withSystemTempDirectory "hnix-store" $ \baseDir -> do - setup baseDir - - let narFilePath = baseDir testName - - ver <- try (P.readProcess "nix-store" ["--version"] "") - case ver of - Left (_ :: SomeException) -> print ("No nix-store on system" :: String) - Right _ -> do - let - nixNarFile = narFilePath <> ".nix" - hnixNarFile = narFilePath <> ".hnix" - outputFile = narFilePath <> ".out" - - step $ "Produce nix-store nar to " <> nixNarFile - (_,_,_,handle) <- P.createProcess (P.shell $ "nix-store --dump " <> narFilePath <> " > " <> nixNarFile) - void $ P.waitForProcess handle - - step $ "Build NAR from " <> narFilePath <> " to " <> hnixNarFile - -- narBS <- buildNarIO narEffectsIO narFile - withFile hnixNarFile WriteMode $ \h -> - buildNarIO narEffectsIO narFilePath h - - -- BSL.writeFile hnixNarFile narBS - - step $ "Unpack NAR to " <> outputFile - _narHandle <- withFile nixNarFile ReadMode $ \h -> - unpackNarIO narEffectsIO h outputFile - - pass - --- | Count file descriptors owned by the current process -countProcessFiles :: IO (Maybe Int) -countProcessFiles = do - pid <- Unix.getProcessID - hasProc <- doesDirectoryExist "/proc" - if not hasProc - then pure Nothing - else do - let fdDir = "/proc/" <> show pid <> "/fd" - fds <- toText <$> P.readProcess "ls" [fdDir] "" - pure $ pure $ length $ words fds - - --- | Read the binary output of `nix-store --dump` for a filepath -getNixStoreDump :: String -> IO BSL.ByteString -getNixStoreDump fp = do - (_,Just h, _, _) <- P.createProcess - (P.proc "nix-store" ["--dump", fp]) - {P.std_out = P.CreatePipe} - BSL.hGetContents h - - --- * Several sample FSOs defined in Haskell, for use in encoding/decoding - --- | Simple regular text file with contents 'hi' -sampleRegular :: FileSystemObject -sampleRegular = Regular Nar.NonExecutable 3 "hi\n" - --- | Simple text file with some c code -sampleRegular' :: FileSystemObject -sampleRegular' = Regular Nar.NonExecutable (BSL.length str) str - where str = - "#include \n\nint main(int argc, char *argv[]){ exit 0; }\n" - --- | Executable file -sampleExecutable :: FileSystemObject -sampleExecutable = Regular Nar.Executable (BSL.length str) str - where str = "#!/bin/bash\n\ngcc -o hello hello.c\n" - --- | A simple symlink -sampleSymLink :: FileSystemObject -sampleSymLink = SymLink "hello.c" - - --- | A directory that includes some of the above sample files -sampleDirectory :: FileSystemObject -sampleDirectory = Directory $ Map.fromList - [(FilePathPart "hello.c", sampleRegular') - ,(FilePathPart "build.sh", sampleExecutable) - ,(FilePathPart "hi.c", sampleSymLink) - ] - --- | A deeper directory tree with crossing links -sampleDirectory' :: FileSystemObject -sampleDirectory' = Directory $ Map.fromList [ - - (FilePathPart "foo", Directory $ Map.fromList [ - (FilePathPart "foo.txt", Regular Nar.NonExecutable 8 "foo text") - , (FilePathPart "tobar" , SymLink "../bar/bar.txt") - ]) - - , (FilePathPart "bar", Directory $ Map.fromList [ - (FilePathPart "bar.txt", Regular Nar.NonExecutable 8 "bar text") - , (FilePathPart "tofoo" , SymLink "../foo/foo.txt") - ]) - ] - -sampleLargeFile :: Int64 -> FileSystemObject -sampleLargeFile fSize = - Regular Nar.NonExecutable fSize (BSL.take fSize (BSL.cycle "Lorem ipsum ")) - - -sampleLargeFile' :: Int64 -> FileSystemObject -sampleLargeFile' fSize = - Regular Nar.NonExecutable fSize (BSL.take fSize (BSL.cycle "Lorems ipsums ")) - -sampleLargeDir :: Int64 -> FileSystemObject -sampleLargeDir fSize = Directory $ Map.fromList $ [ - (FilePathPart "bf1", sampleLargeFile fSize) - , (FilePathPart "bf2", sampleLargeFile' fSize) - ] - <> [ (FilePathPart (BSC.pack $ 'f' : show n), - Regular Nar.NonExecutable 10000 (BSL.take 10000 (BSL.cycle "hi "))) - | n <- [1..100 :: Int]] - <> [ - (FilePathPart "d", Directory $ Map.fromList - [ (FilePathPart (BSC.pack $ "df" <> show n) - , Regular Nar.NonExecutable 10000 (BSL.take 10000 (BSL.cycle "subhi "))) - | n <- [1..100 :: Int]] - ) - ] - -sampleLinkToDirectory :: FileSystemObject -sampleLinkToDirectory = Directory $ Map.fromList [ - (FilePathPart "foo", Directory $ Map.fromList [ - (FilePathPart "file", Regular Nar.NonExecutable 8 "foo text") - ]) - , (FilePathPart "linkfoo" , SymLink "foo") - ] - --------------------------------------------------------------------------------- -sampleDirWithManyFiles :: Int -> FileSystemObject -sampleDirWithManyFiles nFiles = - Directory $ Map.fromList $ mkFile <$> take nFiles [0..] - where - mkFile :: Int -> (FilePathPart, FileSystemObject) - mkFile i = (FilePathPart (BSC.pack (Printf.printf "%08d" i)), - sampleRegular) - --- * For each sample above, feed it into `nix-store --dump`, --- and base64 encode the resulting NAR binary. This lets us --- check our Haskell NAR generator against `nix-store` - --- "hi" file turned to a NAR with `nix-store --dump`, Base64 encoded -sampleRegularBaseline :: BSL.ByteString -sampleRegularBaseline = B64.decodeLenient $ BSL.concat - ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA" - ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHJlZ3VsYXIACAAAAA" - ,"AAAABjb250ZW50cwMAAAAAAAAAaGkKAAAAAAABAAAAAAAAACkAA" - ,"AAAAAAA" - ] - -sampleRegular'Baseline :: BSL.ByteString -sampleRegular'Baseline = B64.decodeLenient $ BSL.concat - ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA" - ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHJlZ3VsYXIACAAAAA" - ,"AAAABjb250ZW50c0AAAAAAAAAAI2luY2x1ZGUgPHN0ZGlvLmg+C" - ,"gppbnQgbWFpbihpbnQgYXJnYywgY2hhciAqYXJndltdKXsgZXhp" - ,"dCAwOyB9CgEAAAAAAAAAKQAAAAAAAAA=" - ] - -sampleExecutableBaseline :: BSL.ByteString -sampleExecutableBaseline = B64.decodeLenient $ BSL.concat - ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA" - ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHJlZ3VsYXIACgAAAA" - ,"AAAABleGVjdXRhYmxlAAAAAAAAAAAAAAAAAAAIAAAAAAAAAGNvb" - ,"nRlbnRzIgAAAAAAAAAjIS9iaW4vYmFzaAoKZ2NjIC1vIGhlbGxv" - ,"IGhlbGxvLmMKAAAAAAAAAQAAAAAAAAApAAAAAAAAAA==" - ] - -sampleSymLinkBaseline :: BSL.ByteString -sampleSymLinkBaseline = B64.decodeLenient $ BSL.concat - ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA" - ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHN5bWxpbmsABgAAAA" - ,"AAAAB0YXJnZXQAAAcAAAAAAAAAaGVsbG8uYwABAAAAAAAAACkAA" - ,"AAAAAAA" - ] - -sampleDirectoryBaseline :: BSL.ByteString -sampleDirectoryBaseline = B64.decodeLenient $ BSL.concat - ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA" - ,"AAAQAAAAAAAAAdHlwZQAAAAAJAAAAAAAAAGRpcmVjdG9yeQAAAA" - ,"AAAAAFAAAAAAAAAGVudHJ5AAAAAQAAAAAAAAAoAAAAAAAAAAQAA" - ,"AAAAAAAbmFtZQAAAAAIAAAAAAAAAGJ1aWxkLnNoBAAAAAAAAABu" - ,"b2RlAAAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAHR5cGUAAAA" - ,"ABwAAAAAAAAByZWd1bGFyAAoAAAAAAAAAZXhlY3V0YWJsZQAAAA" - ,"AAAAAAAAAAAAAACAAAAAAAAABjb250ZW50cyIAAAAAAAAAIyEvY" - ,"mluL2Jhc2gKCmdjYyAtbyBoZWxsbyBoZWxsby5jCgAAAAAAAAEA" - ,"AAAAAAAAKQAAAAAAAAABAAAAAAAAACkAAAAAAAAABQAAAAAAAAB" - ,"lbnRyeQAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAG5hbWUAAA" - ,"AABwAAAAAAAABoZWxsby5jAAQAAAAAAAAAbm9kZQAAAAABAAAAA" - ,"AAAACgAAAAAAAAABAAAAAAAAAB0eXBlAAAAAAcAAAAAAAAAcmVn" - ,"dWxhcgAIAAAAAAAAAGNvbnRlbnRzQAAAAAAAAAAjaW5jbHVkZSA" - ,"8c3RkaW8uaD4KCmludCBtYWluKGludCBhcmdjLCBjaGFyICphcm" - ,"d2W10peyBleGl0IDA7IH0KAQAAAAAAAAApAAAAAAAAAAEAAAAAA" - ,"AAAKQAAAAAAAAAFAAAAAAAAAGVudHJ5AAAAAQAAAAAAAAAoAAAA" - ,"AAAAAAQAAAAAAAAAbmFtZQAAAAAEAAAAAAAAAGhpLmMAAAAABAA" - ,"AAAAAAABub2RlAAAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAH" - ,"R5cGUAAAAABwAAAAAAAABzeW1saW5rAAYAAAAAAAAAdGFyZ2V0A" - ,"AAHAAAAAAAAAGhlbGxvLmMAAQAAAAAAAAApAAAAAAAAAAEAAAAA" - ,"AAAAKQAAAAAAAAABAAAAAAAAACkAAAAAAAAA" - ] - -sampleLinkToDirectoryBaseline :: BSL.ByteString -sampleLinkToDirectoryBaseline = B64.decodeLenient $ BSL.concat - ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAAAAAQAAAAAAAAAdHlwZQAAAAAJ" - ,"AAAAAAAAAGRpcmVjdG9yeQAAAAAAAAAFAAAAAAAAAGVudHJ5AAAAAQAAAAAAAAAoAAAAAAAAAAQA" - ,"AAAAAAAAbmFtZQAAAAADAAAAAAAAAGZvbwAAAAAABAAAAAAAAABub2RlAAAAAAEAAAAAAAAAKAAA" - ,"AAAAAAAEAAAAAAAAAHR5cGUAAAAACQAAAAAAAABkaXJlY3RvcnkAAAAAAAAABQAAAAAAAABlbnRy" - ,"eQAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAG5hbWUAAAAABAAAAAAAAABmaWxlAAAAAAQAAAAA" - ,"AAAAbm9kZQAAAAABAAAAAAAAACgAAAAAAAAABAAAAAAAAAB0eXBlAAAAAAcAAAAAAAAAcmVndWxh" - ,"cgAIAAAAAAAAAGNvbnRlbnRzCAAAAAAAAABmb28gdGV4dAEAAAAAAAAAKQAAAAAAAAABAAAAAAAA" - ,"ACkAAAAAAAAAAQAAAAAAAAApAAAAAAAAAAEAAAAAAAAAKQAAAAAAAAAFAAAAAAAAAGVudHJ5AAAA" - ,"AQAAAAAAAAAoAAAAAAAAAAQAAAAAAAAAbmFtZQAAAAAHAAAAAAAAAGxpbmtmb28ABAAAAAAAAABu" - ,"b2RlAAAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAHR5cGUAAAAABwAAAAAAAABzeW1saW5rAAYA" - ,"AAAAAAAAdGFyZ2V0AAADAAAAAAAAAGZvbwAAAAAAAQAAAAAAAAApAAAAAAAAAAEAAAAAAAAAKQAA" - ,"AAAAAAABAAAAAAAAACkAAAAAAAAA" - ] - --- | Control testcase sizes (bytes) by env variable -getBigFileSize :: IO Int64 -getBigFileSize = fromMaybe 5000000 . readMaybe <$> (getEnv "HNIX_BIG_FILE_SIZE" <|> pure "") - - --- | Add a link to a FileSystemObject. This is useful --- when creating Arbitrary FileSystemObjects. It --- isn't implemented yet -mkLink - :: FilePath -- ^ Target - -> FilePath -- ^ Link - -> FileSystemObject -- ^ FileSystemObject to add link to - -> FileSystemObject -mkLink = undefined -- TODO - -mkBigFile :: FilePath -> IO () -mkBigFile path = do - fsize <- getBigFileSize - BSL.writeFile path (BSL.take fsize $ BSL.cycle "Lorem ipsum") - - --- | Construct FilePathPart from Text by checking that there --- are no '/' or '\\NUL' characters -filePathPart :: BSC.ByteString -> Maybe FilePathPart -filePathPart p = if BSC.any (`elem` ['/', '\NUL']) p then Nothing else Just $ FilePathPart p - -newtype Nar = Nar { narFile :: FileSystemObject } - deriving (Eq, Show, Generic) - --- | A FileSystemObject (FSO) is an anonymous entity that can be NAR archived -data FileSystemObject = - Regular Nar.IsExecutable Int64 BSL.ByteString - -- ^ Reguar file, with its executable state, size (bytes) and contents - | Directory (Map.Map FilePathPart FileSystemObject) - -- ^ Directory with mapping of filenames to sub-FSOs - | SymLink T.Text - -- ^ Symbolic link target - deriving (Eq, Show) - --- | A valid filename or directory name -newtype FilePathPart = FilePathPart { unFilePathPart :: BSC.ByteString } - deriving (Eq, Ord, Show) - -instance Binary Nar where - get = getNar - put = putNar - -instance Arbitrary Nar where - arbitrary = Nar <$> resize 10 arbitrary - -instance Arbitrary FileSystemObject where - -- To build an arbitrary Nar, - arbitrary = do - n <- getSize - if n < 2 - then arbFile - else arbDirectory n - - where - - arbFile :: Gen FileSystemObject - arbFile = do - Positive fSize <- arbitrary - Regular - <$> elements [Nar.NonExecutable, Nar.Executable] - <*> pure (fromIntegral fSize) - <*> oneof [ - fmap (BSL.take fSize . BSL.cycle . BSL.pack . getNonEmpty) arbitrary , -- Binary File - fmap (BSL.take fSize . BSL.cycle . BSLC.pack . getNonEmpty) arbitrary -- ASCII File - ] - - arbName :: Gen FilePathPart - arbName = fmap (FilePathPart . BS.pack . fmap (fromIntegral . fromEnum)) $ do - Positive n <- arbitrary - replicateM n (elements $ ['a'..'z'] <> ['0'..'9']) - - arbDirectory :: Int -> Gen FileSystemObject - arbDirectory n = fmap (Directory . Map.fromList) $ replicateM n $ do - nm <- arbName - f <- oneof [arbFile, arbDirectory (n `div` 2)] - pure (nm,f) - ------------------------------------------------------------------------------- --- | Serialize Nar to lazy ByteString -putNar :: Nar -> Put -putNar (Nar file) = header <> parens (putFile file) - where - - header = str "nix-archive-1" - - putFile (Regular isExec fSize contents) = - strs ["type", "regular"] - >> (if isExec == Nar.Executable - then strs ["executable", ""] - else pass) - >> putContents fSize contents - - putFile (SymLink target) = - strs ["type", "symlink", "target", fromStrict $ encodeUtf8 target] - - -- toList sorts the entries by FilePathPart before serializing - putFile (Directory entries) = - strs ["type", "directory"] - <> mapM_ putEntry (Map.toList entries) - - putEntry (FilePathPart name, fso) = do - str "entry" - parens $ do - str "name" - str (fromStrict name) - str "node" - parens (putFile fso) - - parens m = str "(" >> m >> str ")" - - -- Do not use this for file contents - str :: BSL.ByteString -> Put - str t = let len = BSL.length t - in int len <> pad len t - - putContents :: Int64 -> BSL.ByteString -> Put - putContents fSize bs = str "contents" <> int fSize <> pad fSize bs - - int :: Integral a => a -> Put - int n = putInt64le $ fromIntegral n - - pad :: Int64 -> BSL.ByteString -> Put - pad strSize bs = do - putLazyByteString bs - putLazyByteString (BSL.replicate (padLen strSize) 0) - - strs :: [BSL.ByteString] -> Put - strs = mapM_ str - --- | Distance to the next multiple of 8 -padLen :: Int64 -> Int64 -padLen n = (8 - n) `mod` 8 - - ------------------------------------------------------------------------------- --- | Deserialize a Nar from lazy ByteString -getNar :: Get Nar -getNar = fmap Nar $ header >> parens getFile - where - - header = assertStr "nix-archive-1" - - -- Fetch a FileSystemObject - getFile = getRegularFile <|> getDirectory <|> getSymLink - - getRegularFile = do - assertStr_ "type" - assertStr_ "regular" - mExecutable <- optional $ Nar.Executable <$ (assertStr "executable" - >> assertStr "") - assertStr_ "contents" - (fSize, contents) <- sizedStr - pure $ Regular (fromMaybe Nar.NonExecutable mExecutable) fSize contents - - getDirectory = do - assertStr_ "type" - assertStr_ "directory" - fs <- many getEntry - pure $ Directory (Map.fromList fs) - - getSymLink = do - assertStr_ "type" - assertStr_ "symlink" - assertStr_ "target" - fmap (SymLink . decodeUtf8) str - - getEntry = do - assertStr_ "entry" - parens $ do - assertStr_ "name" - name <- str - assertStr_ "node" - file <- parens getFile - maybe (fail $ "Bad FilePathPart: " <> show name) - (pure . (,file)) - (filePathPart $ toStrict name) - - -- Fetch a length-prefixed, null-padded string - str = fmap snd sizedStr - - sizedStr = do - n <- getInt64le - s <- getLazyByteString n - _ <- getByteString . fromIntegral $ padLen n - pure (n,s) - - parens m = assertStr "(" *> m <* assertStr ")" - - assertStr_ = void . assertStr - assertStr s = do - s' <- str - if s == s' - then pure s - else fail "No" diff --git a/tests/Signature.hs b/tests/Signature.hs new file mode 100644 --- /dev/null +++ b/tests/Signature.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings #-} +-- Inspired by https://cl.tvl.fyi/c/depot/+/10081/1/tvix/nix-compat/src/narinfo/signature.rs +-- and https://github.com/nix-community/go-nix/pull/93 +-- by @flokli and @zimbatm + +module Signature where + +import 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 diff --git a/tests/StorePath.hs b/tests/StorePath.hs --- a/tests/StorePath.hs +++ b/tests/StorePath.hs @@ -1,30 +1,37 @@ -{-# language DataKinds #-} -{-# language ScopedTypeVariables #-} -{-# language OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module StorePath where -import qualified Data.Attoparsec.Text +import Test.Hspec (Spec, describe, it, shouldBe) +import 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 :: StoreDir -> NixLike -> NixLike -> Property -prop_storePathRoundtrip storeDir (_ :: NixLike) (NixLike x) = - parsePath storeDir (storePathToRawFilePath storeDir x) === pure x + it "fails on empty" $ + parseNameText mempty + `shouldBe` + Left EmptyName --- | Test that any `StorePath` roundtrips -prop_storePathRoundtrip' :: StoreDir -> StorePath -> Property -prop_storePathRoundtrip' storeDir x = - parsePath storeDir (storePathToRawFilePath storeDir x) === pure x + it "fails on too long" $ + parseNameText (Data.Text.replicate 256 "n") + `shouldBe` + Left (NameTooLong 256) -prop_storePathRoundtripParser :: StoreDir -> NixLike -> NixLike -> Property -prop_storePathRoundtripParser storeDir (_ :: NixLike) (NixLike x) = - Data.Attoparsec.Text.parseOnly (pathParser storeDir) (storePathToText storeDir x) === pure x + it "fails on leading dot" $ + parseNameText ".ab" + `shouldBe` + Left LeadingDot -prop_storePathRoundtripParser' :: StoreDir -> StorePath -> Property -prop_storePathRoundtripParser' storeDir x = - Data.Attoparsec.Text.parseOnly (pathParser storeDir) (storePathToText storeDir x) === pure x + it "fails on invalid characters" $ + parseNameText "ab!cd#@" + `shouldBe` + Left (InvalidCharacters "!#@") diff --git a/tests/fixtures/case-conflict.nar b/tests/fixtures/case-conflict.nar deleted file mode 100644 Binary files a/tests/fixtures/case-conflict.nar and /dev/null differ