diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,10 @@ +# Changelog + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## [0.1.0.0] - 2020-11-29 + +First cabal release 🎉🥳 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2020 Jordan Mackie + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,20 @@ +# `kesha` + +[![CI](https://github.com/jmackie/kesha/workflows/CI/badge.svg)](https://github.com/jmackie/kesha/actions?query=workflow%3ACI) +[![Hackage](https://img.shields.io/hackage/v/kesha)](https://hackage.haskell.org/package/kesha) + +A Haskell library for computing the cryptographic hash of any path. + +The implementation is an almost verbatim implementation of `nix-hash`, which is the +standard tool used by the [Nix](https://nixos.org/nix/) package manager. + +```haskell +module Main where + +import qualified Kesha + +main :: IO () +main = do + result <- Kesha.hash "some-path" + print result +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/kesha.cabal b/kesha.cabal new file mode 100644 --- /dev/null +++ b/kesha.cabal @@ -0,0 +1,87 @@ +cabal-version: >= 1.10 + +name: kesha +version: 0.1.0.0 +synopsis: Haskell implementation of nix-hash +description: Compute the cryptographic hash of a path, à la . +homepage: https://github.com/jmackie/kesha +bug-reports: https://github.com/jmackie/kesha/issues +license: MIT +license-file: LICENSE +author: Jordan Mackie +maintainer: contact@jmackie.dev +copyright: (c) 2020 Jordan Mackie +category: System +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +tested-with: + GHC == 8.0.2, + GHC == 8.2.2, + GHC == 8.4.4, + GHC == 8.6.5, + GHC == 8.8.3, + GHC == 8.10.1 + +source-repository head + type: git + location: git://github.com/jmackie/kesha.git + +library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: + -Weverything + -fno-warn-missing-import-lists + -fno-warn-safe + -fno-warn-unsafe + exposed-modules: + Kesha + Kesha.NAR + build-depends: + -- https://wiki.haskell.org/Base_package + -- >= 8.2.2 && < 8.9 + base >= 4.10.1 && < 4.14, + + -- core libraries + binary >= 0.8.6 && < 0.9, + bytestring >= 0.10.8 && < 0.11, + containers >= 0.6.0 && < 0.7, + filepath >= 1.4.2 && < 1.5, + text >= 1.2.3 && < 1.3, + -- 1.3.1.0 introduced `getSymbolicLinkTarget` + directory >= 1.3.1 && < 1.4, + + cryptohash-md5 >= 0.11.100 && < 0.12, + cryptohash-sha1 >= 0.11.100 && < 0.12, + cryptohash-sha256 >= 0.11.101 && < 0.12 + +test-suite test + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + ghc-options: + -Weverything + -fno-warn-missing-import-lists + -fno-warn-safe + -fno-warn-unsafe + + -threaded + -rtsopts + build-depends: + kesha, + + base, + bytestring, + containers, + directory, + filepath, + + -- Test dependencies + process, + hspec, + QuickCheck, + temporary diff --git a/src/Kesha.hs b/src/Kesha.hs new file mode 100644 --- /dev/null +++ b/src/Kesha.hs @@ -0,0 +1,153 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Kesha +-- Copyright: (c) 2020 Jordan Mackie +-- License: MIT +-- Maintainer: Jordan Mackie +-- Stability: experimental +-- Portability: portable +-- +-- An implementation of @@. +module Kesha + ( hash, + hashWith, + HashOptions (..), + defaultHashOptions, + HashAlgo (..), + HashRepr (..), + ) +where + +import qualified Crypto.Hash.MD5 as MD5 +import qualified Crypto.Hash.SHA1 as SHA1 +import qualified Crypto.Hash.SHA256 as SHA256 +import Data.Bits (shiftL, shiftR, (.&.), (.|.)) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as ASCII +import qualified Data.Char as Char +import Data.Maybe (fromJust) +import qualified Data.Sequence as Seq +import Data.Word (Word8) +import qualified Kesha.NAR as NAR +import Prelude hiding ((!!)) + +-- | +-- Compute the cryptographic hash of a path using the 'defaultHashOptions'. +-- +-- The output of @'hash' path@ should be consistent with that of +-- @nix-hash --type sha256 --base32 path@. +hash :: FilePath -> IO (Either NAR.PackError BS.ByteString) +hash = hashWith defaultHashOptions + +-- | +-- Compute the cryptographic hash of a path using the given 'HashOptions'. +hashWith :: HashOptions -> FilePath -> IO (Either NAR.PackError BS.ByteString) +hashWith opts path = + fmap (printNar (hashAlgo opts) (hashRepr opts)) <$> NAR.localPack path + +-- | +-- Hashing options. +data HashOptions = HashOptions + { -- | cryptographic hash algorithm to use + hashAlgo :: HashAlgo, + -- | how to print the hash + hashRepr :: HashRepr + } + +-- | +-- Default hashing options. +-- +-- These are the default options used by most of the Nix tooling (e.g. +-- @nix-prefetch-git@). +defaultHashOptions :: HashOptions +defaultHashOptions = HashOptions SHA256 Base32 + +-- | +-- Available hash algorithms. +data HashAlgo + = MD5 + | SHA1 + | SHA256 + +-- | +-- Printable hash representations. +data HashRepr + = Base16 + | Base32 + +printNar :: HashAlgo -> HashRepr -> NAR.NAR -> BS.ByteString +printNar algo repr = + ASCII.map Char.toLower + . ( case repr of + Base16 -> printHash16 algo + Base32 -> printHash32 algo + ) + . ( case algo of + MD5 -> MD5.hash + SHA1 -> SHA1.hash + SHA256 -> SHA256.hash + ) + . NAR.dump + +-- https://github.com/NixOS/nix/blob/master/src/libutil/hash.cc +printHash16 :: HashAlgo -> BS.ByteString -> BS.ByteString +printHash16 algo rawHash = + ASCII.pack $ + foldMap + ( \i -> + [ base16Chars !! fromIntegral (BS.index rawHash i `shiftR` 4), + base16Chars !! fromIntegral (BS.index rawHash i .&. 15) + ] + ) + [0 .. hashSize - 1] + where + hashSize :: Int + hashSize = hashSizeForAlgo algo + + base16Chars :: Seq.Seq Char + base16Chars = "0123456789abcdef" + +-- https://github.com/NixOS/nix/blob/master/src/libutil/hash.cc +printHash32 :: HashAlgo -> BS.ByteString -> BS.ByteString +printHash32 algo rawHash = go (len - 1) "" + where + hashSize :: Int + hashSize = hashSizeForAlgo algo + + -- omitted: E O U T + base32Chars :: Seq.Seq Char + base32Chars = Seq.fromList "0123456789abcdfghijklmnpqrsvwxyz" + + len :: Int + len = (hashSize * 8 - 1) `div` 5 + 1 + + go :: Int -> BS.ByteString -> BS.ByteString + go n accum + | n < 0 = accum + | otherwise = + go (pred n) $ + ASCII.snoc accum (base32Chars !! (fromIntegral c .&. 0x1f)) + where + b, i, j :: Int + b = n * 5 + i = b `div` 8 + j = b `mod` 8 + c :: Word8 + c = + ((bytes !! i) `shiftR` j) + .|. (if i >= (hashSize - 1) then 0 else (bytes !! (i + 1)) `shiftL` (8 - j)) + + bytes :: Seq.Seq Word8 + bytes = Seq.fromList (BS.unpack rawHash) + +-- https://github.com/NixOS/nix/blob/master/src/libutil/hash.hh +hashSizeForAlgo :: HashAlgo -> Int +hashSizeForAlgo MD5 = 16 +hashSizeForAlgo SHA1 = 20 +hashSizeForAlgo SHA256 = 32 + +(!!) :: Seq.Seq a -> Int -> a +(!!) xs i = fromJust (Seq.lookup i xs) + +infixl 9 !! diff --git a/src/Kesha/NAR.hs b/src/Kesha/NAR.hs new file mode 100644 --- /dev/null +++ b/src/Kesha/NAR.hs @@ -0,0 +1,179 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Kesha.NAR +-- Copyright: (c) 2020 Jordan Mackie +-- License: MIT +-- Maintainer: Jordan Mackie +-- Stability: experimental +-- Portability: portable +-- +-- An implementation of the (NAR). +module Kesha.NAR + ( NAR, + PackError (..), + localPack, + dump, + ) +where + +{- HLINT ignore "Use lambda-case" -} + +import Control.Monad (when) +import Data.Bifunctor (second) +import qualified Data.Binary.Put as Binary +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +import Data.Foldable (for_, traverse_) +import qualified Data.List as List +import qualified Data.Map as Map +import Data.Semigroup ((<>)) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Text.Encoding (encodeUtf8) +import Data.Traversable (for) +import qualified System.Directory as Directory +import System.FilePath (()) +import Prelude + +-- | +-- A packed NAR archive. +newtype NAR = NAR {getFSO :: FSO} + +-- | +-- Errors that can be raised when attempting to pack a path into a NAR archive. +data PackError + = -- | + -- Attempted to pack a path that doesn't exist. + FileDoesNotExist FilePath + | -- | + -- Heuristic for detecting the /type/ of path failed. Where /type/ is one: + -- a regular file, a directory, or a symbolic link. + AmbiguousFileType FilePath + deriving (Show, Eq) + +data FSO + = Regular !IsExecutable !Size !BS.ByteString + | SymLink !UTF8FilePath + | Directory !(Map.Map PathSegment FSO) + +type IsExecutable = Bool + +type Size = Int + +type UTF8FilePath = Text + +type PathSegment = Text -- shouldn't include '/' or 'NUL' ! + +data PathType + = RegularType + | SymLinkType + | DirectoryType + | AmbiguousType + +-- | +-- Create a NAR archive for the given path in a local context. +-- +-- See figure 5.2 of https://nixos.org/~eelco/pubs/phd-thesis.pdf +localPack :: FilePath -> IO (Either PackError NAR) +localPack path = second NAR <$> localPackFSO path + +localPackFSO :: FilePath -> IO (Either PackError FSO) +localPackFSO path = + guessPathType path >>= \guess -> case guess of + Nothing -> + pure $ Left (FileDoesNotExist path) + Just AmbiguousType -> + pure $ Left (AmbiguousFileType path) + Just RegularType -> do + isExecutable <- Directory.executable <$> Directory.getPermissions path + size <- fromIntegral <$> Directory.getFileSize path + contents <- BS.readFile path + let fso = Regular isExecutable size contents + pure $ Right fso + Just SymLinkType -> do + target <- Directory.getSymbolicLinkTarget path + let fso = SymLink (Text.pack target) + pure $ Right fso + Just DirectoryType -> do + fs <- Directory.listDirectory path + entries <- for fs $ \path' -> do + results <- localPackFSO (path path') + pure (Text.pack path', results) + pure $ + second + (Directory . Map.fromList) + (traverse sequence entries) + +-- | +-- Serialize a NAR archive. +dump :: NAR -> BS.ByteString +dump = BSL.toStrict . Binary.runPut . putNAR + +putNAR :: NAR -> Binary.Put +putNAR nar = str "nix-archive-1" <> parens (putFSO (getFSO nar)) + where + putFSO :: FSO -> Binary.Put + putFSO fso = case fso of + Regular isExecutable size contents -> do + strs ["type", "regular"] + when isExecutable $ strs ["executable", ""] + str "contents" + int size + pad size contents + SymLink target -> do + strs ["type", "symlink"] + strs ["target", encodeUtf8 target] + Directory entries -> do + strs ["type", "directory"] + let sortedEntries = List.sortOn fst (Map.toList entries) + for_ sortedEntries $ \(name, node) -> do + str "entry" + parens $ do + str "name" + str (encodeUtf8 name) + str "node" + parens (putFSO node) + + int :: Integral a => a -> Binary.Put + int = Binary.putInt64le . fromIntegral + + parens :: Binary.Put -> Binary.Put + parens m = str "(" >> m >> str ")" + + str :: BS.ByteString -> Binary.Put + str bs = let len = BS.length bs in int len <> pad len bs + + strs :: [BS.ByteString] -> Binary.Put + strs = traverse_ str + + pad :: Int -> BS.ByteString -> Binary.Put + pad n bs = do + Binary.putByteString bs + Binary.putByteString (BS.replicate (padLen n) 0) + + -- Distance to the next multiple of 8 + padLen :: Integral a => a -> a + padLen n = (8 - n) `mod` 8 + +guessPathType :: FilePath -> IO (Maybe PathType) +guessPathType path = do + pathExists <- Directory.doesPathExist path + if not pathExists + then pure Nothing + else do + clues <- + (,,) + -- returns True if the argument file exists and is not a directory, + <$> Directory.doesFileExist path + -- returns True if the argument file exists and is either a directory or + -- a symbolic link to a directory + <*> Directory.doesDirectoryExist path + -- Check whether the path refers to a symbolic link + <*> Directory.pathIsSymbolicLink path + case clues of + (True, False, True) -> pure (Just SymLinkType) + (True, False, False) -> pure (Just RegularType) + (False, True, True) -> pure (Just SymLinkType) + (False, True, False) -> pure (Just DirectoryType) + _ -> pure (Just AmbiguousType) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,294 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main + ( main, + ) +where + +{- HLINT ignore "Redundant do" -} +{- HLINT ignore "Use camelCase" -} +{- HLINT ignore "Use lambda-case" -} + +import Control.Applicative (liftA2) +import Control.Monad (when) +import qualified Data.ByteString as BS +import Data.Foldable (traverse_) +import qualified Data.Map as Map +import Data.Semigroup ((<>)) +import qualified Kesha +import qualified Kesha.NAR +import qualified System.Directory as Directory +import qualified System.Exit as Exit +import System.FilePath (()) +import qualified System.IO.Temp as Temp +import qualified System.Process as Process +import Test.Hspec + ( Expectation, + Spec, + describe, + expectationFailure, + hspec, + it, + shouldBe, + ) +import Test.Hspec.QuickCheck + ( modifyMaxSuccess, + ) +import Test.QuickCheck + ( Arbitrary (arbitrary), + choose, + elements, + oneof, + property, + resize, + scale, + sized, + vectorOf, + ) +import Prelude + +main :: IO () +main = do + exes <- + liftA2 + (,) + (Directory.findExecutable "nix-store") + (Directory.findExecutable "nix-hash") + case exes of + (Nothing, Nothing) -> do + putStrLn "Nix tooling not found on path - skipping tests" + (Just _, Nothing) -> do + putStrLn "`nix-store` not found on path - aborting" + Exit.exitFailure + (Nothing, Just _) -> do + putStrLn "`nix-hash` not found on path - aborting" + Exit.exitFailure + (Just _, Just _) -> + Temp.withSystemTempDirectory "kesha-test" (hspec . spec) + +spec :: FilePath -> Spec +spec tempDir = do + describe "NAR packing" $ do + describe "matches the output of `nix-store --dump`" $ do + modifyMaxSuccess (const 20) $ + it "matches for Regular files" $ + property $ + \regular -> + inTempDirectory tempDir "Regular" $ + checkNAR =<< createFSO_Regular regular + modifyMaxSuccess (const 20) $ + it "matches for SymLinks" $ + property $ + \symLink -> do + inTempDirectory tempDir "SymLink" $ + checkNAR =<< createFSO_SymLink symLink + modifyMaxSuccess (const 20) $ + it "matches for Directories" $ + property $ + \directory -> + Temp.withTempDirectory tempDir "Directory" $ \path -> do + createFSO_Directory path directory + checkNAR path + + describe "Hashing" $ do + describe "matches the output of `nix-hash --type md5" $ do + hashTests 20 (Kesha.HashOptions Kesha.MD5 Kesha.Base16) + + describe "matches the output of `nix-hash --type md5 --base32" $ do + hashTests 20 (Kesha.HashOptions Kesha.MD5 Kesha.Base32) + + describe "matches the output of `nix-hash --type sha1" $ do + hashTests 20 (Kesha.HashOptions Kesha.SHA1 Kesha.Base16) + + describe "matches the output of `nix-hash --type sha1 --base32" $ do + hashTests 20 (Kesha.HashOptions Kesha.SHA1 Kesha.Base32) + + describe "matches the output of `nix-hash --type sha256" $ do + hashTests 20 (Kesha.HashOptions Kesha.SHA256 Kesha.Base16) + + describe "matches the output of `nix-hash --type sha256 --base32`" $ do + hashTests 20 (Kesha.HashOptions Kesha.SHA256 Kesha.Base32) + where + hashTests n opts = do + modifyMaxSuccess (const n) $ + it "matches for any FSO" $ + property $ \fso -> case fso of + Regular regular -> + inTempDirectory tempDir "Regular" $ + checkHash opts =<< createFSO_Regular regular + SymLink symLink -> + inTempDirectory tempDir "SymLink" $ + checkHash opts =<< createFSO_SymLink symLink + Directory directory -> + Temp.withTempDirectory tempDir "Directory" $ \path -> do + createFSO_Directory path directory + checkHash opts path + + checkNAR :: FilePath -> Expectation + checkNAR path = do + result <- liftA2 (,) (nixStoreDump path) (Kesha.NAR.localPack path) + case result of + (Right want, Right got) -> + want `shouldBe` Kesha.NAR.dump got + (Left exitCode, _) -> + expectationFailure ("nix-store --dump failed: " <> show exitCode) + (_, Left err) -> + expectationFailure ("Kesha.NAR.localPack failed: " <> show err) + + checkHash :: Kesha.HashOptions -> FilePath -> Expectation + checkHash opts path = do + result <- liftA2 (,) (nixHash (optsToArgs opts) path) (Kesha.hashWith opts path) + case result of + (Right want, Right got) -> + want `shouldBe` got + (Left exitCode, _) -> + expectationFailure ("nix-hash failed: " <> show exitCode) + (_, Left err) -> + expectationFailure ("Kesha.hash failed: " <> show err) + + optsToArgs :: Kesha.HashOptions -> [String] + optsToArgs (Kesha.HashOptions algo repr) = + ( case algo of + Kesha.MD5 -> ["--type", "md5"] + Kesha.SHA1 -> ["--type", "sha1"] + Kesha.SHA256 -> ["--type", "sha256"] + ) + <> ( case repr of + Kesha.Base16 -> [] + Kesha.Base32 -> ["--base32"] + ) + +data FSO + = Regular FSO_Regular + | SymLink FSO_SymLink + | Directory FSO_Directory + deriving (Show) + +instance Arbitrary FSO where + arbitrary = + oneof + [ Regular <$> arbitrary, + SymLink <$> arbitrary, + Directory <$> arbitrary + ] + +data FSO_Regular = FSO_Regular + { _regularIsExecutable :: Bool, + regularName :: PathSegment, + _regularContents :: Contents + } + deriving (Show) + +instance Arbitrary FSO_Regular where + arbitrary = FSO_Regular <$> arbitrary <*> arbitrary <*> arbitrary + +data FSO_SymLink = FSO_SymLink + { _symLinkIsFile :: Bool, + _symLinkTarget :: PathSegment, + symLinkName :: PathSegment + } + deriving (Show) + +instance Arbitrary FSO_SymLink where + arbitrary = FSO_SymLink <$> arbitrary <*> arbitrary <*> arbitrary + +newtype FSO_Directory = FSO_Directory {directoryMap :: Map.Map PathSegment FSO} + deriving (Show) + +instance Arbitrary FSO_Directory where + arbitrary = + scale (min 5) $ + sized $ \size -> do + len <- choose (0, size) + FSO_Directory . Map.fromList <$> vectorOf len (resize (pred size) arbitrary) + +newtype PathSegment = PathSegment {unPathSegment :: String} + deriving (Eq, Ord, Show) + +instance Arbitrary PathSegment where + arbitrary = do + len <- choose (10, 20) + PathSegment <$> vectorOf len (elements validChars) + where + validChars :: String + validChars = ['A' .. 'Z'] <> ['a' .. 'z'] + +newtype Contents = Contents {unContents :: BS.ByteString} + deriving (Show) + +instance Arbitrary Contents where + arbitrary = fmap (Contents . BS.pack) arbitrary + +createFSO_Regular :: FSO_Regular -> IO FilePath +createFSO_Regular (FSO_Regular isExecutable (PathSegment path) contents) = do + BS.writeFile path (unContents contents) + when isExecutable $ do + perm <- Directory.getPermissions path + Directory.setPermissions path perm {Directory.executable = True} + pure path + +createFSO_SymLink :: FSO_SymLink -> IO FilePath +createFSO_SymLink (FSO_SymLink isFile (PathSegment target) (PathSegment name)) + | isFile = do + BS.writeFile target mempty + Directory.createFileLink target name + pure target + | otherwise = do + Directory.createDirectory target + Directory.createDirectoryLink target name + pure target + +createFSO_Directory :: FilePath -> FSO_Directory -> IO () +createFSO_Directory root = + traverse_ (uncurry writeNode) . flattenNodes root + where + flattenNodes :: + FilePath -> FSO_Directory -> [(FilePath, Either FSO_SymLink FSO_Regular)] + flattenNodes dir = + Map.foldMapWithKey + ( \piece fso -> + case fso of + Regular regular -> [(dir, Right regular {regularName = piece})] + SymLink symLink -> [(dir, Left symLink {symLinkName = piece})] + Directory directory -> flattenNodes (dir unPathSegment piece) directory + ) + . directoryMap + + writeNode :: FilePath -> Either FSO_SymLink FSO_Regular -> IO FilePath + writeNode path (Left symLink) = do + Directory.createDirectoryIfMissing True path + Directory.withCurrentDirectory path (createFSO_SymLink symLink) + writeNode path (Right regular) = do + Directory.createDirectoryIfMissing True path + Directory.withCurrentDirectory path (createFSO_Regular regular) + +nixStoreDump :: FilePath -> IO (Either Int BS.ByteString) +nixStoreDump path = do + (_, Just hout, _, processHandle) <- + Process.createProcess + (Process.proc "nix-store" ["--dump", path]) + { Process.std_out = Process.CreatePipe + } + exit <- Process.waitForProcess processHandle + case exit of + Exit.ExitFailure code -> pure (Left code) + Exit.ExitSuccess -> Right <$> BS.hGetContents hout + +nixHash :: [String] -> FilePath -> IO (Either Int BS.ByteString) +nixHash args path = do + (_, Just hout, _, processHandle) <- + Process.createProcess + (Process.proc "nix-hash" (args ++ [path])) + { Process.std_out = Process.CreatePipe + } + exit <- Process.waitForProcess processHandle + case exit of + Exit.ExitFailure code -> pure (Left code) + Exit.ExitSuccess -> + -- `BS.init` is to drop the trailing newline + Right . BS.init <$> BS.hGetContents hout + +inTempDirectory :: FilePath -> String -> IO a -> IO a +inTempDirectory parent template m = + Temp.withTempDirectory parent template $ \tempDir -> + Directory.withCurrentDirectory tempDir m