{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TemplateHaskell #-}

module System.Nix.Store.Remote.Types.StoreRequest
  ( StoreRequest(..)
  ) where

import Data.GADT.Compare.TH (deriveGEq, deriveGCompare)
import Data.GADT.Show.TH (deriveGShow)
import Data.HashSet (HashSet)
import Data.Kind (Type)
import Data.Map (Map)
import Data.Set (Set)
import Data.Text (Text)
import Data.Some (Some(Some))

import System.Nix.Build (BuildMode, BuildResult)
import System.Nix.Derivation (Derivation)
import System.Nix.DerivedPath (DerivedPath)
import System.Nix.Hash (HashAlgo)
import System.Nix.Signature (Signature)
import System.Nix.Store.Types (FileIngestionMethod, RepairMode)
import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart)
import System.Nix.StorePath.Metadata (Metadata)
import System.Nix.Store.Remote.Types.GC (GCOptions, GCResult, GCRoot)
import System.Nix.Store.Remote.Types.CheckMode (CheckMode)
import System.Nix.Store.Remote.Types.NoReply (NoReply)
import System.Nix.Store.Remote.Types.Query.Missing (Missing)
import System.Nix.Store.Remote.Types.StoreText (StoreText)
import System.Nix.Store.Remote.Types.SubstituteMode (SubstituteMode)
import System.Nix.Store.Remote.Types.SuccessCodeReply (SuccessCodeReply)

data StoreRequest :: Type -> Type where
  -- | Add @NarSource@ to the store.
  AddToStore
    :: StorePathName -- ^ Name part of the newly created @StorePath@
    -> FileIngestionMethod -- ^ Add target directory recursively
    -> Some HashAlgo -- ^ Nar hashing algorithm
    -> RepairMode -- ^ Only used by local store backend
    -> StoreRequest StorePath

  -- | Add a NAR with Metadata to the store.
  AddToStoreNar
    :: StorePath
    -> Metadata StorePath
    -> RepairMode
    -> CheckMode -- ^ Whether to check signatures
    -> StoreRequest NoReply

  -- | Add text to store.
  --
  -- Reference accepts repair but only uses it
  -- to throw error in case of remote talking to nix-daemon.
  AddTextToStore
    :: StoreText
    -> HashSet StorePath -- ^ Set of @StorePath@s that the added text references
    -> RepairMode -- ^ Repair mode, must be @RepairMode_DontRepair@ in case of remote backend
    -> StoreRequest StorePath

  AddSignatures
    :: StorePath
    -> Set Signature
    -> StoreRequest SuccessCodeReply

  AddIndirectRoot
    :: StorePath
    -> StoreRequest SuccessCodeReply

  -- | Add temporary garbage collector root.
  --
  -- This root is removed as soon as the client exits.
  AddTempRoot
    :: StorePath
    -> StoreRequest SuccessCodeReply

  -- | Build paths if they are an actual derivations.
  --
  -- If derivation output paths are already valid, do nothing.
  BuildPaths
    :: Set DerivedPath
    -> BuildMode
    -> StoreRequest SuccessCodeReply

  BuildDerivation
    :: StorePath
    -> Derivation StorePath Text
    -> BuildMode
    -> StoreRequest BuildResult

  CollectGarbage
    :: GCOptions
    -> StoreRequest GCResult

  EnsurePath
    :: StorePath
    -> StoreRequest SuccessCodeReply

  -- | Find garbage collector roots.
  FindRoots
    :: StoreRequest (Map GCRoot StorePath)

  IsValidPath
    :: StorePath
    -> StoreRequest Bool

  -- | Fetch a NAR from the server
  NarFromPath
    :: StorePath
    -> StoreRequest NoReply

  -- | Query valid paths from set, optionally try to use substitutes.
  QueryValidPaths
    :: HashSet StorePath
    -- ^ Set of @StorePath@s to query
    -> SubstituteMode
    -- ^ Try substituting missing paths when @SubstituteMode_DoSubstitute@
    -> StoreRequest (HashSet StorePath)

  QueryAllValidPaths
    :: StoreRequest (HashSet StorePath)

  QuerySubstitutablePaths
    :: HashSet StorePath
    -> StoreRequest (HashSet StorePath)

  QueryPathInfo
    :: StorePath
    -> StoreRequest (Maybe (Metadata StorePath))

  QueryReferrers
    :: StorePath
    -> StoreRequest (HashSet StorePath)

  QueryValidDerivers
    :: StorePath
    -> StoreRequest (HashSet StorePath)

  QueryDerivationOutputs
    :: StorePath
    -> StoreRequest (HashSet StorePath)

  QueryDerivationOutputNames
    :: StorePath
    -> StoreRequest (HashSet StorePathName)

  QueryPathFromHashPart
    :: StorePathHashPart
    -> StoreRequest StorePath

  QueryMissing
    :: Set DerivedPath
    -> StoreRequest Missing

  OptimiseStore
    :: StoreRequest SuccessCodeReply

  SyncWithGC
    :: StoreRequest SuccessCodeReply

  -- returns True on errors
  VerifyStore
    :: CheckMode
    -> RepairMode
    -> StoreRequest Bool

