diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -28,4 +28,8 @@ ## 0.1.3.2 -- 2023-07-07 -* Updated bounds for template-haskell dependency. +* Updated bounds for template-haskell dependency. + +## 0.1.3.3 -- 2023-07-07 + +* Rework of the sinkHashStreamly and hashFileStreamly functions in Yesod.Static.Streamly.Internal. diff --git a/src/Yesod/Static/Streamly/Internal.hs b/src/Yesod/Static/Streamly/Internal.hs --- a/src/Yesod/Static/Streamly/Internal.hs +++ b/src/Yesod/Static/Streamly/Internal.hs @@ -48,31 +48,27 @@ sinkHashStreamly ) where +import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.State.Lazy import "cryptonite" Crypto.Hash (hash,Digest,MD5) import "cryptonite" Crypto.Hash.IO (HashAlgorithm) -import "cryptohash" Crypto.Hash (hashInit,hashUpdate) -import "cryptohash" Crypto.Hash.Types -import Data.Byteable import qualified Data.ByteArray as ByteArray import Data.ByteString as B (ByteString) import qualified Data.ByteString.Base64 import qualified Data.ByteString.Char8 as S8 -import Data.ByteString.Lazy as L (fromStrict) -import Data.ByteString.Lazy.Internal as IL (ByteString(..)) import Data.Char (isLower,isDigit) import Data.List (foldl',intercalate,sort) import qualified Data.Map as M import Language.Haskell.TH import Language.Haskell.TH.Syntax as TH import qualified Streamly.Data.Stream as S +import Streamly.Data.Stream.Prelude as StreamlyPrelude import qualified Streamly.Data.Fold as Fold import Streamly.External.ByteString as StreamlyByteString -import Streamly.Internal.Data.Stream.StreamD.Type (Step(..)) -import Streamly.Internal.Data.Unfold.Type as StreamU (Unfold(..)) import Streamly.FileSystem.Handle as StreamlyFile (chunkReader) +import Streamly.Internal.Data.Stream.MkType (MonadThrow) import System.Directory (doesDirectoryExist,doesFileExist,getDirectoryContents) -import System.IO (openFile, IOMode(ReadMode)) +import System.IO (openFile,IOMode(ReadMode)) import WaiAppStatic.Storage.Filesystem (ETagLookup) import Yesod.Static @@ -108,7 +104,7 @@ -> Bool -- ^ append checksum query parameter -> Q [Dec] mkStaticFilesListStreamly' fp fs makeHash = do - concat `fmap` mapM mkRoute fs + concat `fmap` Control.Monad.State.Lazy.mapM mkRoute fs where replace' c | 'A' <= c && c <= 'Z' = c @@ -154,7 +150,7 @@ where hashAlist :: [[String]] -> IO [(FilePath,S8.ByteString)] - hashAlist fs = mapM hashPair fs + hashAlist fs = Control.Monad.State.Lazy.mapM hashPair fs where hashPair :: [String] -> IO (FilePath,S8.ByteString) @@ -182,20 +178,20 @@ -> ([String] -> [String]) -> StateT (M.Map String String) IO [[String]] go fp front = do - allContents <- liftIO $ (sort . filter notHiddenStreamly) `fmap` getDirectoryContents fp + allContents <- liftIO $ (sort . Prelude.filter notHiddenStreamly) `fmap` getDirectoryContents fp let fullPath :: String -> String fullPath f = fp ++ '/' : f - files <- liftIO $ filterM (doesFileExist . fullPath) allContents + files <- liftIO $ Control.Monad.State.Lazy.filterM (doesFileExist . fullPath) allContents let files' = map (front . return) files - files'' <- mapM dedupe files' - dirs <- liftIO $ filterM (doesDirectoryExist . fullPath) allContents - dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs + files'' <- Control.Monad.State.Lazy.mapM dedupe files' + dirs <- liftIO $ Control.Monad.State.Lazy.filterM (doesDirectoryExist . fullPath) allContents + dirs' <- Control.Monad.State.Lazy.mapM (\f -> go (fullPath f) (front . (:) f)) dirs return $ concat $ files'' : dirs' -- Reuse data buffers for identical strings dedupe :: [String] -> StateT (M.Map String String) IO [String] - dedupe = mapM dedupe' + dedupe = Control.Monad.State.Lazy.mapM dedupe' dedupe' :: String -> StateT (M.Map String String) IO String @@ -228,7 +224,7 @@ base64Streamly :: B.ByteString -> String base64Streamly = map tr - . take 8 + . Prelude.take 8 . S8.unpack . Data.ByteString.Base64.encode where @@ -239,32 +235,28 @@ -- | A more performant replacement of -- [hashFile](https://hackage.haskell.org/package/cryptohash-conduit-0.1.1/docs/src/Crypto-Hash-Conduit.html#hashFile) -- found in [Crypto.Hash.Conduit](https://hackage.haskell.org/package/cryptohash-conduit-0.1.1/docs/Crypto-Hash-Conduit.html). -hashFileStreamly :: (MonadIO m,Crypto.Hash.IO.HashAlgorithm hash) +hashFileStreamly :: ( MonadBaseControl IO m + , MonadThrow m + , MonadIO m + ,Crypto.Hash.IO.HashAlgorithm hash + ) => FilePath -> m (Crypto.Hash.Digest hash) hashFileStreamly fp = do - handle <- liftIO $ openFile fp ReadMode - let lazyfile = S.unfold StreamlyFile.chunkReader handle - lazyfilebs <- S.fold (Fold.foldl' (<>) mempty) $ - fmap StreamlyByteString.fromArray lazyfile - sinkHashStreamly lazyfilebs - + shandle <- liftIO $ openFile fp ReadMode + let lazyfile = S.unfold StreamlyFile.chunkReader shandle + let lazyfilef = StreamlyPrelude.parEval id + (fmap StreamlyByteString.fromArray lazyfile) + lazyfileff <- S.fold (Fold.foldl' (<>) mempty) lazyfilef + sinkHashStreamly lazyfileff + -- | A more performant replacement of -- [sinkHash](https://hackage.haskell.org/package/cryptohash-conduit-0.1.1/docs/src/Crypto-Hash-Conduit.html#sinkHash) -- found in [Crypto.Hash.Conduit](https://hackage.haskell.org/package/cryptohash-conduit-0.1.1/docs/Crypto-Hash-Conduit.html). -sinkHashStreamly :: (Monad m,Crypto.Hash.IO.HashAlgorithm hash) +sinkHashStreamly :: ( Monad m + , Crypto.Hash.IO.HashAlgorithm hash + ) => B.ByteString -> m (Crypto.Hash.Digest hash) -sinkHashStreamly bscontent = do - let lazybsf = S.unfold (Unfold step seed) blcontent - let lazybsff = fmap (\x -> StreamlyByteString.toArray $ toBytes x) lazybsf - lazybsfff <- S.fold (Fold.foldl' (<>) mempty) $ - fmap StreamlyByteString.fromArray lazybsff - return $ hash lazybsfff - where - blcontent = L.fromStrict bscontent - ctx = hashInit :: Context MD5 - seed = return - step (Chunk bs bl) = return $ Yield (hashUpdate ctx bs) bl - step Empty = return Stop +sinkHashStreamly bscontent = return $ hash bscontent diff --git a/yesod-static-streamly.cabal b/yesod-static-streamly.cabal --- a/yesod-static-streamly.cabal +++ b/yesod-static-streamly.cabal @@ -20,7 +20,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.3.2 +version: 0.1.3.3 -- A short (one-line) description of the package. synopsis: A streamly-based library providing performance-focused alternatives for functionality found in yesod-static. @@ -80,14 +80,14 @@ -- Other library packages from which modules are imported. build-depends: base ^>=4.17.1.0, base64-bytestring >= 1.2.1 && < 1.3, - byteable >= 0.1.1 && < 0.2, bytestring >= 0.11.4 && < 0.12, - containers >= 0.6.7 && < 0.7, - cryptohash >= 0.11.9 && < 0.12, + containers >= 0.6.7 && < 0.7, cryptonite >= 0.30 && < 0.31, directory >= 1.3.7 && < 1.4, memory >= 0.18.0 && < 0.19, + monad-control >= 1.0.3 && < 1.1, mtl >= 2.2.2 && < 2.3, + streamly >= 0.9.0 && < 0.10, streamly-bytestring >= 0.2.0 && < 0.3, streamly-core >= 0.1.0 && < 0.2, template-haskell >= 2.19.0 && < 2.20,