{-# 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, (<+>))
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
$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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
stakingCredential :: Address -> Maybe StakingCredential
stakingCredential :: Address -> Maybe StakingCredential
stakingCredential (Address Credential
_ Maybe StakingCredential
s) = Maybe StakingCredential
s
$(PlutusTx.makeIsDataSchemaIndexed ''Address [('Address, 0)])
$(PlutusTx.makeLift ''Address)