{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TemplateHaskell #-}
{-# Language QuasiQuotes #-}
module Yesod.Static.Streamly.Internal (
mkStaticFilesStreamly,
mkStaticFilesStreamly',
mkStaticFilesListStreamly,
mkStaticFilesListStreamly',
cachedETagLookupStreamly,
mkHashMapStreamly,
notHiddenStreamly,
getFileListPiecesStreamly,
pathFromRawPiecesStreamly,
base64md5FileStreamly,
base64Streamly,
hashFileStreamly,
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 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.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.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 WaiAppStatic.Storage.Filesystem (ETagLookup)
import Yesod.Static
mkStaticFilesStreamly :: FilePath
-> Q [Dec]
mkStaticFilesStreamly :: FilePath -> Q [Dec]
mkStaticFilesStreamly FilePath
fp = FilePath -> Bool -> Q [Dec]
mkStaticFilesStreamly' FilePath
fp Bool
True
mkStaticFilesStreamly' :: FilePath
-> Bool
-> Q [Dec]
mkStaticFilesStreamly' :: FilePath -> Bool -> Q [Dec]
mkStaticFilesStreamly' FilePath
fp Bool
makeHash = do
[[FilePath]]
fs <- IO [[FilePath]] -> Q [[FilePath]]
forall a. IO a -> Q a
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO [[FilePath]] -> Q [[FilePath]])
-> IO [[FilePath]] -> Q [[FilePath]]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [[FilePath]]
getFileListPiecesStreamly FilePath
fp
FilePath -> [[FilePath]] -> Bool -> Q [Dec]
mkStaticFilesListStreamly FilePath
fp [[FilePath]]
fs Bool
makeHash
mkStaticFilesListStreamly :: FilePath
-> [[String]]
-> Bool
-> Q [Dec]
mkStaticFilesListStreamly :: FilePath -> [[FilePath]] -> Bool -> Q [Dec]
mkStaticFilesListStreamly FilePath
fp [[FilePath]]
fs Bool
makeHash = FilePath -> [([FilePath], [FilePath])] -> Bool -> Q [Dec]
mkStaticFilesListStreamly' FilePath
fp ([[FilePath]] -> [[FilePath]] -> [([FilePath], [FilePath])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[FilePath]]
fs [[FilePath]]
fs) Bool
makeHash
mkStaticFilesListStreamly' :: FilePath
-> [([String], [String])]
-> Bool
-> Q [Dec]
mkStaticFilesListStreamly' :: FilePath -> [([FilePath], [FilePath])] -> Bool -> Q [Dec]
mkStaticFilesListStreamly' FilePath
fp [([FilePath], [FilePath])]
fs Bool
makeHash = do
[[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (([FilePath], [FilePath]) -> Q [Dec])
-> [([FilePath], [FilePath])] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
Control.Monad.State.Lazy.mapM ([FilePath], [FilePath]) -> Q [Dec]
forall {b} {m :: * -> *}.
(Item b ~ Dec, Quote m, Quasi m, IsList b) =>
([FilePath], [FilePath]) -> m b
mkRoute [([FilePath], [FilePath])]
fs
where
replace' :: Char -> Char
replace' Char
c
| Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' = Char
c
| Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z' = Char
c
| Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Char
c
| Bool
otherwise = Char
'_'
mkRoute :: ([FilePath], [FilePath]) -> m b
mkRoute ([FilePath]
alias,[FilePath]
f) = do
let name' :: FilePath
name' = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
Data.List.intercalate FilePath
"_" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
replace') [FilePath]
alias
routeName :: Name
routeName = FilePath -> Name
mkName (FilePath -> Name) -> FilePath -> Name
forall a b. (a -> b) -> a -> b
$
case () of
()
| FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
name' -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"null-named file"
| Char -> Bool
isDigit (FilePath -> Char
forall a. HasCallStack => [a] -> a
head FilePath
name') -> Char
'_' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
name'
| Char -> Bool
isLower (FilePath -> Char
forall a. HasCallStack => [a] -> a
head FilePath
name') -> FilePath
name'
| Bool
otherwise -> Char
'_' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
name'
Exp
f' <- [|map pack $([FilePath] -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => [FilePath] -> m Exp
TH.lift [FilePath]
f)|]
Exp
qs <- if Bool
makeHash
then do FilePath
hash <- IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
base64md5FileStreamly (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
pathFromRawPiecesStreamly FilePath
fp [FilePath]
f
[|[(pack "etag", pack $(FilePath -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => FilePath -> m Exp
TH.lift FilePath
hash))]|]
else Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> m Exp) -> Exp -> m Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
ListE []
b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
[ Name -> Type -> Dec
SigD Name
routeName (Type -> Dec) -> Type -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Type
ConT ''StaticRoute
, Name -> [Clause] -> Dec
FunD Name
routeName
[ [Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ (Name -> Exp
ConE 'StaticRoute) Exp -> Exp -> Exp
`AppE` Exp
f' Exp -> Exp -> Exp
`AppE` Exp
qs) []
]
]
cachedETagLookupStreamly :: FilePath
-> IO ETagLookup
cachedETagLookupStreamly :: FilePath -> IO ETagLookup
cachedETagLookupStreamly FilePath
dir = do
Map FilePath ByteString
etags <- FilePath -> IO (Map FilePath ByteString)
mkHashMapStreamly FilePath
dir
ETagLookup -> IO ETagLookup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ETagLookup -> IO ETagLookup) -> ETagLookup -> IO ETagLookup
forall a b. (a -> b) -> a -> b
$ (\FilePath
f -> Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> Map FilePath ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
f Map FilePath ByteString
etags)
mkHashMapStreamly :: FilePath
-> IO (M.Map FilePath S8.ByteString)
mkHashMapStreamly :: FilePath -> IO (Map FilePath ByteString)
mkHashMapStreamly FilePath
dir = do
[[FilePath]]
fs <- FilePath -> IO [[FilePath]]
getFileListPiecesStreamly FilePath
dir
[[FilePath]] -> IO [(FilePath, ByteString)]
hashAlist [[FilePath]]
fs IO [(FilePath, ByteString)]
-> ([(FilePath, ByteString)] -> IO (Map FilePath ByteString))
-> IO (Map FilePath ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map FilePath ByteString -> IO (Map FilePath ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FilePath ByteString -> IO (Map FilePath ByteString))
-> ([(FilePath, ByteString)] -> Map FilePath ByteString)
-> [(FilePath, ByteString)]
-> IO (Map FilePath ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, ByteString)] -> Map FilePath ByteString
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
where
hashAlist :: [[String]]
-> IO [(FilePath,S8.ByteString)]
hashAlist :: [[FilePath]] -> IO [(FilePath, ByteString)]
hashAlist [[FilePath]]
fs = ([FilePath] -> IO (FilePath, ByteString))
-> [[FilePath]] -> IO [(FilePath, ByteString)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
Control.Monad.State.Lazy.mapM [FilePath] -> IO (FilePath, ByteString)
hashPair [[FilePath]]
fs
where
hashPair :: [String]
-> IO (FilePath,S8.ByteString)
hashPair :: [FilePath] -> IO (FilePath, ByteString)
hashPair [FilePath]
pieces = do let file :: FilePath
file = FilePath -> [FilePath] -> FilePath
pathFromRawPiecesStreamly FilePath
dir [FilePath]
pieces
FilePath
h <- FilePath -> IO FilePath
base64md5FileStreamly FilePath
file
(FilePath, ByteString) -> IO (FilePath, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file, FilePath -> ByteString
S8.pack FilePath
h)
notHiddenStreamly :: FilePath
-> Bool
notHiddenStreamly :: FilePath -> Bool
notHiddenStreamly FilePath
"tmp" = Bool
False
notHiddenStreamly FilePath
s =
case FilePath
s of
Char
'.':FilePath
_ -> Bool
False
FilePath
_ -> Bool
True
getFileListPiecesStreamly :: FilePath
-> IO [[String]]
getFileListPiecesStreamly :: FilePath -> IO [[FilePath]]
getFileListPiecesStreamly = (StateT (Map FilePath FilePath) IO [[FilePath]]
-> Map FilePath FilePath -> IO [[FilePath]])
-> Map FilePath FilePath
-> StateT (Map FilePath FilePath) IO [[FilePath]]
-> IO [[FilePath]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Map FilePath FilePath) IO [[FilePath]]
-> Map FilePath FilePath -> IO [[FilePath]]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Map FilePath FilePath
forall k a. Map k a
M.empty (StateT (Map FilePath FilePath) IO [[FilePath]] -> IO [[FilePath]])
-> (FilePath -> StateT (Map FilePath FilePath) IO [[FilePath]])
-> FilePath
-> IO [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
-> ([FilePath] -> [FilePath])
-> StateT (Map FilePath FilePath) IO [[FilePath]])
-> ([FilePath] -> [FilePath])
-> FilePath
-> StateT (Map FilePath FilePath) IO [[FilePath]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath
-> ([FilePath] -> [FilePath])
-> StateT (Map FilePath FilePath) IO [[FilePath]]
go [FilePath] -> [FilePath]
forall a. a -> a
id
where
go :: String
-> ([String] -> [String])
-> StateT (M.Map String String) IO [[String]]
go :: FilePath
-> ([FilePath] -> [FilePath])
-> StateT (Map FilePath FilePath) IO [[FilePath]]
go FilePath
fp [FilePath] -> [FilePath]
front = do
[FilePath]
allContents <- IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall a. IO a -> StateT (Map FilePath FilePath) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath])
-> IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter FilePath -> Bool
notHiddenStreamly) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO [FilePath]
getDirectoryContents FilePath
fp
let fullPath :: String -> String
fullPath :: FilePath -> FilePath
fullPath FilePath
f = FilePath
fp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
f
[FilePath]
files <- IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall a. IO a -> StateT (Map FilePath FilePath) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath])
-> IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
Control.Monad.State.Lazy.filterM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
fullPath) [FilePath]
allContents
let files' :: [[FilePath]]
files' = (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> [FilePath]
front ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return) [FilePath]
files
[[FilePath]]
files'' <- ([FilePath] -> StateT (Map FilePath FilePath) IO [FilePath])
-> [[FilePath]] -> StateT (Map FilePath FilePath) IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
Control.Monad.State.Lazy.mapM [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
dedupe [[FilePath]]
files'
[FilePath]
dirs <- IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall a. IO a -> StateT (Map FilePath FilePath) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath])
-> IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
Control.Monad.State.Lazy.filterM (FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
fullPath) [FilePath]
allContents
[[[FilePath]]]
dirs' <- (FilePath -> StateT (Map FilePath FilePath) IO [[FilePath]])
-> [FilePath] -> StateT (Map FilePath FilePath) IO [[[FilePath]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
Control.Monad.State.Lazy.mapM (\FilePath
f -> FilePath
-> ([FilePath] -> [FilePath])
-> StateT (Map FilePath FilePath) IO [[FilePath]]
go (FilePath -> FilePath
fullPath FilePath
f) ([FilePath] -> [FilePath]
front ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) FilePath
f)) [FilePath]
dirs
[[FilePath]] -> StateT (Map FilePath FilePath) IO [[FilePath]]
forall a. a -> StateT (Map FilePath FilePath) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[FilePath]] -> StateT (Map FilePath FilePath) IO [[FilePath]])
-> [[FilePath]] -> StateT (Map FilePath FilePath) IO [[FilePath]]
forall a b. (a -> b) -> a -> b
$ [[[FilePath]]] -> [[FilePath]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[FilePath]]] -> [[FilePath]]) -> [[[FilePath]]] -> [[FilePath]]
forall a b. (a -> b) -> a -> b
$ [[FilePath]]
files'' [[FilePath]] -> [[[FilePath]]] -> [[[FilePath]]]
forall a. a -> [a] -> [a]
: [[[FilePath]]]
dirs'
dedupe :: [String]
-> StateT (M.Map String String) IO [String]
dedupe :: [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
dedupe = (FilePath -> StateT (Map FilePath FilePath) IO FilePath)
-> [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
Control.Monad.State.Lazy.mapM FilePath -> StateT (Map FilePath FilePath) IO FilePath
dedupe'
dedupe' :: String
-> StateT (M.Map String String) IO String
dedupe' :: FilePath -> StateT (Map FilePath FilePath) IO FilePath
dedupe' FilePath
s = do
Map FilePath FilePath
m <- StateT (Map FilePath FilePath) IO (Map FilePath FilePath)
forall s (m :: * -> *). MonadState s m => m s
get
case FilePath -> Map FilePath FilePath -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
s Map FilePath FilePath
m of
Just FilePath
s' -> FilePath -> StateT (Map FilePath FilePath) IO FilePath
forall a. a -> StateT (Map FilePath FilePath) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
s'
Maybe FilePath
Nothing -> do Map FilePath FilePath -> StateT (Map FilePath FilePath) IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Map FilePath FilePath -> StateT (Map FilePath FilePath) IO ())
-> Map FilePath FilePath -> StateT (Map FilePath FilePath) IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> Map FilePath FilePath -> Map FilePath FilePath
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
s FilePath
s Map FilePath FilePath
m
FilePath -> StateT (Map FilePath FilePath) IO FilePath
forall a. a -> StateT (Map FilePath FilePath) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
s
pathFromRawPiecesStreamly :: FilePath
-> [String]
-> FilePath
pathFromRawPiecesStreamly :: FilePath -> [FilePath] -> FilePath
pathFromRawPiecesStreamly =
(FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FilePath -> FilePath -> FilePath
append
where
append :: FilePath -> FilePath -> FilePath
append FilePath
a FilePath
b = FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
b
base64md5FileStreamly :: FilePath
-> IO String
base64md5FileStreamly :: FilePath -> IO FilePath
base64md5FileStreamly = (Digest MD5 -> FilePath) -> IO (Digest MD5) -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> FilePath
base64Streamly (ByteString -> FilePath)
-> (Digest MD5 -> ByteString) -> Digest MD5 -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest MD5 -> ByteString
forall {bout}. ByteArray bout => Digest MD5 -> bout
encode) (IO (Digest MD5) -> IO FilePath)
-> (FilePath -> IO (Digest MD5)) -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Digest MD5)
forall (m :: * -> *) hash.
(MonadBaseControl IO m, MonadThrow m, MonadIO m,
HashAlgorithm hash) =>
FilePath -> m (Digest hash)
hashFileStreamly
where encode :: Digest MD5 -> bout
encode Digest MD5
d = Digest MD5 -> bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (Digest MD5
d :: Crypto.Hash.Digest MD5)
base64Streamly :: B.ByteString
-> String
base64Streamly :: ByteString -> FilePath
base64Streamly = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
tr
(FilePath -> FilePath)
-> (ByteString -> FilePath) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
Prelude.take Int
8
(FilePath -> FilePath)
-> (ByteString -> FilePath) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
S8.unpack
(ByteString -> FilePath)
-> (ByteString -> ByteString) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Data.ByteString.Base64.encode
where
tr :: Char -> Char
tr Char
'+' = Char
'-'
tr Char
'/' = Char
'_'
tr Char
c = Char
c
hashFileStreamly :: ( MonadBaseControl IO m
, MonadThrow m
, MonadIO m
,Crypto.Hash.IO.HashAlgorithm hash
)
=> FilePath
-> m (Crypto.Hash.Digest hash)
hashFileStreamly :: forall (m :: * -> *) hash.
(MonadBaseControl IO m, MonadThrow m, MonadIO m,
HashAlgorithm hash) =>
FilePath -> m (Digest hash)
hashFileStreamly FilePath
fp = do
Handle
shandle <- IO Handle -> m Handle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
ReadMode
let lazyfile :: Stream m (Array Word8)
lazyfile = Unfold m Handle (Array Word8) -> Handle -> Stream m (Array Word8)
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
S.unfold Unfold m Handle (Array Word8)
forall (m :: * -> *). MonadIO m => Unfold m Handle (Array Word8)
StreamlyFile.chunkReader Handle
shandle
let lazyfilef :: Stream m ByteString
lazyfilef = (Config -> Config) -> Stream m ByteString -> Stream m ByteString
forall (m :: * -> *) a.
MonadAsync m =>
(Config -> Config) -> Stream m a -> Stream m a
StreamlyPrelude.parEval Config -> Config
forall a. a -> a
id
((Array Word8 -> ByteString)
-> Stream m (Array Word8) -> Stream m ByteString
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array Word8 -> ByteString
StreamlyByteString.fromArray Stream m (Array Word8)
lazyfile)
ByteString
lazyfileff <- Fold m ByteString ByteString -> Stream m ByteString -> m ByteString
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
S.fold ((ByteString -> ByteString -> ByteString)
-> ByteString -> Fold m ByteString ByteString
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
Fold.foldl' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) ByteString
forall a. Monoid a => a
mempty) Stream m ByteString
lazyfilef
ByteString -> m (Digest hash)
forall (m :: * -> *) hash.
(Monad m, HashAlgorithm hash) =>
ByteString -> m (Digest hash)
sinkHashStreamly ByteString
lazyfileff
sinkHashStreamly :: ( Monad m
, Crypto.Hash.IO.HashAlgorithm hash
)
=> B.ByteString
-> m (Crypto.Hash.Digest hash)
sinkHashStreamly :: forall (m :: * -> *) hash.
(Monad m, HashAlgorithm hash) =>
ByteString -> m (Digest hash)
sinkHashStreamly ByteString
bscontent = Digest hash -> m (Digest hash)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Digest hash -> m (Digest hash)) -> Digest hash -> m (Digest hash)
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest hash
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ByteString
bscontent