Skip to content

Commit 2ba0a4b

Browse files
imalsogregimalsogreg
committed
Add provisional NAR parser and generator
1 parent 972e2c7 commit 2ba0a4b

File tree

4 files changed

+267
-50
lines changed

4 files changed

+267
-50
lines changed

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

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,10 +17,13 @@ extra-source-files: ChangeLog.md, README.md
1717
cabal-version: >=1.10
1818

1919
library
20-
exposed-modules: Crypto.Hash.Truncated, System.Nix.Store
20+
exposed-modules: Crypto.Hash.Truncated
21+
, System.Nix.Nar
22+
, System.Nix.Store
2123
build-depends: base >=4.10 && <4.11,
2224
-- Drop foundation when we can drop cryptonite <0.25
23-
cryptonite, memory, foundation, basement,
25+
binary,
26+
bytestring, containers, cryptonite, memory, foundation, basement,
2427
text, regex-base, regex-tdfa-text,
2528
hashable, unordered-containers
2629
hs-source-dirs: src

‎hnix-store-core/src/System/Nix/Nar.hs‎

Lines changed: 181 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,181 @@
1+
{-# LANGUAGE KindSignatures #-}
2+
{-# LANGUAGE ScopedTypeVariables #-}
3+
{-# LANGUAGE TupleSections #-}
4+
{-# LANGUAGE TypeApplications #-}
5+
{-# LANGUAGE OverloadedStrings #-}
6+
7+
{-|
8+
Description : Allowed effects for interacting with Nar files.
9+
Maintainer : Shea Levy <[email protected]>
10+
|-}
11+
module System.Nix.Nar where
12+
13+
import Control.Monad (replicateM, replicateM_)
14+
import Data.Monoid ((<>))
15+
import Control.Applicative
16+
import qualified Data.ByteString.Lazy.Char8 as BSL
17+
import qualified Data.Set as Set
18+
import qualified Data.Binary as B
19+
import qualified Data.Text as T
20+
import qualified Data.Text.Encoding as E
21+
import qualified Data.Binary.Put as B
22+
import qualified Data.Binary.Get as B
23+
import Debug.Trace
24+
25+
import System.Nix.Path
26+
27+
28+
data NarEffects (m :: * -> *) = NarEffets {
29+
readFile :: FilePath -> m BSL.ByteString
30+
, listDir :: FilePath -> m [FileSystemObject]
31+
, narFromFileBytes :: BSL.ByteString -> m Nar
32+
, narFromDirectory :: FilePath -> m Nar
33+
}
34+
35+
36+
-- Directly taken from Eelco thesis
37+
-- https://nixos.org/%7Eeelco/pubs/phd-thesis.pdf
38+
39+
-- TODO: Should we use rootedPath, validPath rather than FilePath?
40+
data Nar = Nar { narFile :: FileSystemObject }
41+
deriving (Eq, Ord, Show)
42+
43+
data FileSystemObject =
44+
Regular IsExecutable BSL.ByteString
45+
| Directory (Set.Set (PathName, FileSystemObject))
46+
| SymLink BSL.ByteString
47+
deriving (Eq, Show)
48+
49+
-- TODO - is this right? How does thesis define ordering of FSOs?
50+
instance Ord FileSystemObject where
51+
compare (Regular _ c1) (Regular _ c2) = compare c1 c2
52+
compare (Regular _ _) _ = GT
53+
compare (Directory s1) (Directory s2) = compare s1 s2
54+
compare (Directory _) _ = GT
55+
compare (SymLink l1) (SymLink l2) = compare l1 l2
56+
57+
data IsExecutable = NonExecutable | Executable
58+
deriving (Eq, Show)
59+
60+
-- data NarFile = NarFile
61+
-- { narFileIsExecutable :: IsExecutable
62+
-- , narFilePath :: FilePath -- TODO: Correct type?
63+
-- } deriving (Show)
64+
65+
data DebugPut = PutAscii | PutBinary
66+
67+
putNar :: Nar -> B.Put
68+
putNar = putNar' PutBinary
69+
70+
putNar' :: DebugPut -> Nar -> B.Put
71+
putNar' dbg (Nar file) = header <>
72+
parens (putFile file)
73+
where
74+
75+
str' = case dbg of
76+
PutAscii -> strDebug
77+
PutBinary -> str
78+
79+
header = str' "nix-archive-1"
80+
parens m = str' "(" <> m <> str ")"
81+
82+
putFile (Regular isExec contents) =
83+
str' "type" <> str' "regular"
84+
<> if isExec == Executable
85+
then str' "executable" <> str' ""
86+
else str' ""
87+
<> str' "contents" <> str' contents
88+
89+
putFile (SymLink target) =
90+
str' "type" <> str' "symlink" <> str' "target" <> str' target
91+
92+
putFile (Directory entries) =
93+
str' "type" <> str' "directory"
94+
<> foldMap putEntry entries
95+
96+
putEntry (PathName name, fso) =
97+
str' "entry" <>
98+
parens (str' "name" <>
99+
str' (BSL.fromStrict $ E.encodeUtf8 name) <>
100+
str' "node" <>
101+
putFile fso)
102+
103+
getNar :: B.Get Nar
104+
getNar = fmap Nar $ header >> parens getFile
105+
where header = trace "header " $ assertStr "nix-archive-1"
106+
107+
padLen n = let r = n `mod` 8
108+
p = (8 - n) `mod` 8
109+
in trace ("padLen: " ++ show p) p
110+
111+
str = do
112+
n <- fmap fromIntegral B.getInt64le
113+
s <- B.getLazyByteString n
114+
p <- B.getByteString (padLen $ fromIntegral n)
115+
traceShow (n,s) $ return s
116+
117+
assertStr s = trace ("Assert " ++ show s) $ do
118+
s' <- str
119+
if s == s'
120+
then trace ("Assert " ++ show s ++ " passed") (return s)
121+
else trace ("Assert " ++ show s ++ " failed") (fail "No")
122+
123+
parens m = assertStr "(" *> m <* assertStr ")"
124+
125+
getFile :: B.Get FileSystemObject
126+
getFile = trace "getFile" (getRegularFile)
127+
<|> trace "getDir" (getDirectory)
128+
<|> trace "getLink" (getSymLink)
129+
130+
getRegularFile = trace "regular" $ do
131+
trace "TESTING" (assertStr "type")
132+
trace "HI" $ assertStr "regular"
133+
trace "HI AGOIN" $ assertStr "contents"
134+
contents <- str
135+
return $ Regular (maybe NonExecutable
136+
(const Executable) Nothing) contents
137+
138+
getDirectory = do
139+
assertStr "type"
140+
assertStr "directory"
141+
fs <- many getEntry
142+
return $ Directory (Set.fromList fs)
143+
144+
getSymLink = do
145+
assertStr "type"
146+
assertStr "symlink"
147+
assertStr "target"
148+
fmap SymLink str
149+
150+
getEntry = do
151+
assertStr "entry"
152+
parens $ do
153+
assertStr "name"
154+
mname <- pathName . E.decodeUtf8 . BSL.toStrict <$> str
155+
assertStr "node"
156+
file <- parens getFile
157+
maybe (fail "Bad PathName") (return . (,file)) mname
158+
159+
str :: BSL.ByteString -> B.Put
160+
str t = let len = BSL.length t
161+
in int len <> pad t
162+
163+
int :: Integral a => a -> B.Put
164+
int n = B.putInt64le $ fromIntegral n
165+
166+
pad :: BSL.ByteString -> B.Put
167+
pad bs =
168+
let padLen = BSL.length bs `div` 8
169+
in B.put bs >> B.put (BSL.replicate padLen '\NUL')
170+
171+
strDebug :: BSL.ByteString -> B.Put
172+
strDebug t = let len = BSL.length t
173+
in intDebug len <> padDebug t
174+
175+
intDebug :: Integral a => a -> B.Put
176+
intDebug a = B.put (show @Int (fromIntegral a))
177+
178+
padDebug :: BSL.ByteString -> B.Put
179+
padDebug bs =
180+
let padLen = BSL.length bs `div` 8
181+
in B.put bs >> B.put (BSL.replicate padLen '_')

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

Lines changed: 76 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,76 @@
1+
{-|
2+
Description : Types and effects for interacting with the Nix store.
3+
Maintainer : Shea Levy <[email protected]>
4+
-}
5+
{-# LANGUAGE DataKinds #-}
6+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7+
module System.Nix.Path
8+
( PathHashAlgo
9+
, Path(..)
10+
, SubstitutablePathInfo(..)
11+
, PathName(..)
12+
, pathName
13+
) where
14+
15+
import Crypto.Hash (Digest)
16+
import Crypto.Hash.Truncated (Truncated)
17+
import Crypto.Hash.Algorithms (SHA256)
18+
import qualified Data.ByteArray as B
19+
import Data.Text (Text)
20+
import Text.Regex.Base.RegexLike (makeRegex, matchTest)
21+
import Text.Regex.TDFA.Text (Regex)
22+
import Data.Hashable (Hashable(..), hashPtrWithSalt)
23+
import Data.HashSet (HashSet)
24+
import Data.HashMap.Strict (HashMap)
25+
import System.IO.Unsafe (unsafeDupablePerformIO)
26+
27+
-- | The name portion of a Nix path.
28+
--
29+
-- Must be composed of a-z, A-Z, 0-9, +, -, ., _, ?, and =, can't
30+
-- start with a ., and must have at least one character.
31+
newtype PathName = PathName
32+
{ pathNameContents :: Text -- ^ The contents of the path name
33+
} deriving (Eq, Ord, Show, Hashable)
34+
35+
-- | A regular expression for matching a valid 'PathName'
36+
nameRegex :: Regex
37+
nameRegex =
38+
makeRegex "[a-zA-Z0-9\\+\\-\\_\\?\\=][a-zA-Z0-9\\+\\-\\.\\_\\?\\=]*"
39+
40+
-- | Construct a 'PathName', assuming the provided contents are valid.
41+
pathName :: Text -> Maybe PathName
42+
pathName n = case matchTest nameRegex n of
43+
True -> Just $ PathName n
44+
False -> Nothing
45+
46+
-- | The hash algorithm used for store path hashes.
47+
type PathHashAlgo = Truncated SHA256 20
48+
49+
-- | A path in a store.
50+
data Path = Path !(Digest PathHashAlgo) !PathName
51+
52+
-- | Wrapper to defined a 'Hashable' instance for 'Digest'.
53+
newtype HashableDigest a = HashableDigest (Digest a)
54+
55+
instance Hashable (HashableDigest a) where
56+
hashWithSalt s (HashableDigest d) = unsafeDupablePerformIO $
57+
B.withByteArray d $ \ptr -> hashPtrWithSalt ptr (B.length d) s
58+
59+
instance Hashable Path where
60+
hashWithSalt s (Path digest name) =
61+
s `hashWithSalt`
62+
(HashableDigest digest) `hashWithSalt` name
63+
64+
65+
-- | Information about substitutes for a 'Path'.
66+
data SubstitutablePathInfo = SubstitutablePathInfo
67+
{ -- | The .drv which led to this 'Path'.
68+
deriver :: !(Maybe Path)
69+
, -- | The references of the 'Path'
70+
references :: !(HashSet Path)
71+
, -- | The (likely compressed) size of the download of this 'Path'.
72+
downloadSize :: !Integer
73+
, -- | The size of the uncompressed NAR serialization of this
74+
-- 'Path'.
75+
narSize :: !Integer
76+
}

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

Lines changed: 5 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE PackageImports #-}
2+
13
{-|
24
Description : Types and effects for interacting with the Nix store.
35
Maintainer : Shea Levy <[email protected]>
@@ -23,55 +25,9 @@ import Data.HashSet (HashSet)
2325
import Data.HashMap.Strict (HashMap)
2426
import System.IO.Unsafe (unsafeDupablePerformIO)
2527

26-
-- | The name portion of a Nix path.
27-
--
28-
-- Must be composed of a-z, A-Z, 0-9, +, -, ., _, ?, and =, can't
29-
-- start with a ., and must have at least one character.
30-
newtype PathName = PathName
31-
{ pathNameContents :: Text -- ^ The contents of the path name
32-
} deriving (Hashable)
33-
34-
-- | A regular expression for matching a valid 'PathName'
35-
nameRegex :: Regex
36-
nameRegex =
37-
makeRegex "[a-zA-Z0-9\\+\\-\\_\\?\\=][a-zA-Z0-9\\+\\-\\.\\_\\?\\=]*"
38-
39-
-- | Construct a 'PathName', assuming the provided contents are valid.
40-
pathName :: Text -> Maybe PathName
41-
pathName n = case matchTest nameRegex n of
42-
True -> Just $ PathName n
43-
False -> Nothing
44-
45-
-- | The hash algorithm used for store path hashes.
46-
type PathHashAlgo = Truncated SHA256 20
47-
48-
-- | A path in a store.
49-
data Path = Path !(Digest PathHashAlgo) !PathName
50-
51-
-- | Wrapper to defined a 'Hashable' instance for 'Digest'.
52-
newtype HashableDigest a = HashableDigest (Digest a)
53-
54-
instance Hashable (HashableDigest a) where
55-
hashWithSalt s (HashableDigest d) = unsafeDupablePerformIO $
56-
B.withByteArray d $ \ptr -> hashPtrWithSalt ptr (B.length d) s
57-
58-
instance Hashable Path where
59-
hashWithSalt s (Path digest name) =
60-
s `hashWithSalt`
61-
(HashableDigest digest) `hashWithSalt` name
28+
import System.Nix.Path
29+
import System.Nix.Nar
6230

63-
-- | Information about substitutes for a 'Path'.
64-
data SubstitutablePathInfo = SubstitutablePathInfo
65-
{ -- | The .drv which led to this 'Path'.
66-
deriver :: !(Maybe Path)
67-
, -- | The references of the 'Path'
68-
references :: !(HashSet Path)
69-
, -- | The (likely compressed) size of the download of this 'Path'.
70-
downloadSize :: !Integer
71-
, -- | The size of the uncompressed NAR serialization of this
72-
-- 'Path'.
73-
narSize :: !Integer
74-
}
7531

7632
-- | Interactions with the Nix store.
7733
--
@@ -109,4 +65,5 @@ data StoreEffects rootedPath validPath m =
10965
derivationOutputNames :: !(validPath -> m (HashSet Text))
11066
, -- | Get a full 'Path' corresponding to a given 'Digest'.
11167
pathFromHashPart :: !(Digest PathHashAlgo -> m Path)
68+
, narEffects :: NarEffects m
11269
}

0 commit comments

Comments
 (0)