{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE RecordWildCards     #-}
module System.Nix.Store.Remote
  ( addToStore
  , addTextToStore
  , addSignatures
  , addIndirectRoot
  , addTempRoot
  , buildPaths
  , buildDerivation
  , ensurePath
  , findRoots
  , isValidPathUncached
  , queryValidPaths
  , queryAllValidPaths
  , querySubstitutablePaths
  , queryPathInfoUncached
  , queryReferrers
  , queryValidDerivers
  , queryDerivationOutputs
  , queryDerivationOutputNames
  , queryPathFromHashPart
  , queryMissing
  , optimiseStore
  , runStore
  , syncWithGC
  , verifyStore
  , module System.Nix.Store.Remote.Types
  )
where

import           Control.Monad                  ( void
                                                , unless
                                                , when
                                                )
import           Data.ByteString.Lazy           ( ByteString )
import           Data.Map.Strict                ( Map )
import           Data.Text                      ( Text )

import           Nix.Derivation                 ( Derivation )
import           System.Nix.Build               ( BuildMode
                                                , BuildResult
                                                )
import           System.Nix.Hash                ( NamedAlgo
                                                , SomeNamedDigest(..)
                                                , BaseEncoding(NixBase32)
                                                , decodeDigestWith
                                                )
import           System.Nix.StorePath           ( StorePath
                                                , StorePathName
                                                , StorePathSet
                                                , StorePathHashPart
                                                )
import           System.Nix.StorePathMetadata   ( StorePathMetadata(..)
                                                , StorePathTrust(..)
                                                )
import           System.Nix.Internal.Base       ( encodeWith )

import qualified Data.Binary.Put
import qualified Data.ByteString.Lazy
import qualified Data.Map.Strict
import qualified Data.Set
import qualified Data.Text.Encoding

import qualified System.Nix.Nar
import qualified System.Nix.Hash
import qualified System.Nix.StorePath
import qualified System.Nix.Store.Remote.Parsers

import           System.Nix.Store.Remote.Binary
import           System.Nix.Store.Remote.Types
import           System.Nix.Store.Remote.Protocol
import           System.Nix.Store.Remote.Util
import           Crypto.Hash                    ( SHA256 )
import           Data.Coerce                    ( coerce )

type RepairFlag = Bool
type CheckFlag = Bool
type SubstituteFlag = Bool

-- | Pack `FilePath` as `Nar` and add it to the store.
addToStore
  :: forall a
   . NamedAlgo a
  => StorePathName        -- ^ Name part of the newly created `StorePath`
  -> FilePath             -- ^ Local `FilePath` to add
  -> Bool                 -- ^ Add target directory recursively
  -> (FilePath -> Bool)   -- ^ Path filter function
  -> RepairFlag           -- ^ Only used by local store backend
  -> MonadStore StorePath
addToStore :: StorePathName
-> FilePath
-> Bool
-> (FilePath -> Bool)
-> Bool
-> MonadStore StorePath
addToStore StorePathName
name FilePath
pth Bool
recursive FilePath -> Bool
_pathFilter Bool
_repair = do

  WorkerOp
-> ((ByteString -> MonadStore ()) -> MonadStore ())
-> MonadStore ()
runOpArgsIO WorkerOp
AddToStore (((ByteString -> MonadStore ()) -> MonadStore ()) -> MonadStore ())
-> ((ByteString -> MonadStore ()) -> MonadStore ())
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ \ByteString -> MonadStore ()
yield -> do
    ByteString -> MonadStore ()
yield (ByteString -> MonadStore ()) -> ByteString -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Data.ByteString.Lazy.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
Data.Binary.Put.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
      Text -> Put
putText (Text -> Put) -> Text -> Put
forall a b. (a -> b) -> a -> b
$ StorePathName -> Text
System.Nix.StorePath.unStorePathName StorePathName
name

      Bool -> Put
putBool (Bool -> Put) -> Bool -> Put
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ NamedAlgo a => Text
forall a. NamedAlgo a => Text
System.Nix.Hash.algoName @a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"sha256" Bool -> Bool -> Bool
&& Bool
recursive

      Bool -> Put
putBool Bool
recursive

      Text -> Put
putText (Text -> Put) -> Text -> Put
forall a b. (a -> b) -> a -> b
$ NamedAlgo a => Text
forall a. NamedAlgo a => Text
System.Nix.Hash.algoName @a

    (ByteString -> MonadStore ())
-> NarEffects IO -> FilePath -> MonadStore ()
forall (m :: * -> *).
MonadIO m =>
(ByteString -> m ()) -> NarEffects IO -> FilePath -> m ()
System.Nix.Nar.streamNarIO ByteString -> MonadStore ()
yield NarEffects IO
forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadBaseControl IO m) =>
NarEffects m
System.Nix.Nar.narEffectsIO FilePath
pth

  MonadStore StorePath
