mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
WIP
A hie.yaml M hnix-store-core/hnix-store-core.cabal M hnix-store-core/src/System/Nix/Hash.hs M hnix-store-core/src/System/Nix/Internal/Base.hs M hnix-store-core/src/System/Nix/Internal/Base32.hs M hnix-store-core/src/System/Nix/Internal/Old.hs M hnix-store-core/src/System/Nix/Internal/SriHash.hs M hnix-store-core/src/System/Nix/Internal/StorePath.hs D hnix-store-core/src/System/Nix/Internal/TruncatedHash.1hs A hnix-store-core/src/System/Nix/Internal/TruncatedHash.hs A hnix-store-core/src/System/Nix/Internal/Uncycle.hs
This commit is contained in:
parent
091b1178ed
commit
b0725fa107
13
hie.yaml
Normal file
13
hie.yaml
Normal file
@ -0,0 +1,13 @@
|
|||||||
|
cradle:
|
||||||
|
cabal:
|
||||||
|
- path: "./hnix-store-core/src"
|
||||||
|
component: "lib:hnix-store-core"
|
||||||
|
|
||||||
|
- path: "./hnix-store-core/tests"
|
||||||
|
component: "hnix-store-core:test:format-tests"
|
||||||
|
|
||||||
|
- path: "./hnix-store-remote/src"
|
||||||
|
component: "lib:hnix-store-remote"
|
||||||
|
|
||||||
|
- path: "./hnix-store-remote/tests"
|
||||||
|
component: "hnix-store-remote:test:hnix-store-remote-tests"
|
@ -50,6 +50,7 @@ library
|
|||||||
, base16-bytestring
|
, base16-bytestring
|
||||||
, base64-bytestring
|
, base64-bytestring
|
||||||
, bytestring
|
, bytestring
|
||||||
|
, bytestring-show
|
||||||
, cereal
|
, cereal
|
||||||
, containers
|
, containers
|
||||||
, cryptonite
|
, cryptonite
|
||||||
@ -57,6 +58,7 @@ library
|
|||||||
, cryptohash-sha1
|
, cryptohash-sha1
|
||||||
, cryptohash-sha256
|
, cryptohash-sha256
|
||||||
, cryptohash-sha512
|
, cryptohash-sha512
|
||||||
|
, digits
|
||||||
, directory
|
, directory
|
||||||
, filepath
|
, filepath
|
||||||
, hashable
|
, hashable
|
||||||
@ -67,6 +69,7 @@ library
|
|||||||
, saltine
|
, saltine
|
||||||
, time
|
, time
|
||||||
, text
|
, text
|
||||||
|
, text-builder
|
||||||
, unix
|
, unix
|
||||||
, unordered-containers
|
, unordered-containers
|
||||||
, vector
|
, vector
|
||||||
|
@ -7,7 +7,6 @@ module System.Nix.Hash (
|
|||||||
, HNix.HashAlgorithm(..)
|
, HNix.HashAlgorithm(..)
|
||||||
, HNix.ValidAlgo(..)
|
, HNix.ValidAlgo(..)
|
||||||
, HNix.NamedAlgo(..)
|
, HNix.NamedAlgo(..)
|
||||||
, HNix.SomeNamedDigest(..)
|
|
||||||
, HNix.hash
|
, HNix.hash
|
||||||
, HNix.hashLazy
|
, HNix.hashLazy
|
||||||
, SRI.mkNamedDigest
|
, SRI.mkNamedDigest
|
||||||
@ -18,5 +17,6 @@ module System.Nix.Hash (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified System.Nix.Internal.Old as HNix
|
import qualified System.Nix.Internal.Old as HNix
|
||||||
|
import qualified System.Nix.Internal.Hash as H
|
||||||
import qualified System.Nix.Internal.Base as B
|
import qualified System.Nix.Internal.Base as B
|
||||||
import qualified System.Nix.Internal.SriHash as SRI
|
import qualified System.Nix.Internal.SriHash as SRI
|
||||||
|
@ -5,10 +5,13 @@
|
|||||||
module System.Nix.Internal.Base where
|
module System.Nix.Internal.Base where
|
||||||
|
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.ByteString.Base16 as Bytes.Base16
|
||||||
import qualified Data.Text.Encoding as T
|
import qualified System.Nix.Base32 as Bytes.Base32 -- Nix has own Base32 encoding
|
||||||
|
import qualified Data.ByteString.Base64 as Bytes.Base64
|
||||||
|
import Data.Text (Text)
|
||||||
|
import qualified Data.Text.Encoding as Text
|
||||||
import Data.Coerce (coerce)
|
import Data.Coerce (coerce)
|
||||||
import qualified System.Nix.Internal.Old as O
|
import qualified System.Nix.Internal.Old as Old
|
||||||
|
|
||||||
|
|
||||||
-- | Constructors to indicate the base encodings
|
-- | Constructors to indicate the base encodings
|
||||||
@ -19,23 +22,23 @@ data BaseEncoding
|
|||||||
| Base64
|
| Base64
|
||||||
|
|
||||||
|
|
||||||
-- | Take BaseEncoding type of the output -> take the Digeest as input -> encode O.Digest
|
-- | Take BaseEncoding type of the output -> take the Digeest as input -> encode Digest
|
||||||
encodeInBase :: BaseEncoding -> O.Digest a -> T.Text
|
encodeInBytes :: BaseEncoding -> Old.Digest a -> Text
|
||||||
encodeInBase Base16 = T.decodeUtf8 . Base16.encode . coerce
|
encodeInBytes Base16 = Text.decodeUtf8 . Bytes.Base16.encode . coerce
|
||||||
encodeInBase Base32 = Base32.encode . coerce
|
encodeInBytes Base32 = Text.decodeUtf8 . Bytes.Base32.encode . coerce
|
||||||
encodeInBase Base64 = T.decodeUtf8 . Base64.encode . coerce
|
encodeInBytes Base64 = Text.decodeUtf8 . Bytes.Base64.encode . coerce
|
||||||
|
|
||||||
|
|
||||||
-- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into O.Digest
|
-- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into Digest
|
||||||
decodeBase :: BaseEncoding -> T.Text -> Either String (O.Digest a)
|
decodeBase :: BaseEncoding -> Text -> Either String (Old.Digest a)
|
||||||
#if MIN_VERSION_base16_bytestring(1,0,0)
|
#if MIN_VERSION_base16_bytestring(1,0,0)
|
||||||
decodeBase Base16 = fmap O.Digest . Base16.decode . T.encodeUtf8
|
decodeBase Base16 = fmap Old.Digest . Bytes.Base16.decode . Text.encodeUtf8
|
||||||
#else
|
#else
|
||||||
decodeBase Base16 = lDecode -- this tacit sugar simply makes GHC pleased with number of args
|
decodeBase Base16 = lDecode -- this tacit sugar simply makes GHC pleased with number of args
|
||||||
where
|
where
|
||||||
lDecode t = case Base16.decode (T.encodeUtf8 t) of
|
lDecode t = case Base16.decode (Text.encodeUtf8 t) of
|
||||||
(x, "") -> Right $ O.Digest x
|
(x, "") -> Right $ Old.Digest x
|
||||||
_ -> Left $ "Unable to decode base16 string" <> T.unpack t
|
_ -> Left $ "Unable to decode base16 string" <> Text.unpack t
|
||||||
#endif
|
#endif
|
||||||
decodeBase Base32 = fmap O.Digest . Base32.decode
|
decodeBase Base32 = fmap Old.Digest . Bytes.Base32.decode . Text.encodeUtf8
|
||||||
decodeBase Base64 = fmap O.Digest . Base64.decode . T.encodeUtf8
|
decodeBase Base64 = fmap Old.Digest . Bytes.Base64.decode . Text.encodeUtf8
|
||||||
|
@ -1,27 +1,40 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
-- | Nix has Nix-specific Base32 encoding.
|
||||||
|
-- Stick to using the Text. But lib provides ByteString (Bytes) just for unsafe optimization case.
|
||||||
|
|
||||||
module System.Nix.Internal.Base32 where
|
module System.Nix.Internal.Base32 where
|
||||||
|
|
||||||
import Data.ByteString (ByteString)
|
|
||||||
import Data.Bits (shiftR)
|
import Data.Maybe
|
||||||
import Data.List (unfoldr)
|
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
import qualified Data.Text as Text
|
||||||
|
import qualified Text.Builder
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
|
import qualified Data.ByteString as Bytes
|
||||||
|
import qualified Data.ByteString.Char8 as Bytes.Char8
|
||||||
|
import qualified Data.ByteString.Internal as Bytes (c2w, unpackChars)
|
||||||
|
import Data.Bits (shiftR)
|
||||||
import Data.Vector (Vector)
|
import Data.Vector (Vector)
|
||||||
|
import qualified Data.Vector as Vector
|
||||||
import Data.Word (Word8)
|
import Data.Word (Word8)
|
||||||
import Numeric (readInt)
|
import Numeric (readInt)
|
||||||
|
|
||||||
import qualified Data.Maybe
|
|
||||||
import qualified Data.ByteString
|
|
||||||
import qualified Data.ByteString.Char8
|
|
||||||
import qualified Data.Text
|
|
||||||
import qualified Data.Vector
|
|
||||||
|
|
||||||
-- Special Nix Base 32 dictinary with omitted: {E,O,U,T}
|
-- Special Nix Base 32 dictinary with omitted: {E,O,U,T}
|
||||||
dictNixBase32 :: Vector Char
|
dictNixBase32 :: Vector Char
|
||||||
dictNixBase32 = Data.Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz"
|
dictNixBase32 = Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz"
|
||||||
|
dictNixBase32Bytes :: Vector Word8
|
||||||
|
dictNixBase32Bytes = Vector.fromList (fmap Bytes.c2w "0123456789abcdfghijklmnpqrsvwxyz")
|
||||||
|
|
||||||
-- | Encode a 'BS.ByteString' in Nix's base32 encoding
|
type NixBase32 = Text
|
||||||
encode :: ByteString -> Text
|
type NixBase32Bytes = ByteString
|
||||||
encode c = Data.Text.pack $ map char32 [nChar - 1, nChar - 2 .. 0]
|
|
||||||
|
-- | Encode a Text in Nix-specific Base32 encoding
|
||||||
|
encode :: Text -> NixBase32
|
||||||
|
encode text = Text.pack $ fmap char32 [nChar - 1, nChar - 2 .. 0]
|
||||||
where
|
where
|
||||||
-- Each base32 character gives us 5 bits of information, while
|
-- Each base32 character gives us 5 bits of information, while
|
||||||
-- each byte gives is 8. Because 'div' rounds down, we need to add
|
-- each byte gives is 8. Because 'div' rounds down, we need to add
|
||||||
@ -30,60 +43,135 @@ encode c = Data.Text.pack $ map char32 [nChar - 1, nChar - 2 .. 0]
|
|||||||
-- bytestring to cover for the case where the number of bits is
|
-- bytestring to cover for the case where the number of bits is
|
||||||
-- already a factor of 5. Thus, the + 1 outside of the 'div' and
|
-- already a factor of 5. Thus, the + 1 outside of the 'div' and
|
||||||
-- the - 1 inside of it.
|
-- the - 1 inside of it.
|
||||||
nChar = fromIntegral $ succ $ (Data.ByteString.length c * 8 - 1) `div` 5
|
nChar = fromIntegral $ succ $ (Text.length text * 8 - 1) `div` 5
|
||||||
|
|
||||||
byte = Data.ByteString.index c . fromIntegral
|
char = Text.index text . fromIntegral
|
||||||
|
|
||||||
-- May need to switch to a more efficient calculation at some
|
-- May need to switch to a more efficient calculation at some
|
||||||
-- point.
|
-- point.
|
||||||
bAsInteger :: Integer
|
bAsInteger :: Integer
|
||||||
bAsInteger = sum [fromIntegral (byte j) * (256 ^ j)
|
bAsInteger = sum [fromIntegral (char j) * (256 ^ j)
|
||||||
| j <- [0 .. Data.ByteString.length c - 1]
|
| j <- [0 .. Text.length text - 1]
|
||||||
]
|
]
|
||||||
|
|
||||||
char32 :: Integer -> Char
|
char32 :: Integer -> Char
|
||||||
char32 i = dictNixBase32 Data.Vector.! digitInd
|
char32 i = dictNixBase32 Vector.! digitInd
|
||||||
where
|
where
|
||||||
digitInd = fromIntegral $
|
digitInd = fromIntegral $
|
||||||
bAsInteger
|
bAsInteger
|
||||||
`div` (32^i)
|
`div` (32^i)
|
||||||
`mod` 32
|
`mod` 32
|
||||||
|
|
||||||
-- | Decode Nix's base32 encoded text
|
-- | Encode a ByteString in Nix-specific Base32 encoding
|
||||||
decode :: Text -> Either String ByteString
|
encodeBytes :: ByteString -> NixBase32Bytes
|
||||||
|
encodeBytes bytes = Bytes.pack $ fmap char32 [nChar - 1, nChar - 2 .. 0]
|
||||||
|
where
|
||||||
|
-- Each base32 character gives us 5 bits of information, while
|
||||||
|
-- each byte gives is 8. Because 'div' rounds down, we need to add
|
||||||
|
-- one extra character to the result, and because of that extra 1
|
||||||
|
-- we need to subtract one from the number of bits in the
|
||||||
|
-- bytestring to cover for the case where the number of bits is
|
||||||
|
-- already a factor of 5. Thus, the + 1 outside of the 'div' and
|
||||||
|
-- the - 1 inside of it.
|
||||||
|
nChar = fromIntegral $ succ $ (Bytes.length bytes * 8 - 1) `div` 5
|
||||||
|
|
||||||
|
char32 :: Integer -> Word8
|
||||||
|
char32 i = dictNixBase32Bytes Vector.! digitInd
|
||||||
|
where
|
||||||
|
digitInd = fromIntegral $
|
||||||
|
bAsInteger
|
||||||
|
`div` (32^i)
|
||||||
|
`mod` 32
|
||||||
|
|
||||||
|
-- May need to switch to a more efficient calculation at some
|
||||||
|
-- point.
|
||||||
|
bAsInteger :: Integer
|
||||||
|
bAsInteger = sum [fromIntegral (byte j) * (256 ^ j)
|
||||||
|
| j <- [0 .. Bytes.length bytes - 1]
|
||||||
|
]
|
||||||
|
byte = Bytes.index bytes . fromIntegral
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- | Decode from Nix-specific Base32 encoding.
|
||||||
|
decode :: NixBase32 -> Either String Text
|
||||||
decode what =
|
decode what =
|
||||||
if Data.Text.all (`elem` dictNixBase32) what
|
if Text.all (`elem` dictNixBase32) what
|
||||||
then unsafeDecode what
|
then unsafeDecode what
|
||||||
else Left "Invalid base32 string"
|
else Left "Invalid Nix-Base32 string"
|
||||||
|
|
||||||
-- | Decode Nix's base32 encoded text
|
-- | Decode from Nix-specific Base32 encoding.
|
||||||
-- Doesn't check if all elements match `dictNixBase32`
|
decodeToBytes :: NixBase32Bytes -> Either String ByteString
|
||||||
unsafeDecode :: Text -> Either String ByteString
|
decodeToBytes what =
|
||||||
|
if Bytes.all (`elem` dictNixBase32Bytes) what
|
||||||
|
then unsafeDecodeToBytes what
|
||||||
|
else Left "Invalid Nix-Base32 string"
|
||||||
|
|
||||||
|
-- | Fast decoding from Nix-specific Base32 encoding.
|
||||||
|
-- Doesn't check if all elements match `dictNixBase32`.
|
||||||
|
unsafeDecode :: NixBase32 -> Either String Text
|
||||||
unsafeDecode what =
|
unsafeDecode what =
|
||||||
case readInt 32
|
-- 2021-01-31: NOTE: `text-show` has a faster version of this implementation,
|
||||||
(`elem` dictNixBase32)
|
-- because here Text -> String happens for readInt.
|
||||||
(\c -> Data.Maybe.fromMaybe (error "character not in dictNixBase32")
|
case readIntegerIntoString $ Text.unpack what of
|
||||||
$ Data.Vector.findIndex (==c) dictNixBase32)
|
[(i, _)] -> Right $ padded $ integerToText i
|
||||||
(Data.Text.unpack what)
|
x -> Left $ "Can't decode `readInt` returned : " <> show x
|
||||||
of
|
where
|
||||||
[(i, _)] -> Right $ padded $ integerToBS i
|
readIntegerIntoString :: (ReadS Integer)
|
||||||
x -> Left $ "Can't decode: readInt returned " ++ show x
|
readIntegerIntoString =
|
||||||
where
|
readInt
|
||||||
padded x
|
32
|
||||||
| Data.ByteString.length x < decLen = x `Data.ByteString.append` bstr
|
(`elem` dictNixBase32)
|
||||||
| otherwise = x
|
(\ c -> Data.Maybe.fromMaybe
|
||||||
where
|
(error "character not in dictNixBase32")
|
||||||
bstr = Data.ByteString.Char8.pack $ take (decLen - Data.ByteString.length x) (cycle "\NUL")
|
$ Vector.findIndex (== c) dictNixBase32)
|
||||||
|
|
||||||
decLen = Data.Text.length what * 5 `div` 8
|
padded :: (Text -> Text)
|
||||||
|
padded x
|
||||||
|
| Text.length x < decLen = x <> bstr
|
||||||
|
| otherwise = x
|
||||||
|
where
|
||||||
|
bstr = Text.pack $ take (decLen - Text.length x) (cycle "\NUL")
|
||||||
|
decLen = Text.length what * 5 `div` 8
|
||||||
|
|
||||||
-- | Encode an Integer to a bytestring
|
-- | Fast decoding from Nix-specific Base32 encoding.
|
||||||
|
-- Doesn't check if all elements match `dictNixBase32`.
|
||||||
|
unsafeDecodeToBytes :: NixBase32Bytes -> Either String ByteString
|
||||||
|
unsafeDecodeToBytes what =
|
||||||
|
case readIntegerIntoString $ Bytes.unpackChars what of
|
||||||
|
[(i, _)] -> Right $ padded $ integerToBytes i
|
||||||
|
x -> Left $ "Can't decode `readInt` returned : " <> show x
|
||||||
|
where
|
||||||
|
readIntegerIntoString :: (ReadS Integer)
|
||||||
|
readIntegerIntoString =
|
||||||
|
readInt
|
||||||
|
32
|
||||||
|
-- 2021-01-30: NOTE: Use of `readInt` that requires `Char -> Bytestring` convertion a bit defeats a ByteString pipeline.
|
||||||
|
-- Using dictNixBase32 with Char because of it
|
||||||
|
(`elem` dictNixBase32)
|
||||||
|
(\ c -> Data.Maybe.fromMaybe
|
||||||
|
(error "character not in dictNixBase32")
|
||||||
|
$ Vector.findIndex (== c) dictNixBase32)
|
||||||
|
padded x
|
||||||
|
| Bytes.length x < decLen = x <> bstr
|
||||||
|
| otherwise = x
|
||||||
|
where
|
||||||
|
bstr = Bytes.Char8.pack $ take (decLen - Bytes.length x) (cycle "\NUL")
|
||||||
|
decLen = Bytes.length what * 5 `div` 8
|
||||||
|
|
||||||
|
|
||||||
|
-- | Encode an Integer to a Text
|
||||||
|
integerToText :: Integer -> Text
|
||||||
|
integerToText = Text.Builder.run . Text.Builder.decimal
|
||||||
|
|
||||||
|
|
||||||
|
-- | Encode an Integer to a ByteString
|
||||||
-- Similar to Data.Base32String (integerToBS) without `reverse`
|
-- Similar to Data.Base32String (integerToBS) without `reverse`
|
||||||
integerToBS :: Integer -> ByteString
|
integerToBytes :: Integer -> ByteString
|
||||||
integerToBS 0 = Data.ByteString.pack [0]
|
integerToBytes i
|
||||||
integerToBS i
|
| i > 0 = Bytes.unfoldr f i
|
||||||
| i > 0 = Data.ByteString.pack $ unfoldr f i
|
| i == 0 = Bytes.empty
|
||||||
| otherwise = error "integerToBS not defined for negative values"
|
| otherwise = error "integerToBytes not defined for negative values."
|
||||||
where
|
where
|
||||||
f 0 = Nothing
|
f 0 = Nothing
|
||||||
f x = Just (fromInteger x :: Word8, x `shiftR` 8)
|
f x = Just (fromInteger x :: Word8, x `shiftR` 8)
|
||||||
|
@ -15,32 +15,18 @@ Description : Cryptographic hashing interface for hnix-store, on top
|
|||||||
|
|
||||||
module System.Nix.Internal.Old where
|
module System.Nix.Internal.Old where
|
||||||
|
|
||||||
|
|
||||||
import qualified "cryptohash-md5" Crypto.Hash.MD5 as MD5
|
import qualified "cryptohash-md5" Crypto.Hash.MD5 as MD5
|
||||||
import qualified "cryptohash-sha1" Crypto.Hash.SHA1 as SHA1
|
import qualified "cryptohash-sha1" Crypto.Hash.SHA1 as SHA1
|
||||||
import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256
|
import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256
|
||||||
import qualified "cryptohash-sha512" Crypto.Hash.SHA512 as SHA512
|
import qualified "cryptohash-sha512" Crypto.Hash.SHA512 as SHA512
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as Bytes
|
||||||
import qualified Data.ByteString.Base16 as Base16
|
import qualified Data.ByteString.Lazy as LazyBytes
|
||||||
import qualified System.Nix.Base32 as Base32 -- Nix has own Base32 encoding
|
|
||||||
import qualified Data.ByteString.Base64 as Base64
|
|
||||||
import Data.Bits (xor)
|
|
||||||
import qualified Data.ByteString.Lazy as BSL
|
|
||||||
import qualified Data.Hashable as DataHashable
|
import qualified Data.Hashable as DataHashable
|
||||||
import Data.List (find, foldl')
|
import Data.List (foldl')
|
||||||
import Data.Proxy (Proxy(Proxy))
|
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import GHC.TypeLits (Nat)
|
||||||
import qualified Data.Text.Encoding as T
|
|
||||||
import Data.Word (Word8)
|
|
||||||
import GHC.TypeLits (Nat, KnownNat, natVal)
|
|
||||||
import Data.Coerce (coerce)
|
|
||||||
|
|
||||||
-- | Constructors to indicate the base encodings
|
|
||||||
data BaseEncoding
|
|
||||||
= Base16
|
|
||||||
| Base32
|
|
||||||
-- ^ Nix has a special map of Base32 encoding
|
|
||||||
| Base64
|
|
||||||
|
|
||||||
-- | The universe of supported hash algorithms.
|
-- | The universe of supported hash algorithms.
|
||||||
--
|
--
|
||||||
@ -73,10 +59,8 @@ instance HashProperties HashAlgorithm
|
|||||||
|
|
||||||
-- | The result of running a 'HashAlgorithm'.
|
-- | The result of running a 'HashAlgorithm'.
|
||||||
newtype Digest (a :: HashAlgorithm) =
|
newtype Digest (a :: HashAlgorithm) =
|
||||||
Digest BS.ByteString deriving (Eq, Ord, DataHashable.Hashable)
|
Digest Bytes.ByteString deriving (Eq, Ord, DataHashable.Hashable)
|
||||||
|
|
||||||
instance Show (Digest a) where
|
|
||||||
show = ("Digest " <>) . show . encodeInBase Base32
|
|
||||||
|
|
||||||
-- | The primitive interface for incremental hashing for a given
|
-- | The primitive interface for incremental hashing for a given
|
||||||
-- 'HashAlgorithm'. Every 'HashAlgorithm' should have an instance.
|
-- 'HashAlgorithm'. Every 'HashAlgorithm' should have an instance.
|
||||||
@ -87,7 +71,7 @@ class ValidAlgo (a :: HashAlgorithm) where
|
|||||||
-- | Start building a new hash.
|
-- | Start building a new hash.
|
||||||
initialize :: AlgoCtx a
|
initialize :: AlgoCtx a
|
||||||
-- | Append a 'BS.ByteString' to the overall contents to be hashed.
|
-- | Append a 'BS.ByteString' to the overall contents to be hashed.
|
||||||
update :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
|
update :: AlgoCtx a -> Bytes.ByteString -> AlgoCtx a
|
||||||
-- | Finish hashing and generate the output.
|
-- | Finish hashing and generate the output.
|
||||||
finalize :: AlgoCtx a -> Digest a
|
finalize :: AlgoCtx a -> Digest a
|
||||||
|
|
||||||
@ -113,89 +97,25 @@ instance NamedAlgo 'SHA512 where
|
|||||||
algoName = "sha512"
|
algoName = "sha512"
|
||||||
hashSize = 64
|
hashSize = 64
|
||||||
|
|
||||||
-- | A digest whose 'NamedAlgo' is not known at compile time.
|
|
||||||
data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (Digest a)
|
|
||||||
|
|
||||||
instance Show SomeNamedDigest where
|
-- | Hash an entire (strict) 'ByteString' as a single call.
|
||||||
show (SomeDigest (digest :: Digest hashType)) = T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeInBase Base32 digest
|
|
||||||
|
|
||||||
mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest
|
|
||||||
mkNamedDigest name sriHash =
|
|
||||||
let (sriName, h) = T.breakOnEnd "-" sriHash in
|
|
||||||
if sriName == "" || sriName == (name <> "-")
|
|
||||||
then mkDigest h
|
|
||||||
else Left $ T.unpack $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name
|
|
||||||
where
|
|
||||||
mkDigest :: Text -> Either String SomeNamedDigest
|
|
||||||
mkDigest h =
|
|
||||||
maybe (Left $ "Unknown hash name: " <> T.unpack name) (`decodeToSomeDigest` h) maybeFindHashTypeByName
|
|
||||||
|
|
||||||
maybeFindHashTypeByName :: Maybe HashAlgorithm
|
|
||||||
maybeFindHashTypeByName = find (\ hashType -> canonicalHashName hashType == name ) [SHA256, MD5, SHA1, SHA512] -- SHA256 is the most used in Nix - so it matches first
|
|
||||||
|
|
||||||
decodeToSomeDigest :: HashAlgorithm -> Text -> Either String SomeNamedDigest
|
|
||||||
decodeToSomeDigest MD5 = fmap SomeDigest . goDecode @'MD5
|
|
||||||
decodeToSomeDigest SHA1 = fmap SomeDigest . goDecode @'SHA1
|
|
||||||
decodeToSomeDigest SHA256 = fmap SomeDigest . goDecode @'SHA256
|
|
||||||
decodeToSomeDigest SHA512 = fmap SomeDigest . goDecode @'SHA512
|
|
||||||
|
|
||||||
goDecode :: forall a . (NamedAlgo a, ValidAlgo a) => Text -> Either String (Digest a)
|
|
||||||
goDecode h =
|
|
||||||
-- Base encoding detected by comparing the lengths of the hash in Base to the canonical length of the demanded hash type
|
|
||||||
maybe left (`decodeBase` h) maybeFindBaseEncByLenMatch
|
|
||||||
where
|
|
||||||
left = Left $ T.unpack sriHash <> " is not a valid " <> T.unpack name <> " hash. Its length (" <> show (T.length h) <> ") does not match any of " <> show (canonicalLenIf <$> bases)
|
|
||||||
|
|
||||||
maybeFindBaseEncByLenMatch = find (\ enc -> T.length h == canonicalLenIf enc) bases
|
|
||||||
|
|
||||||
expectedHashLen = hashSize @a
|
|
||||||
|
|
||||||
canonicalLenIf Base16 = 2 * expectedHashLen
|
|
||||||
canonicalLenIf Base32 = ((8 * expectedHashLen - 1) `div` 5) + 1
|
|
||||||
canonicalLenIf Base64 = ((4 * expectedHashLen `div` 3) + 3) `div` 4 * 4
|
|
||||||
bases = [Base32, Base16, Base64] -- 32 is the most used in Nix - so the first match
|
|
||||||
|
|
||||||
|
|
||||||
-- | Hash an entire (strict) 'BS.ByteString' as a single call.
|
|
||||||
--
|
--
|
||||||
-- For example:
|
-- For example:
|
||||||
-- > let d = hash "Hello, sha-256!" :: Digest SHA256
|
-- > let d = hash "Hello, sha-256!" :: Digest SHA256
|
||||||
-- or
|
-- or
|
||||||
-- > :set -XTypeApplications
|
-- > :set -XTypeApplications
|
||||||
-- > let d = hash @SHA256 "Hello, sha-256!"
|
-- > let d = hash @SHA256 "Hello, sha-256!"
|
||||||
hash :: forall a.ValidAlgo a => BS.ByteString -> Digest a
|
hash :: forall a.ValidAlgo a => Bytes.ByteString -> Digest a
|
||||||
hash bs =
|
hash bs =
|
||||||
finalize $ update @a (initialize @a) bs
|
finalize $ update @a (initialize @a) bs
|
||||||
|
|
||||||
-- | Hash an entire (lazy) 'BSL.ByteString' as a single call.
|
-- | Hash an entire (lazy) 'ByteString' as a single call.
|
||||||
--
|
--
|
||||||
-- Use is the same as for 'hash'. This runs in constant space, but
|
-- Use is the same as for 'hash'. This runs in constant space, but
|
||||||
-- forces the entire bytestring.
|
-- forces the entire bytestring.
|
||||||
hashLazy :: forall a.ValidAlgo a => BSL.ByteString -> Digest a
|
hashLazy :: forall a.ValidAlgo a => LazyBytes.ByteString -> Digest a
|
||||||
hashLazy bsl =
|
hashLazy bsl =
|
||||||
finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl)
|
finalize $ foldl' (update @a) (initialize @a) (LazyBytes.toChunks bsl)
|
||||||
|
|
||||||
|
|
||||||
-- | Take BaseEncoding type of the output -> take the Digeest as input -> encode Digest
|
|
||||||
encodeInBase :: BaseEncoding -> Digest a -> T.Text
|
|
||||||
encodeInBase Base16 = T.decodeUtf8 . Base16.encode . coerce
|
|
||||||
encodeInBase Base32 = Base32.encode . coerce
|
|
||||||
encodeInBase Base64 = T.decodeUtf8 . Base64.encode . coerce
|
|
||||||
|
|
||||||
|
|
||||||
-- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into Digest
|
|
||||||
decodeBase :: BaseEncoding -> T.Text -> Either String (Digest a)
|
|
||||||
#if MIN_VERSION_base16_bytestring(1,0,0)
|
|
||||||
decodeBase Base16 = fmap Digest . Base16.decode . T.encodeUtf8
|
|
||||||
#else
|
|
||||||
decodeBase Base16 = lDecode -- this tacit sugar simply makes GHC pleased with number of args
|
|
||||||
where
|
|
||||||
lDecode t = case Base16.decode (T.encodeUtf8 t) of
|
|
||||||
(x, "") -> Right $ Digest x
|
|
||||||
_ -> Left $ "Unable to decode base16 string" <> T.unpack t
|
|
||||||
#endif
|
|
||||||
decodeBase Base32 = fmap Digest . Base32.decode
|
|
||||||
decodeBase Base64 = fmap Digest . Base64.decode . T.encodeUtf8
|
|
||||||
|
|
||||||
|
|
||||||
-- | Uses "Crypto.Hash.MD5" from cryptohash-md5.
|
-- | Uses "Crypto.Hash.MD5" from cryptohash-md5.
|
||||||
@ -225,36 +145,3 @@ instance ValidAlgo 'SHA512 where
|
|||||||
initialize = SHA512.init
|
initialize = SHA512.init
|
||||||
update = SHA512.update
|
update = SHA512.update
|
||||||
finalize = Digest . SHA512.finalize
|
finalize = Digest . SHA512.finalize
|
||||||
|
|
||||||
-- | Reuses the underlying 'ValidAlgo' instance, but does a
|
|
||||||
-- 'truncateDigest' at the end.
|
|
||||||
instance (ValidAlgo a, KnownNat n) => ValidAlgo ('Truncated n a) where
|
|
||||||
type AlgoCtx ('Truncated n a) = AlgoCtx a
|
|
||||||
initialize = initialize @a
|
|
||||||
update = update @a
|
|
||||||
finalize = truncateDigest @n . finalize @a
|
|
||||||
|
|
||||||
-- | Bytewise truncation of a 'Digest'.
|
|
||||||
--
|
|
||||||
-- When truncation length is greater than the length of the bytestring
|
|
||||||
-- but less than twice the bytestring length, truncation splits the
|
|
||||||
-- 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.(KnownNat n) => Digest a -> Digest ('Truncated n a)
|
|
||||||
truncateDigest (Digest c) =
|
|
||||||
Digest $ BS.pack $ map truncOutputByte [0.. n-1]
|
|
||||||
where
|
|
||||||
n = fromIntegral $ natVal (Proxy @n)
|
|
||||||
|
|
||||||
truncOutputByte :: Int -> Word8
|
|
||||||
truncOutputByte i = foldl' (aux i) 0 [0 .. BS.length c - 1]
|
|
||||||
|
|
||||||
inputByte :: Int -> Word8
|
|
||||||
inputByte j = BS.index c (fromIntegral j)
|
|
||||||
|
|
||||||
aux :: Int -> Word8 -> Int -> Word8
|
|
||||||
aux i x j = if j `mod` fromIntegral n == fromIntegral i
|
|
||||||
then xor x (inputByte $ fromIntegral j)
|
|
||||||
else x
|
|
||||||
|
@ -1,42 +1,45 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
|
||||||
module System.Nix.Internal.SriHash where
|
module System.Nix.Internal.SriHash where
|
||||||
|
|
||||||
import qualified System.Nix.Internal.Old as O
|
import Data.Text (Text)
|
||||||
import qualified System.Nix.Internal.Base as B
|
import qualified Data.Text as Text
|
||||||
|
import qualified System.Nix.Internal.Old as Old
|
||||||
|
import qualified System.Nix.Internal.Base as Base
|
||||||
|
import Data.Foldable (find)
|
||||||
|
|
||||||
mkNamedDigest :: Text -> Text -> Either String O.SomeNamedDigest
|
mkNamedDigest :: Text -> Text -> Either String (Old.Digest a)
|
||||||
mkNamedDigest name sriHash =
|
mkNamedDigest name sriHash =
|
||||||
let (sriName, h) = T.breakOnEnd "-" sriHash in
|
let (sriName, h) = Text.breakOnEnd "-" sriHash in
|
||||||
if sriName == "" || sriName == (name <> "-")
|
if sriName == "" || sriName == (name <> "-")
|
||||||
then mkDigest h
|
then mkDigest h
|
||||||
else Left $ T.unpack $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name
|
else Left $ Text.unpack $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name
|
||||||
where
|
where
|
||||||
mkDigest :: Text -> Either String O.SomeNamedDigest
|
mkDigest :: Text -> Either String (Old.Digest a)
|
||||||
mkDigest h =
|
mkDigest h =
|
||||||
maybe (Left $ "Unknown hash name: " <> T.unpack name) (`decodeToSomeDigest` h) maybeFindHashTypeByName
|
maybe (Left $ "Unknown hash name: " <> Text.unpack name) (`decodeToSomeDigest` h) maybeFindHashTypeByName
|
||||||
|
|
||||||
maybeFindHashTypeByName :: Maybe O.HashAlgorithm
|
maybeFindHashTypeByName :: Maybe Old.HashAlgorithm
|
||||||
maybeFindHashTypeByName = find (\ hashType -> O.canonicalHashName hashType == name ) [O.SHA256, O.MD5, O.SHA1, O.SHA512] -- SHA256 is the most used in Nix - so it matches first
|
maybeFindHashTypeByName = find (\ hashType -> Old.canonicalHashName hashType == name ) [Old.SHA256, Old.MD5, Old.SHA1, Old.SHA512] -- SHA256 is the most used in Nix - so it matches first
|
||||||
|
|
||||||
decodeToSomeDigest :: O.HashAlgorithm -> Text -> Either String O.SomeNamedDigest
|
decodeToSomeDigest :: Old.HashAlgorithm -> Text -> Either String (Old.Digest a)
|
||||||
decodeToSomeDigest O.MD5 = fmap O.SomeDigest . goDecode @'O.MD5
|
decodeToSomeDigest a s = goDecode a s
|
||||||
decodeToSomeDigest O.SHA1 = fmap O.SomeDigest . goDecode @'O.SHA1
|
|
||||||
decodeToSomeDigest O.SHA256 = fmap O.SomeDigest . goDecode @'O.SHA256
|
|
||||||
decodeToSomeDigest O.SHA512 = fmap O.SomeDigest . goDecode @'O.SHA512
|
|
||||||
|
|
||||||
goDecode :: forall a . (O.NamedAlgo a, O.ValidAlgo a) => Text -> Either String (O.Digest a)
|
goDecode :: Old.HashAlgorithm -> Text -> Either String (Old.Digest a)
|
||||||
goDecode h =
|
goDecode a s =
|
||||||
-- Base encoding detected by comparing the lengths of the hash in Base to the canonical length of the demanded hash type
|
-- Base encoding detected by comparing the lengths of the hash in Base to the canonical length of the demanded hash type
|
||||||
maybe left (`B.decodeBase` h) maybeFindBaseEncByLenMatch
|
maybe left (`Base.decodeBase` s) maybeFindBaseEncByLenMatch
|
||||||
where
|
where
|
||||||
left = Left $ T.unpack sriHash <> " is not a valid " <> T.unpack name <> " hash. Its length (" <> show (T.length h) <> ") does not match any of " <> show (canonicalLenIf <$> bases)
|
left = Left $ Text.unpack sriHash <> " is not a valid " <> Text.unpack name <> " hash. Its length (" <> show (Text.length s) <> ") does not match any of " <> show (canonicalLenIf <$> bases)
|
||||||
|
|
||||||
maybeFindBaseEncByLenMatch = find (\ enc -> T.length h == canonicalLenIf enc) bases
|
maybeFindBaseEncByLenMatch = find (\ enc -> Text.length s == canonicalLenIf enc) bases
|
||||||
|
|
||||||
expectedHashLen = O.hashSize @a
|
expectedHashLen = Old.canonicalHashLen a
|
||||||
|
|
||||||
canonicalLenIf B.Base16 = 2 * expectedHashLen
|
canonicalLenIf Base.Base16 = 2 * expectedHashLen
|
||||||
canonicalLenIf B.Base32 = ((8 * expectedHashLen - 1) `div` 5) + 1
|
canonicalLenIf Base.Base32 = ((8 * expectedHashLen - 1) `div` 5) + 1
|
||||||
canonicalLenIf B.Base64 = ((4 * expectedHashLen `div` 3) + 3) `div` 4 * 4
|
canonicalLenIf Base.Base64 = ((4 * expectedHashLen `div` 3) + 3) `div` 4 * 4
|
||||||
bases = [B.Base32, B.Base16, B.Base64] -- 32 is the most used in Nix - so the first match
|
bases = [Base.Base32, Base.Base16, Base.Base64] -- 32 is the most used in Nix - so the first match
|
||||||
|
@ -8,32 +8,40 @@ Description : Representation of Nix store paths.
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
{-# LANGUAGE TypeInType #-} -- Needed for GHC 8.4.4 for some reason
|
{-# LANGUAGE TypeInType #-} -- Needed for GHC 8.4.4 for some reason
|
||||||
|
|
||||||
|
|
||||||
module System.Nix.Internal.StorePath where
|
module System.Nix.Internal.StorePath where
|
||||||
|
|
||||||
|
|
||||||
import System.Nix.Hash
|
import System.Nix.Hash
|
||||||
( HashAlgorithm(Truncated, SHA256)
|
( HashAlgorithm (SHA256)
|
||||||
, Digest
|
, Digest
|
||||||
, BaseEncoding(..)
|
, BaseEncoding(..)
|
||||||
, encodeInBase
|
, encodeInBase
|
||||||
, decodeBase
|
, decodeBase
|
||||||
, SomeNamedDigest
|
|
||||||
)
|
)
|
||||||
|
import System.Nix.Internal.Old as Old
|
||||||
|
import System.Nix.Internal.TruncatedHash as TruncatedHash
|
||||||
import System.Nix.Internal.Base32 (dictNixBase32)
|
import System.Nix.Internal.Base32 (dictNixBase32)
|
||||||
|
|
||||||
import Data.Bool (bool)
|
import Data.Bool (bool)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Text.Encoding (encodeUtf8)
|
import qualified Data.Text as Text
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text.Encoding as Text (encodeUtf8)
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as ByteString
|
||||||
import qualified Data.ByteString.Char8 as BC
|
import qualified Data.ByteString.Char8 as ByteString.Char8
|
||||||
import qualified Data.Char
|
import qualified Data.Char as Char
|
||||||
import Data.Hashable (Hashable(..))
|
import Data.Hashable (Hashable(..))
|
||||||
import Data.HashSet (HashSet)
|
import Data.HashSet (HashSet)
|
||||||
|
|
||||||
import Data.Attoparsec.Text.Lazy (Parser, (<?>))
|
-- import Data.Attoparsec.Text.Lazy (Parser, (<?>))
|
||||||
|
import Data.Attoparsec.ByteString.Lazy (Parser, (<?>))
|
||||||
|
|
||||||
import qualified Data.Attoparsec.Text.Lazy
|
import qualified Data.Attoparsec.Text.Lazy as Parse.Text
|
||||||
import qualified System.FilePath
|
import qualified Data.Attoparsec.ByteString.Lazy as Parse.ByteString
|
||||||
|
import qualified Data.Attoparsec.ByteString.Char8 as Parse.ByteString (char)
|
||||||
|
import qualified System.FilePath as FilePath
|
||||||
|
|
||||||
-- | A path in a Nix store.
|
-- | A path in a Nix store.
|
||||||
--
|
--
|
||||||
@ -61,7 +69,7 @@ instance Hashable StorePath where
|
|||||||
s `hashWithSalt` storePathHash `hashWithSalt` storePathName
|
s `hashWithSalt` storePathHash `hashWithSalt` storePathName
|
||||||
|
|
||||||
instance Show StorePath where
|
instance Show StorePath where
|
||||||
show p = BC.unpack $ storePathToRawFilePath p
|
show p = ByteString.Char8.unpack $ storePathToRawFilePath p
|
||||||
|
|
||||||
-- | The name portion of a Nix path.
|
-- | The name portion of a Nix path.
|
||||||
--
|
--
|
||||||
@ -73,7 +81,7 @@ newtype StorePathName = StorePathName
|
|||||||
} deriving (Eq, Hashable, Ord)
|
} deriving (Eq, Hashable, Ord)
|
||||||
|
|
||||||
-- | The hash algorithm used for store path hashes.
|
-- | The hash algorithm used for store path hashes.
|
||||||
type StorePathHashAlgo = 'Truncated 20 'SHA256
|
type StorePathHashAlgo = 'Old.Truncated 20 'SHA256
|
||||||
|
|
||||||
-- | A set of 'StorePath's.
|
-- | A set of 'StorePath's.
|
||||||
type StorePathSet = HashSet StorePath
|
type StorePathSet = HashSet StorePath
|
||||||
@ -92,10 +100,10 @@ data ContentAddressableAddress
|
|||||||
-- addTextToStore. It is addressed according to a sha256sum of the
|
-- addTextToStore. It is addressed according to a sha256sum of the
|
||||||
-- file contents.
|
-- file contents.
|
||||||
Text !(Digest 'SHA256)
|
Text !(Digest 'SHA256)
|
||||||
| -- | The path was added to the store via makeFixedOutputPath or
|
-- | -- | The path was added to the store via makeFixedOutputPath or
|
||||||
-- addToStore. It is addressed according to some hash algorithm
|
-- -- addToStore. It is addressed according to some hash algorithm
|
||||||
-- applied to the nar serialization via some 'NarHashMode'.
|
-- -- applied to the nar serialization via some 'NarHashMode'.
|
||||||
Fixed !NarHashMode !SomeNamedDigest
|
-- Fixed !NarHashMode !(Digest 'HashAlgorithm)
|
||||||
|
|
||||||
-- | Schemes for hashing a Nix archive.
|
-- | Schemes for hashing a Nix archive.
|
||||||
--
|
--
|
||||||
@ -115,26 +123,26 @@ makeStorePathName n = case validStorePathName n of
|
|||||||
|
|
||||||
reasonInvalid :: Text -> String
|
reasonInvalid :: Text -> String
|
||||||
reasonInvalid n | n == "" = "Empty name"
|
reasonInvalid n | n == "" = "Empty name"
|
||||||
reasonInvalid n | (T.length n > 211) = "Path too long"
|
reasonInvalid n | (Text.length n > 211) = "Path too long"
|
||||||
reasonInvalid n | (T.head n == '.') = "Leading dot"
|
reasonInvalid n | (Text.head n == '.') = "Leading dot"
|
||||||
reasonInvalid _ | otherwise = "Invalid character"
|
reasonInvalid _ | otherwise = "Invalid character"
|
||||||
|
|
||||||
validStorePathName :: Text -> Bool
|
validStorePathName :: Text -> Bool
|
||||||
validStorePathName "" = False
|
validStorePathName "" = False
|
||||||
validStorePathName n = (T.length n <= 211)
|
validStorePathName n = (Text.length n <= 211)
|
||||||
&& T.head n /= '.'
|
&& Text.head n /= '.'
|
||||||
&& T.all validateStorePathNameChar n
|
&& Text.all validateStorePathNameChar n
|
||||||
|
|
||||||
validateStorePathNameChar :: Char -> Bool
|
validateStorePathNameChar :: Char -> Bool
|
||||||
validateStorePathNameChar c =
|
validateStorePathNameChar c =
|
||||||
bool
|
bool
|
||||||
False
|
False
|
||||||
(any ($ c)
|
(any ($ c)
|
||||||
[ Data.Char.isLower
|
[ Char.isLower
|
||||||
, Data.Char.isDigit
|
, Char.isDigit
|
||||||
, Data.Char.isUpper
|
, Char.isUpper
|
||||||
, (`elem` ("+-._?=" :: String))])
|
, (`elem` ("+-._?=" :: String))])
|
||||||
(Data.Char.isAscii c)
|
(Char.isAscii c)
|
||||||
|
|
||||||
-- | Copied from @RawFilePath@ in the @unix@ package, duplicated here
|
-- | Copied from @RawFilePath@ in the @unix@ package, duplicated here
|
||||||
-- to avoid the dependency.
|
-- to avoid the dependency.
|
||||||
@ -146,7 +154,7 @@ storePathToRawFilePath
|
|||||||
-> RawFilePath
|
-> RawFilePath
|
||||||
storePathToRawFilePath StorePath{..} = root <> "/" <> hashPart <> "-" <> name
|
storePathToRawFilePath StorePath{..} = root <> "/" <> hashPart <> "-" <> name
|
||||||
where
|
where
|
||||||
root = BC.pack storePathRoot
|
root = ByteString.Char8.pack storePathRoot
|
||||||
hashPart = encodeUtf8 $ encodeInBase Base32 storePathHash
|
hashPart = encodeUtf8 $ encodeInBase Base32 storePathHash
|
||||||
name = encodeUtf8 $ unStorePathName storePathName
|
name = encodeUtf8 $ unStorePathName storePathName
|
||||||
|
|
||||||
@ -154,35 +162,35 @@ storePathToRawFilePath StorePath{..} = root <> "/" <> hashPart <> "-" <> name
|
|||||||
storePathToFilePath
|
storePathToFilePath
|
||||||
:: StorePath
|
:: StorePath
|
||||||
-> FilePath
|
-> FilePath
|
||||||
storePathToFilePath = BC.unpack . storePathToRawFilePath
|
storePathToFilePath = ByteString.Char8.unpack . storePathToRawFilePath
|
||||||
|
|
||||||
-- | Render a 'StorePath' as a 'Text'.
|
-- | Render a 'StorePath' as a 'Text'.
|
||||||
storePathToText
|
storePathToText
|
||||||
:: StorePath
|
:: StorePath
|
||||||
-> Text
|
-> Text
|
||||||
storePathToText = T.pack . BC.unpack . storePathToRawFilePath
|
storePathToText = Text.pack . ByteString.Char8.unpack . storePathToRawFilePath
|
||||||
|
|
||||||
-- | Build `narinfo` suffix from `StorePath` which
|
-- | Build `narinfo` suffix from `StorePath` which
|
||||||
-- can be used to query binary caches.
|
-- can be used to query binary caches.
|
||||||
storePathToNarInfo
|
storePathToNarInfo
|
||||||
:: StorePath
|
:: StorePath
|
||||||
-> BC.ByteString
|
-> ByteString.Char8.ByteString
|
||||||
storePathToNarInfo StorePath{..} = storePathHashInNixBase <> ".narinfo"
|
storePathToNarInfo StorePath{..} = storePathHashInNixBase <> ".narinfo"
|
||||||
where
|
where
|
||||||
storePathHashInNixBase = encodeUtf8 $ encodeInBase Base32 storePathHash
|
storePathHashInNixBase = encodeUtf8 $ encodeInBase Base32 storePathHash
|
||||||
|
|
||||||
-- | Parse `StorePath` from `BC.ByteString`, checking
|
-- | Parse `StorePath` from `ByteString.Char8.ByteString`, checking
|
||||||
-- that store directory matches `expectedRoot`.
|
-- that store directory matches `expectedRoot`.
|
||||||
parsePath
|
parsePath
|
||||||
:: FilePath
|
:: FilePath
|
||||||
-> BC.ByteString
|
-> ByteString.Char8.ByteString
|
||||||
-> Either String StorePath
|
-> Either String StorePath
|
||||||
parsePath expectedRoot x =
|
parsePath expectedRoot x =
|
||||||
let
|
let
|
||||||
(rootDir, fname) = System.FilePath.splitFileName . BC.unpack $ x
|
(rootDir, fname) = FilePath.splitFileName . ByteString.Char8.unpack $ x
|
||||||
(digestPart, namePart) = T.breakOn "-" $ T.pack fname
|
(digestPart, namePart) = Text.breakOn "-" $ Text.pack fname
|
||||||
digest = decodeBase Base32 digestPart
|
digest = decodeBase Base32 digestPart
|
||||||
name = makeStorePathName . T.drop 1 $ namePart
|
name = makeStorePathName . Text.drop 1 $ namePart
|
||||||
--rootDir' = dropTrailingPathSeparator rootDir
|
--rootDir' = dropTrailingPathSeparator rootDir
|
||||||
-- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b
|
-- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b
|
||||||
rootDir' = init rootDir
|
rootDir' = init rootDir
|
||||||
@ -192,28 +200,29 @@ parsePath expectedRoot x =
|
|||||||
in
|
in
|
||||||
StorePath <$> digest <*> name <*> storeDir
|
StorePath <$> digest <*> name <*> storeDir
|
||||||
|
|
||||||
|
-- 2021-01-30: NOTE: Converted Text parser to ByteString. This currently uses Char8
|
||||||
pathParser :: FilePath -> Parser StorePath
|
pathParser :: FilePath -> Parser StorePath
|
||||||
pathParser expectedRoot = do
|
pathParser expectedRoot = do
|
||||||
_ <- Data.Attoparsec.Text.Lazy.string (T.pack expectedRoot)
|
_ <- Parse.ByteString.string (Text.pack expectedRoot)
|
||||||
<?> "Store root mismatch" -- e.g. /nix/store
|
<?> "Store root mismatch" -- e.g. /nix/store
|
||||||
|
|
||||||
_ <- Data.Attoparsec.Text.Lazy.char '/'
|
_ <- Parse.ByteString.char '/'
|
||||||
<?> "Expecting path separator"
|
<?> "Expecting path separator"
|
||||||
|
|
||||||
digest <- decodeBase Base32
|
digest <- decodeBase Base32
|
||||||
<$> Data.Attoparsec.Text.Lazy.takeWhile1 (`elem` dictNixBase32)
|
<$> Parse.ByteString.takeWhile1 (`elem` dictNixBase32)
|
||||||
<?> "Invalid Base32 part"
|
<?> "Invalid Base32 part"
|
||||||
|
|
||||||
_ <- Data.Attoparsec.Text.Lazy.char '-'
|
_ <- Parse.ByteString.char '-'
|
||||||
<?> "Expecting dash (path name separator)"
|
<?> "Expecting dash (path name separator)"
|
||||||
|
|
||||||
c0 <- Data.Attoparsec.Text.Lazy.satisfy (\c -> c /= '.' && validateStorePathNameChar c)
|
c0 <- Parse.ByteString.satisfy (\c -> c /= '.' && validateStorePathNameChar c)
|
||||||
<?> "Leading path name character is a dot or invalid character"
|
<?> "Leading path name character is a dot or invalid character"
|
||||||
|
|
||||||
rest <- Data.Attoparsec.Text.Lazy.takeWhile validateStorePathNameChar
|
rest <- Parse.ByteString.takeWhile validateStorePathNameChar
|
||||||
<?> "Path name contains invalid character"
|
<?> "Path name contains invalid character"
|
||||||
|
|
||||||
let name = makeStorePathName $ T.cons c0 rest
|
let name = makeStorePathName $ Text.cons c0 rest
|
||||||
|
|
||||||
either fail return
|
either fail return
|
||||||
$ StorePath <$> digest <*> name <*> pure expectedRoot
|
$ StorePath <$> digest <*> name <*> pure expectedRoot
|
||||||
|
@ -1,33 +0,0 @@
|
|||||||
|
|
||||||
module System.Nix.Internal.TruncatedHash where
|
|
||||||
|
|
||||||
-- data TruncatedHash = Truncated HashAlgorithm Integer
|
|
||||||
-- ^ The hash algorithm obtained by truncating the result of the
|
|
||||||
-- input 'HashAlgorithm' to the given number of bytes. See
|
|
||||||
-- 'truncateDigest' for a description of the truncation algorithm.
|
|
||||||
|
|
||||||
-- TODO: HNix really uses 1 type/length of truncation.
|
|
||||||
-- | Bytewise truncation of a 'Digest'.
|
|
||||||
--
|
|
||||||
-- When truncation length is greater than the length of the bytestring
|
|
||||||
-- but less than twice the bytestring length, truncation splits the
|
|
||||||
-- 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.(KnownNat n) => Digest a -> Digest ('Truncated n a)
|
|
||||||
-- truncateDigest (Digest c) =
|
|
||||||
-- Digest $ BS.pack $ map truncOutputByte [0.. n-1]
|
|
||||||
-- where
|
|
||||||
-- n = fromIntegral $ natVal (Proxy @n)
|
|
||||||
|
|
||||||
-- truncOutputByte :: Int -> Word8
|
|
||||||
-- truncOutputByte i = foldl' (aux i) 0 [0 .. BS.length c - 1]
|
|
||||||
|
|
||||||
-- inputByte :: Int -> Word8
|
|
||||||
-- inputByte j = BS.index c (fromIntegral j)
|
|
||||||
|
|
||||||
-- aux :: Int -> Word8 -> Int -> Word8
|
|
||||||
-- aux i x j = if j `mod` fromIntegral n == fromIntegral i
|
|
||||||
-- then xor x (inputByte $ fromIntegral j)
|
|
||||||
-- else x
|
|
61
hnix-store-core/src/System/Nix/Internal/TruncatedHash.hs
Normal file
61
hnix-store-core/src/System/Nix/Internal/TruncatedHash.hs
Normal file
@ -0,0 +1,61 @@
|
|||||||
|
{-# LANGUAGE PackageImports #-}
|
||||||
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
|
|
||||||
|
|
||||||
|
module System.Nix.Internal.TruncatedHash where
|
||||||
|
|
||||||
|
|
||||||
|
import qualified Data.ByteString as ByteString
|
||||||
|
import Data.Word (Word8)
|
||||||
|
import Data.Foldable (foldl')
|
||||||
|
import Data.Bits (xor)
|
||||||
|
import System.Nix.Internal.Old as Old
|
||||||
|
import Data.Bool (bool)
|
||||||
|
import GHC.TypeLits (Nat, KnownNat, natVal)
|
||||||
|
import Data.Proxy (Proxy(Proxy))
|
||||||
|
|
||||||
|
-- TODO: HNix really uses 1 type/length of truncation.
|
||||||
|
|
||||||
|
-- data TruncatedHash = Truncated Nat Old.HashAlgorithm
|
||||||
|
|
||||||
|
-- | Reuses the underlying 'ValidAlgo' instance, but does a
|
||||||
|
-- 'truncateDigest' at the end.
|
||||||
|
instance (Old.ValidAlgo a, KnownNat n) => Old.ValidAlgo ('Old.Truncated n a) where
|
||||||
|
type AlgoCtx ('Old.Truncated n a) = AlgoCtx a
|
||||||
|
initialize = initialize @a
|
||||||
|
update = update @a
|
||||||
|
finalize = truncateDigest @n . finalize @a
|
||||||
|
|
||||||
|
-- | Bytewise truncation of a 'Digest'.
|
||||||
|
--
|
||||||
|
-- When truncation length is greater than the length of the bytestring
|
||||||
|
-- but less than twice the bytestring length, truncation splits the
|
||||||
|
-- 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.(KnownNat n) => Old.Digest a -> Old.Digest ('Old.Truncated n a)
|
||||||
|
truncateDigest (Old.Digest c) =
|
||||||
|
Old.Digest $ ByteString.pack $ map truncOutputByte [0.. n-1]
|
||||||
|
where
|
||||||
|
n = fromIntegral $ natVal (Proxy @n)
|
||||||
|
|
||||||
|
truncOutputByte :: Int -> Word8
|
||||||
|
truncOutputByte i = foldl' (aux i) 0 [0 .. ByteString.length c - 1]
|
||||||
|
|
||||||
|
inputByte :: Int -> Word8
|
||||||
|
inputByte j = ByteString.index c (fromIntegral j)
|
||||||
|
|
||||||
|
aux :: Int -> Word8 -> Int -> Word8
|
||||||
|
aux i x j = if j `mod` fromIntegral n == fromIntegral i
|
||||||
|
then xor x (inputByte $ fromIntegral j)
|
||||||
|
else x
|
194
hnix-store-core/src/System/Nix/Internal/Uncycle.hs
Normal file
194
hnix-store-core/src/System/Nix/Internal/Uncycle.hs
Normal file
@ -0,0 +1,194 @@
|
|||||||
|
{-|
|
||||||
|
Description : Cryptographic hashing interface for hnix-store, on top
|
||||||
|
of the cryptohash family of libraries.
|
||||||
|
-}
|
||||||
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE PackageImports #-}
|
||||||
|
|
||||||
|
module System.Nix.Internal.Uncycle where
|
||||||
|
|
||||||
|
|
||||||
|
import qualified "cryptohash-md5" Crypto.Hash.MD5 as MD5
|
||||||
|
import qualified "cryptohash-sha1" Crypto.Hash.SHA1 as SHA1
|
||||||
|
import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256
|
||||||
|
import qualified "cryptohash-sha512" Crypto.Hash.SHA512 as SHA512
|
||||||
|
import qualified Data.ByteString as BS
|
||||||
|
import Data.Bits (xor)
|
||||||
|
import qualified Data.ByteString.Lazy as BSL
|
||||||
|
import qualified Data.Hashable as DataHashable
|
||||||
|
import Data.List (foldl')
|
||||||
|
import Data.Proxy (Proxy(Proxy))
|
||||||
|
import Data.Text (Text)
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import Data.Word (Word8)
|
||||||
|
import GHC.TypeLits (Nat, KnownNat, natVal)
|
||||||
|
import qualified System.Nix.Internal.Base as B
|
||||||
|
import qualified System.Nix.Internal.Old as O
|
||||||
|
|
||||||
|
|
||||||
|
-- | The universe of supported hash algorithms.
|
||||||
|
--
|
||||||
|
-- Currently only intended for use at the type level.
|
||||||
|
data HashAlgorithm
|
||||||
|
= MD5
|
||||||
|
| SHA1
|
||||||
|
| SHA256
|
||||||
|
| SHA512
|
||||||
|
| Truncated Nat HashAlgorithm
|
||||||
|
-- ^ The hash algorithm obtained by truncating the result of the
|
||||||
|
-- input 'HashAlgorithm' to the given number of bytes. See
|
||||||
|
-- 'truncateDigest' for a description of the truncation algorithm.
|
||||||
|
|
||||||
|
class HashProperties a
|
||||||
|
where
|
||||||
|
canonicalHashName :: a -> Text
|
||||||
|
canonicalHashLen :: a -> Int
|
||||||
|
|
||||||
|
instance HashProperties HashAlgorithm
|
||||||
|
where
|
||||||
|
canonicalHashName SHA256 = "sha256" -- SHA256 is the most used in Nix - so it matches first
|
||||||
|
canonicalHashName MD5 = "md5"
|
||||||
|
canonicalHashName SHA1 = "sha1"
|
||||||
|
canonicalHashName SHA512 = "sha512"
|
||||||
|
canonicalHashLen SHA256 = 32
|
||||||
|
canonicalHashLen MD5 = 16
|
||||||
|
canonicalHashLen SHA1 = 20
|
||||||
|
canonicalHashLen SHA512 = 64
|
||||||
|
|
||||||
|
-- | The result of running a 'HashAlgorithm'.
|
||||||
|
newtype Digest (a :: HashAlgorithm) =
|
||||||
|
Digest BS.ByteString deriving (Eq, Ord, DataHashable.Hashable)
|
||||||
|
|
||||||
|
instance Show (Digest a) where
|
||||||
|
show = ("Digest " <>) . show . encodeInBase Base32
|
||||||
|
|
||||||
|
-- | The primitive interface for incremental hashing for a given
|
||||||
|
-- 'HashAlgorithm'. Every 'HashAlgorithm' should have an instance.
|
||||||
|
class ValidAlgo (a :: HashAlgorithm) where
|
||||||
|
-- | The incremental state for constructing a hash.
|
||||||
|
type AlgoCtx a
|
||||||
|
|
||||||
|
-- | Start building a new hash.
|
||||||
|
initialize :: AlgoCtx a
|
||||||
|
-- | Append a 'BS.ByteString' to the overall contents to be hashed.
|
||||||
|
update :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
|
||||||
|
-- | Finish hashing and generate the output.
|
||||||
|
finalize :: AlgoCtx a -> Digest a
|
||||||
|
|
||||||
|
-- | A 'HashAlgorithm' with a canonical name, for serialization
|
||||||
|
-- purposes (e.g. SRI hashes)
|
||||||
|
class ValidAlgo a => NamedAlgo (a :: HashAlgorithm) where
|
||||||
|
algoName :: Text
|
||||||
|
hashSize :: Int
|
||||||
|
|
||||||
|
instance NamedAlgo 'MD5 where
|
||||||
|
algoName = "md5"
|
||||||
|
hashSize = 16
|
||||||
|
|
||||||
|
instance NamedAlgo 'SHA1 where
|
||||||
|
algoName = "sha1"
|
||||||
|
hashSize = 20
|
||||||
|
|
||||||
|
instance NamedAlgo 'SHA256 where
|
||||||
|
algoName = "sha256"
|
||||||
|
hashSize = 32
|
||||||
|
|
||||||
|
instance NamedAlgo 'SHA512 where
|
||||||
|
algoName = "sha512"
|
||||||
|
hashSize = 64
|
||||||
|
|
||||||
|
-- | A digest whose 'NamedAlgo' is not known at compile time.
|
||||||
|
data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (Digest a)
|
||||||
|
|
||||||
|
instance Show SomeNamedDigest where
|
||||||
|
show (SomeDigest (digest :: Digest hashType)) = T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeInBase Base32 digest
|
||||||
|
|
||||||
|
|
||||||
|
-- | Hash an entire (strict) 'BS.ByteString' as a single call.
|
||||||
|
--
|
||||||
|
-- For example:
|
||||||
|
-- > let d = hash "Hello, sha-256!" :: Digest SHA256
|
||||||
|
-- or
|
||||||
|
-- > :set -XTypeApplications
|
||||||
|
-- > let d = hash @SHA256 "Hello, sha-256!"
|
||||||
|
hash :: forall a.ValidAlgo a => BS.ByteString -> Digest a
|
||||||
|
hash bs =
|
||||||
|
finalize $ update @a (initialize @a) bs
|
||||||
|
|
||||||
|
-- | Hash an entire (lazy) 'BSL.ByteString' as a single call.
|
||||||
|
--
|
||||||
|
-- Use is the same as for 'hash'. This runs in constant space, but
|
||||||
|
-- forces the entire bytestring.
|
||||||
|
hashLazy :: forall a.ValidAlgo a => BSL.ByteString -> Digest a
|
||||||
|
hashLazy bsl =
|
||||||
|
finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Uses "Crypto.Hash.MD5" from cryptohash-md5.
|
||||||
|
instance ValidAlgo 'MD5 where
|
||||||
|
type AlgoCtx 'MD5 = MD5.Ctx
|
||||||
|
initialize = MD5.init
|
||||||
|
update = MD5.update
|
||||||
|
finalize = Digest . MD5.finalize
|
||||||
|
|
||||||
|
-- | Uses "Crypto.Hash.SHA1" from cryptohash-sha1.
|
||||||
|
instance ValidAlgo 'SHA1 where
|
||||||
|
type AlgoCtx 'SHA1 = SHA1.Ctx
|
||||||
|
initialize = SHA1.init
|
||||||
|
update = SHA1.update
|
||||||
|
finalize = Digest . SHA1.finalize
|
||||||
|
|
||||||
|
-- | Uses "Crypto.Hash.SHA256" from cryptohash-sha256.
|
||||||
|
instance ValidAlgo 'SHA256 where
|
||||||
|
type AlgoCtx 'SHA256 = SHA256.Ctx
|
||||||
|
initialize = SHA256.init
|
||||||
|
update = SHA256.update
|
||||||
|
finalize = Digest . SHA256.finalize
|
||||||
|
|
||||||
|
-- | Uses "Crypto.Hash.SHA512" from cryptohash-sha512.
|
||||||
|
instance ValidAlgo 'SHA512 where
|
||||||
|
type AlgoCtx 'SHA512 = SHA512.Ctx
|
||||||
|
initialize = SHA512.init
|
||||||
|
update = SHA512.update
|
||||||
|
finalize = Digest . SHA512.finalize
|
||||||
|
|
||||||
|
-- | Reuses the underlying 'ValidAlgo' instance, but does a
|
||||||
|
-- 'truncateDigest' at the end.
|
||||||
|
instance (ValidAlgo a, KnownNat n) => ValidAlgo ('Truncated n a) where
|
||||||
|
type AlgoCtx ('Truncated n a) = AlgoCtx a
|
||||||
|
initialize = initialize @a
|
||||||
|
update = update @a
|
||||||
|
finalize = truncateDigest @n . finalize @a
|
||||||
|
|
||||||
|
-- | Bytewise truncation of a 'Digest'.
|
||||||
|
--
|
||||||
|
-- When truncation length is greater than the length of the bytestring
|
||||||
|
-- but less than twice the bytestring length, truncation splits the
|
||||||
|
-- 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.(KnownNat n) => Digest a -> Digest ('Truncated n a)
|
||||||
|
truncateDigest (Digest c) =
|
||||||
|
Digest $ BS.pack $ map truncOutputByte [0.. n-1]
|
||||||
|
where
|
||||||
|
n = fromIntegral $ natVal (Proxy @n)
|
||||||
|
|
||||||
|
truncOutputByte :: Int -> Word8
|
||||||
|
truncOutputByte i = foldl' (aux i) 0 [0 .. BS.length c - 1]
|
||||||
|
|
||||||
|
inputByte :: Int -> Word8
|
||||||
|
inputByte j = BS.index c (fromIntegral j)
|
||||||
|
|
||||||
|
aux :: Int -> Word8 -> Int -> Word8
|
||||||
|
aux i x j = if j `mod` fromIntegral n == fromIntegral i
|
||||||
|
then xor x (inputByte $ fromIntegral j)
|
||||||
|
else x
|
Loading…
Reference in New Issue
Block a user