Bit too late

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

@@ -18,6 +18,7 @@ cabal-version:       >=1.10
 
 library
   exposed-modules:     System.Nix.Base32
+                     , System.Nix.Build
                      , System.Nix.Hash
                      , System.Nix.Internal.Hash
                      , System.Nix.Internal.Signature
@@ -28,6 +29,7 @@ library
                      , System.Nix.StorePath
                      , System.Nix.StorePathMetadata
                      , System.Nix.Util
+                     , System.Nix.ValidPath
   build-depends:       base >=4.10 && <5
                      , base16-bytestring
                      , bytestring

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

@@ -0,0 +1,55 @@
+{-# LANGUAGE RecordWildCards #-}
+{-|
+Description : Build related types
+Maintainer  : srk <[email protected]>
+|-}
+module System.Nix.Build (
+    BuildMode(..)
+  , BuildStatus(..)
+  , BuildResult(..)
+  , buildSuccess
+  ) where
+
+import           Data.Time                 (UTCTime)
+import           Data.Text                 (Text)
+import           Data.HashSet              (HashSet)
+
+-- 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 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
+    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
+  } deriving (Eq, Ord, Show)
+
+buildSuccess BuildResult{..} = status == Built || status == Substituted || status == AlreadyValid

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

@@ -10,7 +10,6 @@ module System.Nix.Hash (
   , HNix.SomeNamedDigest(..)
   , HNix.hash
   , HNix.hashLazy
-
   , HNix.encodeBase32
   , HNix.encodeBase16
   ) where

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

@@ -95,6 +95,16 @@ hashLazy :: forall a.ValidAlgo a => BSL.ByteString -> Digest a
 hashLazy bsl =
   finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl)
 
+-- | Hash file
+hashFile :: forall a.ValidAlgo a => FilePath -> IO (Digest a)
+hashFile fp = hashLazy <$> BSL.readFile fp
+
+digestText32 :: forall a. (NamedAlgo a, ValidAlgo a) => Digest a -> T.Text
+digestText32 d = algoName @a <> ":" <> encodeBase32 d
+
+digestText16 :: forall a. NamedAlgo a => Digest a -> T.Text
+digestText16 d = algoName @a <> ":" <> encodeBase16 d
+
 -- | Encode a 'Digest' in the special Nix base-32 encoding.
 encodeBase32 :: Digest a -> T.Text
 encodeBase32 (Digest bs) = Base32.encode bs

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

