mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-12-13 23:56:37 +03:00
Merge #166: Use relude, default language extensions, {,text} clean-up
This commit is contained in:
Anton Latukha
GitHub
commit
5e55781516
4
.github/workflows/Cabal-Linux-Remote.yml
vendored
4
.github/workflows/Cabal-Linux-Remote.yml
vendored
@ -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
|
||||
|
||||
4
.github/workflows/Core-Cabal-Linux.yml
vendored
4
.github/workflows/Core-Cabal-Linux.yml
vendored
@ -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
|
||||
|
||||
2
.github/workflows/Core-Cabal-macOS.yml
vendored
2
.github/workflows/Core-Cabal-macOS.yml
vendored
@ -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
|
||||
|
||||
2
.github/workflows/On-Release-Cabal-Linux.yml
vendored
2
.github/workflows/On-Release-Cabal-Linux.yml
vendored
@ -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 }}"
|
||||
|
||||
BIN
core-simple.png
Normal file
BIN
core-simple.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 310 KiB |
@ -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
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# language RecordWildCards #-}
|
||||
{-|
|
||||
Description : Build related types
|
||||
Maintainer : srk <srk@48.io>
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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(..) )
|
||||
|
||||
|
||||
@ -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 '/'
|
||||
|
||||
@ -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'.
|
||||
--
|
||||
|
||||
@ -3,10 +3,8 @@ Description : Generating and consuming NAR files
|
||||
Maintainer : Shea Levy <shea@shealevy.com>
|
||||
-}
|
||||
|
||||
{-# 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
|
||||
|
||||
@ -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
|
||||
]
|
||||
|
||||
|
||||
@ -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'
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
)
|
||||
|
||||
@ -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=="
|
||||
)
|
||||
]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -4,10 +4,8 @@ Maintainer : srk <srk@48.io>
|
||||
|-}
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
)
|
||||
|
||||
@ -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" $
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user