WIP

hnix-store-core/hnix-store-core.cabal

@@ -41,6 +41,7 @@ library
                      , regex-base
                      , regex-tdfa-text
                      , text
+                     , time
                      , unix
                      , unordered-containers
                      , vector

hnix-store-core/src/System/Nix/Hash.hs

@@ -14,6 +14,8 @@ module System.Nix.Hash (
     HNix.Digest
 
   , HNix.HashAlgorithm(..)
+  , HNix.NamedAlgorithm(..)
+  , HNix.NamedDigest(..)
   , HNix.HasDigest(..)
   , HNix.hash
   , HNix.hashLazy

hnix-store-core/src/System/Nix/Internal/Hash.hs

@@ -2,18 +2,22 @@
 Description : Cryptographic hashes for hnix-store.
 Maintainer  : Greg Hale <imalsogreg@gmail.com>
 -}
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE AllowAmbiguousTypes       #-}
+{-# LANGUAGE DataKinds                 #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE PolyKinds           #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE KindSignatures      #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE PolyKinds                 #-}
+{-# LANGUAGE RankNTypes                #-}
+{-# LANGUAGE TypeFamilies              #-}
+{-# LANGUAGE KindSignatures            #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+{-# LANGUAGE TypeApplications          #-}
+{-# LANGUAGE OverloadedStrings         #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE StandaloneDeriving        #-}
 
 module System.Nix.Internal.Hash where
 
+import Data.Text (Text)
 import qualified Crypto.Hash.MD5       as MD5
 import qualified Crypto.Hash.SHA1      as SHA1
 import qualified Crypto.Hash.SHA256    as SHA256
@@ -40,6 +44,17 @@ data HashAlgorithm
   | SHA256
   | Truncated Nat HashAlgorithm
 
+class NamedAlgorithm (a :: HashAlgorithm) where
+  algorithmName :: Text
+
+instance NamedAlgorithm 'MD5 where
+  algorithmName = "md5"
+
+instance NamedAlgorithm 'SHA1 where
+  algorithmName = "sha1"
+
+instance NamedAlgorithm 'SHA256 where
+  algorithmName = "sha256"
 
 -- | Types with kind @HashAlgorithm@ may be a @HasDigest@ instance
 --   if they are able to hash bytestrings via the init/update/finalize
@@ -114,6 +129,9 @@ newtype Digest (a :: HashAlgorithm) = Digest
     --   not some particular text encoding.
   } deriving (Show, Eq, Ord, DataHashable.Hashable)
 
+-- | A digest from a named hash algorithm.
+data NamedDigest =
+  forall a . NamedAlgorithm a => NamedDigest (Digest a)
 
 -- instance DataHashable.Hashable (Digest a) where
 --   hashWithSalt a (Digest bs) = DataHashable.hashWithSalt a bs

hnix-store-core/src/System/Nix/Path.hs

@@ -4,21 +4,14 @@ Maintainer  : Shea Levy <shea@shealevy.com>
 -}
 {-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module System.Nix.Path
-  ( FilePathPart(..)
-  , PathHashAlgo
-  , Path(..)
-  , PathSet
-  , SubstitutablePathInfo(..)
-  , ValidPathInfo(..)
-  , PathName(..)
-  , filePathPart
-  , pathName
-  , Roots
-  ) where
+{-# LANGUAGE KindSignatures             #-}
+{-# LANGUAGE ExistentialQuantification  #-}
+module System.Nix.Path where
 
-import           System.Nix.Hash           (Digest(..),
-                                            HashAlgorithm(Truncated, SHA256))
+import Data.Word
+import           GHC.TypeLits
+import           System.Nix.Hash
+import           Data.Time
 import qualified Data.ByteString           as BS
 import qualified Data.ByteString.Char8     as BSC
 import           Data.Hashable             (Hashable (..), hashPtrWithSalt)
@@ -32,8 +25,7 @@ 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
-
+type PathHashAlgo = 'Truncated 20 'SHA256
 
 -- | The name portion of a Nix path.
 --
@@ -55,67 +47,55 @@ pathName n = case matchTest nameRegex n of
   False -> Nothing
 
 -- | A path in a store.
-data Path = Path !(Digest PathHashAlgo) !PathName
+--
+-- @root@: The root path of the store (e.g. "/nix/store").
+data Path (root :: Symbol) = Path !(Digest PathHashAlgo) !PathName
   deriving (Eq, Ord, Show)
 
-type PathSet = HashSet Path
+type PathSet root = HashSet (Path root)
 
--- | 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
+-- | Metadata about a valid @Path@ in the store.
+data PathInfo store = PathInfo
   { -- | Path itself
-    path             :: !Path
+    path             :: !(Path store)
   , -- | 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
+    deriver        :: !(Maybe (Path store))
+  , -- | The hash of the serialization of this path.
+    narHash          :: !NamedDigest
+  , -- | The references of the 'Path'.
+    references     :: !(PathSet store)
+  , -- | When this store path was registered valid.
+    registrationTime :: !UTCTime
   , -- | The size of the uncompressed NAR serialization of this
     -- 'Path'.
-    narSizeVP        :: !Integer
+    narSizeVP        :: !Word64
   , -- | 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)
+  , -- | Signatures attesting to the validity of this registration.
+    sigs             :: ![Text] -- TODO better type?
+  , -- | Whether or not the store path is content-addressed, and if so
+    ca               :: !(Maybe ContentAddressedHash)
+  }
 
--- | 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
+-- | The different types of content-addressed hashing we have in Nix.
+data ContentAddressedHash
+  = RegularFile (Digest SHA256)
+    -- ^ A regular file hashed like sha256sum.
+  | forall algo . NamedAlgorithm algo =>
+      FixedFile (HashMode algo) (Digest algo)
+      -- ^ A file hashed via the add-fixed-file-to-store approach.
+      -- This can in fact overlap with RegularFile (if the 'HashMode'
+      -- is 'Flat @SHA256'), but the resulting Nix store hash is
+      -- different for stupid legacy reasons.
 
-type Roots = Map Path Path
+-- | A specification of how to hash a file.
+data HashMode (a :: HashAlgorithm)
+  = Flat -- ^ Normal hashing of a regular file.
+  | Recursive -- ^ Hashing of a serialization of a file, compatible
+              -- with directories and executable files as well as
+              -- regular files.
 
-instance Hashable Path where
+instance Hashable (Path store) where
   hashWithSalt s (Path hash name) = s `hashWithSalt` hash `hashWithSalt` name

hnix-store-core/src/System/Nix/Store.hs

@@ -2,65 +2,51 @@
 Description : Types and effects for interacting with the Nix store.
 Maintainer  : Shea Levy <shea@shealevy.com>
 -}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module System.Nix.Store
-  ( PathName, pathNameContents, pathName
-  , PathHashAlgo, Path(..)
-  , StoreEffects(..)
-  , SubstitutablePathInfo(..)
-  ) where
+module System.Nix.Store 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 Data.ByteString.Lazy (ByteString)
+import System.Nix.Hash (NamedAlgorithm, HashAlgorithm)
 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.
+-- @root@: The root path of the store (e.g. "/nix/store").
 --
 -- @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)
-    }
+data StoreEffects root m = StoreEffects
+  { regularFileToStore -- ^ Add a regular file to the store with the
+                       -- given references, hashed with 'SHA256'.
+      :: PathName -- ^ The name of the path.
+      -> ByteString -- ^ The contents of the file.
+      -> PathSet root -- ^ The references of the path.
+      -> m (Path root) -- ^ The added store path.
+  , fixedFileToStore -- ^ Add a fixed file (possibly not regular) to
+                     -- the store with the diven hash algorithm.
+      :: forall a . (NamedAlgorithm a)
+      => PathName -- ^ The name of the path.
+      -> HashMode a -- ^ How to hash the file.
+      -> Nar -- ^ A nix archive dump of the file.
+      -> m (Path root)
+  , importPath -- ^ Import a serialization of a valid path into the
+               -- store.
+      :: PathInfo root -- ^ Store path metadata.
+      -> Nar -- ^ A nix archive dump of file.
+      -> Repair -- ^ Whether to overwrite the path if it is already
+                -- valid in the store.
+      -> CheckSigs -- ^ Whether to validate the signatures on the
+                   -- archive. Ignored if not a trusted user.
+      -> m ()
+  }
+
+
+-- | Flag to indicate whether a command should overwrite a specified
+-- path if it already exists (in an attempt to fix issues).
+data Repair = Repair | DontRepair
+
+-- | Flag to indicate whether signatures should be validated on an
+-- imported archive.
+data CheckSigs = CheckSigs | DontCheckSigs