hasherize (empty) → 0.0.0.0

raw patch · 6 files changed

+405/−0 lines, 6 filesdep +basedep +base16-bytestringdep +bytestring

Dependencies added: base, base16-bytestring, bytestring, cassava, containers, cryptohash-sha256, directory, envparse, file-io, filepath, hasherize, ki, mtl, qsem, quaalude, safe-exceptions, stm, text, unfork, vector

Files

• changelog.md +3/−0
• executable/Main.hs +142/−0
• hasherize.cabal +70/−0
• library/Hasherize.hs +95/−0
• license.txt +13/−0
• readme.md +82/−0

@@ -0,0 +1,3 @@+## 0.0.0.0 - 2023-07-04++Initial release

@@ -0,0 +1,142 @@+module Main (main) where++import Control.Concurrent (getNumCapabilities)+import Control.Exception.Safe (bracket_, displayException)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.STM (atomically)+import Data.ByteString (ByteString)+import Data.ByteString.Base16 qualified as Base16+import Data.ByteString.Builder qualified as BSB+import Data.ByteString.Lazy qualified as LBS+import Data.Csv qualified as CSV+import Data.Csv.Builder qualified as CSV.Builder+import Data.Either (Either (..))+import Data.Foldable (for_)+import Data.String (String)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Vector qualified as Vector+import Env qualified+import Essentials+import Hasherize (getHash)+import Ki qualified+import QSem (newQSem, signalQSem, waitQSem)+import System.Directory.OsPath qualified as Dir+import System.File.OsPath qualified as OsPath (withFile)+import System.IO (Handle, IO)+import System.IO qualified as IO+import System.OsPath (OsPath, (</>))+import System.OsPath qualified as OsPath+import System.OsString (OsString, osstr)+import Unfork (unforkAsyncIO_)+import Prelude ((*))++main :: IO ()+main = do+  -- Read environment variables+  Env {inputDirectory, outputDirectory, outputManifest} <- getHasherizeArgs++  -- Get a list of all the inputs+  inputNameList <- Dir.listDirectory inputDirectory++  capabilities <- getNumCapabilities++  -- How many threads+  let concurrency = capabilities * 2++  -- Set up a thread-safe function to write to the manifest CSV+  withManifestWriter outputManifest \writeToManifest' ->+    -- Establish a thread scope to start forking threads+    liftIO $ Ki.scoped \scope -> do+      semaphore <- newQSem concurrency++      -- Loop over the list of inputs+      for_ inputNameList \(inputName :: OsString) ->+        bracket_ (waitQSem semaphore) (signalQSem semaphore) $+          -- Start one thread per input+          Ki.fork scope do+            -- Create a symlink from original path to hashed path+            entry <- hasherize inputDirectory outputDirectory inputName+            -- Record the mapping in the manifest CSV+            writeToManifest' entry++      -- Wait for all threads to finish+      atomically $ Ki.awaitAll scope++hasherize ::+  (MonadIO m) =>+  -- | Input directory+  OsPath ->+  -- | Output directory+  OsPath ->+  -- | Name of file or directory being hasherized+  OsPath ->+  m (ManifestEntry ByteString)+hasherize inDirectory outDirectory inputName = do+  inputNameString :: String <- liftIO $ OsPath.decodeUtf inputName+  let inputNameText :: Text = Text.pack inputNameString++  -- How we'll refer to the input in filesystem operations+  let inputPath = inDirectory </> inputName++  -- Hash of the content+  hashText :: Text <- do+    hash :: ByteString <- getHash inputPath+    pure $ Text.decodeUtf8 $ Base16.encode hash++  -- The new input name with the hash included+  nameWithHash :: OsPath <- do+    hashOsString :: OsString <- liftIO $ OsPath.encodeUtf $ Text.unpack hashText+    pure $ hashOsString <> [osstr|-|] <> inputName++  -- Place the content in the output directory under its new alias+  createLink inputPath (outDirectory </> nameWithHash)++  -- Return the mapping to store in the manifest CSV+  pure $+    fmap Text.encodeUtf8 $+      ManifestEntry inputNameText (hashText <> "-" <> inputNameText)++data ManifestEntry a = ManifestEntry a a+  deriving stock (Functor, Foldable, Traversable)++instance CSV.ToRecord (ManifestEntry ByteString) where+  toRecord (ManifestEntry k v) = Vector.fromList [k, v]++createLink :: (MonadIO m) => OsPath -> OsPath -> m ()+createLink target source = do+  isDir <- liftIO $ Dir.doesDirectoryExist target+  target' <- liftIO $ Dir.makeAbsolute target+  liftIO $ (if isDir then Dir.createDirectoryLink else Dir.createFileLink) target' source++withManifestWriter ::+  (MonadIO m) =>+  OsPath ->+  ((ManifestEntry ByteString -> IO ()) -> IO a) ->+  m a+withManifestWriter path continue = liftIO $+  OsPath.withFile path IO.WriteMode \handle ->+    liftIO $ unforkAsyncIO_ (writeToManifest handle) continue++writeToManifest :: Handle -> ManifestEntry ByteString -> IO ()+writeToManifest handle =+  LBS.hPutStr handle . BSB.toLazyByteString . CSV.Builder.encodeRecord++data Env = Env+  { inputDirectory :: OsString,+    outputDirectory :: OsString,+    outputManifest :: OsString+  }++getHasherizeArgs :: (MonadIO m) => m Env+getHasherizeArgs = liftIO $ Env.parse id do+  inputDirectory <- Env.var pathReader "input-directory" mempty+  outputDirectory <- Env.var pathReader "output-directory" mempty+  outputManifest <- Env.var pathReader "output-manifest" mempty+  pure Env {inputDirectory, outputDirectory, outputManifest}++pathReader :: Env.Reader Env.Error OsPath+pathReader string = case OsPath.encodeUtf string of+  Left e -> Left $ Env.unread $ displayException e+  Right x -> Right x

