hnix-store-core (empty) → 0.1.0.0
raw patch · 19 files changed
+1595/−0 lines, 19 filesdep +basedep +base16-bytestringdep +base64-bytestringsetup-changed
Dependencies added: base, base16-bytestring, base64-bytestring, binary, bytestring, containers, cryptohash-md5, cryptohash-sha1, cryptohash-sha256, directory, filepath, hashable, hnix-store-core, mtl, process, regex-base, regex-tdfa-text, tasty, tasty-discover, tasty-hspec, tasty-hunit, tasty-quickcheck, temporary, text, unix, unordered-containers, vector
Files
- ChangeLog.md +5/−0
- LICENSE +201/−0
- README.md +15/−0
- Setup.hs +2/−0
- hnix-store-core.cabal +84/−0
- src/System/Nix/Base32.hs +31/−0
- src/System/Nix/Build.hs +50/−0
- src/System/Nix/Derivation.hs +30/−0
- src/System/Nix/GC.hs +47/−0
- src/System/Nix/Hash.hs +17/−0
- src/System/Nix/Internal/Hash.hs +154/−0
- src/System/Nix/Nar.hs +267/−0
- src/System/Nix/Path.hs +128/−0
- src/System/Nix/ReadonlyStore.hs +34/−0
- src/System/Nix/Store.hs +66/−0
- src/System/Nix/Util.hs +48/−0
- tests/Driver.hs +1/−0
- tests/Hash.hs +49/−0
- tests/NarFormat.hs +366/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for hnix-store-core++## 0.1.0.0 -- YYYY-mm-dd++* First version.
+ LICENSE view
@@ -0,0 +1,201 @@+ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright 2018 Shea Levy.++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,15 @@+hnix-store-core+=================++Core effects for interacting with the Nix store.++See `StoreEffects` in [System.Nix.Store] for the available operations+on the store.++[System.Nix.Store]: ./src/System/Nix/Store.hs+++Tests+======++ - `ghcid --command "cabal repl test-suite:format-tests" --test="Main.main"`
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hnix-store-core.cabal view
@@ -0,0 +1,84 @@+name: hnix-store-core+version: 0.1.0.0+synopsis: Core effects 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.+homepage: https://github.com/haskell-nix/hnix-store+license: Apache-2.0+license-file: LICENSE+author: Shea Levy+maintainer: shea@shealevy.com+copyright: 2018 Shea Levy+category: System+build-type: Simple+extra-source-files: ChangeLog.md, README.md+cabal-version: >=1.10++library+ exposed-modules: System.Nix.Base32+ , System.Nix.Build+ , System.Nix.Derivation+ , System.Nix.GC+ , System.Nix.Hash+ , System.Nix.Internal.Hash+ , System.Nix.Nar+ , System.Nix.Path+ , System.Nix.ReadonlyStore+ , System.Nix.Store+ , System.Nix.Util+ build-depends: base >=4.10 && <5+ , base16-bytestring+ , bytestring+ , binary+ , bytestring+ , containers+ , cryptohash-md5+ , cryptohash-sha1+ , cryptohash-sha256+ , directory+ , filepath+ , hashable+ , mtl+ , regex-base+ , regex-tdfa-text+ , text+ , unix+ , unordered-containers+ , vector+ hs-source-dirs: src+ default-language: Haskell2010++Flag bounded_memory+ description: Run tests of constant memory use (requires +RTS -T)+ default: False++test-suite format-tests+ if flag(bounded_memory)+ cpp-options: -DBOUNDED_MEMORY+ ghc-options: -rtsopts -fprof-auto+ type: exitcode-stdio-1.0+ main-is: Driver.hs+ other-modules:+ NarFormat+ Hash+ hs-source-dirs:+ tests+ build-depends:+ hnix-store-core+ , base+ , base64-bytestring+ , binary+ , bytestring+ , containers+ , directory+ , process+ , tasty+ , tasty-discover+ , tasty-hspec+ , tasty-hunit+ , tasty-quickcheck+ , temporary+ , text+ default-language: Haskell2010
+ src/System/Nix/Base32.hs view
@@ -0,0 +1,31 @@+{-|+Description: Implementation of Nix's base32 encoding.+-}+module System.Nix.Base32 where++import qualified Data.ByteString as BS+import qualified Data.Text as T+import qualified Data.Vector as V++-- | Encode a 'BS.ByteString' in Nix's base32 encoding+encode :: BS.ByteString -> T.Text+encode c = T.pack $ concatMap char32 [nChar - 1, nChar - 2 .. 0]+ where+ digits32 = V.fromList "0123456789abcdfghijklmnpqrsvwxyz"+ -- The base32 encoding is 8/5's as long as the base256 digest. This `+ 1`+ -- `- 1` business is a bit odd, but has always been used in C++ since the+ -- base32 truncation was added in was first added in+ -- d58a11e019813902b6c4547ca61a127938b2cc20.+ nChar = fromIntegral $ ((BS.length c * 8 - 1) `div` 5) + 1++ char32 :: Integer -> [Char]+ char32 i = [digits32 V.! digitInd]+ where+ byte j = BS.index c (fromIntegral j)+ fromIntegral' :: Num b => Integer -> b+ fromIntegral' = fromIntegral+ digitInd = fromIntegral' $+ sum [fromIntegral (byte j) * (256^j)+ | j <- [0 .. BS.length c - 1]]+ `div` (32^i)+ `mod` 32
+ src/System/Nix/Build.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE RecordWildCards #-}+{-|+Description : Build related types+Maintainer : srk <srk@48.io>+|-}+module System.Nix.Build (+ BuildMode(..)+ , BuildStatus(..)+ , BuildResult(..)+ , buildSuccess+ ) where++import Data.Text (Text)+import Data.HashSet (HashSet)+import System.Nix.Path (Path)++data BuildMode = Normal | Repair | Check+ deriving (Eq, Ord, Enum, Show)++data BuildStatus =+ Built+ | Substituted+ | AlreadyValid+ | PermanentFailure+ | InputRejected+ | OutputRejected+ | TransientFailure -- possibly transient+ | CachedFailure -- no longer used+ | TimedOut+ | MiscFailure+ | DependencyFailed+ | LogLimitExceeded+ | NotDeterministic+ deriving (Eq, Ord, Enum, Show)+++-- | Result of the build+data BuildResult = BuildResult+ { -- | build status, MiscFailure should be default+ status :: !BuildStatus+ , -- | possible build error message+ error :: !(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+ -- XXX: | startTime stopTime time_t+ } deriving (Eq, Ord, Show)++buildSuccess BuildResult{..} = status == Built || status == Substituted || status == AlreadyValid
+ src/System/Nix/Derivation.hs view
@@ -0,0 +1,30 @@+{-|+Description : Derivation types+Maintainer : srk <srk@48.io>+|-}++module System.Nix.Derivation where+++import Data.Text (Text)+import Data.HashMap.Strict (HashMap)+import Data.HashSet (HashSet)+import System.Nix.Path++type OutputName = Text++newtype DerivationInputs = DerivationInputs+ { _unDerivationInputs :: HashMap Path (HashSet OutputName)+ } deriving (Eq, Ord, Show)++data Derivation = Derivation+ { _derivationInputs :: DerivationInputs+ , _derivationOutputs :: !(HashMap OutputName Path)+ -- | Inputs that are sources+ , _derivationInputSrcs :: !PathSet+ , _derivationPlatform :: !Text+ -- | Path to builder+ , _derivationBuilder :: !Path+ , _derivationArgs :: ![Text]+ , _derivationEnv :: ![HashMap Text Text]+ } deriving (Eq, Ord, Show)
+ src/System/Nix/GC.hs view
@@ -0,0 +1,47 @@+{-|+Description : Garbage collection actions / options+Maintainer : srk <srk@48.io>+|-}+module System.Nix.GC (+ Action(..)+ , Options(..)+ , Result(..)+ ) where++import System.Nix.Path (PathSet)++{- Garbage collector operation:+ - ReturnLive: return the set of paths reachable from+ (i.e. in the closure of) the roots.+ - ReturnDead: return the set of paths not reachable from+ the roots.+ - DeleteDead: actually delete the latter set.+ - DeleteSpecific: delete the paths listed in+ `pathsToDelete', insofar as they are not reachable.+-}++data Action = ReturnLive | ReturnDead | DeleteDead | DeleteSpecific+ deriving (Eq, Ord, Enum, Show)++-- | Garbage collector operation options+data Options = Options+ { -- | operation+ operation :: !Action+ -- | If `ignoreLiveness' is set, then reachability from the roots is+ -- ignored (dangerous!). However, the paths must still be+ -- unreferenced *within* the store (i.e., there can be no other+ -- store paths that depend on them).+ , ignoreLiveness :: !Bool+ -- | For DeleteSpecific, the paths to delete+ , pathsToDelete :: !PathSet+ , -- | Stop after at least `maxFreed` bytes have been freed+ maxFreed :: !Integer+ } deriving (Eq, Ord, Show)++data Result = Result+ { -- | Depending on the action, the GC roots, or the paths that would be or have been deleted+ paths :: !PathSet+ , -- | For ReturnDead, DeleteDead and DeleteSpecific, the number of bytes that would be or was freed+ bytesFreed :: !Integer+ } deriving (Eq, Ord, Show)+
+ src/System/Nix/Hash.hs view
@@ -0,0 +1,17 @@+{-|+Description : Cryptographic hashes for hnix-store.+-}+module System.Nix.Hash (+ HNix.Digest++ , HNix.HashAlgorithm(..)+ , HNix.ValidAlgo(..)+ , HNix.NamedAlgo(..)+ , HNix.hash+ , HNix.hashLazy++ , HNix.encodeBase32+ , HNix.encodeBase16+ ) where++import qualified System.Nix.Internal.Hash as HNix
+ src/System/Nix/Internal/Hash.hs view
@@ -0,0 +1,154 @@+{-|+Description : Cryptographic hashing interface for hnix-store, on top+ of the cryptohash family of libraries.+-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++module System.Nix.Internal.Hash where++import qualified Crypto.Hash.MD5 as MD5+import qualified Crypto.Hash.SHA1 as SHA1+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as Base16+import Data.Bits (xor)+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Hashable as DataHashable+import Data.List (foldl')+import Data.Proxy (Proxy(Proxy))+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Word (Word8)+import GHC.TypeLits (Nat, KnownNat, natVal)+import qualified System.Nix.Base32 as Base32++-- | The universe of supported hash algorithms.+--+-- Currently only intended for use at the type level.+data HashAlgorithm+ = MD5+ | SHA1+ | SHA256+ | Truncated Nat HashAlgorithm+ -- ^ The hash algorithm obtained by truncating the result of the+ -- input 'HashAlgorithm' to the given number of bytes. See+ -- 'truncateDigest' for a description of the truncation algorithm.++-- | The result of running a 'HashAlgorithm'.+newtype Digest (a :: HashAlgorithm) =+ Digest BS.ByteString deriving (Show, Eq, Ord, DataHashable.Hashable)++-- | The primitive interface for incremental hashing for a given+-- 'HashAlgorithm'. Every 'HashAlgorithm' should have an instance.+class ValidAlgo (a :: HashAlgorithm) where+ -- | The incremental state for constructing a hash.+ type AlgoCtx a++ -- | Start building a new hash.+ initialize :: AlgoCtx a+ -- | Append a 'BS.ByteString' to the overall contents to be hashed.+ update :: AlgoCtx a -> BS.ByteString -> AlgoCtx a+ -- | Finish hashing and generate the output.+ finalize :: AlgoCtx a -> Digest a++-- | A 'HashAlgorithm' with a canonical name, for serialization+-- purposes (e.g. SRI hashes)+class NamedAlgo (a :: HashAlgorithm) where+ algoName :: Text++instance NamedAlgo 'MD5 where+ algoName = "md5"++instance NamedAlgo 'SHA1 where+ algoName = "sha1"++instance NamedAlgo 'SHA256 where+ algoName = "sha256"++-- | Hash an entire (strict) 'BS.ByteString' as a single call.+--+-- For example:+-- > let d = hash "Hello, sha-256!" :: Digest SHA256+-- or+-- > :set -XTypeApplications+-- > let d = hash @SHA256 "Hello, sha-256!"+hash :: forall a.ValidAlgo a => BS.ByteString -> Digest a+hash bs =+ finalize $ update @a (initialize @a) bs++-- | Hash an entire (lazy) 'BSL.ByteString' as a single call.+--+-- Use is the same as for 'hash'. This runs in constant space, but+-- forces the entire bytestring.+hashLazy :: forall a.ValidAlgo a => BSL.ByteString -> Digest a+hashLazy bsl =+ finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl)++-- | Encode a 'Digest' in the special Nix base-32 encoding.+encodeBase32 :: Digest a -> T.Text+encodeBase32 (Digest bs) = Base32.encode bs++-- | Encode a 'Digest' in hex.+encodeBase16 :: Digest a -> T.Text+encodeBase16 (Digest bs) = T.decodeUtf8 (Base16.encode bs)++-- | Uses "Crypto.Hash.MD5" from cryptohash-md5.+instance ValidAlgo 'MD5 where+ type AlgoCtx 'MD5 = MD5.Ctx+ initialize = MD5.init+ update = MD5.update+ finalize = Digest . MD5.finalize++-- | Uses "Crypto.Hash.SHA1" from cryptohash-sha1.+instance ValidAlgo 'SHA1 where+ type AlgoCtx 'SHA1 = SHA1.Ctx+ initialize = SHA1.init+ update = SHA1.update+ finalize = Digest . SHA1.finalize++-- | Uses "Crypto.Hash.SHA256" from cryptohash-sha256.+instance ValidAlgo 'SHA256 where+ type AlgoCtx 'SHA256 = SHA256.Ctx+ initialize = SHA256.init+ update = SHA256.update+ finalize = Digest . SHA256.finalize++-- | Reuses the underlying 'ValidAlgo' instance, but does a+-- 'truncateDigest' at the end.+instance (ValidAlgo a, KnownNat n) => ValidAlgo ('Truncated n a) where+ type AlgoCtx ('Truncated n a) = AlgoCtx a+ initialize = initialize @a+ update = update @a+ finalize = truncateDigest @n . finalize @a++-- | 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'.+truncateDigest+ :: forall n a.(KnownNat n) => Digest a -> Digest ('Truncated n a)+truncateDigest (Digest c) =+ Digest $ BS.pack $ map truncOutputByte [0.. n-1]+ where+ n = fromIntegral $ natVal (Proxy @n)++ truncOutputByte :: Int -> Word8+ truncOutputByte i = foldl' (aux i) 0 [0 .. BS.length c - 1]++ inputByte :: Int -> Word8+ inputByte j = BS.index c (fromIntegral j)++ aux :: Int -> Word8 -> Int -> Word8+ aux i x j = if j `mod` fromIntegral n == fromIntegral i+ then xor x (inputByte $ fromIntegral j)+ else x
+ src/System/Nix/Nar.hs view
@@ -0,0 +1,267 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}++{-|+Description : Allowed effects for interacting with Nar files.+Maintainer : Shea Levy <shea@shealevy.com>+|-}+module System.Nix.Nar (+ FileSystemObject(..)+ , IsExecutable (..)+ , Nar(..)+ , getNar+ , localPackNar+ , localUnpackNar+ , narEffectsIO+ , putNar+ ) where++import Control.Applicative+import Control.Monad (replicateM, replicateM_, (<=<))+import qualified Data.Binary as B+import qualified Data.Binary.Get as B+import qualified Data.Binary.Put as B+import Data.Bool (bool)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL+import Data.Foldable (forM_)+import qualified Data.Map as Map+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import qualified Data.Text as T+import qualified Data.Text.Encoding as E+import Data.Traversable (forM)+import GHC.Int (Int64)+import System.Directory+import System.FilePath+import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus,+ isDirectory, readSymbolicLink)++import System.Nix.Path++data NarEffects (m :: * -> *) = NarEffects {+ narReadFile :: FilePath -> m BSL.ByteString+ , narWriteFile :: FilePath -> BSL.ByteString -> m ()+ , narListDir :: FilePath -> m [FilePath]+ , narCreateDir :: FilePath -> m ()+ , narCreateLink :: FilePath -> FilePath -> m ()+ , narGetPerms :: FilePath -> m Permissions+ , narSetPerms :: FilePath -> Permissions -> m ()+ , narIsDir :: FilePath -> m Bool+ , narIsSymLink :: FilePath -> m Bool+ , narFileSize :: FilePath -> m Int64+ , narReadLink :: FilePath -> m FilePath+}+++-- Directly taken from Eelco thesis+-- https://nixos.org/%7Eeelco/pubs/phd-thesis.pdf++data Nar = Nar { narFile :: FileSystemObject }+ deriving (Eq, Show)++-- | A FileSystemObject (FSO) is an anonymous entity that can be NAR archived+data FileSystemObject =+ Regular 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)+++data IsExecutable = NonExecutable | Executable+ deriving (Eq, Show)+++instance B.Binary Nar where+ get = getNar+ put = putNar++------------------------------------------------------------------------------+-- | Serialize Nar to lazy ByteString+putNar :: Nar -> B.Put+putNar (Nar file) = header <> parens (putFile file)+ where++ header = str "nix-archive-1"++ putFile (Regular isExec fSize contents) =+ strs ["type", "regular"]+ >> (if isExec == Executable+ then strs ["executable", ""]+ else return ())+ >> putContents fSize contents++ putFile (SymLink target) =+ strs ["type", "symlink", "target", BSL.fromStrict $ E.encodeUtf8 target]++ -- toList sorts the entries by FilePathPart before serializing+ putFile (Directory entries) =+ strs ["type", "directory"]+ <> mapM_ putEntry (Map.toList entries)++ putEntry (FilePathPart name, fso) = do+ str "entry"+ parens $ do+ str "name"+ str (BSL.fromStrict name)+ str "node"+ parens (putFile fso)++ parens m = str "(" >> m >> str ")"++ -- Do not use this for file contents+ str :: BSL.ByteString -> B.Put+ str t = let len = BSL.length t+ in int len <> pad len t++ putContents :: Int64 -> BSL.ByteString -> B.Put+ putContents fSize bs = str "contents" <> int fSize <> (pad fSize bs)+ -- putContents fSize bs = str "contents" <> int (BSL.length bs) <> (pad fSize bs)++ int :: Integral a => a -> B.Put+ int n = B.putInt64le $ fromIntegral n++ pad :: Int64 -> BSL.ByteString -> B.Put+ pad strSize bs = do+ B.putLazyByteString bs+ B.putLazyByteString (BSL.replicate (padLen strSize) 0)++ strs :: [BSL.ByteString] -> B.Put+ strs = mapM_ str+++------------------------------------------------------------------------------+-- | Deserialize a Nar from lazy ByteString+getNar :: B.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 $ Executable <$ (assertStr "executable"+ >> assertStr "")+ assertStr "contents"+ (fSize, contents) <- sizedStr+ return $ Regular (fromMaybe NonExecutable mExecutable) fSize contents++ getDirectory = do+ assertStr "type"+ assertStr "directory"+ fs <- many getEntry+ return $ Directory (Map.fromList fs)++ getSymLink = do+ assertStr "type"+ assertStr "symlink"+ assertStr "target"+ fmap (SymLink . E.decodeUtf8 . BSL.toStrict) str++ getEntry = do+ assertStr "entry"+ parens $ do+ assertStr "name"+ name <- E.decodeUtf8 . BSL.toStrict <$> str+ assertStr "node"+ file <- parens getFile+ maybe (fail $ "Bad FilePathPart: " ++ show name)+ (return . (,file))+ (filePathPart $ E.encodeUtf8 name)++ -- Fetch a length-prefixed, null-padded string+ str = fmap snd sizedStr++ sizedStr = do+ n <- B.getInt64le+ s <- B.getLazyByteString n+ p <- B.getByteString . fromIntegral $ padLen n+ return (n,s)++ parens m = assertStr "(" *> m <* assertStr ")"++ assertStr s = do+ s' <- str+ if s == s'+ then return s+ else fail "No"+++-- | Distance to the next multiple of 8+padLen :: Int64 -> Int64+padLen n = (8 - n) `mod` 8+++-- | Unpack a NAR into a non-nix-store directory (e.g. for testing)+localUnpackNar :: Monad m => NarEffects m -> FilePath -> Nar -> m ()+localUnpackNar effs basePath (Nar fso) = localUnpackFSO basePath fso++ where++ localUnpackFSO basePath fso = case fso of++ Regular isExec _ bs -> do+ (narWriteFile effs) basePath bs+ p <- narGetPerms effs basePath+ (narSetPerms effs) basePath (p {executable = isExec == Executable})++ SymLink targ -> narCreateLink effs (T.unpack targ) basePath++ Directory contents -> do+ narCreateDir effs basePath+ forM_ (Map.toList contents) $ \(FilePathPart path', fso) ->+ localUnpackFSO (basePath </> BSC.unpack path') fso+++-- | Pack a NAR from a filepath+localPackNar :: Monad m => NarEffects m -> FilePath -> m Nar+localPackNar effs basePath = Nar <$> localPackFSO basePath++ where++ localPackFSO path' = do+ fType <- (,) <$> narIsDir effs path' <*> narIsSymLink effs path'+ case fType of+ (_, True) -> SymLink . T.pack <$> narReadLink effs path'+ (False, _) -> Regular <$> isExecutable effs path'+ <*> narFileSize effs path'+ <*> narReadFile effs path'+ (True , _) -> fmap (Directory . Map.fromList) $ do+ fs <- narListDir effs path'+ forM fs $ \fp ->+ (FilePathPart (BSC.pack $ fp),) <$> localPackFSO (path' </> fp)++++narEffectsIO :: NarEffects IO+narEffectsIO = NarEffects {+ narReadFile = BSL.readFile+ , narWriteFile = BSL.writeFile+ , narListDir = listDirectory+ , narCreateDir = createDirectory+ , narCreateLink = createSymbolicLink+ , narGetPerms = getPermissions+ , narSetPerms = setPermissions+ , narIsDir = fmap isDirectory <$> getFileStatus+ , narIsSymLink = pathIsSymbolicLink+ , narFileSize = fmap (fromIntegral . fileSize) <$> getFileStatus+ , narReadLink = readSymbolicLink+ }+++isExecutable :: Functor m => NarEffects m -> FilePath -> m IsExecutable+isExecutable effs fp =+ bool NonExecutable Executable . executable <$> narGetPerms effs fp
+ src/System/Nix/Path.hs view
@@ -0,0 +1,128 @@+{-|+Description : Types and effects for interacting with the Nix store.+Maintainer : Shea Levy <shea@shealevy.com>+-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module System.Nix.Path+ ( FilePathPart(..)+ , PathHashAlgo+ , Path(..)+ , pathToText+ , PathSet+ , SubstitutablePathInfo(..)+ , ValidPathInfo(..)+ , PathName(..)+ , filePathPart+ , pathName+ , Roots+ ) where++import System.Nix.Hash (Digest(..),+ HashAlgorithm(Truncated, SHA256))+import System.Nix.Internal.Hash+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.Hashable (Hashable (..), hashPtrWithSalt)+import Data.HashMap.Strict (HashMap)+import Data.HashSet (HashSet)+import Data.Map.Strict (Map)+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import System.IO.Unsafe (unsafeDupablePerformIO)+import Text.Regex.Base.RegexLike (makeRegex, matchTest)+import Text.Regex.TDFA.Text (Regex)++-- | The hash algorithm used for store path hashes.+type PathHashAlgo = Truncated 20 SHA256+++-- | The name portion of a Nix path.+--+-- Must be composed of a-z, A-Z, 0-9, +, -, ., _, ?, and =, can't+-- start with a ., and must have at least one character.+newtype PathName = PathName+ { pathNameContents :: Text -- ^ The contents of the path name+ } deriving (Eq, Ord, Show, Hashable)++-- | A regular expression for matching a valid 'PathName'+nameRegex :: Regex+nameRegex =+ makeRegex ("[a-zA-Z0-9\\+\\-\\_\\?\\=][a-zA-Z0-9\\+\\-\\.\\_\\?\\=]*" :: String)++-- | Construct a 'PathName', assuming the provided contents are valid.+pathName :: Text -> Maybe PathName+pathName n = case matchTest nameRegex n of+ True -> Just $ PathName n+ False -> Nothing++-- | A path in a store.+data Path = Path !(Digest PathHashAlgo) !PathName+ deriving (Eq, Ord, Show)++pathToText :: Text -> Path -> Text+pathToText storeDir (Path h nm) = storeDir <> "/" <> encodeBase32 h <> "-" <> pathNameContents nm++type PathSet = HashSet Path++-- | Information about substitutes for a 'Path'.+data SubstitutablePathInfo = SubstitutablePathInfo+ { -- | The .drv which led to this 'Path'.+ deriver :: !(Maybe Path)+ , -- | The references of the 'Path'+ references :: !PathSet+ , -- | The (likely compressed) size of the download of this 'Path'.+ downloadSize :: !Integer+ , -- | The size of the uncompressed NAR serialization of this+ -- 'Path'.+ narSize :: !Integer+ } deriving (Eq, Ord, Show)++-- | Information about @Path@+data ValidPathInfo = ValidPathInfo+ { -- | Path itself+ path :: !Path+ , -- | The .drv which led to this 'Path'.+ deriverVP :: !(Maybe Path)+ , -- | NAR hash+ narHash :: !Text+ , -- | The references of the 'Path'+ referencesVP :: !PathSet+ , -- | Registration time should be time_t+ registrationTime :: !Integer+ , -- | The size of the uncompressed NAR serialization of this+ -- 'Path'.+ narSizeVP :: !Integer+ , -- | Whether the path is ultimately trusted, that is, it's a+ -- derivation output that was built locally.+ ultimate :: !Bool+ , -- | Signatures+ sigs :: ![Text]+ , -- | Content-addressed+ -- Store path is computed from a cryptographic hash+ -- of the contents of the path, plus some other bits of data like+ -- the "name" part of the path.+ --+ -- ‘ca’ has one of the following forms:+ -- * ‘text:sha256:<sha256 hash of file contents>’ (paths by makeTextPath() / addTextToStore())+ -- * ‘fixed:<r?>:<ht>:<h>’ (paths by makeFixedOutputPath() / addToStore())+ ca :: !Text+ } deriving (Eq, Ord, Show)++-- | A valid filename or directory name+newtype FilePathPart = FilePathPart { unFilePathPart :: BSC.ByteString }+ deriving (Eq, Ord, Show)++-- | Construct FilePathPart from Text by checking that there+-- are no '/' or '\\NUL' characters+filePathPart :: BSC.ByteString -> Maybe FilePathPart+filePathPart p = case BSC.any (`elem` ['/', '\NUL']) p of+ False -> Just $ FilePathPart p+ True -> Nothing++type Roots = Map Path Path++instance Hashable Path where+ hashWithSalt s (Path hash name) = s `hashWithSalt` hash `hashWithSalt` name
+ src/System/Nix/ReadonlyStore.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module System.Nix.ReadonlyStore where++import Data.ByteString (ByteString)+import Data.ByteString.Base16 as Base16+import qualified Data.HashSet as HS+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding+import System.Nix.Hash+import System.Nix.Path++makeStorePath :: Text -> Text -> Digest 'SHA256 -> Text -> Path+makeStorePath storeDir ty h nm = Path storeHash (PathName nm)+ where+ s = T.intercalate ":"+ [ ty+ , algoName @'SHA256+ , encodeBase16 h+ , storeDir+ , nm+ ]+ storeHash = hash $ encodeUtf8 s++makeTextPath :: Text -> Text -> Digest 'SHA256 -> PathSet -> Path+makeTextPath storeDir nm h refs = makeStorePath storeDir ty h nm+ where+ ty = T.intercalate ":" ("text" : map (pathToText storeDir) (HS.toList refs))++computeStorePathForText :: Text -> Text -> ByteString -> PathSet -> Path+computeStorePathForText storeDir nm s refs = makeTextPath storeDir nm (hash s) refs
+ src/System/Nix/Store.hs view
@@ -0,0 +1,66 @@+{-|+Description : Types and effects for interacting with the Nix store.+Maintainer : Shea Levy <shea@shealevy.com>+-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module System.Nix.Store+ ( PathName, pathNameContents, pathName+ , PathHashAlgo, Path(..)+ , StoreEffects(..)+ , SubstitutablePathInfo(..)+ ) where++import qualified Data.ByteString.Lazy as BS+import Data.Text (Text)+import Text.Regex.Base.RegexLike (makeRegex, matchTest)+import Text.Regex.TDFA.Text (Regex)+import Data.Hashable (Hashable(..), hashPtrWithSalt)+import Data.HashSet (HashSet)+import Data.HashMap.Strict (HashMap)+import System.IO.Unsafe (unsafeDupablePerformIO)++import System.Nix.Hash (Digest)+import System.Nix.Path+import System.Nix.Nar+++-- | Interactions with the Nix store.+--+-- @rootedPath@: A path plus a witness to the fact that the path is+-- reachable from a root whose liftime is at least as long as the+-- @rootedPath@ reference itself, when the implementation supports+-- this.+--+-- @validPath@: A @rootedPath@ plus a witness to the fact that the+-- path is valid. On implementations that support temporary roots,+-- this implies that the path will remain valid so long as the+-- reference is held.+--+-- @m@: The monad the effects operate in.+data StoreEffects rootedPath validPath m =+ StoreEffects+ { -- | Project out the underlying 'Path' from a 'rootedPath'+ fromRootedPath :: !(rootedPath -> Path)+ , -- | Project out the underlying 'rootedPath' from a 'validPath'+ fromValidPath :: !(validPath -> rootedPath)+ , -- | Which of the given paths are valid?+ validPaths :: !(HashSet rootedPath -> m (HashSet validPath))+ , -- | Get the paths that refer to a given path.+ referrers :: !(validPath -> m (HashSet Path))+ , -- | Get a root to the 'Path'.+ rootedPath :: !(Path -> m rootedPath)+ , -- | Get information about substituters of a set of 'Path's+ substitutablePathInfos ::+ !(HashSet Path -> m (HashMap Path SubstitutablePathInfo))+ , -- | Get the currently valid derivers of a 'Path'.+ validDerivers :: !(Path -> m (HashSet Path))+ , -- | Get the outputs of the derivation at a 'Path'.+ derivationOutputs :: !(validPath -> m (HashSet Path))+ , -- | Get the output names of the derivation at a 'Path'.+ derivationOutputNames :: !(validPath -> m (HashSet Text))+ , -- | Get a full 'Path' corresponding to a given 'Digest'.+ pathFromHashPart :: !(Digest PathHashAlgo -> m Path)+ , -- | Add a non-nar file to the store+ addFile :: !(BS.ByteString -> m validPath)+ }
+ src/System/Nix/Util.hs view
@@ -0,0 +1,48 @@+{-|+Description : Utilities for packing stuff+Maintainer : srk <srk@48.io>+|-}+module System.Nix.Util where++import Control.Monad+import Data.Binary.Get+import Data.Binary.Put+import qualified Data.ByteString.Lazy as LBS++putInt :: Integral a => a -> Put+putInt = putWord64le . fromIntegral++getInt :: Integral a => Get a+getInt = fromIntegral <$> getWord64le++-- length prefixed string packing with padding to 8 bytes+putByteStringLen :: LBS.ByteString -> Put+putByteStringLen x = do+ putInt $ fromIntegral $ len+ putLazyByteString x+ when (len `mod` 8 /= 0) $+ pad $ fromIntegral $ 8 - (len `mod` 8)+ where len = LBS.length x+ pad x = forM_ (take x $ cycle [0]) putWord8++putByteStrings :: Foldable t => t LBS.ByteString -> Put+putByteStrings xs = do+ putInt $ fromIntegral $ length xs+ mapM_ putByteStringLen xs++getByteStringLen :: Get LBS.ByteString+getByteStringLen = do+ len <- getInt+ st <- getLazyByteString len+ when (len `mod` 8 /= 0) $ do+ pads <- unpad $ fromIntegral $ 8 - (len `mod` 8)+ unless (all (==0) pads) $ fail $ "No zeroes" ++ show (st, len, pads)+ return st+ where unpad x = sequence $ replicate x getWord8++getByteStrings :: Get [LBS.ByteString]+getByteStrings = do+ count <- getInt+ res <- sequence $ replicate count getByteStringLen+ return res+
+ tests/Driver.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}
+ tests/Hash.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Hash where++import Control.Monad.IO.Class (liftIO)+import Control.Exception (bracket)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64.Lazy as B64+import qualified Data.ByteString.Lazy as BSL+import Data.Monoid ((<>))+import qualified Data.Text as T+import System.Directory (removeFile)+import System.IO.Temp (withSystemTempFile, writeSystemTempFile)+import qualified System.IO as IO -- (hGetContents, hPutStr, openFile)+import qualified System.Process as P+import Test.Tasty as T+import Test.Tasty.Hspec+import qualified Test.Tasty.HUnit as HU+import Test.Tasty.QuickCheck+import Text.Read (readMaybe)++import System.Nix.Hash+import System.Nix.Path+import NarFormat -- TODO: Move the fixtures into a common module++spec_hash :: Spec+spec_hash = do++ describe "hashing parity with nix-store" $ do++ it "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" $+ shouldBe (encodeBase32 (hash @SHA256 "nix-output:foo"))+ "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5"++ it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $+ shouldBe (encodeBase32 (hash @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+ let exampleStr =+ "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3"+ <> "c0d7b98883f9ee3:/nix/store:myfile"+ shouldBe (encodeBase32 @PathHashAlgo (hash exampleStr))+ "xv2iccirbrvklck36f1g7vldn5v58vck"
+ tests/NarFormat.hs view
@@ -0,0 +1,366 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module NarFormat where++import Control.Applicative ((<|>))+import Control.Concurrent (threadDelay)+import Control.Exception (SomeException, bracket, try)+import Control.Monad (replicateM)+import Control.Monad.IO.Class (liftIO)+import Data.Binary (put)+import Data.Binary.Get (Get (..), runGet)+import Data.Binary.Put (Put (..), runPut)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64.Lazy as B64+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BSLC+import Data.Int+import qualified Data.Map as Map+import Data.Maybe (fromMaybe, isJust)+import qualified Data.Text as T+import GHC.Stats (getRTSStats, max_live_bytes)+import System.Directory (removeFile)+import System.Environment (getEnv)+import qualified System.Process as P+import Test.Tasty as T+import Test.Tasty.Hspec+import qualified Test.Tasty.HUnit as HU+import Test.Tasty.QuickCheck+import Text.Read (readMaybe)++import System.Nix.Nar+import System.Nix.Path++++spec_narEncoding :: Spec+spec_narEncoding = do++ -- For a Haskell embedded Nar, check that (decode . encode === id)+ let roundTrip n = runGet getNar (runPut $ putNar n) `shouldBe` n++ -- For a Haskell embedded Nar, check that encoding it gives+ -- the same bytestring as `nix-store --dump`+ let encEqualsNixStore n b = runPut (putNar n) `shouldBe` b+++ describe "parser-roundtrip" $ do+ it "roundtrips regular" $ do+ roundTrip (Nar sampleRegular)++ it "roundtrips regular 2" $ do+ roundTrip (Nar sampleRegular')++ it "roundtrips executable" $ do+ roundTrip (Nar sampleExecutable)++ it "roundtrips symlink" $ do+ roundTrip (Nar sampleSymLink)++ it "roundtrips directory" $ do+ roundTrip (Nar sampleDirectory)+++ describe "matches-nix-store fixture" $ do+ it "matches regular" $ do+ encEqualsNixStore (Nar sampleRegular) sampleRegularBaseline++ it "matches regular'" $+ encEqualsNixStore (Nar sampleRegular') sampleRegular'Baseline++ it "matches executable" $+ encEqualsNixStore (Nar sampleExecutable) sampleExecutableBaseline++ it "matches symlink" $+ encEqualsNixStore (Nar sampleSymLink) sampleSymLinkBaseline++ it "matches directory" $ do+ encEqualsNixStore (Nar sampleDirectory) sampleDirectoryBaseline++unit_nixStoreRegular :: HU.Assertion+unit_nixStoreRegular = filesystemNixStore "regular" (Nar sampleRegular)++unit_nixStoreDirectory :: HU.Assertion+unit_nixStoreDirectory = filesystemNixStore "directory" (Nar sampleDirectory)++unit_nixStoreDirectory' :: HU.Assertion+unit_nixStoreDirectory' = filesystemNixStore "directory'" (Nar sampleDirectory')++unit_nixStoreBigFile :: HU.Assertion+unit_nixStoreBigFile = getBigFileSize >>= \sz ->+ filesystemNixStore "bigfile'" (Nar $ sampleLargeFile sz)++unit_nixStoreBigDir :: HU.Assertion+unit_nixStoreBigDir = getBigFileSize >>= \sz ->+ filesystemNixStore "bigfile'" (Nar $ sampleLargeDir sz)++prop_narEncodingArbitrary :: Nar -> Property+prop_narEncodingArbitrary n = runGet getNar (runPut $ putNar n) === n++unit_packSelfSrcDir :: HU.Assertion+unit_packSelfSrcDir = do+ ver <- try (P.readProcess "nix-store" ["--version"] "")+ case ver of+ Left (e :: SomeException) -> print "No nix-store on system"+ Right _ -> do+ hnixNar <- runPut . put <$> localPackNar narEffectsIO "src"+ nixStoreNar <- getNixStoreDump "src"+ HU.assertEqual+ "src dir serializes the same between hnix-store and nix-store"+ hnixNar+ nixStoreNar++unit_streamLargeFileToNar :: HU.Assertion+unit_streamLargeFileToNar =+ bracket (getBigFileSize >>= makeBigFile) (const rmFiles) $ \_ -> do+ nar <- localPackNar narEffectsIO bigFileName+ BSL.writeFile narFileName . runPut . put $ nar+ assertBoundedMemory+ where+ bigFileName = "bigFile.bin"+ narFileName = "bigFile.nar"+ makeBigFile = \sz -> BSL.writeFile bigFileName+ (BSL.take sz $ BSL.cycle "Lorem ipsum")+ rmFiles = removeFile bigFileName >> removeFile narFileName+++-- **************** 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 (e :: SomeException) -> print "No nix-store on system"+ Right _ ->+ bracket (return ()) (\_ -> P.runCommand "rm -rf testfile nixstorenar.nar hnix.nar") $ \_ -> do++ -- stream nar contents to unpacked file(s)+ localUnpackNar narEffectsIO "testfile" n++ -- nix-store converts those files to nar+ getNixStoreDump "testfile" >>= BSL.writeFile "nixstorenar.nar"++ -- hnix converts those files to nar+ localPackNar narEffectsIO "testfile" >>= BSL.writeFile "hnix.nar" . runPut . putNar++ diffResult <- P.readProcess "diff" ["nixstorenar.nar", "hnix.nar"] ""++ 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+ return ()+#endif+++-- | 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 NonExecutable 3 "hi\n"++-- | Simple text file with some c code+sampleRegular' :: FileSystemObject+sampleRegular' = Regular NonExecutable (BSL.length str) str+ where str =+ "#include <stdio.h>\n\nint main(int argc, char *argv[]){ exit 0; }\n"++-- | Executable file+sampleExecutable :: FileSystemObject+sampleExecutable = Regular 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 NonExecutable 8 "foo text")+ , (FilePathPart "tobar" , SymLink "../bar/bar.txt")+ ])++ , (FilePathPart "bar", Directory $ Map.fromList [+ (FilePathPart "bar.txt", Regular NonExecutable 8 "bar text")+ , (FilePathPart "tofoo" , SymLink "../foo/foo.txt")+ ])+ ]++sampleLargeFile :: Int64 -> FileSystemObject+sampleLargeFile fSize =+ Regular NonExecutable fSize (BSL.take fSize (BSL.cycle "Lorem ipsum "))+++sampleLargeFile' :: Int64 -> FileSystemObject+sampleLargeFile' fSize =+ Regular 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 NonExecutable 10000 (BSL.take 10000 (BSL.cycle "hi ")))+ | n <- [1..100]]+ ++ [+ (FilePathPart "d", Directory $ Map.fromList+ [ (FilePathPart (BSC.pack $ "df" ++ show n)+ , Regular NonExecutable 10000 (BSL.take 10000 (BSL.cycle "subhi ")))+ | n <- [1..100]]+ )+ ]++-- * For each sample above, feed it into `nix-store --dump`,+-- and base64 encode the resulting NAR binary. This lets us+-- check our Haskell NAR generator against `nix-store`++-- "hi" file turned to a NAR with `nix-store --dump`, Base64 encoded+sampleRegularBaseline :: BSL.ByteString+sampleRegularBaseline = B64.decodeLenient $ BSL.concat+ ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA"+ ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHJlZ3VsYXIACAAAAA"+ ,"AAAABjb250ZW50cwMAAAAAAAAAaGkKAAAAAAABAAAAAAAAACkAA"+ ,"AAAAAAA"+ ]++sampleRegular'Baseline :: BSL.ByteString+sampleRegular'Baseline = B64.decodeLenient $ BSL.concat+ ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA"+ ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHJlZ3VsYXIACAAAAA"+ ,"AAAABjb250ZW50c0AAAAAAAAAAI2luY2x1ZGUgPHN0ZGlvLmg+C"+ ,"gppbnQgbWFpbihpbnQgYXJnYywgY2hhciAqYXJndltdKXsgZXhp"+ ,"dCAwOyB9CgEAAAAAAAAAKQAAAAAAAAA="+ ]++sampleExecutableBaseline :: BSL.ByteString+sampleExecutableBaseline = B64.decodeLenient $ BSL.concat+ ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA"+ ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHJlZ3VsYXIACgAAAA"+ ,"AAAABleGVjdXRhYmxlAAAAAAAAAAAAAAAAAAAIAAAAAAAAAGNvb"+ ,"nRlbnRzIgAAAAAAAAAjIS9iaW4vYmFzaAoKZ2NjIC1vIGhlbGxv"+ ,"IGhlbGxvLmMKAAAAAAAAAQAAAAAAAAApAAAAAAAAAA=="+ ]++sampleSymLinkBaseline :: BSL.ByteString+sampleSymLinkBaseline = B64.decodeLenient $ BSL.concat+ ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA"+ ,"AAAQAAAAAAAAAdHlwZQAAAAAHAAAAAAAAAHN5bWxpbmsABgAAAA"+ ,"AAAAB0YXJnZXQAAAcAAAAAAAAAaGVsbG8uYwABAAAAAAAAACkAA"+ ,"AAAAAAA"+ ]++sampleDirectoryBaseline :: BSL.ByteString+sampleDirectoryBaseline = B64.decodeLenient $ BSL.concat+ ["DQAAAAAAAABuaXgtYXJjaGl2ZS0xAAAAAQAAAAAAAAAoAAAAAAA"+ ,"AAAQAAAAAAAAAdHlwZQAAAAAJAAAAAAAAAGRpcmVjdG9yeQAAAA"+ ,"AAAAAFAAAAAAAAAGVudHJ5AAAAAQAAAAAAAAAoAAAAAAAAAAQAA"+ ,"AAAAAAAbmFtZQAAAAAIAAAAAAAAAGJ1aWxkLnNoBAAAAAAAAABu"+ ,"b2RlAAAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAHR5cGUAAAA"+ ,"ABwAAAAAAAAByZWd1bGFyAAoAAAAAAAAAZXhlY3V0YWJsZQAAAA"+ ,"AAAAAAAAAAAAAACAAAAAAAAABjb250ZW50cyIAAAAAAAAAIyEvY"+ ,"mluL2Jhc2gKCmdjYyAtbyBoZWxsbyBoZWxsby5jCgAAAAAAAAEA"+ ,"AAAAAAAAKQAAAAAAAAABAAAAAAAAACkAAAAAAAAABQAAAAAAAAB"+ ,"lbnRyeQAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAG5hbWUAAA"+ ,"AABwAAAAAAAABoZWxsby5jAAQAAAAAAAAAbm9kZQAAAAABAAAAA"+ ,"AAAACgAAAAAAAAABAAAAAAAAAB0eXBlAAAAAAcAAAAAAAAAcmVn"+ ,"dWxhcgAIAAAAAAAAAGNvbnRlbnRzQAAAAAAAAAAjaW5jbHVkZSA"+ ,"8c3RkaW8uaD4KCmludCBtYWluKGludCBhcmdjLCBjaGFyICphcm"+ ,"d2W10peyBleGl0IDA7IH0KAQAAAAAAAAApAAAAAAAAAAEAAAAAA"+ ,"AAAKQAAAAAAAAAFAAAAAAAAAGVudHJ5AAAAAQAAAAAAAAAoAAAA"+ ,"AAAAAAQAAAAAAAAAbmFtZQAAAAAEAAAAAAAAAGhpLmMAAAAABAA"+ ,"AAAAAAABub2RlAAAAAAEAAAAAAAAAKAAAAAAAAAAEAAAAAAAAAH"+ ,"R5cGUAAAAABwAAAAAAAABzeW1saW5rAAYAAAAAAAAAdGFyZ2V0A"+ ,"AAHAAAAAAAAAGhlbGxvLmMAAQAAAAAAAAApAAAAAAAAAAEAAAAA"+ ,"AAAAKQAAAAAAAAABAAAAAAAAACkAAAAAAAAA"+ ]+++-- | Control testcase sizes (bytes) by env variable+getBigFileSize :: IO Int64+getBigFileSize = fromMaybe 1000000 . 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+++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 [NonExecutable, 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)]+ return (nm,f)