diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for nix-freeze-tree +## 0.1.1.0 -- 2023-12-05 + +* Bump a lot of versions +* Support more illegal characters in filenames ([~jack/nix-freeze-tree#8](https://todo.sr.ht/~jack/nix-freeze-tree/8)) + ## 0.1.0.1 -- 2021-11-01 * Support `hnix-store-core ^>=0.14.0.1` and `hnix ^>=0.5` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -31,7 +31,9 @@ ### Nix If you use Nix, you can install the command into your local -environment by running `nix-env -f +environment by running `nix profile install +sourcehut:~jack/nix-freeze-tree`. If you're not using flakes, you can +instead try `nix-env -f https://git.sr.ht/~jack/nix-freeze-tree/archive/master.tar.gz -iA command`. @@ -64,11 +66,31 @@ ## Calling from Nix -This repository's `default.nix` gives access to a function `freeze`, -which can be used to freeze the output of an existing derivation. +This repository's flake defines a function `lib.${system}.freeze`, +which can be used to freeze the output of an existing derivation. You +can use it like this: -You can use it with Nix code that looks a bit like: +```nix +{ + inputs = { + flake-utils.url = "github:numtide/flake-utils"; + nix-freeze-tree = "git+https://git.sr.ht/~jack/nix-freeze-tree" + }; + outputs = inputs@{ ... }: + inputs.flake-utils.lib.eachDefaultSystem (system: + { + defaultPackage = (import nix-freeze-tree { }).lib.${system}.freeze + some-derivation-to-be-frozen; + } + ); +} +``` + +The `freeze` function corresponding to `builtins.currentSystem` is +also exposed in `default.nix`, so you can use it with Nix code that looks +a bit like: + ```nix let # Some nixpkgs from somewhere @@ -111,8 +133,7 @@ ## Other Resources * Questions should go to the - [nix-freeze-tree-discuss](https://lists.sr.ht/~jack/nix-freeze-tree-discuss) - mailing list. + [public-inbox](https://lists.sr.ht/~jack/public-inbox) mailing list. * Bug reports should go to the [bug tracker](https://todo.sr.ht/~jack/nix-freeze-tree). diff --git a/nix-freeze-tree.cabal b/nix-freeze-tree.cabal --- a/nix-freeze-tree.cabal +++ b/nix-freeze-tree.cabal @@ -1,27 +1,27 @@ -cabal-version: 2.2 -name: nix-freeze-tree -version: 0.1.0.1 -synopsis: Convert a tree of files into fixed-output derivations +cabal-version: 2.2 +name: nix-freeze-tree +version: 0.1.1.0 +synopsis: Convert a tree of files into fixed-output derivations description: @nix-freeze-tree@ walks a directory tree and generates a tree of Nix expressions that recreate the tree from fixed-output derivations, one derivation per file in the source tree. See @README.md@ to get started. -homepage: https://git.sr.ht/~jack/nix-freeze-tree -bug-reports: https://todo.sr.ht/~jack/nix-freeze-tree -license: AGPL-3.0-or-later -license-file: LICENSE -author: Jack Kelly -maintainer: jack@jackkelly.name -copyright: (c) 2020 Jack Kelly -category: Application, Nix -build-type: Simple -extra-source-files: +homepage: https://git.sr.ht/~jack/nix-freeze-tree +bug-reports: https://todo.sr.ht/~jack/nix-freeze-tree +license: AGPL-3.0-or-later +license-file: LICENSE +author: Jack Kelly +maintainer: jack@jackkelly.name +copyright: (c) 2020, 2023 Jack Kelly +category: Application, Nix +build-type: Simple +extra-doc-files: CHANGELOG.md README.md -tested-with: GHC ==8.10.2 +tested-with: GHC ==9.4.8 executable nix-freeze-tree hs-source-dirs: bin @@ -46,20 +46,20 @@ default-language: Haskell2010 ghc-options: -Wall build-depends: - , base >=4.9 && <4.17 + , base >=4.9 && <4.18 , bytestring >=0.10.8.2 && <0.12 - , cryptonite >=0.28 && <0.30 + , cryptonite >=0.28 && <0.31 , data-fix >=0.2.0 && <0.4 , directory ^>=1.3.3.0 , directory-tree ^>=0.12.1 - , hnix ^>=0.14.0.1 - , hnix-store-core ^>=0.5 - , optparse-applicative >=0.14.3.0 && <0.17 + , hnix ^>=0.16.0 + , hnix-store-core ^>=0.5.0.0 + , optparse-applicative >=0.14.3.0 && <0.18 , path >=0.6.1 && <0.10 - , path-io ^>=1.6 - , prettyprinter >=1.2.1.1 && <1.8 + , path-io >=1.6 && <1.9 + , prettyprinter ^>=1.7.0 , raw-strings-qq ^>=1.1 - , text ^>=1.2.3.1 + , text ^>=1.2.3.1 || ^>=2.0 , transformers >=0.5.6.2 && <0.7 test-suite nix-freeze-tree-tests @@ -72,8 +72,8 @@ , HUnit ^>=1.6.0.0 , nix-freeze-tree-internal , optparse-applicative - , tasty >=1.2.3 && <1.5 - , tasty-discover ^>=4.2.1 + , tasty >=1.2.3 && <1.5 + , tasty-discover ^>=4.2.1 || ^>=5.0.0 , tasty-hunit ^>=0.10.0.2 hs-source-dirs: test diff --git a/src/BuilderDirs.hs b/src/BuilderDirs.hs --- a/src/BuilderDirs.hs +++ b/src/BuilderDirs.hs @@ -1,12 +1,12 @@ -module BuilderDirs (BuilderDirs(..), currentDir) where +module BuilderDirs (BuilderDirs (..), currentDir) where import Control.Applicative (liftA2) -import Path (Abs, Dir, Path, Rel, ()) import Control.Monad.Trans.Reader (ReaderT, asks) +import Path (Abs, Dir, Path, Rel, ()) data BuilderDirs = BuilderDirs - { _root :: Path Abs Dir - , _subdir :: Path Rel Dir + { _root :: Path Abs Dir, + _subdir :: Path Rel Dir } currentDir :: ReaderT BuilderDirs IO (Path Abs Dir) diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -1,42 +1,50 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} module Config - ( Config(..) - , configParserInfo - , checkConfig - ) where + ( Config (..), + configParserInfo, + checkConfig, + ) +where -import Data.Functor.Identity (Identity(..)) -import Data.Version (showVersion) -import Options.Applicative +import Data.Functor.Identity (Identity (..)) +import Data.Version (showVersion) +import Options.Applicative import qualified Paths_nix_freeze_tree as NixFreezeTree -import Text.RawString.QQ (r) +import Text.RawString.QQ (r) data Config f = Config - { _force :: f Bool - , _verbose :: f Bool - , _outputRoot :: f FilePath - , _inDir :: f FilePath + { _force :: f Bool, + _verbose :: f Bool, + _outputRoot :: f FilePath, + _inDir :: f FilePath } deriving instance Eq (Config Identity) + deriving instance Eq (Config Maybe) + deriving instance Show (Config Identity) + deriving instance Show (Config Maybe) version :: Parser (a -> a) -version = abortOption (InfoMsg message) $ mconcat - [ long "version" - , help "Display version information and exit." - ] +version = + abortOption (InfoMsg message) $ + mconcat + [ long "version", + help "Display version information and exit." + ] where - message = "nix-freeze-tree " <> showVersion NixFreezeTree.version <> "\n" - <> [r|Copyright (C) 2020 Jack Kelly + message = + "nix-freeze-tree " + <> showVersion NixFreezeTree.version + <> "\n" + <> [r|Copyright (C) 2020 Jack Kelly License AGPLv3+: GNU Affero General Public License version 3 or later @@ -46,57 +54,70 @@ |] configParser :: Parser (Config Maybe) -configParser = Config - <$> do fmap Just . switch $ mconcat - [ long "force" - , short 'f' - , help - $ "If any default.nix exist in the output directory, " - <> "remove them and generate anyway" - ] - <*> do fmap Just . switch $ mconcat - [ long "verbose" - , short 'v' - , help "Display messages while working." - ] - <*> do option (Just <$> str) $ mconcat - [ long "out-root" - , short 'o' - , metavar "OUT_ROOT" - , help "Where to write the nix files" - , showDefaultWith $ const "IN_DIR" - , value Nothing - ] - <*> do argument (Just <$> str) $ mconcat - [ metavar "IN_DIR" - , help "Directory to freeze" - , showDefaultWith $ const "." - , value (Just ".") - ] +configParser = + Config + <$> do + fmap Just . switch $ + mconcat + [ long "force", + short 'f', + help $ + "If any default.nix exist in the output directory, " + <> "remove them and generate anyway" + ] + <*> do + fmap Just . switch $ + mconcat + [ long "verbose", + short 'v', + help "Display messages while working." + ] + <*> do + option (Just <$> str) $ + mconcat + [ long "out-root", + short 'o', + metavar "OUT_ROOT", + help "Where to write the nix files", + showDefaultWith $ const "IN_DIR", + value Nothing + ] + <*> do + argument (Just <$> str) $ + mconcat + [ metavar "IN_DIR", + help "Directory to freeze", + showDefaultWith $ const ".", + value (Just ".") + ] configParserInfo :: ParserInfo (Config Maybe) -configParserInfo = info (version <*> helper <*> configParser) $ mconcat - [ header - $ "nix-freeze-tree - " - <> "Create fixed-output derivations for each file in a tree" - , progDesc - $ "Write a tree of nix expressions to OUT_ROOT that build a " - <> "derivation, symlinking every file in IN_DIR as a separate " - <> "fixed-output derivation." - , fullDesc - ] +configParserInfo = + info (version <*> helper <*> configParser) $ + mconcat + [ header $ + "nix-freeze-tree - " + <> "Create fixed-output derivations for each file in a tree", + progDesc $ + "Write a tree of nix expressions to OUT_ROOT that build a " + <> "derivation, symlinking every file in IN_DIR as a separate " + <> "fixed-output derivation.", + fullDesc + ] checkConfig :: Config Maybe -> Maybe (Config Identity) checkConfig = collectMaybes . applyDefaults where - collectMaybes (Config f v o i) = Config - <$> (Identity <$> f) - <*> (Identity <$> v) - <*> (Identity <$> o) - <*> (Identity <$> i) + collectMaybes (Config f v o i) = + Config + <$> (Identity <$> f) + <*> (Identity <$> v) + <*> (Identity <$> o) + <*> (Identity <$> i) - applyDefaults c = Config - (_force c) - (_verbose c <|> Just False) - (_outputRoot c <|> _inDir c) - (_inDir c) + applyDefaults c = + Config + (_force c) + (_verbose c <|> Just False) + (_outputRoot c <|> _inDir c) + (_inDir c) diff --git a/src/NixBuilder.hs b/src/NixBuilder.hs --- a/src/NixBuilder.hs +++ b/src/NixBuilder.hs @@ -1,21 +1,20 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -module NixBuilder (BuilderDirs(..), mkBuildExpr) where +module NixBuilder (BuilderDirs (..), mkBuildExpr) where -import BuilderDirs (BuilderDirs(..), currentDir) -import Control.Monad.Trans.Reader (ReaderT) -import Data.Fix (Fix(..)) -import Data.Functor ((<&>)) -import Data.List (dropWhileEnd) -import Data.List.NonEmpty (NonEmpty(..)) +import BuilderDirs (BuilderDirs (..), currentDir) +import Control.Monad.Trans.Reader (ReaderT) +import Data.Fix (Fix (..)) +import Data.List (dropWhileEnd) +import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE -import Data.Text (Text) +import Data.Text (Text) import qualified Data.Text as T -import Nix -import NixHash (mkFileAttrs, replaceLeadingDot) -import Path (Abs, Dir, File, Path, Rel) +import Nix +import NixHash (mkFileAttrs, replaceUnsafeChars) +import Path (Abs, Dir, File, Path, Rel) import qualified Path as P -- | Given a list of directory contents, construct a Nix expression @@ -30,27 +29,25 @@ mkBuildExpr files dirs = do fileAttrs <- mkFileAttrs files - let - dirAttrs = mkDirAttr <$> dirs - mSrcs = NE.nonEmpty $ dirAttrs ++ fileAttrs + let dirAttrs = mkDirAttr <$> dirs + mSrcs = NE.nonEmpty $ dirAttrs ++ fileAttrs - drv <- currentDir <&> case mSrcs of - Nothing -> mkEmptyDerivation - Just srcs -> mkDirectoryDerivation srcs + drv <- maybe mkEmptyDerivation mkDirectoryDerivation mSrcs <$> currentDir pure $ mkParamset [stdenvArg] False ==> drv - where mkDirAttr :: Path Rel Dir -> (Text, NExpr) mkDirAttr d = - ( T.pack $ nixSafeFilePath d - , "import" @@ mkPath False (nixSafeFilePath d) @@ mkNonRecSet - [ inherit ["stdenv"] nullPos ] + ( T.pack $ nixSafeFilePath d, + "import (./. + " + @@ mkStr (T.pack ("/" ++ nixSafeFilePath d)) + @@ ")" + @@ mkNonRecSet [inherit ["stdenv"]] ) stdenvArg = - ( "stdenv" - , Just $ ("import" @@ mkEnvPath "nixpkgs" @@ mkNonRecSet []) @. "stdenv" + ( "stdenv", + Just $ ("import" @@ mkEnvPath "nixpkgs" @@ mkNonRecSet []) @. "stdenv" ) -- | Construct the @mkDerivation@ call for a directory. It builds a @@ -59,57 +56,59 @@ mkDirectoryDerivation :: NonEmpty (Text, NExpr) -> Path Abs Dir -> NExpr mkDirectoryDerivation srcs d = mkLets ["paths" $= mkNonRecSet (NE.toList $ mkBinding <$> srcs)] $ - "stdenv" @. "mkDerivation" @@ mkNonRecSet - [ "name" $= abspathToDerivationName d - , "allowSubstitutes" $= mkBool False - , "preferLocalBuild" $= mkBool True - , "phases" $= mkList [mkStr "installPhase"] - , "installPhase" $= installCmds - ] - + "stdenv" + @. "mkDerivation" + @@ mkNonRecSet + [ "name" $= abspathToDerivationName d, + "allowSubstitutes" $= mkBool False, + "preferLocalBuild" $= mkBool True, + "phases" $= mkList [mkStr "installPhase"], + "installPhase" $= installCmds + ] where mkBinding :: (Text, NExpr) -> Binding NExpr mkBinding (t, e) = NamedVar (DynamicKey (Plain (DoubleQuoted [Plain t])) :| []) e nullPos installCmds :: NExpr - installCmds = Fix . NStr . Indented 2 $ - [ Plain "mkdir -p $out;" - , Plain "cd $out;" - ] ++ foldMap (mkLinkCmd . fst) srcs + installCmds = + Fix . NStr . Indented 2 $ + [ Plain "mkdir -p $out;", + Plain "cd $out;" + ] + ++ foldMap (mkLinkCmd . fst) srcs where mkLinkCmd :: Text -> [Antiquoted Text NExpr] mkLinkCmd name = - let - -- Use double-quoted selections from "paths". - -- This works on files that start with a leading '.'. - sourcePath :: NonEmpty (NKeyName r) - sourcePath = pure . DynamicKey . Plain $ DoubleQuoted [Plain name] - - in - [ Plain "ln -sv " - , Antiquoted . Fix $ NSelect "paths" sourcePath Nothing - , Plain $ " " <> name <> ";" - ] - + let -- Use double-quoted selections from "paths". + -- This works on files that start with a leading '.'. + sourcePath :: NonEmpty (NKeyName r) + sourcePath = pure . DynamicKey . Plain $ DoubleQuoted [Plain name] + in [ Plain "ln -sv ", + Antiquoted . Fix $ NSelect Nothing "paths" sourcePath, + Plain $ " '" <> name <> "';" + ] -- | Construct the @mkDerivation@ call for an empty directory. mkEmptyDerivation :: Path Abs Dir -> NExpr -mkEmptyDerivation d = "stdenv" @. "mkDerivation" @@ mkNonRecSet - [ "name" $= abspathToDerivationName d - , "allowSubstitutes" $= mkBool False - , "preferLocalBuild" $= mkBool True - , "phases" $= mkList [mkStr "installPhase"] - , "installPhase" $= mkStr "mkdir $out" - ] +mkEmptyDerivation d = + "stdenv" + @. "mkDerivation" + @@ mkNonRecSet + [ "name" $= abspathToDerivationName d, + "allowSubstitutes" $= mkBool False, + "preferLocalBuild" $= mkBool True, + "phases" $= mkList [mkStr "installPhase"], + "installPhase" $= mkStr "mkdir $out" + ] abspathToDerivationName :: Path Abs Dir -> NExpr -abspathToDerivationName - = mkStr - . T.pack - . replaceLeadingDot - . nixSafeFilePath - . P.dirname +abspathToDerivationName = + mkStr + . T.pack + . replaceUnsafeChars + . nixSafeFilePath + . P.dirname -- | Nix doesn't like trailing slashes in derivation names or paths. nixSafeFilePath :: Path b t -> FilePath diff --git a/src/NixFreezeTree.hs b/src/NixFreezeTree.hs --- a/src/NixFreezeTree.hs +++ b/src/NixFreezeTree.hs @@ -1,45 +1,45 @@ -{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} module NixFreezeTree (main) where -import BuilderDirs (BuilderDirs(..)) -import Config (Config(..)) +import BuilderDirs (BuilderDirs (..)) +import Config (Config (..)) import qualified Config as C -import Control.Exception (catch) -import Control.Monad (when) -import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Trans.Reader (ReaderT(..), asks, local) -import Data.Bool (bool) -import Data.Functor (void) -import Data.Functor.Identity (Identity(..)) -import Data.List (isSuffixOf) -import Data.Text (Text) +import Control.Exception (catch) +import Control.Monad (when) +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Trans.Reader (ReaderT (..), asks, local) +import Data.Bool (bool) +import Data.Functor (void) +import Data.Functor.Identity (Identity (..)) +import Data.List (isSuffixOf) +import Data.Text (Text) import qualified Data.Text.IO as T -import Data.Text.Prettyprint.Doc (defaultLayoutOptions, layoutPretty) -import Data.Text.Prettyprint.Doc.Render.Text (renderStrict) -import Nix.Pretty (prettyNix) -import NixBuilder (mkBuildExpr) -import Options.Applicative (execParser) -import Path (Abs, Dir, Path, Rel, ()) +import Nix.Pretty (prettyNix) +import NixBuilder (mkBuildExpr) +import Options.Applicative (execParser) +import Path (Abs, Dir, Path, PathException, ()) import qualified Path as P +import Prettyprinter (defaultLayoutOptions, layoutPretty) +import Prettyprinter.Render.Text (renderStrict) import qualified System.Directory as D -import System.Directory.Tree - ( AnchoredDirTree(..) - , DirTree(..) - , FileName +import System.Directory.Tree + ( AnchoredDirTree (..), + DirTree (..), + FileName, ) import qualified System.Directory.Tree as DT -import System.Exit (exitFailure) -import System.IO (hPutStrLn, stderr) +import System.Exit (exitFailure) +import System.IO (hPutStrLn, stderr) buildExprTree :: Path Abs Dir -> IO (DirTree Text) buildExprTree p = flip runReaderT (BuilderDirs p [P.reldir|.|]) $ do - (_ :/ inDirTree) <- P.toFilePath <$> asks _root >>= liftIO . DT.build + (_ :/ inDirTree) <- asks _root >>= liftIO . DT.build . P.toFilePath case inDirTree of Dir _ fs -> go (".", fs) -- Use "." to avoid the root in output paths _ -> fail "Should never happen" - where -- Walk the directory tree, building the @default.nix@ files, and -- keeping an absolute path to where we are in the ReaderT @@ -47,13 +47,13 @@ go :: (FileName, [DirTree a]) -> ReaderT BuilderDirs IO (DirTree Text) go (dirName, dirFiles) = do relDirName <- P.parseRelDir dirName - local (\b -> b { _subdir = _subdir b relDirName }) $ do - files <- traverse P.parseRelFile [ f | File f _ <- dirFiles ] - dirs <- traverse P.parseRelDir [ d | Dir d _ <- dirFiles ] + local (\b -> b {_subdir = _subdir b relDirName}) $ do + files <- traverse P.parseRelFile [f | File f _ <- dirFiles] + dirs <- traverse P.parseRelDir [d | Dir d _ <- dirFiles] defaultNix <- renderNix <$> mkBuildExpr files dirs - subdirs <- traverse go [ (d, fs) | Dir d fs <- dirFiles ] - pure . Dir dirName $ File "default.nix" defaultNix:subdirs + subdirs <- traverse go [(d, fs) | Dir d fs <- dirFiles] + pure . Dir dirName $ File "default.nix" defaultNix : subdirs renderNix = renderStrict . layoutPretty defaultLayoutOptions . prettyNix @@ -61,17 +61,18 @@ toAbsDir :: DirConstraint -> FilePath -> IO (Path Abs Dir) toAbsDir constraint d = liftIO $ do - absD <- (D.canonicalizePath d >>= P.parseAbsDir) `catch` - \(P.InvalidAbsDir _) -> dieD "does not name a directory" + absD <- + (D.canonicalizePath d >>= P.parseAbsDir) + `catch` \(_ :: PathException) -> dieD "does not name a directory" isDir <- D.doesDirectoryExist d if isDir then pure absD else case constraint of - MustNameDirectory -> dieD "does not name a directory" - MustNameDirectoryIfExists -> D.doesPathExist d >>= - bool (pure absD) (dieD "names something other than a directory") - + MustNameDirectory -> dieD "does not name a directory" + MustNameDirectoryIfExists -> + D.doesPathExist d + >>= bool (pure absD) (dieD "names something other than a directory") where dieD m = die $ show d <> " " <> m @@ -85,31 +86,31 @@ when (defaultNixExists outFiles) $ if get _force - then do - vPutStrLn "a default.nix exists somewhere in the output tree, cleaning" - void . liftIO $ flip DT.writeDirectoryWith outPathTree $ \fp _ -> - when ("default.nix" `isSuffixOf` fp) $ do - vPutStrLn $ "deleting " <> fp - D.removePathForcibly fp - else die "a default.nix exists somewhere in the output tree, cannot proceed" + then do + vPutStrLn "a default.nix exists somewhere in the output tree, cleaning" + void . liftIO $ flip DT.writeDirectoryWith outPathTree $ \fp _ -> + when ("default.nix" `isSuffixOf` fp) $ do + vPutStrLn $ "deleting " <> fp + D.removePathForcibly fp + else die "a default.nix exists somewhere in the output tree, cannot proceed" outTree <- buildExprTree inDir void $ flip DT.writeDirectoryWith (outRootPath :/ outTree) $ \fp t -> do vPutStrLn . ("writing " <>) =<< D.canonicalizePath fp T.writeFile fp t - where get f = runIdentity $ f cfg defaultNixExists (File n _) = n == "default.nix" defaultNixExists (Dir _ cs) = any defaultNixExists cs - defaultNixExists Failed{} = False + defaultNixExists Failed {} = False vPutStrLn msg = when (get _verbose) $ putStrLn msg main :: IO () -main = C.checkConfig <$> execParser C.configParserInfo >>= - maybe (fail "Should be impossible") writeNixTree +main = + execParser C.configParserInfo + >>= maybe (fail "Should be impossible") writeNixTree . C.checkConfig -die :: MonadIO m => String -> m a +die :: (MonadIO m) => String -> m a die msg = liftIO $ hPutStrLn stderr ("FATAL: " <> msg) *> exitFailure diff --git a/src/NixHash.hs b/src/NixHash.hs --- a/src/NixHash.hs +++ b/src/NixHash.hs @@ -1,22 +1,22 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -module NixHash (mkFileAttrs, replaceLeadingDot) where +module NixHash (mkFileAttrs, replaceUnsafeChars) where -import BuilderDirs (BuilderDirs, currentDir) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Reader -import Crypto.Hash (Digest, SHA256, hash) +import BuilderDirs (BuilderDirs, currentDir) +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Trans.Reader +import Crypto.Hash (Digest, SHA256, hash) import qualified Data.ByteString as B -import Data.Text (Text) +import Data.Char (isAsciiLower, isAsciiUpper, isDigit) +import Data.Text (Text) import qualified Data.Text as T -import Nix -import Path (Abs, File, Path, Rel, toFilePath, ()) -import Path.IO (withSystemTempFile) -import System.IO -import System.Nix.Hash (BaseEncoding (..), encodeDigestWith) -import System.Nix.Nar (buildNarIO, narEffectsIO) +import Nix +import Path (Abs, File, Path, Rel, toFilePath, ()) +import Path.IO (withSystemTempFile) +import System.IO +import System.Nix.Hash (BaseEncoding (..), encodeDigestWith) +import System.Nix.Nar (buildNarIO, narEffectsIO) -- | Build a set of @filename -> derivation@ attributes. mkFileAttrs :: [Path Rel File] -> ReaderT BuilderDirs IO [(Text, NExpr)] @@ -51,20 +51,20 @@ absF <- ( f) <$> currentDir h <- recursiveHash absF - let bindings = - [ "path" $= mkPath False (toFilePath absF) - , "sha256" $= mkStr h - ] ++ [ "name" $= mkStr (T.pack . replaceLeadingDot $ toFilePath f) - | head (toFilePath f) == '.' - ] + let name = toFilePath f + sanitizedName = replaceUnsafeChars name + bindings = + [ "path" $= mkStr (T.pack (toFilePath absF)), + "sha256" $= mkStr h + ] + ++ ["name" $= mkStr (T.pack sanitizedName) | name /= sanitizedName] pure $ "builtins" @. "path" @@ mkNonRecSet bindings - -- | Serialise as per -- https://gist.github.com/jbeda/5c79d2b1434f0018d693 , which is an -- extract from Figure 5.2 of http://nixos.org/~eelco/pubs/phd-thesis.pdf , -- which is the Nix thesis. -recursiveHash :: MonadIO m => Path Abs File -> m Text +recursiveHash :: (MonadIO m) => Path Abs File -> m Text recursiveHash absF = liftIO . withSystemTempFile "nix-freeze-tree.nar" $ \_ h -> do buildNarIO narEffectsIO (toFilePath absF) h @@ -72,7 +72,16 @@ contents <- B.hGetContents h pure $ encodeDigestWith NixBase32 (hash contents :: Digest SHA256) --- | A leading dot is illegal in Nix derivation names. Replace it with '_'. -replaceLeadingDot :: FilePath -> FilePath -replaceLeadingDot ('.':f) = '_':f -replaceLeadingDot f = f +-- | Replace various characters which don't work in Nix derivation names +replaceUnsafeChars :: FilePath -> FilePath +replaceUnsafeChars = map replaceUnsafeChar . replaceLeadingDot + where + replaceLeadingDot ('.' : f) = '_' : f + replaceLeadingDot f = f + + replaceUnsafeChar ch + | isAsciiLower ch = ch + | isAsciiUpper ch = ch + | isDigit ch = ch + | ch `elem` ['\'', '_', '-', '.'] = ch + | otherwise = '_' diff --git a/test/ConfigTest.hs b/test/ConfigTest.hs --- a/test/ConfigTest.hs +++ b/test/ConfigTest.hs @@ -1,25 +1,33 @@ module ConfigTest where import Config -import Data.Functor.Identity (Identity(..)) +import Data.Functor.Identity (Identity (..)) +import Options.Applicative (ParserResult (..), defaultPrefs, execParserPure) import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (Assertion, (@?=), assertFailure, testCase) -import Options.Applicative (ParserResult(..), defaultPrefs, execParserPure) +import Test.Tasty.HUnit (Assertion, assertFailure, testCase, (@?=)) test_optionParser :: TestTree -test_optionParser = testGroup "Option Parser" - [ testCase "defaults" $ [] - `shouldParseTo` Config (i False) (i False) (i ".") (i ".") - , testCase "dir only" $ ["here"] - `shouldParseTo` Config (i False) (i False) (i "here") (i "here") - , testCase "custom output dir" $ ["-o", "there", "here"] - `shouldParseTo` Config (i False) (i False) (i "there") (i "here") - , testCase "force" $ ["-f", "here"] - `shouldParseTo` Config (i True) (i False) (i "here") (i "here") - , testCase "verbose" $ ["-v"] - `shouldParseTo` Config (i False) (i True) (i ".") (i ".") - ] - where i = Identity +test_optionParser = + testGroup + "Option Parser" + [ testCase "defaults" $ + [] + `shouldParseTo` Config (i False) (i False) (i ".") (i "."), + testCase "dir only" $ + ["here"] + `shouldParseTo` Config (i False) (i False) (i "here") (i "here"), + testCase "custom output dir" $ + ["-o", "there", "here"] + `shouldParseTo` Config (i False) (i False) (i "there") (i "here"), + testCase "force" $ + ["-f", "here"] + `shouldParseTo` Config (i True) (i False) (i "here") (i "here"), + testCase "verbose" $ + ["-v"] + `shouldParseTo` Config (i False) (i True) (i ".") (i ".") + ] + where + i = Identity shouldParseTo :: [String] -> Config Identity -> Assertion args `shouldParseTo` c =