@@ -0,0 +1,70 @@+cabal-version: 3.0++name: hasherize+version: 0.0.0.0+synopsis: Hash digests for files and directories+category: Filesystem, Hash++description:+    This library can produce a hash for filesystem content, which can be+    either a file or a directory.++    The name of the file or directory is not included in the hash digest.+    The digest of a directory is based on the names and contents of the+    files contained therein.+    No other filesystem metadata (timestamps, permissions, etc.) is+    included in the digest.++license: Apache-2.0+license-file: license.txt++author: Chris Martin+maintainer: Chris Martin, Julie Moronuki++homepage: https://github.com/typeclasses/hasherize++extra-source-files: *.md++common base+    default-language: GHC2021+    ghc-options: -Wall+    default-extensions:+        ApplicativeDo+        BlockArguments+        DerivingStrategies+        LambdaCase+        NoImplicitPrelude+        OverloadedStrings+        QuasiQuotes+    build-depends:+      , base ^>= 4.18+      , bytestring ^>= 0.11+      , containers ^>= 0.6.7+      , cryptohash-sha256 ^>= 0.11.102+      , directory ^>= 1.3.8+      , file-io ^>= 0.1+      , filepath ^>= 1.4.100+      , mtl ^>= 2.3.1+      , quaalude ^>= 0.0+      , text ^>= 2.0.2++library+    import: base+    hs-source-dirs: library+    exposed-modules: Hasherize++executable hasherize+    import: base+    hs-source-dirs: executable+    main-is: Main.hs+    build-depends:+      , base16-bytestring ^>= 1.0.2+      , cassava ^>= 0.5+      , envparse ^>= 0.5+      , hasherize+      , ki ^>= 1.0+      , qsem ^>= 0.1+      , safe-exceptions ^>= 0.1.7+      , stm ^>= 2.5.1+      , unfork ^>= 1.0.0+      , vector ^>= 0.12.3

