{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module System.Nix.Internal.Nar.Streamer where
import Control.Monad (forM, forM_, when)
import qualified Control.Monad.IO.Class as IO
import Data.Bool (bool)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BSL
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 ((</>))
import qualified System.Nix.Internal.Nar.Effects as Nar
streamNarIO
:: forall m.(IO.MonadIO m)
=> (BS.ByteString -> m ())
-> Nar.NarEffects IO
-> FilePath
-> m ()
streamNarIO :: (ByteString -> m ()) -> NarEffects IO -> FilePath -> m ()
streamNarIO ByteString -> m ()
yield NarEffects IO
effs FilePath
basePath = do
ByteString -> m ()
yield (ByteString -> ByteString
str ByteString
"nix-archive-1")
m () -> m ()
parens (FilePath -> m ()
go FilePath
basePath)
where
go :: FilePath -> m ()
go :: FilePath -> m ()
go FilePath
path = do
Bool
isDir <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ NarEffects IO -> FilePath -> IO Bool
forall (m :: * -> *). NarEffects m -> FilePath -> m Bool
Nar.narIsDir NarEffects IO
effs FilePath
path
Bool
isSymLink <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ NarEffects IO -> FilePath -> IO Bool
forall (m :: * -> *). NarEffects m -> FilePath -> m Bool
Nar.narIsSymLink NarEffects IO
effs FilePath
path
let isRegular :: Bool
isRegular = Bool -> Bool
not (Bool
isDir Bool -> Bool -> Bool
|| Bool
isSymLink)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSymLink (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
FilePath
target <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ NarEffects IO -> FilePath -> IO FilePath
forall (m :: * -> *). NarEffects m -> FilePath -> m FilePath
Nar.narReadLink NarEffects IO
effs FilePath
path
ByteString -> m ()
yield (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$
[ByteString] -> ByteString
strs [ByteString
"type", ByteString
"symlink", ByteString
"target", FilePath -> ByteString
BSC.pack FilePath
target]
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isRegular (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
IsExecutable
isExec <- IO IsExecutable -> m IsExecutable
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO IsExecutable -> m IsExecutable)
-> IO IsExecutable -> m IsExecutable
forall a b. (a -> b) -> a -> b
$ NarEffects IO -> FilePath -> IO IsExecutable
forall (m :: * -> *).
Functor m =>
NarEffects m -> FilePath -> m IsExecutable
isExecutable NarEffects IO
effs FilePath
path
ByteString -> m ()
yield (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
strs [ByteString
"type",ByteString
"regular"]
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IsExecutable
isExec IsExecutable -> IsExecutable -> Bool
forall a. Eq a => a -> a -> Bool
== IsExecutable
Executable) (ByteString -> m ()
yield (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
strs [ByteString
"executable", ByteString
""])
Int64
fSize <- IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ NarEffects IO -> FilePath -> IO Int64
forall (m :: * -> *). NarEffects m -> FilePath -> m Int64
Nar.narFileSize NarEffects IO
effs FilePath
path
ByteString -> m ()
yield (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
str ByteString
"contents"
ByteString -> m ()
yield (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString
forall a. Integral a => a -> ByteString
int Int64
fSize
FilePath -> Int64 -> m ()
yieldFile FilePath
path Int64
fSize
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isDir (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[FilePath]
fs <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (NarEffects IO -> FilePath -> IO [FilePath]
forall (m :: * -> *). NarEffects m -> FilePath -> m [FilePath]
Nar.narListDir NarEffects IO
effs FilePath
path)
ByteString -> m ()
yield (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
strs [ByteString
"type", ByteString
"directory"]
[FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
List.sort [FilePath]
fs) ((FilePath -> m ()) -> m ()) -> (FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
ByteString -> m ()
yield (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
str ByteString
"entry"
m () -> m ()
parens (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let fullName :: FilePath
fullName = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
f
ByteString -> m ()
yield ([ByteString] -> ByteString
strs [ByteString
"name", FilePath -> ByteString
BSC.pack FilePath
f, ByteString
"node"])
m () -> m ()
parens (FilePath -> m ()
go FilePath
fullName)
str :: BS.ByteString -> BS.ByteString
str :: ByteString -> ByteString
str ByteString
t = let len :: Int
len = ByteString -> Int
BS.length ByteString
t
in Int -> ByteString
forall a. Integral a => a -> ByteString
int Int
len ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
padBS Int
len ByteString
t
padBS :: Int -> BS.ByteString -> BS.ByteString
padBS :: Int -> ByteString -> ByteString
padBS Int
strSize ByteString
bs = ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int -> Int
padLen Int
strSize) Word8
0
parens :: m () -> m ()
parens m ()
act = do
ByteString -> m ()
yield (ByteString -> ByteString
str ByteString
"(")
()
r <- m ()
act
ByteString -> m ()
yield (ByteString -> ByteString
str ByteString
")")
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
r
yieldFile :: FilePath -> Int64 -> m ()
yieldFile :: FilePath -> Int64 -> m ()
yieldFile FilePath
path Int64
fsize = do
(ByteString -> m ()) -> [ByteString] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> m ()
yield ([ByteString] -> m ())
-> (ByteString -> [ByteString]) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.toChunks (ByteString -> m ()) -> m ByteString -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (FilePath -> IO ByteString
BSL.readFile FilePath
path)
ByteString -> m ()
yield (Int -> Word8 -> ByteString
BS.replicate (Int -> Int
padLen (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
fsize)) Word8
0)
strs :: [BS.ByteString] -> BS.ByteString
strs :: [ByteString] -> ByteString
strs [ByteString]
xs = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
str (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
xs
int :: Integral a => a -> BS.ByteString
int :: a -> ByteString
int a
n = Put -> ByteString
Serial.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter Int64
Serial.putInt64le (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
data IsExecutable = NonExecutable | Executable
deriving (IsExecutable -> IsExecutable -> Bool
(IsExecutable -> IsExecutable -> Bool)
-> (IsExecutable -> IsExecutable -> Bool) -> Eq IsExecutable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsExecutable -> IsExecutable -> Bool
$c/= :: IsExecutable -> IsExecutable -> Bool
== :: IsExecutable -> IsExecutable -> Bool
$c== :: IsExecutable -> IsExecutable -> Bool
Eq, Int -> IsExecutable -> FilePath -> FilePath
[IsExecutable] -> FilePath -> FilePath
IsExecutable -> FilePath
(Int -> IsExecutable -> FilePath -> FilePath)
-> (IsExecutable -> FilePath)
-> ([IsExecutable] -> FilePath -> FilePath)
-> Show IsExecutable
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [IsExecutable] -> FilePath -> FilePath
$cshowList :: [IsExecutable] -> FilePath -> FilePath
show :: IsExecutable -> FilePath
$cshow :: IsExecutable -> FilePath
showsPrec :: Int -> IsExecutable -> FilePath -> FilePath
$cshowsPrec :: Int -> IsExecutable -> FilePath -> FilePath
Show)
isExecutable :: Functor m => Nar.NarEffects m -> FilePath -> m IsExecutable
isExecutable :: NarEffects m -> FilePath -> m IsExecutable
isExecutable NarEffects m
effs FilePath
fp =
IsExecutable -> IsExecutable -> Bool -> IsExecutable
forall a. a -> a -> Bool -> a
bool IsExecutable
NonExecutable IsExecutable
Executable (Bool -> IsExecutable)
-> (Permissions -> Bool) -> Permissions -> IsExecutable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Bool
Directory.executable (Permissions -> IsExecutable) -> m Permissions -> m IsExecutable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NarEffects m -> FilePath -> m Permissions
forall (m :: * -> *). NarEffects m -> FilePath -> m Permissions
Nar.narGetPerms NarEffects m
effs FilePath
fp
padLen:: Int -> Int
padLen :: Int -> Int
padLen Int
n = (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8