-- due to recent generic-arbitrary
{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module System.Nix.Store.Remote.Arbitrary where

import Data.Some (Some(Some))
import System.Nix.Arbitrary ()
import System.Nix.Store.Types (RepairMode(..))
import System.Nix.Store.Remote.Types

import Test.QuickCheck (Arbitrary(..), oneof, suchThat)
import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))

deriving via GenericArbitrary CheckMode
  instance Arbitrary CheckMode

deriving via GenericArbitrary SubstituteMode
  instance Arbitrary SubstituteMode

deriving via GenericArbitrary ProtoStoreConfig
  instance Arbitrary ProtoStoreConfig

deriving via GenericArbitrary ProtoVersion
  instance Arbitrary ProtoVersion

deriving via GenericArbitrary StoreText
  instance Arbitrary StoreText

-- * Logger

deriving via GenericArbitrary Activity
  instance Arbitrary Activity

deriving via GenericArbitrary ActivityID
  instance Arbitrary ActivityID

deriving via GenericArbitrary ActivityResult
  instance Arbitrary ActivityResult

deriving via GenericArbitrary Field
  instance Arbitrary Field

instance Arbitrary Trace where
  arbitrary :: Gen Trace
arbitrary = do
    -- we encode 0 position as Nothing
    Maybe Int
tracePosition <- Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe Int) -> (Maybe Int -> Bool) -> Gen (Maybe Int)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
    Text
traceHint <- Gen Text
forall a. Arbitrary a => Gen a
arbitrary

    Trace -> Gen Trace
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Trace{Maybe Int
Text
tracePosition :: Maybe Int
traceHint :: Text
tracePosition :: Maybe Int
traceHint :: Text
..}

deriving via GenericArbitrary BasicError
  instance Arbitrary BasicError

instance Arbitrary ErrorInfo where
  arbitrary :: Gen ErrorInfo
arbitrary = do
    Verbosity
errorInfoLevel <- Gen Verbosity
forall a. Arbitrary a => Gen a
arbitrary
    Text
errorInfoMessage <- Gen Text
forall a. Arbitrary a => Gen a
arbitrary
    -- we encode 0 position as Nothing
    Maybe Int
errorInfoPosition <- Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe Int) -> (Maybe Int -> Bool) -> Gen (Maybe Int)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
    [Trace]
errorInfoTraces <- Gen [Trace]
forall a. Arbitrary a => Gen a
arbitrary

    ErrorInfo -> Gen ErrorInfo
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorInfo{[Trace]
Maybe Int
Text
Verbosity
errorInfoLevel :: Verbosity
errorInfoMessage :: Text
errorInfoPosition :: Maybe Int
errorInfoTraces :: [Trace]
errorInfoLevel :: Verbosity
errorInfoMessage :: Text
errorInfoPosition :: Maybe Int
errorInfoTraces :: [Trace]
..}

deriving via GenericArbitrary LoggerOpCode
  instance Arbitrary LoggerOpCode

deriving via GenericArbitrary Logger
  instance Arbitrary Logger

deriving via GenericArbitrary Verbosity
  instance Arbitrary Verbosity

-- * GC

deriving via GenericArbitrary GCAction
  instance Arbitrary GCAction

deriving via GenericArbitrary GCOptions
  instance Arbitrary GCOptions

-- * Handshake

deriving via GenericArbitrary WorkerMagic
  instance Arbitrary WorkerMagic

deriving via GenericArbitrary TrustedFlag
  instance Arbitrary TrustedFlag

-- * Worker protocol

deriving via GenericArbitrary WorkerOp
  instance Arbitrary WorkerOp

-- ** Request

instance Arbitrary (Some StoreRequest) where
  arbitrary :: Gen (Some StoreRequest)
arbitrary = [Gen (Some StoreRequest)] -> Gen (Some StoreRequest)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ StoreRequest StorePath -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest StorePath -> Some StoreRequest)
-> Gen (StoreRequest StorePath) -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StorePathName
-> FileIngestionMethod
-> Some HashAlgo
-> RepairMode
-> StoreRequest StorePath
AddToStore (StorePathName
 -> FileIngestionMethod
 -> Some HashAlgo
 -> RepairMode
 -> StoreRequest StorePath)