sockGetPath

-- | Add text to store.
--
-- Reference accepts repair but only uses it
-- to throw error in case of remote talking to nix-daemon.
addTextToStore
  :: Text         -- ^ Name of the text
  -> Text         -- ^ Actual text to add
  -> StorePathSet -- ^ Set of `StorePath`s that the added text references
  -> RepairFlag   -- ^ Repair flag, must be `False` in case of remote backend
  -> MonadStore StorePath
addTextToStore :: Text -> Text -> StorePathSet -> Bool -> MonadStore StorePath
addTextToStore Text
name Text
text StorePathSet
references' Bool
repair = do
  Bool -> MonadStore () -> MonadStore ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
repair
    (MonadStore () -> MonadStore ()) -> MonadStore () -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ FilePath -> MonadStore ()
forall a. HasCallStack => FilePath -> a
error FilePath
"repairing is not supported when building through the Nix daemon"
  WorkerOp -> Put -> MonadStore ()
runOpArgs WorkerOp
AddTextToStore (Put -> MonadStore ()) -> Put -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> Put
putText Text
name
    Text -> Put
putText Text
text
    StorePathSet -> Put
putPaths StorePathSet
references'
  MonadStore StorePath
sockGetPath

addSignatures :: StorePath -> [ByteString] -> MonadStore ()
addSignatures :: StorePath -> [ByteString] -> MonadStore ()
addSignatures StorePath
p [ByteString]
signatures = do
  ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   FilePath
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
AddSignatures (Put
 -> ExceptT
      FilePath
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
forall a b. (a -> b) -> a -> b
$ do
    StorePath -> Put
putPath StorePath
p
    [ByteString] -> Put
forall (t :: * -> *). Foldable t => t ByteString -> Put
putByteStrings [ByteString]
signatures

addIndirectRoot :: StorePath -> MonadStore ()
addIndirectRoot :: StorePath -> MonadStore ()
addIndirectRoot StorePath
pn = do
  ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   FilePath
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
AddIndirectRoot (Put
 -> ExceptT
      FilePath
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
forall a b. (a -> b) -> a -> b
$ StorePath -> Put
putPath StorePath
pn

-- | Add temporary garbage collector root.
--
-- This root is removed as soon as the client exits.
addTempRoot :: StorePath -> MonadStore ()
addTempRoot :: StorePath -> MonadStore ()
addTempRoot StorePath
pn = do
  ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   FilePath
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
AddTempRoot (Put
 -> ExceptT
      FilePath
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
forall a b. (a -> b) -> a -> b
$ StorePath -> Put
putPath StorePath
pn

-- | Build paths if they are an actual derivations.
--
-- If derivation output paths are already valid, do nothing.
buildPaths :: StorePathSet -> BuildMode -> MonadStore ()
buildPaths :: StorePathSet -> BuildMode -> MonadStore ()
buildPaths StorePathSet
ps BuildMode
bm = do
  ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   FilePath
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
BuildPaths (Put
 -> ExceptT
      FilePath
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
forall a b. (a -> b) -> a -> b
$ do
    StorePathSet -> Put
putPaths StorePathSet
ps
    Int -> Put
forall a. Integral a => a -> Put
putInt (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ BuildMode -> Int
forall a. Enum a => a -> Int
fromEnum BuildMode
bm

buildDerivation
  :: StorePath
  -> Derivation StorePath Text
  -> BuildMode
  -> MonadStore BuildResult
buildDerivation :: StorePath
-> Derivation StorePath Text -> BuildMode -> MonadStore BuildResult
buildDerivation StorePath
p Derivation StorePath Text
drv BuildMode
buildMode = do
  WorkerOp -> Put -> MonadStore ()
runOpArgs WorkerOp
BuildDerivation (Put -> MonadStore ()) -> Put -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ do
    StorePath -> Put
putPath StorePath
p
    Derivation StorePath Text -> Put
putDerivation Derivation StorePath Text
drv
    BuildMode -> Put
forall a. Enum a => a -> Put
putEnum BuildMode
buildMode
    -- XXX: reason for this is unknown
    -- but without it protocol just hangs waiting for
    -- more data. Needs investigation.
    -- Intentionally the only warning that should pop-up.
    Integer -> Put
forall a. Integral a => a -> Put
putInt (Integer
0 :: Integer)

  BuildResult
res <- Get BuildResult -> MonadStore BuildResult
forall a. Get a -> MonadStore a
getSocketIncremental Get BuildResult
getBuildResult
  BuildResult -> MonadStore BuildResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildResult
res

ensurePath :: StorePath -> MonadStore ()
ensurePath :: StorePath -> MonadStore ()
ensurePath StorePath
pn = do
  ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   FilePath
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
EnsurePath (Put
 -> ExceptT
      FilePath
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
forall a b. (a -> b) -> a -> b
$ StorePath -> Put
putPath StorePath
pn

-- | Find garbage collector roots.
findRoots :: MonadStore (Map ByteString StorePath)
findRoots :: MonadStore (Map ByteString StorePath)
findRoots = do
  WorkerOp -> MonadStore ()
runOp WorkerOp
FindRoots
  FilePath
sd  <- MonadStore FilePath
getStoreDir
  [(ByteString, Either FilePath StorePath)]
res <-
    Get [(ByteString, Either FilePath StorePath)]
-> MonadStore [(ByteString, Either FilePath StorePath)]
forall a. Get a -> MonadStore a
getSocketIncremental
    (Get [(ByteString, Either FilePath StorePath)]
 -> MonadStore [(ByteString, Either FilePath StorePath)])
-> Get [(ByteString, Either FilePath StorePath)]
-> MonadStore [(ByteString, Either FilePath StorePath)]
forall a b. (a -> b) -> a -> b
$ Get (ByteString, Either FilePath StorePath)
-> Get [(ByteString, Either FilePath StorePath)]
forall a. Get a -> Get [a]
getMany
    (Get (ByteString, Either FilePath StorePath)
 -> Get [(ByteString, Either FilePath StorePath)])
-> Get (ByteString, Either FilePath StorePath)
-> Get [(ByteString, Either FilePath StorePath)]
forall a b. (a -> b) -> a -> b
$ (,)
      (ByteString
 -> Either FilePath StorePath
 -> (ByteString, Either FilePath StorePath))
-> Get ByteString
-> Get
     (Either FilePath StorePath
      -> (ByteString, Either FilePath StorePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> ByteString
Data.ByteString.Lazy.fromStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getByteStringLen)
      Get
  (Either FilePath StorePath
   -> (ByteString, Either FilePath StorePath))
-> Get (Either FilePath StorePath)
-> Get (ByteString, Either FilePath StorePath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> Get (Either FilePath StorePath)
getPath FilePath
sd

  [(ByteString, StorePath)]
r <- [(ByteString, Either FilePath StorePath)]
-> MonadStore [(ByteString, StorePath)]
forall a b. [(a, Either FilePath b)] -> MonadStore [(a, b)]
catRights [(ByteString, Either FilePath StorePath)]
res
  Map ByteString StorePath -> MonadStore (Map ByteString StorePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ByteString StorePath -> MonadStore (Map ByteString StorePath))
-> Map ByteString StorePath
-> MonadStore (Map ByteString StorePath)
forall a b. (a -> b) -> a -> b
$ [(ByteString, StorePath)] -> Map ByteString StorePath
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.Strict.fromList [(ByteString, StorePath)]
r
 where
  catRights :: [(a, Either String b)] -> MonadStore [(a, b)]
  catRights :: [(a, Either FilePath b)] -> MonadStore [(a, b)]
catRights = ((a, Either FilePath b)
 -> ExceptT
      FilePath
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      (a, b))
-> [(a, Either FilePath b)] -> MonadStore [(a, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (a, Either FilePath b)
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     (a, b)
forall a b. (a, Either FilePath b) -> MonadStore (a, b)
ex

  ex :: (a, Either [Char] b) -> MonadStore (a, b)
  ex :: (a, Either FilePath b) -> MonadStore (a, b)
ex (a
x , Right b
y) = (a, b) -> MonadStore (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, b
y)
  ex (a
_x, Left FilePath
e ) = FilePath -> MonadStore (a, b)
forall a. HasCallStack => FilePath -> a
error (FilePath -> MonadStore (a, b)) -> FilePath -> MonadStore (a, b)
forall a b. (a -> b) -> a -> b
$ FilePath
"Unable to decode root: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
e

isValidPathUncached :: StorePath -> MonadStore Bool
isValidPathUncached :: StorePath
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
isValidPathUncached StorePath
p = do
  WorkerOp
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
IsValidPath (Put
 -> ExceptT
      FilePath
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
forall a b. (a -> b) -> a -> b
$ StorePath -> Put
putPath StorePath
p

-- | Query valid paths from set, optionally try to use substitutes.
queryValidPaths
  :: StorePathSet   -- ^ Set of `StorePath`s to query
  -> SubstituteFlag -- ^ Try substituting missing paths when `True`
  -> MonadStore StorePathSet
queryValidPaths :: StorePathSet -> Bool -> MonadStore StorePathSet
queryValidPaths StorePathSet
ps Bool
substitute = do
  WorkerOp -> Put -> MonadStore ()
runOpArgs WorkerOp
QueryValidPaths (Put -> MonadStore ()) -> Put -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ do
    StorePathSet -> Put
putPaths StorePathSet
ps
    Bool -> Put
putBool Bool
substitute
  MonadStore StorePathSet
sockGetPaths

queryAllValidPaths :: MonadStore StorePathSet
queryAllValidPaths :: MonadStore StorePathSet
queryAllValidPaths = do
  WorkerOp -> MonadStore ()
runOp WorkerOp
QueryAllValidPaths
  MonadStore StorePathSet
sockGetPaths

querySubstitutablePaths :: StorePathSet -> MonadStore StorePathSet
querySubstitutablePaths :: StorePathSet -> MonadStore StorePathSet
querySubstitutablePaths StorePathSet
ps = do
  WorkerOp -> Put -> MonadStore ()
runOpArgs WorkerOp
QuerySubstitutablePaths (Put -> MonadStore ()) -> Put -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ StorePathSet -> Put
putPaths StorePathSet
ps
  MonadStore StorePathSet
sockGetPaths

queryPathInfoUncached :: StorePath -> MonadStore StorePathMetadata
queryPathInfoUncached :: StorePath -> MonadStore StorePathMetadata
queryPathInfoUncached StorePath
path = do
  WorkerOp -> Put -> MonadStore ()
runOpArgs WorkerOp
QueryPathInfo (Put -> MonadStore ()) -> Put -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ do
    StorePath -> Put
putPath StorePath
path

  Bool
valid <- ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
sockGetBool
  Bool -> MonadStore () -> MonadStore ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
valid (MonadStore () -> MonadStore ()) -> MonadStore () -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ FilePath -> MonadStore ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Path is not valid"

  Maybe StorePath
deriverPath <- MonadStore (Maybe StorePath)
sockGetPathMay

  Text
narHashText <- ByteString -> Text
Data.Text.Encoding.decodeUtf8 (ByteString -> Text)
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     ByteString
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  ByteString
sockGetStr
  let
    narHash :: SomeNamedDigest
narHash =
      case
        BaseEncoding -> Text -> Either FilePath (Digest SHA256)
forall a.
HashAlgorithm a =>
BaseEncoding -> Text -> Either FilePath (Digest a)
decodeDigestWith @SHA256 BaseEncoding
NixBase32 Text
narHashText
        of
        Left  FilePath
e -> FilePath -> SomeNamedDigest
forall a. HasCallStack => FilePath -> a
error FilePath
e
        Right Digest SHA256
x -> Digest SHA256 -> SomeNamedDigest
forall a. NamedAlgo a => Digest a -> SomeNamedDigest
SomeDigest Digest SHA256
x

  StorePathSet
references       <- MonadStore StorePathSet
sockGetPaths
  UTCTime
registrationTime <- Get UTCTime -> MonadStore UTCTime
forall a. Get a -> MonadStore a
sockGet Get UTCTime
getTime
  Maybe Word64
narBytes         <- Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64)
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Word64
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     (Maybe Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Word64
forall a. Integral a => MonadStore a
sockGetInt
  Bool
ultimate         <- ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
sockGetBool

  [Text]
_sigStrings      <- (ByteString -> Text) -> [ByteString] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
bsToText ([ByteString] -> [Text])
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     [ByteString]
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  [ByteString]
sockGetStrings
  ByteString
caString         <- ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  ByteString
sockGetStr

  let
      -- XXX: signatures need pubkey from config
      sigs :: Set a
sigs = Set a
forall a. Set a
Data.Set.empty

      contentAddressableAddress :: Maybe ContentAddressableAddress
contentAddressableAddress =
        case
          ByteString -> Either FilePath ContentAddressableAddress
System.Nix.Store.Remote.Parsers.parseContentAddressableAddress ByteString
caString
          of
          Left  FilePath
e -> FilePath -> Maybe ContentAddressableAddress
forall a. HasCallStack => FilePath -> a
error FilePath
e
          Right ContentAddressableAddress
x -> ContentAddressableAddress -> Maybe ContentAddressableAddress
forall a. a -> Maybe a
Just ContentAddressableAddress
x

      trust :: StorePathTrust
trust = if Bool
ultimate then StorePathTrust
BuiltLocally else StorePathTrust
BuiltElsewhere

  StorePathMetadata -> MonadStore StorePathMetadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StorePathMetadata -> MonadStore StorePathMetadata)
-> StorePathMetadata -> MonadStore StorePathMetadata
forall a b. (a -> b) -> a -> b
$ StorePathMetadata :: StorePath
-> Maybe StorePath
-> SomeNamedDigest
-> StorePathSet
-> UTCTime
-> Maybe Word64
-> StorePathTrust
-> Set NarSignature
-> Maybe ContentAddressableAddress
-> StorePathMetadata
StorePathMetadata{Maybe Word64
Maybe StorePath
Maybe ContentAddressableAddress
Set NarSignature
StorePathTrust
StorePath
SomeNamedDigest
UTCTime
StorePathSet
forall a. Set a
path :: StorePath
deriverPath :: Maybe StorePath
narHash :: SomeNamedDigest
references :: StorePathSet
registrationTime :: UTCTime
narBytes :: Maybe Word64
trust :: StorePathTrust
sigs :: Set NarSignature
contentAddressableAddress :: Maybe ContentAddressableAddress
trust :: StorePathTrust
contentAddressableAddress :: Maybe ContentAddressableAddress
sigs :: forall a. Set a
narBytes :: Maybe Word64
registrationTime :: UTCTime
references :: StorePathSet
narHash :: SomeNamedDigest
deriverPath :: Maybe StorePath
path :: StorePath
..}

queryReferrers :: StorePath -> MonadStore StorePathSet
queryReferrers :: StorePath -> MonadStore StorePathSet
queryReferrers StorePath
p = do
  WorkerOp -> Put -> MonadStore ()
runOpArgs WorkerOp
QueryReferrers (Put -> MonadStore ()) -> Put -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ StorePath -> Put
putPath StorePath
p
  MonadStore StorePathSet
sockGetPaths

queryValidDerivers :: StorePath -> MonadStore StorePathSet
queryValidDerivers :: StorePath -> MonadStore StorePathSet
queryValidDerivers StorePath
p = do
  WorkerOp -> Put -> MonadStore ()
runOpArgs WorkerOp
QueryValidDerivers (Put -> MonadStore ()) -> Put -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ StorePath -> Put
putPath StorePath
p
  MonadStore StorePathSet
sockGetPaths

queryDerivationOutputs :: StorePath -> MonadStore StorePathSet
queryDerivationOutputs :: StorePath -> MonadStore StorePathSet
queryDerivationOutputs StorePath
p = do
  WorkerOp -> Put -> MonadStore ()
runOpArgs WorkerOp
QueryDerivationOutputs (Put -> MonadStore ()) -> Put -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ StorePath -> Put
putPath StorePath
p
  MonadStore StorePathSet
sockGetPaths

queryDerivationOutputNames :: StorePath -> MonadStore StorePathSet
queryDerivationOutputNames :: StorePath -> MonadStore StorePathSet
queryDerivationOutputNames StorePath
p = do
  WorkerOp -> Put -> MonadStore ()
runOpArgs WorkerOp
QueryDerivationOutputNames (Put -> MonadStore ()) -> Put -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ StorePath -> Put
putPath StorePath
p
  MonadStore StorePathSet
sockGetPaths

queryPathFromHashPart :: StorePathHashPart -> MonadStore StorePath
queryPathFromHashPart :: StorePathHashPart -> MonadStore StorePath
queryPathFromHashPart StorePathHashPart
storePathHash = do
  WorkerOp -> Put -> MonadStore ()
runOpArgs WorkerOp
QueryPathFromHashPart
    (Put -> MonadStore ()) -> Put -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putByteStringLen
    (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Data.ByteString.Lazy.fromStrict
    (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Data.Text.Encoding.encodeUtf8
    (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ BaseEncoding -> ByteString -> Text
encodeWith BaseEncoding
NixBase32 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ StorePathHashPart -> ByteString
coerce StorePathHashPart
storePathHash
  MonadStore StorePath
sockGetPath

queryMissing
  :: StorePathSet
  -> MonadStore
      ( StorePathSet-- Paths that will be built
      , StorePathSet -- Paths that have substitutes
      , StorePathSet -- Unknown paths
      , Integer            -- Download size
      , Integer            -- Nar size?
      )
queryMissing :: StorePathSet
-> MonadStore
     (StorePathSet, StorePathSet, StorePathSet, Integer, Integer)
queryMissing StorePathSet
ps = do
  WorkerOp -> Put -> MonadStore ()
runOpArgs WorkerOp
QueryMissing (Put -> MonadStore ()) -> Put -> MonadStore ()
forall a b. (a -> b) -> a -> b
$ StorePathSet -> Put
putPaths StorePathSet
ps

  StorePathSet
willBuild      <- MonadStore StorePathSet
sockGetPaths
  StorePathSet
willSubstitute <- MonadStore StorePathSet
sockGetPaths
  StorePathSet
unknown        <- MonadStore StorePathSet
sockGetPaths
  Integer
downloadSize'  <- MonadStore Integer
forall a. Integral a => MonadStore a
sockGetInt
  Integer
narSize'       <- MonadStore Integer
forall a. Integral a => MonadStore a
sockGetInt
  (StorePathSet, StorePathSet, StorePathSet, Integer, Integer)
-> MonadStore
     (StorePathSet, StorePathSet, StorePathSet, Integer, Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StorePathSet
willBuild, StorePathSet
willSubstitute, StorePathSet
unknown, Integer
downloadSize', Integer
narSize')

optimiseStore :: MonadStore ()
optimiseStore :: MonadStore ()
optimiseStore = ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   FilePath
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOp WorkerOp
OptimiseStore

syncWithGC :: MonadStore ()
syncWithGC :: MonadStore ()
syncWithGC = ExceptT
  FilePath
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   FilePath
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOp WorkerOp
SyncWithGC

-- returns True on errors
verifyStore :: CheckFlag -> RepairFlag -> MonadStore Bool
verifyStore :: Bool
-> Bool
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
verifyStore Bool
check Bool
repair = WorkerOp
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
VerifyStore (Put
 -> ExceptT
      FilePath
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     FilePath
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
forall a b. (a -> b) -> a -> b
$ do
  Bool -> Put
putBool Bool
check
  Bool -> Put
putBool Bool
repair