{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}

module System.Nix.ReadonlyStore where


import           Data.ByteString                ( ByteString )
import qualified Data.ByteString               as BS
import           Data.List                      ( sort )
import qualified Data.Text                     as T
import qualified Data.HashSet                  as HS
import           Data.Text.Encoding
import           System.Nix.Hash
import           System.Nix.Nar
import           System.Nix.StorePath
import           Control.Monad.State.Strict


makeStorePath
  :: forall hashAlgo
   . (NamedAlgo hashAlgo)
  => FilePath
  -> ByteString
  -> Digest hashAlgo
  -> StorePathName
  -> StorePath
makeStorePath :: FilePath
-> ByteString -> Digest hashAlgo -> StorePathName -> StorePath
makeStorePath FilePath
fp ByteString
ty Digest hashAlgo
h StorePathName
nm = Digest StorePathHashAlgo -> StorePathName -> FilePath -> StorePath
StorePath Digest StorePathHashAlgo
storeHash StorePathName
nm FilePath
fp
 where
  storeHash :: Digest StorePathHashAlgo
storeHash = ByteString -> Digest StorePathHashAlgo
forall (a :: HashAlgorithm). ValidAlgo a => ByteString -> Digest a
hash ByteString
s

  s :: ByteString
s =
    ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
":" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
      ByteString
tyByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:(Text -> ByteString) -> [Text] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeUtf8
        [ NamedAlgo hashAlgo => Text
forall (a :: HashAlgorithm). NamedAlgo a => Text
algoName @hashAlgo
        , BaseEncoding -> Digest hashAlgo -> Text
forall (a :: HashAlgorithm). BaseEncoding -> Digest a -> Text
encodeInBase BaseEncoding
Base16 Digest hashAlgo
h
        , FilePath -> Text
T.pack FilePath
fp
        , StorePathName -> Text
unStorePathName StorePathName
nm
        ]

makeTextPath
  :: FilePath -> StorePathName -> Digest 'SHA256 -> StorePathSet -> StorePath
makeTextPath :: FilePath
-> StorePathName -> Digest 'SHA256 -> StorePathSet -> StorePath
makeTextPath FilePath
fp StorePathName
nm Digest 'SHA256
h StorePathSet
refs = FilePath
-> ByteString -> Digest 'SHA256 -> StorePathName -> StorePath
forall (hashAlgo :: HashAlgorithm).
NamedAlgo hashAlgo =>
FilePath
-> ByteString -> Digest hashAlgo -> StorePathName -> StorePath
makeStorePath FilePath
fp ByteString
ty Digest 'SHA256
h StorePathName
nm
 where
  ty :: ByteString
ty =
    ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
":" (ByteString
"text" ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
forall a. Ord a => [a] -> [a]
sort ((StorePath -> ByteString) -> [StorePath] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StorePath -> ByteString
storePathToRawFilePath (StorePathSet -> [StorePath]
forall a. HashSet a -> [a]
HS.toList StorePathSet
refs)))

makeFixedOutputPath
  :: forall hashAlgo
  .  NamedAlgo hashAlgo
  => FilePath
  -> Bool
  -> Digest hashAlgo
  -> StorePathName
  -> StorePath
makeFixedOutputPath :: FilePath -> Bool -> Digest hashAlgo -> StorePathName -> StorePath
makeFixedOutputPath FilePath
fp Bool
recursive Digest hashAlgo
h =
  if Bool
recursive Bool -> Bool -> Bool
&& (NamedAlgo hashAlgo => Text
forall (a :: HashAlgorithm). NamedAlgo a => Text
algoName @hashAlgo) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"sha256"
    then FilePath
-> ByteString -> Digest hashAlgo -> StorePathName -> StorePath
forall (hashAlgo :: HashAlgorithm).
NamedAlgo hashAlgo =>
FilePath
-> ByteString -> Digest hashAlgo -> StorePathName -> StorePath
makeStorePath FilePath
fp ByteString
"source" Digest hashAlgo
h
    else FilePath
-> ByteString -> Digest 'SHA256 -> StorePathName -> StorePath
forall (hashAlgo :: HashAlgorithm).
NamedAlgo hashAlgo =>
FilePath
-> ByteString -> Digest hashAlgo -> StorePathName -> StorePath
makeStorePath FilePath
fp ByteString
"output:out" Digest 'SHA256
h'
 where
  h' :: Digest 'SHA256
h' =
    ValidAlgo 'SHA256 => ByteString -> Digest 'SHA256
