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

module PlutusLedgerApi.V1.Data.Address (
  Address,
  pattern Address,
  addressCredential,
  addressStakingCredential,
  pubKeyHashAddress,
  toPubKeyHash,
  toScriptHash,
  scriptHashAddress,
  stakingCredential,
) where

import Control.DeepSeq (NFData)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusLedgerApi.V1.Data.Credential (Credential, StakingCredential, pattern PubKeyCredential,
                                           pattern ScriptCredential)
import PlutusLedgerApi.V1.Scripts (ScriptHash)
import PlutusTx qualified
import PlutusTx.AsData qualified as PlutusTx
import PlutusTx.Blueprint.Definition (HasBlueprintDefinition)
import PlutusTx.Bool qualified as PlutusTx
import PlutusTx.Eq qualified as PlutusTx
import Prettyprinter (Pretty (pretty), parens, (<+>))

{-| An address may contain two credentials,
the payment credential and optionally a 'StakingCredential'.
-}
PlutusTx.asData
  [d|
    data Address = Address
      { addressCredential :: Credential
      , -- \^ the payment credential
        addressStakingCredential :: Maybe StakingCredential
      }
      -- \^ the staking credential

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

instance Pretty Address where
  pretty :: forall ann. Address -> Doc ann
pretty (Address Credential
cred Maybe StakingCredential
stakingCred) =
    let staking :: Doc ann
staking = Doc ann
-> (StakingCredential -> Doc ann)
-> Maybe StakingCredential
-> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
"no staking credential" StakingCredential -> Doc ann
forall ann. StakingCredential -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe StakingCredential
stakingCred
     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

instance PlutusTx.Eq Address where
  {-# INLINEABLE (==) #-}
  Address Credential
cred Maybe StakingCredential
stakingCred == :: Address -> Address -> Bool
== Address Credential
cred' Maybe StakingCredential
stakingCred' =
    Credential
cred
      Credential -> Credential -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Credential
cred'
      Bool -> Bool -> Bool
PlutusTx.&& Maybe StakingCredential
stakingCred
      Maybe StakingCredential -> Maybe StakingCredential -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Maybe StakingCredential
stakingCred'

{-# 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 StakingCredential -> Address
Address (PubKeyHash -> Credential
PubKeyCredential PubKeyHash
pkh) Maybe StakingCredential
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 StakingCredential
_) = 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 StakingCredential
_) = 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 StakingCredential -> Address
Address (ScriptHash -> Credential
ScriptCredential ScriptHash
vh) Maybe StakingCredential
forall a. Maybe a
Nothing

{-# INLINEABLE stakingCredential #-}

-- | The staking credential of an address (if any)
stakingCredential :: Address -> Maybe StakingCredential
stakingCredential :: Address -> Maybe StakingCredential
stakingCredential (Address Credential
_ Maybe StakingCredential
s) = Maybe StakingCredential
s

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

$(PlutusTx.makeLift ''Address)