-- | Transaction or script redeemer validation purpose
module Blockfrost.Types.Shared.ValidationPurpose
  ( ValidationPurpose (..)
  ) where

import Deriving.Aeson
import Servant.Docs (ToSample (..), samples)

import Blockfrost.Types.Shared.Opts

-- | Validation purpose
data ValidationPurpose = Spend | Mint | Cert | Reward
  deriving stock (Int -> ValidationPurpose -> ShowS
[ValidationPurpose] -> ShowS
ValidationPurpose -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationPurpose] -> ShowS
$cshowList :: [ValidationPurpose] -> ShowS
show :: ValidationPurpose -> String
$cshow :: ValidationPurpose -> String
showsPrec :: Int -> ValidationPurpose -> ShowS
$cshowsPrec :: Int -> ValidationPurpose -> ShowS
Show, ValidationPurpose -> ValidationPurpose -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidationPurpose -> ValidationPurpose -> Bool
$c/= :: ValidationPurpose -> ValidationPurpose -> Bool
== :: ValidationPurpose -> ValidationPurpose -> Bool
$c== :: ValidationPurpose -> ValidationPurpose -> Bool
Eq, forall x. Rep ValidationPurpose x -> ValidationPurpose
forall x. ValidationPurpose -> Rep ValidationPurpose x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValidationPurpose x -> ValidationPurpose
$cfrom :: forall x. ValidationPurpose -> Rep ValidationPurpose x
Generic)
  deriving (Value -> Parser [ValidationPurpose]
Value -> Parser ValidationPurpose
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ValidationPurpose]
$cparseJSONList :: Value -> Parser [ValidationPurpose]
parseJSON :: Value -> Parser ValidationPurpose
$cparseJSON :: Value -> Parser ValidationPurpose
FromJSON, [ValidationPurpose] -> Encoding
[ValidationPurpose] -> Value
ValidationPurpose -> Encoding
ValidationPurpose -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ValidationPurpose] -> Encoding
$ctoEncodingList :: [ValidationPurpose] -> Encoding
toJSONList :: [ValidationPurpose] -> Value
$ctoJSONList :: [ValidationPurpose] -> Value
toEncoding :: ValidationPurpose -> Encoding
$ctoEncoding :: ValidationPurpose -> Encoding
toJSON :: ValidationPurpose -> Value
$ctoJSON :: ValidationPurpose -> Value
ToJSON)
  via CustomJSON '[ConstructorTagModifier '[ToLower]] ValidationPurpose

instance ToSample ValidationPurpose where
  toSamples :: Proxy ValidationPurpose -> [(Text, ValidationPurpose)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Text, a)]
samples [ ValidationPurpose
Spend, ValidationPurpose
Mint, ValidationPurpose
Cert, ValidationPurpose
Reward ]