{-# LANGUAGE CPP #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use newtype instead of data" #-}

{- | Module: Cardano.YTxP.Control.Parameters
Description: Data required to work with the compiled control scripts
-}
module Cardano.YTxP.SDK.SdkParameters (
  SdkParameters (..),
  AuthorisedScriptsSTCS (..),
) where

import Control.Monad ((<=<))
import Data.Aeson (
  FromJSON (parseJSON),
  ToJSON (toEncoding, toJSON),
  withText,
 )
import Data.Text (unpack)
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import PlutusCore (DefaultUni)
import PlutusLedgerApi.V3 (CurrencySymbol (CurrencySymbol))
import PlutusTx qualified
import PlutusTx.Builtins.HasOpaque (stringToBuiltinByteStringHex)
import Prettyprinter (
  Pretty,
  align,
  braces,
  dquotes,
  pretty,
  punctuate,
  vsep,
  (<+>),
 )

-- | Parameters available during compilation (therefore not containing any script hashes).
data SdkParameters = SdkParameters
  { SdkParameters -> [Natural]
validatorsNonceList :: [Natural]
  -- ^ A list of nonces for the validators. One validator is compiled for each nonce.
  -- @since 0.2.1
  , SdkParameters -> AuthorisedScriptsSTCS
authorisedScriptsSTCS :: AuthorisedScriptsSTCS
  -- ^ The Currency symbol of the token that identifies authorised reference scripts .
  -- @since 0.1.0
  }
  deriving stock (SdkParameters -> SdkParameters -> Bool
(SdkParameters -> SdkParameters -> Bool)
-> (SdkParameters -> SdkParameters -> Bool) -> Eq SdkParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SdkParameters -> SdkParameters -> Bool
== :: SdkParameters -> SdkParameters -> Bool
$c/= :: SdkParameters -> SdkParameters -> Bool
/= :: SdkParameters -> SdkParameters -> Bool
Eq, (forall x. SdkParameters -> Rep SdkParameters x)
-> (forall x. Rep SdkParameters x -> SdkParameters)
-> Generic SdkParameters
forall x. Rep SdkParameters x -> SdkParameters
forall x. SdkParameters -> Rep SdkParameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SdkParameters -> Rep SdkParameters x
from :: forall x. SdkParameters -> Rep SdkParameters x
$cto :: forall x. Rep SdkParameters x -> SdkParameters
to :: forall x. Rep SdkParameters x -> SdkParameters
Generic, Int -> SdkParameters -> ShowS
[SdkParameters] -> ShowS
SdkParameters -> String
(Int -> SdkParameters -> ShowS)
-> (SdkParameters -> String)
-> ([SdkParameters] -> ShowS)
-> Show SdkParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SdkParameters -> ShowS
showsPrec :: Int -> SdkParameters -> ShowS
$cshow :: SdkParameters -> String
show :: SdkParameters -> String
$cshowList :: [SdkParameters] -> ShowS
showList :: [SdkParameters] -> ShowS
Show)
  deriving anyclass ([SdkParameters] -> Value
[SdkParameters] -> Encoding
SdkParameters -> Bool
SdkParameters -> Value
SdkParameters -> Encoding
(SdkParameters -> Value)
-> (SdkParameters -> Encoding)
-> ([SdkParameters] -> Value)
-> ([SdkParameters] -> Encoding)
-> (SdkParameters -> Bool)
-> ToJSON SdkParameters
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SdkParameters -> Value
toJSON :: SdkParameters -> Value
$ctoEncoding :: SdkParameters -> Encoding
toEncoding :: SdkParameters -> Encoding
$ctoJSONList :: [SdkParameters] -> Value
toJSONList :: [SdkParameters] -> Value
$ctoEncodingList :: [SdkParameters] -> Encoding
toEncodingList :: [SdkParameters] -> Encoding
$comitField :: SdkParameters -> Bool
omitField :: SdkParameters -> Bool
ToJSON, Maybe SdkParameters
Value -> Parser [SdkParameters]
Value -> Parser SdkParameters
(Value -> Parser SdkParameters)
-> (Value -> Parser [SdkParameters])
-> Maybe SdkParameters
-> FromJSON SdkParameters
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SdkParameters
parseJSON :: Value -> Parser SdkParameters
$cparseJSONList :: Value -> Parser [SdkParameters]
parseJSONList :: Value -> Parser [SdkParameters]
$comittedField :: Maybe SdkParameters
omittedField :: Maybe SdkParameters
FromJSON)

instance Pretty SdkParameters where
  pretty :: forall ann. SdkParameters -> Doc ann
pretty
    SdkParameters
      { [Natural]
$sel:validatorsNonceList:SdkParameters :: SdkParameters -> [Natural]
validatorsNonceList :: [Natural]
validatorsNonceList
      , AuthorisedScriptsSTCS
$sel:authorisedScriptsSTCS:SdkParameters :: SdkParameters -> AuthorisedScriptsSTCS
authorisedScriptsSTCS :: AuthorisedScriptsSTCS
authorisedScriptsSTCS
      } =
      (Doc ann
"SdkParameters:" <+>) (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann)
-> ([Doc ann] -> [Doc ann]) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
"," ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
        [ Doc ann
"validatorsNonceList:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Natural] -> Doc ann
forall ann. [Natural] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Natural]
validatorsNonceList
        , Doc ann
"authorisedScriptsSTCS:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (AuthorisedScriptsSTCS -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AuthorisedScriptsSTCS -> Doc ann
pretty AuthorisedScriptsSTCS
authorisedScriptsSTCS)
        ]

