{-# language DataKinds #-}
{-# language ScopedTypeVariables #-}

module System.Nix.ReadonlyStore where


import qualified Data.ByteString.Char8         as Bytes.Char8
import qualified Data.ByteString               as BS
import qualified Data.HashSet                  as HS
import           System.Nix.Hash
import           System.Nix.Nar
import           System.Nix.StorePath
import           Crypto.Hash                    ( Context
                                                , Digest
                                                , hash
                                                , hashlazy
                                                , hashInit
                                                , hashUpdate
                                                , hashFinalize
                                                , SHA256
                                                )


makeStorePath
  :: forall h
   . (NamedAlgo h)
  => StoreDir
  -> ByteString
  -> Digest h
  -> StorePathName
  -> StorePath
makeStorePath :: forall h.
NamedAlgo h =>
StoreDir -> ByteString -> Digest h -> StorePathName -> StorePath
makeStorePath StoreDir
storeDir ByteString
ty Digest h
h StorePathName
nm = StorePathHashPart -> StorePathName -> StorePath
StorePath (coerce :: forall a b. Coercible a b => a -> b
coerce ByteString
storeHash) StorePathName
nm
 where
  storeHash :: ByteString
storeHash = forall a. HashAlgorithm a => ByteString -> ByteString
mkStorePathHash @h ByteString
s
  s :: ByteString
s =
    ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
":" forall a b. (a -> b) -> a -> b
$
      ByteString
tyforall a. a -> [a] -> [a]
:forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
        [ forall a. NamedAlgo a => Text
algoName @h
        , forall a. BaseEncoding -> Digest a -> Text
encodeDigestWith BaseEncoding
Base16 Digest h
h
        , forall a. ToText a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
Bytes.Char8.unpack forall a b. (a -> b) -> a -> b
$ StoreDir -> ByteString
unStoreDir StoreDir
storeDir
        , coerce :: forall a b. Coercible a b => a -> b
coerce StorePathName
nm
        ]

makeTextPath
  :: StoreDir -> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath
makeTextPath :: StoreDir
-> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath
makeTextPath StoreDir
storeDir StorePathName
nm Digest SHA256
h StorePathSet
refs = forall h.
NamedAlgo h =>
StoreDir -> ByteString -> Digest h -> StorePathName -> StorePath
makeStorePath StoreDir
storeDir ByteString
ty Digest SHA256
h StorePathName
nm
 where
  ty :: ByteString
ty =
    ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
":" forall a b. (a -> b) -> a -> b
$ ByteString
"text" forall a. a -> [a] -> [a]
: forall a. Ord a => [a] -> [a]
sort (StoreDir -> StorePath -> ByteString
storePathToRawFilePath StoreDir
storeDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HashSet a -> [a]
HS.toList StorePathSet
refs)

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

computeStorePathForText
  :: StoreDir -> StorePathName -> ByteString -> (StorePathSet -> StorePath)
computeStorePathForText :: StoreDir
-> StorePathName -> ByteString -> StorePathSet -> StorePath
computeStorePathForText StoreDir
storeDir StorePathName
nm = StoreDir
-> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath
makeTextPath StoreDir
storeDir StorePathName
nm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash

computeStorePathForPath
  :: StoreDir
  -> 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 :: StoreDir
-> StorePathName
-> [Char]
-> Bool
-> ([Char] -> Bool)
-> Bool
-> IO StorePath
computeStorePathForPath StoreDir
storeDir StorePathName
name [Char]
pth Bool
recursive [Char] -> Bool
_pathFilter Bool
_repair = do
  Digest SHA256
selectedHash <- if Bool
recursive then IO (Digest SHA256)
recursiveContentHash else IO (Digest SHA256)
flatContentHash
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hashAlgo.
NamedAlgo hashAlgo =>
StoreDir -> Bool -> Digest hashAlgo -> StorePathName -> StorePath
makeFixedOutputPath StoreDir
storeDir Bool
recursive Digest SHA256
selectedHash StorePathName
name
 where
  recursiveContentHash :: IO (Digest SHA256)
  recursiveContentHash :: IO (Digest SHA256)
recursiveContentHash = forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT (Context SHA256) IO ()
streamNarUpdate (forall a. HashAlgorithm a => Context a
hashInit @SHA256)
  streamNarUpdate :: StateT (Context SHA256) IO ()
  streamNarUpdate :: StateT (Context SHA256) IO ()
streamNarUpdate = forall (m :: * -> *).
MonadIO m =>
NarEffects IO -> [Char] -> NarSource m
streamNarIO forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadBaseControl IO m) =>
NarEffects m
narEffectsIO [Char]
pth (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate @ByteString @SHA256))

  flatContentHash :: IO (Digest SHA256)
  flatContentHash :: IO (Digest SHA256)
flatContentHash = forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). NarEffects m -> [Char] -> m ByteString
narReadFile forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadBaseControl IO m) =>
NarEffects m
narEffectsIO [Char]
pth