{-# 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 :: 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
$ 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
    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
  String
sd  <- MonadStore String
getStoreDir
  [(ByteString, Either String StorePath)]
res <-
    Get [(ByteString, Either String StorePath)]
-> MonadStore [(ByteString, Either String StorePath)]
forall a. Get a -> MonadStore a
getSocketIncremental
    (Get [(ByteString, Either String StorePath)]
 -> MonadStore [(ByteString, Either String StorePath)])
-> Get [(ByteString, Either String StorePath)]
-> MonadStore [(ByteString, Either String StorePath)]
forall a b. (a -> b) -> a -> b
$ Get (ByteString, Either String StorePath)
-> Get [(ByteString, Either String StorePath)]
forall a. Get a -> Get [a]
getMany
    (Get (ByteString, Either String StorePath)
 -> Get [(ByteString, Either String StorePath)])
-> Get (ByteString, Either String StorePath)
-> Get [(ByteString, Either String StorePath)]
forall a b. (a -> b) -> a -> b
$ (,)
      (ByteString
 -> Either String StorePath
 -> (ByteString, Either String StorePath))
-> Get ByteString
-> Get
     (Either String StorePath -> (ByteString, Either String StorePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> ByteString
forall l s. LazyStrict l s => s -> l
fromStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getByteStringLen)
      Get
  (Either String StorePath -> (ByteString, Either String StorePath))
-> Get (Either String StorePath)
-> Get (ByteString, Either String StorePath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Get (Either String StorePath)
getPath String
sd

  [(ByteString, StorePath)]
r <- [(ByteString, Either String StorePath)]
-> MonadStore [(ByteString, StorePath)]
forall a b. [(a, Either String b)] -> MonadStore [(a, b)]
catRights [(ByteString, Either String 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 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)] -> MonadStore [(a, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 :: (a, Either String 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 String
e ) = Text -> MonadStore (a, b)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> MonadStore (a, b)) -> Text -> MonadStore (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

  Bool
valid <- ExceptT
  String
  (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
$ Text -> MonadStore ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Path is not valid"

  Maybe StorePath
deriverPath <- MonadStore (Maybe StorePath)
sockGetPathMay

  Text
narHashText <- ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     ByteString
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  String
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  ByteString
sockGetStr
  let
    narHash :: SomeNamedDigest
narHash =
      case
        BaseEncoding -> Text -> Either String (Digest SHA256)
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

  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
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     Word64
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     (Maybe Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  String
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  Word64
forall a. Integral a => MonadStore a
sockGetInt
  Bool
ultimate         <- ExceptT
  String
  (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
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     [ByteString]
-> ExceptT
     String
     (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
     [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  String
  (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
  [ByteString]
sockGetStrings
  ByteString
caString         <- ExceptT
  String
  (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 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 :: 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
StorePathSet
UTCTime
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
$ 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
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
  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