-- | Semantic newtype for the YieldList state thread currency symbol
newtype AuthorisedScriptsSTCS = AuthorisedScriptsSTCS CurrencySymbol
  deriving newtype
    ( AuthorisedScriptsSTCS -> AuthorisedScriptsSTCS -> Bool
(AuthorisedScriptsSTCS -> AuthorisedScriptsSTCS -> Bool)
-> (AuthorisedScriptsSTCS -> AuthorisedScriptsSTCS -> Bool)
-> Eq AuthorisedScriptsSTCS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthorisedScriptsSTCS -> AuthorisedScriptsSTCS -> Bool
== :: AuthorisedScriptsSTCS -> AuthorisedScriptsSTCS -> Bool
$c/= :: AuthorisedScriptsSTCS -> AuthorisedScriptsSTCS -> Bool
/= :: AuthorisedScriptsSTCS -> AuthorisedScriptsSTCS -> Bool
Eq
    , Int -> AuthorisedScriptsSTCS -> ShowS
[AuthorisedScriptsSTCS] -> ShowS
AuthorisedScriptsSTCS -> String
(Int -> AuthorisedScriptsSTCS -> ShowS)
-> (AuthorisedScriptsSTCS -> String)
-> ([AuthorisedScriptsSTCS] -> ShowS)
-> Show AuthorisedScriptsSTCS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthorisedScriptsSTCS -> ShowS
showsPrec :: Int -> AuthorisedScriptsSTCS -> ShowS
$cshow :: AuthorisedScriptsSTCS -> String
show :: AuthorisedScriptsSTCS -> String
$cshowList :: [AuthorisedScriptsSTCS] -> ShowS
showList :: [AuthorisedScriptsSTCS] -> ShowS
Show
    , AuthorisedScriptsSTCS -> BuiltinData
(AuthorisedScriptsSTCS -> BuiltinData)
-> ToData AuthorisedScriptsSTCS
forall a. (a -> BuiltinData) -> ToData a
$ctoBuiltinData :: AuthorisedScriptsSTCS -> BuiltinData
toBuiltinData :: AuthorisedScriptsSTCS -> BuiltinData
PlutusTx.ToData
    , BuiltinData -> Maybe AuthorisedScriptsSTCS
(BuiltinData -> Maybe AuthorisedScriptsSTCS)
-> FromData AuthorisedScriptsSTCS
forall a. (BuiltinData -> Maybe a) -> FromData a
$cfromBuiltinData :: BuiltinData -> Maybe AuthorisedScriptsSTCS
fromBuiltinData :: BuiltinData -> Maybe AuthorisedScriptsSTCS
PlutusTx.FromData
    , BuiltinData -> AuthorisedScriptsSTCS
(BuiltinData -> AuthorisedScriptsSTCS)
-> UnsafeFromData AuthorisedScriptsSTCS
forall a. (BuiltinData -> a) -> UnsafeFromData a
$cunsafeFromBuiltinData :: BuiltinData -> AuthorisedScriptsSTCS
unsafeFromBuiltinData :: BuiltinData -> AuthorisedScriptsSTCS
PlutusTx.UnsafeFromData
    , PlutusTx.Typeable DefaultUni
    , PlutusTx.Lift DefaultUni
    , (forall ann. AuthorisedScriptsSTCS -> Doc ann)
-> (forall ann. [AuthorisedScriptsSTCS] -> Doc ann)
-> Pretty AuthorisedScriptsSTCS
forall ann. [AuthorisedScriptsSTCS] -> Doc ann
forall ann. AuthorisedScriptsSTCS -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. AuthorisedScriptsSTCS -> Doc ann
pretty :: forall ann. AuthorisedScriptsSTCS -> Doc ann
$cprettyList :: forall ann. [AuthorisedScriptsSTCS] -> Doc ann
prettyList :: forall ann. [AuthorisedScriptsSTCS] -> Doc ann
Pretty
    )

