{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE DeriveAnyClass       #-}
{-# 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 #-}

module PlutusLedgerApi.V1.Address
  ( Address (..)
  , pubKeyHashAddress
  , toPubKeyHash
  , toScriptHash
  , scriptHashAddress
  , stakingCredential
  ) where

import Control.DeepSeq (NFData)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Credential (Credential (..), StakingCredential)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusLedgerApi.V1.Scripts (ScriptHash)
import PlutusTx qualified
import PlutusTx.Blueprint.Definition (HasBlueprintDefinition, definitionRef)
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'.
data Address = Address
  { Address -> Credential
addressCredential        :: Credential
  -- ^ the payment credential
  , Address -> Maybe StakingCredential
addressStakingCredential :: Maybe StakingCredential
  -- ^ the staking credential
  }
  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, Typeable)
  deriving anyclass (Address -> ()
(Address -> ()) -> NFData Address
forall a. (a -> ()) -> NFData a
$crnf :: Address -> ()
rnf :: Address -> ()
NFData, DefinitionId
DefinitionId -> HasBlueprintDefinition Address
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
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 a ann. Pretty a => a -> Doc ann
forall ann. StakingCredential -> Doc ann
pretty Maybe StakingCredential
stakingCred
     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

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.makeIsDataSchemaIndexed ''Address [('Address, 0)])
$(PlutusTx.makeLift ''Address)