mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-08-17 13:51:21 +03:00
WIP Merge branch 'master' into cleanup-store-record
This commit is contained in:
commit
02c253702d
@ -24,9 +24,11 @@ library
|
||||
, System.Nix.Internal.Hash
|
||||
, System.Nix.Nar
|
||||
, System.Nix.Path
|
||||
, System.Nix.ReadonlyStore
|
||||
, System.Nix.Store
|
||||
, System.Nix.Util
|
||||
build-depends: base >=4.10
|
||||
, base16-bytestring
|
||||
, bytestring
|
||||
, binary
|
||||
, bytestring
|
||||
@ -62,7 +64,7 @@ test-suite format-tests
|
||||
NarFormat
|
||||
Hash
|
||||
hs-source-dirs:
|
||||
tests
|
||||
tests
|
||||
build-depends:
|
||||
hnix-store-core
|
||||
, base
|
||||
|
@ -12,10 +12,12 @@ Maintainer : Shea Levy <shea@shealevy.com>; Greg Hale <imalsogreg@gmail.com>
|
||||
{-# LANGUAGE CPP #-}
|
||||
module System.Nix.Hash (
|
||||
HNix.Digest
|
||||
|
||||
, HNix.HashAlgorithm(..)
|
||||
, HNix.HashForm'(..)
|
||||
, HNix.HashForm
|
||||
, HNix.NamedAlgorithm(..)
|
||||
, HNix.NamedDigest(..)
|
||||
, HNix.AnyDigest(..)
|
||||
, HNix.AlgoVal(..)
|
||||
, HNix.HasDigest(..)
|
||||
, HNix.hash
|
||||
, HNix.hashLazy
|
||||
|
@ -2,50 +2,66 @@
|
||||
Description : Cryptographic hashes for hnix-store.
|
||||
Maintainer : Greg Hale <imalsogreg@gmail.com>
|
||||
-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeInType #-}
|
||||
|
||||
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
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Crypto.Hash.MD5 as MD5
|
||||
import qualified Crypto.Hash.SHA1 as SHA1
|
||||
import qualified Crypto.Hash.SHA256 as SHA256
|
||||
import Data.Bits (xor)
|
||||
import Data.Kind (Type)
|
||||
import Data.List (foldl')
|
||||
import Data.Monoid
|
||||
import Data.Proxy (Proxy(Proxy))
|
||||
import Data.Text (Text)
|
||||
import Data.Word (Word8)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Base16 as Base16
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import Data.Bits (xor)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import qualified Data.Hashable as DataHashable
|
||||
import Data.List (foldl')
|
||||
import Data.Proxy (Proxy(Proxy))
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Data.Vector as V
|
||||
import Data.Word (Word8)
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import Data.Hashable
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Data.Vector as V
|
||||
import GHC.TypeLits
|
||||
import Numeric.Natural
|
||||
|
||||
-- | A tag for different hashing algorithms
|
||||
-- Also used as a type-level tag for hash digests
|
||||
-- (e.g. @Digest SHA256@ is the type for a sha256 hash)
|
||||
--
|
||||
-- When used at the type level, `n` is `Nat`
|
||||
data HashAlgorithm
|
||||
= MD5
|
||||
| SHA1
|
||||
| SHA256
|
||||
| Truncated Nat HashAlgorithm
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
class NamedAlgorithm (a :: HashAlgorithm) where
|
||||
algorithmName :: Text
|
||||
data HashForm' n
|
||||
= Plain HashAlgorithm
|
||||
| Truncated n HashAlgorithm
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
type HashForm = HashForm' Nat
|
||||
|
||||
class HasDigest (Plain a) => NamedAlgorithm (a :: HashAlgorithm) where
|
||||
algorithmName :: forall a. Text
|
||||
|
||||
instance NamedAlgorithm 'MD5 where
|
||||
algorithmName = "md5"
|
||||
@ -62,9 +78,9 @@ instance NamedAlgorithm 'SHA256 where
|
||||
--
|
||||
-- Each instance defined here simply defers to one of the underlying
|
||||
-- monomorphic hashing libraries, such as `cryptohash-sha256`.
|
||||
class HasDigest (a :: HashAlgorithm) where
|
||||
class HasDigest (a :: HashForm) where
|
||||
|
||||
type AlgoCtx a :: *
|
||||
type AlgoCtx a :: Type
|
||||
|
||||
initialize :: AlgoCtx a
|
||||
update :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
|
||||
@ -89,49 +105,57 @@ hashLazy :: forall a.HasDigest a => BSL.ByteString -> Digest a
|
||||
hashLazy bsl =
|
||||
finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl)
|
||||
|
||||
digestText32 :: forall a. NamedAlgorithm a => Digest ('Plain a) -> T.Text
|
||||
digestText32 d = algorithmName @a <> ":" <> printAsBase32 d
|
||||
|
||||
|
||||
digestText16 :: forall a. NamedAlgorithm a => Digest ('Plain a) -> T.Text
|
||||
digestText16 (Digest bs) = algorithmName @a <> ":" <> T.decodeUtf8 (Base16.encode bs)
|
||||
|
||||
-- | Convert any Digest to a base32-encoded string.
|
||||
-- This is not used in producing store path hashes
|
||||
printAsBase32 :: Digest a -> T.Text
|
||||
printAsBase32 (Digest bs) = printHashBytes32 bs
|
||||
|
||||
|
||||
instance HasDigest MD5 where
|
||||
type AlgoCtx 'MD5 = MD5.Ctx
|
||||
instance HasDigest ('Plain 'MD5) where
|
||||
type AlgoCtx (Plain 'MD5) = MD5.Ctx
|
||||
initialize = MD5.init
|
||||
update = MD5.update
|
||||
finalize = Digest . MD5.finalize
|
||||
|
||||
instance HasDigest 'SHA1 where
|
||||
type AlgoCtx SHA1 = SHA1.Ctx
|
||||
instance HasDigest ('Plain 'SHA1) where
|
||||
type AlgoCtx (Plain SHA1) = SHA1.Ctx
|
||||
initialize = SHA1.init
|
||||
update = SHA1.update
|
||||
finalize = Digest . SHA1.finalize
|
||||
|
||||
instance HasDigest 'SHA256 where
|
||||
type AlgoCtx SHA256 = SHA256.Ctx
|
||||
instance HasDigest ('Plain 'SHA256) where
|
||||
type AlgoCtx (Plain SHA256) = SHA256.Ctx
|
||||
initialize = SHA256.init
|
||||
update = SHA256.update
|
||||
finalize = Digest . SHA256.finalize
|
||||
|
||||
instance (HasDigest a, KnownNat n) => HasDigest (Truncated n a) where
|
||||
type AlgoCtx (Truncated n a) = AlgoCtx a
|
||||
initialize = initialize @a
|
||||
update = update @a
|
||||
finalize = truncateDigest @n . finalize @a
|
||||
instance (HasDigest ('Plain a), KnownNat n) => HasDigest ('Truncated n a) where
|
||||
type AlgoCtx ('Truncated n a) = AlgoCtx ('Plain a)
|
||||
initialize = initialize @('Plain a)
|
||||
update = update @('Plain a)
|
||||
finalize = truncateDigest @n @a . finalize @('Plain a)
|
||||
|
||||
-- | A raw hash digest, with a type-level tag
|
||||
newtype Digest (a :: HashAlgorithm) = Digest
|
||||
newtype Digest (a :: HashForm) = Digest
|
||||
{ digestBytes :: BS.ByteString
|
||||
-- ^ The bytestring in a Digest is an opaque string of bytes,
|
||||
-- not some particular text encoding.
|
||||
} deriving (Show, Eq, Ord, DataHashable.Hashable)
|
||||
} deriving (Show, Eq, Ord, Hashable)
|
||||
|
||||
-- | A digest from a named hash algorithm.
|
||||
data NamedDigest =
|
||||
forall a . NamedAlgorithm a => NamedDigest (Digest a)
|
||||
data AnyDigest =
|
||||
forall a . HasDigest a => AnyDigest (Digest a)
|
||||
|
||||
--instance Show AnyDigest
|
||||
--instance Eq AnyDigest
|
||||
--instance Ord AnyDigest
|
||||
--instance Hashable AnyDigest where
|
||||
-- hashWithSalt salt (AnyDigest bs) = hashWithSalt salt bs
|
||||
|
||||
-- instance DataHashable.Hashable (Digest a) where
|
||||
-- hashWithSalt a (Digest bs) = DataHashable.hashWithSalt a bs
|
||||
@ -143,8 +167,11 @@ data NamedDigest =
|
||||
printHashBytes32 :: BS.ByteString -> T.Text
|
||||
printHashBytes32 c = T.pack $ concatMap char32 [nChar - 1, nChar - 2 .. 0]
|
||||
where
|
||||
-- The base32 encoding is 8/5's as long as the base256 digest
|
||||
nChar = fromIntegral $ BS.length c * 8 `div` 5
|
||||
-- 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]
|
||||
@ -163,7 +190,11 @@ printHashBytes32 c = T.pack $ concatMap char32 [nChar - 1, nChar - 2 .. 0]
|
||||
-- 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.(HasDigest a, KnownNat n) => Digest a -> Digest (Truncated n a)
|
||||
truncateDigest
|
||||
:: forall n a
|
||||
. (HasDigest ('Plain a), KnownNat n)
|
||||
=> Digest ('Plain a)
|
||||
-> Digest (Truncated n a)
|
||||
truncateDigest (Digest c) = Digest $ BS.pack $ map truncOutputByte [0.. n-1]
|
||||
where
|
||||
|
||||
@ -182,3 +213,26 @@ truncateDigest (Digest c) = Digest $ BS.pack $ map truncOutputByte [0.. n-1]
|
||||
|
||||
digits32 :: V.Vector Char
|
||||
digits32 = V.fromList "0123456789abcdfghijklmnpqrsvwxyz"
|
||||
|
||||
|
||||
-- | Convert type-level @HashAlgorithm@ into the value level
|
||||
class AlgoVal (a :: HashAlgorithm) where
|
||||
algoVal :: forall a. HashAlgorithm
|
||||
|
||||
instance AlgoVal MD5 where
|
||||
algoVal = MD5
|
||||
|
||||
instance AlgoVal SHA1 where
|
||||
algoVal = SHA1
|
||||
|
||||
instance AlgoVal SHA256 where
|
||||
algoVal = SHA256
|
||||
|
||||
class FormVal (a :: HashForm) where
|
||||
formVal :: HashForm' Natural
|
||||
|
||||
instance forall a. AlgoVal a => FormVal (Plain a) where
|
||||
formVal = Plain $ algoVal @a
|
||||
|
||||
instance forall a n. (AlgoVal a, KnownNat n) => FormVal (Truncated n a) where
|
||||
formVal = Truncated (fromIntegral $ natVal (Proxy @n)) (algoVal @a)
|
||||
|
@ -3,14 +3,25 @@ Description : Types and effects for interacting with the Nix store.
|
||||
Maintainer : Shea Levy <shea@shealevy.com>
|
||||
-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
module System.Nix.Path where
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module System.Nix.Path
|
||||
( FilePathPart(..)
|
||||
, filePathPart
|
||||
, HashMode(..)
|
||||
, PathInfo(..)
|
||||
, Path(..)
|
||||
, PathHashAlgo
|
||||
, PathName(..)
|
||||
, PathSet
|
||||
, pathName
|
||||
, pathToText
|
||||
) where
|
||||
|
||||
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
|
||||
@ -18,12 +29,20 @@ 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)
|
||||
|
||||
import System.Nix.Hash
|
||||
import System.Nix.Hash (Digest(..),
|
||||
HashAlgorithm(SHA256),
|
||||
HashForm'(Truncated),
|
||||
NamedAlgorithm)
|
||||
import System.Nix.Internal.Hash
|
||||
|
||||
-- | The hash algorithm used for store path hashes.
|
||||
type PathHashAlgo = 'Truncated 20 'SHA256
|
||||
|
||||
@ -38,7 +57,7 @@ newtype PathName = PathName
|
||||
-- | A regular expression for matching a valid 'PathName'
|
||||
nameRegex :: Regex
|
||||
nameRegex =
|
||||
makeRegex "[a-zA-Z0-9\\+\\-\\_\\?\\=][a-zA-Z0-9\\+\\-\\.\\_\\?\\=]*"
|
||||
makeRegex ("[a-zA-Z0-9\\+\\-\\_\\?\\=][a-zA-Z0-9\\+\\-\\.\\_\\?\\=]*" :: String)
|
||||
|
||||
-- | Construct a 'PathName', assuming the provided contents are valid.
|
||||
pathName :: Text -> Maybe PathName
|
||||
@ -47,23 +66,25 @@ pathName n = case matchTest nameRegex n of
|
||||
False -> Nothing
|
||||
|
||||
-- | A path in a store.
|
||||
--
|
||||
-- @root@: The root path of the store (e.g. "/nix/store").
|
||||
data Path (root :: Symbol) = Path !(Digest PathHashAlgo) !PathName
|
||||
-- Does not include the path *to* the store, e.g. "/nix/store".
|
||||
data Path = Path !(Digest PathHashAlgo) !PathName
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
type PathSet root = HashSet (Path root)
|
||||
pathToText :: Text -> Path -> Text
|
||||
pathToText storeDir (Path h nm) = storeDir <> "/" <> printAsBase32 h <> "-" <> pathNameContents nm
|
||||
|
||||
type PathSet = HashSet Path
|
||||
|
||||
-- | Metadata about a valid @Path@ in the store.
|
||||
data PathInfo store = PathInfo
|
||||
data PathInfo = PathInfo
|
||||
{ -- | Path itself
|
||||
path :: !(Path store)
|
||||
path :: !Path
|
||||
, -- | The .drv which led to this 'Path'.
|
||||
deriver :: !(Maybe (Path store))
|
||||
deriver :: !(Maybe Path)
|
||||
, -- | The hash of the serialization of this path.
|
||||
narHash :: !NamedDigest
|
||||
narHash :: !AnyDigest
|
||||
, -- | The references of the 'Path'.
|
||||
references :: !(PathSet store)
|
||||
references :: !PathSet
|
||||
, -- | When this store path was registered valid.
|
||||
registrationTime :: !UTCTime
|
||||
, -- | The size of the uncompressed NAR serialization of this
|
||||
@ -76,26 +97,36 @@ data PathInfo store = PathInfo
|
||||
sigs :: ![Text] -- TODO better type?
|
||||
, -- | Whether or not the store path is content-addressed, and if so
|
||||
ca :: !(Maybe ContentAddressedHash)
|
||||
}
|
||||
|
||||
} --deriving (Eq, Ord, Show)
|
||||
|
||||
-- | The different types of content-addressed hashing we have in Nix.
|
||||
data ContentAddressedHash
|
||||
= RegularFile (Digest SHA256)
|
||||
= RegularFile (Digest ('Plain 'SHA256))
|
||||
-- ^ A regular file hashed like sha256sum.
|
||||
| forall algo . NamedAlgorithm algo =>
|
||||
FixedFile (HashMode algo) (Digest algo)
|
||||
FixedFile HashMode (Digest (Plain 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.
|
||||
|
||||
-- | A specification of how to hash a file.
|
||||
data HashMode (a :: HashAlgorithm)
|
||||
data HashMode
|
||||
= 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 store) where
|
||||
instance Hashable Path where
|
||||
hashWithSalt s (Path hash name) = s `hashWithSalt` hash `hashWithSalt` name
|
||||
|
||||
-- | 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
|
||||
|
33
hnix-store-core/src/System/Nix/ReadonlyStore.hs
Normal file
33
hnix-store-core/src/System/Nix/ReadonlyStore.hs
Normal file
@ -0,0 +1,33 @@
|
||||
{-# 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.Internal.Hash
|
||||
import System.Nix.Path
|
||||
|
||||
makeStorePath :: Text -> Text -> Digest ('Plain 'SHA256) -> Text -> Path
|
||||
makeStorePath storeDir ty h nm = Path storeHash (PathName nm)
|
||||
where
|
||||
s = T.intercalate ":"
|
||||
[ ty
|
||||
, digestText16 h
|
||||
, storeDir
|
||||
, nm
|
||||
]
|
||||
storeHash = truncateDigest $ hash $ encodeUtf8 s
|
||||
|
||||
makeTextPath :: Text -> Text -> Digest ('Plain '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
|
@ -8,6 +8,7 @@ Maintainer : Shea Levy <shea@shealevy.com>
|
||||
module System.Nix.Store where
|
||||
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Numeric.Natural (Natural)
|
||||
import System.Nix.Hash (NamedAlgorithm, HashAlgorithm)
|
||||
import System.Nix.Path
|
||||
import System.Nix.Nar
|
||||
@ -17,23 +18,23 @@ import System.Nix.Nar
|
||||
-- @root@: The root path of the store (e.g. "/nix/store").
|
||||
--
|
||||
-- @m@: The monad the effects operate in.
|
||||
data StoreEffects root m = StoreEffects
|
||||
data StoreEffects 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.
|
||||
-> PathSet -- ^ The references of the path.
|
||||
-> m Path -- ^ 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.
|
||||
:: HashAlgorithm
|
||||
-> PathName -- ^ The name of the path.
|
||||
-> HashMode -- ^ How to hash the file.
|
||||
-> Nar -- ^ A nix archive dump of the file.
|
||||
-> m (Path root)
|
||||
-> m Path
|
||||
, importPath -- ^ Import a serialization of a valid path into the
|
||||
-- store.
|
||||
:: PathInfo root -- ^ Store path metadata.
|
||||
:: PathInfo -- ^ Store path metadata.
|
||||
-> Nar -- ^ A nix archive dump of file.
|
||||
-> Repair -- ^ Whether to overwrite the path if it is already
|
||||
-- valid in the store.
|
||||
@ -42,7 +43,6 @@ data StoreEffects root m = StoreEffects
|
||||
-> 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
|
||||
|
@ -31,6 +31,10 @@ 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 (printAsBase32 (hash @SHA256 "nix-output:foo"))
|
||||
"1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5"
|
||||
|
||||
it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $
|
||||
shouldBe (printAsBase32 (hash @SHA1 "Hello World"))
|
||||
"s23c9fs0v32pf6bhmcph5rbqsyl5ak8a"
|
||||
|
@ -1,13 +1,15 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashSet as HS
|
||||
import qualified System.Nix.GC as GC
|
||||
import System.Nix.Store.Remote
|
||||
import System.Nix.Store.Remote.Util
|
||||
import Data.Maybe
|
||||
import Control.Monad.Reader
|
||||
import qualified Data.HashSet as HS
|
||||
import Data.Maybe
|
||||
import Control.Monad.Reader
|
||||
import Text.Pretty.Simple
|
||||
import Data.Proxy
|
||||
|
||||
import Text.Pretty.Simple
|
||||
import qualified System.Nix.GC as GC
|
||||
import System.Nix.Path (PathHashAlgo)
|
||||
import System.Nix.Store.Remote
|
||||
import System.Nix.Store.Remote.Util
|
||||
|
||||
noSuchPath = fromJust $ mkPath "blah"
|
||||
|
||||
@ -17,19 +19,27 @@ main = do
|
||||
|
||||
verifyStore False False
|
||||
|
||||
(Just path) <- addTextToStore "hnix-store" "test" (HS.fromList []) False
|
||||
(Just path) <- addTextToStore "hnix-store" "test" (HS.fromList []) False
|
||||
|
||||
-- (Just path2) <- addTextToStore "hnix-store2" "test2" (HS.fromList []) False
|
||||
path2 <- addToStore "hi-test-file"
|
||||
"/home/greghale/code/hnix-store/hnix-store-remote/hi"
|
||||
False (Proxy :: Proxy PathHashAlgo) (const True) False
|
||||
|
||||
valid <- isValidPathUncached path
|
||||
case valid of
|
||||
True -> do
|
||||
valid2 <- isValidPathUncached path2
|
||||
|
||||
case (valid, valid2) of
|
||||
(True, True) -> do
|
||||
info <- queryPathInfoUncached path
|
||||
return (path, info)
|
||||
info2 <- queryPathInfoUncached path2
|
||||
return (path, info, path2, info2)
|
||||
_ -> error "shouldn't happen"
|
||||
|
||||
pPrint x
|
||||
case x of
|
||||
(Left err, log) -> putStrLn err >> print log
|
||||
(Right (path, pathinfo), log) -> do
|
||||
(Right (path, pathinfo, path2, pathinfo2), log) -> do
|
||||
gcres <- runStore $ do
|
||||
collectGarbage $ GC.Options
|
||||
{ GC.operation = GC.DeleteSpecific
|
||||
|
@ -21,6 +21,7 @@ library
|
||||
, System.Nix.Store.Remote.Util
|
||||
|
||||
build-depends: base >=4.10
|
||||
, base64-bytestring
|
||||
, bytestring
|
||||
, binary
|
||||
, bytestring
|
||||
|
@ -1,4 +1,10 @@
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
module System.Nix.Store.Remote (
|
||||
runStore
|
||||
, isValidPathUncached
|
||||
@ -29,23 +35,33 @@ module System.Nix.Store.Remote (
|
||||
, queryMissing
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Data.Binary as B
|
||||
import qualified Data.Binary.Put as B
|
||||
import Data.Maybe
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Proxy (Proxy(Proxy))
|
||||
import qualified Data.Text.Lazy as T
|
||||
import qualified Data.Text.Lazy.Encoding as T
|
||||
|
||||
import Control.Monad
|
||||
|
||||
import qualified System.Nix.Build as Build
|
||||
import qualified System.Nix.Derivation as Drv
|
||||
import qualified System.Nix.GC as GC
|
||||
import System.Nix.Hash (Digest, HashAlgorithm)
|
||||
import qualified System.Nix.Build as Build
|
||||
import qualified System.Nix.Derivation as Drv
|
||||
import qualified System.Nix.GC as GC
|
||||
import System.Nix.Hash (Digest, HashAlgorithm)
|
||||
import System.Nix.Path
|
||||
import System.Nix.Hash
|
||||
import System.Nix.Nar (localPackNar, putNar, narEffectsIO)
|
||||
import System.Nix.Util
|
||||
|
||||
import System.Nix.Store.Remote.Types
|
||||
import System.Nix.Store.Remote.Protocol
|
||||
import System.Nix.Store.Remote.Util
|
||||
|
||||
-- tmp
|
||||
import qualified Data.ByteString.Base64.Lazy as B64
|
||||
|
||||
type RepairFlag = Bool
|
||||
type CheckFlag = Bool
|
||||
type CheckSigsFlag = Bool
|
||||
@ -159,9 +175,43 @@ type Source = () -- abstract binary source
|
||||
addToStoreNar :: ValidPathInfo -> Source -> RepairFlag -> CheckSigsFlag -> MonadStore ()
|
||||
addToStoreNar = undefined -- XXX
|
||||
|
||||
printHashType :: HashAlgorithm' Integer -> T.Text
|
||||
printHashType MD5 = "MD5"
|
||||
printHashType SHA1 = "SHA1"
|
||||
printHashType SHA256 = "SHA256"
|
||||
printHashType (Truncated _ a) = printHashType a
|
||||
|
||||
type PathFilter = Path -> Bool
|
||||
addToStore :: LBS.ByteString -> Path -> Bool -> HashAlgorithm -> PathFilter -> RepairFlag -> MonadStore Path
|
||||
addToStore name pth recursive hashAlgo pfilter repair = undefined -- XXX
|
||||
|
||||
addToStore
|
||||
:: forall a. (HasDigest a, AlgoVal a)
|
||||
=> LBS.ByteString
|
||||
-> FilePath
|
||||
-> Bool
|
||||
-> Proxy a
|
||||
-> PathFilter
|
||||
-> RepairFlag
|
||||
-> MonadStore Path
|
||||
addToStore name pth recursive algoProxy pfilter repair = do
|
||||
|
||||
-- TODO: Is this lazy enough? We need `B.putLazyByteString bs` to stream `bs`
|
||||
bs :: LBS.ByteString <- liftIO $ B.runPut . putNar <$> localPackNar narEffectsIO pth
|
||||
|
||||
runOpArgs AddToStore $ do
|
||||
putByteStringLen name
|
||||
if algoVal @a `elem` [SHA256, Truncated 20 SHA256] && recursive
|
||||
then putInt 0
|
||||
else putInt 1
|
||||
if recursive
|
||||
then putInt 1
|
||||
else putInt 0
|
||||
|
||||
putByteStringLen (T.encodeUtf8 . T.toLower . printHashType $ algoVal @a)
|
||||
|
||||
B.putLazyByteString bs
|
||||
|
||||
fmap (fromMaybe $ error "TODO: Error") sockGetPath
|
||||
|
||||
|
||||
addTextToStore :: LBS.ByteString -> LBS.ByteString -> PathSet -> RepairFlag -> MonadStore (Maybe Path)
|
||||
addTextToStore name text references' repair = do
|
||||
|
@ -127,6 +127,13 @@ runOp op = runOpArgs op $ return ()
|
||||
|
||||
runOpArgs :: WorkerOp -> Put -> MonadStore ()
|
||||
runOpArgs op args = do
|
||||
|
||||
-- Temporary hack for printing the messages destined for nix-daemon socket
|
||||
when False $
|
||||
liftIO $ LBS.writeFile "mytestfile2" $ runPut $ do
|
||||
putInt $ opNum op
|
||||
args
|
||||
|
||||
sockPut $ do
|
||||
putInt $ opNum op
|
||||
args
|
||||
|
@ -15,6 +15,7 @@ import qualified Data.HashSet as HashSet
|
||||
import Network.Socket.ByteString (recv, sendAll)
|
||||
|
||||
import System.Nix.Store.Remote.Types
|
||||
import System.Nix.Hash
|
||||
import System.Nix.Path
|
||||
import System.Nix.Util
|
||||
|
||||
@ -73,7 +74,7 @@ mkPath p = case (pathName $ lBSToText p) of
|
||||
-- TODO: replace `undefined` with digest encoding function when
|
||||
-- [issue 24](https://github.com/haskell-nix/hnix-store/issues/24)
|
||||
-- is closed
|
||||
Just x -> Just $ Path (undefined $ LBS.toStrict p) x --XXX: hash
|
||||
Just x -> Just $ Path (hash $ LBS.toStrict p) x --XXX: hash
|
||||
Nothing -> Nothing
|
||||
|
||||
-- WOOT
|
||||
|
Loading…
Reference in New Issue
Block a user