-> Gen StorePathName
-> Gen
     (FileIngestionMethod
      -> Some HashAlgo -> RepairMode -> StoreRequest StorePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePathName
forall a. Arbitrary a => Gen a
arbitrary Gen
  (FileIngestionMethod
   -> Some HashAlgo -> RepairMode -> StoreRequest StorePath)
-> Gen FileIngestionMethod
-> Gen (Some HashAlgo -> RepairMode -> StoreRequest StorePath)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen FileIngestionMethod
forall a. Arbitrary a => Gen a
arbitrary Gen (Some HashAlgo -> RepairMode -> StoreRequest StorePath)
-> Gen (Some HashAlgo)
-> Gen (RepairMode -> StoreRequest StorePath)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Some HashAlgo)
forall a. Arbitrary a => Gen a
arbitrary Gen (RepairMode -> StoreRequest StorePath)
-> Gen RepairMode -> Gen (StoreRequest StorePath)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RepairMode -> Gen RepairMode
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepairMode
RepairMode_DontRepair)
    , StoreRequest StorePath -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest StorePath -> Some StoreRequest)
-> Gen (StoreRequest StorePath) -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StoreText
-> HashSet StorePath -> RepairMode -> StoreRequest StorePath
AddTextToStore (StoreText
 -> HashSet StorePath -> RepairMode -> StoreRequest StorePath)
-> Gen StoreText
-> Gen (HashSet StorePath -> RepairMode -> StoreRequest StorePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StoreText
forall a. Arbitrary a => Gen a
arbitrary Gen (HashSet StorePath -> RepairMode -> StoreRequest StorePath)
-> Gen (HashSet StorePath)
-> Gen (RepairMode -> StoreRequest StorePath)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (HashSet StorePath)
forall a. Arbitrary a => Gen a
arbitrary Gen (RepairMode -> StoreRequest StorePath)
-> Gen RepairMode -> Gen (StoreRequest StorePath)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RepairMode -> Gen RepairMode
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepairMode
RepairMode_DontRepair)
    , StoreRequest SuccessCodeReply -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest SuccessCodeReply -> Some StoreRequest)
-> Gen (StoreRequest SuccessCodeReply) -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StorePath -> Set Signature -> StoreRequest SuccessCodeReply
AddSignatures (StorePath -> Set Signature -> StoreRequest SuccessCodeReply)
-> Gen StorePath
-> Gen (Set Signature -> StoreRequest SuccessCodeReply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary Gen (Set Signature -> StoreRequest SuccessCodeReply)
-> Gen (Set Signature) -> Gen (StoreRequest SuccessCodeReply)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Set Signature)
forall a. Arbitrary a => Gen a
arbitrary)
    , StoreRequest SuccessCodeReply -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest SuccessCodeReply -> Some StoreRequest)
-> (StorePath -> StoreRequest SuccessCodeReply)
-> StorePath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> StoreRequest SuccessCodeReply
AddIndirectRoot  (StorePath -> Some StoreRequest)
-> Gen StorePath -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest SuccessCodeReply -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest SuccessCodeReply -> Some StoreRequest)
-> (StorePath -> StoreRequest SuccessCodeReply)
-> StorePath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> StoreRequest SuccessCodeReply
AddTempRoot (StorePath -> Some StoreRequest)
-> Gen StorePath -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest SuccessCodeReply -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest SuccessCodeReply -> Some StoreRequest)
-> Gen (StoreRequest SuccessCodeReply) -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set DerivedPath -> BuildMode -> StoreRequest SuccessCodeReply
BuildPaths (Set DerivedPath -> BuildMode -> StoreRequest SuccessCodeReply)
-> Gen (Set DerivedPath)
-> Gen (BuildMode -> StoreRequest SuccessCodeReply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set DerivedPath)
forall a. Arbitrary a => Gen a
arbitrary Gen (BuildMode -> StoreRequest SuccessCodeReply)
-> Gen BuildMode -> Gen (StoreRequest SuccessCodeReply)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen BuildMode
forall a. Arbitrary a => Gen a
arbitrary)
    , StoreRequest BuildResult -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest BuildResult -> Some StoreRequest)