@@ -0,0 +1,95 @@+module Hasherize (getHash) where++import Control.Monad (foldM)+import Control.Monad.Fail (fail)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.State (evalState, evalStateT, get, modify')+import Crypto.Hash.SHA256 qualified as Hash+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Foldable (for_)+import Data.Function (fix, flip)+import Data.List (map)+import Data.Map (Map)+import Data.Map qualified as Map+import Data.Sequence (Seq)+import Data.Sequence qualified as Seq+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Essentials+import System.Directory.OsPath qualified as Dir+import System.File.OsPath qualified as OsPath (withFile)+import System.IO qualified as IO+import System.OsPath (OsPath, (</>))+import System.OsPath qualified as OsPath+import Text.Show (show)++-- | Calculate the hash of a file or directory+getHash :: (MonadIO m) => OsPath -> m ByteString+getHash path = do+  files <- Map.toAscList <$> enumerateFiles path+  liftIO $ flip evalStateT Hash.init do+    for_ files \(k, v) -> do+      modify' $ flip Hash.update $ hashAbstractPath k+      modify' . flip Hash.update =<< getFileHash (path <//> v)+    Hash.finalize <$> get++getFileHash :: (MonadIO m) => OsPath -> m ByteString+getFileHash path = liftIO $ OsPath.withFile path IO.ReadMode \handle ->+  flip evalStateT Hash.init $ fix \continue -> do+    bs <- liftIO $ BS.hGetSome handle 4_096+    case BS.null bs of+      True -> Hash.finalize <$> get+      False -> do+        modify' $ flip Hash.update bs+        continue++newtype AbstractPath = AbstractPath (Seq Text)+  deriving newtype (Semigroup, Monoid, Eq, Ord)+  deriving stock (Show)++hashAbstractPath :: AbstractPath -> ByteString+hashAbstractPath (AbstractPath xs) = flip evalState Hash.init do+  for_ xs \x -> do+    modify' $ flip Hash.update $ Hash.hash $ Text.encodeUtf8 x+  Hash.finalize <$> get++abstractPathSingleton :: Text -> AbstractPath+abstractPathSingleton = AbstractPath . Seq.singleton++data OsPath' = This | OsPath' OsPath+  deriving stock (Show)++(<//>) :: OsPath -> OsPath' -> OsPath+(<//>) x = \case This -> x; OsPath' y -> (x </> y)++enumerateFiles :: forall m. (MonadIO m) => OsPath -> m (Map AbstractPath OsPath')+enumerateFiles x =+  getFType x >>= \case+    File -> pure (Map.singleton mempty This)+    Directory -> do+      let enumerateChild :: Map AbstractPath OsPath' -> OsPath -> m (Map AbstractPath OsPath')+          enumerateChild m name = do+            nameText <- Text.pack <$> liftIO (OsPath.decodeUtf name)++            let contextualize :: (AbstractPath, OsPath') -> (AbstractPath, OsPath')+                contextualize (k, v) = (abstractPathSingleton nameText <> k, OsPath' (name <//> v))++            m' <- enumerateFiles (x </> name)+            pure $ m <> Map.fromList (map contextualize (Map.toList m'))++      children <- liftIO $ Dir.listDirectory x++      foldM enumerateChild Map.empty children++data FType = File | Directory++getFType :: (MonadIO m) => OsPath -> m FType+getFType x =+  liftIO (Dir.doesFileExist x) >>= \case+    True -> pure File+    False ->+      liftIO (Dir.doesDirectoryExist x) >>= \case+        True -> pure Directory+        False -> liftIO (fail $ "Neither file nor directory: " <> show x)

@@ -0,0 +1,13 @@+Copyright 2023 Mission Valley Software LLC++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.

@@ -0,0 +1,82 @@+## Executable++The `hasherize` executable creates a copy of a directory in which each+direct child of the directory has a hasherized name.++For example, suppose the input directory looks like this:++```+├── favicon.ico+└── fonts+    ├── css+    │   └── fonts.css+    └── fonts+        ├── FiraMono-Bold.woff2+        └── FiraMono-Regular.woff2+```++The output directory will look something like this:++```+├── d7555833df923044e820a82a040850268d80ca2a8b4ade4a7ecb1aaa709f503a-favicon.ico+└── b7114fb092b385a4419e4aafa30075ded6fe3232219dcb75f49afbc24bbee39c-fonts+    ├── css+    │   └── fonts.css+    └── fonts+        ├── FiraMono-Bold.woff2+        └── FiraMono-Regular.woff2+```++Additionally, a CSV file will be generated that maps input names to hashed names:++```+favicon.ico,d7555833df923044e820a82a040850268d80ca2a8b4ade4a7ecb1aaa709f503a-favicon.ico+fonts,b7114fb092b385a4419e4aafa30075ded6fe3232219dcb75f49afbc24bbee39c-fonts+```++### Parameters++The input and output paths must be specified by environment variables:++* `input-directory` - Where to read input from+* `output-directory` - Where to write hashed files to+* `output-manifest` - Where to put the CSV file+++## Library++This library provides a function called `getHash` which computes a hash+of a file or directory.++```haskell+Hasherize.getHash :: (MonadIO m) => OsPath -> m ByteString+```+++## Hashing system++A *path segment* is Unicode text.+The hash of a path segment is the SHA-256 digest of its UTF-8 encoding.++A *path* is a list of path segments.+The hash of a path is determined by hashing each segment, concatenating,+and taking a SHA-256 digest.++An *entry* consists of a path and the content of a file.+The hash of an entry is determined by hashing the path, hashing the+content, concatenating, and taking a SHA-256 digest.++The *enumeration* of a path is a list of entries.++* If the path is a file *x*, its enumeration consists of a single+  entry, *([], x)*.+* If the path is a directory, its enumeration consists of an entry for+  each file recursively contained within the directory, sorted by path.+  We assume that the file system contains no directory cycles.++The result returned by the `getHash` function is produced by enumerating+the path, hashing each entry, concatenating, and taking a SHA-256 digest.++The `hasherize` executable produces a hashed file name by concatenating+the hash digest in hexadecimal form, the hyphen character `-`, and the+original file name.