{-
Description : Generating and consuming NAR files
Maintainer  : Shea Levy <shea@shealevy.com>
-}

{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}


module System.Nix.Nar
  (

  -- * Encoding and Decoding NAR archives
    buildNarIO
  , unpackNarIO

  -- * Experimental
  , Nar.parseNar
  , Nar.testParser
  , Nar.testParser'

  -- * Filesystem capabilities used by NAR encoder/decoder
  , Nar.NarEffects(..)
  , Nar.narEffectsIO

  -- * Internal
  , Nar.streamNarIO
  , Nar.runParser
  )
where

import qualified Control.Concurrent                as Concurrent
import qualified Data.ByteString                   as BS
import qualified System.IO                         as IO

import qualified System.Nix.Internal.Nar.Effects   as Nar
import qualified System.Nix.Internal.Nar.Parser    as Nar
import qualified System.Nix.Internal.Nar.Streamer  as Nar


-- For a description of the NAR format, see Eelco's thesis
-- https://nixos.org/%7Eeelco/pubs/phd-thesis.pdf


-- | Pack the filesystem object at @FilePath@ into a NAR and stream it into the
--   @IO.Handle@
--   The handle should aleady be open and in @IO.WriteMode@.
buildNarIO
  :: Nar.NarEffects IO
  -> FilePath
  -> IO.Handle
  -> IO ()
buildNarIO :: NarEffects IO -> FilePath -> Handle -> IO ()
buildNarIO NarEffects IO
effs FilePath
basePath Handle
outHandle =
  (ByteString -> IO ()) -> NarEffects IO -> FilePath -> IO ()
forall (m :: * -> *).
MonadIO m =>
(ByteString -> m ()) -> NarEffects IO -> FilePath -> m ()
Nar.streamNarIO
    (\ByteString
chunk -> Handle -> ByteString -> IO ()
BS.hPut Handle
outHandle ByteString
chunk IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
Concurrent.threadDelay Int
10)
    NarEffects IO
effs
    FilePath
basePath


-- | Read NAR formatted bytes from the @IO.Handle@ and unpack them into
--   file system object(s) at the supplied @FilePath@
unpackNarIO
  :: Nar.NarEffects IO
  -> IO.Handle
  -> FilePath
  -> IO (Either String ())
unpackNarIO :: NarEffects IO -> Handle -> FilePath -> IO (Either FilePath ())
unpackNarIO NarEffects IO
effs = NarEffects IO
-> NarParser IO () -> Handle -> FilePath -> IO (Either FilePath ())
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
NarEffects m
-> NarParser m a -> Handle -> FilePath -> m (Either FilePath a)
Nar.runParser NarEffects IO
effs NarParser IO ()
forall (m :: * -> *). (MonadIO m, MonadFail m) => NarParser m ()
Nar.parseNar