forall (a :: HashAlgorithm). ValidAlgo a => ByteString -> Digest a
hash @'SHA256
      (ByteString -> Digest 'SHA256) -> ByteString -> Digest 'SHA256
forall a b. (a -> b) -> a -> b
$  ByteString
"fixed:out:"
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 (NamedAlgo hashAlgo => Text
forall (a :: HashAlgorithm). NamedAlgo a => Text
algoName @hashAlgo)
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (if Bool
recursive then ByteString
":r:" else ByteString
":")
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 (BaseEncoding -> Digest hashAlgo -> Text
forall (a :: HashAlgorithm). BaseEncoding -> Digest a -> Text
encodeInBase BaseEncoding
Base16 Digest hashAlgo
h)
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":"

computeStorePathForText
  :: FilePath -> StorePathName -> ByteString -> (StorePathSet -> StorePath)
computeStorePathForText :: FilePath
-> StorePathName -> ByteString -> StorePathSet -> StorePath
computeStorePathForText FilePath
fp StorePathName
nm = FilePath
-> StorePathName -> Digest 'SHA256 -> StorePathSet -> StorePath
makeTextPath FilePath
fp StorePathName
nm (Digest 'SHA256 -> StorePathSet -> StorePath)
-> (ByteString -> Digest 'SHA256)
-> ByteString
-> StorePathSet
-> StorePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest 'SHA256
forall (a :: HashAlgorithm). ValidAlgo a => ByteString -> Digest a
hash

computeStorePathForPath
  :: StorePathName        -- ^ Name part of the newly created `StorePath`
  -> FilePath             -- ^ Local `FilePath` to add
  -> Bool                 -- ^ Add target directory recursively
  -> (FilePath -> Bool)   -- ^ Path filter function
  -> Bool                 -- ^ Only used by local store backend
  -> IO StorePath
computeStorePathForPath :: StorePathName
-> FilePath -> Bool -> (FilePath -> Bool) -> Bool -> IO StorePath
computeStorePathForPath StorePathName
name FilePath
pth Bool
recursive FilePath -> Bool
_pathFilter Bool
_repair = do
  Digest 'SHA256
selectedHash <- if Bool
recursive then IO (Digest 'SHA256)
recursiveContentHash else IO (Digest 'SHA256)
flatContentHash
  StorePath -> IO StorePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StorePath -> IO StorePath) -> StorePath -> IO StorePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Bool -> Digest 'SHA256 -> StorePathName -> StorePath
forall (hashAlgo :: HashAlgorithm).
NamedAlgo hashAlgo =>
FilePath -> Bool -> Digest hashAlgo -> StorePathName -> StorePath
makeFixedOutputPath FilePath
"/nix/store" Bool
recursive Digest 'SHA256
selectedHash StorePathName
name
 where
  recursiveContentHash :: IO (Digest 'SHA256)
  recursiveContentHash :: IO (Digest 'SHA256)
recursiveContentHash = Ctx -> Digest 'SHA256
forall (a :: HashAlgorithm). ValidAlgo a => AlgoCtx a -> Digest a
finalize (Ctx -> Digest 'SHA256) -> IO Ctx -> IO (Digest 'SHA256)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Ctx IO () -> Ctx -> IO Ctx
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT Ctx IO ()
StateT (AlgoCtx 'SHA256) IO ()
streamNarUpdate (ValidAlgo 'SHA256 => AlgoCtx 'SHA256
forall (a :: HashAlgorithm). ValidAlgo a => AlgoCtx a
initialize @'SHA256)
  streamNarUpdate :: StateT (AlgoCtx 'SHA256) IO ()
  streamNarUpdate :: StateT (AlgoCtx 'SHA256) IO ()
streamNarUpdate = (ByteString -> StateT Ctx IO ())
-> NarEffects IO -> FilePath -> StateT Ctx IO ()
forall (m :: * -> *).
MonadIO m =>
(ByteString -> m ()) -> NarEffects IO -> FilePath -> m ()
streamNarIO ((Ctx -> Ctx) -> StateT Ctx IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Ctx -> Ctx) -> StateT Ctx IO ())
-> (ByteString -> Ctx -> Ctx) -> ByteString -> StateT Ctx IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ctx -> ByteString -> Ctx) -> ByteString -> Ctx -> Ctx
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ValidAlgo 'SHA256 =>
AlgoCtx 'SHA256 -> ByteString -> AlgoCtx 'SHA256
forall (a :: HashAlgorithm).
ValidAlgo a =>
AlgoCtx a -> ByteString -> AlgoCtx a
update @'SHA256)) NarEffects IO
forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadBaseControl IO m) =>
NarEffects m
narEffectsIO FilePath
pth

  flatContentHash :: IO (Digest 'SHA256)
  flatContentHash :: IO (Digest 'SHA256)
flatContentHash = ByteString -> Digest 'SHA256
forall (a :: HashAlgorithm). ValidAlgo a => ByteString -> Digest a
hashLazy (ByteString -> Digest 'SHA256)
-> IO ByteString -> IO (Digest 'SHA256)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NarEffects IO -> FilePath -> IO ByteString
forall (m :: * -> *). NarEffects m -> FilePath -> m ByteString
narReadFile NarEffects IO
forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadBaseControl IO m) =>
NarEffects m
narEffectsIO FilePath
pth