mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-12-13 15:46:26 +03:00
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:
commit
71991e5722
@ -3,7 +3,10 @@
|
||||
{-# language ScopedTypeVariables #-}
|
||||
|
||||
module System.Nix.Internal.Nar.Streamer
|
||||
( streamNarIO
|
||||
( NarSource
|
||||
, dumpString
|
||||
, dumpPath
|
||||
, streamNarIO
|
||||
, IsExecutable(..)
|
||||
)
|
||||
where
|
||||
@ -19,22 +22,43 @@ import System.FilePath ( (</>) )
|
||||
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@
|
||||
-- function from any streaming library, and repeatedly calls
|
||||
-- it while traversing the filesystem object to Nar encode
|
||||
streamNarIO
|
||||
:: forall m
|
||||
. (IO.MonadIO m)
|
||||
=> (ByteString -> m ())
|
||||
-> Nar.NarEffects IO
|
||||
-> FilePath
|
||||
-> m ()
|
||||
streamNarIO yield effs basePath = do
|
||||
streamNarIO :: forall m . IO.MonadIO m => Nar.NarEffects IO -> FilePath -> NarSource m
|
||||
streamNarIO effs basePath yield = do
|
||||
yield $ str "nix-archive-1"
|
||||
parens $ go basePath
|
||||
|
||||
where
|
||||
|
||||
go :: FilePath -> m ()
|
||||
go path = do
|
||||
isDir <- IO.liftIO $ Nar.narIsDir effs path
|
||||
@ -65,16 +89,6 @@ streamNarIO yield effs basePath = do
|
||||
yield $ strs ["name", Bytes.Char8.pack f, "node"]
|
||||
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
|
||||
yield $ str "("
|
||||
r <- act
|
||||
@ -87,13 +101,6 @@ streamNarIO yield effs basePath = do
|
||||
mapM_ yield . Bytes.Lazy.toChunks =<< IO.liftIO (Bytes.Lazy.readFile path)
|
||||
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
|
||||
deriving (Eq, Show)
|
||||
|
||||
@ -107,3 +114,19 @@ isExecutable effs fp =
|
||||
-- | Distance to the next multiple of 8
|
||||
padLen :: Int -> Int
|
||||
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
|
||||
|
@ -26,6 +26,11 @@ module System.Nix.Nar
|
||||
-- * Internal
|
||||
, Nar.streamNarIO
|
||||
, Nar.runParser
|
||||
, Nar.dumpString
|
||||
, Nar.dumpPath
|
||||
|
||||
-- * Type
|
||||
, Nar.NarSource
|
||||
)
|
||||
where
|
||||
|
||||
@ -52,9 +57,9 @@ buildNarIO
|
||||
-> IO ()
|
||||
buildNarIO effs basePath outHandle =
|
||||
Nar.streamNarIO
|
||||
(\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10)
|
||||
effs
|
||||
basePath
|
||||
(\chunk -> BS.hPut outHandle chunk >> Concurrent.threadDelay 10)
|
||||
|
||||
|
||||
-- | Read NAR formatted bytes from the @IO.Handle@ and unpack them into
|
||||
|
@ -87,7 +87,7 @@ computeStorePathForPath name pth recursive _pathFilter _repair = do
|
||||
recursiveContentHash :: IO (Digest SHA256)
|
||||
recursiveContentHash = hashFinalize <$> execStateT streamNarUpdate (hashInit @SHA256)
|
||||
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 = hashlazy <$> narReadFile narEffectsIO pth
|
||||
|
Loading…
Reference in New Issue
Block a user