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 #-}
|
{-# 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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user