{-# language AllowAmbiguousTypes #-}
{-# language KindSignatures      #-}
{-# language RankNTypes          #-}
{-# language ScopedTypeVariables #-}
{-# language DataKinds           #-}
{-# language RecordWildCards     #-}
{-# language LiberalTypeSynonyms #-}

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           Prelude                 hiding ( putText )
import qualified Data.ByteString.Lazy          as BSL

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.Map.Strict
import qualified Data.Set

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           System.Nix.Nar                 ( NarSource )

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

-- | Pack `Nar` and add it to the store.
addToStore
  :: forall a
   . (NamedAlgo a)
  => StorePathName        -- ^ Name part of the newly created `StorePath`
  -> NarSource MonadStore -- ^ provide nar stream
  -> Bool                 -- ^ Add target directory recursively
  -> RepairFlag           -- ^ Only used by local store backend
  -> MonadStore StorePath
addToStore :: forall a.
NamedAlgo a =>
StorePathName
-> NarSource MonadStore -> Bool -> Bool -> MonadStore StorePath
addToStore StorePathName
name NarSource MonadStore
source Bool
recursive Bool
_repair = do
  WorkerOp -> NarSource MonadStore -> MonadStore ()
runOpArgsIO WorkerOp
AddToStore (NarSource MonadStore -> MonadStore ())
-> NarSource 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
forall l s. LazyStrict l s => l -> s
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
$ 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
$ forall a. NamedAlgo a => Text
System.Nix.Hash.algoName @a
    NarSource MonadStore
source ByteString -> MonadStore ()
yield
  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
$ Text -> MonadStore ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"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 -> [BSL.ByteString] -> MonadStore ()
addSignatures :: StorePath -> [ByteString] -> MonadStore ()
addSignatures StorePath
p [ByteString]
signatures = do
  ExceptT
  String
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   String
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> Put
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
AddSignatures (Put
 -> ExceptT
      String
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     String
     (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
  String
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   String
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> Put
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
AddIndirectRoot (Put
 -> ExceptT
      String
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     String
     (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
  String
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   String
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> Put
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
AddTempRoot (Put
 -> ExceptT
      String
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     String
     (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
  String
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   String
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> Put
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
BuildPaths (Put
 -> ExceptT
      String
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     String
     (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)

  Get BuildResult -> MonadStore BuildResult
forall a. Get a -> MonadStore a
getSocketIncremental Get BuildResult
getBuildResult

ensurePath :: StorePath -> MonadStore ()
ensurePath :: StorePath -> MonadStore ()
ensurePath StorePath
pn = do
  ExceptT
  String
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
-> MonadStore ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   String
   (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
   Bool
 -> MonadStore ())
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
-> MonadStore ()
forall a b. (a -> b) -> a -> b
$ WorkerOp
-> Put
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
EnsurePath (Put
 -> ExceptT
      String
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     String
     (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 BSL.ByteString StorePath)
findRoots :: MonadStore (Map ByteString StorePath)
findRoots = do
  WorkerOp -> MonadStore ()
runOp WorkerOp
FindRoots
  sd  <- MonadStore String
getStoreDir
  res <-
    getSocketIncremental
    $ getMany
    $ (,)
      <$> (fromStrict <$> getByteStringLen)
      <*> getPath sd

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

  ex :: (a, Either [Char] b) -> MonadStore (a, b)
  ex :: forall a b. (a, Either String b) -> MonadStore (a, b)
ex (a
x , Right b
y) = (a, b)
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     (a, b)
forall a.
a
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, b
y)
  ex (a
_x, Left String
e ) = Text
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     (a, b)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text
 -> ExceptT
      String
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      (a, b))
-> Text
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     (a, b)
forall a b. (a -> b) -> a -> b
$ Text
"Unable to decode root: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString String
e

isValidPathUncached :: StorePath -> MonadStore Bool
isValidPathUncached :: StorePath
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
isValidPathUncached StorePath
p = do
  WorkerOp
-> Put
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
IsValidPath (Put
 -> ExceptT
      String
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     String
     (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

  valid <- ExceptT
  String
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Bool
sockGetBool
  unless valid $ error "Path is not valid"

  deriverPath <- sockGetPathMay

  narHashText <- decodeUtf8 <$> sockGetStr
  let
    narHash =
      case
        forall a.
HashAlgorithm a =>
BaseEncoding -> Text -> Either String (Digest a)
decodeDigestWith @SHA256 BaseEncoding
NixBase32 Text
narHashText
        of
        Left  String
e -> Text -> SomeNamedDigest
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> SomeNamedDigest) -> Text -> SomeNamedDigest
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
e
        Right Digest SHA256
x -> Digest SHA256 -> SomeNamedDigest
forall a. NamedAlgo a => Digest a -> SomeNamedDigest
SomeDigest Digest SHA256
x

  references       <- sockGetPaths
  registrationTime <- sockGet getTime
  narBytes         <- Just <$> sockGetInt
  ultimate         <- sockGetBool

  _sigStrings      <- fmap bsToText <$> sockGetStrings
  caString         <- sockGetStr

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

      contentAddressableAddress =
        case
          ByteString -> Either String ContentAddressableAddress
System.Nix.Store.Remote.Parsers.parseContentAddressableAddress ByteString
caString
          of
          Left  String
e -> Text -> Maybe ContentAddressableAddress
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Maybe ContentAddressableAddress)
-> Text -> Maybe ContentAddressableAddress
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
e
          Right ContentAddressableAddress
x -> ContentAddressableAddress -> Maybe ContentAddressableAddress
forall a. a -> Maybe a
Just ContentAddressableAddress
x

      trust = if Bool
ultimate then StorePathTrust
BuiltLocally else StorePathTrust
BuiltElsewhere

  pure $ StorePathMetadata{..}

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
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (BaseEncoding -> ByteString -> Text
encodeWith BaseEncoding
NixBase32 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ StorePathHashPart -> ByteString
forall a b. Coercible a b => a -> b
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

  willBuild      <- MonadStore StorePathSet
sockGetPaths
  willSubstitute <- sockGetPaths
  unknown        <- sockGetPaths
  downloadSize'  <- sockGetInt
  narSize'       <- sockGetInt
  pure (willBuild, willSubstitute, unknown, downloadSize', narSize')

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

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

-- returns True on errors
verifyStore :: CheckFlag -> RepairFlag -> MonadStore Bool
verifyStore :: Bool
-> Bool
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
verifyStore Bool
check Bool
repair = WorkerOp
-> Put
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Bool
simpleOpArgs WorkerOp
VerifyStore (Put
 -> ExceptT
      String
      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
      Bool)
-> Put
-> ExceptT
     String
     (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