diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index 867296d26a..7e35536623 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -16,9 +16,7 @@ module Stack.Build.Source ) where import Stack.Prelude -import Crypto.Hash (Digest, SHA256(..)) -import Crypto.Hash.Conduit (sinkHash) -import qualified Data.ByteArray as Mem (convert) +import qualified Pantry.SHA256 as SHA256 import qualified Data.ByteString as S import Conduit (ZipSink (..), withSourceFile) import qualified Data.Conduit.List as CL @@ -467,11 +465,11 @@ calcFci modTime' fp = liftIO $ <$> ZipSink (CL.fold (\x y -> x + fromIntegral (S.length y)) 0) - <*> ZipSink sinkHash) + <*> ZipSink SHA256.sinkHash) return FileCacheInfo { fciModTime = modTime' , fciSize = size - , fciHash = Mem.convert (digest :: Digest SHA256) + , fciHash = digest } checkComponentsBuildable :: MonadThrow m => [LocalPackage] -> m () diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index ada152dd87..9f610f322f 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -51,6 +51,7 @@ import Control.Monad.Extra (firstJustM) import Stack.Prelude import Data.Aeson.Extended import qualified Data.ByteString as S +import Data.ByteString.Builder (toLazyByteString) import Data.Coerce (coerce) import Data.IORef.RunOnce (runOnce) import qualified Data.IntMap as IntMap @@ -68,7 +69,7 @@ import GHC.Conc (getNumProcessors) import Lens.Micro (lens, set) import Network.HTTP.StackClient (httpJSON, parseUrlThrow, getResponseBody) import Options.Applicative (Parser, strOption, long, help) -import Pantry.StaticSHA256 +import qualified Pantry.SHA256 as SHA256 import Path import Path.Extra (toFilePathNoTrailingSep) import Path.Find (findInParents) @@ -920,7 +921,7 @@ getFakeConfigPath getFakeConfigPath stackRoot ar = do asString <- case ar of - ARResolver r -> pure $ T.unpack $ staticSHA256ToText $ mkStaticSHA256FromBytes $ encodeUtf8 $ utf8BuilderToText $ display r + ARResolver r -> pure $ T.unpack $ SHA256.toHexText $ SHA256.hashLazyBytes $ toLazyByteString $ getUtf8Builder $ display r _ -> throwM $ InvalidResolverForNoLocalConfig $ show ar -- This takeWhile is an ugly hack. We don't actually need this -- path for anything useful. But if we take the raw value for diff --git a/src/Stack/Config/Docker.hs b/src/Stack/Config/Docker.hs index 19fcb987ee..c3ab49d83c 100644 --- a/src/Stack/Config/Docker.hs +++ b/src/Stack/Config/Docker.hs @@ -11,7 +11,6 @@ import qualified Data.Text as T import Data.Text.Read (decimal) import Distribution.Version (simplifyVersionRange) import Path -import Pantry.Types (UnresolvedSnapshotLocation (USLUrl)) import Stack.Types.Version import Stack.Types.Config import Stack.Types.Docker @@ -113,6 +112,8 @@ instance Show StackDockerConfigException where show (InvalidDatabasePathException ex) = "Invalid database path: " ++ show ex -- | Parse an LTS major and minor number from a snapshot URL. +-- +-- This might make more sense in pantry instead. parseLtsName :: Text -> Maybe (Int, Int) parseLtsName t0 = do t1 <- T.stripPrefix "https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/" t0 diff --git a/src/Stack/Snapshot.hs b/src/Stack/Snapshot.hs index 18ef7c438f..a306291400 100644 --- a/src/Stack/Snapshot.hs +++ b/src/Stack/Snapshot.hs @@ -39,9 +39,8 @@ import qualified Distribution.Version as C import Network.HTTP.Download (download, redownload) import Network.HTTP.StackClient (Request, parseRequest) import qualified RIO -import qualified RIO.ByteString.Lazy as BL import Data.ByteString.Builder (toLazyByteString) -import Pantry.StaticSHA256 +import qualified Pantry.SHA256 as SHA256 import Stack.Package import Stack.PackageDump import Stack.Types.BuildPlan @@ -152,11 +151,11 @@ loadResolver sl = do where - mkUniqueHash :: WantedCompiler -> StaticSHA256 - mkUniqueHash = mkStaticSHA256FromBytes . BL.toStrict . toLazyByteString . getUtf8Builder . RIO.display + mkUniqueHash :: WantedCompiler -> SHA256 + mkUniqueHash = SHA256.hashLazyBytes . toLazyByteString . getUtf8Builder . RIO.display - combineHashes :: StaticSHA256 -> StaticSHA256 -> StaticSHA256 - combineHashes x y = mkStaticSHA256FromBytes (staticSHA256ToRaw x <> staticSHA256ToRaw y) + combineHashes :: SHA256 -> SHA256 -> SHA256 + combineHashes x y = SHA256.hashBytes (SHA256.toRaw x <> SHA256.toRaw y) -- | Fully load up a 'SnapshotDef' into a 'LoadedSnapshot' loadSnapshot diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs index 417db2887c..8f75f173de 100644 --- a/src/Stack/Types/Build.hs +++ b/src/Stack/Types/Build.hs @@ -378,7 +378,7 @@ instance NFData BuildCache instance Store BuildCache buildCacheVC :: VersionConfig BuildCache -buildCacheVC = storeVersionConfig "build-v1" "KVUoviSWWAd7tiRRGeWAvd0UIN4=" +buildCacheVC = storeVersionConfig "build-v2" "c9BeiWP7Mpe9OBDAPPEYPDaFEGM=" -- | Stored on disk to know whether the flags have changed. data ConfigCache = ConfigCache diff --git a/src/Stack/Types/BuildPlan.hs b/src/Stack/Types/BuildPlan.hs index 9c5a2558e1..52d3f28972 100644 --- a/src/Stack/Types/BuildPlan.hs +++ b/src/Stack/Types/BuildPlan.hs @@ -51,7 +51,7 @@ data SnapshotDef = SnapshotDef -- To be removed as part of https://github.com/co { sdResolver :: !SnapshotLocation , sdSnapshot :: !(Maybe (Snapshot, SnapshotDef)) , sdWantedCompilerVersion :: !WantedCompiler - , sdUniqueHash :: !StaticSHA256 + , sdUniqueHash :: !SHA256 } deriving (Show, Eq, Data, Generic, Typeable) instance Store SnapshotDef @@ -144,7 +144,7 @@ configuration. Otherwise, we don't cache. -} loadedSnapshotVC :: VersionConfig LoadedSnapshot -loadedSnapshotVC = storeVersionConfig "ls-v6" "pmaNGNwdLx9dgFqd2TiMcRhTQzQ=" +loadedSnapshotVC = storeVersionConfig "ls-v6" "ARoQclS4aNPX7uW8YMmM8-ZLrl0=" -- | Information on a single package for the 'LoadedSnapshot' which -- can be installed. diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs index 7160d6afc1..ce8671c486 100644 --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -203,7 +203,7 @@ import Lens.Micro (Lens', lens, _1, _2, to) import Options.Applicative (ReadM) import qualified Options.Applicative as OA import qualified Options.Applicative.Types as OA -import Pantry.StaticSHA256 +import qualified Pantry.SHA256 as SHA256 import Path import qualified Paths_stack as Meta import Stack.Constants @@ -1252,7 +1252,7 @@ platformSnapAndCompilerRel platformSnapAndCompilerRel = do sd <- view snapshotDefL platform <- platformGhcRelDir - name <- parseRelDir $ T.unpack $ staticSHA256ToText $ sdUniqueHash sd + name <- parseRelDir $ T.unpack $ SHA256.toHexText $ sdUniqueHash sd ghc <- compilerVersionDir useShaPathOnWindows (platform name ghc) @@ -1354,7 +1354,7 @@ configLoadedSnapshotCache configLoadedSnapshotCache sd gis = do root <- view stackRootL platform <- platformGhcVerOnlyRelDir - file <- parseRelFile $ T.unpack (staticSHA256ToText $ sdUniqueHash sd) ++ ".cache" + file <- parseRelFile $ T.unpack (SHA256.toHexText $ sdUniqueHash sd) ++ ".cache" gis' <- parseRelDir $ case gis of GISSnapshotHints -> "__snapshot_hints__" diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 8ce93ea823..c36cf7d6cc 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -10,7 +10,6 @@ module Stack.Types.Package where import Stack.Prelude -import qualified Data.ByteString as S import qualified RIO.Text as T import qualified Data.Map as M import qualified Data.Set as Set @@ -306,7 +305,7 @@ data InstalledPackageLocation = InstalledTo InstallLocation | ExtraGlobal data FileCacheInfo = FileCacheInfo { fciModTime :: !ModTime , fciSize :: !Word64 - , fciHash :: !S.ByteString + , fciHash :: !SHA256 } deriving (Generic, Show, Eq, Data, Typeable) instance Store FileCacheInfo diff --git a/subs/pantry/app/Pantry/OldStackage.hs b/subs/pantry/app/Pantry/OldStackage.hs index 5c98f7febc..1371d1502b 100644 --- a/subs/pantry/app/Pantry/OldStackage.hs +++ b/subs/pantry/app/Pantry/OldStackage.hs @@ -7,7 +7,7 @@ module Pantry.OldStackage ) where import Pantry.Types -import Pantry.StaticSHA256 +import qualified Pantry.SHA256 as SHA256 import Pantry.Storage import RIO import Data.Aeson @@ -75,7 +75,7 @@ parseStackageSnapshot snapshotName = withObject "StackageSnapshotDef" $ \o -> do case Map.lookup ("SHA256" :: Text) cfiHashes of Nothing -> fail "Could not find SHA256" Just shaText -> - case mkStaticSHA256FromText shaText of + case SHA256.fromHexText shaText of Left e -> fail $ "Invalid SHA256: " ++ show e Right x -> return x return $ CFIHash hash' msize diff --git a/subs/pantry/package.yaml b/subs/pantry/package.yaml index c151433b63..c80e9f2f35 100644 --- a/subs/pantry/package.yaml +++ b/subs/pantry/package.yaml @@ -60,6 +60,10 @@ library: - Pantry.SHA256 - Data.Aeson.Extended + # For testing + - Pantry.Internal + - Pantry.Internal.StaticBytes + flags: convert-old-stackage: description: Build the convert-old-stackage executable diff --git a/subs/pantry/src/Pantry.hs b/subs/pantry/src/Pantry.hs index 4024d42c38..856a5452bc 100644 --- a/subs/pantry/src/Pantry.hs +++ b/subs/pantry/src/Pantry.hs @@ -15,7 +15,7 @@ module Pantry , hpackExecutableL -- * Types - , StaticSHA256 + , SHA256 , CabalFileInfo (..) , Revision (..) , FileSize (..) @@ -49,7 +49,7 @@ module Pantry , loadPackageLocation -- ** Snapshots - , UnresolvedSnapshotLocation + , UnresolvedSnapshotLocation (..) , resolveSnapshotLocation , unresolveSnapshotLocation , SnapshotLocation (..) @@ -113,7 +113,7 @@ import qualified RIO.List as List import qualified RIO.FilePath as FilePath import Pantry.Archive import Pantry.Repo -import Pantry.StaticSHA256 +import qualified Pantry.SHA256 as SHA256 import Pantry.Storage import Pantry.Tree import Pantry.Types @@ -367,7 +367,7 @@ parseCabalFileImmutable parseCabalFileImmutable loc = do logDebug $ "Parsing cabal file for " <> display loc bs <- loadCabalFile loc - let foundCabalKey = BlobKey (mkStaticSHA256FromBytes bs) (FileSize (fromIntegral (B.length bs))) + let foundCabalKey = BlobKey (SHA256.hashBytes bs) (FileSize (fromIntegral (B.length bs))) (_warnings, gpd) <- rawParseGPD (Left loc) bs let pm = case loc of @@ -617,7 +617,7 @@ completePackageLocation (PLIHackage pir0@(PackageIdentifierRevision name version CFIHash{} -> pure pir0 _ -> do bs <- getHackageCabalFile pir0 - let cfi = CFIHash (mkStaticSHA256FromBytes bs) (Just (FileSize (fromIntegral (B.length bs)))) + let cfi = CFIHash (SHA256.hashBytes bs) (Just (FileSize (fromIntegral (B.length bs)))) pir = PackageIdentifierRevision name version cfi logDebug $ "Added in cabal file hash: " <> display pir pure pir @@ -668,7 +668,7 @@ completeSnapshotLocation sl@SLFilePath{} = pure sl completeSnapshotLocation sl@(SLUrl _ (Just _) _) = pure sl completeSnapshotLocation (SLUrl url Nothing mcompiler) = do bs <- loadFromURL url Nothing - let blobKey = BlobKey (mkStaticSHA256FromBytes bs) (FileSize $ fromIntegral $ B.length bs) + let blobKey = BlobKey (SHA256.hashBytes bs) (FileSize $ fromIntegral $ B.length bs) pure $ SLUrl url (Just blobKey) mcompiler -- | Fill in optional fields in a 'Snapshot' for more reproducible builds. @@ -757,18 +757,18 @@ traverseConcurrentlyWith count f t0 = do loadPantrySnapshot :: (HasPantryConfig env, HasLogFunc env) => SnapshotLocation - -> RIO env (Either WantedCompiler (Snapshot, Maybe WantedCompiler, StaticSHA256)) + -> RIO env (Either WantedCompiler (Snapshot, Maybe WantedCompiler, SHA256)) loadPantrySnapshot (SLCompiler compiler) = pure $ Left compiler loadPantrySnapshot sl@(SLUrl url mblob mcompiler) = handleAny (throwIO . InvalidSnapshot sl) $ do bs <- loadFromURL url mblob value <- Yaml.decodeThrow bs snapshot <- warningsParserHelper sl value (parseSnapshot Nothing) - pure $ Right (snapshot, mcompiler, mkStaticSHA256FromBytes bs) + pure $ Right (snapshot, mcompiler, SHA256.hashBytes bs) loadPantrySnapshot sl@(SLFilePath fp mcompiler) = handleAny (throwIO . InvalidSnapshot sl) $ do value <- Yaml.decodeFileThrow $ toFilePath $ resolvedAbsolute fp - sha <- mkStaticSHA256FromFile $ toFilePath $ resolvedAbsolute fp + sha <- SHA256.hashFile $ toFilePath $ resolvedAbsolute fp snapshot <- warningsParserHelper sl value $ parseSnapshot $ Just $ parent $ resolvedAbsolute fp pure $ Right (snapshot, mcompiler, sha) diff --git a/subs/pantry/src/Pantry/Archive.hs b/subs/pantry/src/Pantry/Archive.hs index 5640939ae3..c540a88b13 100644 --- a/subs/pantry/src/Pantry/Archive.hs +++ b/subs/pantry/src/Pantry/Archive.hs @@ -12,7 +12,7 @@ module Pantry.Archive import RIO import RIO.FilePath (normalise, takeDirectory, ()) -import Pantry.StaticSHA256 +import qualified Pantry.SHA256 as SHA256 import Pantry.Storage import Pantry.Tree import Pantry.Types @@ -26,7 +26,6 @@ import Path (toFilePath) import qualified Codec.Archive.Zip as Zip import Conduit -import Crypto.Hash.Conduit import Data.Conduit.Zlib (ungzip) import qualified Data.Conduit.Tar as Tar import Pantry.HTTP @@ -64,7 +63,7 @@ getArchive archive pm = loc = archiveLocation archive withCache - :: RIO env (TreeSId, StaticSHA256, FileSize, TreeKey, Tree) + :: RIO env (TreeSId, SHA256, FileSize, TreeKey, Tree) -> RIO env (TreeKey, Tree) withCache inner = let loop [] = do @@ -111,7 +110,7 @@ getArchive archive pm = withArchiveLoc :: HasLogFunc env => Archive - -> (FilePath -> StaticSHA256 -> FileSize -> RIO env a) + -> (FilePath -> SHA256 -> FileSize -> RIO env a) -> RIO env a withArchiveLoc (Archive (ALFilePath resolved) msha msize) f = do let fp = toFilePath $ resolvedAbsolute resolved @@ -119,7 +118,7 @@ withArchiveLoc (Archive (ALFilePath resolved) msha msize) f = do size <- FileSize . fromIntegral <$> hFileSize h for_ msize $ \size' -> when (size /= size') $ error $ "Mismatched local archive size: " ++ show (resolved, size, size') - sha <- mkStaticSHA256FromDigest <$> runConduit (sourceHandle h .| sinkHash) + sha <- runConduit (sourceHandle h .| SHA256.sinkHash) for_ msha $ \sha' -> when (sha /= sha') $ error $ "Mismatched local archive sha: " ++ show (resolved, sha, sha') pure (sha, size) diff --git a/subs/pantry/src/Pantry/HTTP.hs b/subs/pantry/src/Pantry/HTTP.hs index d907d6d703..a3ebb6b1fb 100644 --- a/subs/pantry/src/Pantry/HTTP.hs +++ b/subs/pantry/src/Pantry/HTTP.hs @@ -8,7 +8,6 @@ module Pantry.HTTP ) where import Conduit -import Crypto.Hash.Conduit import Network.HTTP.Client as Export (parseRequest) import Network.HTTP.Client as Export (parseUrlThrow) import Network.HTTP.Client as Export (BodyReader, HttpExceptionContent (StatusCodeException)) @@ -30,7 +29,7 @@ import Network.HTTP.Types as Export (Header, HeaderName, hRange, ok200, partialContent206, statusCode) -import Pantry.StaticSHA256 +import qualified Pantry.SHA256 as SHA256 import Pantry.Types import RIO import qualified RIO.ByteString as B @@ -58,10 +57,10 @@ httpSink req inner = HTTP.httpSink (setUserAgent req) inner httpSinkChecked :: MonadUnliftIO m => Text - -> Maybe StaticSHA256 + -> Maybe SHA256 -> Maybe FileSize -> ConduitT ByteString Void m a - -> m (StaticSHA256, FileSize, a) + -> m (SHA256, FileSize, a) httpSinkChecked url msha msize sink = do req <- liftIO $ parseUrlThrow $ T.unpack url httpSink req $ const $ getZipSink $ (,,) @@ -70,7 +69,7 @@ httpSinkChecked url msha msize sink = do <*> ZipSink sink where checkSha mexpected = do - actual <- mkStaticSHA256FromDigest <$> sinkHash + actual <- SHA256.sinkHash for_ mexpected $ \expected -> unless (actual == expected) $ throwIO $ DownloadInvalidSHA256 url Mismatch { mismatchExpected = expected diff --git a/subs/pantry/src/Pantry/Hackage.hs b/subs/pantry/src/Pantry/Hackage.hs index bbe6cd73df..300bf54433 100644 --- a/subs/pantry/src/Pantry/Hackage.hs +++ b/subs/pantry/src/Pantry/Hackage.hs @@ -14,7 +14,6 @@ module Pantry.Hackage import RIO import Data.Aeson import Conduit -import Crypto.Hash.Conduit (sinkHash) import Data.Conduit.Tar import qualified RIO.Text as T import qualified RIO.Map as Map @@ -25,7 +24,7 @@ import Pantry.Archive import Pantry.Types hiding (FileType (..)) import Pantry.Storage import Pantry.Tree -import Pantry.StaticSHA256 +import qualified Pantry.SHA256 as SHA256 import Network.URI (parseURI) import Data.Time (getCurrentTime) import Path ((), Path, Abs, Dir, File, mkRelDir, mkRelFile, toFilePath) @@ -119,7 +118,7 @@ updateHackageIndex mreason = gateUpdate $ do -- (by the tar spec) 1024 null bytes at the end, which will be -- mutated in the future by other updates. newSize :: Word <- (fromIntegral . max 0 . subtract 1024) <$> hFileSize h - let sinkSHA256 len = mkStaticSHA256FromDigest <$> (takeCE (fromIntegral len) .| sinkHash) + let sinkSHA256 len = takeCE (fromIntegral len) .| SHA256.sinkHash case minfo of Nothing -> do @@ -247,7 +246,7 @@ populateCache fp offset = withBinaryFile (toFilePath fp) ReadMode $ \h -> do Just (name', version', filename) -- | Package download info from Hackage -data PackageDownload = PackageDownload !StaticSHA256 !Word +data PackageDownload = PackageDownload !SHA256 !Word instance FromJSON PackageDownload where parseJSON = withObject "PackageDownload" $ \o1 -> do o2 <- o1 .: "signed" @@ -257,7 +256,7 @@ instance FromJSON PackageDownload where hashes <- o4 .: "hashes" sha256' <- hashes .: "sha256" sha256 <- - case mkStaticSHA256FromText sha256' of + case SHA256.fromHexText sha256' of Left e -> fail $ "Invalid sha256: " ++ show e Right x -> return x return $ PackageDownload sha256 len diff --git a/subs/pantry/src/Pantry/Internal.hs b/subs/pantry/src/Pantry/Internal.hs new file mode 100644 index 0000000000..c3e4d49907 --- /dev/null +++ b/subs/pantry/src/Pantry/Internal.hs @@ -0,0 +1,10 @@ +-- | Exposed for testing, do not use! +module Pantry.Internal + ( parseTree + , renderTree + , Tree (..) + , TreeEntry (..) + , mkSafeFilePath + ) where + +import Pantry.Types diff --git a/subs/pantry/src/Pantry/StaticBytes.hs b/subs/pantry/src/Pantry/Internal/StaticBytes.hs similarity index 98% rename from subs/pantry/src/Pantry/StaticBytes.hs rename to subs/pantry/src/Pantry/Internal/StaticBytes.hs index 6cdf975034..c53754632a 100644 --- a/subs/pantry/src/Pantry/StaticBytes.hs +++ b/subs/pantry/src/Pantry/Internal/StaticBytes.hs @@ -1,12 +1,15 @@ --- This module can (and perhaps should) be separate into its own --- package, it's generally useful. {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-} -module Pantry.StaticBytes +-- | This is an unstable API, exposed only for testing. Relying on +-- this may break your code! Caveat emptor. +-- +-- This module can (and perhaps should) be separate into its own +-- package, it's generally useful. +module Pantry.Internal.StaticBytes ( Bytes8 , Bytes16 , Bytes32 diff --git a/subs/pantry/src/Pantry/SHA256.hs b/subs/pantry/src/Pantry/SHA256.hs index dbf2bda059..c91242833a 100644 --- a/subs/pantry/src/Pantry/SHA256.hs +++ b/subs/pantry/src/Pantry/SHA256.hs @@ -3,102 +3,165 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module Pantry.StaticSHA256 - ( StaticSHA256 - , mkStaticSHA256FromText - , mkStaticSHA256FromFile - , mkStaticSHA256FromDigest - , mkStaticSHA256FromBytes - , mkStaticSHA256FromRaw - , staticSHA256ToText - , staticSHA256ToBase16 - , staticSHA256ToRaw +-- | Provides a data type ('SHA256') for efficient memory +-- representation of a sha-256 hash value, together with helper +-- functions for converting to and from that value. This module is +-- intended to be imported qualified as @SHA256@. +-- +-- Some nomenclature: +-- +-- * Hashing calculates a new hash value from some input. @from@ takes a value that representats an existing hash. +-- +-- * Raw means a raw binary representation of the hash value, without any hex encoding. +-- +-- * Text always uses lower case hex encoding +-- +-- @since 0.1.0.0 +module Pantry.SHA256 + ( -- * Types + SHA256 + , SHA256Exception (..) + -- * Hashing + , hashFile + , hashBytes + , hashLazyBytes + , sinkHash + -- * Convert from a hash representation + , fromHexText + , fromHexBytes + , fromDigest + , fromRaw + -- * Convert to a hash representation + , toHexText + , toHexBytes + , toRaw ) where import RIO import Data.Aeson import Database.Persist.Sql -import Pantry.StaticBytes +import Pantry.Internal.StaticBytes import Data.Store (Store) -- FIXME remove +import Conduit +import qualified RIO.Text as T -import Crypto.Hash.Conduit (hashFile) -import Crypto.Hash as Hash (hash, Digest, SHA256) +import qualified Crypto.Hash.Conduit as Hash (hashFile, sinkHash) +import qualified Crypto.Hash as Hash (hash, hashlazy, Digest, SHA256) import qualified Data.ByteArray import qualified Data.ByteArray.Encoding as Mem -- | A SHA256 hash, stored in a static size for more efficient --- serialization with store. -newtype StaticSHA256 = StaticSHA256 Bytes32 +-- memory representation. +-- +-- @since 0.1.0.0 +newtype SHA256 = SHA256 Bytes32 deriving (Generic, Eq, NFData, Data, Typeable, Ord, Hashable, Store) -instance Show StaticSHA256 where - show s = "StaticSHA256 " ++ show (staticSHA256ToText s) +-- | Exceptions which can occur in this module +-- +-- @since 0.1.0.0 +data SHA256Exception + = InvalidByteCount !ByteString !StaticBytesException + | InvalidHexBytes !ByteString !Text + deriving (Typeable) + +-- | Generate a 'SHA256' value by hashing the contents of a file. +-- +-- @since 0.1.0.0 +hashFile :: MonadIO m => FilePath -> m SHA256 +hashFile fp = fromDigest <$> Hash.hashFile fp + +-- | Generate a 'SHA256' value by hashing a @ByteString@. +-- +-- @since 0.1.0.0 +hashBytes :: ByteString -> SHA256 +hashBytes = fromDigest . Hash.hash + +-- | Generate a 'SHA256' value by hashing a lazy @ByteString@. +-- +-- @since 0.1.0.0 +hashLazyBytes :: LByteString -> SHA256 +hashLazyBytes = fromDigest . Hash.hashlazy + +-- | Generate a 'SHA256' value by hashing the contents of a stream. +-- +-- @since 0.1.0.0 +sinkHash :: Monad m => ConduitT ByteString o m SHA256 +sinkHash = fromDigest <$> Hash.sinkHash + +-- | Convert a base16-encoded 'Text' value containing a hash into a 'SHA256'. +-- +-- @since 0.1.0.0 +fromHexText :: Text -> Either SHA256Exception SHA256 +fromHexText = fromHexBytes . encodeUtf8 + +-- | Convert a base16-encoded 'ByteString' value containing a hash into a 'SHA256'. +-- +-- @since 0.1.0.0 +fromHexBytes :: ByteString -> Either SHA256Exception SHA256 +fromHexBytes hexBS = do + mapLeft (InvalidHexBytes hexBS . T.pack) (Mem.convertFromBase Mem.Base16 hexBS) >>= fromRaw + +-- | Convert a 'Hash.Digest' into a 'SHA256' +-- +-- @since 0.1.0.0 +fromDigest :: Hash.Digest Hash.SHA256 -> SHA256 +fromDigest digest = + case toStaticExact (Data.ByteArray.convert digest :: ByteString) of + Left e -> error $ "Impossible failure in fromDigest: " ++ show (digest, e) + Right x -> SHA256 x + +-- | Convert a raw representation of a hash into a 'SHA256'. +-- +-- @since 0.1.0.0 +fromRaw :: ByteString -> Either SHA256Exception SHA256 +fromRaw bs = either (Left . InvalidByteCount bs) (Right . SHA256) (toStaticExact bs) + +-- | Convert a 'SHA256' into a base16-encoded SHA256 hash. +-- +-- @since 0.1.0.0 +toHexText :: SHA256 -> Text +toHexText ss = + case decodeUtf8' $ toHexBytes ss of + Left e -> error $ "Impossible failure in staticSHA256ToText: " ++ show (ss, e) + Right t -> t + +-- | Convert a 'SHA256' into a base16-encoded SHA256 hash. +-- +-- @since 0.1.0.0 +toHexBytes :: SHA256 -> ByteString +toHexBytes (SHA256 x) = Mem.convertToBase Mem.Base16 x + +-- | Convert a 'SHA256' into a raw binary representation. +-- +-- @since 0.1.0.0 +toRaw :: SHA256 -> ByteString +toRaw (SHA256 x) = Data.ByteArray.convert x -instance PersistField StaticSHA256 where - toPersistValue = PersistByteString . staticSHA256ToRaw +-- Instances + +instance Show SHA256 where + show s = "SHA256 " ++ show (toHexText s) + +instance PersistField SHA256 where + toPersistValue = PersistByteString . toRaw fromPersistValue (PersistByteString bs) = case toStaticExact bs of Left e -> Left $ tshow e - Right ss -> pure $ StaticSHA256 ss + Right ss -> pure $ SHA256 ss fromPersistValue x = Left $ "Unexpected value: " <> tshow x -instance PersistFieldSql StaticSHA256 where +instance PersistFieldSql SHA256 where sqlType _ = SqlBlob -instance Display StaticSHA256 where - display = display . staticSHA256ToText - --- | Generate a 'StaticSHA256' value from the contents of a file. -mkStaticSHA256FromFile :: MonadIO m => FilePath -> m StaticSHA256 -mkStaticSHA256FromFile fp = liftIO $ mkStaticSHA256FromDigest <$> hashFile fp +instance Display SHA256 where + display = displayBytesUtf8 . toHexBytes -mkStaticSHA256FromBytes :: ByteString -> StaticSHA256 -mkStaticSHA256FromBytes = mkStaticSHA256FromDigest . Hash.hash - -mkStaticSHA256FromDigest :: Hash.Digest Hash.SHA256 -> StaticSHA256 -mkStaticSHA256FromDigest digest - = StaticSHA256 - $ either impureThrow id - $ toStaticExact - (Data.ByteArray.convert digest :: ByteString) - --- | Convert a 'StaticSHA256' into a base16-encoded SHA256 hash. -staticSHA256ToText :: StaticSHA256 -> Text -staticSHA256ToText ss = - case decodeUtf8' $ staticSHA256ToBase16 ss of - Left e -> error $ "Impossible failure in staticSHA256ToText: " ++ show (ss, e) - Right t -> t - --- | Convert a 'StaticSHA256' into a base16-encoded SHA256 hash. -staticSHA256ToBase16 :: StaticSHA256 -> ByteString -staticSHA256ToBase16 (StaticSHA256 x) = Mem.convertToBase Mem.Base16 x - -staticSHA256ToRaw :: StaticSHA256 -> ByteString -staticSHA256ToRaw (StaticSHA256 x) = Data.ByteArray.convert x - -mkStaticSHA256FromRaw :: ByteString -> Either StaticBytesException StaticSHA256 -mkStaticSHA256FromRaw = fmap StaticSHA256 . toStaticExact - --- | Generate a 'StaticSHA256' value from a base16-encoded SHA256 hash. -mkStaticSHA256FromText :: Text -> Either SomeException StaticSHA256 -mkStaticSHA256FromText t = - mapLeft (toException . stringException) (Mem.convertFromBase Mem.Base16 (encodeUtf8 t)) - >>= either (Left . toE) (Right . StaticSHA256) - . toStaticExact - . (id :: ByteString -> ByteString) - where - toE e = toException $ stringException $ concat - [ "Unable to convert " - , show t - , " into SHA256: " - , show e - ] - -instance ToJSON StaticSHA256 where - toJSON = toJSON . staticSHA256ToText -instance FromJSON StaticSHA256 where - parseJSON = withText "StaticSHA256" $ \t -> - case mkStaticSHA256FromText t of +instance ToJSON SHA256 where + toJSON = toJSON . toHexText +instance FromJSON SHA256 where + parseJSON = withText "SHA256" $ \t -> + case fromHexText t of Right x -> pure x Left e -> fail $ concat [ "Invalid SHA256 " @@ -106,3 +169,18 @@ instance FromJSON StaticSHA256 where , ": " , show e ] + +instance Exception SHA256Exception +instance Show SHA256Exception where + show = T.unpack . utf8BuilderToText . display +instance Display SHA256Exception where + display (InvalidByteCount bs sbe) = + "Invalid byte count creating a SHA256 from " <> + displayShow bs <> + ": " <> + displayShow sbe + display (InvalidHexBytes bs t) = + "Invalid hex bytes creating a SHA256: " <> + displayShow bs <> + ": " <> + display t diff --git a/subs/pantry/src/Pantry/Storage.hs b/subs/pantry/src/Pantry/Storage.hs index 9dba26f2d4..e2f7748e87 100644 --- a/subs/pantry/src/Pantry/Storage.hs +++ b/subs/pantry/src/Pantry/Storage.hs @@ -61,7 +61,7 @@ import Database.Persist import Database.Persist.Sqlite import Database.Persist.TH import RIO.Orphans () -import Pantry.StaticSHA256 +import qualified Pantry.SHA256 as SHA256 import qualified RIO.Map as Map import RIO.Time (UTCTime, getCurrentTime) import Path (Path, Abs, File, toFilePath, parent) @@ -70,7 +70,7 @@ import Data.Pool (destroyAllResources) share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| BlobTable sql=blob - hash StaticSHA256 + hash SHA256 size FileSize contents ByteString UniqueBlobHash hash @@ -88,7 +88,7 @@ VersionTable sql=version HackageTarball name NameId version VersionTableId - hash StaticSHA256 + hash SHA256 size FileSize UniqueHackageTarball name version HackageCabal @@ -105,13 +105,13 @@ PreferredVersions CacheUpdate time UTCTime size FileSize - hash StaticSHA256 + hash SHA256 ArchiveCache time UTCTime url Text subdir Text - sha StaticSHA256 + sha SHA256 size FileSize tree TreeSId @@ -186,7 +186,7 @@ storeBlob => ByteString -> ReaderT SqlBackend (RIO env) (BlobTableId, BlobKey) storeBlob bs = do - let sha = mkStaticSHA256FromBytes bs + let sha = SHA256.hashBytes bs size = FileSize $ fromIntegral $ B.length bs keys <- selectKeysList [BlobTableHash ==. sha] [] key <- @@ -217,7 +217,7 @@ loadBlob (BlobKey sha size) = do loadBlobBySHA :: (HasPantryConfig env, HasLogFunc env) - => StaticSHA256 + => SHA256 -> ReaderT SqlBackend (RIO env) (Maybe ByteString) loadBlobBySHA sha = fmap (fmap (blobTableContents . entityVal)) $ getBy $ UniqueBlobHash sha @@ -378,7 +378,7 @@ loadHackageCabalFile name version cfi = do loadLatestCacheUpdate :: (HasPantryConfig env, HasLogFunc env) - => ReaderT SqlBackend (RIO env) (Maybe (FileSize, StaticSHA256)) + => ReaderT SqlBackend (RIO env) (Maybe (FileSize, SHA256)) loadLatestCacheUpdate = fmap go <$> selectFirst [] [Desc CacheUpdateTime] where @@ -387,7 +387,7 @@ loadLatestCacheUpdate = storeCacheUpdate :: (HasPantryConfig env, HasLogFunc env) => FileSize - -> StaticSHA256 + -> SHA256 -> ReaderT SqlBackend (RIO env) () storeCacheUpdate size hash' = do now <- getCurrentTime @@ -401,7 +401,7 @@ storeHackageTarballInfo :: (HasPantryConfig env, HasLogFunc env) => PackageName -> Version - -> StaticSHA256 + -> SHA256 -> FileSize -> ReaderT SqlBackend (RIO env) () storeHackageTarballInfo name version sha size = do @@ -418,7 +418,7 @@ loadHackageTarballInfo :: (HasPantryConfig env, HasLogFunc env) => PackageName -> Version - -> ReaderT SqlBackend (RIO env) (Maybe (StaticSHA256, FileSize)) + -> ReaderT SqlBackend (RIO env) (Maybe (SHA256, FileSize)) loadHackageTarballInfo name version = do nameid <- getNameId name versionid <- getVersionId version @@ -533,7 +533,7 @@ loadHackageTreeKey :: (HasPantryConfig env, HasLogFunc env) => PackageName -> Version - -> StaticSHA256 + -> SHA256 -> ReaderT SqlBackend (RIO env) (Maybe TreeKey) loadHackageTreeKey name ver sha = do res <- rawSql @@ -582,7 +582,7 @@ storeArchiveCache :: (HasPantryConfig env, HasLogFunc env) => Text -- ^ URL -> Text -- ^ subdir - -> StaticSHA256 + -> SHA256 -> FileSize -> TreeSId -> ReaderT SqlBackend (RIO env) () @@ -601,7 +601,7 @@ loadArchiveCache :: (HasPantryConfig env, HasLogFunc env) => Text -- ^ URL -> Text -- ^ subdir - -> ReaderT SqlBackend (RIO env) [(StaticSHA256, FileSize, TreeSId)] + -> ReaderT SqlBackend (RIO env) [(SHA256, FileSize, TreeSId)] loadArchiveCache url subdir = map go <$> selectList [ ArchiveCacheUrl ==. url , ArchiveCacheSubdir ==. subdir diff --git a/subs/pantry/src/Pantry/Types.hs b/subs/pantry/src/Pantry/Types.hs index 1729113950..b3d7f551d8 100644 --- a/subs/pantry/src/Pantry/Types.hs +++ b/subs/pantry/src/Pantry/Types.hs @@ -35,6 +35,7 @@ module Pantry.Types , Tree (..) , renderTree , parseTree + , SHA256 -- , PackageTarball (..) , PackageLocation (..) , PackageLocationImmutable (..) @@ -92,7 +93,8 @@ import Data.Aeson.Extended import Data.ByteString.Builder (toLazyByteString, byteString, wordDec) import Database.Persist import Database.Persist.Sql -import Pantry.StaticSHA256 +import Pantry.SHA256 (SHA256) +import qualified Pantry.SHA256 as SHA256 import qualified Distribution.Compat.ReadP as Parse import Distribution.CabalSpecVersion (CabalSpecVersion (..), cabalSpecLatest) import Distribution.Parsec.Common (PError (..), PWarning (..), showPos) @@ -192,7 +194,7 @@ instance Display PackageLocationImmutable where -- over time, and so are allowed in custom snapshots. data Archive = Archive { archiveLocation :: !ArchiveLocation - , archiveHash :: !(Maybe StaticSHA256) + , archiveHash :: !(Maybe SHA256) , archiveSize :: !(Maybe FileSize) } deriving (Generic, Show, Eq, Ord, Data, Typeable) @@ -204,7 +206,7 @@ instance NFData Archive -- over time, and so are allowed in custom snapshots. data UnresolvedArchive = UnresolvedArchive { uaLocation :: !UnresolvedArchiveLocation - , uaHash :: !(Maybe StaticSHA256) + , uaHash :: !(Maybe SHA256) , uaSize :: !(Maybe FileSize) } deriving (Generic, Show, Eq, Ord, Data, Typeable) @@ -258,7 +260,7 @@ class HasPantryConfig env where newtype FileSize = FileSize Word deriving (Show, Eq, Ord, Data, Typeable, Generic, Display, Hashable, NFData, Store, PersistField, PersistFieldSql, ToJSON, FromJSON) -data BlobKey = BlobKey !StaticSHA256 !FileSize +data BlobKey = BlobKey !SHA256 !FileSize deriving (Eq, Ord, Data, Typeable, Generic) instance Store BlobKey instance NFData BlobKey @@ -310,7 +312,7 @@ data CabalFileInfo -- isn't reproducible at all, but the running assumption (not -- necessarily true) is that cabal file revisions do not change -- semantics of the build. - | CFIHash !StaticSHA256 !(Maybe FileSize) + | CFIHash !SHA256 !(Maybe FileSize) -- ^ Identify by contents of the cabal file itself. Only reason for -- @Maybe@ on @FileSize@ is for compatibility with input that -- doesn't include the file size. @@ -358,7 +360,7 @@ parsePackageIdentifierRevision t = maybe (throwM $ PackageIdentifierRevisionPars case splitColon cfiT of Just ("@sha256", shaSizeT) -> do let (shaT, sizeT) = T.break (== ',') shaSizeT - sha <- either (const Nothing) Just $ mkStaticSHA256FromText shaT + sha <- either (const Nothing) Just $ SHA256.fromHexText shaT msize <- case T.stripPrefix "," sizeT of Nothing -> Just Nothing @@ -411,7 +413,7 @@ data PantryException | InvalidBlobKey !(Mismatch BlobKey) | Couldn'tParseSnapshot !SnapshotLocation !String | WrongCabalFileName !PackageLocationImmutable !SafeFilePath !PackageName - | DownloadInvalidSHA256 !Text !(Mismatch StaticSHA256) + | DownloadInvalidSHA256 !Text !(Mismatch SHA256) | DownloadInvalidSize !Text !(Mismatch FileSize) | DownloadTooLarge !Text !(Mismatch FileSize) -- ^ Different from 'DownloadInvalidSize' since 'mismatchActual' is @@ -609,7 +611,7 @@ renderTree = BL.toStrict . toLazyByteString . go goEntry sfp (TreeEntry (BlobKey sha (FileSize size')) ft) = netstring (unSafeFilePath sfp) <> - byteString (staticSHA256ToRaw sha) <> + byteString (SHA256.toRaw sha) <> netword size' <> (case ft of FTNormal -> "N" @@ -661,7 +663,7 @@ parseTree' bs0 = do takeSha bs = do let (x, y) = B.splitAt 32 bs - x' <- either (const Nothing) Just (mkStaticSHA256FromRaw x) + x' <- either (const Nothing) Just (SHA256.fromRaw x) Just (x', y) takeNetword = diff --git a/subs/pantry/test/Pantry/CabalSpec.hs b/subs/pantry/test/Pantry/CabalSpec.hs index 5f1bc9adbc..54b606fcb5 100644 --- a/subs/pantry/test/Pantry/CabalSpec.hs +++ b/subs/pantry/test/Pantry/CabalSpec.hs @@ -4,16 +4,18 @@ module Pantry.CabalSpec (spec) where import Test.Hspec import Pantry +import qualified Pantry.SHA256 as SHA256 import RIO import Distribution.Types.PackageName (mkPackageName) import Distribution.Types.Version (mkVersion) -import Pantry.StaticSHA256 spec :: Spec spec = describe "wrong cabal file" $ do let test name action = it name (runPantryApp action :: IO ()) shouldThrow' x y = withRunInIO $ \run -> run x `shouldThrow` y test "Hackage" $ do + sha <- either throwIO pure + $ SHA256.fromHexBytes "71c2c685a932cd3a70ec52d7bd0ec96ecbfa5e31e22130099cd50fa073ad1a69" let pli = PLIHackage (PackageIdentifierRevision @@ -25,7 +27,6 @@ spec = describe "wrong cabal file" $ do name = mkPackageName "acme-missiles" version2 = mkVersion [0, 2] version3 = mkVersion [0, 3] - Right sha = mkStaticSHA256FromText "71c2c685a932cd3a70ec52d7bd0ec96ecbfa5e31e22130099cd50fa073ad1a69" size = FileSize 597 go `shouldThrow'` \e -> case e of @@ -43,12 +44,15 @@ spec = describe "wrong cabal file" $ do _ -> False test "tarball with wrong ident" $ do + archiveHash' <- either throwIO pure + $ SHA256.fromHexBytes "b5a582209c50e4a61e4b6c0fb91a6a7d65177a881225438b0144719bc3682c3a" + sha <- either throwIO pure + $ SHA256.fromHexBytes "71c2c685a932cd3a70ec52d7bd0ec96ecbfa5e31e22130099cd50fa073ad1a69" let pli = PLIArchive archive pm archive = Archive { archiveLocation = ALUrl "https://github.com/yesodweb/yesod/archive/yesod-auth-1.6.4.1.tar.gz" - , archiveHash = either impureThrow Just - $ mkStaticSHA256FromText "b5a582209c50e4a61e4b6c0fb91a6a7d65177a881225438b0144719bc3682c3a" + , archiveHash = Just archiveHash' , archiveSize = Just $ FileSize 309199 } pm = @@ -62,14 +66,13 @@ spec = describe "wrong cabal file" $ do go = parseCabalFileImmutable pli acmeMissiles = mkPackageName "acme-missiles" version2 = mkVersion [0, 2] - Right sha = mkStaticSHA256FromText "71c2c685a932cd3a70ec52d7bd0ec96ecbfa5e31e22130099cd50fa073ad1a69" go `shouldThrow'` \e -> case e of MismatchedPackageMetadata pli' pm' cabal ident -> pli == pli' && pm == pm' && cabal == BlobKey - (either impureThrow id $ mkStaticSHA256FromText "940d82426ad1db0fcc978c0f386ac5d06df019546071993cb7c6633f1ad17d50") + (either impureThrow id $ SHA256.fromHexBytes "940d82426ad1db0fcc978c0f386ac5d06df019546071993cb7c6633f1ad17d50") (FileSize 3038) && ident == PackageIdentifier (mkPackageName "yesod-auth") @@ -77,12 +80,14 @@ spec = describe "wrong cabal file" $ do _ -> False test "tarball with wrong cabal file" $ do + sha <- either throwIO pure + $ SHA256.fromHexBytes "71c2c685a932cd3a70ec52d7bd0ec96ecbfa5e31e22130099cd50fa073ad1a69" let pli = PLIArchive archive pm archive = Archive { archiveLocation = ALUrl "https://github.com/yesodweb/yesod/archive/yesod-auth-1.6.4.1.tar.gz" , archiveHash = either impureThrow Just - $ mkStaticSHA256FromText "b5a582209c50e4a61e4b6c0fb91a6a7d65177a881225438b0144719bc3682c3a" + $ SHA256.fromHexBytes "b5a582209c50e4a61e4b6c0fb91a6a7d65177a881225438b0144719bc3682c3a" , archiveSize = Just $ FileSize 309199 } pm = @@ -96,14 +101,13 @@ spec = describe "wrong cabal file" $ do go = parseCabalFileImmutable pli yesodAuth = mkPackageName "yesod-auth" version = mkVersion [1, 6, 4, 1] - Right sha = mkStaticSHA256FromText "71c2c685a932cd3a70ec52d7bd0ec96ecbfa5e31e22130099cd50fa073ad1a69" go `shouldThrow'` \e -> case e of MismatchedPackageMetadata pli' pm' cabal ident -> pli == pli' && pm == pm' && cabal == BlobKey - (either impureThrow id $ mkStaticSHA256FromText "940d82426ad1db0fcc978c0f386ac5d06df019546071993cb7c6633f1ad17d50") + (either impureThrow id $ SHA256.fromHexBytes "940d82426ad1db0fcc978c0f386ac5d06df019546071993cb7c6633f1ad17d50") (FileSize 3038) && ident == PackageIdentifier yesodAuth version _ -> False diff --git a/subs/pantry/test/Pantry/StaticBytesSpec.hs b/subs/pantry/test/Pantry/Internal/StaticBytesSpec.hs similarity index 96% rename from subs/pantry/test/Pantry/StaticBytesSpec.hs rename to subs/pantry/test/Pantry/Internal/StaticBytesSpec.hs index dfca1d44d9..6a8d273859 100644 --- a/subs/pantry/test/Pantry/StaticBytesSpec.hs +++ b/subs/pantry/test/Pantry/Internal/StaticBytesSpec.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} -module Pantry.StaticBytesSpec (spec) where +module Pantry.Internal.StaticBytesSpec (spec) where -import Pantry.StaticBytes import RIO +import Pantry.Internal.StaticBytes import qualified Data.ByteString as B import qualified Data.Vector.Unboxed as VU import qualified Data.Vector.Primitive as VP diff --git a/subs/pantry/test/Pantry/TypesSpec.hs b/subs/pantry/test/Pantry/TypesSpec.hs index ee5e29b71a..c746846062 100644 --- a/subs/pantry/test/Pantry/TypesSpec.hs +++ b/subs/pantry/test/Pantry/TypesSpec.hs @@ -7,8 +7,8 @@ import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Pantry -import Pantry.StaticSHA256 -import Pantry.Types (parseTree, renderTree, Tree (..), TreeEntry (..), mkSafeFilePath) +import qualified Pantry.SHA256 as SHA256 +import Pantry.Internal (parseTree, renderTree, Tree (..), TreeEntry (..), mkSafeFilePath) import RIO import Distribution.Types.Version (mkVersion) import qualified RIO.Text as T @@ -21,8 +21,8 @@ hh name p = it name $ do genBlobKey :: Gen BlobKey genBlobKey = BlobKey <$> genSha256 <*> (FileSize <$> (Gen.word (Range.linear 1 10000))) -genSha256 :: Gen StaticSHA256 -genSha256 = mkStaticSHA256FromBytes <$> Gen.bytes (Range.linear 1 500) +genSha256 :: Gen SHA256 +genSha256 = SHA256.hashBytes <$> Gen.bytes (Range.linear 1 500) spec :: Spec spec = do