-- | 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 (ValidationPurpose -> ValidationPurpose -> Bool
(ValidationPurpose -> ValidationPurpose -> Bool)
-> (ValidationPurpose -> ValidationPurpose -> Bool)
-> Eq ValidationPurpose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidationPurpose -> ValidationPurpose -> Bool
== :: ValidationPurpose -> ValidationPurpose -> Bool
$c/= :: ValidationPurpose -> ValidationPurpose -> Bool
/= :: ValidationPurpose -> ValidationPurpose -> Bool
Eq, Eq ValidationPurpose
Eq ValidationPurpose =>
(ValidationPurpose -> ValidationPurpose -> Ordering)
-> (ValidationPurpose -> ValidationPurpose -> Bool)
-> (ValidationPurpose -> ValidationPurpose -> Bool)
-> (ValidationPurpose -> ValidationPurpose -> Bool)
-> (ValidationPurpose -> ValidationPurpose -> Bool)
-> (ValidationPurpose -> ValidationPurpose -> ValidationPurpose)
-> (ValidationPurpose -> ValidationPurpose -> ValidationPurpose)
-> Ord ValidationPurpose
ValidationPurpose -> ValidationPurpose -> Bool
ValidationPurpose -> ValidationPurpose -> Ordering
ValidationPurpose -> ValidationPurpose -> ValidationPurpose
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ValidationPurpose -> ValidationPurpose -> Ordering
compare :: ValidationPurpose -> ValidationPurpose -> Ordering
$c< :: ValidationPurpose -> ValidationPurpose -> Bool
< :: ValidationPurpose -> ValidationPurpose -> Bool
$c<= :: ValidationPurpose -> ValidationPurpose -> Bool
<= :: ValidationPurpose -> ValidationPurpose -> Bool
$c> :: ValidationPurpose -> ValidationPurpose -> Bool
> :: ValidationPurpose -> ValidationPurpose -> Bool
$c>= :: ValidationPurpose -> ValidationPurpose -> Bool
>= :: ValidationPurpose -> ValidationPurpose -> Bool
$cmax :: ValidationPurpose -> ValidationPurpose -> ValidationPurpose
max :: ValidationPurpose -> ValidationPurpose -> ValidationPurpose
$cmin :: ValidationPurpose -> ValidationPurpose -> ValidationPurpose
min :: ValidationPurpose -> ValidationPurpose -> ValidationPurpose
Ord, Int -> ValidationPurpose -> ShowS
[ValidationPurpose] -> ShowS
ValidationPurpose -> String
(Int -> ValidationPurpose -> ShowS)
-> (ValidationPurpose -> String)
-> ([ValidationPurpose] -> ShowS)
-> Show ValidationPurpose
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidationPurpose -> ShowS
showsPrec :: Int -> ValidationPurpose -> ShowS
$cshow :: ValidationPurpose -> String
show :: ValidationPurpose -> String
$cshowList :: [ValidationPurpose] -> ShowS
showList :: [ValidationPurpose] -> ShowS
Show, (forall x. ValidationPurpose -> Rep ValidationPurpose x)
-> (forall x. Rep ValidationPurpose x -> ValidationPurpose)
-> Generic ValidationPurpose
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
$cfrom :: forall x. ValidationPurpose -> Rep ValidationPurpose x
from :: forall x. ValidationPurpose -> Rep ValidationPurpose x
$cto :: forall x. Rep ValidationPurpose x -> ValidationPurpose
to :: forall x. Rep ValidationPurpose x -> ValidationPurpose
Generic)
  deriving (Maybe ValidationPurpose
Value -> Parser [ValidationPurpose]
Value -> Parser ValidationPurpose
(Value -> Parser ValidationPurpose)
-> (Value -> Parser [ValidationPurpose])
-> Maybe ValidationPurpose
-> FromJSON ValidationPurpose
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ValidationPurpose
parseJSON :: Value -> Parser ValidationPurpose
$cparseJSONList :: Value -> Parser [ValidationPurpose]
parseJSONList :: Value -> Parser [ValidationPurpose]
$comittedField :: Maybe ValidationPurpose
omittedField :: Maybe ValidationPurpose
FromJSON, [ValidationPurpose] -> Value
[ValidationPurpose] -> Encoding
ValidationPurpose -> Bool
ValidationPurpose -> Value
ValidationPurpose -> Encoding
(ValidationPurpose -> Value)
-> (ValidationPurpose -> Encoding)
-> ([ValidationPurpose] -> Value)
-> ([ValidationPurpose] -> Encoding)
-> (ValidationPurpose -> Bool)
-> ToJSON ValidationPurpose
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ValidationPurpose -> Value
toJSON :: ValidationPurpose -> Value
$ctoEncoding :: ValidationPurpose -> Encoding
toEncoding :: ValidationPurpose -> Encoding
$ctoJSONList :: [ValidationPurpose] -> Value
toJSONList :: [ValidationPurpose] -> Value
$ctoEncodingList :: [ValidationPurpose] -> Encoding
toEncodingList :: [ValidationPurpose] -> Encoding
$comitField :: ValidationPurpose -> Bool
omitField :: ValidationPurpose -> Bool
ToJSON)
  via CustomJSON '[ConstructorTagModifier '[ToLower]] ValidationPurpose

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