-> Gen (StoreRequest BuildResult) -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StorePath
-> Derivation StorePath Text
-> BuildMode
-> StoreRequest BuildResult
BuildDerivation (StorePath
 -> Derivation StorePath Text
 -> BuildMode
 -> StoreRequest BuildResult)
-> Gen StorePath
-> Gen
     (Derivation StorePath Text
      -> BuildMode -> StoreRequest BuildResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary Gen
  (Derivation StorePath Text
   -> BuildMode -> StoreRequest BuildResult)
-> Gen (Derivation StorePath Text)
-> Gen (BuildMode -> StoreRequest BuildResult)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Derivation StorePath Text)
forall a. Arbitrary a => Gen a
arbitrary Gen (BuildMode -> StoreRequest BuildResult)
-> Gen BuildMode -> Gen (StoreRequest BuildResult)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen BuildMode
forall a. Arbitrary a => Gen a
arbitrary)
    , StoreRequest GCResult -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest GCResult -> Some StoreRequest)
-> (GCOptions -> StoreRequest GCResult)
-> GCOptions
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCOptions -> StoreRequest GCResult
CollectGarbage (GCOptions -> Some StoreRequest)
-> Gen GCOptions -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen GCOptions
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest SuccessCodeReply -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest SuccessCodeReply -> Some StoreRequest)
-> (StorePath -> StoreRequest SuccessCodeReply)
-> StorePath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> StoreRequest SuccessCodeReply
EnsurePath (StorePath -> Some StoreRequest)
-> Gen StorePath -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary
    , Some StoreRequest -> Gen (Some StoreRequest)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Some StoreRequest -> Gen (Some StoreRequest))
-> Some StoreRequest -> Gen (Some StoreRequest)
forall a b. (a -> b) -> a -> b
$ StoreRequest (Map GCRoot StorePath) -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some StoreRequest (Map GCRoot StorePath)
FindRoots
    , StoreRequest Bool -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest Bool -> Some StoreRequest)
-> (StorePath -> StoreRequest Bool)
-> StorePath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> StoreRequest Bool
IsValidPath (StorePath -> Some StoreRequest)
-> Gen StorePath -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest NoReply -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest NoReply -> Some StoreRequest)
-> (StorePath -> StoreRequest NoReply)
-> StorePath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> StoreRequest NoReply
NarFromPath (StorePath -> Some StoreRequest)
-> Gen StorePath -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest (HashSet StorePath) -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest (HashSet StorePath) -> Some StoreRequest)
-> Gen (StoreRequest (HashSet StorePath))
-> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashSet StorePath
-> SubstituteMode -> StoreRequest (HashSet StorePath)
QueryValidPaths (HashSet StorePath
 -> SubstituteMode -> StoreRequest (HashSet StorePath))
-> Gen (HashSet StorePath)
-> Gen (SubstituteMode -> StoreRequest (HashSet StorePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (HashSet StorePath)
forall a. Arbitrary a => Gen a
arbitrary Gen (SubstituteMode -> StoreRequest (HashSet StorePath))
-> Gen SubstituteMode -> Gen (StoreRequest (HashSet StorePath))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SubstituteMode
forall a. Arbitrary a => Gen a
arbitrary)
    , Some StoreRequest -> Gen (Some StoreRequest)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Some StoreRequest -> Gen (Some StoreRequest))
-> Some StoreRequest -> Gen (Some StoreRequest)
forall a b. (a -> b) -> a -> b
$ StoreRequest (HashSet StorePath) -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some StoreRequest (HashSet StorePath)
QueryAllValidPaths
    , StoreRequest (HashSet StorePath) -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest (HashSet StorePath) -> Some StoreRequest)
