{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}

module Plutus.V1.Ledger.Address (
    Address (..),
    pubKeyHashAddress,
    scriptHashAddress,
    toPubKeyHash,
    toValidatorHash,
    stakingCredential
    ) where

import Control.DeepSeq (NFData)
import GHC.Generics (Generic)
import PlutusTx qualified
import PlutusTx.Bool qualified as PlutusTx
import PlutusTx.Eq qualified as PlutusTx
import Prettyprinter

import Plutus.V1.Ledger.Credential (Credential (..), StakingCredential)
import Plutus.V1.Ledger.Crypto
import Plutus.V1.Ledger.Scripts

-- | Address with two kinds of credentials, normal and staking.
data Address = Address{ Address -> Credential
addressCredential :: Credential, Address -> Maybe StakingCredential
addressStakingCredential :: Maybe StakingCredential }
    deriving stock (Address -> Address -> Bool
(Address -> Address -> Bool)
-> (Address -> Address -> Bool) -> Eq Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Address -> Address -> Bool
$c/= :: Address -> Address -> Bool
== :: Address -> Address -> Bool
$c== :: 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
min :: Address -> Address -> Address
$cmin :: Address -> Address -> Address
max :: Address -> Address -> Address
$cmax :: Address -> Address -> Address
>= :: Address -> Address -> Bool
$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
compare :: Address -> Address -> Ordering
$ccompare :: Address -> Address -> Ordering
$cp1Ord :: Eq 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
showList :: [Address] -> ShowS
$cshowList :: [Address] -> ShowS
show :: Address -> String
$cshow :: Address -> String
showsPrec :: Int -> Address -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Address x -> Address
$cfrom :: forall x. Address -> Rep Address x
Generic)
    deriving anyclass (Address -> ()
(Address -> ()) -> NFData Address
forall a. (a -> ()) -> NFData a
rnf :: Address -> ()
$crnf :: Address -> ()
NFData)

instance Pretty Address where
    pretty :: 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
pretty Maybe StakingCredential
stakingCred in
        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
    {-# INLINABLE (==) #-}
    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'

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

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

{-# INLINABLE toValidatorHash #-}
-- | The validator hash of the address, if any
toValidatorHash :: Address -> Maybe ValidatorHash
toValidatorHash :: Address -> Maybe ValidatorHash
toValidatorHash (Address (ScriptCredential ValidatorHash
k) Maybe StakingCredential
_) = ValidatorHash -> Maybe ValidatorHash
forall a. a -> Maybe a
Just ValidatorHash
k
toValidatorHash Address
_                                = Maybe ValidatorHash
forall a. Maybe a
Nothing

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

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

PlutusTx.makeIsDataIndexed ''Address [('Address,0)]
PlutusTx.makeLift ''Address