{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
-- needed for asData pattern synonyms
{-# OPTIONS_GHC -fexpose-all-unfoldings #-}
{-# 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.Data.Address
  ( AccountId (..)
  , Address
  , pattern Address
  , matchAddress
  , addressCredential
  , addressStakingAccountId
  , pubKeyHashAddress
  , toPubKeyHash
  , toScriptHash
  , scriptHashAddress
  , stakingAccountId
  ) where

import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusLedgerApi.V1.Data.Credential
  ( Credential
  , pattern PubKeyCredential
  , pattern ScriptCredential
  )
import PlutusLedgerApi.V1.Scripts (ScriptHash)
import PlutusTx qualified
import PlutusTx.AsData qualified as PlutusTx
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 ((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
    , 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
    )

PlutusTx.makeLift ''AccountId

{-| An address may contain two things: the payment credential, and optionally
the 'AccountId' of the account the funds are staked to. -}
PlutusTx.asData
  [d|
    data Address = Address
      { addressCredential :: Credential
      , -- \^ the payment credential
        addressStakingAccountId :: Maybe AccountId
      }
      -- \^ the account the funds locked by this address are staked to

      deriving stock (Eq, Ord, Show, Generic)
      deriving newtype (PlutusTx.FromData, PlutusTx.UnsafeFromData, PlutusTx.ToData)
    |]

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 ann. Credential -> Doc ann
forall a ann. Pretty a => a -> 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 ''Address)