{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-specialise #-}

{-| Addresses and account identifiers for Plutus V4.

In Plutus V1-V3 an `Address` pairs a payment credential with an optional
staking credential. In V4 staking credentials no longer exist: the funds
locked by an address are staked via an account, identified by an `AccountId`. -}
module PlutusLedgerApi.V4.Address
  ( AccountId (..)
  , Address (..)
  , pubKeyHashAddress
  , toPubKeyHash
  , toScriptHash
  , scriptHashAddress
  , stakingAccountId
  ) where

import Data.Function ((&))
import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Credential (Credential (..))
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusLedgerApi.V1.Scripts (ScriptHash)
import PlutusTx qualified
import PlutusTx.Blueprint
  ( HasBlueprintDefinition
  , HasBlueprintSchema (..)
  , HasSchemaDefinition
  , SchemaInfo (..)
  , definitionRef
  , withSchemaInfo
  )
import PlutusTx.Eq qualified as PlutusTx
import Prettyprinter (Pretty (pretty), parens, (<+>))
import Prettyprinter.Extras (PrettyShow (PrettyShow))

newtype AccountId = AccountId Credential
  deriving stock ((forall x. AccountId -> Rep AccountId x)
-> (forall x. Rep AccountId x -> AccountId) -> Generic AccountId
forall x. Rep AccountId x -> AccountId
forall x. AccountId -> Rep AccountId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccountId -> Rep AccountId x
from :: forall x. AccountId -> Rep AccountId x
$cto :: forall x. Rep AccountId x -> AccountId
to :: forall x. Rep AccountId x -> AccountId
Generic)
  deriving anyclass (DefinitionId
DefinitionId -> HasBlueprintDefinition AccountId
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)
  deriving ((forall ann. AccountId -> Doc ann)
-> (forall ann. [AccountId] -> Doc ann) -> Pretty AccountId
forall ann. [AccountId] -> Doc ann
forall ann. AccountId -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. AccountId -> Doc ann
pretty :: forall ann. AccountId -> Doc ann
$cprettyList :: forall ann. [AccountId] -> Doc ann
prettyList :: forall ann. [AccountId] -> Doc ann
Pretty) via (PrettyShow AccountId)
  deriving newtype
    ( AccountId -> AccountId -> Bool
(AccountId -> AccountId -> Bool)
-> (AccountId -> AccountId -> Bool) -> Eq AccountId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccountId -> AccountId -> Bool
== :: AccountId -> AccountId -> Bool
$c/= :: AccountId -> AccountId -> Bool
/= :: AccountId -> AccountId -> Bool
Eq
    , Eq AccountId
Eq AccountId =>
(AccountId -> AccountId -> Ordering)
-> (AccountId -> AccountId -> Bool)
-> (AccountId -> AccountId -> Bool)
-> (AccountId -> AccountId -> Bool)
-> (AccountId -> AccountId -> Bool)
-> (AccountId -> AccountId -> AccountId)
-> (AccountId -> AccountId -> AccountId)
-> Ord AccountId
AccountId -> AccountId -> Bool
AccountId -> AccountId -> Ordering
AccountId -> AccountId -> AccountId
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 :: AccountId -> AccountId -> Ordering
compare :: AccountId -> AccountId -> Ordering
$c< :: AccountId -> AccountId -> Bool
< :: AccountId -> AccountId -> Bool
$c<= :: AccountId -> AccountId -> Bool
<= :: AccountId -> AccountId -> Bool
$c> :: AccountId -> AccountId -> Bool
> :: AccountId -> AccountId -> Bool
$c>= :: AccountId -> AccountId -> Bool
>= :: AccountId -> AccountId -> Bool
$cmax :: AccountId -> AccountId -> AccountId
max :: AccountId -> AccountId -> AccountId
$cmin :: AccountId -> AccountId -> AccountId
min :: AccountId -> AccountId -> AccountId
Ord
    , Int -> AccountId -> ShowS
[AccountId] -> ShowS
AccountId -> String
(Int -> AccountId -> ShowS)
-> (AccountId -> String)
-> ([AccountId] -> ShowS)
-> Show AccountId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountId -> ShowS
showsPrec :: Int -> AccountId -> ShowS
$cshow :: AccountId -> String
show :: AccountId -> String
$cshowList :: [AccountId] -> ShowS
showList :: [AccountId] -> ShowS
Show
    , AccountId -> AccountId -> Bool
(AccountId -> AccountId -> Bool) -> Eq AccountId
forall a. (a -> a -> Bool) -> Eq a
$c== :: AccountId -> AccountId -> Bool
== :: AccountId -> AccountId -> Bool
PlutusTx.Eq
    , AccountId -> BuiltinData
(AccountId -> BuiltinData) -> ToData AccountId
forall a. (a -> BuiltinData) -> ToData a
$ctoBuiltinData :: AccountId -> BuiltinData
toBuiltinData :: AccountId -> BuiltinData
PlutusTx.ToData
    , BuiltinData -> Maybe AccountId
(BuiltinData -> Maybe AccountId) -> FromData AccountId
forall a. (BuiltinData -> Maybe a) -> FromData a
$cfromBuiltinData :: BuiltinData -> Maybe AccountId
fromBuiltinData :: BuiltinData -> Maybe AccountId
PlutusTx.FromData
    , BuiltinData -> AccountId
(BuiltinData -> AccountId) -> UnsafeFromData AccountId
forall a. (BuiltinData -> a) -> UnsafeFromData a
$cunsafeFromBuiltinData :: BuiltinData -> AccountId
unsafeFromBuiltinData :: BuiltinData -> AccountId
PlutusTx.UnsafeFromData
    )

instance
  ( HasSchemaDefinition PubKeyHash referencedTypes
  , HasSchemaDefinition ScriptHash referencedTypes
  )
  => HasBlueprintSchema AccountId referencedTypes
  where
  schema :: Schema referencedTypes
schema =
    forall t (referencedTypes :: [*]).
HasBlueprintSchema t referencedTypes =>
Schema referencedTypes
schema @Credential @referencedTypes
      Schema referencedTypes
-> (Schema referencedTypes -> Schema referencedTypes)
-> Schema referencedTypes
forall a b. a -> (a -> b) -> b
& (SchemaInfo -> SchemaInfo)
-> Schema referencedTypes -> Schema referencedTypes
forall (referencedTypes :: [*]).
(SchemaInfo -> SchemaInfo)
-> Schema referencedTypes -> Schema referencedTypes
withSchemaInfo \SchemaInfo
info -> SchemaInfo
info {title = Just "AccountId"}

{-| An address may contain two things: the payment credential, and optionally
the 'AccountId' of the account the funds are staked to. -}
data Address = Address
  { Address -> Credential
addressCredential :: Credential
  -- ^ the payment credential
  , Address -> Maybe AccountId
addressStakingAccountId :: Maybe AccountId
  -- ^ the account the funds locked by this address are staked to
  }
  deriving stock (Address -> Address -> Bool
(Address -> Address -> Bool)
-> (Address -> Address -> Bool) -> Eq Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Address -> Address -> Bool
== :: Address -> Address -> Bool
$c/= :: Address -> Address -> Bool
/= :: Address -> Address -> Bool
Eq, Eq Address
Eq Address =>
(Address -> Address -> Ordering)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Address)
-> (Address -> Address -> Address)
-> Ord Address
Address -> Address -> Bool
Address -> Address -> Ordering
Address -> Address -> Address
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 :: Address -> Address -> Ordering
compare :: Address -> Address -> Ordering
$c< :: Address -> Address -> Bool
< :: Address -> Address -> Bool
$c<= :: Address -> Address -> Bool
<= :: Address -> Address -> Bool
$c> :: Address -> Address -> Bool
> :: Address -> Address -> Bool
$c>= :: Address -> Address -> Bool
>= :: Address -> Address -> Bool
$cmax :: Address -> Address -> Address
max :: Address -> Address -> Address
$cmin :: Address -> Address -> Address
min :: Address -> Address -> Address
Ord, Int -> Address -> ShowS
[Address] -> ShowS
Address -> String
(Int -> Address -> ShowS)
-> (Address -> String) -> ([Address] -> ShowS) -> Show Address
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Address -> ShowS
showsPrec :: Int -> Address -> ShowS
$cshow :: Address -> String
show :: Address -> String
$cshowList :: [Address] -> ShowS
showList :: [Address] -> ShowS
Show, (forall x. Address -> Rep Address x)
-> (forall x. Rep Address x -> Address) -> Generic Address
forall x. Rep Address x -> Address
forall x. Address -> Rep Address x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Address -> Rep Address x
from :: forall x. Address -> Rep Address x
$cto :: forall x. Rep Address x -> Address
to :: forall x. Rep Address x -> Address
Generic)
  deriving anyclass (DefinitionId
DefinitionId -> HasBlueprintDefinition Address
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)

