{-# 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 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)
      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)