diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,20 @@ # Revision history for hnix-store-core +## [0.4.2.0](https://github.com/haskell-nix/hnix-store/compare/0.4.1.0...0.4.2.0) 2021-03-12 + +* Additional: + + * [(link)](https://github.com/haskell-nix/hnix-store/commit/5d03ffc43cde9448df05e84838ece70cc83b1b6c) Cabal now properly states `tasty-discover` as `build-tool-depends`. + + * [(link)](https://github.com/haskell-nix/hnix-store/commit/b5ad38573d27e0732d0fadfebd98de1f753b4f07) added explicit `hie.yml` cradle description for `cabal` to help Haskell Language Server to work with monorepo. + + * [(link)](https://github.com/haskell-nix/hnix-store/commit/a5b7a614c0e0e11147a93b9a197c2a443afa3244) rm vacuous `Setup.hs`, it was throwing-off HLS, and anyway file is vacuous and gets deprecated by Cabal itself. + + * [(link)](https://github.com/haskell-nix/hnix-store/commit/cf04083aba98ad40d183d1e26251101816cc07ae) Nix dev env: removed GHC 8.6.5 support, afaik it is not even in Nixpkgs anymore. + + * [(link)](https://github.com/haskell-nix/hnix-store/commit/2a897ab581c0501587ce04da6d6e3a6f543b1d72) Test suite: fixed nar test for the envs without `/proc` (test suite now works on `macOS`). + + ## [0.4.1.0](https://github.com/haskell-nix/hnix-store/compare/0.4.0.0...0.4.1.0) 2021-01-16 * Big clean-up of dependencies. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/hnix-store-core.cabal b/hnix-store-core.cabal --- a/hnix-store-core.cabal +++ b/hnix-store-core.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hnix-store-core -version: 0.4.1.0 +version: 0.4.2.0 synopsis: Core effects for interacting with the Nix store. description: This package contains types and functions needed to describe @@ -90,6 +90,8 @@ StorePath hs-source-dirs: tests + build-tool-depends: + tasty-discover:tasty-discover build-depends: hnix-store-core , attoparsec diff --git a/src/System/Nix/Base32.hs b/src/System/Nix/Base32.hs --- a/src/System/Nix/Base32.hs +++ b/src/System/Nix/Base32.hs @@ -1,9 +1,10 @@ {-| Description: Implementation of Nix's base32 encoding. -} -module System.Nix.Base32 ( - encode +module System.Nix.Base32 + ( encode , decode - ) where + ) +where -import System.Nix.Internal.Base32 +import System.Nix.Internal.Base32 diff --git a/src/System/Nix/Build.hs b/src/System/Nix/Build.hs --- a/src/System/Nix/Build.hs +++ b/src/System/Nix/Build.hs @@ -3,15 +3,16 @@ Description : Build related types Maintainer : srk |-} -module System.Nix.Build ( - BuildMode(..) +module System.Nix.Build + ( BuildMode(..) , BuildStatus(..) , BuildResult(..) , buildSuccess - ) where + ) +where -import Data.Time (UTCTime) -import Data.Text (Text) +import Data.Time ( UTCTime ) +import Data.Text ( Text ) -- keep the order of these Enums to match enums from reference implementations -- src/libstore/store-api.hh @@ -49,11 +50,9 @@ startTime :: !UTCTime , -- Stop time of this build stopTime :: !UTCTime - } deriving (Eq, Ord, Show) + } + deriving (Eq, Ord, Show) buildSuccess :: BuildResult -> Bool -buildSuccess BuildResult{..} = elem status - [ Built - , Substituted - , AlreadyValid - ] +buildSuccess BuildResult {..} = + status `elem` [Built, Substituted, AlreadyValid] diff --git a/src/System/Nix/Derivation.hs b/src/System/Nix/Derivation.hs --- a/src/System/Nix/Derivation.hs +++ b/src/System/Nix/Derivation.hs @@ -1,33 +1,35 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Nix.Derivation ( - parseDerivation +module System.Nix.Derivation + ( parseDerivation , buildDerivation - ) where + ) +where -import Data.Attoparsec.Text.Lazy (Parser) -import Data.Text (Text) -import Data.Text.Lazy.Builder (Builder) -import Nix.Derivation (Derivation) -import System.Nix.StorePath (StorePath) +import Data.Text ( Text ) +import qualified Data.Text as Text +import qualified Data.Text.Lazy.Builder as Text.Lazy + ( Builder ) +import qualified Data.Text.Lazy.Builder as Text.Lazy.Builder +import qualified Data.Attoparsec.Text.Lazy as Text.Lazy + ( Parser ) +import Nix.Derivation ( Derivation ) +import qualified Nix.Derivation as Derivation +import System.Nix.StorePath ( StorePath ) +import qualified System.Nix.StorePath as StorePath -import qualified Data.Text -import qualified Data.Text.Lazy.Builder -import qualified Nix.Derivation -import qualified System.Nix.StorePath -parseDerivation :: FilePath -> Parser (Derivation StorePath Text) +parseDerivation :: FilePath -> Text.Lazy.Parser (Derivation StorePath Text) parseDerivation expectedRoot = - Nix.Derivation.parseDerivationWith - ("\"" *> System.Nix.StorePath.pathParser expectedRoot <* "\"") - Nix.Derivation.textParser + Derivation.parseDerivationWith + ("\"" *> StorePath.pathParser expectedRoot <* "\"") + Derivation.textParser -buildDerivation :: Derivation StorePath Text -> Builder -buildDerivation derivation = - Nix.Derivation.buildDerivationWith - (string . Data.Text.pack . show) +buildDerivation :: Derivation StorePath Text -> Text.Lazy.Builder +buildDerivation = + Derivation.buildDerivationWith + (string . Text.pack . show) string - derivation where - string = Data.Text.Lazy.Builder.fromText . Data.Text.pack . show + string = Text.Lazy.Builder.fromText . Text.pack . show diff --git a/src/System/Nix/Hash.hs b/src/System/Nix/Hash.hs --- a/src/System/Nix/Hash.hs +++ b/src/System/Nix/Hash.hs @@ -1,20 +1,22 @@ {-| Description : Cryptographic hashes for hnix-store. -} -module System.Nix.Hash ( - HNix.Digest +module System.Nix.Hash + ( Hash.Digest - , HNix.HashAlgorithm(..) - , HNix.ValidAlgo(..) - , HNix.NamedAlgo(..) - , HNix.SomeNamedDigest(..) - , HNix.hash - , HNix.hashLazy - , HNix.mkNamedDigest + , Hash.HashAlgorithm(..) + , Hash.ValidAlgo(..) + , Hash.NamedAlgo(..) + , Hash.SomeNamedDigest(..) - , HNix.BaseEncoding(..) - , HNix.encodeInBase - , HNix.decodeBase - ) where + , Hash.hash + , Hash.hashLazy + , Hash.mkNamedDigest -import qualified System.Nix.Internal.Hash as HNix + , Hash.BaseEncoding(..) + , Hash.encodeInBase + , Hash.decodeBase + ) +where + +import qualified System.Nix.Internal.Hash as Hash diff --git a/src/System/Nix/Internal/Base32.hs b/src/System/Nix/Internal/Base32.hs --- a/src/System/Nix/Internal/Base32.hs +++ b/src/System/Nix/Internal/Base32.hs @@ -1,88 +1,93 @@ - module System.Nix.Internal.Base32 where -import Data.ByteString (ByteString) -import Data.Vector (Vector) -import Data.Text (Text) -import Data.Bits (shiftR) -import Data.Word (Word8) -import Data.List (unfoldr) -import Numeric (readInt) -import qualified Data.Maybe -import qualified Data.ByteString -import qualified Data.ByteString.Char8 +import Data.Bool ( bool ) +import Data.Maybe ( fromMaybe ) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as Bytes +import qualified Data.ByteString.Char8 as Bytes.Char8 import qualified Data.Text -import qualified Data.Vector +import Data.Vector ( Vector ) +import qualified Data.Vector as Vector +import Data.Text ( Text ) +import Data.Bits ( shiftR ) +import Data.Word ( Word8 ) +import Data.List ( unfoldr ) +import Numeric ( readInt ) + -- omitted: E O U T digits32 :: Vector Char -digits32 = Data.Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz" +digits32 = Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz" -- | Encode a 'BS.ByteString' in Nix's base32 encoding encode :: ByteString -> Text -encode c = Data.Text.pack $ map char32 [nChar - 1, nChar - 2 .. 0] - where - -- Each base32 character gives us 5 bits of information, while - -- each byte gives is 8. Because 'div' rounds down, we need to add - -- one extra character to the result, and because of that extra 1 - -- we need to subtract one from the number of bits in the - -- bytestring to cover for the case where the number of bits is - -- already a factor of 5. Thus, the + 1 outside of the 'div' and - -- the - 1 inside of it. - nChar = fromIntegral $ ((Data.ByteString.length c * 8 - 1) `div` 5) + 1 +encode c = Data.Text.pack $ fmap char32 [nChar - 1, nChar - 2 .. 0] + where + -- Each base32 character gives us 5 bits of information, while + -- each byte gives is 8. Because 'div' rounds down, we need to add + -- one extra character to the result, and because of that extra 1 + -- we need to subtract one from the number of bits in the + -- bytestring to cover for the case where the number of bits is + -- already a factor of 5. Thus, the + 1 outside of the 'div' and + -- the - 1 inside of it. + nChar = fromIntegral $ ((Bytes.length c * 8 - 1) `div` 5) + 1 - byte = Data.ByteString.index c . fromIntegral + byte = Bytes.index c . fromIntegral - -- May need to switch to a more efficient calculation at some - -- point. - bAsInteger :: Integer - bAsInteger = sum [fromIntegral (byte j) * (256 ^ j) - | j <- [0 .. Data.ByteString.length c - 1] - ] + -- May need to switch to a more efficient calculation at some + -- point. + bAsInteger :: Integer + bAsInteger = + sum + [ fromIntegral (byte j) * (256 ^ j) + | j <- [0 .. Bytes.length c - 1] ] - char32 :: Integer -> Char - char32 i = digits32 Data.Vector.! digitInd - where - digitInd = fromIntegral $ - bAsInteger - `div` (32^i) - `mod` 32 + char32 :: Integer -> Char + char32 i = digits32 Vector.! digitInd + where + digitInd = + fromIntegral $ + bAsInteger `div` (32^i) `mod` 32 -- | Decode Nix's base32 encoded text decode :: Text -> Either String ByteString decode what = - if Data.Text.all (`elem` digits32) what - then unsafeDecode what - else Left "Invalid base32 string" + bool + (Left "Invalid Base32 string") + (unsafeDecode what) + (Data.Text.all (`elem` digits32) what) -- | Decode Nix's base32 encoded text -- Doesn't check if all elements match `digits32` unsafeDecode :: Text -> Either String ByteString unsafeDecode what = - case readInt 32 - (`elem` digits32) - (\c -> Data.Maybe.fromMaybe (error "character not in digits32") - $ Data.Vector.findIndex (==c) digits32) - (Data.Text.unpack what) + case + readInt + 32 + (`elem` digits32) + (\c -> fromMaybe (error "character not in digits32") + $ Vector.findIndex (== c) digits32 + ) + (Data.Text.unpack what) of [(i, _)] -> Right $ padded $ integerToBS i - x -> Left $ "Can't decode: readInt returned " ++ show x - where - padded x - | Data.ByteString.length x < decLen = x `Data.ByteString.append` bstr - | otherwise = x - where - bstr = Data.ByteString.Char8.pack $ take (decLen - Data.ByteString.length x) (cycle "\NUL") + x -> Left $ "Can't decode: readInt returned " <> show x + where + padded x + | Bytes.length x < decLen = x `Bytes.append` bstr + | otherwise = x + where + bstr = Bytes.Char8.pack $ take (decLen - Bytes.length x) (cycle "\NUL") - decLen = Data.Text.length what * 5 `div` 8 + decLen = Data.Text.length what * 5 `div` 8 -- | Encode an Integer to a bytestring -- Similar to Data.Base32String (integerToBS) without `reverse` integerToBS :: Integer -> ByteString -integerToBS 0 = Data.ByteString.pack [0] +integerToBS 0 = Bytes.pack [0] integerToBS i - | i > 0 = Data.ByteString.pack $ unfoldr f i + | i > 0 = Bytes.pack $ unfoldr f i | otherwise = error "integerToBS not defined for negative values" where f 0 = Nothing diff --git a/src/System/Nix/Internal/Hash.hs b/src/System/Nix/Internal/Hash.hs --- a/src/System/Nix/Internal/Hash.hs +++ b/src/System/Nix/Internal/Hash.hs @@ -115,13 +115,13 @@ "sha1" -> SomeDigest <$> decodeGo @'SHA1 h "sha256" -> SomeDigest <$> decodeGo @'SHA256 h "sha512" -> SomeDigest <$> decodeGo @'SHA512 h - _ -> Left $ "Unknown hash name: " ++ T.unpack name + _ -> Left $ "Unknown hash name: " <> T.unpack name decodeGo :: forall a . (NamedAlgo a, ValidAlgo a) => Text -> Either String (Digest a) decodeGo h | size == base16Len = decodeBase Base16 h | size == base32Len = decodeBase Base32 h | size == base64Len = decodeBase Base64 h - | otherwise = Left $ T.unpack sriHash ++ " is not a valid " ++ T.unpack name ++ " hash. Its length (" ++ show size ++ ") does not match any of " ++ show [base16Len, base32Len, base64Len] + | otherwise = Left $ T.unpack sriHash <> " is not a valid " <> T.unpack name <> " hash. Its length (" <> show size <> ") does not match any of " <> show [base16Len, base32Len, base64Len] where size = T.length h hsize = hashSize @a @@ -218,7 +218,7 @@ truncateDigest :: forall n a.(KnownNat n) => Digest a -> Digest ('Truncated n a) truncateDigest (Digest c) = - Digest $ BS.pack $ map truncOutputByte [0.. n-1] + Digest $ BS.pack $ fmap truncOutputByte [0.. n-1] where n = fromIntegral $ natVal (Proxy @n) diff --git a/src/System/Nix/Internal/Nar/Effects.hs b/src/System/Nix/Internal/Nar/Effects.hs --- a/src/System/Nix/Internal/Nar/Effects.hs +++ b/src/System/Nix/Internal/Nar/Effects.hs @@ -8,23 +8,26 @@ , narEffectsIO ) where -import qualified Control.Exception.Lifted as Lifted -import qualified Control.Monad.Fail as MonadFail -import qualified Control.Monad.IO.Class as IO -import Control.Monad.Trans.Control (MonadBaseControl) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString as Bytes +import qualified Data.ByteString.Lazy as Bytes.Lazy import Data.Int (Int64) import qualified System.Directory as Directory +import System.Posix.Files ( createSymbolicLink + , fileSize + , getFileStatus + , isDirectory + , readSymbolicLink + ) import qualified System.IO as IO -import System.Posix.Files (createSymbolicLink, fileSize, - getFileStatus, isDirectory, - readSymbolicLink) +import qualified Control.Monad.IO.Class as IO +import Control.Monad.Trans.Control (MonadBaseControl) +import qualified Control.Exception.Lifted as Exception.Lifted +import qualified Control.Monad.Fail as MonadFail data NarEffects (m :: * -> *) = NarEffects { - narReadFile :: FilePath -> m BSL.ByteString - , narWriteFile :: FilePath -> BSL.ByteString -> m () - , narStreamFile :: FilePath -> m (Maybe BS.ByteString) -> m () + narReadFile :: FilePath -> m Bytes.Lazy.ByteString + , narWriteFile :: FilePath -> Bytes.Lazy.ByteString -> m () + , narStreamFile :: FilePath -> m (Maybe Bytes.ByteString) -> m () , narListDir :: FilePath -> m [FilePath] , narCreateDir :: FilePath -> m () , narCreateLink :: FilePath -> FilePath -> m () @@ -48,17 +51,17 @@ MonadBaseControl IO m ) => NarEffects m narEffectsIO = NarEffects { - narReadFile = IO.liftIO . BSL.readFile - , narWriteFile = \a b -> IO.liftIO $ BSL.writeFile a b + narReadFile = IO.liftIO . Bytes.Lazy.readFile + , narWriteFile = \a -> IO.liftIO . Bytes.Lazy.writeFile a , narStreamFile = streamStringOutIO , narListDir = IO.liftIO . Directory.listDirectory , narCreateDir = IO.liftIO . Directory.createDirectory - , narCreateLink = \f t -> IO.liftIO $ createSymbolicLink f t + , narCreateLink = \f -> IO.liftIO . createSymbolicLink f , narGetPerms = IO.liftIO . Directory.getPermissions - , narSetPerms = \f p -> IO.liftIO $ Directory.setPermissions f p - , narIsDir = \d -> fmap isDirectory $ IO.liftIO (getFileStatus d) + , narSetPerms = \f -> IO.liftIO . Directory.setPermissions f + , narIsDir = fmap isDirectory . IO.liftIO . getFileStatus , narIsSymLink = IO.liftIO . Directory.pathIsSymbolicLink - , narFileSize = \n -> fmap (fromIntegral . fileSize) $ IO.liftIO (getFileStatus n) + , narFileSize = fmap (fromIntegral . fileSize) . IO.liftIO . getFileStatus , narReadLink = IO.liftIO . readSymbolicLink , narDeleteDir = IO.liftIO . Directory.removeDirectoryRecursive , narDeleteFile = IO.liftIO . Directory.removeFile @@ -72,23 +75,25 @@ MonadFail.MonadFail m, MonadBaseControl IO m ) => FilePath - -> m (Maybe BS.ByteString) + -> m (Maybe Bytes.ByteString) -> m () streamStringOutIO f getChunk = - Lifted.bracket - (IO.liftIO (IO.openFile f IO.WriteMode)) (IO.liftIO . IO.hClose) go - `Lifted.catch` + Exception.Lifted.bracket + (IO.liftIO $ IO.openFile f IO.WriteMode) + (IO.liftIO . IO.hClose) + go + `Exception.Lifted.catch` cleanupException - where - go :: IO.Handle -> m () - go handle = do - chunk <- getChunk - case chunk of - Nothing -> return () - Just c -> do - IO.liftIO $ BS.hPut handle c - go handle - cleanupException (e :: Lifted.SomeException) = do - IO.liftIO $ Directory.removeFile f - MonadFail.fail $ - "Failed to stream string to " ++ f ++ ": " ++ show e + where + go :: IO.Handle -> m () + go handle = do + chunk <- getChunk + case chunk of + Nothing -> pure () + Just c -> do + IO.liftIO $ Bytes.hPut handle c + go handle + cleanupException (e :: Exception.Lifted.SomeException) = do + IO.liftIO $ Directory.removeFile f + MonadFail.fail $ + "Failed to stream string to " <> f <> ": " <> show e diff --git a/src/System/Nix/Internal/Nar/Parser.hs b/src/System/Nix/Internal/Nar/Parser.hs --- a/src/System/Nix/Internal/Nar/Parser.hs +++ b/src/System/Nix/Internal/Nar/Parser.hs @@ -12,8 +12,11 @@ import qualified Algebra.Graph as Graph import qualified Algebra.Graph.ToGraph as Graph import qualified Control.Concurrent as Concurrent -import qualified Control.Exception.Lifted as ExceptionLifted -import Control.Monad (forM, when) +import qualified Control.Exception.Lifted as Exception.Lifted +import Control.Monad ( forM + , when + , forM_ + ) import qualified Control.Monad.Except as Except import qualified Control.Monad.Fail as Fail import qualified Control.Monad.IO.Class as IO @@ -21,16 +24,19 @@ import qualified Control.Monad.State as State import qualified Control.Monad.Trans as Trans import qualified Control.Monad.Trans.Control as Base -import qualified Data.ByteString as BS +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as Bytes +import Data.Bool ( bool ) import qualified Data.Either as Either -import Data.Int (Int64) +import Data.Int ( Int64 ) import qualified Data.IORef as IORef import qualified Data.List as List import qualified Data.Map as Map -import Data.Maybe (catMaybes) -import qualified Data.Serialize as S -import qualified Data.Text as T -import qualified Data.Text.Encoding as E +import Data.Maybe ( catMaybes ) +import qualified Data.Serialize as Serialize +import Data.Text ( Text ) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text import qualified System.Directory as Directory import System.FilePath as FilePath import qualified System.IO as IO @@ -44,9 +50,18 @@ -- of the actions the parser can take, and @ParserState@ for the -- internals of the parser newtype NarParser m a = NarParser - { runNarParser - :: State.StateT ParserState - (Except.ExceptT String (Reader.ReaderT (Nar.NarEffects m) m)) a} + { runNarParser :: + State.StateT + ParserState + (Except.ExceptT + String + (Reader.ReaderT + (Nar.NarEffects m) + m + ) + ) + a + } deriving ( Functor, Applicative, Monad, Fail.MonadFail , Trans.MonadIO, State.MonadState ParserState , Except.MonadError String @@ -57,7 +72,8 @@ -- This is suitable for testing the top-level NAR parser, or any of the -- smaller utilities parsers, if you have bytes appropriate for them runParser - :: forall m a.(IO.MonadIO m, Base.MonadBaseControl IO m) + :: forall m a + . (IO.MonadIO m, Base.MonadBaseControl IO m) => Nar.NarEffects m -- ^ Provide the effects set, usually @narEffectsIO@ -> NarParser m a @@ -69,38 +85,43 @@ -- ^ The root file system object to be created by the NAR -> m (Either String a) runParser effs (NarParser action) h target = do - unpackResult <- Reader.runReaderT - (Except.runExceptT (State.evalStateT action state0)) effs - `ExceptionLifted.catch` exceptionHandler + unpackResult <- + Reader.runReaderT (Except.runExceptT $ State.evalStateT action state0) effs + `Exception.Lifted.catch` exceptionHandler when (Either.isLeft unpackResult) cleanup - return unpackResult + pure unpackResult - where - state0 :: ParserState - state0 = ParserState + where + state0 :: ParserState + state0 = + ParserState { tokenStack = [] , handle = h , directoryStack = [target] , links = [] } - exceptionHandler :: ExceptionLifted.SomeException -> m (Either String a) - exceptionHandler e = do - return (Left $ "Exception while unpacking NAR file: " ++ show e) - cleanup :: m () - cleanup = do - isDir <- Nar.narIsDir effs target - if isDir - then Nar.narDeleteDir effs target - else Nar.narDeleteFile effs target + exceptionHandler :: Exception.Lifted.SomeException -> m (Either String a) + exceptionHandler e = + pure $ Left $ "Exception while unpacking NAR file: " <> show e + cleanup :: m () + cleanup = + (\ef trg -> do + isDir <- Nar.narIsDir ef trg + bool + (Nar.narDeleteFile ef trg) + (Nar.narDeleteDir ef trg) + isDir + ) effs target + instance Trans.MonadTrans NarParser where lift act = NarParser $ (Trans.lift . Trans.lift . Trans.lift) act data ParserState = ParserState - { tokenStack :: ![T.Text] + { tokenStack :: ![Text] -- ^ The parser can push tokens (words or punctuation) -- onto this stack. We use this for a very limited backtracking -- where the Nar format requires it @@ -120,11 +141,11 @@ -- | Parse a NAR byte string, producing @()@. -- Parsing a NAR is mostly used for its side-effect: producing --- the file system objects packed in the NAR. That's why we return @()@ +-- the file system objects packed in the NAR. That's why we pure @()@ parseNar :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseNar = do expectStr "nix-archive-1" - parens $ parseFSO + parens parseFSO createLinks @@ -132,9 +153,9 @@ parseFSO = do expectStr "type" matchStr - [("symlink", parseSymlink) - ,("regular", parseFile) - ,("directory", parseDirectory) + [ ("symlink" , parseSymlink ) + , ("regular" , parseFile ) + , ("directory", parseDirectory) ] @@ -146,14 +167,19 @@ parseSymlink :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseSymlink = do expectStr "target" - target <- parseStr - (dir,file) <- currentDirectoryAndFile - pushLink $ LinkInfo { linkTarget = (T.unpack target), linkFile = file, linkPWD = dir } - where - currentDirectoryAndFile :: Monad m => NarParser m (FilePath, FilePath) - currentDirectoryAndFile = do - dirStack <- State.gets directoryStack - return $ (List.foldr1 () (List.reverse $ drop 1 dirStack), head dirStack) + target <- parseStr + (dir, file) <- currentDirectoryAndFile + pushLink $ + LinkInfo + { linkTarget = Text.unpack target + , linkFile = file + , linkPWD = dir + } + where + currentDirectoryAndFile :: Monad m => NarParser m (FilePath, FilePath) + currentDirectoryAndFile = do + dirStack <- State.gets directoryStack + pure (List.foldr1 () (List.reverse $ drop 1 dirStack), head dirStack) -- | Internal data type representing symlinks encountered in the NAR @@ -164,25 +190,27 @@ -- ^ file name of the link being created , linkPWD :: String -- ^ directory in which to create the link (relative to unpacking root) - } deriving (Show) + } + deriving Show -- | When the NAR includes a file, we read from the NAR handle in chunks and -- write the target in chunks. This lets us avoid reading the full contents -- of the encoded file into memory -parseFile :: forall m.(IO.MonadIO m, Fail.MonadFail m) => NarParser m () +parseFile :: forall m . (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseFile = do s <- parseStr - when (s `notElem` ["executable", "contents"]) - (Fail.fail $ "Parser found " ++ show s ++ - " when expecting element from " ++ - (show :: [String] -> String) ["executable", "contents"]) + when (s `notElem` ["executable", "contents"]) $ + Fail.fail + $ "Parser found " <> show s + <> " when expecting element from " + <> (show :: [String] -> String) ["executable", "contents"] when (s == "executable") $ do expectStr "" expectStr "contents" - fSize <- parseLength + fSize <- parseLength -- Set up for defining `getChunk` narHandle <- State.gets handle @@ -192,21 +220,21 @@ -- getChunk tracks the number of total bytes we still need to get from the -- file (starting at the file size, and decrementing by the size of the -- chunk we read) - getChunk :: m (Maybe BS.ByteString) + getChunk :: m (Maybe ByteString) getChunk = do bytesLeft <- IO.liftIO $ IORef.readIORef bytesLeftVar if bytesLeft == 0 - then return Nothing + then pure Nothing else do - chunk <- IO.liftIO $ BS.hGetSome narHandle (fromIntegral $ min 10000 bytesLeft) - when (BS.null chunk) (Fail.fail "ZERO BYTES") - IO.liftIO $ IORef.modifyIORef bytesLeftVar (\n -> n - fromIntegral (BS.length chunk)) + chunk <- IO.liftIO $ Bytes.hGetSome narHandle $ fromIntegral $ min 10000 bytesLeft + when (Bytes.null chunk) (Fail.fail "ZERO BYTES") + IO.liftIO $ IORef.modifyIORef bytesLeftVar $ \n -> n - fromIntegral (Bytes.length chunk) - -- This short pause is necessary for letting the garbage collector - -- clean up chunks from previous runs. Without it, heap memory usage can - -- quickly spike - IO.liftIO $ Concurrent.threadDelay 10 - return $ Just chunk + -- This short pause is necessary for letting the garbage collector + -- clean up chunks from previous runs. Without it, heap memory usage can + -- quickly spike + IO.liftIO $ Concurrent.threadDelay 10 + pure $ Just chunk target <- currentFile streamFile <- Reader.asks Nar.narStreamFile @@ -218,7 +246,7 @@ p <- Nar.narGetPerms effs target Nar.narSetPerms effs target (p { Directory.executable = True }) - expectRawString (BS.replicate (padLen $ fromIntegral fSize) 0) + expectRawString (Bytes.replicate (padLen $ fromIntegral fSize) 0) -- | Parse a NAR encoded directory, being careful not to hold onto file @@ -226,33 +254,33 @@ parseDirectory :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseDirectory = do createDirectory <- Reader.asks Nar.narCreateDir - target <- currentFile + target <- currentFile Trans.lift $ createDirectory target parseEntryOrFinish - where + where - parseEntryOrFinish :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () - parseEntryOrFinish = do - -- If we reach a ")", we finished the directory's entries, and we have - -- to put ")" back into the stream, because the outer call to @parens@ - -- expects to consume it. - -- Otherwise, parse an entry as a fresh file system object - matchStr - [(")", pushStr ")") - ,("entry", parseEntry ) - ] + parseEntryOrFinish :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () + parseEntryOrFinish = + -- If we reach a ")", we finished the directory's entries, and we have + -- to put ")" back into the stream, because the outer call to @parens@ + -- expects to consume it. + -- Otherwise, parse an entry as a fresh file system object + matchStr + [ ( ")" , pushStr ")" ) + , ("entry", parseEntry ) + ] - parseEntry :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () - parseEntry = do - parens $ do - expectStr "name" - fName <- parseStr - pushFileName (T.unpack fName) - expectStr "node" - parens $ parseFSO - popFileName - parseEntryOrFinish + parseEntry :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () + parseEntry = do + parens $ do + expectStr "name" + fName <- parseStr + pushFileName (Text.unpack fName) + expectStr "node" + parens parseFSO + popFileName + parseEntryOrFinish @@ -263,17 +291,17 @@ -- | Short strings guiding the NAR parsing are prefixed with their -- length, then encoded in ASCII, and padded to 8 bytes. @parseStr@ -- captures this logic -parseStr :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m T.Text +parseStr :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m Text parseStr = do cachedStr <- popStr case cachedStr of - Just str -> do - return str + Just str -> pure str Nothing -> do - len <- parseLength - strBytes <- consume (fromIntegral len) - expectRawString (BS.replicate (fromIntegral $ padLen $ fromIntegral len) 0) - return $ E.decodeUtf8 strBytes + len <- parseLength + strBytes <- consume $ fromIntegral len + expectRawString + (Bytes.replicate (fromIntegral $ padLen $ fromIntegral len) 0) + pure $ Text.decodeUtf8 strBytes -- | Get an Int64 describing the length of the upcoming string, @@ -281,50 +309,61 @@ parseLength :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m Int64 parseLength = do eightBytes <- consume 8 - case S.runGet S.getInt64le eightBytes of - Left e -> Fail.fail $ "parseLength failed to decode int64: " ++ e - Right n -> return n + either + (\e -> Fail.fail $ "parseLength failed to decode int64: " <> e) + pure + (Serialize.runGet Serialize.getInt64le eightBytes) -- | Consume a NAR string and assert that it matches an expectation -expectStr :: (IO.MonadIO m, Fail.MonadFail m) => T.Text -> NarParser m () +expectStr :: (IO.MonadIO m, Fail.MonadFail m) => Text -> NarParser m () expectStr expected = do actual <- parseStr - when (actual /= expected) - (Fail.fail $ "Expected " ++ err expected ++ ", got " ++ err actual ) - where - err t = - if T.length t > 10 - then show (T.take 10 t) - else show t + when (actual /= expected) $ + Fail.fail $ "Expected " <> err expected <> ", got " <> err actual + where + err t = + show $ + bool + t + (Text.take 10 t <> "...") + (Text.length t > 10) -- | Consume a raw string and assert that it equals some expectation. -- This is usually used when consuming padding 0's -expectRawString :: (IO.MonadIO m, Fail.MonadFail m) => BS.ByteString -> NarParser m () +expectRawString + :: (IO.MonadIO m, Fail.MonadFail m) => ByteString -> NarParser m () expectRawString expected = do - actual <- consume (BS.length expected) - when (actual /= expected) $ - Fail.fail $ "Expected " ++ err expected ++ ", got " ++ err actual - where - err bs = - if BS.length bs > 10 - then show (BS.take 10 bs) ++ "..." - else show bs + actual <- consume $ Bytes.length expected + when (actual /= expected) + $ Fail.fail + $ "Expected " + <> err expected + <> ", got " + <> err actual + where + err bs = + show $ + bool + bs + (Bytes.take 10 bs <> "...") + (Bytes.length bs > 10) -- | Consume a NAR string, and dispatch to a parser depending on which string -- matched matchStr :: (IO.MonadIO m, Fail.MonadFail m) - => [(T.Text, NarParser m a)] + => [(Text, NarParser m a)] -- ^ List of expected possible strings and the parsers they should run -> NarParser m a matchStr parsers = do str <- parseStr case List.lookup str parsers of - Just p -> p - Nothing -> Fail.fail $ "Expected one of " ++ show (fst <$> parsers) ++ " found " ++ show str + Just p -> p + Nothing -> + Fail.fail $ "Expected one of " <> show (fst <$> parsers) <> " found " <> show str -- | Wrap any parser in NAR formatted parentheses @@ -334,7 +373,7 @@ expectStr "(" r <- act expectStr ")" - return r + pure r -- | Sort links in the symlink stack according to their connectivity @@ -344,38 +383,38 @@ createLink <- Reader.asks Nar.narCreateLink allLinks <- State.gets links sortedLinks <- IO.liftIO $ sortLinksIO allLinks - flip mapM_ sortedLinks $ \li -> do - pwd <- IO.liftIO $ Directory.getCurrentDirectory + forM_ sortedLinks $ \li -> do + pwd <- IO.liftIO Directory.getCurrentDirectory IO.liftIO $ Directory.setCurrentDirectory (linkPWD li) Trans.lift $ createLink (linkTarget li) (linkFile li) IO.liftIO $ Directory.setCurrentDirectory pwd - where + where - -- Convert every target and link file to a filepath relative - -- to NAR root, then @Graph.topSort@ it, and map from the - -- relative filepaths back to the original @LinkInfo@. - -- Relative paths are needed for sorting, but @LinkInfo@s - -- are needed for creating the link files - sortLinksIO :: [LinkInfo] -> IO [LinkInfo] - sortLinksIO ls = do - linkLocations <- fmap Map.fromList $ - forM ls $ \li-> - (,li) <$> Directory.canonicalizePath (linkFile li) - canonicalLinks <- forM ls $ \l -> do - targetAbsPath <- Directory.canonicalizePath - (linkPWD l linkTarget l) - fileAbsPath <- Directory.canonicalizePath - (linkFile l) - return (fileAbsPath, targetAbsPath) - let linkGraph = Graph.edges canonicalLinks - case Graph.topSort linkGraph of - Left _ -> error "Symlinks form a loop" - Right sortedNodes -> - let - sortedLinks = flip Map.lookup linkLocations <$> sortedNodes - in - return $ catMaybes sortedLinks + -- Convert every target and link file to a filepath relative + -- to NAR root, then @Graph.topSort@ it, and map from the + -- relative filepaths back to the original @LinkInfo@. + -- Relative paths are needed for sorting, but @LinkInfo@s + -- are needed for creating the link files + sortLinksIO :: [LinkInfo] -> IO [LinkInfo] + sortLinksIO ls = do + linkLocations <- fmap Map.fromList $ + forM ls $ \li-> + (,li) <$> Directory.canonicalizePath (linkFile li) + canonicalLinks <- forM ls $ \l -> do + targetAbsPath <- Directory.canonicalizePath + (linkPWD l linkTarget l) + fileAbsPath <- Directory.canonicalizePath + (linkFile l) + pure (fileAbsPath, targetAbsPath) + let linkGraph = Graph.edges canonicalLinks + case Graph.topSort linkGraph of + Left _ -> error "Symlinks form a loop" + Right sortedNodes -> + let + sortedLinks = flip Map.lookup linkLocations <$> sortedNodes + in + pure $ catMaybes sortedLinks ------------------------------------------------------------------------------ @@ -386,44 +425,45 @@ consume :: (IO.MonadIO m, Fail.MonadFail m) => Int - -> NarParser m BS.ByteString -consume 0 = return "" + -> NarParser m ByteString +consume 0 = pure "" consume n = do - state0 <- State.get - newBytes <- IO.liftIO $ BS.hGetSome (handle state0) (max 0 n) - when (BS.length newBytes < n) $ + state0 <- State.get + newBytes <- IO.liftIO $ Bytes.hGetSome (handle state0) (max 0 n) + when (Bytes.length newBytes < n) $ Fail.fail $ "consume: Not enough bytes in handle. Wanted " - ++ show n ++ " got " ++ show (BS.length newBytes) - return newBytes + <> show n <> " got " <> show (Bytes.length newBytes) + pure newBytes -- | Pop a string off the token stack -popStr :: Monad m => NarParser m (Maybe T.Text) +popStr :: Monad m => NarParser m (Maybe Text) popStr = do s <- State.get case List.uncons (tokenStack s) of - Nothing -> return Nothing - Just (x,xs) -> do + Nothing -> pure Nothing + Just (x, xs) -> do State.put $ s { tokenStack = xs } - return $ Just x + pure $ Just x -- | Push a string onto the token stack -pushStr :: Monad m => T.Text -> NarParser m () -pushStr str = do +pushStr :: Monad m => Text -> NarParser m () +pushStr str = State.modify $ \s -> -- s { loadedBytes = strBytes <> loadedBytes s } s { tokenStack = str : tokenStack s } -- | Push a level onto the directory stack pushFileName :: Monad m => FilePath -> NarParser m () -pushFileName fName = State.modify (\s -> s { directoryStack = fName : directoryStack s }) +pushFileName fName = + State.modify (\s -> s { directoryStack = fName : directoryStack s }) -- | Go to the parent level in the directory stack popFileName :: Monad m => NarParser m () -popFileName = do +popFileName = State.modify (\s -> s { directoryStack = List.drop 1 (directoryStack s )}) @@ -432,7 +472,7 @@ currentFile :: Monad m => NarParser m FilePath currentFile = do dirStack <- State.gets directoryStack - return $ List.foldr1 () (List.reverse dirStack) + pure $ List.foldr1 () $ List.reverse dirStack -- | Add a link to the collection of encountered symlinks @@ -443,20 +483,23 @@ ------------------------------------------------------------------------------ -- * Utilities -testParser :: (m ~ IO) => NarParser m a -> BS.ByteString -> m (Either String a) +testParser :: (m ~ IO) => NarParser m a -> ByteString -> m (Either String a) testParser p b = do - BS.writeFile "tmp" b - IO.withFile "tmp" IO.ReadMode $ \h -> - runParser Nar.narEffectsIO p h "tmp" + Bytes.writeFile tmpFileName b + IO.withFile tmpFileName IO.ReadMode $ \h -> + runParser Nar.narEffectsIO p h tmpFileName + where + tmpFileName = "tmp" testParser' :: (m ~ IO) => FilePath -> IO (Either String ()) -testParser' fp = IO.withFile fp IO.ReadMode $ \h -> runParser Nar.narEffectsIO parseNar h "tmp" +testParser' fp = + IO.withFile fp IO.ReadMode $ \h -> runParser Nar.narEffectsIO parseNar h "tmp" -- | Distance to the next multiple of 8 -padLen:: Int -> Int +padLen :: Int -> Int padLen n = (8 - n) `mod` 8 diff --git a/src/System/Nix/Internal/Nar/Streamer.hs b/src/System/Nix/Internal/Nar/Streamer.hs --- a/src/System/Nix/Internal/Nar/Streamer.hs +++ b/src/System/Nix/Internal/Nar/Streamer.hs @@ -1,23 +1,24 @@ -- | Stream out a NAR file from a regular file {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} module System.Nix.Internal.Nar.Streamer where -import Control.Monad (forM_, when) +import Control.Monad ( forM_ + , when + ) import qualified Control.Monad.IO.Class as IO -import Data.Bool (bool) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Lazy as BSL +import Data.Bool ( bool ) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as Bytes +import qualified Data.ByteString.Char8 as Bytes.Char8 +import qualified Data.ByteString.Lazy as Bytes.Lazy import qualified Data.List as List import qualified Data.Serialize as Serial -import GHC.Int (Int64) +import GHC.Int ( Int64 ) import qualified System.Directory as Directory -import System.FilePath (()) +import System.FilePath ( () ) import qualified System.Nix.Internal.Nar.Effects as Nar @@ -26,79 +27,87 @@ -- function from any streaming library, and repeatedly calls -- it while traversing the filesystem object to Nar encode streamNarIO - :: forall m.(IO.MonadIO m) - => (BS.ByteString -> m ()) + :: forall m + . (IO.MonadIO m) + => (ByteString -> m ()) -> Nar.NarEffects IO -> FilePath -> m () streamNarIO yield effs basePath = do - yield (str "nix-archive-1") - parens (go basePath) - where + yield $ str "nix-archive-1" + parens $ go basePath - go :: FilePath -> m () - go path = do - isDir <- IO.liftIO $ Nar.narIsDir effs path - isSymLink <- IO.liftIO $ Nar.narIsSymLink effs path - let isRegular = not (isDir || isSymLink) + where - when isSymLink $ do - target <- IO.liftIO $ Nar.narReadLink effs path - yield $ - strs ["type", "symlink", "target", BSC.pack target] + go :: FilePath -> m () + go path = do + isDir <- IO.liftIO $ Nar.narIsDir effs path + isSymLink <- IO.liftIO $ Nar.narIsSymLink effs path + let isRegular = not $ isDir || isSymLink - when isRegular $ do - isExec <- IO.liftIO $ isExecutable effs path - yield $ strs ["type","regular"] - when (isExec == Executable) (yield $ strs ["executable", ""]) - fSize <- IO.liftIO $ Nar.narFileSize effs path - yield $ str "contents" - yield $ int fSize - yieldFile path fSize + when isSymLink $ do + target <- IO.liftIO $ Nar.narReadLink effs path + yield $ + strs ["type", "symlink", "target", Bytes.Char8.pack target] - when isDir $ do - fs <- IO.liftIO (Nar.narListDir effs path) - yield $ strs ["type", "directory"] - forM_ (List.sort fs) $ \f -> do - yield $ str "entry" - parens $ do - let fullName = path f - yield (strs ["name", BSC.pack f, "node"]) - parens (go fullName) + when isRegular $ do + isExec <- IO.liftIO $ isExecutable effs path + yield $ strs ["type", "regular"] + when (isExec == Executable) $ yield $ strs ["executable", ""] + fSize <- IO.liftIO $ Nar.narFileSize effs path + yield $ str "contents" + yield $ int fSize + yieldFile path fSize - str :: BS.ByteString -> BS.ByteString - str t = let len = BS.length t - in int len <> padBS len t + when isDir $ do + fs <- IO.liftIO (Nar.narListDir effs path) + yield $ strs ["type", "directory"] + forM_ (List.sort fs) $ \f -> do + yield $ str "entry" + parens $ do + let fullName = path f + yield $ strs ["name", Bytes.Char8.pack f, "node"] + parens $ go fullName - padBS :: Int -> BS.ByteString -> BS.ByteString - padBS strSize bs = bs <> BS.replicate (padLen strSize) 0 + str :: ByteString -> ByteString + str t = + let + len = Bytes.length t + in + int len <> padBS len t - parens act = do - yield (str "(") - r <- act - yield (str ")") - return r + padBS :: Int -> ByteString -> ByteString + padBS strSize bs = bs <> Bytes.replicate (padLen strSize) 0 - -- Read, yield, and pad the file - yieldFile :: FilePath -> Int64 -> m () - yieldFile path fsize = do - mapM_ yield . BSL.toChunks =<< IO.liftIO (BSL.readFile path) - yield (BS.replicate (padLen (fromIntegral fsize)) 0) + parens act = do + yield $ str "(" + r <- act + yield $ str ")" + pure r - strs :: [BS.ByteString] -> BS.ByteString - strs xs = BS.concat $ str <$> xs + -- Read, yield, and pad the file + yieldFile :: FilePath -> Int64 -> m () + yieldFile path fsize = do + mapM_ yield . Bytes.Lazy.toChunks =<< IO.liftIO (Bytes.Lazy.readFile path) + yield $ Bytes.replicate (padLen $ fromIntegral fsize) 0 - int :: Integral a => a -> BS.ByteString - int n = Serial.runPut $ Serial.putInt64le (fromIntegral n) + strs :: [ByteString] -> ByteString + strs xs = Bytes.concat $ str <$> xs + int :: Integral a => a -> ByteString + int n = Serial.runPut $ Serial.putInt64le $ fromIntegral n + data IsExecutable = NonExecutable | Executable - deriving (Eq, Show) + deriving (Eq, Show) isExecutable :: Functor m => Nar.NarEffects m -> FilePath -> m IsExecutable isExecutable effs fp = - bool NonExecutable Executable . Directory.executable <$> Nar.narGetPerms effs fp + bool + NonExecutable + Executable + . Directory.executable <$> Nar.narGetPerms effs fp -- | Distance to the next multiple of 8 -padLen:: Int -> Int +padLen :: Int -> Int padLen n = (8 - n) `mod` 8 diff --git a/src/System/Nix/Internal/Signature.hs b/src/System/Nix/Internal/Signature.hs --- a/src/System/Nix/Internal/Signature.hs +++ b/src/System/Nix/Internal/Signature.hs @@ -2,21 +2,25 @@ Description : Nix-relevant interfaces to NaCl signatures. -} {-# LANGUAGE GeneralizedNewtypeDeriving #-} + module System.Nix.Internal.Signature where -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.Coerce (coerce) -import Crypto.Saltine.Core.Sign (PublicKey) -import Crypto.Saltine.Class (IsEncoding(..)) + +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as Bytes +import Data.Coerce ( coerce ) +import Crypto.Saltine.Core.Sign ( PublicKey ) +import Crypto.Saltine.Class ( IsEncoding(..) ) import qualified Crypto.Saltine.Internal.ByteSizes as NaClSizes + -- | A NaCl signature. -newtype Signature = Signature ByteString deriving (Eq, Ord) +newtype Signature = Signature ByteString + deriving (Eq, Ord) instance IsEncoding Signature where decode s - | BS.length s == NaClSizes.sign = Just (Signature s) + | Bytes.length s == NaClSizes.sign = Just $ Signature s | otherwise = Nothing encode = coerce @@ -25,5 +29,6 @@ { -- | The public key used to sign the archive. publicKey :: PublicKey , -- | The archive's signature. - sig :: Signature - } deriving (Eq, Ord) + sig :: Signature + } + deriving (Eq, Ord) diff --git a/src/System/Nix/Internal/StorePath.hs b/src/System/Nix/Internal/StorePath.hs --- a/src/System/Nix/Internal/StorePath.hs +++ b/src/System/Nix/Internal/StorePath.hs @@ -8,31 +8,37 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeInType #-} -- Needed for GHC 8.4.4 for some reason + module System.Nix.Internal.StorePath where -import System.Nix.Hash - ( HashAlgorithm(Truncated, SHA256) - , Digest - , BaseEncoding(..) - , encodeInBase - , decodeBase - , SomeNamedDigest - ) -import System.Nix.Internal.Base32 (digits32) +import System.Nix.Hash ( HashAlgorithm + ( Truncated + , SHA256 + ) + , Digest + , BaseEncoding(..) + , encodeInBase + , decodeBase + , SomeNamedDigest + ) -import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8) -import qualified Data.Text as T -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BC -import qualified Data.Char -import Data.Hashable (Hashable(..)) -import Data.HashSet (HashSet) -import Data.Attoparsec.Text.Lazy (Parser, ()) +import qualified System.Nix.Internal.Base32 as Nix.Base32 + ( digits32 ) -import qualified Data.Attoparsec.Text.Lazy -import qualified System.FilePath +import Data.ByteString ( ByteString ) +import qualified Data.ByteString.Char8 as Bytes.Char8 +import qualified Data.Char as Char +import Data.Text ( Text ) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text + ( encodeUtf8 ) +import Data.Attoparsec.Text.Lazy ( Parser + , () + ) +import qualified Data.Attoparsec.Text.Lazy as Parser.Text.Lazy +import qualified System.FilePath as FilePath +import Data.Hashable ( Hashable(..) ) +import Data.HashSet ( HashSet ) -- | A path in a Nix store. -- @@ -53,14 +59,15 @@ storePathName :: !StorePathName , -- | Root of the store storePathRoot :: !FilePath - } deriving (Eq, Ord) + } + deriving (Eq, Ord) instance Hashable StorePath where - hashWithSalt s (StorePath {..}) = + hashWithSalt s StorePath{..} = s `hashWithSalt` storePathHash `hashWithSalt` storePathName instance Show StorePath where - show p = BC.unpack $ storePathToRawFilePath p + show p = Bytes.Char8.unpack $ storePathToRawFilePath p -- | The name portion of a Nix path. -- @@ -97,7 +104,7 @@ -- applied to the nar serialization via some 'NarHashMode'. Fixed !NarHashMode !SomeNamedDigest --- | Schemes for hashing a nix archive. +-- | Schemes for hashing a Nix archive. -- -- For backwards-compatibility reasons, there are two different modes -- here, even though 'Recursive' should be able to cover both. @@ -109,115 +116,107 @@ Recursive makeStorePathName :: Text -> Either String StorePathName -makeStorePathName n = case validStorePathName n of - True -> Right $ StorePathName n - False -> Left $ reasonInvalid n +makeStorePathName n = + if validStorePathName n + then Right $ StorePathName n + else Left $ reasonInvalid n reasonInvalid :: Text -> String -reasonInvalid n | n == "" = "Empty name" -reasonInvalid n | (T.length n > 211) = "Path too long" -reasonInvalid n | (T.head n == '.') = "Leading dot" -reasonInvalid _ | otherwise = "Invalid character" +reasonInvalid n + | n == "" = "Empty name" + | Text.length n > 211 = "Path too long" + | Text.head n == '.' = "Leading dot" + | otherwise = "Invalid character" validStorePathName :: Text -> Bool -validStorePathName "" = False -validStorePathName n = (T.length n <= 211) - && T.head n /= '.' - && T.all validStorePathNameChar n +validStorePathName n = + n /= "" + && Text.length n <= 211 + && Text.head n /= '.' + && Text.all validStorePathNameChar n validStorePathNameChar :: Char -> Bool -validStorePathNameChar c = any ($ c) $ - [ Data.Char.isAsciiLower -- 'a'..'z' - , Data.Char.isAsciiUpper -- 'A'..'Z' - , Data.Char.isDigit - ] ++ - map (==) "+-._?=" +validStorePathNameChar c = + any ($ c) + [ Char.isAsciiLower -- 'a'..'z', isAscii..er probably faster then putting it out + , Char.isAsciiUpper -- 'A'..'Z' + , Char.isDigit + , (`elem` ("+-._?=" :: String)) + ] -- | Copied from @RawFilePath@ in the @unix@ package, duplicated here -- to avoid the dependency. type RawFilePath = ByteString -- | Render a 'StorePath' as a 'RawFilePath'. -storePathToRawFilePath - :: StorePath - -> RawFilePath -storePathToRawFilePath StorePath {..} = BS.concat - [ root - , "/" - , hashPart - , "-" - , name - ] - where - root = BC.pack storePathRoot - hashPart = encodeUtf8 $ encodeInBase Base32 storePathHash - name = encodeUtf8 $ unStorePathName storePathName +storePathToRawFilePath :: StorePath -> RawFilePath +storePathToRawFilePath StorePath{..} = + root <> "/" <> hashPart <> "-" <> name + where + root = Bytes.Char8.pack storePathRoot + hashPart = Text.encodeUtf8 $ encodeInBase Base32 storePathHash + name = Text.encodeUtf8 $ unStorePathName storePathName -- | Render a 'StorePath' as a 'FilePath'. -storePathToFilePath - :: StorePath - -> FilePath -storePathToFilePath = BC.unpack . storePathToRawFilePath +storePathToFilePath :: StorePath -> FilePath +storePathToFilePath = Bytes.Char8.unpack . storePathToRawFilePath -- | Render a 'StorePath' as a 'Text'. -storePathToText - :: StorePath - -> Text -storePathToText = T.pack . BC.unpack . storePathToRawFilePath +storePathToText :: StorePath -> Text +storePathToText = Text.pack . Bytes.Char8.unpack . storePathToRawFilePath -- | Build `narinfo` suffix from `StorePath` which -- can be used to query binary caches. -storePathToNarInfo - :: StorePath - -> BC.ByteString -storePathToNarInfo StorePath {..} = BS.concat - [ encodeUtf8 $ encodeInBase Base32 storePathHash - , ".narinfo" - ] +storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString +storePathToNarInfo StorePath{..} = + Text.encodeUtf8 $ encodeInBase Base32 storePathHash <> ".narinfo" --- | Parse `StorePath` from `BC.ByteString`, checking +-- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking -- that store directory matches `expectedRoot`. -parsePath - :: FilePath - -> BC.ByteString - -> Either String StorePath +parsePath :: FilePath -> Bytes.Char8.ByteString -> Either String StorePath parsePath expectedRoot x = let - (rootDir, fname) = System.FilePath.splitFileName . BC.unpack $ x - (digestPart, namePart) = T.breakOn "-" $ T.pack fname + (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x + (digestPart, namePart) = Text.breakOn "-" $ Text.pack fname digest = decodeBase Base32 digestPart - name = makeStorePathName . T.drop 1 $ namePart + name = makeStorePathName . Text.drop 1 $ namePart --rootDir' = dropTrailingPathSeparator rootDir -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b rootDir' = init rootDir - storeDir = if expectedRoot == rootDir' - then Right rootDir' - else Left $ "Root store dir mismatch, expected" <> expectedRoot <> "got" <> rootDir' + storeDir = + if expectedRoot == rootDir' + then Right rootDir' + else Left $ "Root store dir mismatch, expected" <> expectedRoot <> "got" <> rootDir' in StorePath <$> digest <*> name <*> storeDir pathParser :: FilePath -> Parser StorePath pathParser expectedRoot = do - _ <- Data.Attoparsec.Text.Lazy.string (T.pack expectedRoot) - "Store root mismatch" -- e.g. /nix/store + _ <- + Parser.Text.Lazy.string (Text.pack expectedRoot) + "Store root mismatch" -- e.g. /nix/store - _ <- Data.Attoparsec.Text.Lazy.char '/' - "Expecting path separator" + _ <- Parser.Text.Lazy.char '/' + "Expecting path separator" - digest <- decodeBase Base32 - <$> Data.Attoparsec.Text.Lazy.takeWhile1 (`elem` digits32) - "Invalid Base32 part" + digest <- + decodeBase Base32 + <$> Parser.Text.Lazy.takeWhile1 (`elem` Nix.Base32.digits32) + "Invalid Base32 part" - _ <- Data.Attoparsec.Text.Lazy.char '-' - "Expecting dash (path name separator)" + _ <- Parser.Text.Lazy.char '-' "Expecting dash (path name separator)" - c0 <- Data.Attoparsec.Text.Lazy.satisfy (\c -> c /= '.' && validStorePathNameChar c) - "Leading path name character is a dot or invalid character" + c0 <- + Parser.Text.Lazy.satisfy (\c -> c /= '.' && validStorePathNameChar c) + "Leading path name character is a dot or invalid character" - rest <- Data.Attoparsec.Text.Lazy.takeWhile validStorePathNameChar - "Path name contains invalid character" + rest <- + Parser.Text.Lazy.takeWhile validStorePathNameChar + "Path name contains invalid character" - let name = makeStorePathName $ T.cons c0 rest + let name = makeStorePathName $ Text.cons c0 rest - either fail return - $ StorePath <$> digest <*> name <*> pure expectedRoot + either + fail + pure + (StorePath <$> digest <*> name <*> pure expectedRoot) diff --git a/src/System/Nix/Nar.hs b/src/System/Nix/Nar.hs --- a/src/System/Nix/Nar.hs +++ b/src/System/Nix/Nar.hs @@ -9,7 +9,8 @@ {-# LANGUAGE TypeFamilies #-} -module System.Nix.Nar ( +module System.Nix.Nar + ( -- * Encoding and Decoding NAR archives buildNarIO @@ -27,15 +28,16 @@ -- * Internal , Nar.streamNarIO , Nar.runParser - ) where + ) +where -import qualified Control.Concurrent as Concurrent -import qualified Data.ByteString as BS -import qualified System.IO as IO +import qualified Control.Concurrent as Concurrent +import qualified Data.ByteString as BS +import qualified System.IO as IO -import qualified System.Nix.Internal.Nar.Effects as Nar -import qualified System.Nix.Internal.Nar.Parser as Nar -import qualified System.Nix.Internal.Nar.Streamer as Nar +import qualified System.Nix.Internal.Nar.Effects as Nar +import qualified System.Nix.Internal.Nar.Parser as Nar +import qualified System.Nix.Internal.Nar.Streamer as Nar -- For a description of the NAR format, see Eelco's thesis @@ -50,8 +52,11 @@ -> FilePath -> IO.Handle -> IO () -buildNarIO effs basePath outHandle = do - Nar.streamNarIO (\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10) effs basePath +buildNarIO effs basePath outHandle = + Nar.streamNarIO + (\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10) + effs + basePath -- | Read NAR formatted bytes from the @IO.Handle@ and unpack them into @@ -61,5 +66,4 @@ -> IO.Handle -> FilePath -> IO (Either String ()) -unpackNarIO effs narHandle outputFile = do - Nar.runParser effs Nar.parseNar narHandle outputFile +unpackNarIO effs = Nar.runParser effs Nar.parseNar diff --git a/src/System/Nix/ReadonlyStore.hs b/src/System/Nix/ReadonlyStore.hs --- a/src/System/Nix/ReadonlyStore.hs +++ b/src/System/Nix/ReadonlyStore.hs @@ -2,50 +2,68 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} + module System.Nix.ReadonlyStore where -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import qualified Data.Text as T -import qualified Data.HashSet as HS + +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.HashSet as HS import Data.Text.Encoding import System.Nix.Hash import System.Nix.StorePath -makeStorePath :: forall hashAlgo . (NamedAlgo hashAlgo) + +makeStorePath + :: forall hashAlgo + . (NamedAlgo hashAlgo) => FilePath -> ByteString -> Digest hashAlgo -> StorePathName -> StorePath makeStorePath fp ty h nm = StorePath storeHash nm fp - where - s = BS.intercalate ":" - [ ty - , encodeUtf8 $ algoName @hashAlgo - , encodeUtf8 $ encodeInBase Base16 h - , encodeUtf8 $ T.pack fp - , encodeUtf8 $ unStorePathName nm - ] - storeHash = hash s + where + storeHash = hash s -makeTextPath :: FilePath -> StorePathName -> Digest 'SHA256 -> StorePathSet -> StorePath + s = + BS.intercalate ":" $ + ty:fmap encodeUtf8 + [ algoName @hashAlgo + , encodeInBase Base16 h + , T.pack fp + , unStorePathName nm + ] + +makeTextPath + :: FilePath -> StorePathName -> Digest 'SHA256 -> StorePathSet -> StorePath makeTextPath fp nm h refs = makeStorePath fp ty h nm - where - ty = BS.intercalate ":" ("text" : map storePathToRawFilePath (HS.toList refs)) + where + ty = + BS.intercalate ":" ("text" : fmap storePathToRawFilePath (HS.toList refs)) -makeFixedOutputPath :: forall hashAlgo . (ValidAlgo hashAlgo, NamedAlgo hashAlgo) +makeFixedOutputPath + :: forall hashAlgo + . (ValidAlgo hashAlgo, NamedAlgo hashAlgo) => FilePath -> Bool -> Digest hashAlgo -> StorePathName -> StorePath -makeFixedOutputPath fp recursive h nm = +makeFixedOutputPath fp recursive h = if recursive && (algoName @hashAlgo) == "sha256" - then makeStorePath fp "source" h nm - else makeStorePath fp "output:out" h' nm + then makeStorePath fp "source" h + else makeStorePath fp "output:out" h' where - h' = hash @'SHA256 $ "fixed:out:" <> encodeUtf8 (algoName @hashAlgo) <> (if recursive then ":r:" else ":") <> encodeUtf8 (encodeInBase Base16 h) <> ":" + h' = + hash @ 'SHA256 + $ "fixed:out:" + <> encodeUtf8 (algoName @hashAlgo) + <> (if recursive then ":r:" else ":") + <> encodeUtf8 (encodeInBase Base16 h) + <> ":" -computeStorePathForText :: FilePath -> StorePathName -> ByteString -> StorePathSet -> StorePath -computeStorePathForText fp nm s refs = makeTextPath fp nm (hash s) refs +computeStorePathForText + :: FilePath -> StorePathName -> ByteString -> (StorePathSet -> StorePath) +computeStorePathForText fp nm = makeTextPath fp nm . hash diff --git a/src/System/Nix/Signature.hs b/src/System/Nix/Signature.hs --- a/src/System/Nix/Signature.hs +++ b/src/System/Nix/Signature.hs @@ -4,6 +4,7 @@ module System.Nix.Signature ( Signature , NarSignature(..) - ) where + ) +where -import System.Nix.Internal.Signature +import System.Nix.Internal.Signature diff --git a/src/System/Nix/StorePath.hs b/src/System/Nix/StorePath.hs --- a/src/System/Nix/StorePath.hs +++ b/src/System/Nix/StorePath.hs @@ -21,6 +21,7 @@ , -- * Parsing 'StorePath's parsePath , pathParser - ) where + ) +where -import System.Nix.Internal.StorePath +import System.Nix.Internal.StorePath diff --git a/src/System/Nix/StorePathMetadata.hs b/src/System/Nix/StorePathMetadata.hs --- a/src/System/Nix/StorePathMetadata.hs +++ b/src/System/Nix/StorePathMetadata.hs @@ -3,12 +3,15 @@ -} module System.Nix.StorePathMetadata where -import System.Nix.StorePath (StorePath, StorePathSet, ContentAddressableAddress) -import System.Nix.Hash (SomeNamedDigest) -import Data.Set (Set) -import Data.Time (UTCTime) -import Data.Word (Word64) -import System.Nix.Signature (NarSignature) +import System.Nix.StorePath ( StorePath + , StorePathSet + , ContentAddressableAddress + ) +import System.Nix.Hash ( SomeNamedDigest ) +import Data.Set ( Set ) +import Data.Time ( UTCTime ) +import Data.Word ( Word64 ) +import System.Nix.Signature ( NarSignature ) -- | Metadata about a 'StorePath' data StorePathMetadata = StorePathMetadata diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs --- a/tests/Arbitrary.hs +++ b/tests/Arbitrary.hs @@ -4,9 +4,9 @@ module Arbitrary where -import Control.Monad (replicateM) -import qualified Data.ByteString.Char8 as BSC -import qualified Data.Text as T +import Control.Monad ( replicateM ) +import qualified Data.ByteString.Char8 as BSC +import qualified Data.Text as T import Test.Tasty.QuickCheck @@ -22,15 +22,14 @@ nonEmptyString = listOf1 genSafeChar dir :: Gen String -dir = ('/':) <$> (listOf1 $ elements $ ('/':['a'..'z'])) +dir = ('/':) <$> (listOf1 $ elements $ '/':['a'..'z']) instance Arbitrary StorePathName where - arbitrary = StorePathName . T.pack - <$> ((:) <$> s1 <*> listOf sn) - where - alphanum = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] - s1 = elements $ alphanum ++ "+-_?=" - sn = elements $ alphanum ++ "+-._?=" + arbitrary = StorePathName . T.pack <$> ((:) <$> s1 <*> listOf sn) + where + alphanum = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'] + s1 = elements $ alphanum <> "+-_?=" + sn = elements $ alphanum <> "+-._?=" instance Arbitrary (Digest StorePathHashAlgo) where arbitrary = hash . BSC.pack <$> arbitrary @@ -41,19 +40,17 @@ newtype NixLike = NixLike {getNixLike :: StorePath} deriving (Eq, Ord, Show) -instance Arbitrary (NixLike) where - arbitrary = NixLike <$> - (StorePath - <$> arbitraryTruncatedDigest - <*> arbitrary - <*> pure "/nix/store") - where - -- 160-bit hash, 20 bytes, 32 chars in base32 - arbitraryTruncatedDigest = Digest . BSC.pack - <$> replicateM 20 genSafeChar +instance Arbitrary NixLike where + arbitrary = + NixLike + <$> (StorePath + <$> arbitraryTruncatedDigest + <*> arbitrary + <*> pure "/nix/store" + ) + where + -- 160-bit hash, 20 bytes, 32 chars in base32 + arbitraryTruncatedDigest = Digest . BSC.pack <$> replicateM 20 genSafeChar instance Arbitrary StorePath where - arbitrary = StorePath - <$> arbitrary - <*> arbitrary - <*> dir + arbitrary = StorePath <$> arbitrary <*> arbitrary <*> dir diff --git a/tests/Derivation.hs b/tests/Derivation.hs --- a/tests/Derivation.hs +++ b/tests/Derivation.hs @@ -1,10 +1,14 @@ module Derivation where -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Golden (goldenVsFile) +import Test.Tasty ( TestTree + , testGroup + ) +import Test.Tasty.Golden ( goldenVsFile ) -import System.Nix.Derivation (parseDerivation, buildDerivation) +import System.Nix.Derivation ( parseDerivation + , buildDerivation + ) import qualified Data.Attoparsec.Text.Lazy import qualified Data.Text.IO @@ -14,25 +18,30 @@ processDerivation :: FilePath -> FilePath -> IO () processDerivation source dest = do contents <- Data.Text.IO.readFile source - case Data.Attoparsec.Text.Lazy.parseOnly (parseDerivation "/nix/store") contents of + case + Data.Attoparsec.Text.Lazy.parseOnly + (parseDerivation "/nix/store") + contents + of Left e -> error e Right drv -> - Data.Text.IO.writeFile dest - . Data.Text.Lazy.toStrict - . Data.Text.Lazy.Builder.toLazyText - $ buildDerivation drv + Data.Text.IO.writeFile dest + . Data.Text.Lazy.toStrict + . Data.Text.Lazy.Builder.toLazyText + $ buildDerivation drv test_derivation :: TestTree -test_derivation = testGroup "golden" $ map mk [0..1] - where - mk :: Int -> TestTree - mk n = - let - fp = "tests/samples/example" - drv = (fp ++ show n ++ ".drv") - act = (fp ++ show n ++ ".actual") - in - goldenVsFile - ("derivation roundtrip of " ++ drv) - drv act (processDerivation drv act) - +test_derivation = + testGroup "golden" $ fmap mk [0 .. 1] + where + mk :: Int -> TestTree + mk n = + goldenVsFile + ("derivation roundtrip of " <> drv) + drv + act + (processDerivation drv act) + where + drv = fp <> show n <> ".drv" + act = fp <> show n <> ".actual" + fp = "tests/samples/example" diff --git a/tests/NarFormat.hs b/tests/NarFormat.hs --- a/tests/NarFormat.hs +++ b/tests/NarFormat.hs @@ -159,7 +159,7 @@ let go dir = do srcHere <- doesDirectoryExist dir case srcHere of - False -> return () + False -> pure () True -> do IO.withFile narFilePath IO.WriteMode $ \h -> buildNarIO narEffectsIO "src" h @@ -231,7 +231,7 @@ IO.withFile "hnar" IO.WriteMode $ \h -> buildNarIO narEffectsIO narFilePath h filesPostcount <- countProcessFiles - return $ filesPostcount - filesPrecount + pure $ (-) <$> filesPostcount <*> filesPrecount step "create test files" Directory.createDirectory packagePath @@ -252,7 +252,9 @@ step "check constant file usage" filesPostcount <- countProcessFiles - (filesPostcount - filesPrecount) `shouldSatisfy` (< 50) + case ((-) <$> filesPostcount <*> filesPrecount) of + Nothing -> pure () + Just c -> c `shouldSatisfy` (< 50) -- step "check file exists" -- e <- doesPathExist packagePath' @@ -316,7 +318,7 @@ bytes <- max_live_bytes <$> getRTSStats bytes < 100 * 1000 * 1000 `shouldBe` True #else - return () + pure () #endif @@ -339,34 +341,38 @@ Left (_ :: SomeException) -> print ("No nix-store on system" :: String) Right _ -> do let - nixNarFile = narFilePath ++ ".nix" - hnixNarFile = narFilePath ++ ".hnix" - outputFile = narFilePath ++ ".out" + nixNarFile = narFilePath <> ".nix" + hnixNarFile = narFilePath <> ".hnix" + outputFile = narFilePath <> ".out" - step $ "Produce nix-store nar to " ++ nixNarFile - (_,_,_,handle) <- P.createProcess (P.shell $ "nix-store --dump " ++ narFilePath ++ " > " ++ nixNarFile) + step $ "Produce nix-store nar to " <> nixNarFile + (_,_,_,handle) <- P.createProcess (P.shell $ "nix-store --dump " <> narFilePath <> " > " <> nixNarFile) void $ P.waitForProcess handle - step $ "Build NAR from " ++ narFilePath ++ " to " ++ hnixNarFile + step $ "Build NAR from " <> narFilePath <> " to " <> hnixNarFile -- narBS <- buildNarIO narEffectsIO narFile IO.withFile hnixNarFile IO.WriteMode $ \h -> buildNarIO narEffectsIO narFilePath h -- BSL.writeFile hnixNarFile narBS - step $ "Unpack NAR to " ++ outputFile + step $ "Unpack NAR to " <> outputFile _narHandle <- IO.withFile nixNarFile IO.ReadMode $ \h -> unpackNarIO narEffectsIO h outputFile - return () + pure () -- | Count file descriptors owned by the current process -countProcessFiles :: IO Int +countProcessFiles :: IO (Maybe Int) countProcessFiles = do pid <- Unix.getProcessID - let fdDir = "/proc/" ++ show pid ++ "/fd" - fds <- P.readProcess "ls" [fdDir] "" - return $ length $ words fds + hasProc <- doesDirectoryExist "/proc" + if not hasProc + then pure Nothing + else do + let fdDir = "/proc/" <> show pid <> "/fd" + fds <- P.readProcess "ls" [fdDir] "" + pure $ pure $ length $ words fds -- | Read the binary output of `nix-store --dump` for a filepath @@ -437,12 +443,12 @@ (FilePathPart "bf1", sampleLargeFile fSize) , (FilePathPart "bf2", sampleLargeFile' fSize) ] - ++ [ (FilePathPart (BSC.pack $ 'f' : show n), + <> [ (FilePathPart (BSC.pack $ 'f' : show n), Regular Nar.NonExecutable 10000 (BSL.take 10000 (BSL.cycle "hi "))) | n <- [1..100 :: Int]] - ++ [ + <> [ (FilePathPart "d", Directory $ Map.fromList - [ (FilePathPart (BSC.pack $ "df" ++ show n) + [ (FilePathPart (BSC.pack $ "df" <> show n) , Regular Nar.NonExecutable 10000 (BSL.take 10000 (BSL.cycle "subhi "))) | n <- [1..100 :: Int]] ) @@ -595,13 +601,13 @@ arbName :: Gen FilePathPart arbName = fmap (FilePathPart . BS.pack . fmap (fromIntegral . fromEnum)) $ do Positive n <- arbitrary - replicateM n (elements $ ['a'..'z'] ++ ['0'..'9']) + replicateM n (elements $ ['a'..'z'] <> ['0'..'9']) arbDirectory :: Int -> Gen FileSystemObject arbDirectory n = fmap (Directory . Map.fromList) $ replicateM n $ do nm <- arbName f <- oneof [arbFile, arbDirectory (n `div` 2)] - return (nm,f) + pure (nm,f) ------------------------------------------------------------------------------ -- | Serialize Nar to lazy ByteString @@ -615,7 +621,7 @@ strs ["type", "regular"] >> (if isExec == Nar.Executable then strs ["executable", ""] - else return ()) + else pure ()) >> putContents fSize contents putFile (SymLink target) = @@ -678,13 +684,13 @@ >> assertStr "") assertStr_ "contents" (fSize, contents) <- sizedStr - return $ Regular (fromMaybe Nar.NonExecutable mExecutable) fSize contents + pure $ Regular (fromMaybe Nar.NonExecutable mExecutable) fSize contents getDirectory = do assertStr_ "type" assertStr_ "directory" fs <- many getEntry - return $ Directory (Map.fromList fs) + pure $ Directory (Map.fromList fs) getSymLink = do assertStr_ "type" @@ -699,8 +705,8 @@ name <- E.decodeUtf8 . BSL.toStrict <$> str assertStr_ "node" file <- parens getFile - maybe (fail $ "Bad FilePathPart: " ++ show name) - (return . (,file)) + maybe (fail $ "Bad FilePathPart: " <> show name) + (pure . (,file)) (filePathPart $ E.encodeUtf8 name) -- Fetch a length-prefixed, null-padded string @@ -710,7 +716,7 @@ n <- getInt64le s <- getLazyByteString n _ <- getByteString . fromIntegral $ padLen n - return (n,s) + pure (n,s) parens m = assertStr "(" *> m <* assertStr ")" @@ -718,5 +724,5 @@ assertStr s = do s' <- str if s == s' - then return s + then pure s else fail "No" diff --git a/tests/StorePath.hs b/tests/StorePath.hs --- a/tests/StorePath.hs +++ b/tests/StorePath.hs @@ -24,10 +24,8 @@ prop_storePathRoundtripParser :: NixLike -> NixLike -> Property prop_storePathRoundtripParser (_ :: NixLike) = \(NixLike x) -> - (Data.Attoparsec.Text.Lazy.parseOnly (pathParser (storePathRoot x)) - $ storePathToText x) === Right x + (Data.Attoparsec.Text.Lazy.parseOnly (pathParser $ storePathRoot x) $ storePathToText x) === Right x prop_storePathRoundtripParser' :: StorePath -> Property prop_storePathRoundtripParser' x = - (Data.Attoparsec.Text.Lazy.parseOnly (pathParser (storePathRoot x)) - $ storePathToText x) === Right x + (Data.Attoparsec.Text.Lazy.parseOnly (pathParser $ storePathRoot x) $ storePathToText x) === Right x