-- | Stream out a NAR file from a regular file

{-# LANGUAGE ScopedTypeVariables #-}

module System.Nix.Internal.Nar.Streamer
  ( NarSource
  , dumpString
  , dumpPath
  , streamNarIO
  , streamNarIOWithOptions
  , IsExecutable(..)
  )
where

import qualified Control.Monad.IO.Class          as IO
import qualified Data.ByteString                 as Bytes
import qualified Data.ByteString.Lazy            as Bytes.Lazy
import qualified Data.Serialize                  as Serial
import qualified Data.Text                       as T (pack, breakOn)
import qualified Data.Text.Encoding              as TE (encodeUtf8)
import qualified System.Directory                as Directory
import           System.FilePath                 ((</>))

import qualified System.Nix.Internal.Nar.Effects as Nar
import qualified System.Nix.Internal.Nar.Options 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 :: forall (m :: * -> *). MonadIO m => ByteString -> NarSource m
dumpString ByteString
text ByteString -> m ()
yield = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ByteString -> m ()
yield forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
str)
  [ByteString
"nix-archive-1", ByteString
"(", ByteString
"type" , ByteString
"regular", ByteString
"contents", ByteString
text, ByteString
")"]


-- | 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 :: forall (m :: * -> *). MonadIO m => FilePath -> NarSource m
dumpPath = forall (m :: * -> *).
MonadIO m =>
NarEffects IO -> FilePath -> NarSource m
streamNarIO forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadBaseControl IO m) =>
NarEffects m
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 => Nar.NarEffects IO -> FilePath -> NarSource m
streamNarIO :: forall (m :: * -> *).
MonadIO m =>
NarEffects IO -> FilePath -> NarSource m
streamNarIO NarEffects IO
effs FilePath
basePath ByteString -> m ()
yield =
  forall (m :: * -> *).
MonadIO m =>
NarOptions -> NarEffects IO -> FilePath -> NarSource m
streamNarIOWithOptions NarOptions
Nar.defaultNarOptions NarEffects IO
effs FilePath
basePath ByteString -> m ()
yield

streamNarIOWithOptions :: forall m . IO.MonadIO m => Nar.NarOptions -> Nar.NarEffects IO -> FilePath -> NarSource m
streamNarIOWithOptions :: forall (m :: * -> *).
MonadIO m =>
NarOptions -> NarEffects IO -> FilePath -> NarSource m
streamNarIOWithOptions NarOptions
opts NarEffects IO
effs FilePath
basePath ByteString -> m ()
yield = do
  ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
str ByteString
"nix-archive-1"
  forall {b}. m b -> m b
parens forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
go FilePath
basePath
 where
  go :: FilePath -> m ()
  go :: FilePath -> m ()
go FilePath
path = do
    Bool
isSymLink <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). NarEffects m -> FilePath -> m Bool
Nar.narIsSymLink NarEffects IO
effs FilePath
path
    if Bool
isSymLink then do
      FilePath
target <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). NarEffects m -> FilePath -> m FilePath
Nar.narReadLink NarEffects IO
effs FilePath
path
      ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$
        [ByteString] -> ByteString
strs [ByteString
"type", ByteString
"symlink", ByteString
"target", FilePath -> ByteString
filePathToBS FilePath
target]
      else do
        Bool
isDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). NarEffects m -> FilePath -> m Bool
Nar.narIsDir NarEffects IO
effs FilePath
path
        if Bool
isDir then do
          [FilePath]
fs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (forall (m :: * -> *). NarEffects m -> FilePath -> m [FilePath]
Nar.narListDir NarEffects IO
effs FilePath
path)
          ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
strs [ByteString
"type", ByteString
"directory"]
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Ord a => [a] -> [a]
sort [FilePath]
fs) forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
            ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
str ByteString
"entry"
            forall {b}. m b -> m b
parens forall a b. (a -> b) -> a -> b
$ do
              let fullName :: FilePath
fullName = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
f
              let serializedPath :: ByteString
serializedPath =
                    if NarOptions -> Bool
Nar.optUseCaseHack NarOptions
opts then
                      FilePath -> ByteString