PlutusTx.deriveEq ''Address

instance Pretty Address where
  pretty :: forall ann. Address -> Doc ann
pretty (Address Credential
cred Maybe AccountId
accountId) =
    let staking :: Doc ann
staking = Doc ann -> (AccountId -> Doc ann) -> Maybe AccountId -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
"no staking account" AccountId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AccountId -> Doc ann
pretty Maybe AccountId
accountId
     in Credential -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Credential -> Doc ann
pretty Credential
cred Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens Doc ann
forall {ann}. Doc ann
staking

{-# INLINEABLE pubKeyHashAddress #-}

{-| The address that should be targeted by a transaction output
locked by the public key with the given hash. -}
pubKeyHashAddress :: PubKeyHash -> Address
pubKeyHashAddress :: PubKeyHash -> Address
pubKeyHashAddress PubKeyHash
pkh = Credential -> Maybe AccountId -> Address
Address (PubKeyHash -> Credential
PubKeyCredential PubKeyHash
pkh) Maybe AccountId
forall a. Maybe a
Nothing

{-# INLINEABLE toPubKeyHash #-}

-- | The PubKeyHash of the address, if any
toPubKeyHash :: Address -> Maybe PubKeyHash
toPubKeyHash :: Address -> Maybe PubKeyHash
toPubKeyHash (Address (PubKeyCredential PubKeyHash
k) Maybe AccountId
_) = PubKeyHash -> Maybe PubKeyHash
forall a. a -> Maybe a
Just PubKeyHash
k
toPubKeyHash Address
_ = Maybe PubKeyHash
forall a. Maybe a
Nothing

{-# INLINEABLE toScriptHash #-}

-- | The validator hash of the address, if any
toScriptHash :: Address -> Maybe ScriptHash
toScriptHash :: Address -> Maybe ScriptHash
toScriptHash (Address (ScriptCredential ScriptHash
k) Maybe AccountId
_) = ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just ScriptHash
k
toScriptHash Address
_ = Maybe ScriptHash
forall a. Maybe a
Nothing

{-# INLINEABLE scriptHashAddress #-}

{-| The address that should be used by a transaction output
locked by the given validator script hash. -}
scriptHashAddress :: ScriptHash -> Address
scriptHashAddress :: ScriptHash -> Address
scriptHashAddress ScriptHash
vh = Credential -> Maybe AccountId -> Address
Address (ScriptHash -> Credential
ScriptCredential ScriptHash
vh) Maybe AccountId
forall a. Maybe a
Nothing

{-# INLINEABLE stakingAccountId #-}

-- | The account the funds locked by an address are staked to (if any)
stakingAccountId :: Address -> Maybe AccountId
stakingAccountId :: Address -> Maybe AccountId
stakingAccountId (Address Credential
_ Maybe AccountId
a) = Maybe AccountId
a

----------------------------------------------------------------------------------------------------
-- TH Splices --------------------------------------------------------------------------------------

$(PlutusTx.makeLift ''AccountId)

$(PlutusTx.makeIsDataSchemaIndexed ''Address [('Address, 0)])
$(PlutusTx.makeLift ''Address)