instance FromJSON AuthorisedScriptsSTCS where
  {-# INLINEABLE parseJSON #-}
  parseJSON :: Value -> Parser AuthorisedScriptsSTCS
parseJSON =
    (AuthorisedScriptsSTCS -> Parser AuthorisedScriptsSTCS
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (AuthorisedScriptsSTCS -> Parser AuthorisedScriptsSTCS)
-> (CurrencySymbol -> AuthorisedScriptsSTCS)
-> CurrencySymbol
-> Parser AuthorisedScriptsSTCS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrencySymbol -> AuthorisedScriptsSTCS
AuthorisedScriptsSTCS)
      (CurrencySymbol -> Parser AuthorisedScriptsSTCS)
-> (Value -> Parser CurrencySymbol)
-> Value
-> Parser AuthorisedScriptsSTCS
forall (m :: Type -> Type) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String
-> (Text -> Parser CurrencySymbol)
-> Value
-> Parser CurrencySymbol
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText
        String
"AuthorisedScriptsSTCS"
        (CurrencySymbol -> Parser CurrencySymbol
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (CurrencySymbol -> Parser CurrencySymbol)
-> (Text -> CurrencySymbol) -> Text -> Parser CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> CurrencySymbol
CurrencySymbol (BuiltinByteString -> CurrencySymbol)
-> (Text -> BuiltinByteString) -> Text -> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BuiltinByteString
stringToBuiltinByteStringHex (String -> BuiltinByteString)
-> (Text -> String) -> Text -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack)

instance ToJSON AuthorisedScriptsSTCS where
  {-# INLINEABLE toJSON #-}
  toJSON :: AuthorisedScriptsSTCS -> Value
toJSON (AuthorisedScriptsSTCS CurrencySymbol
cs) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value)
-> (CurrencySymbol -> String) -> CurrencySymbol -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrencySymbol -> String
forall a. Show a => a -> String
show (CurrencySymbol -> Value) -> CurrencySymbol -> Value
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
cs

  {-# INLINEABLE toEncoding #-}
  toEncoding :: AuthorisedScriptsSTCS -> Encoding
toEncoding (AuthorisedScriptsSTCS CurrencySymbol
cs) = String -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (String -> Encoding)
-> (CurrencySymbol -> String) -> CurrencySymbol -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrencySymbol -> String
forall a. Show a => a -> String
show (CurrencySymbol -> Encoding) -> CurrencySymbol -> Encoding
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
cs