@@ -0,0 +1,150 @@
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE TypeApplications           #-}
+
+{-|
+Description : Internal path utilities
+Maintainer  : srk <[email protected]>
+|-}
+module System.Nix.Internal.Path where
+
+import           Control.Monad
+import qualified Data.ByteString.Lazy      as BSL
+import qualified Data.ByteString.Char8     as BSC
+import           Data.Text                 (Text)
+import qualified Data.Text                 as T
+import           System.FilePath.Posix     (takeBaseName, takeDirectory)
+import           System.Nix.Path           (Path(..), PathName(..), pathName, PathHashAlgo)
+import           System.Nix.Internal.Hash  (Digest(..),  HashAlgorithm'( SHA256 ))
+import           System.Nix.Hash           (HasDigest, printAsBase16, printAsBase32, printHashAlgo)
+import qualified System.Nix.Hash
+
+-- | Parse store location
+parseStore :: BSL.ByteString -> T.Text
+parseStore = T.pack . takeDirectory . BSC.unpack . BSL.toStrict
+
+-- | Parse path from string
+--
+-- in form <storeDir>/<hash>-<pathName>
+-- into (Just (Path <hash> (PathName <pathName>)))
+-- or Nothing on error
+--
+-- XXX: should check for @PathHashAlgo length
+parsePath :: BSL.ByteString -> Maybe Path
+parsePath p = case name of
+    Nothing -> Nothing
+    Just n -> Just $ Path digest n
+  where
+  base = T.pack . takeBaseName . BSC.unpack . BSL.toStrict $ p
+  parts = T.breakOn "-" base
+  digest = Digest . BSC.pack . T.unpack . fst $ parts
+  name = pathName . T.drop 1 . snd $ parts
+
+
+-- experimental
+-- Directory of the store
+type StoreDir = Text
+type Stored a = (StoreDir, a)
+
+-- wrap StoreDir and Path into tuple
+makeStored :: StoreDir -> Path -> Stored Path
+makeStored sl p = (sl, p)
+
+type PathType = Text
+-- "text:<r1>:<r2>:...<rN>"
+-- "source"
+-- "output:<id>"
+--    <id> is the name of the output (usually, "out").
+
+-- store settings
+data Settings = Settings {
+  storeDir :: StoreDir -- settings.nixStore
+  } deriving (Eq, Show)
+
+-- build a store path in the following form:
+-- <storeDir>/<hash>-<pathName>
+storedToText :: Stored Path -> Text
+storedToText (storeLoc, (Path digest pName)) = T.concat
+  [ storeLoc
+  , "/"
+  , printAsBase32 @PathHashAlgo digest
+  , "-"
+  , pathNameContents pName
+  ]
+
+makeStorePath :: (HasDigest a) => PathType -> PathName -> Digest a -> Settings -> Text
+makeStorePath typ pName digest settings = T.concat
+  [ storeDir settings
+  , "/"
+  , printAsBase32 @PathHashAlgo $ pathHash typ pName digest (storeDir settings)
+  , "-"
+  , pathNameContents pName
+  ]
+
+makeStorePath' :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Path
+makeStorePath' typ pName digest storeLoc = snd $ makeStoredPath typ pName digest storeLoc
+
+-- | build Stored Path from the type of the path, path name and a digest stored at StoreDir
+-- As StoreDir is part of the path hashing process we need to take it into account
+-- when building Path(s)
+makeStoredPath :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Stored Path
+makeStoredPath typ pName digest storeLoc = makeStored storeLoc $ Path (pathHash typ pName digest storeLoc) pName
+
+-- build <h> string which is a truncated base32 formatted SHA256 hash of <s>
+pathHash :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Digest PathHashAlgo
+pathHash typ pName digest storeLoc = System.Nix.Hash.hash . BSC.pack . T.unpack $
+  makePathDigestString typ pName digest storeLoc
+
+-- build <s> string which is hashed and used in makeStorePath
+-- <s> = "<pathType>:<hash_algo>:<base16_hash>:<storeDir>:<pathName>"
+-- (exposed for testing purposes only)
+makePathDigestString ::  (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Text
+makePathDigestString typ pName digest storeLoc = T.intercalate (T.pack ":")
+  [ typ
+  , printHashAlgo digest
+  , printAsBase16 digest
+  , storeLoc
+  , pathNameContents pName
+  ]
+
+-- make output path from `PathName` digest and outputId which typically is "out"
+makeOutputPath :: (HasDigest a) => PathName -> Digest a -> T.Text -> Settings -> Text
+makeOutputPath pName digest outputId settings =
+  makeStorePath typ (adjustName pName) digest settings
+  where
+    typ = T.concat [ "output:", outputId ]
+    adjustName n | outputId == "out" = n
+    adjustName (PathName name) | otherwise = PathName $ T.concat [ name, T.pack "-", outputId ]
+
+type Recursive = Bool
+-- make fixed output path from `PathName` and Recursive option
+makeFixedOutputPath :: (HasDigest a) => PathName -> Digest a -> Recursive -> Settings -> Text
+makeFixedOutputPath pName digest True      settings =  -- XXX: this needs be restricted to @a == @SHA256
+  makeStorePath ("source") pName digest settings
+makeFixedOutputPath pName digest recursive settings =
+  makeStorePath ("output:out") pName digest' settings
+  where
+    rec True = "r:"
+    rec False = T.empty
+    digest' = System.Nix.Hash.hash @SHA256 $ BSC.pack . T.unpack . T.concat $
+      [ "fixed:out:"
+      , rec recursive
+      , printHashAlgo digest
+      , printAsBase16 digest
+      , ":"
+      ]
+
+-- references should be PathSet not [T.Text]
+-- but how to turn PathSet into store paths (texts) again
+-- when we don't have PathType
+type References = [T.Text]
+
+makeTextPath :: (HasDigest a) => PathName -> Digest a -> References-> Settings -> Text
+makeTextPath pName digest references settings =
+  makeStorePath typ pName digest settings
+  where typ = T.concat $ [ "text" ] ++ (map (T.cons ':') references)
+
+storePathForText :: PathName -> T.Text -> References -> Settings -> Text
+storePathForText pName contents references settings =
+  makeTextPath pName hashOfContents references settings
+  where hashOfContents = System.Nix.Hash.hash @SHA256 (BSC.pack . T.unpack $ contents)

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

@@ -0,0 +1,55 @@
+{-|
+Description : Types and effects for interacting with the Nix store.
+Maintainer  : Shea Levy <[email protected]>
+-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module System.Nix.ValidPath
+  ( ValidPath(..)
+  ) where
+
+import           System.Nix.Hash           (Digest(..))
+import           System.Nix.StorePath      (StorePath(..), StorePathSet, KnownStoreDir)
+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.Text                 (Text)
+import           Data.Time                 (UTCTime)
+import qualified Data.Text                 as T
+import           System.IO.Unsafe          (unsafeDupablePerformIO)
+import           Text.Regex.Base.RegexLike (makeRegex, matchTest)
+import           Text.Regex.TDFA.Text      (Regex)
+
+-- | Information about @Path@
+data (KnownStoreDir a) => ValidPath a = ValidPath
+  { -- | Path itself
+    path             :: !(StorePath a)
+  , -- | The .drv which led to this 'Path'.
+    deriver          :: !(Maybe (StorePath a))
+  , -- | NAR hash
+    narHash          :: !Text
+  , -- | The references of the 'Path'
+    references       :: !(StorePathSet a)
+  , -- | Registration time
+    registrationTime :: !UTCTime
+  , -- | The size of the uncompressed NAR serialization of this
+    -- 'Path'.
+    narSize          :: !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)

hnix-store-core/tests/Hash.hs

@@ -34,7 +34,9 @@ spec_hash = 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 (base16 . md5) of \"Hello World\" the same as the thesis" $
+      shouldBe (encodeBase16 (hash @MD5 "Hello World"))
+               "b10a8db164e0754105b7a99be72e3fe5"
     it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $
       shouldBe (encodeBase32 (hash @SHA1 "Hello World"))
                "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a"

hnix-store-core/tests/Path.hs

@@ -0,0 +1,50 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+
+module Path 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.Internal.Hash
+import           NarFormat -- TODO: Move the fixtures into a common module
+
+spec_path :: Spec
+spec_path = do
+  return ()
+
+{-
+  describe "path operations" $ do
+
+    it "makeStorePath hashes correctly" $
+      makeStorePath "text" (PathName "lal") (hash @MD5 "Hello World") (Settings "/nix/store") `shouldBe` "/nix/store/vsfi9phi6a2hvvvihyh48jn8xh9ld5ax-lal"
+
+    it "store path for text matches real world test scenario" $
+      storePathForText (PathName "lal") ("Hello World") [] (Settings "/run/user/1000/test-nix-store-a256230bc88fe520/store") `shouldBe` "/run/user/1000/test-nix-store-a256230bc88fe520/store/3v0g8si7h0as1nqdanymv2zh2gagbl4f-lal"
+
+    it "parses valid path" $
+      parsePath "/nix/store/vsfi9phi6a2hvvvihyh48jn8xh9ld5ax-lal" `shouldBe` (Just (Path (Digest "vsfi9phi6a2hvvvihyh48jn8xh9ld5ax") (PathName "lal")))
+
+    it "fails on invalid name" $
+      parsePath "/st/hash-$%^^#" `shouldBe` Nothing
+
+    it "parses store" $
+      parseStore "/nix/store/vsfi9phi6a2hvvvihyh48jn8xh9ld5ax-lal" `shouldBe` "/nix/store"
+-}