-> (HashSet StorePath -> StoreRequest (HashSet StorePath))
-> HashSet StorePath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet StorePath -> StoreRequest (HashSet StorePath)
QuerySubstitutablePaths (HashSet StorePath -> Some StoreRequest)
-> Gen (HashSet StorePath) -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (HashSet StorePath)
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest (Maybe (Metadata StorePath)) -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest (Maybe (Metadata StorePath)) -> Some StoreRequest)
-> (StorePath -> StoreRequest (Maybe (Metadata StorePath)))
-> StorePath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> StoreRequest (Maybe (Metadata StorePath))
QueryPathInfo (StorePath -> Some StoreRequest)
-> Gen StorePath -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest (HashSet StorePath) -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest (HashSet StorePath) -> Some StoreRequest)
-> (StorePath -> StoreRequest (HashSet StorePath))
-> StorePath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> StoreRequest (HashSet StorePath)
QueryReferrers (StorePath -> Some StoreRequest)
-> Gen StorePath -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest (HashSet StorePath) -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest (HashSet StorePath) -> Some StoreRequest)
-> (StorePath -> StoreRequest (HashSet StorePath))
-> StorePath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> StoreRequest (HashSet StorePath)
QueryValidDerivers (StorePath -> Some StoreRequest)
-> Gen StorePath -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest (HashSet StorePath) -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest (HashSet StorePath) -> Some StoreRequest)
-> (StorePath -> StoreRequest (HashSet StorePath))
-> StorePath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> StoreRequest (HashSet StorePath)
QueryDerivationOutputs (StorePath -> Some StoreRequest)
-> Gen StorePath -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest (HashSet StorePathName) -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest (HashSet StorePathName) -> Some StoreRequest)
-> (StorePath -> StoreRequest (HashSet StorePathName))
-> StorePath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> StoreRequest (HashSet StorePathName)
QueryDerivationOutputNames (StorePath -> Some StoreRequest)
-> Gen StorePath -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePath
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest StorePath -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest StorePath -> Some StoreRequest)
-> (StorePathHashPart -> StoreRequest StorePath)
-> StorePathHashPart
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePathHashPart -> StoreRequest StorePath
QueryPathFromHashPart (StorePathHashPart -> Some StoreRequest)
-> Gen StorePathHashPart -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StorePathHashPart
forall a. Arbitrary a => Gen a
arbitrary
    , StoreRequest Missing -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest Missing -> Some StoreRequest)
-> (Set DerivedPath -> StoreRequest Missing)
-> Set DerivedPath
-> Some StoreRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set DerivedPath -> StoreRequest Missing
QueryMissing (Set DerivedPath -> Some StoreRequest)
-> Gen (Set DerivedPath) -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set DerivedPath)
forall a. Arbitrary a => Gen a
arbitrary
    , Some StoreRequest -> Gen (Some StoreRequest)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Some StoreRequest -> Gen (Some StoreRequest))
-> Some StoreRequest -> Gen (Some StoreRequest)
forall a b. (a -> b) -> a -> b
$ StoreRequest SuccessCodeReply -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some StoreRequest SuccessCodeReply
OptimiseStore
    , Some StoreRequest -> Gen (Some StoreRequest)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Some StoreRequest -> Gen (Some StoreRequest))
-> Some StoreRequest -> Gen (Some StoreRequest)
forall a b. (a -> b) -> a -> b
$ StoreRequest SuccessCodeReply -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some StoreRequest SuccessCodeReply
SyncWithGC
    , StoreRequest Bool -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (StoreRequest Bool -> Some StoreRequest)
-> Gen (StoreRequest Bool) -> Gen (Some StoreRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CheckMode -> RepairMode -> StoreRequest Bool
VerifyStore (CheckMode -> RepairMode -> StoreRequest Bool)
-> Gen CheckMode -> Gen (RepairMode -> StoreRequest Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen CheckMode
forall a. Arbitrary a => Gen a
arbitrary Gen (RepairMode -> StoreRequest Bool)
-> Gen RepairMode -> Gen (StoreRequest Bool)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen RepairMode
forall a. Arbitrary a => Gen a
arbitrary)
    ]

-- ** Reply

deriving via GenericArbitrary SuccessCodeReply
  instance Arbitrary SuccessCodeReply

deriving via GenericArbitrary GCResult
  instance Arbitrary GCResult

deriving via GenericArbitrary GCRoot
  instance Arbitrary GCRoot

deriving via GenericArbitrary Missing
  instance Arbitrary Missing