Merge pull request #177 from soulomoon/dev

replace the filepath argument in `addToStore` with a more common type `NarSource` (The core part)
This commit is contained in:
Richard Marko 2022-04-28 15:00:46 +02:00 committed by GitHub
commit 71991e5722
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 58 additions and 30 deletions

View File

@ -3,7 +3,10 @@
{-# language ScopedTypeVariables #-} {-# language ScopedTypeVariables #-}
module System.Nix.Internal.Nar.Streamer module System.Nix.Internal.Nar.Streamer
( streamNarIO ( NarSource
, dumpString
, dumpPath
, streamNarIO
, IsExecutable(..) , IsExecutable(..)
) )
where where
@ -19,22 +22,43 @@ import System.FilePath ( (</>) )
import qualified System.Nix.Internal.Nar.Effects as Nar import qualified System.Nix.Internal.Nar.Effects as Nar
-- | NarSource
-- The source to provide nar to the handler `(ByteString -> m ())`.
-- It is isomorphic to ByteString by Yoneda lemma
-- if the result is meant to be m ().
-- It is done in CPS style so IO can be chunks.
type NarSource m = (ByteString -> m ()) -> m ()
-- | dumpString
-- dump a string to nar in CPS style. The function takes in a `ByteString`,
-- and build a `NarSource m`.
dumpString
:: forall m. IO.MonadIO m
=> ByteString -- ^ the string you want to dump
-> NarSource m -- ^ The nar result in CPS style
dumpString text yield = traverse_ (yield . str)
["nix-archive-1", "(", "type" , "regular", "contents", text, ")"]
-- | dumpPath
-- shorthand
-- build a Source that turn file path to nar using the default narEffectsIO.
dumpPath
:: forall m . IO.MonadIO m
=> FilePath -- ^ path for the file you want to dump to nar
-> NarSource m -- ^ the nar result in CPS style
dumpPath = streamNarIO Nar.narEffectsIO
-- | This implementation of Nar encoding takes an arbitrary @yield@ -- | This implementation of Nar encoding takes an arbitrary @yield@
-- function from any streaming library, and repeatedly calls -- function from any streaming library, and repeatedly calls
-- it while traversing the filesystem object to Nar encode -- it while traversing the filesystem object to Nar encode
streamNarIO streamNarIO :: forall m . IO.MonadIO m => Nar.NarEffects IO -> FilePath -> NarSource m
:: forall m streamNarIO effs basePath yield = do
. (IO.MonadIO m)
=> (ByteString -> m ())
-> Nar.NarEffects IO
-> FilePath
-> m ()
streamNarIO yield effs basePath = do
yield $ str "nix-archive-1" yield $ str "nix-archive-1"
parens $ go basePath parens $ go basePath
where where
go :: FilePath -> m () go :: FilePath -> m ()
go path = do go path = do
isDir <- IO.liftIO $ Nar.narIsDir effs path isDir <- IO.liftIO $ Nar.narIsDir effs path
@ -65,16 +89,6 @@ streamNarIO yield effs basePath = do
yield $ strs ["name", Bytes.Char8.pack f, "node"] yield $ strs ["name", Bytes.Char8.pack f, "node"]
parens $ go fullName parens $ go fullName
str :: ByteString -> ByteString
str t =
let
len = Bytes.length t
in
int len <> padBS len t
padBS :: Int -> ByteString -> ByteString
padBS strSize bs = bs <> Bytes.replicate (padLen strSize) 0
parens act = do parens act = do
yield $ str "(" yield $ str "("
r <- act r <- act
@ -87,13 +101,6 @@ streamNarIO yield effs basePath = do
mapM_ yield . Bytes.Lazy.toChunks =<< IO.liftIO (Bytes.Lazy.readFile path) mapM_ yield . Bytes.Lazy.toChunks =<< IO.liftIO (Bytes.Lazy.readFile path)
yield $ Bytes.replicate (padLen $ fromIntegral fsize) 0 yield $ Bytes.replicate (padLen $ fromIntegral fsize) 0
strs :: [ByteString] -> ByteString
strs xs = Bytes.concat $ str <$> xs
int :: Integral a => a -> ByteString
int n = Serial.runPut $ Serial.putInt64le $ fromIntegral n
data IsExecutable = NonExecutable | Executable data IsExecutable = NonExecutable | Executable
deriving (Eq, Show) deriving (Eq, Show)
@ -107,3 +114,19 @@ isExecutable effs fp =
-- | Distance to the next multiple of 8 -- | Distance to the next multiple of 8
padLen :: Int -> Int padLen :: Int -> Int
padLen n = (8 - n) `mod` 8 padLen n = (8 - n) `mod` 8
int :: Integral a => a -> ByteString
int n = Serial.runPut $ Serial.putInt64le $ fromIntegral n
str :: ByteString -> ByteString
str t =
let
len = Bytes.length t
in
int len <> padBS len t
padBS :: Int -> ByteString -> ByteString
padBS strSize bs = bs <> Bytes.replicate (padLen strSize) 0
strs :: [ByteString] -> ByteString
strs xs = Bytes.concat $ str <$> xs

View File

@ -26,6 +26,11 @@ module System.Nix.Nar
-- * Internal -- * Internal
, Nar.streamNarIO , Nar.streamNarIO
, Nar.runParser , Nar.runParser
, Nar.dumpString
, Nar.dumpPath
-- * Type
, Nar.NarSource
) )
where where
@ -52,9 +57,9 @@ buildNarIO
-> IO () -> IO ()
buildNarIO effs basePath outHandle = buildNarIO effs basePath outHandle =
Nar.streamNarIO Nar.streamNarIO
(\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10)
effs effs
basePath basePath
(\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10)
-- | Read NAR formatted bytes from the @IO.Handle@ and unpack them into -- | Read NAR formatted bytes from the @IO.Handle@ and unpack them into

View File

@ -87,7 +87,7 @@ computeStorePathForPath name pth recursive _pathFilter _repair = do
recursiveContentHash :: IO (Digest SHA256) recursiveContentHash :: IO (Digest SHA256)
recursiveContentHash = hashFinalize <$> execStateT streamNarUpdate (hashInit @SHA256) recursiveContentHash = hashFinalize <$> execStateT streamNarUpdate (hashInit @SHA256)
streamNarUpdate :: StateT (Context SHA256) IO () streamNarUpdate :: StateT (Context SHA256) IO ()
streamNarUpdate = streamNarIO (modify . flip (hashUpdate @ByteString @SHA256)) narEffectsIO pth streamNarUpdate = streamNarIO narEffectsIO pth (modify . flip (hashUpdate @ByteString @SHA256))
flatContentHash :: IO (Digest SHA256) flatContentHash :: IO (Digest SHA256)
flatContentHash = hashlazy <$> narReadFile narEffectsIO pth flatContentHash = hashlazy <$> narReadFile narEffectsIO pth