mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +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.Internal.Hash
|
||||||
, System.Nix.Nar
|
, System.Nix.Nar
|
||||||
, System.Nix.Path
|
, System.Nix.Path
|
||||||
|
, System.Nix.ReadonlyStore
|
||||||
, System.Nix.Store
|
, System.Nix.Store
|
||||||
, System.Nix.Util
|
, System.Nix.Util
|
||||||
build-depends: base >=4.10
|
build-depends: base >=4.10
|
||||||
|
, base16-bytestring
|
||||||
, bytestring
|
, bytestring
|
||||||
, binary
|
, binary
|
||||||
, bytestring
|
, bytestring
|
||||||
@ -62,7 +64,7 @@ test-suite format-tests
|
|||||||
NarFormat
|
NarFormat
|
||||||
Hash
|
Hash
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
tests
|
tests
|
||||||
build-depends:
|
build-depends:
|
||||||
hnix-store-core
|
hnix-store-core
|
||||||
, base
|
, base
|
||||||
|
@ -12,10 +12,12 @@ Maintainer : Shea Levy <shea@shealevy.com>; Greg Hale <imalsogreg@gmail.com>
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
module System.Nix.Hash (
|
module System.Nix.Hash (
|
||||||
HNix.Digest
|
HNix.Digest
|
||||||
|
|
||||||
, HNix.HashAlgorithm(..)
|
, HNix.HashAlgorithm(..)
|
||||||
|
, HNix.HashForm'(..)
|
||||||
|
, HNix.HashForm
|
||||||
, HNix.NamedAlgorithm(..)
|
, HNix.NamedAlgorithm(..)
|
||||||
, HNix.NamedDigest(..)
|
, HNix.AnyDigest(..)
|
||||||
|
, HNix.AlgoVal(..)
|
||||||
, HNix.HasDigest(..)
|
, HNix.HasDigest(..)
|
||||||
, HNix.hash
|
, HNix.hash
|
||||||
, HNix.hashLazy
|
, HNix.hashLazy
|
||||||
|
@ -2,50 +2,66 @@
|
|||||||
Description : Cryptographic hashes for hnix-store.
|
Description : Cryptographic hashes for hnix-store.
|
||||||
Maintainer : Greg Hale <imalsogreg@gmail.com>
|
Maintainer : Greg Hale <imalsogreg@gmail.com>
|
||||||
-}
|
-}
|
||||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
||||||
{-# LANGUAGE PolyKinds #-}
|
|
||||||
{-# LANGUAGE RankNTypes #-}
|
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
|
||||||
{-# LANGUAGE KindSignatures #-}
|
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
|
||||||
{-# LANGUAGE TypeApplications #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE ExistentialQuantification #-}
|
{-# 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
|
module System.Nix.Internal.Hash where
|
||||||
|
|
||||||
import Data.Text (Text)
|
import qualified Crypto.Hash.MD5 as MD5
|
||||||
import qualified Crypto.Hash.MD5 as MD5
|
import qualified Crypto.Hash.SHA1 as SHA1
|
||||||
import qualified Crypto.Hash.SHA1 as SHA1
|
import qualified Crypto.Hash.SHA256 as SHA256
|
||||||
import qualified Crypto.Hash.SHA256 as SHA256
|
import Data.Bits (xor)
|
||||||
import qualified Data.ByteString as BS
|
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 qualified Data.ByteString.Char8 as BSC
|
||||||
import Data.Bits (xor)
|
import qualified Data.ByteString.Lazy as BSL
|
||||||
import qualified Data.ByteString as BS
|
import Data.Hashable
|
||||||
import qualified Data.ByteString.Lazy as BSL
|
import qualified Data.Text as T
|
||||||
import qualified Data.Hashable as DataHashable
|
import qualified Data.Text.Encoding as T
|
||||||
import Data.List (foldl')
|
import qualified Data.Vector as V
|
||||||
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 GHC.TypeLits
|
import GHC.TypeLits
|
||||||
|
import Numeric.Natural
|
||||||
|
|
||||||
-- | A tag for different hashing algorithms
|
-- | A tag for different hashing algorithms
|
||||||
-- Also used as a type-level tag for hash digests
|
-- Also used as a type-level tag for hash digests
|
||||||
-- (e.g. @Digest SHA256@ is the type for a sha256 hash)
|
-- (e.g. @Digest SHA256@ is the type for a sha256 hash)
|
||||||
|
--
|
||||||
|
-- When used at the type level, `n` is `Nat`
|
||||||
data HashAlgorithm
|
data HashAlgorithm
|
||||||
= MD5
|
= MD5
|
||||||
| SHA1
|
| SHA1
|
||||||
| SHA256
|
| SHA256
|
||||||
| Truncated Nat HashAlgorithm
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
class NamedAlgorithm (a :: HashAlgorithm) where
|
data HashForm' n
|
||||||
algorithmName :: Text
|
= 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
|
instance NamedAlgorithm 'MD5 where
|
||||||
algorithmName = "md5"
|
algorithmName = "md5"
|
||||||
@ -62,9 +78,9 @@ instance NamedAlgorithm 'SHA256 where
|
|||||||
--
|
--
|
||||||
-- Each instance defined here simply defers to one of the underlying
|
-- Each instance defined here simply defers to one of the underlying
|
||||||
-- monomorphic hashing libraries, such as `cryptohash-sha256`.
|
-- 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
|
initialize :: AlgoCtx a
|
||||||
update :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
|
update :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
|
||||||
@ -89,49 +105,57 @@ hashLazy :: forall a.HasDigest a => BSL.ByteString -> Digest a
|
|||||||
hashLazy bsl =
|
hashLazy bsl =
|
||||||
finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks 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.
|
-- | Convert any Digest to a base32-encoded string.
|
||||||
-- This is not used in producing store path hashes
|
-- This is not used in producing store path hashes
|
||||||
printAsBase32 :: Digest a -> T.Text
|
printAsBase32 :: Digest a -> T.Text
|
||||||
printAsBase32 (Digest bs) = printHashBytes32 bs
|
printAsBase32 (Digest bs) = printHashBytes32 bs
|
||||||
|
|
||||||
|
instance HasDigest ('Plain 'MD5) where
|
||||||
instance HasDigest MD5 where
|
type AlgoCtx (Plain 'MD5) = MD5.Ctx
|
||||||
type AlgoCtx 'MD5 = MD5.Ctx
|
|
||||||
initialize = MD5.init
|
initialize = MD5.init
|
||||||
update = MD5.update
|
update = MD5.update
|
||||||
finalize = Digest . MD5.finalize
|
finalize = Digest . MD5.finalize
|
||||||
|
|
||||||
instance HasDigest 'SHA1 where
|
instance HasDigest ('Plain 'SHA1) where
|
||||||
type AlgoCtx SHA1 = SHA1.Ctx
|
type AlgoCtx (Plain SHA1) = SHA1.Ctx
|
||||||
initialize = SHA1.init
|
initialize = SHA1.init
|
||||||
update = SHA1.update
|
update = SHA1.update
|
||||||
finalize = Digest . SHA1.finalize
|
finalize = Digest . SHA1.finalize
|
||||||
|
|
||||||
instance HasDigest 'SHA256 where
|
instance HasDigest ('Plain 'SHA256) where
|
||||||
type AlgoCtx SHA256 = SHA256.Ctx
|
type AlgoCtx (Plain SHA256) = SHA256.Ctx
|
||||||
initialize = SHA256.init
|
initialize = SHA256.init
|
||||||
update = SHA256.update
|
update = SHA256.update
|
||||||
finalize = Digest . SHA256.finalize
|
finalize = Digest . SHA256.finalize
|
||||||
|
|
||||||
instance (HasDigest a, KnownNat n) => HasDigest (Truncated n a) where
|
instance (HasDigest ('Plain a), KnownNat n) => HasDigest ('Truncated n a) where
|
||||||
type AlgoCtx (Truncated n a) = AlgoCtx a
|
type AlgoCtx ('Truncated n a) = AlgoCtx ('Plain a)
|
||||||
initialize = initialize @a
|
initialize = initialize @('Plain a)
|
||||||
update = update @a
|
update = update @('Plain a)
|
||||||
finalize = truncateDigest @n . finalize @a
|
finalize = truncateDigest @n @a . finalize @('Plain a)
|
||||||
|
|
||||||
-- | A raw hash digest, with a type-level tag
|
-- | A raw hash digest, with a type-level tag
|
||||||
newtype Digest (a :: HashAlgorithm) = Digest
|
newtype Digest (a :: HashForm) = Digest
|
||||||
{ digestBytes :: BS.ByteString
|
{ digestBytes :: BS.ByteString
|
||||||
-- ^ The bytestring in a Digest is an opaque string of bytes,
|
-- ^ The bytestring in a Digest is an opaque string of bytes,
|
||||||
-- not some particular text encoding.
|
-- not some particular text encoding.
|
||||||
} deriving (Show, Eq, Ord, DataHashable.Hashable)
|
} deriving (Show, Eq, Ord, Hashable)
|
||||||
|
|
||||||
-- | A digest from a named hash algorithm.
|
-- | A digest from a named hash algorithm.
|
||||||
data NamedDigest =
|
data AnyDigest =
|
||||||
forall a . NamedAlgorithm a => NamedDigest (Digest a)
|
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
|
-- instance DataHashable.Hashable (Digest a) where
|
||||||
-- hashWithSalt a (Digest bs) = DataHashable.hashWithSalt a bs
|
-- hashWithSalt a (Digest bs) = DataHashable.hashWithSalt a bs
|
||||||
@ -143,8 +167,11 @@ data NamedDigest =
|
|||||||
printHashBytes32 :: BS.ByteString -> T.Text
|
printHashBytes32 :: BS.ByteString -> T.Text
|
||||||
printHashBytes32 c = T.pack $ concatMap char32 [nChar - 1, nChar - 2 .. 0]
|
printHashBytes32 c = T.pack $ concatMap char32 [nChar - 1, nChar - 2 .. 0]
|
||||||
where
|
where
|
||||||
-- The base32 encoding is 8/5's as long as the base256 digest
|
-- The base32 encoding is 8/5's as long as the base256 digest. This `+ 1`
|
||||||
nChar = fromIntegral $ BS.length c * 8 `div` 5
|
-- `- 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 :: Integer -> [Char]
|
||||||
char32 i = [digits32 V.! digitInd]
|
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
|
-- bytestring into a head part (truncation length) and tail part (leftover
|
||||||
-- part) right-pads the leftovers with 0 to the truncation length, and
|
-- part) right-pads the leftovers with 0 to the truncation length, and
|
||||||
-- combines the two strings bytewise with `xor`
|
-- 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]
|
truncateDigest (Digest c) = Digest $ BS.pack $ map truncOutputByte [0.. n-1]
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -182,3 +213,26 @@ truncateDigest (Digest c) = Digest $ BS.pack $ map truncOutputByte [0.. n-1]
|
|||||||
|
|
||||||
digits32 :: V.Vector Char
|
digits32 :: V.Vector Char
|
||||||
digits32 = V.fromList "0123456789abcdfghijklmnpqrsvwxyz"
|
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>
|
Maintainer : Shea Levy <shea@shealevy.com>
|
||||||
-}
|
-}
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
{-# LANGUAGE KindSignatures #-}
|
{-# LANGUAGE KindSignatures #-}
|
||||||
{-# LANGUAGE ExistentialQuantification #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module System.Nix.Path where
|
module System.Nix.Path
|
||||||
|
( FilePathPart(..)
|
||||||
|
, filePathPart
|
||||||
|
, HashMode(..)
|
||||||
|
, PathInfo(..)
|
||||||
|
, Path(..)
|
||||||
|
, PathHashAlgo
|
||||||
|
, PathName(..)
|
||||||
|
, PathSet
|
||||||
|
, pathName
|
||||||
|
, pathToText
|
||||||
|
) where
|
||||||
|
|
||||||
import Data.Word
|
import Data.Word
|
||||||
import GHC.TypeLits
|
import GHC.TypeLits
|
||||||
import System.Nix.Hash
|
|
||||||
import Data.Time
|
import Data.Time
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Char8 as BSC
|
import qualified Data.ByteString.Char8 as BSC
|
||||||
@ -18,12 +29,20 @@ import Data.Hashable (Hashable (..), hashPtrWithSalt)
|
|||||||
import Data.HashMap.Strict (HashMap)
|
import Data.HashMap.Strict (HashMap)
|
||||||
import Data.HashSet (HashSet)
|
import Data.HashSet (HashSet)
|
||||||
import Data.Map.Strict (Map)
|
import Data.Map.Strict (Map)
|
||||||
|
import Data.Monoid
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import System.IO.Unsafe (unsafeDupablePerformIO)
|
import System.IO.Unsafe (unsafeDupablePerformIO)
|
||||||
import Text.Regex.Base.RegexLike (makeRegex, matchTest)
|
import Text.Regex.Base.RegexLike (makeRegex, matchTest)
|
||||||
import Text.Regex.TDFA.Text (Regex)
|
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.
|
-- | The hash algorithm used for store path hashes.
|
||||||
type PathHashAlgo = 'Truncated 20 'SHA256
|
type PathHashAlgo = 'Truncated 20 'SHA256
|
||||||
|
|
||||||
@ -38,7 +57,7 @@ newtype PathName = PathName
|
|||||||
-- | A regular expression for matching a valid 'PathName'
|
-- | A regular expression for matching a valid 'PathName'
|
||||||
nameRegex :: Regex
|
nameRegex :: Regex
|
||||||
nameRegex =
|
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.
|
-- | Construct a 'PathName', assuming the provided contents are valid.
|
||||||
pathName :: Text -> Maybe PathName
|
pathName :: Text -> Maybe PathName
|
||||||
@ -47,23 +66,25 @@ pathName n = case matchTest nameRegex n of
|
|||||||
False -> Nothing
|
False -> Nothing
|
||||||
|
|
||||||
-- | A path in a store.
|
-- | A path in a store.
|
||||||
--
|
-- Does not include the path *to* the store, e.g. "/nix/store".
|
||||||
-- @root@: The root path of the store (e.g. "/nix/store").
|
data Path = Path !(Digest PathHashAlgo) !PathName
|
||||||
data Path (root :: Symbol) = Path !(Digest PathHashAlgo) !PathName
|
|
||||||
deriving (Eq, Ord, Show)
|
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.
|
-- | Metadata about a valid @Path@ in the store.
|
||||||
data PathInfo store = PathInfo
|
data PathInfo = PathInfo
|
||||||
{ -- | Path itself
|
{ -- | Path itself
|
||||||
path :: !(Path store)
|
path :: !Path
|
||||||
, -- | The .drv which led to this 'Path'.
|
, -- | The .drv which led to this 'Path'.
|
||||||
deriver :: !(Maybe (Path store))
|
deriver :: !(Maybe Path)
|
||||||
, -- | The hash of the serialization of this path.
|
, -- | The hash of the serialization of this path.
|
||||||
narHash :: !NamedDigest
|
narHash :: !AnyDigest
|
||||||
, -- | The references of the 'Path'.
|
, -- | The references of the 'Path'.
|
||||||
references :: !(PathSet store)
|
references :: !PathSet
|
||||||
, -- | When this store path was registered valid.
|
, -- | When this store path was registered valid.
|
||||||
registrationTime :: !UTCTime
|
registrationTime :: !UTCTime
|
||||||
, -- | The size of the uncompressed NAR serialization of this
|
, -- | The size of the uncompressed NAR serialization of this
|
||||||
@ -76,26 +97,36 @@ data PathInfo store = PathInfo
|
|||||||
sigs :: ![Text] -- TODO better type?
|
sigs :: ![Text] -- TODO better type?
|
||||||
, -- | Whether or not the store path is content-addressed, and if so
|
, -- | Whether or not the store path is content-addressed, and if so
|
||||||
ca :: !(Maybe ContentAddressedHash)
|
ca :: !(Maybe ContentAddressedHash)
|
||||||
}
|
} --deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
|
|
||||||
-- | The different types of content-addressed hashing we have in Nix.
|
-- | The different types of content-addressed hashing we have in Nix.
|
||||||
data ContentAddressedHash
|
data ContentAddressedHash
|
||||||
= RegularFile (Digest SHA256)
|
= RegularFile (Digest ('Plain 'SHA256))
|
||||||
-- ^ A regular file hashed like sha256sum.
|
-- ^ A regular file hashed like sha256sum.
|
||||||
| forall algo . NamedAlgorithm algo =>
|
| 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.
|
-- ^ A file hashed via the add-fixed-file-to-store approach.
|
||||||
-- This can in fact overlap with RegularFile (if the 'HashMode'
|
-- This can in fact overlap with RegularFile (if the 'HashMode'
|
||||||
-- is 'Flat @SHA256'), but the resulting Nix store hash is
|
-- is 'Flat @SHA256'), but the resulting Nix store hash is
|
||||||
-- different for stupid legacy reasons.
|
-- different for stupid legacy reasons.
|
||||||
|
|
||||||
-- | A specification of how to hash a file.
|
-- | A specification of how to hash a file.
|
||||||
data HashMode (a :: HashAlgorithm)
|
data HashMode
|
||||||
= Flat -- ^ Normal hashing of a regular file.
|
= Flat -- ^ Normal hashing of a regular file.
|
||||||
| Recursive -- ^ Hashing of a serialization of a file, compatible
|
| Recursive -- ^ Hashing of a serialization of a file, compatible
|
||||||
-- with directories and executable files as well as
|
-- with directories and executable files as well as
|
||||||
-- regular files.
|
-- regular files.
|
||||||
|
|
||||||
instance Hashable (Path store) where
|
instance Hashable Path where
|
||||||
hashWithSalt s (Path hash name) = s `hashWithSalt` hash `hashWithSalt` name
|
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
|
module System.Nix.Store where
|
||||||
|
|
||||||
import Data.ByteString.Lazy (ByteString)
|
import Data.ByteString.Lazy (ByteString)
|
||||||
|
import Numeric.Natural (Natural)
|
||||||
import System.Nix.Hash (NamedAlgorithm, HashAlgorithm)
|
import System.Nix.Hash (NamedAlgorithm, HashAlgorithm)
|
||||||
import System.Nix.Path
|
import System.Nix.Path
|
||||||
import System.Nix.Nar
|
import System.Nix.Nar
|
||||||
@ -17,23 +18,23 @@ import System.Nix.Nar
|
|||||||
-- @root@: The root path of the store (e.g. "/nix/store").
|
-- @root@: The root path of the store (e.g. "/nix/store").
|
||||||
--
|
--
|
||||||
-- @m@: The monad the effects operate in.
|
-- @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
|
{ regularFileToStore -- ^ Add a regular file to the store with the
|
||||||
-- given references, hashed with 'SHA256'.
|
-- given references, hashed with 'SHA256'.
|
||||||
:: PathName -- ^ The name of the path.
|
:: PathName -- ^ The name of the path.
|
||||||
-> ByteString -- ^ The contents of the file.
|
-> ByteString -- ^ The contents of the file.
|
||||||
-> PathSet root -- ^ The references of the path.
|
-> PathSet -- ^ The references of the path.
|
||||||
-> m (Path root) -- ^ The added store path.
|
-> m Path -- ^ The added store path.
|
||||||
, fixedFileToStore -- ^ Add a fixed file (possibly not regular) to
|
, fixedFileToStore -- ^ Add a fixed file (possibly not regular) to
|
||||||
-- the store with the diven hash algorithm.
|
-- the store with the diven hash algorithm.
|
||||||
:: forall a . (NamedAlgorithm a)
|
:: HashAlgorithm
|
||||||
=> PathName -- ^ The name of the path.
|
-> PathName -- ^ The name of the path.
|
||||||
-> HashMode a -- ^ How to hash the file.
|
-> HashMode -- ^ How to hash the file.
|
||||||
-> Nar -- ^ A nix archive dump of 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
|
, importPath -- ^ Import a serialization of a valid path into the
|
||||||
-- store.
|
-- store.
|
||||||
:: PathInfo root -- ^ Store path metadata.
|
:: PathInfo -- ^ Store path metadata.
|
||||||
-> Nar -- ^ A nix archive dump of file.
|
-> Nar -- ^ A nix archive dump of file.
|
||||||
-> Repair -- ^ Whether to overwrite the path if it is already
|
-> Repair -- ^ Whether to overwrite the path if it is already
|
||||||
-- valid in the store.
|
-- valid in the store.
|
||||||
@ -42,7 +43,6 @@ data StoreEffects root m = StoreEffects
|
|||||||
-> m ()
|
-> m ()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
-- | Flag to indicate whether a command should overwrite a specified
|
-- | Flag to indicate whether a command should overwrite a specified
|
||||||
-- path if it already exists (in an attempt to fix issues).
|
-- path if it already exists (in an attempt to fix issues).
|
||||||
data Repair = Repair | DontRepair
|
data Repair = Repair | DontRepair
|
||||||
|
@ -31,6 +31,10 @@ spec_hash = do
|
|||||||
|
|
||||||
describe "hashing parity with nix-store" $ 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" $
|
it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $
|
||||||
shouldBe (printAsBase32 (hash @SHA1 "Hello World"))
|
shouldBe (printAsBase32 (hash @SHA1 "Hello World"))
|
||||||
"s23c9fs0v32pf6bhmcph5rbqsyl5ak8a"
|
"s23c9fs0v32pf6bhmcph5rbqsyl5ak8a"
|
||||||
|
@ -1,13 +1,15 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.HashSet as HS
|
import qualified Data.HashSet as HS
|
||||||
import qualified System.Nix.GC as GC
|
import Data.Maybe
|
||||||
import System.Nix.Store.Remote
|
import Control.Monad.Reader
|
||||||
import System.Nix.Store.Remote.Util
|
import Text.Pretty.Simple
|
||||||
import Data.Maybe
|
import Data.Proxy
|
||||||
import Control.Monad.Reader
|
|
||||||
|
|
||||||
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"
|
noSuchPath = fromJust $ mkPath "blah"
|
||||||
|
|
||||||
@ -17,19 +19,27 @@ main = do
|
|||||||
|
|
||||||
verifyStore False False
|
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
|
valid <- isValidPathUncached path
|
||||||
case valid of
|
valid2 <- isValidPathUncached path2
|
||||||
True -> do
|
|
||||||
|
case (valid, valid2) of
|
||||||
|
(True, True) -> do
|
||||||
info <- queryPathInfoUncached path
|
info <- queryPathInfoUncached path
|
||||||
return (path, info)
|
info2 <- queryPathInfoUncached path2
|
||||||
|
return (path, info, path2, info2)
|
||||||
_ -> error "shouldn't happen"
|
_ -> error "shouldn't happen"
|
||||||
|
|
||||||
pPrint x
|
pPrint x
|
||||||
case x of
|
case x of
|
||||||
(Left err, log) -> putStrLn err >> print log
|
(Left err, log) -> putStrLn err >> print log
|
||||||
(Right (path, pathinfo), log) -> do
|
(Right (path, pathinfo, path2, pathinfo2), log) -> do
|
||||||
gcres <- runStore $ do
|
gcres <- runStore $ do
|
||||||
collectGarbage $ GC.Options
|
collectGarbage $ GC.Options
|
||||||
{ GC.operation = GC.DeleteSpecific
|
{ GC.operation = GC.DeleteSpecific
|
||||||
|
@ -21,6 +21,7 @@ library
|
|||||||
, System.Nix.Store.Remote.Util
|
, System.Nix.Store.Remote.Util
|
||||||
|
|
||||||
build-depends: base >=4.10
|
build-depends: base >=4.10
|
||||||
|
, base64-bytestring
|
||||||
, bytestring
|
, bytestring
|
||||||
, binary
|
, binary
|
||||||
, bytestring
|
, bytestring
|
||||||
|
@ -1,4 +1,10 @@
|
|||||||
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE KindSignatures #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE RankNTypes #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
module System.Nix.Store.Remote (
|
module System.Nix.Store.Remote (
|
||||||
runStore
|
runStore
|
||||||
, isValidPathUncached
|
, isValidPathUncached
|
||||||
@ -29,23 +35,33 @@ module System.Nix.Store.Remote (
|
|||||||
, queryMissing
|
, queryMissing
|
||||||
) where
|
) 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 Data.Maybe
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.Map.Strict as M
|
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.Build as Build
|
import qualified System.Nix.GC as GC
|
||||||
import qualified System.Nix.Derivation as Drv
|
import System.Nix.Hash (Digest, HashAlgorithm)
|
||||||
import qualified System.Nix.GC as GC
|
|
||||||
import System.Nix.Hash (Digest, HashAlgorithm)
|
|
||||||
import System.Nix.Path
|
import System.Nix.Path
|
||||||
|
import System.Nix.Hash
|
||||||
|
import System.Nix.Nar (localPackNar, putNar, narEffectsIO)
|
||||||
import System.Nix.Util
|
import System.Nix.Util
|
||||||
|
|
||||||
import System.Nix.Store.Remote.Types
|
import System.Nix.Store.Remote.Types
|
||||||
import System.Nix.Store.Remote.Protocol
|
import System.Nix.Store.Remote.Protocol
|
||||||
import System.Nix.Store.Remote.Util
|
import System.Nix.Store.Remote.Util
|
||||||
|
|
||||||
|
-- tmp
|
||||||
|
import qualified Data.ByteString.Base64.Lazy as B64
|
||||||
|
|
||||||
type RepairFlag = Bool
|
type RepairFlag = Bool
|
||||||
type CheckFlag = Bool
|
type CheckFlag = Bool
|
||||||
type CheckSigsFlag = Bool
|
type CheckSigsFlag = Bool
|
||||||
@ -159,9 +175,43 @@ type Source = () -- abstract binary source
|
|||||||
addToStoreNar :: ValidPathInfo -> Source -> RepairFlag -> CheckSigsFlag -> MonadStore ()
|
addToStoreNar :: ValidPathInfo -> Source -> RepairFlag -> CheckSigsFlag -> MonadStore ()
|
||||||
addToStoreNar = undefined -- XXX
|
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
|
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 :: LBS.ByteString -> LBS.ByteString -> PathSet -> RepairFlag -> MonadStore (Maybe Path)
|
||||||
addTextToStore name text references' repair = do
|
addTextToStore name text references' repair = do
|
||||||
|
@ -127,6 +127,13 @@ runOp op = runOpArgs op $ return ()
|
|||||||
|
|
||||||
runOpArgs :: WorkerOp -> Put -> MonadStore ()
|
runOpArgs :: WorkerOp -> Put -> MonadStore ()
|
||||||
runOpArgs op args = do
|
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
|
sockPut $ do
|
||||||
putInt $ opNum op
|
putInt $ opNum op
|
||||||
args
|
args
|
||||||
|
@ -15,6 +15,7 @@ import qualified Data.HashSet as HashSet
|
|||||||
import Network.Socket.ByteString (recv, sendAll)
|
import Network.Socket.ByteString (recv, sendAll)
|
||||||
|
|
||||||
import System.Nix.Store.Remote.Types
|
import System.Nix.Store.Remote.Types
|
||||||
|
import System.Nix.Hash
|
||||||
import System.Nix.Path
|
import System.Nix.Path
|
||||||
import System.Nix.Util
|
import System.Nix.Util
|
||||||
|
|
||||||
@ -73,7 +74,7 @@ mkPath p = case (pathName $ lBSToText p) of
|
|||||||
-- TODO: replace `undefined` with digest encoding function when
|
-- TODO: replace `undefined` with digest encoding function when
|
||||||
-- [issue 24](https://github.com/haskell-nix/hnix-store/issues/24)
|
-- [issue 24](https://github.com/haskell-nix/hnix-store/issues/24)
|
||||||
-- is closed
|
-- 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
|
Nothing -> Nothing
|
||||||
|
|
||||||
-- WOOT
|
-- WOOT
|
||||||
|
Loading…
Reference in New Issue
Block a user