deriving instance Eq (StoreRequest a)
deriving instance Show (StoreRequest a)

deriveGEq ''StoreRequest
deriveGCompare ''StoreRequest
deriveGShow ''StoreRequest

instance {-# OVERLAPPING #-} Eq (Some StoreRequest) where
  Some (AddToStore StorePathName
a FileIngestionMethod
b Some HashAlgo
c RepairMode
d) == :: Some StoreRequest -> Some StoreRequest -> Bool
== Some (AddToStore StorePathName
a' FileIngestionMethod
b' Some HashAlgo
c' RepairMode
d') = (StorePathName
a, FileIngestionMethod
b, Some HashAlgo
c, RepairMode
d) (StorePathName, FileIngestionMethod, Some HashAlgo, RepairMode)
-> (StorePathName, FileIngestionMethod, Some HashAlgo, RepairMode)
-> Bool
forall a. Eq a => a -> a -> Bool
== (StorePathName
a', FileIngestionMethod
b', Some HashAlgo
c', RepairMode
d')
  Some (AddToStoreNar StorePath
a Metadata StorePath
b RepairMode
c CheckMode
d) == Some (AddToStoreNar StorePath
a' Metadata StorePath
b' RepairMode
c' CheckMode
d') = (StorePath
a, Metadata StorePath
b, RepairMode
c, CheckMode
d) (StorePath, Metadata StorePath, RepairMode, CheckMode)
-> (StorePath, Metadata StorePath, RepairMode, CheckMode) -> Bool
forall a. Eq a => a -> a -> Bool
== (StorePath
a', Metadata StorePath
b', RepairMode
c', CheckMode
d')
  Some (AddTextToStore StoreText
a HashSet StorePath
b RepairMode
c) == Some (AddTextToStore StoreText
a' HashSet StorePath
b' RepairMode
c') = (StoreText
a, HashSet StorePath
b, RepairMode
c) (StoreText, HashSet StorePath, RepairMode)
-> (StoreText, HashSet StorePath, RepairMode) -> Bool
forall a. Eq a => a -> a -> Bool
== (StoreText
a', HashSet StorePath
b', RepairMode
c')
  Some (AddSignatures StorePath
a Set Signature
b) == Some (AddSignatures StorePath
a' Set Signature
b') = (StorePath
a, Set Signature
b) (StorePath, Set Signature) -> (StorePath, Set Signature) -> Bool
forall a. Eq a => a -> a -> Bool
== (StorePath
a', Set Signature
b')
  Some (AddIndirectRoot StorePath
a) == Some (AddIndirectRoot StorePath
a') = StorePath
a StorePath -> StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath
a'
  Some (AddTempRoot StorePath
a) == Some (AddTempRoot StorePath
a') = StorePath
a StorePath -> StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath
a'
  Some (BuildPaths Set DerivedPath
a BuildMode
b) == Some (BuildPaths Set DerivedPath
a' BuildMode
b') = (Set DerivedPath
a, BuildMode
b) (Set DerivedPath, BuildMode)
-> (Set DerivedPath, BuildMode) -> Bool
forall a. Eq a => a -> a -> Bool
== (Set DerivedPath
a', BuildMode
b')
  Some (BuildDerivation StorePath
a Derivation StorePath Text
b BuildMode
c) == Some (BuildDerivation StorePath
a' Derivation StorePath Text
b' BuildMode
c') = (StorePath
a, Derivation StorePath Text
b, BuildMode
c) (StorePath, Derivation StorePath Text, BuildMode)
-> (StorePath, Derivation StorePath Text, BuildMode) -> Bool
forall a. Eq a => a -> a -> Bool
== (StorePath
a', Derivation StorePath Text
b', BuildMode
c')
  Some (CollectGarbage GCOptions
a) == Some (CollectGarbage GCOptions
a') = GCOptions
a GCOptions -> GCOptions -> Bool
forall a. Eq a => a -> a -> Bool
== GCOptions
a'
  Some (EnsurePath StorePath
a) == Some (EnsurePath StorePath
a') = StorePath
a StorePath -> StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath
a'
  Some (StoreRequest a
FindRoots) == Some (StoreRequest a
FindRoots) = Bool
True
  Some (IsValidPath StorePath
a) == Some (IsValidPath StorePath
a') = StorePath
a StorePath -> StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath
a'
  Some (NarFromPath StorePath
a) == Some (NarFromPath StorePath
a') = StorePath
a StorePath -> StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath
a'
  Some (QueryValidPaths HashSet StorePath
a SubstituteMode
b) == Some (QueryValidPaths HashSet StorePath
a' SubstituteMode
b') = (HashSet StorePath
a, SubstituteMode
b) (HashSet StorePath, SubstituteMode)
-> (HashSet StorePath, SubstituteMode) -> Bool
forall a. Eq a => a -> a -> Bool
== (HashSet StorePath
a', SubstituteMode
b')
  Some StoreRequest a
QueryAllValidPaths == Some StoreRequest a
QueryAllValidPaths = Bool
True
  Some (QuerySubstitutablePaths HashSet StorePath
a) == Some (QuerySubstitutablePaths HashSet StorePath
a') = HashSet StorePath
a HashSet StorePath -> HashSet StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== HashSet StorePath
a'
  Some (QueryPathInfo StorePath
a) == Some (QueryPathInfo StorePath
a') = StorePath
a StorePath -> StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath
a'
  Some (QueryReferrers StorePath
a) == Some (QueryReferrers StorePath
a') = StorePath
a StorePath -> StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath
a'
  Some (QueryValidDerivers StorePath
a) == Some (QueryValidDerivers StorePath
a') = StorePath
a StorePath -> StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath
a'
  Some (QueryDerivationOutputs StorePath
a) == Some (QueryDerivationOutputs StorePath
a') = StorePath
a StorePath -> StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath
a'
  Some (QueryDerivationOutputNames StorePath
a) == Some (QueryDerivationOutputNames StorePath
a') = StorePath
a StorePath -> StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath
a'
  Some (QueryPathFromHashPart StorePathHashPart
a) == Some (QueryPathFromHashPart StorePathHashPart
a') = StorePathHashPart
a StorePathHashPart -> StorePathHashPart -> Bool
forall a. Eq a => a -> a -> Bool
== StorePathHashPart
a'
  Some (QueryMissing Set DerivedPath
a) == Some (QueryMissing Set DerivedPath
a') = Set DerivedPath
a Set DerivedPath -> Set DerivedPath -> Bool
forall a. Eq a => a -> a -> Bool
== Set DerivedPath
a'
  Some StoreRequest a
OptimiseStore == Some StoreRequest a
OptimiseStore = Bool
True
  Some StoreRequest a
SyncWithGC == Some StoreRequest a
SyncWithGC = Bool
True
  Some (VerifyStore CheckMode
a RepairMode
b) == Some (VerifyStore CheckMode
a' RepairMode
b') = (CheckMode
a, RepairMode
b) (CheckMode, RepairMode) -> (CheckMode, RepairMode) -> Bool
forall a. Eq a => a -> a -> Bool
== (CheckMode
a', RepairMode
b')

  Some StoreRequest
_ == Some StoreRequest
_ = Bool
False