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..056f704e 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -44,7 +44,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 +64,55 @@ 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 hash = case name of + "md5" -> SomeDigest <$> decode @'MD5 + "sha1" -> SomeDigest <$> decode @'SHA1 + "sha256" -> SomeDigest <$> decode @'SHA256 + _ -> Left $ "Unknown hash name: " ++ T.unpack name + where + size = T.length hash + decode :: forall a . (NamedAlgo a, ValidAlgo a) => Either String (Digest a) + decode + | size == base16Len = decodeBase16 hash + | size == base32Len = decodeBase32 hash + -- | size == base64Len = decodeBase64 s -- TODO + | otherwise = Left $ T.unpack hash ++ " is not a valid " ++ T.unpack name ++ " hash." + where + hsize = hashSize @a + base16Len = hsize * 2 + base32Len = ((hsize * 8 - 1) `div` 5) + 1; + -- base64Len = ((4 * hsize / 3) + 3) & ~3; + -- | Hash an entire (strict) 'BS.ByteString' as a single call. -- -- For example: 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..94b2a242 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" <|> "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 (/= ':')