diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index e9a71c4f..47b933a4 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -33,6 +33,7 @@ library build-depends: base >=4.10 && <5 , attoparsec , base16-bytestring + , base64-bytestring , bytestring , binary , bytestring @@ -40,6 +41,7 @@ library , cryptohash-md5 , cryptohash-sha1 , cryptohash-sha256 + , cryptohash-sha512 , directory , filepath , hashable diff --git a/hnix-store-core/src/System/Nix/Hash.hs b/hnix-store-core/src/System/Nix/Hash.hs index 332d99e3..3bb8c63a 100644 --- a/hnix-store-core/src/System/Nix/Hash.hs +++ b/hnix-store-core/src/System/Nix/Hash.hs @@ -10,6 +10,7 @@ module System.Nix.Hash ( , HNix.SomeNamedDigest(..) , HNix.hash , HNix.hashLazy + , HNix.mkNamedDigest , HNix.encodeBase32 , HNix.decodeBase32 diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 2c9d6d6a..9496770b 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -16,8 +16,10 @@ module System.Nix.Internal.Hash where import qualified Crypto.Hash.MD5 as MD5 import qualified Crypto.Hash.SHA1 as SHA1 import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Crypto.Hash.SHA512 as SHA512 import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Base64 as Base64 import Data.Bits (xor) import qualified Data.ByteString.Lazy as BSL import qualified Data.Hashable as DataHashable @@ -37,6 +39,7 @@ 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 @@ -44,7 +47,10 @@ data HashAlgorithm -- | The result of running a 'HashAlgorithm'. newtype Digest (a :: HashAlgorithm) = - Digest BS.ByteString deriving (Show, Eq, Ord, DataHashable.Hashable) + Digest BS.ByteString deriving (Eq, Ord, DataHashable.Hashable) + +instance Show (Digest a) where + show = ("Digest " ++) . show . encodeBase32 -- | The primitive interface for incremental hashing for a given -- 'HashAlgorithm'. Every 'HashAlgorithm' should have an instance. @@ -61,21 +67,60 @@ class ValidAlgo (a :: HashAlgorithm) where -- | A 'HashAlgorithm' with a canonical name, for serialization -- purposes (e.g. SRI hashes) -class NamedAlgo (a :: HashAlgorithm) where +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 sd = case sd of + SomeDigest (digest :: Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeBase32 digest + +mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest +mkNamedDigest name sriHash = + let (sriName, hash) = T.breakOnEnd "-" sriHash in + if sriName == "" || sriName == (name <> "-") + then mkDigest name hash + else Left $ T.unpack $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name + where + mkDigest name hash = case name of + "md5" -> SomeDigest <$> decode @'MD5 hash + "sha1" -> SomeDigest <$> decode @'SHA1 hash + "sha256" -> SomeDigest <$> decode @'SHA256 hash + "sha512" -> SomeDigest <$> decode @'SHA512 hash + _ -> Left $ "Unknown hash name: " ++ T.unpack name + decode :: forall a . (NamedAlgo a, ValidAlgo a) => Text -> Either String (Digest a) + decode hash + | size == base16Len = decodeBase16 hash + | size == base32Len = decodeBase32 hash + | size == base64Len = decodeBase64 hash + | otherwise = Left $ T.unpack sriHash ++ " is not a valid " ++ T.unpack name ++ " hash. Its length (" ++ show size ++ ") does not match any of " ++ show [base16Len, base32Len, base64Len] + where + size = T.length hash + hsize = hashSize @a + base16Len = hsize * 2 + base32Len = ((hsize * 8 - 1) `div` 5) + 1; + base64Len = ((4 * hsize `div` 3) + 3) `div` 4 * 4; + + -- | Hash an entire (strict) 'BS.ByteString' as a single call. -- -- For example: @@ -113,6 +158,16 @@ decodeBase16 t = case Base16.decode (T.encodeUtf8 t) of (x, "") -> Right $ Digest x _ -> Left $ "Unable to decode base16 string " ++ T.unpack t +-- | Encode a 'Digest' in hex. +encodeBase64 :: Digest a -> T.Text +encodeBase64 (Digest bs) = T.decodeUtf8 (Base64.encode bs) + +-- | Decode a 'Digest' in hex +decodeBase64 :: T.Text -> Either String (Digest a) +decodeBase64 t = case Base64.decode (T.encodeUtf8 t) of + Right x -> Right $ Digest x + Left e -> Left $ "Unable to decode base64 string " ++ T.unpack t ++ ": " ++ e + -- | Uses "Crypto.Hash.MD5" from cryptohash-md5. instance ValidAlgo 'MD5 where type AlgoCtx 'MD5 = MD5.Ctx @@ -134,6 +189,13 @@ instance ValidAlgo 'SHA256 where 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 diff --git a/hnix-store-core/src/System/Nix/ReadonlyStore.hs b/hnix-store-core/src/System/Nix/ReadonlyStore.hs index 21e9c609..aeec67f5 100644 --- a/hnix-store-core/src/System/Nix/ReadonlyStore.hs +++ b/hnix-store-core/src/System/Nix/ReadonlyStore.hs @@ -12,7 +12,12 @@ import Data.Text.Encoding import System.Nix.Hash import System.Nix.StorePath -makeStorePath :: forall hashAlgo . (NamedAlgo hashAlgo) => FilePath -> ByteString -> Digest hashAlgo -> StorePathName -> StorePath +makeStorePath :: forall hashAlgo . (NamedAlgo hashAlgo) + => FilePath + -> ByteString + -> Digest hashAlgo + -> StorePathName + -> StorePath makeStorePath fp ty h nm = StorePath storeHash nm fp where s = BS.intercalate ":" @@ -29,14 +34,18 @@ makeTextPath fp nm h refs = makeStorePath fp ty h nm where ty = BS.intercalate ":" ("text" : map storePathToRawFilePath (HS.toList refs)) -makeFixedOutputPath :: forall hashAlgo. (ValidAlgo hashAlgo, NamedAlgo hashAlgo) => FilePath -> Bool -> Digest hashAlgo -> StorePathName -> StorePath +makeFixedOutputPath :: forall hashAlgo . (ValidAlgo hashAlgo, NamedAlgo hashAlgo) + => FilePath + -> Bool + -> Digest hashAlgo + -> StorePathName + -> StorePath makeFixedOutputPath fp recursive h nm = - makeStorePath fp ty h' nm - where - (ty, h') = - if recursive && algoName @hashAlgo == algoName @'SHA256 - then ("source", h) - else ("output:out", hash ("fixed:out:" <> encodeUtf8 (encodeBase16 h) <> ":")) + if recursive && (algoName @hashAlgo) == "sha256" + then makeStorePath fp "source" h nm + else makeStorePath fp "output:out" h' nm + where + h' = hash @'SHA256 $ "fixed:out:" <> encodeUtf8 (algoName @hashAlgo) <> (if recursive then ":r:" else ":") <> encodeUtf8 (encodeBase16 h) <> ":" computeStorePathForText :: FilePath -> StorePathName -> ByteString -> StorePathSet -> StorePath computeStorePathForText fp nm s refs = makeTextPath fp nm (hash s) refs diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index d68f313c..4c9f63c1 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -264,8 +264,7 @@ querySubstitutablePaths ps = do putPaths ps sockGetPaths -queryPathInfoUncached :: forall a . NamedAlgo a - => StorePath +queryPathInfoUncached :: StorePath -> MonadStore StorePathMetadata queryPathInfoUncached path = do runOpArgs QueryPathInfo $ do @@ -277,9 +276,9 @@ queryPathInfoUncached path = do deriverPath <- sockGetPathMay narHashText <- Data.Text.Encoding.decodeUtf8 <$> sockGetStr - let narHash = case System.Nix.Hash.decodeBase32 narHashText of + let narHash = case System.Nix.Hash.decodeBase32 @'System.Nix.Hash.SHA256 narHashText of Left e -> error e - Right x -> SomeDigest @a x + Right x -> SomeDigest x references <- sockGetPaths registrationTime <- sockGet getTime @@ -294,7 +293,7 @@ queryPathInfoUncached path = do sigs = Data.Set.empty contentAddressableAddress = - case System.Nix.Store.Remote.Parsers.parseContentAddressableAddress @a caString of + case System.Nix.Store.Remote.Parsers.parseContentAddressableAddress caString of Left e -> error e Right x -> Just x diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs index 97a2af23..e2d3bca5 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs @@ -2,63 +2,54 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-} -module System.Nix.Store.Remote.Parsers ( - parseContentAddressableAddress - ) where +module System.Nix.Store.Remote.Parsers + ( parseContentAddressableAddress + ) +where -import Control.Applicative ((<|>)) -import Data.Attoparsec.ByteString.Char8 (Parser, ()) -import Data.ByteString (ByteString) -import System.Nix.Hash (Digest, NamedAlgo, SomeNamedDigest(SomeDigest)) -import System.Nix.StorePath (ContentAddressableAddress(..), NarHashMode(..)) - -import qualified Data.Attoparsec.ByteString.Char8 -import qualified Data.ByteString.Char8 +import Control.Applicative ( (<|>) ) +import Data.Attoparsec.ByteString.Char8 +import Data.ByteString.Char8 import qualified Data.Text - -import qualified System.Nix.Internal.Base32 -import qualified System.Nix.Hash +import Data.Text.Encoding ( decodeUtf8 ) +import System.Nix.Hash +import System.Nix.StorePath ( ContentAddressableAddress(..) + , NarHashMode(..) + ) -- | Parse `ContentAddressableAddress` from `ByteString` -parseContentAddressableAddress :: forall hashAlgo . NamedAlgo hashAlgo - => ByteString - -> Either String ContentAddressableAddress +parseContentAddressableAddress + :: ByteString -> Either String ContentAddressableAddress parseContentAddressableAddress = - Data.Attoparsec.ByteString.Char8.parseOnly - (contentAddressableAddressParser @hashAlgo) + Data.Attoparsec.ByteString.Char8.parseOnly contentAddressableAddressParser -- | Parser for content addressable field -contentAddressableAddressParser :: forall hashAlgo . NamedAlgo hashAlgo - => Parser ContentAddressableAddress -contentAddressableAddressParser = - caText - <|> caFixed @hashAlgo +contentAddressableAddressParser :: Parser ContentAddressableAddress +contentAddressableAddressParser = caText <|> caFixed -- | Parser for @text:sha256:@ caText :: Parser ContentAddressableAddress caText = do - _ <- "text:sha256:" - digest <- parseDigest - either fail return - $ Text <$> digest + _ <- "text:sha256:" + digest <- decodeBase32 @'SHA256 <$> parseHash + either fail return $ Text <$> digest -- | Parser for @fixed:::@ -caFixed :: forall hashAlgo . NamedAlgo hashAlgo => Parser ContentAddressableAddress +caFixed :: Parser ContentAddressableAddress caFixed = do - _ <- "fixed:" - narHashMode <- (pure Recursive <$> "true") <|> (pure RegularFile <$> "false") - "Invalid Base32 part" - digest <- parseDigest + _ <- "fixed:" + narHashMode <- (pure Recursive <$> "r:") <|> (pure RegularFile <$> "") + digest <- parseTypedDigest + either fail return $ Fixed narHashMode <$> digest + +parseTypedDigest :: Parser (Either String SomeNamedDigest) +parseTypedDigest = mkNamedDigest <$> parseHashType <*> parseHash - either fail return - $ Fixed <$> pure narHashMode <*> (SomeDigest @hashAlgo <$> digest) +parseHashType :: Parser Data.Text.Text +parseHashType = decodeUtf8 <$> ("sha256" <|> "sha512" <|> "sha1" <|> "md5") <* (":" <|> "-") -parseDigest :: forall a . Parser (Either String (Digest a)) -parseDigest = - System.Nix.Hash.decodeBase32 - . Data.Text.pack - . Data.ByteString.Char8.unpack - <$> Data.Attoparsec.ByteString.Char8.takeWhile1 - (\c -> c `elem` System.Nix.Internal.Base32.digits32) +parseHash :: Parser Data.Text.Text +parseHash = decodeUtf8 <$> takeWhile1 (/= ':')