filePathToBSWithCaseHack FilePath
f
                    else
                      FilePath -> ByteString
filePathToBS FilePath
f
              ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
strs [ByteString
"name", ByteString
serializedPath, ByteString
"node"]
              forall {b}. m b -> m b
parens forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
go FilePath
fullName
        else do
          IsExecutable
isExec <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Functor m =>
NarEffects m -> FilePath -> m IsExecutable
isExecutable NarEffects IO
effs FilePath
path
          ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
strs [ByteString
"type", ByteString
"regular"]
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IsExecutable
isExec forall a. Eq a => a -> a -> Bool
== IsExecutable
Executable) forall a b. (a -> b) -> a -> b
$ ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
strs [ByteString
"executable", ByteString
""]
          Int64
fSize <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). NarEffects m -> FilePath -> m Int64
Nar.narFileSize NarEffects IO
effs FilePath
path
          ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
str ByteString
"contents"
          ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> ByteString
int Int64
fSize
          FilePath -> Int64 -> m ()
yieldFile FilePath
path Int64
fSize

  parens :: m b -> m b
parens m b
act = do
    ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
str ByteString
"("
    b
r <- m b
act
    ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
str ByteString
")"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure b
r

  -- Read, yield, and pad the file
  yieldFile :: FilePath -> Int64 -> m ()
  yieldFile :: FilePath -> Int64 -> m ()
yieldFile FilePath
path Int64
fsize = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> m ()
yield forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
Bytes.Lazy.toChunks forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (forall (m :: * -> *). NarEffects m -> FilePath -> m ByteString
Nar.narReadFile NarEffects IO
effs FilePath
path)
    ByteString -> m ()
yield forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
Bytes.replicate (Int -> Int
padLen forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
fsize) Word8
0

data IsExecutable = NonExecutable | Executable
  deriving (IsExecutable -> IsExecutable -> Bool
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
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 :: forall (m :: * -> *).
Functor m =>
NarEffects m -> FilePath -> m IsExecutable
isExecutable NarEffects m
effs FilePath
fp =
  forall a. a -> a -> Bool -> a
bool
    IsExecutable
NonExecutable
    IsExecutable
Executable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Bool
Directory.executable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). NarEffects m -> FilePath -> m Permissions
Nar.narGetPerms NarEffects m
effs FilePath
fp

-- | Distance to the next multiple of 8
padLen :: Int -> Int
padLen :: Int -> Int
padLen Int
n = (Int
8 forall a. Num a => a -> a -> a
- Int
n) forall a. Integral a => a -> a -> a
`mod` Int
8

int :: Integral a => a -> ByteString
int :: forall a. Integral a => a -> ByteString
int a
n = Put -> ByteString
Serial.runPut forall a b. (a -> b) -> a -> b
$ Putter Int64
Serial.putInt64le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n

str :: ByteString -> ByteString
str :: ByteString -> ByteString
str ByteString
t =
  let
    len :: Int
len = ByteString -> Int
Bytes.length ByteString
t
  in
    forall a. Integral a => a -> ByteString
int Int
len forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
padBS Int
len ByteString
t

padBS :: Int -> ByteString -> ByteString
padBS :: Int -> ByteString -> ByteString
padBS Int
strSize ByteString
bs = ByteString
bs forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
Bytes.replicate (Int -> Int
padLen Int
strSize) Word8
0

strs :: [ByteString] -> ByteString
strs :: [ByteString] -> ByteString
strs [ByteString]
xs = [ByteString] -> ByteString
Bytes.concat forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
str forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
xs

filePathToBS :: FilePath -> ByteString
filePathToBS :: FilePath -> ByteString
filePathToBS = Text -> ByteString
TE.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack

filePathToBSWithCaseHack :: FilePath -> ByteString
filePathToBSWithCaseHack :: FilePath -> ByteString
filePathToBSWithCaseHack = Text -> ByteString
TE.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
undoCaseHack forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack

undoCaseHack :: Text -> Text
undoCaseHack :: Text -> Text
undoCaseHack = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> (Text, Text)
T.breakOn Text
Nar.caseHackSuffix