Expose less from pantry, much nicer SHA256 module

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 ()

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

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

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

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

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.

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__"

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

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

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

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)
 

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,15 +110,15 @@ 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
   (sha, size) <- withBinaryFile fp ReadMode $ \h -> 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)

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

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