diff --git a/.github/workflows/Cabal-Linux-Remote.yml b/.github/workflows/Cabal-Linux-Remote.yml index 7e70df1..59aec27 100644 --- a/.github/workflows/Cabal-Linux-Remote.yml +++ b/.github/workflows/Cabal-Linux-Remote.yml @@ -19,7 +19,7 @@ jobs: strategy: matrix: packageRoot: [ hnix-store-remote ] - ghc: [ "8.10", "8.4" ] + ghc: [ "9.0", "8.6" ] defaults: run: working-directory: "./${{ matrix.packageRoot }}" @@ -75,5 +75,5 @@ jobs: run: cabal v2-test $cabalConfig - name: "Source distribution file" - if: ${{ matrix.ghc == '8.10' }} + if: ${{ matrix.ghc == '9.0' }} run: cabal v2-sdist diff --git a/.github/workflows/Core-Cabal-Linux.yml b/.github/workflows/Core-Cabal-Linux.yml index 181f478..ba683f8 100644 --- a/.github/workflows/Core-Cabal-Linux.yml +++ b/.github/workflows/Core-Cabal-Linux.yml @@ -21,7 +21,7 @@ jobs: # Separation between Core & Store workflows made deliberately, so when one fixes Core, CI does not falls because of the Hackage Core Remote builds with. # Also singleton also use is deliberate, it allows to reference the value in the further configuration & also leaves a name in the CI & preserves matrix flexibility for the future. packageRoot: [ hnix-store-core ] - ghc: [ "8.10", "8.4" ] + ghc: [ "9.0", "8.6" ] defaults: run: working-directory: "./${{ matrix.packageRoot }}" @@ -67,5 +67,5 @@ jobs: run: cabal v2-test $cabalConfig - name: "Source distribution file" - if: ${{ matrix.ghc == '8.10' }} + if: ${{ matrix.ghc == '9.0' }} run: cabal v2-sdist diff --git a/.github/workflows/Core-Cabal-macOS.yml b/.github/workflows/Core-Cabal-macOS.yml index 080ee97..1116751 100644 --- a/.github/workflows/Core-Cabal-macOS.yml +++ b/.github/workflows/Core-Cabal-macOS.yml @@ -33,7 +33,7 @@ jobs: id: HaskEnvSetup uses: haskell/actions/setup@v1 with: - ghc-version: '8.10' + ghc-version: '9.0' - name: "Repository update" run: cabal v2-update diff --git a/.github/workflows/On-Release-Cabal-Linux.yml b/.github/workflows/On-Release-Cabal-Linux.yml index 5785549..994649d 100644 --- a/.github/workflows/On-Release-Cabal-Linux.yml +++ b/.github/workflows/On-Release-Cabal-Linux.yml @@ -18,7 +18,7 @@ jobs: matrix: packageRoot: [ hnix-store-core, hnix-store-remote ] # Since CI by default tests boundary GHCs, test middle versions of GHCs - ghc: [ "8.8", "8.6"] + ghc: [ "8.10", "8.8"] defaults: run: working-directory: "./${{ matrix.packageRoot }}" diff --git a/core-simple.png b/core-simple.png new file mode 100644 index 0000000..c70793c Binary files /dev/null and b/core-simple.png differ diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index 2c3efa8..ab5e07a 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -48,7 +48,8 @@ library , System.Nix.StorePath , System.Nix.StorePathMetadata build-depends: - base >=4.10 && <5 + base >=4.12 && <5 + , relude , attoparsec , algebraic-graphs >= 0.5 && < 0.6 , base16-bytestring @@ -72,6 +73,29 @@ library , unix , unordered-containers , vector + mixins: + base hiding (Prelude) + , relude (Relude as Prelude) + , relude + default-extensions: + OverloadedStrings + , DeriveGeneric + , DeriveDataTypeable + , DeriveFunctor + , DeriveFoldable + , DeriveTraversable + , DeriveLift + , FlexibleContexts + , FlexibleInstances + , StandaloneDeriving + , TypeApplications + , TypeSynonymInstances + , InstanceSigs + , MultiParamTypeClasses + , TupleSections + , LambdaCase + , BangPatterns + , ViewPatterns hs-source-dirs: src default-language: Haskell2010 @@ -100,6 +124,7 @@ test-suite format-tests hnix-store-core , attoparsec , base + , relude , base16-bytestring , base64-bytestring , binary @@ -118,4 +143,27 @@ test-suite format-tests , temporary , text , unix + mixins: + base hiding (Prelude) + , relude (Relude as Prelude) + , relude + default-extensions: + OverloadedStrings + , DeriveGeneric + , DeriveDataTypeable + , DeriveFunctor + , DeriveFoldable + , DeriveTraversable + , DeriveLift + , FlexibleContexts + , FlexibleInstances + , StandaloneDeriving + , TypeApplications + , TypeSynonymInstances + , InstanceSigs + , MultiParamTypeClasses + , TupleSections + , LambdaCase + , BangPatterns + , ViewPatterns default-language: Haskell2010 diff --git a/hnix-store-core/src/System/Nix/Build.hs b/hnix-store-core/src/System/Nix/Build.hs index 22a8c27..01b29a6 100644 --- a/hnix-store-core/src/System/Nix/Build.hs +++ b/hnix-store-core/src/System/Nix/Build.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards #-} +{-# language RecordWildCards #-} {-| Description : Build related types Maintainer : srk @@ -12,7 +12,6 @@ module System.Nix.Build where 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 diff --git a/hnix-store-core/src/System/Nix/Derivation.hs b/hnix-store-core/src/System/Nix/Derivation.hs index 63ade3d..3d72330 100644 --- a/hnix-store-core/src/System/Nix/Derivation.hs +++ b/hnix-store-core/src/System/Nix/Derivation.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} module System.Nix.Derivation ( parseDerivation @@ -6,11 +5,8 @@ module System.Nix.Derivation ) where -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 ) @@ -29,7 +25,5 @@ parseDerivation expectedRoot = buildDerivation :: Derivation StorePath Text -> Text.Lazy.Builder buildDerivation = Derivation.buildDerivationWith - (string . Text.pack . show) - string - where - string = Text.Lazy.Builder.fromText . Text.pack . show + (show . show) + show diff --git a/hnix-store-core/src/System/Nix/Internal/Base.hs b/hnix-store-core/src/System/Nix/Internal/Base.hs index c87ba82..c8b511b 100644 --- a/hnix-store-core/src/System/Nix/Internal/Base.hs +++ b/hnix-store-core/src/System/Nix/Internal/Base.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# language CPP #-} module System.Nix.Internal.Base ( BaseEncoding(Base16,NixBase32,Base64) @@ -7,9 +7,6 @@ module System.Nix.Internal.Base ) where -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.ByteString as Bytes import qualified Data.ByteString.Base16 as Base16 import qualified System.Nix.Base32 as Base32 -- Nix has own Base32 encoding import qualified Data.ByteString.Base64 as Base64 @@ -24,22 +21,22 @@ data BaseEncoding -- | Encode @ByteString@ with @Base@ encoding, produce @Text@. -encodeWith :: BaseEncoding -> Bytes.ByteString -> T.Text -encodeWith Base16 = T.decodeUtf8 . Base16.encode +encodeWith :: BaseEncoding -> ByteString -> Text +encodeWith Base16 = decodeUtf8 . Base16.encode encodeWith NixBase32 = Base32.encode -encodeWith Base64 = T.decodeUtf8 . Base64.encode +encodeWith Base64 = decodeUtf8 . Base64.encode -- | Take the input & @Base@ encoding witness -> decode into @Text@. -decodeWith :: BaseEncoding -> T.Text -> Either String Bytes.ByteString +decodeWith :: BaseEncoding -> Text -> Either String ByteString #if MIN_VERSION_base16_bytestring(1,0,0) -decodeWith Base16 = Base16.decode . T.encodeUtf8 +decodeWith Base16 = Base16.decode . encodeUtf8 #else decodeWith Base16 = lDecode -- this tacit sugar simply makes GHC pleased with number of args where lDecode t = - case Base16.decode (T.encodeUtf8 t) of + case Base16.decode (encodeUtf8 t) of (x, "") -> pure $ x - _ -> Left $ "Unable to decode base16 string" <> T.unpack t + _ -> Left $ "Unable to decode base16 string" <> toString t #endif decodeWith NixBase32 = Base32.decode -decodeWith Base64 = Base64.decode . T.encodeUtf8 +decodeWith Base64 = Base64.decode . encodeUtf8 diff --git a/hnix-store-core/src/System/Nix/Internal/Base32.hs b/hnix-store-core/src/System/Nix/Internal/Base32.hs index 3fffe9a..bc35f22 100644 --- a/hnix-store-core/src/System/Nix/Internal/Base32.hs +++ b/hnix-store-core/src/System/Nix/Internal/Base32.hs @@ -6,18 +6,12 @@ module System.Nix.Internal.Base32 where -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 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 ) @@ -27,7 +21,7 @@ digits32 = Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz" -- | Encode a 'BS.ByteString' in Nix's base32 encoding encode :: ByteString -> Text -encode c = Data.Text.pack $ takeCharPosFromDict <$> [nChar - 1, nChar - 2 .. 0] +encode c = toText $ takeCharPosFromDict <$> [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 @@ -74,9 +68,9 @@ unsafeDecode what = (\c -> fromMaybe (error "character not in digits32") $ Vector.findIndex (== c) digits32 ) - (Data.Text.unpack what) + (toString what) of - [(i, _)] -> Right $ padded $ integerToBS i + [(i, _)] -> pure $ padded $ integerToBS i x -> Left $ "Can't decode: readInt returned " <> show x where padded x diff --git a/hnix-store-core/src/System/Nix/Internal/Hash.hs b/hnix-store-core/src/System/Nix/Internal/Hash.hs index 7be72dd..7ac3c49 100644 --- a/hnix-store-core/src/System/Nix/Internal/Hash.hs +++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs @@ -2,15 +2,12 @@ Description : Cryptographic hashing interface for hnix-store, on top of the cryptohash family of libraries. -} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE CPP #-} +{-# language AllowAmbiguousTypes #-} +{-# language TypeFamilies #-} +{-# language ScopedTypeVariables #-} +{-# language DataKinds #-} +{-# language ExistentialQuantification #-} +{-# language CPP #-} module System.Nix.Internal.Hash ( NamedAlgo(..) @@ -22,9 +19,9 @@ module System.Nix.Internal.Hash ) where +import qualified Text.Show import qualified Crypto.Hash as C import qualified Data.ByteString as BS -import Data.Text (Text) import qualified Data.Text as T import System.Nix.Internal.Base import Data.ByteArray @@ -52,27 +49,27 @@ data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (C.Digest a) instance Show SomeNamedDigest where show sd = case sd of - SomeDigest (digest :: C.Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest + SomeDigest (digest :: C.Digest hashType) -> toString $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest mkNamedDigest name sriHash = let (sriName, h) = T.breakOnEnd "-" sriHash in if sriName == "" || sriName == name <> "-" then mkDigest h - else Left $ T.unpack $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name + else Left $ toString $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name where mkDigest h = case name of "md5" -> SomeDigest <$> decodeGo C.MD5 h "sha1" -> SomeDigest <$> decodeGo C.SHA1 h "sha256" -> SomeDigest <$> decodeGo C.SHA256 h "sha512" -> SomeDigest <$> decodeGo C.SHA512 h - _ -> Left $ "Unknown hash name: " <> T.unpack name + _ -> Left $ "Unknown hash name: " <> toString name decodeGo :: forall a . NamedAlgo a => a -> Text -> Either String (C.Digest a) decodeGo a h | size == base16Len = decodeDigestWith Base16 h | size == base32Len = decodeDigestWith NixBase32 h | size == base64Len = decodeDigestWith 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 $ toString sriHash <> " is not a valid " <> toString name <> " hash. Its length (" <> show size <> ") does not match any of " <> show [base16Len, base32Len, base64Len] where size = T.length h hsize = C.hashDigestSize a @@ -100,8 +97,3 @@ decodeDigestWith b x = maybeToRight ("Cryptonite was not able to convert '(ByteString -> Digest a)' for: '" <> show bs <>"'.") (toEither . C.digestFromByteString) bs - where - -- To not depend on @extra@ - maybeToRight :: b -> Maybe a -> Either b a - maybeToRight _ (Just r) = pure r - maybeToRight y Nothing = Left y diff --git a/hnix-store-core/src/System/Nix/Internal/Nar/Effects.hs b/hnix-store-core/src/System/Nix/Internal/Nar/Effects.hs index ed28662..89fde66 100644 --- a/hnix-store-core/src/System/Nix/Internal/Nar/Effects.hs +++ b/hnix-store-core/src/System/Nix/Internal/Nar/Effects.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# language KindSignatures #-} +{-# language RankNTypes #-} +{-# language ScopedTypeVariables #-} module System.Nix.Internal.Nar.Effects ( NarEffects(..) @@ -10,7 +9,6 @@ module System.Nix.Internal.Nar.Effects 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 @@ -79,7 +77,7 @@ streamStringOutIO -> m () streamStringOutIO f getChunk = Exception.Lifted.bracket - (IO.liftIO $ IO.openFile f IO.WriteMode) + (IO.liftIO $ IO.openFile f WriteMode) (IO.liftIO . IO.hClose) go `Exception.Lifted.catch` @@ -89,7 +87,7 @@ streamStringOutIO f getChunk = go handle = do chunk <- getChunk case chunk of - Nothing -> pure () + Nothing -> pass Just c -> do IO.liftIO $ Bytes.hPut handle c go handle diff --git a/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs b/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs index 88ea42e..621927c 100644 --- a/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs +++ b/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs @@ -1,11 +1,8 @@ -- | A streaming parser for the NAR format -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeFamilies #-} +{-# language GeneralizedNewtypeDeriving #-} +{-# language ScopedTypeVariables #-} +{-# language TypeFamilies #-} module System.Nix.Internal.Nar.Parser ( runParser @@ -15,14 +12,11 @@ module System.Nix.Internal.Nar.Parser ) where +import qualified Relude.Unsafe as Unsafe 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 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 @@ -30,19 +24,11 @@ import qualified Control.Monad.Reader as Reader import qualified Control.Monad.State as State import qualified Control.Monad.Trans as Trans import qualified Control.Monad.Trans.Control as Base -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 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 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 @@ -86,15 +72,15 @@ runParser -- ^ A parser to run, such as @parseNar@ -> IO.Handle -- ^ A handle the stream containg the NAR. It should already be - -- open and in @IO.ReadMode@ + -- open and in @ReadMode@ -> FilePath -- ^ 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 + runReaderT (runExceptT $ State.evalStateT action state0) effs `Exception.Lifted.catch` exceptionHandler - when (Either.isLeft unpackResult) cleanup + when (isLeft unpackResult) cleanup pure unpackResult where @@ -123,7 +109,7 @@ runParser effs (NarParser action) h target = do instance Trans.MonadTrans NarParser where - lift act = NarParser $ (Trans.lift . Trans.lift . Trans.lift) act + lift act = NarParser $ (lift . lift . lift) act data ParserState = ParserState @@ -177,7 +163,7 @@ parseSymlink = do (dir, file) <- currentDirectoryAndFile pushLink $ LinkInfo - { linkTarget = Text.unpack target + { linkTarget = toString target , linkFile = file , linkPWD = dir } @@ -185,7 +171,7 @@ parseSymlink = do currentDirectoryAndFile :: Monad m => NarParser m (FilePath, FilePath) currentDirectoryAndFile = do dirStack <- State.gets directoryStack - pure (List.foldr1 () (List.reverse $ drop 1 dirStack), head dirStack) + pure (List.foldr1 () (List.reverse $ drop 1 dirStack), Unsafe.head dirStack) -- | Internal data type representing symlinks encountered in the NAR @@ -220,7 +206,7 @@ parseFile = do -- Set up for defining `getChunk` narHandle <- State.gets handle - bytesLeftVar <- IO.liftIO $ IORef.newIORef fSize + bytesLeftVar <- IO.liftIO $ newIORef fSize let -- getChunk tracks the number of total bytes we still need to get from the @@ -228,13 +214,13 @@ parseFile = do -- chunk we read) getChunk :: m (Maybe ByteString) getChunk = do - bytesLeft <- IO.liftIO $ IORef.readIORef bytesLeftVar + bytesLeft <- IO.liftIO $ readIORef bytesLeftVar if bytesLeft == 0 then pure Nothing else do 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) + IO.liftIO $ 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 @@ -243,12 +229,12 @@ parseFile = do pure $ Just chunk target <- currentFile - streamFile <- Reader.asks Nar.narStreamFile - Trans.lift (streamFile target getChunk) + streamFile <- asks Nar.narStreamFile + lift (streamFile target getChunk) when (s == "executable") $ do - effs :: Nar.NarEffects m <- Reader.ask - Trans.lift $ do + effs :: Nar.NarEffects m <- ask + lift $ do p <- Nar.narGetPerms effs target Nar.narSetPerms effs target (p { Directory.executable = True }) @@ -259,9 +245,9 @@ parseFile = do -- handles for target files longer than needed parseDirectory :: (IO.MonadIO m, Fail.MonadFail m) => NarParser m () parseDirectory = do - createDirectory <- Reader.asks Nar.narCreateDir + createDirectory <- asks Nar.narCreateDir target <- currentFile - Trans.lift $ createDirectory target + lift $ createDirectory target parseEntryOrFinish where @@ -282,7 +268,7 @@ parseDirectory = do parens $ do expectStr "name" fName <- parseStr - pushFileName (Text.unpack fName) + pushFileName (toString fName) expectStr "node" parens parseFSO popFileName @@ -307,7 +293,7 @@ parseStr = do strBytes <- consume $ fromIntegral len expectRawString (Bytes.replicate (fromIntegral $ padLen $ fromIntegral len) 0) - pure $ Text.decodeUtf8 strBytes + pure $ decodeUtf8 strBytes -- | Get an Int64 describing the length of the upcoming string, @@ -386,13 +372,13 @@ parens act = do -- (Targets must be created before the links that target them) createLinks :: IO.MonadIO m => NarParser m () createLinks = do - createLink <- Reader.asks Nar.narCreateLink + createLink <- asks Nar.narCreateLink allLinks <- State.gets links sortedLinks <- IO.liftIO $ sortLinksIO allLinks forM_ sortedLinks $ \li -> do pwd <- IO.liftIO Directory.getCurrentDirectory IO.liftIO $ Directory.setCurrentDirectory (linkPWD li) - Trans.lift $ createLink (linkTarget li) (linkFile li) + lift $ createLink (linkTarget li) (linkFile li) IO.liftIO $ Directory.setCurrentDirectory pwd where @@ -447,7 +433,7 @@ consume n = do popStr :: Monad m => NarParser m (Maybe Text) popStr = do s <- State.get - case List.uncons (tokenStack s) of + case uncons (tokenStack s) of Nothing -> pure Nothing Just (x, xs) -> do State.put $ s { tokenStack = xs } @@ -492,14 +478,14 @@ pushLink linkInfo = State.modify (\s -> s { links = linkInfo : links s }) testParser :: (m ~ IO) => NarParser m a -> ByteString -> m (Either String a) testParser p b = do Bytes.writeFile tmpFileName b - IO.withFile tmpFileName IO.ReadMode $ \h -> + withFile tmpFileName 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" + withFile fp ReadMode $ \h -> runParser Nar.narEffectsIO parseNar h "tmp" diff --git a/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs b/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs index 00fb696..3cf21c9 100644 --- a/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs +++ b/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs @@ -1,7 +1,6 @@ -- | Stream out a NAR file from a regular file -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# language ScopedTypeVariables #-} module System.Nix.Internal.Nar.Streamer ( streamNarIO @@ -9,18 +8,11 @@ module System.Nix.Internal.Nar.Streamer ) where -import Control.Monad ( forM_ - , when - ) import qualified Control.Monad.IO.Class as IO -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 qualified System.Directory as Directory import System.FilePath ( () ) @@ -66,7 +58,7 @@ streamNarIO yield effs basePath = do when isDir $ do fs <- IO.liftIO (Nar.narListDir effs path) yield $ strs ["type", "directory"] - forM_ (List.sort fs) $ \f -> do + forM_ (sort fs) $ \f -> do yield $ str "entry" parens $ do let fullName = path f diff --git a/hnix-store-core/src/System/Nix/Internal/Signature.hs b/hnix-store-core/src/System/Nix/Internal/Signature.hs index 952f45d..75d7ad6 100644 --- a/hnix-store-core/src/System/Nix/Internal/Signature.hs +++ b/hnix-store-core/src/System/Nix/Internal/Signature.hs @@ -1,8 +1,7 @@ {-| Description : Nix-relevant interfaces to NaCl signatures. -} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE CPP #-} +{-# language CPP #-} module System.Nix.Internal.Signature ( Signature @@ -11,9 +10,7 @@ module System.Nix.Internal.Signature where -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(..) ) diff --git a/hnix-store-core/src/System/Nix/Internal/StorePath.hs b/hnix-store-core/src/System/Nix/Internal/StorePath.hs index e232d1a..8ae1bb8 100644 --- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs +++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs @@ -1,14 +1,12 @@ {-| Description : Representation of Nix store paths. -} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DataKinds #-} +{-# language ConstraintKinds #-} +{-# language RecordWildCards #-} +{-# language GeneralizedNewtypeDeriving #-} +{-# language ScopedTypeVariables #-} +{-# language AllowAmbiguousTypes #-} +{-# language DataKinds #-} module System.Nix.Internal.StorePath ( -- * Basic store path types @@ -32,25 +30,21 @@ module System.Nix.Internal.StorePath , pathParser ) where + +import qualified Relude.Unsafe as Unsafe +import qualified Text.Show import System.Nix.Internal.Hash import System.Nix.Internal.Base import qualified System.Nix.Internal.Base32 as Nix.Base32 -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 ) -import Data.Coerce ( coerce ) import Crypto.Hash ( SHA256 , Digest ) @@ -173,8 +167,8 @@ storePathToRawFilePath StorePath{..} = root <> "/" <> hashPart <> "-" <> name where root = Bytes.Char8.pack storePathRoot - hashPart = Text.encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash - name = Text.encodeUtf8 $ unStorePathName storePathName + hashPart = encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash + name = encodeUtf8 $ unStorePathName storePathName -- | Render a 'StorePath' as a 'FilePath'. storePathToFilePath :: StorePath -> FilePath @@ -182,13 +176,13 @@ storePathToFilePath = Bytes.Char8.unpack . storePathToRawFilePath -- | Render a 'StorePath' as a 'Text'. storePathToText :: StorePath -> Text -storePathToText = Text.pack . Bytes.Char8.unpack . storePathToRawFilePath +storePathToText = toText . Bytes.Char8.unpack . storePathToRawFilePath -- | Build `narinfo` suffix from `StorePath` which -- can be used to query binary caches. storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString storePathToNarInfo StorePath{..} = - Text.encodeUtf8 $ encodeWith NixBase32 (coerce storePathHash) <> ".narinfo" + encodeUtf8 $ encodeWith NixBase32 (coerce storePathHash) <> ".narinfo" -- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking -- that store directory matches `expectedRoot`. @@ -196,15 +190,15 @@ parsePath :: FilePath -> Bytes.Char8.ByteString -> Either String StorePath parsePath expectedRoot x = let (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x - (storeBasedHashPart, namePart) = Text.breakOn "-" $ Text.pack fname + (storeBasedHashPart, namePart) = Text.breakOn "-" $ toText fname storeHash = decodeWith NixBase32 storeBasedHashPart name = makeStorePathName . Text.drop 1 $ namePart --rootDir' = dropTrailingPathSeparator rootDir -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b - rootDir' = init rootDir + rootDir' = Unsafe.init rootDir storeDir = if expectedRoot == rootDir' - then Right rootDir' + then pure rootDir' else Left $ "Root store dir mismatch, expected" <> expectedRoot <> "got" <> rootDir' in StorePath <$> coerce storeHash <*> name <*> storeDir @@ -212,7 +206,7 @@ parsePath expectedRoot x = pathParser :: FilePath -> Parser StorePath pathParser expectedRoot = do _ <- - Parser.Text.Lazy.string (Text.pack expectedRoot) + Parser.Text.Lazy.string (toText expectedRoot) "Store root mismatch" -- e.g. /nix/store _ <- Parser.Text.Lazy.char '/' diff --git a/hnix-store-core/src/System/Nix/Internal/Truncation.hs b/hnix-store-core/src/System/Nix/Internal/Truncation.hs index a143f7e..14d25de 100644 --- a/hnix-store-core/src/System/Nix/Internal/Truncation.hs +++ b/hnix-store-core/src/System/Nix/Internal/Truncation.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE DataKinds #-} +{-# language ScopedTypeVariables #-} +{-# language DataKinds #-} module System.Nix.Internal.Truncation ( truncateInNixWay @@ -8,10 +7,6 @@ module System.Nix.Internal.Truncation where import qualified Data.ByteString as Bytes -import Data.Bits (xor) -import Data.List (foldl') -import Data.Word (Word8) -import Data.Bool (bool) -- | Bytewise truncation of a 'Digest'. -- diff --git a/hnix-store-core/src/System/Nix/Nar.hs b/hnix-store-core/src/System/Nix/Nar.hs index c1b1f96..8ea95bf 100644 --- a/hnix-store-core/src/System/Nix/Nar.hs +++ b/hnix-store-core/src/System/Nix/Nar.hs @@ -3,10 +3,8 @@ Description : Generating and consuming NAR files Maintainer : Shea Levy -} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} +{-# language ScopedTypeVariables #-} +{-# language TypeFamilies #-} module System.Nix.Nar @@ -46,7 +44,7 @@ import qualified System.Nix.Internal.Nar.Streamer as Nar -- | Pack the filesystem object at @FilePath@ into a NAR and stream it into the -- @IO.Handle@ --- The handle should aleady be open and in @IO.WriteMode@. +-- The handle should aleady be open and in @WriteMode@. buildNarIO :: Nar.NarEffects IO -> FilePath diff --git a/hnix-store-core/src/System/Nix/ReadonlyStore.hs b/hnix-store-core/src/System/Nix/ReadonlyStore.hs index 44d18d0..491bf3a 100644 --- a/hnix-store-core/src/System/Nix/ReadonlyStore.hs +++ b/hnix-store-core/src/System/Nix/ReadonlyStore.hs @@ -1,22 +1,14 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# language DataKinds #-} +{-# language ScopedTypeVariables #-} module System.Nix.ReadonlyStore where -import Data.ByteString ( ByteString ) import qualified Data.ByteString as BS -import Data.List ( sort ) -import qualified Data.Text as T import qualified Data.HashSet as HS -import Data.Text.Encoding import System.Nix.Hash import System.Nix.Nar import System.Nix.StorePath -import Control.Monad.State.Strict -import Data.Coerce ( coerce ) import Crypto.Hash ( Context , Digest , hash @@ -45,7 +37,7 @@ makeStorePath fp ty h nm = StorePath (coerce storeHash) nm fp ty:fmap encodeUtf8 [ algoName @h , encodeDigestWith Base16 h - , T.pack fp + , toText fp , coerce nm ] diff --git a/hnix-store-core/src/System/Nix/StorePathMetadata.hs b/hnix-store-core/src/System/Nix/StorePathMetadata.hs index 9f4a283..49b3bd8 100644 --- a/hnix-store-core/src/System/Nix/StorePathMetadata.hs +++ b/hnix-store-core/src/System/Nix/StorePathMetadata.hs @@ -8,9 +8,7 @@ import System.Nix.StorePath ( StorePath , 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' diff --git a/hnix-store-core/tests/Arbitrary.hs b/hnix-store-core/tests/Arbitrary.hs index 667c9a5..f615fbb 100644 --- a/hnix-store-core/tests/Arbitrary.hs +++ b/hnix-store-core/tests/Arbitrary.hs @@ -1,19 +1,13 @@ -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DataKinds #-} +{-# language DataKinds #-} {-# OPTIONS_GHC -Wno-orphans #-} module Arbitrary where -import Control.Monad ( replicateM ) import qualified Data.ByteString.Char8 as BSC -import qualified Data.Text as T import Test.Tasty.QuickCheck import System.Nix.Internal.StorePath -import Control.Applicative ( liftA3 ) -import Data.Coerce ( coerce ) import Crypto.Hash ( SHA256 , Digest , hash @@ -29,7 +23,7 @@ dir :: Gen String dir = ('/':) <$> listOf1 (elements $ '/':['a'..'z']) instance Arbitrary StorePathName where - arbitrary = StorePathName . T.pack <$> ((:) <$> s1 <*> listOf sn) + arbitrary = StorePathName . toText <$> ((:) <$> s1 <*> listOf sn) where alphanum = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'] s1 = elements $ alphanum <> "+-_?=" @@ -47,11 +41,10 @@ newtype NixLike = NixLike {getNixLike :: StorePath} instance Arbitrary NixLike where arbitrary = NixLike <$> - (liftA3 StorePath + liftA3 StorePath arbitraryTruncatedDigest arbitrary (pure "/nix/store") - ) where -- 160-bit hash, 20 bytes, 32 chars in base32 arbitraryTruncatedDigest = coerce . BSC.pack <$> replicateM 20 genSafeChar diff --git a/hnix-store-core/tests/Derivation.hs b/hnix-store-core/tests/Derivation.hs index b614128..b3cc225 100644 --- a/hnix-store-core/tests/Derivation.hs +++ b/hnix-store-core/tests/Derivation.hs @@ -12,7 +12,6 @@ import System.Nix.Derivation ( parseDerivation import qualified Data.Attoparsec.Text import qualified Data.Text.IO -import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Builder processDerivation :: FilePath -> FilePath -> IO () @@ -22,7 +21,7 @@ processDerivation source dest = do fail -- It seems to be derivation. (Data.Text.IO.writeFile dest - . Data.Text.Lazy.toStrict + . toText . Data.Text.Lazy.Builder.toLazyText . buildDerivation ) diff --git a/hnix-store-core/tests/Hash.hs b/hnix-store-core/tests/Hash.hs index e348f20..690f3d5 100644 --- a/hnix-store-core/tests/Hash.hs +++ b/hnix-store-core/tests/Hash.hs @@ -1,18 +1,12 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE CPP #-} +{-# language DataKinds #-} +{-# language ScopedTypeVariables #-} +{-# language CPP #-} module Hash where -import Control.Monad ( forM_ ) -import Data.ByteString ( ByteString ) -import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Base16 as B16 import qualified System.Nix.Base32 as B32 import qualified Data.ByteString.Base64.Lazy as B64 -import qualified Data.ByteString.Lazy as BSL import Test.Hspec import Test.Tasty.QuickCheck @@ -21,11 +15,11 @@ import System.Nix.Hash import System.Nix.StorePath import Arbitrary import System.Nix.Internal.Base -import Data.Coerce ( coerce ) import Crypto.Hash ( MD5 , SHA1 , SHA256 , hash + , Digest ) spec_hash :: Spec @@ -33,29 +27,28 @@ spec_hash = do describe "hashing parity with nix-store" $ do - it "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" $ - shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA256 "nix-output:foo")) - "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5" - it "produces (base16 . md5) of \"Hello World\" the same as the thesis" $ - shouldBe (encodeDigestWith Base16 (hash @ByteString @MD5 "Hello World")) - "b10a8db164e0754105b7a99be72e3fe5" - it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $ - shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA1 "Hello World")) - "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" + cmp "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" + NixBase32 (hash @ByteString @SHA256) "nix-output:foo" "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5" + cmp "produces (base16 . md5) of \"Hello World\" the same as the thesis" + Base16 (hash @ByteString @MD5) "Hello World" "b10a8db164e0754105b7a99be72e3fe5" + cmp "produces (base32 . sha1) of \"Hello World\" the same as the thesis" + NixBase32 (hash @ByteString @SHA1) "Hello World" "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a" -- The example in question: -- https://nixos.org/nixos/nix-pills/nix-store-paths.html it "produces same base32 as nix pill flat file example" $ do - let exampleStr = - "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3" - <> "c0d7b98883f9ee3:/nix/store:myfile" - shouldBe (encodeWith NixBase32 $ coerce $ mkStorePathHashPart exampleStr) + shouldBe (encodeWith NixBase32 $ coerce $ mkStorePathHashPart "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3c0d7b98883f9ee3:/nix/store:myfile") "xv2iccirbrvklck36f1g7vldn5v58vck" + where + cmp :: String -> BaseEncoding -> (ByteString -> Digest a) -> ByteString -> Text -> SpecWith () + cmp t b f s h = + it t $ + shouldBe (encodeDigestWith b $ f s) h -- | Test that Nix-like base32 encoding roundtrips prop_nixBase32Roundtrip :: Property prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $ - \x -> pure (BSC.pack x) === (B32.decode . B32.encode . BSC.pack $ x) + \x -> pure (encodeUtf8 x) === (B32.decode . B32.encode . encodeUtf8 $ x) -- | API variants prop_nixBase16Roundtrip :: StorePathHashPart -> Property @@ -68,48 +61,68 @@ spec_nixhash = do describe "hashing parity with nix-nash" $ do - let - samples = [ - ( "800d59cfcd3c05e900cb4e214be48f6b886a08df" - , "vw46m23bizj4n8afrc0fj19wrp7mj3c0" - , "gA1Zz808BekAy04hS+SPa4hqCN8=" - ) - , ( "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" - , "1b8m03r63zqhnjf7l5wnldhh7c134ap5vpj0850ymkq1iyzicy5s" - , "ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0=" - ) - , ( "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445" - , "12k9jiq29iyqm03swfsgiw5mlqs173qazm3n7daz43infy12pyrcdf30fkk3qwv4yl2ick8yipc2mqnlh48xsvvxl60lbx8vp38yji0" - , "IEqPxt2oLwoM7XvrjgikFlfBbvRosiioJ5vjMacDwzWW/RXBOxsH+aodO+pXeJygMa2Fx6cd1wNU7GMSOMo0RQ==" - ) - ] + cmp + "b16 encoded . b32 decoded should equal original b16" + B16.encode B32.decode b32s b16s - it "b16 encoded . b32 decoded should equal original b16" $ - forM_ samples $ \(b16, b32, _b64) -> shouldBe (B16.encode <$> B32.decode b32) (Right b16) + cmp + "b64 encoded . b32 decoded should equal original b64" + (B64.encode . fromStrict) B32.decode b32s b64s - it "b64 encoded . b32 decoded should equal original b64" $ - forM_ samples $ \(_b16, b32, b64) -> shouldBe (B64.encode . BSL.fromStrict <$> B32.decode b32) (Right b64) + cmp + "b32 encoded . b64 decoded should equal original b32" + (B32.encode . toStrict) B64.decode b64s b32s - it "b32 encoded . b64 decoded should equal original b32" $ - forM_ samples $ \(_b16, b32, b64) -> shouldBe (B32.encode . BSL.toStrict <$> B64.decode b64 ) (Right b32) + cmp + "b16 encoded . b64 decoded should equal original b16" + (B16.encode . toStrict) B64.decode b64s b16s - it "b16 encoded . b64 decoded should equal original b16" $ - forM_ samples $ \(b16, _b32, b64) -> shouldBe (B16.encode . BSL.toStrict <$> B64.decode b64 ) (Right b16) - - it "b32 encoded . b16 decoded should equal original b32" $ - forM_ samples $ \(b16, b32, _b64) -> shouldBe (B32.encode #if MIN_VERSION_base16_bytestring(1,0,0) - <$> B16.decode b16) (Right b32) -#else - $ fst $ B16.decode b16) (b32) + cmp + "b32 encoded . b16 decoded should equal original b32" + B32.encode B16.decode b16s b32s -#endif + cmp + "b64 encoded . b16 decoded should equal original b64" + (B64.encode . fromStrict) B16.decode b16s b64s +#else + it "b32 encoded . b16 decoded should equal original b32" $ + traverse_ (\ b -> shouldBe (B32.encode $ fst $ B16.decode $ fst b) (snd b)) $ zip b16s b32s it "b64 encoded . b16 decoded should equal original b64" $ - forM_ samples $ \(b16, _b32, b64) -> shouldBe (B64.encode . BSL.fromStrict -#if MIN_VERSION_base16_bytestring(1,0,0) - <$> B16.decode b16) (Right b64) -#else - $ fst $ B16.decode b16 ) (b64) + traverse_ (\ b -> shouldBe (B64.encode . fromStrict $ fst $ B16.decode $ fst b) (snd b)) $ zip b16s b64s #endif + where + cmp + :: ( Eq b + , Show b + ) + => String + -> (a -> b) + -> (c -> Either String a) + -> [c] + -> [b] + -> SpecWith () + cmp s f1 f2 b1 b2 = it s $ traverse_ (uncurry shouldBe . bimap (fmap f1 . f2) pure) $ zip b1 b2 + + b16s = takeAxis (\(a,_,_) -> a) + b32s = takeAxis (\(_,b,_) -> b) + b64s = takeAxis (\(_,_,c) -> c) + + takeAxis f = fmap f samples + + samples = + [ ( "800d59cfcd3c05e900cb4e214be48f6b886a08df" + , "vw46m23bizj4n8afrc0fj19wrp7mj3c0" + , "gA1Zz808BekAy04hS+SPa4hqCN8=" + ) + , ( "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" + , "1b8m03r63zqhnjf7l5wnldhh7c134ap5vpj0850ymkq1iyzicy5s" + , "ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0=" + ) + , ( "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445" + , "12k9jiq29iyqm03swfsgiw5mlqs173qazm3n7daz43infy12pyrcdf30fkk3qwv4yl2ick8yipc2mqnlh48xsvvxl60lbx8vp38yji0" + , "IEqPxt2oLwoM7XvrjgikFlfBbvRosiioJ5vjMacDwzWW/RXBOxsH+aodO+pXeJygMa2Fx6cd1wNU7GMSOMo0RQ==" + ) + ] diff --git a/hnix-store-core/tests/NarFormat.hs b/hnix-store-core/tests/NarFormat.hs index 382e0b5..bd31a2c 100644 --- a/hnix-store-core/tests/NarFormat.hs +++ b/hnix-store-core/tests/NarFormat.hs @@ -1,16 +1,10 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} +{-# language CPP #-} +{-# language ScopedTypeVariables #-} module NarFormat where -import Control.Applicative (many, optional, (<|>)) import qualified Control.Concurrent as Concurrent -import Control.Exception (SomeException, try) -import Control.Monad (replicateM, void, - when) +import Control.Exception (try) import Data.Binary.Get (Get, getByteString, getInt64le, getLazyByteString, runGet) @@ -21,11 +15,8 @@ import qualified Data.ByteString.Base64.Lazy as B64 import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Char8 as BSLC -import Data.Int import qualified Data.Map as Map -import Data.Maybe (fromMaybe) import qualified Data.Text as T -import qualified Data.Text.Encoding as E import System.Directory ( doesDirectoryExist , doesPathExist , removeDirectoryRecursive @@ -43,7 +34,6 @@ import Test.Hspec import qualified Test.Tasty.HUnit as HU import Test.Tasty.QuickCheck import qualified Text.Printf as Printf -import Text.Read (readMaybe) import qualified System.Nix.Internal.Nar.Streamer as Nar import System.Nix.Nar @@ -55,7 +45,7 @@ withBytesAsHandle bytes act = do Temp.withSystemTempFile "nar-test-file-XXXXX" $ \tmpFile h -> do IO.hClose h BSL.writeFile tmpFile bytes - IO.withFile tmpFile IO.ReadMode act + withFile tmpFile ReadMode act spec_narEncoding :: Spec spec_narEncoding = do @@ -74,7 +64,7 @@ spec_narEncoding = do res <- withBytesAsHandle (runPut (putNar n)) $ \h -> do unpackNarIO narEffectsIO h packageFilePath - res `shouldBe` Right () + res `shouldBe` pass e' <- doesPathExist packageFilePath e' `shouldBe` True @@ -84,7 +74,7 @@ spec_narEncoding = do IO.hClose h BSL.readFile tmpFile - res' `shouldBe` (runPut $ putNar n) + res' `shouldBe` runPut (putNar n) -- For a Haskell embedded Nar, check that encoding it gives -- the same bytestring as `nix-store --dump` @@ -160,10 +150,10 @@ unit_packSelfSrcDir = Temp.withSystemTempDirectory "nar-test" $ \tmpDir -> do Right _ -> do let go dir = do srcHere <- doesDirectoryExist dir - case srcHere of - False -> pure () - True -> do - IO.withFile narFilePath IO.WriteMode $ \h -> + bool + pass + (do + withFile narFilePath WriteMode $ \h -> buildNarIO narEffectsIO "src" h hnixNar <- BSL.readFile narFilePath nixStoreNar <- getNixStoreDump "src" @@ -171,6 +161,8 @@ unit_packSelfSrcDir = Temp.withSystemTempDirectory "nar-test" $ \tmpDir -> do "src dir serializes the same between hnix-store and nix-store" hnixNar nixStoreNar + ) + srcHere go "src" go "hnix-store-core/src" -- ||||||| merged common ancestors @@ -182,7 +174,7 @@ unit_packSelfSrcDir = Temp.withSystemTempDirectory "nar-test" $ \tmpDir -> do -- nixStoreNar -- ======= -- let narFile = tmpDir "src.nar" --- IO.withFile narFile IO.WriteMode $ \h -> +-- withFile narFile WriteMode $ \h -> -- buildNarIO narEffectsIO "src" h -- hnixNar <- BSL.readFile narFile -- nixStoreNar <- getNixStoreDump "src" @@ -201,7 +193,7 @@ test_streamLargeFileToNar = HU.testCaseSteps "streamLargeFileToNar" $ \step -> d -- BSL.writeFile narFileName =<< buildNarIO narEffectsIO bigFileName -- step "create nar file" - IO.withFile narFileName IO.WriteMode $ \h -> + withFile narFileName WriteMode $ \h -> buildNarIO narEffectsIO bigFileName h step "assert bounded memory" @@ -230,32 +222,32 @@ test_streamManyFilesToNar = HU.testCaseSteps "streamManyFilesToNar" $ \step -> _run = do filesPrecount <- countProcessFiles - IO.withFile "hnar" IO.WriteMode $ \h -> + withFile "hnar" WriteMode $ \h -> buildNarIO narEffectsIO narFilePath h filesPostcount <- countProcessFiles pure $ (-) <$> filesPostcount <*> filesPrecount step "create test files" Directory.createDirectory packagePath - flip mapM_ [0..1000] $ \i -> do + forM_ [0..1000] $ \i -> do BSL.writeFile (Printf.printf (packagePath "%08d") (i :: Int)) "hi\n" Concurrent.threadDelay 50 filesPrecount <- countProcessFiles step "pack nar" - IO.withFile narFilePath IO.WriteMode $ \h -> + withFile narFilePath WriteMode $ \h -> buildNarIO narEffectsIO packagePath h step "unpack nar" - r <- IO.withFile narFilePath IO.ReadMode $ \h -> + r <- withFile narFilePath ReadMode $ \h -> unpackNarIO narEffectsIO h packagePath' - r `shouldBe` Right () + r `shouldBe` pass step "check constant file usage" filesPostcount <- countProcessFiles - case ((-) <$> filesPostcount <*> filesPrecount) of - Nothing -> pure () + case (-) <$> filesPostcount <*> filesPrecount of + Nothing -> pass Just c -> c `shouldSatisfy` (< 50) -- step "check file exists" @@ -303,7 +295,7 @@ filesystemNixStore testErrorName n = do assertExists nixNarFile -- hnix converts those files to nar - IO.withFile hnixNarFile IO.WriteMode $ \h -> + withFile hnixNarFile WriteMode $ \h -> buildNarIO narEffectsIO testFile h assertExists hnixNarFile @@ -320,7 +312,7 @@ assertBoundedMemory = do bytes <- max_live_bytes <$> getRTSStats bytes < 100 * 1000 * 1000 `shouldBe` True #else - pure () + pass #endif @@ -353,16 +345,16 @@ packThenExtract testName setup = step $ "Build NAR from " <> narFilePath <> " to " <> hnixNarFile -- narBS <- buildNarIO narEffectsIO narFile - IO.withFile hnixNarFile IO.WriteMode $ \h -> + withFile hnixNarFile WriteMode $ \h -> buildNarIO narEffectsIO narFilePath h -- BSL.writeFile hnixNarFile narBS step $ "Unpack NAR to " <> outputFile - _narHandle <- IO.withFile nixNarFile IO.ReadMode $ \h -> + _narHandle <- withFile nixNarFile ReadMode $ \h -> unpackNarIO narEffectsIO h outputFile - pure () + pass -- | Count file descriptors owned by the current process countProcessFiles :: IO (Maybe Int) @@ -373,7 +365,7 @@ countProcessFiles = do then pure Nothing else do let fdDir = "/proc/" <> show pid <> "/fd" - fds <- P.readProcess "ls" [fdDir] "" + fds <- toText <$> P.readProcess "ls" [fdDir] "" pure $ pure $ length $ words fds @@ -538,8 +530,8 @@ getBigFileSize = fromMaybe 5000000 . readMaybe <$> (getEnv "HNIX_BIG_FILE_SIZE" -- | Add a link to a FileSystemObject. This is useful -- when creating Arbitrary FileSystemObjects. It -- isn't implemented yet -mkLink :: - FilePath -- ^ Target +mkLink + :: FilePath -- ^ Target -> FilePath -- ^ Link -> FileSystemObject -- ^ FileSystemObject to add link to -> FileSystemObject @@ -554,11 +546,9 @@ mkBigFile path = do -- | Construct FilePathPart from Text by checking that there -- are no '/' or '\\NUL' characters filePathPart :: BSC.ByteString -> Maybe FilePathPart -filePathPart p = case BSC.any (`elem` ['/', '\NUL']) p of - False -> Just $ FilePathPart p - True -> Nothing +filePathPart p = if BSC.any (`elem` ['/', '\NUL']) p then Nothing else Just $ FilePathPart p -data Nar = Nar { narFile :: FileSystemObject } +newtype Nar = Nar { narFile :: FileSystemObject } deriving (Eq, Show) -- | A FileSystemObject (FSO) is an anonymous entity that can be NAR archived @@ -623,11 +613,11 @@ putNar (Nar file) = header <> parens (putFile file) strs ["type", "regular"] >> (if isExec == Nar.Executable then strs ["executable", ""] - else pure ()) + else pass) >> putContents fSize contents putFile (SymLink target) = - strs ["type", "symlink", "target", BSL.fromStrict $ E.encodeUtf8 target] + strs ["type", "symlink", "target", fromStrict $ encodeUtf8 target] -- toList sorts the entries by FilePathPart before serializing putFile (Directory entries) = @@ -638,7 +628,7 @@ putNar (Nar file) = header <> parens (putFile file) str "entry" parens $ do str "name" - str (BSL.fromStrict name) + str (fromStrict name) str "node" parens (putFile fso) @@ -650,7 +640,7 @@ putNar (Nar file) = header <> parens (putFile file) in int len <> pad len t putContents :: Int64 -> BSL.ByteString -> Put - putContents fSize bs = str "contents" <> int fSize <> (pad fSize bs) + putContents fSize bs = str "contents" <> int fSize <> pad fSize bs int :: Integral a => a -> Put int n = putInt64le $ fromIntegral n @@ -698,18 +688,18 @@ getNar = fmap Nar $ header >> parens getFile assertStr_ "type" assertStr_ "symlink" assertStr_ "target" - fmap (SymLink . E.decodeUtf8 . BSL.toStrict) str + fmap (SymLink . decodeUtf8) str getEntry = do assertStr_ "entry" parens $ do assertStr_ "name" - name <- E.decodeUtf8 . BSL.toStrict <$> str + name <- str assertStr_ "node" file <- parens getFile maybe (fail $ "Bad FilePathPart: " <> show name) (pure . (,file)) - (filePathPart $ E.encodeUtf8 name) + (filePathPart $ toStrict name) -- Fetch a length-prefixed, null-padded string str = fmap snd sizedStr diff --git a/hnix-store-core/tests/StorePath.hs b/hnix-store-core/tests/StorePath.hs index f4d2e77..b26fd2c 100644 --- a/hnix-store-core/tests/StorePath.hs +++ b/hnix-store-core/tests/StorePath.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# language DataKinds #-} +{-# language ScopedTypeVariables #-} module StorePath where @@ -14,18 +12,18 @@ import Arbitrary -- | Test that Nix(OS) like paths roundtrip prop_storePathRoundtrip :: NixLike -> NixLike -> Property -prop_storePathRoundtrip (_ :: NixLike) = \(NixLike x) -> - (parsePath "/nix/store" $ storePathToRawFilePath x) === Right x +prop_storePathRoundtrip (_ :: NixLike) (NixLike x) = + parsePath "/nix/store" (storePathToRawFilePath x) === pure x -- | Test that any `StorePath` roundtrips prop_storePathRoundtrip' :: StorePath -> Property prop_storePathRoundtrip' x = - (parsePath (storePathRoot x) $ storePathToRawFilePath x) === Right x + parsePath (storePathRoot x) (storePathToRawFilePath x) === pure x prop_storePathRoundtripParser :: NixLike -> NixLike -> Property -prop_storePathRoundtripParser (_ :: NixLike) = \(NixLike x) -> - (Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) $ storePathToText x) === Right x +prop_storePathRoundtripParser (_ :: NixLike) (NixLike x) = + Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) (storePathToText x) === pure x prop_storePathRoundtripParser' :: StorePath -> Property prop_storePathRoundtripParser' x = - (Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) $ storePathToText x) === Right x + Data.Attoparsec.Text.parseOnly (pathParser $ storePathRoot x) (storePathToText x) === pure x diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index 4652eb1..adf7beb 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -39,7 +39,8 @@ library , System.Nix.Store.Remote.Util build-depends: - base >=4.10 && <5 + base >=4.12 && <5 + , relude , attoparsec , binary , bytestring @@ -52,6 +53,29 @@ library , mtl , unordered-containers , hnix-store-core >= 0.5 && <0.6 + mixins: + base hiding (Prelude) + , relude (Relude as Prelude) + , relude + default-extensions: + OverloadedStrings + , DeriveGeneric + , DeriveDataTypeable + , DeriveFunctor + , DeriveFoldable + , DeriveTraversable + , DeriveLift + , FlexibleContexts + , FlexibleInstances + , StandaloneDeriving + , TypeApplications + , TypeSynonymInstances + , InstanceSigs + , MultiParamTypeClasses + , TupleSections + , LambdaCase + , BangPatterns + , ViewPatterns hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall @@ -75,6 +99,7 @@ test-suite hnix-store-remote-tests tasty-discover:tasty-discover build-depends: base + , relude , hnix-store-core >= 0.3 , hnix-store-remote , containers @@ -95,4 +120,27 @@ test-suite hnix-store-remote-tests , unix , unordered-containers , vector + mixins: + base hiding (Prelude) + , relude (Relude as Prelude) + , relude + default-extensions: + OverloadedStrings + , DeriveGeneric + , DeriveDataTypeable + , DeriveFunctor + , DeriveFoldable + , DeriveTraversable + , DeriveLift + , FlexibleContexts + , FlexibleInstances + , StandaloneDeriving + , TypeApplications + , TypeSynonymInstances + , InstanceSigs + , MultiParamTypeClasses + , TupleSections + , LambdaCase + , BangPatterns + , ViewPatterns default-language: Haskell2010 diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index 1502d96..68b6cc2 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -1,11 +1,9 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE RecordWildCards #-} +{-# language AllowAmbiguousTypes #-} +{-# language KindSignatures #-} +{-# language RankNTypes #-} +{-# language ScopedTypeVariables #-} +{-# language DataKinds #-} +{-# language RecordWildCards #-} module System.Nix.Store.Remote ( addToStore , addTextToStore @@ -35,19 +33,14 @@ module System.Nix.Store.Remote ) where -import Control.Monad ( void - , unless - , when - ) -import Data.ByteString.Lazy ( ByteString ) -import Data.Map.Strict ( Map ) -import Data.Text ( Text ) +import Prelude hiding ( putText ) +import qualified Data.ByteString.Lazy as BSL import Nix.Derivation ( Derivation ) import System.Nix.Build ( BuildMode , BuildResult ) -import System.Nix.Hash ( NamedAlgo +import System.Nix.Hash ( NamedAlgo(..) , SomeNamedDigest(..) , BaseEncoding(NixBase32) , decodeDigestWith @@ -63,13 +56,10 @@ import System.Nix.StorePathMetadata ( StorePathMetadata(..) import System.Nix.Internal.Base ( encodeWith ) import qualified Data.Binary.Put -import qualified Data.ByteString.Lazy import qualified Data.Map.Strict import qualified Data.Set -import qualified Data.Text.Encoding import qualified System.Nix.Nar -import qualified System.Nix.Hash import qualified System.Nix.StorePath import qualified System.Nix.Store.Remote.Parsers @@ -78,7 +68,6 @@ import System.Nix.Store.Remote.Types import System.Nix.Store.Remote.Protocol import System.Nix.Store.Remote.Util import Crypto.Hash ( SHA256 ) -import Data.Coerce ( coerce ) type RepairFlag = Bool type CheckFlag = Bool @@ -97,7 +86,7 @@ addToStore addToStore name pth recursive _pathFilter _repair = do runOpArgsIO AddToStore $ \yield -> do - yield $ Data.ByteString.Lazy.toStrict $ Data.Binary.Put.runPut $ do + yield $ toStrict $ Data.Binary.Put.runPut $ do putText $ System.Nix.StorePath.unStorePathName name putBool $ not $ System.Nix.Hash.algoName @a == "sha256" && recursive @@ -129,7 +118,7 @@ addTextToStore name text references' repair = do putPaths references' sockGetPath -addSignatures :: StorePath -> [ByteString] -> MonadStore () +addSignatures :: StorePath -> [BSL.ByteString] -> MonadStore () addSignatures p signatures = do void $ simpleOpArgs AddSignatures $ do putPath p @@ -171,15 +160,14 @@ buildDerivation p drv buildMode = do -- Intentionally the only warning that should pop-up. putInt (0 :: Integer) - res <- getSocketIncremental getBuildResult - pure res + getSocketIncremental getBuildResult ensurePath :: StorePath -> MonadStore () ensurePath pn = do void $ simpleOpArgs EnsurePath $ putPath pn -- | Find garbage collector roots. -findRoots :: MonadStore (Map ByteString StorePath) +findRoots :: MonadStore (Map BSL.ByteString StorePath) findRoots = do runOp FindRoots sd <- getStoreDir @@ -187,7 +175,7 @@ findRoots = do getSocketIncremental $ getMany $ (,) - <$> (Data.ByteString.Lazy.fromStrict <$> getByteStringLen) + <$> (fromStrict <$> getByteStringLen) <*> getPath sd r <- catRights res @@ -198,7 +186,7 @@ findRoots = do ex :: (a, Either [Char] b) -> MonadStore (a, b) ex (x , Right y) = pure (x, y) - ex (_x, Left e ) = error $ "Unable to decode root: " <> e + ex (_x, Left e ) = error $ "Unable to decode root: " <> fromString e isValidPathUncached :: StorePath -> MonadStore Bool isValidPathUncached p = do @@ -235,13 +223,13 @@ queryPathInfoUncached path = do deriverPath <- sockGetPathMay - narHashText <- Data.Text.Encoding.decodeUtf8 <$> sockGetStr + narHashText <- decodeUtf8 <$> sockGetStr let narHash = case decodeDigestWith @SHA256 NixBase32 narHashText of - Left e -> error e + Left e -> error $ fromString e Right x -> SomeDigest x references <- sockGetPaths @@ -260,7 +248,7 @@ queryPathInfoUncached path = do case System.Nix.Store.Remote.Parsers.parseContentAddressableAddress caString of - Left e -> error e + Left e -> error $ fromString e Right x -> Just x trust = if ultimate then BuiltLocally else BuiltElsewhere @@ -291,9 +279,7 @@ queryPathFromHashPart :: StorePathHashPart -> MonadStore StorePath queryPathFromHashPart storePathHash = do runOpArgs QueryPathFromHashPart $ putByteStringLen - $ Data.ByteString.Lazy.fromStrict - $ Data.Text.Encoding.encodeUtf8 - $ encodeWith NixBase32 $ coerce storePathHash + $ encodeUtf8 (encodeWith NixBase32 $ coerce storePathHash) sockGetPath queryMissing diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs index 3d56b2d..b084216 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs @@ -4,10 +4,8 @@ Maintainer : srk |-} module System.Nix.Store.Remote.Binary where -import Control.Monad import Data.Binary.Get import Data.Binary.Put -import Data.ByteString ( ByteString ) import qualified Data.ByteString.Lazy as BSL putInt :: Integral a => a -> Put @@ -35,7 +33,7 @@ putByteStringLen x = do where len :: Int len = fromIntegral $ BSL.length x - pad count = sequence_ $ replicate count (putWord8 0) + pad count = replicateM_ count (putWord8 0) putByteStrings :: Foldable t => t BSL.ByteString -> Put putByteStrings = putMany putByteStringLen @@ -47,8 +45,8 @@ getByteStringLen = do when (len `mod` 8 /= 0) $ do pads <- unpad $ fromIntegral $ 8 - (len `mod` 8) unless (all (== 0) pads) $ fail $ "No zeroes" <> show (st, len, pads) - pure $ BSL.toStrict st - where unpad x = sequence $ replicate x getWord8 + pure $ toStrict st + where unpad x = replicateM x getWord8 getByteStrings :: Get [ByteString] getByteStrings = getMany getByteStringLen diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs index 92f99f8..1ee5dfe 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs @@ -1,38 +1,36 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeApplications #-} +{-# language AllowAmbiguousTypes #-} +{-# language ScopedTypeVariables #-} +{-# language RankNTypes #-} module System.Nix.Store.Remote.Builders ( buildContentAddressableAddress ) where -import Data.Text.Lazy ( Text ) +import qualified Data.Text.Lazy as TL import Crypto.Hash ( Digest ) import System.Nix.StorePath ( ContentAddressableAddress(..) ) import Data.Text.Lazy.Builder ( Builder ) -import qualified Data.Text.Lazy.Builder +import qualified Data.Text.Lazy.Builder as TL import System.Nix.Hash -- | Marshall `ContentAddressableAddress` to `Text` -- in form suitable for remote protocol usage. -buildContentAddressableAddress :: ContentAddressableAddress -> Text +buildContentAddressableAddress :: ContentAddressableAddress -> TL.Text buildContentAddressableAddress = - Data.Text.Lazy.Builder.toLazyText . contentAddressableAddressBuilder + TL.toLazyText . contentAddressableAddressBuilder contentAddressableAddressBuilder :: ContentAddressableAddress -> Builder contentAddressableAddressBuilder (Text digest) = "text:" <> digestBuilder digest contentAddressableAddressBuilder (Fixed _narHashMode (SomeDigest (digest :: Digest hashAlgo))) = "fixed:" - <> (Data.Text.Lazy.Builder.fromText $ System.Nix.Hash.algoName @hashAlgo) + <> TL.fromText (System.Nix.Hash.algoName @hashAlgo) <> digestBuilder digest digestBuilder :: Digest a -> Builder digestBuilder = - Data.Text.Lazy.Builder.fromText . encodeDigestWith NixBase32 + TL.fromText . encodeDigestWith NixBase32 diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs index 7f6064b..cc4768b 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RankNTypes #-} +{-# language RankNTypes #-} module System.Nix.Store.Remote.Logger ( Logger(..) @@ -8,9 +8,8 @@ module System.Nix.Store.Remote.Logger where -import Control.Monad.Except -import Control.Monad.Reader ( asks ) -import Control.Monad.State ( get ) +import Prelude hiding ( Last ) +import Control.Monad.Except ( throwError ) import Data.Binary.Get import Network.Socket.ByteString ( recv ) @@ -60,8 +59,7 @@ processOutput = go decoder sockPut $ putByteStringLen part clearData - next <- go decoder - pure next + go decoder -- we should probably handle Read here as well x -> do @@ -72,12 +70,12 @@ processOutput = go decoder chunk <- liftIO (Just <$> recv soc 8) go (k chunk) - go (Fail _leftover _consumed msg) = error msg + go (Fail _leftover _consumed msg) = error $ fromString msg getFields :: Get [Field] getFields = do cnt <- getInt - sequence $ replicate cnt getField + replicateM cnt getField getField :: Get Field getField = do diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs index a6b73dd..cb6b6ab 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Parsers.hs @@ -1,20 +1,14 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeApplications #-} +{-# language AllowAmbiguousTypes #-} +{-# language ScopedTypeVariables #-} +{-# language RankNTypes #-} +{-# language DataKinds #-} module System.Nix.Store.Remote.Parsers ( parseContentAddressableAddress ) where -import Control.Applicative ( (<|>) ) import Data.Attoparsec.ByteString.Char8 -import Data.ByteString.Char8 -import Data.Text ( Text ) -import Data.Text.Encoding ( decodeUtf8 ) import System.Nix.Hash import System.Nix.StorePath ( ContentAddressableAddress(..) , NarHashMode(..) @@ -42,7 +36,7 @@ caText = do caFixed :: Parser ContentAddressableAddress caFixed = do _ <- "fixed:" - narHashMode <- (pure Recursive <$> "r:") <|> (pure RegularFile <$> "") + narHashMode <- (Recursive <$ "r:") <|> (RegularFile <$ "") digest <- parseTypedDigest either fail pure $ Fixed narHashMode <$> digest diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs index 5f844df..d8ff6b3 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# language DataKinds #-} +{-# language ScopedTypeVariables #-} module System.Nix.Store.Remote.Protocol ( WorkerOp(..) , simpleOp @@ -13,18 +12,15 @@ module System.Nix.Store.Remote.Protocol ) where +import qualified Relude.Unsafe as Unsafe -import Data.Bool ( bool ) import Control.Exception ( bracket ) import Control.Monad.Except -import Control.Monad.Reader -import Control.Monad.State import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString import qualified Data.ByteString.Char8 -import qualified Data.ByteString.Lazy import Network.Socket ( SockAddr(SockAddrUnix) ) import qualified Network.Socket @@ -122,7 +118,7 @@ opNum QueryMissing = 40 simpleOp :: WorkerOp -> MonadStore Bool -simpleOp op = simpleOpArgs op $ pure () +simpleOp op = simpleOpArgs op pass simpleOpArgs :: WorkerOp -> Put -> MonadStore Bool simpleOpArgs op args = do @@ -131,19 +127,19 @@ simpleOpArgs op args = do bool sockGetBool (do - Error _num msg <- head <$> getError + Error _num msg <- Unsafe.head <$> getError throwError $ Data.ByteString.Char8.unpack msg ) err runOp :: WorkerOp -> MonadStore () -runOp op = runOpArgs op $ pure () +runOp op = runOpArgs op pass runOpArgs :: WorkerOp -> Put -> MonadStore () runOpArgs op args = runOpArgsIO op - (\encode -> encode $ Data.ByteString.Lazy.toStrict $ runPut args) + (\encode -> encode $ toStrict $ runPut args) runOpArgsIO :: WorkerOp @@ -160,7 +156,7 @@ runOpArgsIO op encoder = do modify (\(a, b) -> (a, b <> out)) err <- gotError when err $ do - Error _num msg <- head <$> getError + Error _num msg <- Unsafe.head <$> getError throwError $ Data.ByteString.Char8.unpack msg runStore :: MonadStore a -> IO (Either String a, [Logger]) @@ -190,7 +186,7 @@ runStoreOpts sockPath storeRootDir code = do vermagic <- liftIO $ recv soc 16 let (magic2, _daemonProtoVersion) = - flip runGet (Data.ByteString.Lazy.fromStrict vermagic) + flip runGet (fromStrict vermagic) $ (,) <$> (getInt :: Get Int) <*> (getInt :: Get Int) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs index 4688d9b..2311fd3 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# language DataKinds #-} +{-# language KindSignatures #-} +{-# language ScopedTypeVariables #-} module System.Nix.Store.Remote.Types ( MonadStore , StoreConfig(..) @@ -18,12 +17,8 @@ module System.Nix.Store.Remote.Types where -import Data.ByteString ( ByteString ) import qualified Data.ByteString.Lazy as BSL import Network.Socket ( Socket ) -import Control.Monad.Except -import Control.Monad.Reader -import Control.Monad.State data StoreConfig = StoreConfig { storeDir :: FilePath @@ -61,13 +56,13 @@ isError (Error _ _) = True isError _ = False gotError :: MonadStore Bool -gotError = any isError . snd <$> get +gotError = gets (any isError . snd) getError :: MonadStore [Logger] -getError = filter isError . snd <$> get +getError = gets (filter isError . snd) getLog :: MonadStore [Logger] -getLog = snd <$> get +getLog = gets snd flushLog :: MonadStore () flushLog = modify (\(a, _b) -> (a, [])) @@ -79,4 +74,4 @@ clearData :: MonadStore () clearData = modify (\(_, b) -> (Nothing, b)) getStoreDir :: MonadStore FilePath -getStoreDir = storeDir <$> ask +getStoreDir = asks storeDir diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs index 26df79d..ba6110a 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs @@ -1,20 +1,14 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# language RecordWildCards #-} module System.Nix.Store.Remote.Util where +import Prelude hiding ( putText ) import Control.Monad.Except -import Control.Monad.Reader -import Data.Either import Data.Binary.Get import Data.Binary.Put -import Data.Text ( Text ) -import qualified Data.Text.Encoding as T -import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import Data.Time import Data.Time.Clock.POSIX -import Data.ByteString ( ByteString ) import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as BSL @@ -40,7 +34,7 @@ genericIncremental getsome parser = go decoder go (Partial k ) = do chunk <- getsome go (k chunk) - go (Fail _leftover _consumed msg) = error msg + go (Fail _leftover _consumed msg) = error $ fromString msg getSocketIncremental :: Get a -> MonadStore a getSocketIncremental = genericIncremental sockGet8 @@ -53,7 +47,7 @@ getSocketIncremental = genericIncremental sockGet8 sockPut :: Put -> MonadStore () sockPut p = do soc <- asks storeSocket - liftIO $ sendAll soc $ BSL.toStrict $ runPut p + liftIO $ sendAll soc $ toStrict $ runPut p sockGet :: Get a -> MonadStore a sockGet = getSocketIncremental @@ -95,16 +89,16 @@ sockGetPaths = do getSocketIncremental (getPaths sd) bsToText :: ByteString -> Text -bsToText = T.decodeUtf8 +bsToText = decodeUtf8 textToBS :: Text -> ByteString -textToBS = T.encodeUtf8 +textToBS = encodeUtf8 bslToText :: BSL.ByteString -> Text -bslToText = TL.toStrict . TL.decodeUtf8 +bslToText = toText . TL.decodeUtf8 textToBSL :: Text -> BSL.ByteString -textToBSL = TL.encodeUtf8 . TL.fromStrict +textToBSL = TL.encodeUtf8 . toLText putText :: Text -> Put putText = putByteStringLen . textToBSL @@ -120,11 +114,11 @@ getPaths sd = Data.HashSet.fromList . rights . fmap (parsePath sd) <$> getByteStrings putPath :: StorePath -> Put -putPath = putByteStringLen . BSL.fromStrict . storePathToRawFilePath +putPath = putByteStringLen . fromStrict . storePathToRawFilePath putPaths :: StorePathSet -> Put putPaths = putByteStrings . Data.HashSet.toList . Data.HashSet.map - (BSL.fromStrict . storePathToRawFilePath) + (fromStrict . storePathToRawFilePath) putBool :: Bool -> Put putBool True = putInt (1 :: Int) @@ -170,4 +164,4 @@ putDerivation Derivation{..} = do putMany putText args flip putMany (Data.Map.toList env) - $ \(first, second) -> putText first >> putText second + $ \(a1, a2) -> putText a1 *> putText a2 diff --git a/hnix-store-remote/tests/Derivation.hs b/hnix-store-remote/tests/Derivation.hs index da35fb1..fb95de9 100644 --- a/hnix-store-remote/tests/Derivation.hs +++ b/hnix-store-remote/tests/Derivation.hs @@ -1,12 +1,7 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeApplications #-} +{-# language DataKinds #-} module Derivation where -import Control.Monad.IO.Class ( liftIO ) - -import Data.Text ( Text ) import Nix.Derivation ( Derivation(..) , DerivationOutput(..) ) @@ -21,7 +16,6 @@ import System.Nix.Store.Remote ( MonadStore import qualified Data.Map import qualified Data.Set import qualified Data.Text -import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Builder import qualified Data.Vector import qualified System.Nix.Derivation @@ -69,7 +63,7 @@ withDerivation action = withBuildScript $ \buildScript -> withBash $ \bash -> pth <- addTextToStore "hnix-store-derivation" - ( Data.Text.Lazy.toStrict + ( toText $ Data.Text.Lazy.Builder.toLazyText $ System.Nix.Derivation.buildDerivation d ) diff --git a/hnix-store-remote/tests/NixDaemon.hs b/hnix-store-remote/tests/NixDaemon.hs index d8f4b5d..36a797c 100644 --- a/hnix-store-remote/tests/NixDaemon.hs +++ b/hnix-store-remote/tests/NixDaemon.hs @@ -1,23 +1,14 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# language DataKinds #-} +{-# language ScopedTypeVariables #-} module NixDaemon where -import Data.Bool ( bool ) -import Control.Monad ( void ) -import Control.Monad.IO.Class ( liftIO ) +import qualified System.Environment as Env import Control.Exception ( bracket ) import Control.Concurrent ( threadDelay ) -import Data.Either ( isRight - , isLeft - ) -import Data.Text ( Text ) import qualified Data.HashSet as HS import qualified Data.Map.Strict as M import System.Directory -import qualified System.Environment import System.IO.Temp import qualified System.Process as P import System.Posix.User as U @@ -42,24 +33,24 @@ import Crypto.Hash ( SHA256 createProcessEnv :: FilePath -> String -> [String] -> IO P.ProcessHandle createProcessEnv fp proc args = do - mPath <- System.Environment.lookupEnv "PATH" + mPath <- Env.lookupEnv "PATH" (_, _, _, ph) <- P.createProcess (P.proc proc args) - { P.cwd = Just $ fp + { P.cwd = Just fp , P.env = Just $ mockedEnv mPath fp } pure ph mockedEnv :: Maybe String -> FilePath -> [(String, FilePath)] -mockedEnv mEnvPath fp = - [ ("NIX_STORE_DIR" , fp "store") - , ("NIX_LOCALSTATE_DIR", fp "var") - , ("NIX_LOG_DIR" , fp "var" "log") - , ("NIX_STATE_DIR" , fp "var" "nix") - , ("NIX_CONF_DIR" , fp "etc") +mockedEnv mEnvPath fp = (fp ) <<$>> + [ ("NIX_STORE_DIR" , "store") + , ("NIX_LOCALSTATE_DIR", "var") + , ("NIX_LOG_DIR" , "var" "log") + , ("NIX_STATE_DIR" , "var" "nix") + , ("NIX_CONF_DIR" , "etc") -- , ("NIX_REMOTE", "daemon") - ] <> (maybe [] (\x -> [("PATH", x)]) mEnvPath) + ] <> foldMap (\x -> [("PATH", x)]) mEnvPath waitSocket :: FilePath -> Int -> IO () waitSocket _ 0 = fail "No socket" @@ -67,12 +58,12 @@ waitSocket fp x = do ex <- doesFileExist fp bool (threadDelay 100000 >> waitSocket fp (x - 1)) - (pure ()) + pass ex writeConf :: FilePath -> IO () writeConf fp = - writeFile fp $ unlines + writeFile fp $ toString $ unlines [ "build-users-group = " , "trusted-users = root" , "allowed-users = *" @@ -131,7 +122,7 @@ withNixDaemon action = bracket (startDaemon path) (P.terminateProcess . fst) - (\x -> action . snd $ x) + (action . snd) checks :: (Show a, Show b) => IO (a, b) -> (a -> Bool) -> IO () checks action check = action >>= (`Hspec.shouldSatisfy` (check . fst)) @@ -143,7 +134,7 @@ it -> (a -> Bool) -> Hspec.SpecWith (m () -> IO (a, b)) it name action check = - Hspec.it name $ \run -> (run (action >> pure ())) `checks` check + Hspec.it name $ \run -> run (action >> pass) `checks` check itRights :: (Show a, Show b, Show c, Monad m) @@ -168,8 +159,7 @@ withPath action = do dummy :: MonadStore StorePath dummy = do let Right n = makeStorePathName "dummy" - res <- addToStore @SHA256 n "dummy" False (pure True) False - pure res + addToStore @SHA256 n "dummy" False (pure True) False invalidPath :: StorePath invalidPath = @@ -204,30 +194,30 @@ spec_protocol = Hspec.around withNixDaemon $ verifyStore True True `shouldReturn` False context "addTextToStore" $ - itRights "adds text to store" $ withPath $ const pure () + itRights "adds text to store" $ withPath pure context "isValidPathUncached" $ do itRights "validates path" $ withPath $ \path -> do - liftIO $ putStrLn $ show path - (isValidPathUncached path) `shouldReturn` True - itLefts "fails on invalid path" $ isValidPathUncached $ invalidPath + liftIO $ print path + isValidPathUncached path `shouldReturn` True + itLefts "fails on invalid path" $ isValidPathUncached invalidPath context "queryAllValidPaths" $ do - itRights "empty query" $ queryAllValidPaths + itRights "empty query" queryAllValidPaths itRights "non-empty query" $ withPath $ \path -> - queryAllValidPaths `shouldReturn` (HS.fromList [path]) + queryAllValidPaths `shouldReturn` HS.fromList [path] context "queryPathInfoUncached" $ - itRights "queries path info" $ withPath $ queryPathInfoUncached + itRights "queries path info" $ withPath queryPathInfoUncached context "ensurePath" $ - itRights "simple ensure" $ withPath $ ensurePath + itRights "simple ensure" $ withPath ensurePath context "addTempRoot" $ - itRights "simple addition" $ withPath $ addTempRoot + itRights "simple addition" $ withPath addTempRoot context "addIndirectRoot" $ - itRights "simple addition" $ withPath $ addIndirectRoot + itRights "simple addition" $ withPath addIndirectRoot context "buildPaths" $ do itRights "build Normal" $ withPath $ \path -> do @@ -243,13 +233,13 @@ spec_protocol = Hspec.around withNixDaemon $ buildPaths pathSet Repair context "roots" $ context "findRoots" $ do - itRights "empty roots" $ (findRoots `shouldReturn` M.empty) + itRights "empty roots" (findRoots `shouldReturn` M.empty) itRights "path added as a temp root" $ withPath $ \_ -> do roots <- findRoots roots `shouldSatisfy` ((== 1) . M.size) - context "optimiseStore" $ itRights "optimises" $ optimiseStore + context "optimiseStore" $ itRights "optimises" optimiseStore context "queryMissing" $ itRights "queries" $ withPath $ \path -> do @@ -268,8 +258,8 @@ spec_protocol = Hspec.around withNixDaemon $ itRights "valid dummy" $ do path <- dummy - liftIO $ putStrLn $ show path - (isValidPathUncached path) `shouldReturn` True + liftIO $ print path + isValidPathUncached path `shouldReturn` True context "derivation" $ itRights "build derivation" $ diff --git a/hnix-store-remote/tests/Util.hs b/hnix-store-remote/tests/Util.hs index b25b03f..dcb61fb 100644 --- a/hnix-store-remote/tests/Util.hs +++ b/hnix-store-remote/tests/Util.hs @@ -1,7 +1,7 @@ module Util where -import Data.Text.Arbitrary +import Data.Text.Arbitrary () import System.Nix.Store.Remote.Util import Test.Tasty.QuickCheck