Skip to content

Commit 1fe1237

Browse files
committed
add Path hashing / parsing and tests
1 parent b608733 commit 1fe1237

File tree

4 files changed

+202
-2
lines changed

4 files changed

+202
-2
lines changed

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ library
2525
, System.Nix.Nar
2626
, System.Nix.Path
2727
, System.Nix.ReadonlyStore
28+
, System.Nix.Internal.Path
2829
, System.Nix.Store
2930
, System.Nix.Util
3031
, System.Nix.ValidPath
@@ -64,6 +65,7 @@ test-suite format-tests
6465
other-modules:
6566
NarFormat
6667
Hash
68+
Path
6769
hs-source-dirs:
6870
tests
6971
build-depends:
Lines changed: 150 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,150 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE TypeApplications #-}
4+
5+
{-|
6+
Description : Internal path utilities
7+
Maintainer : srk <[email protected]>
8+
|-}
9+
module System.Nix.Internal.Path where
10+
11+
import Control.Monad
12+
import qualified Data.ByteString.Lazy as BSL
13+
import qualified Data.ByteString.Char8 as BSC
14+
import Data.Text (Text)
15+
import qualified Data.Text as T
16+
import System.FilePath.Posix (takeBaseName, takeDirectory)
17+
import System.Nix.Path (Path(..), PathName(..), pathName, PathHashAlgo)
18+
import System.Nix.Internal.Hash (Digest(..), HashAlgorithm'( SHA256 ))
19+
import System.Nix.Hash (HasDigest, printAsBase16, printAsBase32, printHashAlgo)
20+
import qualified System.Nix.Hash
21+
22+
-- | Parse store location
23+
parseStore :: BSL.ByteString -> T.Text
24+
parseStore = T.pack . takeDirectory . BSC.unpack . BSL.toStrict
25+
26+
-- | Parse path from string
27+
--
28+
-- in form <storeDir>/<hash>-<pathName>
29+
-- into (Just (Path <hash> (PathName <pathName>)))
30+
-- or Nothing on error
31+
--
32+
-- XXX: should check for @PathHashAlgo length
33+
parsePath :: BSL.ByteString -> Maybe Path
34+
parsePath p = case name of
35+
Nothing -> Nothing
36+
Just n -> Just $ Path digest n
37+
where
38+
base = T.pack . takeBaseName . BSC.unpack . BSL.toStrict $ p
39+
parts = T.breakOn "-" base
40+
digest = Digest . BSC.pack . T.unpack . fst $ parts
41+
name = pathName . T.drop 1 . snd $ parts
42+
43+
44+
-- experimental
45+
-- Directory of the store
46+
type StoreDir = Text
47+
type Stored a = (StoreDir, a)
48+
49+
-- wrap StoreDir and Path into tuple
50+
makeStored :: StoreDir -> Path -> Stored Path
51+
makeStored sl p = (sl, p)
52+
53+
type PathType = Text
54+
-- "text:<r1>:<r2>:...<rN>"
55+
-- "source"
56+
-- "output:<id>"
57+
-- <id> is the name of the output (usually, "out").
58+
59+
-- store settings
60+
data Settings = Settings {
61+
storeDir :: StoreDir -- settings.nixStore
62+
} deriving (Eq, Show)
63+
64+
-- build a store path in the following form:
65+
-- <storeDir>/<hash>-<pathName>
66+
storedToText :: Stored Path -> Text
67+
storedToText (storeLoc, (Path digest pName)) = T.concat
68+
[ storeLoc
69+
, "/"
70+
, printAsBase32 @PathHashAlgo digest
71+
, "-"
72+
, pathNameContents pName
73+
]
74+
75+
makeStorePath :: (HasDigest a) => PathType -> PathName -> Digest a -> Settings -> Text
76+
makeStorePath typ pName digest settings = T.concat
77+
[ storeDir settings
78+
, "/"
79+
, printAsBase32 @PathHashAlgo $ pathHash typ pName digest (storeDir settings)
80+
, "-"
81+
, pathNameContents pName
82+
]
83+
84+
makeStorePath' :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Path
85+
makeStorePath' typ pName digest storeLoc = snd $ makeStoredPath typ pName digest storeLoc
86+
87+
-- | build Stored Path from the type of the path, path name and a digest stored at StoreDir
88+
-- As StoreDir is part of the path hashing process we need to take it into account
89+
-- when building Path(s)
90+
makeStoredPath :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Stored Path
91+
makeStoredPath typ pName digest storeLoc = makeStored storeLoc $ Path (pathHash typ pName digest storeLoc) pName
92+
93+
-- build <h> string which is a truncated base32 formatted SHA256 hash of <s>
94+
pathHash :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Digest PathHashAlgo
95+
pathHash typ pName digest storeLoc = System.Nix.Hash.hash . BSC.pack . T.unpack $
96+
makePathDigestString typ pName digest storeLoc
97+
98+
-- build <s> string which is hashed and used in makeStorePath
99+
-- <s> = "<pathType>:<hash_algo>:<base16_hash>:<storeDir>:<pathName>"
100+
-- (exposed for testing purposes only)
101+
makePathDigestString :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Text
102+
makePathDigestString typ pName digest storeLoc = T.intercalate (T.pack ":")
103+
[ typ
104+
, printHashAlgo digest
105+
, printAsBase16 digest
106+
, storeLoc
107+
, pathNameContents pName
108+
]
109+
110+
-- make output path from `PathName` digest and outputId which typically is "out"
111+
makeOutputPath :: (HasDigest a) => PathName -> Digest a -> T.Text -> Settings -> Text
112+
makeOutputPath pName digest outputId settings =
113+
makeStorePath typ (adjustName pName) digest settings
114+
where
115+
typ = T.concat [ "output:", outputId ]
116+
adjustName n | outputId == "out" = n
117+
adjustName (PathName name) | otherwise = PathName $ T.concat [ name, T.pack "-", outputId ]
118+
119+
type Recursive = Bool
120+
-- make fixed output path from `PathName` and Recursive option
121+
makeFixedOutputPath :: (HasDigest a) => PathName -> Digest a -> Recursive -> Settings -> Text
122+
makeFixedOutputPath pName digest True settings = -- XXX: this needs be restricted to @a == @SHA256
123+
makeStorePath ("source") pName digest settings
124+
makeFixedOutputPath pName digest recursive settings =
125+
makeStorePath ("output:out") pName digest' settings
126+
where
127+
rec True = "r:"
128+
rec False = T.empty
129+
digest' = System.Nix.Hash.hash @SHA256 $ BSC.pack . T.unpack . T.concat $
130+
[ "fixed:out:"
131+
, rec recursive
132+
, printHashAlgo digest
133+
, printAsBase16 digest
134+
, ":"
135+
]
136+
137+
-- references should be PathSet not [T.Text]
138+
-- but how to turn PathSet into store paths (texts) again
139+
-- when we don't have PathType
140+
type References = [T.Text]
141+
142+
makeTextPath :: (HasDigest a) => PathName -> Digest a -> References-> Settings -> Text
143+
makeTextPath pName digest references settings =
144+
makeStorePath typ pName digest settings
145+
where typ = T.concat $ [ "text" ] ++ (map (T.cons ':') references)
146+
147+
storePathForText :: PathName -> T.Text -> References -> Settings -> Text
148+
storePathForText pName contents references settings =
149+
makeTextPath pName hashOfContents references settings
150+
where hashOfContents = System.Nix.Hash.hash @SHA256 (BSC.pack . T.unpack $ contents)

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

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,7 @@ module System.Nix.ValidPath
88
( ValidPath(..)
99
) where
1010

11-
import System.Nix.Hash (Digest(..),
12-
HashAlgorithm(Truncated, SHA256))
11+
import System.Nix.Hash (Digest(..))
1312
import System.Nix.Path (Path(..), PathSet)
1413
import qualified Data.ByteString as BS
1514
import qualified Data.ByteString.Char8 as BSC

hnix-store-core/tests/Path.hs

Lines changed: 49 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,49 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE ScopedTypeVariables #-}
4+
{-# LANGUAGE TypeApplications #-}
5+
6+
module Path where
7+
8+
import Control.Monad.IO.Class (liftIO)
9+
import Control.Exception (bracket)
10+
import qualified Data.ByteString as BS
11+
import qualified Data.ByteString.Base64.Lazy as B64
12+
import qualified Data.ByteString.Lazy as BSL
13+
import Data.Monoid ((<>))
14+
import qualified Data.Text as T
15+
import System.Directory (removeFile)
16+
import System.IO.Temp (withSystemTempFile, writeSystemTempFile)
17+
import qualified System.IO as IO -- (hGetContents, hPutStr, openFile)
18+
import qualified System.Process as P
19+
import Test.Tasty as T
20+
import Test.Tasty.Hspec
21+
import qualified Test.Tasty.HUnit as HU
22+
import Test.Tasty.QuickCheck
23+
import Text.Read (readMaybe)
24+
25+
import System.Nix.Hash
26+
import System.Nix.Path
27+
import System.Nix.Internal.Hash
28+
import System.Nix.Internal.Path
29+
import NarFormat -- TODO: Move the fixtures into a common module
30+
31+
spec_path :: Spec
32+
spec_path = do
33+
34+
describe "path operations" $ do
35+
36+
it "makeStorePath hashes correctly" $
37+
makeStorePath "text" (PathName "lal") (hash @MD5 "Hello World") (Settings "/nix/store") `shouldBe` "/nix/store/vsfi9phi6a2hvvvihyh48jn8xh9ld5ax-lal"
38+
39+
it "store path for text matches real world test scenario" $
40+
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"
41+
42+
it "parses valid path" $
43+
parsePath "/nix/store/vsfi9phi6a2hvvvihyh48jn8xh9ld5ax-lal" `shouldBe` (Just (Path (Digest "vsfi9phi6a2hvvvihyh48jn8xh9ld5ax") (PathName "lal")))
44+
45+
it "fails on invalid name" $
46+
parsePath "/st/hash-$%^^#" `shouldBe` Nothing
47+
48+
it "parses store" $
49+
parseStore "/nix/store/vsfi9phi6a2hvvvihyh48jn8xh9ld5ax-lal" `shouldBe` "/nix/store"

0 commit comments

Comments
 (0)