{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}

-- | Certificates embedded in transactions
--
module Cardano.Api.Certificate (
    Certificate(..),

    -- * Registering stake address and delegating
    makeStakeAddressRegistrationCertificate,
    makeStakeAddressDeregistrationCertificate,
    makeStakeAddressDelegationCertificate,
    PoolId,

    -- * Registering stake pools
    makeStakePoolRegistrationCertificate,
    makeStakePoolRetirementCertificate,
    StakePoolParameters(..),
    StakePoolRelay(..),
    StakePoolMetadataReference(..),

    -- * Special certificates
    makeMIRCertificate,
    makeGenesisKeyDelegationCertificate,
    MIRTarget (..),

    -- * Internal conversion functions
    toShelleyCertificate,
    fromShelleyCertificate,
    toShelleyPoolParams,
    fromShelleyPoolParams,

    -- * Data family instances
    AsType(..)
  ) where

import           Data.ByteString (ByteString)
import qualified Data.Foldable as Foldable
import qualified Data.Map.Strict as Map
import           Data.Maybe
import qualified Data.Sequence.Strict as Seq
import qualified Data.Set as Set
import           Data.Text (Text)
import qualified Data.Text.Encoding as Text

import           Data.IP (IPv4, IPv6)
import           Network.Socket (PortNumber)

import qualified Cardano.Crypto.Hash.Class as Crypto
import           Cardano.Slotting.Slot (EpochNo (..))

import           Cardano.Ledger.Crypto (StandardCrypto)

import           Cardano.Ledger.BaseTypes (maybeToStrictMaybe, strictMaybeToMaybe)
import qualified Cardano.Ledger.BaseTypes as Shelley
import qualified Cardano.Ledger.Coin as Shelley (toDeltaCoin)
import           Cardano.Ledger.Shelley.TxBody (MIRPot (..))
import qualified Cardano.Ledger.Shelley.TxBody as Shelley

import           Cardano.Api.Address
import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Keys.Byron
import           Cardano.Api.Keys.Praos
import           Cardano.Api.Keys.Shelley
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseTextEnvelope
import           Cardano.Api.StakePoolMetadata
import           Cardano.Api.Value


-- ----------------------------------------------------------------------------
-- Certificates embedded in transactions
--

data Certificate =

     -- Stake address certificates
     StakeAddressRegistrationCertificate   StakeCredential
   | StakeAddressDeregistrationCertificate StakeCredential
   | StakeAddressDelegationCertificate     StakeCredential PoolId

     -- Stake pool certificates
   | StakePoolRegistrationCertificate StakePoolParameters
   | StakePoolRetirementCertificate   PoolId EpochNo

     -- Special certificates
   | GenesisKeyDelegationCertificate (Hash GenesisKey)
                                     (Hash GenesisDelegateKey)
                                     (Hash VrfKey)
   | MIRCertificate MIRPot MIRTarget

  deriving stock (Certificate -> Certificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Certificate -> Certificate -> Bool
$c/= :: Certificate -> Certificate -> Bool
== :: Certificate -> Certificate -> Bool
$c== :: Certificate -> Certificate -> Bool
Eq, Int -> Certificate -> ShowS
[Certificate] -> ShowS
Certificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Certificate] -> ShowS
$cshowList :: [Certificate] -> ShowS
show :: Certificate -> String
$cshow :: Certificate -> String
showsPrec :: Int -> Certificate -> ShowS
$cshowsPrec :: Int -> Certificate -> ShowS
Show)
  deriving anyclass HasTypeProxy Certificate
AsType Certificate -> ByteString -> Either DecoderError Certificate
Certificate -> ByteString
forall a.
HasTypeProxy a
-> (a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
deserialiseFromCBOR :: AsType Certificate -> ByteString -> Either DecoderError Certificate
$cdeserialiseFromCBOR :: AsType Certificate -> ByteString -> Either DecoderError Certificate
serialiseToCBOR :: Certificate -> ByteString
$cserialiseToCBOR :: Certificate -> ByteString
SerialiseAsCBOR

instance HasTypeProxy Certificate where
    data AsType Certificate = AsCertificate
    proxyToAsType :: Proxy Certificate -> AsType Certificate
proxyToAsType Proxy Certificate
_ = AsType Certificate
AsCertificate

instance ToCBOR Certificate where
    toCBOR :: Certificate -> Encoding
toCBOR = forall a. ToCBOR a => a -> Encoding
toCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. Certificate -> DCert StandardCrypto
toShelleyCertificate

instance FromCBOR Certificate where
    fromCBOR :: forall s. Decoder s Certificate
fromCBOR = DCert StandardCrypto -> Certificate
fromShelleyCertificate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. FromCBOR a => Decoder s a
fromCBOR

instance HasTextEnvelope Certificate where
    textEnvelopeType :: AsType Certificate -> TextEnvelopeType
textEnvelopeType AsType Certificate
_ = TextEnvelopeType
"CertificateShelley"
    textEnvelopeDefaultDescr :: Certificate -> TextEnvelopeDescr
textEnvelopeDefaultDescr Certificate
cert = case Certificate
cert of
      StakeAddressRegistrationCertificate{}   -> TextEnvelopeDescr
"Stake address registration"
      StakeAddressDeregistrationCertificate{} -> TextEnvelopeDescr
"Stake address de-registration"
      StakeAddressDelegationCertificate{}     -> TextEnvelopeDescr
"Stake address delegation"
      StakePoolRegistrationCertificate{}      -> TextEnvelopeDescr
"Pool registration"
      StakePoolRetirementCertificate{}        -> TextEnvelopeDescr
"Pool retirement"
      GenesisKeyDelegationCertificate{}       -> TextEnvelopeDescr
"Genesis key delegation"
      MIRCertificate{}                        -> TextEnvelopeDescr
"MIR"

-- | The 'MIRTarget' determines the target of a 'MIRCertificate'.
-- A 'MIRCertificate' moves lovelace from either the reserves or the treasury
-- to either a collection of stake credentials or to the other pot.
data MIRTarget =

     -- | Use 'StakeAddressesMIR' to make the target of a 'MIRCertificate'
     -- a mapping of stake credentials to lovelace.
     StakeAddressesMIR [(StakeCredential, Lovelace)]

     -- | Use 'SendToReservesMIR' to make the target of a 'MIRCertificate'
     -- the reserves pot.
   | SendToReservesMIR Lovelace

     -- | Use 'SendToTreasuryMIR' to make the target of a 'MIRCertificate'
     -- the treasury pot.
   | SendToTreasuryMIR Lovelace
  deriving stock (MIRTarget -> MIRTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIRTarget -> MIRTarget -> Bool
$c/= :: MIRTarget -> MIRTarget -> Bool
== :: MIRTarget -> MIRTarget -> Bool
$c== :: MIRTarget -> MIRTarget -> Bool
Eq, Int -> MIRTarget -> ShowS
[MIRTarget] -> ShowS
MIRTarget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MIRTarget] -> ShowS
$cshowList :: [MIRTarget] -> ShowS
show :: MIRTarget -> String
$cshow :: MIRTarget -> String
showsPrec :: Int -> MIRTarget -> ShowS
$cshowsPrec :: Int -> MIRTarget -> ShowS
Show)

-- ----------------------------------------------------------------------------
-- Stake pool parameters
--

type PoolId = Hash StakePoolKey

data StakePoolParameters =
     StakePoolParameters {
       StakePoolParameters -> PoolId
stakePoolId            :: PoolId,
       StakePoolParameters -> Hash VrfKey
stakePoolVRF           :: Hash VrfKey,
       StakePoolParameters -> Lovelace
stakePoolCost          :: Lovelace,
       StakePoolParameters -> Rational
stakePoolMargin        :: Rational,
       StakePoolParameters -> StakeAddress
stakePoolRewardAccount :: StakeAddress,
       StakePoolParameters -> Lovelace
stakePoolPledge        :: Lovelace,
       StakePoolParameters -> [Hash StakeKey]
stakePoolOwners        :: [Hash StakeKey],
       StakePoolParameters -> [StakePoolRelay]
stakePoolRelays        :: [StakePoolRelay],
       StakePoolParameters -> Maybe StakePoolMetadataReference
stakePoolMetadata      :: Maybe StakePoolMetadataReference
     }
  deriving (StakePoolParameters -> StakePoolParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakePoolParameters -> StakePoolParameters -> Bool
$c/= :: StakePoolParameters -> StakePoolParameters -> Bool
== :: StakePoolParameters -> StakePoolParameters -> Bool
$c== :: StakePoolParameters -> StakePoolParameters -> Bool
Eq, Int -> StakePoolParameters -> ShowS
[StakePoolParameters] -> ShowS
StakePoolParameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakePoolParameters] -> ShowS
$cshowList :: [StakePoolParameters] -> ShowS
show :: StakePoolParameters -> String
$cshow :: StakePoolParameters -> String
showsPrec :: Int -> StakePoolParameters -> ShowS
$cshowsPrec :: Int -> StakePoolParameters -> ShowS
Show)

data StakePoolRelay =

       -- | One or both of IPv4 & IPv6
       StakePoolRelayIp
          (Maybe IPv4) (Maybe IPv6) (Maybe PortNumber)

       -- | An DNS name pointing to a @A@ or @AAAA@ record.
     | StakePoolRelayDnsARecord
          ByteString (Maybe PortNumber)

       -- | A DNS name pointing to a @SRV@ record.
     | StakePoolRelayDnsSrvRecord
          ByteString

  deriving (StakePoolRelay -> StakePoolRelay -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakePoolRelay -> StakePoolRelay -> Bool
$c/= :: StakePoolRelay -> StakePoolRelay -> Bool
== :: StakePoolRelay -> StakePoolRelay -> Bool
$c== :: StakePoolRelay -> StakePoolRelay -> Bool
Eq, Int -> StakePoolRelay -> ShowS
[StakePoolRelay] -> ShowS
StakePoolRelay -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakePoolRelay] -> ShowS
$cshowList :: [StakePoolRelay] -> ShowS
show :: StakePoolRelay -> String
$cshow :: StakePoolRelay -> String
showsPrec :: Int -> StakePoolRelay -> ShowS
$cshowsPrec :: Int -> StakePoolRelay -> ShowS
Show)

data StakePoolMetadataReference =
     StakePoolMetadataReference {
       StakePoolMetadataReference -> Text
stakePoolMetadataURL  :: Text,
       StakePoolMetadataReference -> Hash StakePoolMetadata
stakePoolMetadataHash :: Hash StakePoolMetadata
     }
  deriving (StakePoolMetadataReference -> StakePoolMetadataReference -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakePoolMetadataReference -> StakePoolMetadataReference -> Bool
$c/= :: StakePoolMetadataReference -> StakePoolMetadataReference -> Bool
== :: StakePoolMetadataReference -> StakePoolMetadataReference -> Bool
$c== :: StakePoolMetadataReference -> StakePoolMetadataReference -> Bool
Eq, Int -> StakePoolMetadataReference -> ShowS
[StakePoolMetadataReference] -> ShowS
StakePoolMetadataReference -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakePoolMetadataReference] -> ShowS
$cshowList :: [StakePoolMetadataReference] -> ShowS
show :: StakePoolMetadataReference -> String
$cshow :: StakePoolMetadataReference -> String
showsPrec :: Int -> StakePoolMetadataReference -> ShowS
$cshowsPrec :: Int -> StakePoolMetadataReference -> ShowS
Show)


-- ----------------------------------------------------------------------------
-- Constructor functions
--

makeStakeAddressRegistrationCertificate :: StakeCredential -> Certificate
makeStakeAddressRegistrationCertificate :: StakeCredential -> Certificate
makeStakeAddressRegistrationCertificate = StakeCredential -> Certificate
StakeAddressRegistrationCertificate

makeStakeAddressDeregistrationCertificate :: StakeCredential -> Certificate
makeStakeAddressDeregistrationCertificate :: StakeCredential -> Certificate
makeStakeAddressDeregistrationCertificate = StakeCredential -> Certificate
StakeAddressDeregistrationCertificate

makeStakeAddressDelegationCertificate :: StakeCredential -> PoolId -> Certificate
makeStakeAddressDelegationCertificate :: StakeCredential -> PoolId -> Certificate
makeStakeAddressDelegationCertificate = StakeCredential -> PoolId -> Certificate
StakeAddressDelegationCertificate

makeStakePoolRegistrationCertificate :: StakePoolParameters -> Certificate
makeStakePoolRegistrationCertificate :: StakePoolParameters -> Certificate
makeStakePoolRegistrationCertificate = StakePoolParameters -> Certificate
StakePoolRegistrationCertificate

makeStakePoolRetirementCertificate :: PoolId -> EpochNo -> Certificate
makeStakePoolRetirementCertificate :: PoolId -> EpochNo -> Certificate
makeStakePoolRetirementCertificate = PoolId -> EpochNo -> Certificate
StakePoolRetirementCertificate

makeGenesisKeyDelegationCertificate :: Hash GenesisKey
                                    -> Hash GenesisDelegateKey
                                    -> Hash VrfKey
                                    -> Certificate
makeGenesisKeyDelegationCertificate :: Hash GenesisKey
-> Hash GenesisDelegateKey -> Hash VrfKey -> Certificate
makeGenesisKeyDelegationCertificate = Hash GenesisKey
-> Hash GenesisDelegateKey -> Hash VrfKey -> Certificate
GenesisKeyDelegationCertificate

makeMIRCertificate :: MIRPot -> MIRTarget -> Certificate
makeMIRCertificate :: MIRPot -> MIRTarget -> Certificate
makeMIRCertificate = MIRPot -> MIRTarget -> Certificate
MIRCertificate


-- ----------------------------------------------------------------------------
-- Internal conversion functions
--

toShelleyCertificate :: Certificate -> Shelley.DCert StandardCrypto
toShelleyCertificate :: Certificate -> DCert StandardCrypto
toShelleyCertificate (StakeAddressRegistrationCertificate StakeCredential
stakecred) =
    forall crypto. DelegCert crypto -> DCert crypto
Shelley.DCertDeleg forall a b. (a -> b) -> a -> b
$
      forall crypto. StakeCredential crypto -> DelegCert crypto
Shelley.RegKey
        (StakeCredential -> Credential 'Staking StandardCrypto
toShelleyStakeCredential StakeCredential
stakecred)

toShelleyCertificate (StakeAddressDeregistrationCertificate StakeCredential
stakecred) =
    forall crypto. DelegCert crypto -> DCert crypto
Shelley.DCertDeleg forall a b. (a -> b) -> a -> b
$
      forall crypto. StakeCredential crypto -> DelegCert crypto
Shelley.DeRegKey
        (StakeCredential -> Credential 'Staking StandardCrypto
toShelleyStakeCredential StakeCredential
stakecred)

toShelleyCertificate (StakeAddressDelegationCertificate
                        StakeCredential
stakecred (StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolid)) =
    forall crypto. DelegCert crypto -> DCert crypto
Shelley.DCertDeleg forall a b. (a -> b) -> a -> b
$
    forall crypto. Delegation crypto -> DelegCert crypto
Shelley.Delegate forall a b. (a -> b) -> a -> b
$
      forall crypto.
StakeCredential crypto
-> KeyHash 'StakePool crypto -> Delegation crypto
Shelley.Delegation
        (StakeCredential -> Credential 'Staking StandardCrypto
toShelleyStakeCredential StakeCredential
stakecred)
        KeyHash 'StakePool StandardCrypto
poolid

toShelleyCertificate (StakePoolRegistrationCertificate StakePoolParameters
poolparams) =
    forall crypto. PoolCert crypto -> DCert crypto
Shelley.DCertPool forall a b. (a -> b) -> a -> b
$
      forall crypto. PoolParams crypto -> PoolCert crypto
Shelley.RegPool
        (StakePoolParameters -> PoolParams StandardCrypto
toShelleyPoolParams StakePoolParameters
poolparams)

toShelleyCertificate (StakePoolRetirementCertificate
                       (StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolid) EpochNo
epochno) =
    forall crypto. PoolCert crypto -> DCert crypto
Shelley.DCertPool forall a b. (a -> b) -> a -> b
$
      forall crypto.
KeyHash 'StakePool crypto -> EpochNo -> PoolCert crypto
Shelley.RetirePool
        KeyHash 'StakePool StandardCrypto
poolid
        EpochNo
epochno

toShelleyCertificate (GenesisKeyDelegationCertificate
                       (GenesisKeyHash         KeyHash 'Genesis StandardCrypto
genesiskh)
                       (GenesisDelegateKeyHash KeyHash 'GenesisDelegate StandardCrypto
delegatekh)
                       (VrfKeyHash             Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh)) =
    forall crypto. GenesisDelegCert crypto -> DCert crypto
Shelley.DCertGenesis forall a b. (a -> b) -> a -> b
$
      forall crypto.
KeyHash 'Genesis crypto
-> KeyHash 'GenesisDelegate crypto
-> Hash crypto (VerKeyVRF crypto)
-> GenesisDelegCert crypto
Shelley.GenesisDelegCert
        KeyHash 'Genesis StandardCrypto
genesiskh
        KeyHash 'GenesisDelegate StandardCrypto
delegatekh
        Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh

toShelleyCertificate (MIRCertificate MIRPot
mirpot (StakeAddressesMIR [(StakeCredential, Lovelace)]
amounts)) =
    forall crypto. MIRCert crypto -> DCert crypto
Shelley.DCertMir forall a b. (a -> b) -> a -> b
$
      forall crypto. MIRPot -> MIRTarget crypto -> MIRCert crypto
Shelley.MIRCert
        MIRPot
mirpot
        (forall crypto.
Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto
Shelley.StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>)
           [ (StakeCredential -> Credential 'Staking StandardCrypto
toShelleyStakeCredential StakeCredential
sc, Coin -> DeltaCoin
Shelley.toDeltaCoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Coin
toShelleyLovelace forall a b. (a -> b) -> a -> b
$ Lovelace
v)
           | (StakeCredential
sc, Lovelace
v) <- [(StakeCredential, Lovelace)]
amounts ])

toShelleyCertificate (MIRCertificate MIRPot
mirPot (SendToReservesMIR Lovelace
amount)) =
    case MIRPot
mirPot of
      MIRPot
TreasuryMIR ->
        forall crypto. MIRCert crypto -> DCert crypto
Shelley.DCertMir forall a b. (a -> b) -> a -> b
$
          forall crypto. MIRPot -> MIRTarget crypto -> MIRCert crypto
Shelley.MIRCert
            MIRPot
TreasuryMIR
            (forall crypto. Coin -> MIRTarget crypto
Shelley.SendToOppositePotMIR forall a b. (a -> b) -> a -> b
$ Lovelace -> Coin
toShelleyLovelace Lovelace
amount)
      MIRPot
ReservesMIR ->
        forall a. HasCallStack => String -> a
error String
"toShelleyCertificate: Incorrect MIRPot specified. Expected TreasuryMIR but got ReservesMIR"

toShelleyCertificate (MIRCertificate MIRPot
mirPot (SendToTreasuryMIR Lovelace
amount)) =
    case MIRPot
mirPot of
      MIRPot
ReservesMIR ->
        forall crypto. MIRCert crypto -> DCert crypto
Shelley.DCertMir forall a b. (a -> b) -> a -> b
$
          forall crypto. MIRPot -> MIRTarget crypto -> MIRCert crypto
Shelley.MIRCert
            MIRPot
ReservesMIR
            (forall crypto. Coin -> MIRTarget crypto
Shelley.SendToOppositePotMIR forall a b. (a -> b) -> a -> b
$ Lovelace -> Coin
toShelleyLovelace Lovelace
amount)
      MIRPot
TreasuryMIR ->
        forall a. HasCallStack => String -> a
error String
"toShelleyCertificate: Incorrect MIRPot specified. Expected ReservesMIR but got TreasuryMIR"


fromShelleyCertificate :: Shelley.DCert StandardCrypto -> Certificate
fromShelleyCertificate :: DCert StandardCrypto -> Certificate
fromShelleyCertificate (Shelley.DCertDeleg (Shelley.RegKey Credential 'Staking StandardCrypto
stakecred)) =
    StakeCredential -> Certificate
StakeAddressRegistrationCertificate
      (Credential 'Staking StandardCrypto -> StakeCredential
fromShelleyStakeCredential Credential 'Staking StandardCrypto
stakecred)

fromShelleyCertificate (Shelley.DCertDeleg (Shelley.DeRegKey Credential 'Staking StandardCrypto
stakecred)) =
    StakeCredential -> Certificate
StakeAddressDeregistrationCertificate
      (Credential 'Staking StandardCrypto -> StakeCredential
fromShelleyStakeCredential Credential 'Staking StandardCrypto
stakecred)

fromShelleyCertificate (Shelley.DCertDeleg
                         (Shelley.Delegate (Shelley.Delegation Credential 'Staking StandardCrypto
stakecred KeyHash 'StakePool StandardCrypto
poolid))) =
    StakeCredential -> PoolId -> Certificate
StakeAddressDelegationCertificate
      (Credential 'Staking StandardCrypto -> StakeCredential
fromShelleyStakeCredential Credential 'Staking StandardCrypto
stakecred)
      (KeyHash 'StakePool StandardCrypto -> PoolId
StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolid)

fromShelleyCertificate (Shelley.DCertPool (Shelley.RegPool PoolParams StandardCrypto
poolparams)) =
    StakePoolParameters -> Certificate
StakePoolRegistrationCertificate
      (PoolParams StandardCrypto -> StakePoolParameters
fromShelleyPoolParams PoolParams StandardCrypto
poolparams)

fromShelleyCertificate (Shelley.DCertPool (Shelley.RetirePool KeyHash 'StakePool StandardCrypto
poolid EpochNo
epochno)) =
    PoolId -> EpochNo -> Certificate
StakePoolRetirementCertificate
      (KeyHash 'StakePool StandardCrypto -> PoolId
StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolid)
      EpochNo
epochno

fromShelleyCertificate (Shelley.DCertGenesis
                         (Shelley.GenesisDelegCert KeyHash 'Genesis StandardCrypto
genesiskh KeyHash 'GenesisDelegate StandardCrypto
delegatekh Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh)) =
    Hash GenesisKey
-> Hash GenesisDelegateKey -> Hash VrfKey -> Certificate
GenesisKeyDelegationCertificate
      (KeyHash 'Genesis StandardCrypto -> Hash GenesisKey
GenesisKeyHash         KeyHash 'Genesis StandardCrypto
genesiskh)
      (KeyHash 'GenesisDelegate StandardCrypto -> Hash GenesisDelegateKey
GenesisDelegateKeyHash KeyHash 'GenesisDelegate StandardCrypto
delegatekh)
      (Hash StandardCrypto (VerKeyVRF StandardCrypto) -> Hash VrfKey
VrfKeyHash             Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh)

fromShelleyCertificate (Shelley.DCertMir
                         (Shelley.MIRCert MIRPot
mirpot (Shelley.StakeAddressesMIR Map (Credential 'Staking StandardCrypto) DeltaCoin
amounts))) =
    MIRPot -> MIRTarget -> Certificate
MIRCertificate
      MIRPot
mirpot
      ([(StakeCredential, Lovelace)] -> MIRTarget
StakeAddressesMIR
        [ (Credential 'Staking StandardCrypto -> StakeCredential
fromShelleyStakeCredential Credential 'Staking StandardCrypto
sc, DeltaCoin -> Lovelace
fromShelleyDeltaLovelace DeltaCoin
v)
        | (Credential 'Staking StandardCrypto
sc, DeltaCoin
v) <- forall k a. Map k a -> [(k, a)]
Map.toList Map (Credential 'Staking StandardCrypto) DeltaCoin
amounts ]
      )
fromShelleyCertificate (Shelley.DCertMir
                         (Shelley.MIRCert MIRPot
ReservesMIR (Shelley.SendToOppositePotMIR Coin
amount))) =
    MIRPot -> MIRTarget -> Certificate
MIRCertificate MIRPot
ReservesMIR
      (Lovelace -> MIRTarget
SendToTreasuryMIR forall a b. (a -> b) -> a -> b
$ Coin -> Lovelace
fromShelleyLovelace Coin
amount)

fromShelleyCertificate (Shelley.DCertMir
                         (Shelley.MIRCert MIRPot
TreasuryMIR (Shelley.SendToOppositePotMIR Coin
amount))) =
    MIRPot -> MIRTarget -> Certificate
MIRCertificate MIRPot
TreasuryMIR
      (Lovelace -> MIRTarget
SendToReservesMIR forall a b. (a -> b) -> a -> b
$ Coin -> Lovelace
fromShelleyLovelace Coin
amount)

toShelleyPoolParams :: StakePoolParameters -> Shelley.PoolParams StandardCrypto
toShelleyPoolParams :: StakePoolParameters -> PoolParams StandardCrypto
toShelleyPoolParams StakePoolParameters {
                      stakePoolId :: StakePoolParameters -> PoolId
stakePoolId            = StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolkh
                    , stakePoolVRF :: StakePoolParameters -> Hash VrfKey
stakePoolVRF           = VrfKeyHash Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh
                    , Lovelace
stakePoolCost :: Lovelace
stakePoolCost :: StakePoolParameters -> Lovelace
stakePoolCost
                    , Rational
stakePoolMargin :: Rational
stakePoolMargin :: StakePoolParameters -> Rational
stakePoolMargin
                    , StakeAddress
stakePoolRewardAccount :: StakeAddress
stakePoolRewardAccount :: StakePoolParameters -> StakeAddress
stakePoolRewardAccount
                    , Lovelace
stakePoolPledge :: Lovelace
stakePoolPledge :: StakePoolParameters -> Lovelace
stakePoolPledge
                    , [Hash StakeKey]
stakePoolOwners :: [Hash StakeKey]
stakePoolOwners :: StakePoolParameters -> [Hash StakeKey]
stakePoolOwners
                    , [StakePoolRelay]
stakePoolRelays :: [StakePoolRelay]
stakePoolRelays :: StakePoolParameters -> [StakePoolRelay]
stakePoolRelays
                    , Maybe StakePoolMetadataReference
stakePoolMetadata :: Maybe StakePoolMetadataReference
stakePoolMetadata :: StakePoolParameters -> Maybe StakePoolMetadataReference
stakePoolMetadata
                    } =
    --TODO: validate pool parameters such as the PoolMargin below, but also
    -- do simple client-side sanity checks, e.g. on the pool metadata url
    Shelley.PoolParams {
      _poolId :: KeyHash 'StakePool StandardCrypto
Shelley._poolId     = KeyHash 'StakePool StandardCrypto
poolkh
    , _poolVrf :: Hash StandardCrypto (VerKeyVRF StandardCrypto)
Shelley._poolVrf    = Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh
    , _poolPledge :: Coin
Shelley._poolPledge = Lovelace -> Coin
toShelleyLovelace Lovelace
stakePoolPledge
    , _poolCost :: Coin
Shelley._poolCost   = Lovelace -> Coin
toShelleyLovelace Lovelace
stakePoolCost
    , _poolMargin :: UnitInterval
Shelley._poolMargin = forall a. a -> Maybe a -> a
fromMaybe
                              (forall a. HasCallStack => String -> a
error String
"toShelleyPoolParams: invalid PoolMargin")
                              (forall r. BoundedRational r => Rational -> Maybe r
Shelley.boundRational Rational
stakePoolMargin)
    , _poolRAcnt :: RewardAcnt StandardCrypto
Shelley._poolRAcnt  = StakeAddress -> RewardAcnt StandardCrypto
toShelleyStakeAddr StakeAddress
stakePoolRewardAccount
    , _poolOwners :: Set (KeyHash 'Staking StandardCrypto)
Shelley._poolOwners = forall a. Ord a => [a] -> Set a
Set.fromList
                              [ KeyHash 'Staking StandardCrypto
kh | StakeKeyHash KeyHash 'Staking StandardCrypto
kh <- [Hash StakeKey]
stakePoolOwners ]
    , _poolRelays :: StrictSeq StakePoolRelay
Shelley._poolRelays = forall a. [a] -> StrictSeq a
Seq.fromList
                              (forall a b. (a -> b) -> [a] -> [b]
map StakePoolRelay -> StakePoolRelay
toShelleyStakePoolRelay [StakePoolRelay]
stakePoolRelays)
    , _poolMD :: StrictMaybe PoolMetadata
Shelley._poolMD     = StakePoolMetadataReference -> PoolMetadata
toShelleyPoolMetadata forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                              forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe StakePoolMetadataReference
stakePoolMetadata
    }
  where
    toShelleyStakePoolRelay :: StakePoolRelay -> Shelley.StakePoolRelay
    toShelleyStakePoolRelay :: StakePoolRelay -> StakePoolRelay
toShelleyStakePoolRelay (StakePoolRelayIp Maybe IPv4
mipv4 Maybe IPv6
mipv6 Maybe PortNumber
mport) =
      StrictMaybe Port
-> StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay
Shelley.SingleHostAddr
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe PortNumber
mport)
        (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe IPv4
mipv4)
        (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe IPv6
mipv6)

    toShelleyStakePoolRelay (StakePoolRelayDnsARecord ByteString
dnsname Maybe PortNumber
mport) =
      StrictMaybe Port -> DnsName -> StakePoolRelay
Shelley.SingleHostName
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe PortNumber
mport)
        (ByteString -> DnsName
toShelleyDnsName ByteString
dnsname)

    toShelleyStakePoolRelay (StakePoolRelayDnsSrvRecord ByteString
dnsname) =
      DnsName -> StakePoolRelay
Shelley.MultiHostName
        (ByteString -> DnsName
toShelleyDnsName ByteString
dnsname)

    toShelleyPoolMetadata :: StakePoolMetadataReference -> Shelley.PoolMetadata
    toShelleyPoolMetadata :: StakePoolMetadataReference -> PoolMetadata
toShelleyPoolMetadata StakePoolMetadataReference {
                            Text
stakePoolMetadataURL :: Text
stakePoolMetadataURL :: StakePoolMetadataReference -> Text
stakePoolMetadataURL
                          , stakePoolMetadataHash :: StakePoolMetadataReference -> Hash StakePoolMetadata
stakePoolMetadataHash = StakePoolMetadataHash Hash StandardCrypto ByteString
mdh
                          } =
      Shelley.PoolMetadata {
        _poolMDUrl :: Url
Shelley._poolMDUrl  = Text -> Url
toShelleyUrl Text
stakePoolMetadataURL
      , _poolMDHash :: ByteString
Shelley._poolMDHash = forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash StandardCrypto ByteString
mdh
      }

    toShelleyDnsName :: ByteString -> Shelley.DnsName
    toShelleyDnsName :: ByteString -> DnsName
toShelleyDnsName = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"toShelleyDnsName: invalid dns name. TODO: proper validation")
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe DnsName
Shelley.textToDns
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeLatin1

    toShelleyUrl :: Text -> Shelley.Url
    toShelleyUrl :: Text -> Url
toShelleyUrl = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"toShelleyUrl: invalid url. TODO: proper validation")
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Url
Shelley.textToUrl


fromShelleyPoolParams :: Shelley.PoolParams StandardCrypto
                      -> StakePoolParameters
fromShelleyPoolParams :: PoolParams StandardCrypto -> StakePoolParameters
fromShelleyPoolParams
    Shelley.PoolParams {
      KeyHash 'StakePool StandardCrypto
_poolId :: KeyHash 'StakePool StandardCrypto
_poolId :: forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
Shelley._poolId
    , Hash StandardCrypto (VerKeyVRF StandardCrypto)
_poolVrf :: Hash StandardCrypto (VerKeyVRF StandardCrypto)
_poolVrf :: forall crypto. PoolParams crypto -> Hash crypto (VerKeyVRF crypto)
Shelley._poolVrf
    , Coin
_poolPledge :: Coin
_poolPledge :: forall crypto. PoolParams crypto -> Coin
Shelley._poolPledge
    , Coin
_poolCost :: Coin
_poolCost :: forall crypto. PoolParams crypto -> Coin
Shelley._poolCost
    , UnitInterval
_poolMargin :: UnitInterval
_poolMargin :: forall crypto. PoolParams crypto -> UnitInterval
Shelley._poolMargin
    , RewardAcnt StandardCrypto
_poolRAcnt :: RewardAcnt StandardCrypto
_poolRAcnt :: forall crypto. PoolParams crypto -> RewardAcnt crypto
Shelley._poolRAcnt
    , Set (KeyHash 'Staking StandardCrypto)
_poolOwners :: Set (KeyHash 'Staking StandardCrypto)
_poolOwners :: forall crypto. PoolParams crypto -> Set (KeyHash 'Staking crypto)
Shelley._poolOwners
    , StrictSeq StakePoolRelay
_poolRelays :: StrictSeq StakePoolRelay
_poolRelays :: forall crypto. PoolParams crypto -> StrictSeq StakePoolRelay
Shelley._poolRelays
    , StrictMaybe PoolMetadata
_poolMD :: StrictMaybe PoolMetadata
_poolMD :: forall crypto. PoolParams crypto -> StrictMaybe PoolMetadata
Shelley._poolMD
    } =
    StakePoolParameters {
      stakePoolId :: PoolId
stakePoolId            = KeyHash 'StakePool StandardCrypto -> PoolId
StakePoolKeyHash KeyHash 'StakePool StandardCrypto
_poolId
    , stakePoolVRF :: Hash VrfKey
stakePoolVRF           = Hash StandardCrypto (VerKeyVRF StandardCrypto) -> Hash VrfKey
VrfKeyHash Hash StandardCrypto (VerKeyVRF StandardCrypto)
_poolVrf
    , stakePoolCost :: Lovelace
stakePoolCost          = Coin -> Lovelace
fromShelleyLovelace Coin
_poolCost
    , stakePoolMargin :: Rational
stakePoolMargin        = forall r. BoundedRational r => r -> Rational
Shelley.unboundRational UnitInterval
_poolMargin
    , stakePoolRewardAccount :: StakeAddress
stakePoolRewardAccount = RewardAcnt StandardCrypto -> StakeAddress
fromShelleyStakeAddr RewardAcnt StandardCrypto
_poolRAcnt
    , stakePoolPledge :: Lovelace
stakePoolPledge        = Coin -> Lovelace
fromShelleyLovelace Coin
_poolPledge
    , stakePoolOwners :: [Hash StakeKey]
stakePoolOwners        = forall a b. (a -> b) -> [a] -> [b]
map KeyHash 'Staking StandardCrypto -> Hash StakeKey
StakeKeyHash (forall a. Set a -> [a]
Set.toList Set (KeyHash 'Staking StandardCrypto)
_poolOwners)
    , stakePoolRelays :: [StakePoolRelay]
stakePoolRelays        = forall a b. (a -> b) -> [a] -> [b]
map StakePoolRelay -> StakePoolRelay
fromShelleyStakePoolRelay
                                   (forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList StrictSeq StakePoolRelay
_poolRelays)
    , stakePoolMetadata :: Maybe StakePoolMetadataReference
stakePoolMetadata      = PoolMetadata -> StakePoolMetadataReference
fromShelleyPoolMetadata forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                 forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe PoolMetadata
_poolMD
    }
  where
    fromShelleyStakePoolRelay :: Shelley.StakePoolRelay -> StakePoolRelay
    fromShelleyStakePoolRelay :: StakePoolRelay -> StakePoolRelay
fromShelleyStakePoolRelay (Shelley.SingleHostAddr StrictMaybe Port
mport StrictMaybe IPv4
mipv4 StrictMaybe IPv6
mipv6) =
      Maybe IPv4 -> Maybe IPv6 -> Maybe PortNumber -> StakePoolRelay
StakePoolRelayIp
        (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe IPv4
mipv4)
        (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe IPv6
mipv6)
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Word16
Shelley.portToWord16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Port
mport)

    fromShelleyStakePoolRelay (Shelley.SingleHostName StrictMaybe Port
mport DnsName
dnsname) =
      ByteString -> Maybe PortNumber -> StakePoolRelay
StakePoolRelayDnsARecord
        (DnsName -> ByteString
fromShelleyDnsName DnsName
dnsname)
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Word16
Shelley.portToWord16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Port
mport)

    fromShelleyStakePoolRelay (Shelley.MultiHostName DnsName
dnsname) =
      ByteString -> StakePoolRelay
StakePoolRelayDnsSrvRecord
        (DnsName -> ByteString
fromShelleyDnsName DnsName
dnsname)

    fromShelleyPoolMetadata :: Shelley.PoolMetadata -> StakePoolMetadataReference
    fromShelleyPoolMetadata :: PoolMetadata -> StakePoolMetadataReference
fromShelleyPoolMetadata Shelley.PoolMetadata {
                              Url
_poolMDUrl :: Url
_poolMDUrl :: PoolMetadata -> Url
Shelley._poolMDUrl
                            , ByteString
_poolMDHash :: ByteString
_poolMDHash :: PoolMetadata -> ByteString
Shelley._poolMDHash
                            } =
      StakePoolMetadataReference {
        stakePoolMetadataURL :: Text
stakePoolMetadataURL  = Url -> Text
Shelley.urlToText Url
_poolMDUrl
      , stakePoolMetadataHash :: Hash StakePoolMetadata
stakePoolMetadataHash = Hash StandardCrypto ByteString -> Hash StakePoolMetadata
StakePoolMetadataHash
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"fromShelleyPoolMetadata: invalid hash. TODO: proper validation")
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes
                              forall a b. (a -> b) -> a -> b
$ ByteString
_poolMDHash
      }

    --TODO: change the ledger rep of the DNS name to use ShortByteString
    fromShelleyDnsName :: Shelley.DnsName -> ByteString
    fromShelleyDnsName :: DnsName -> ByteString
fromShelleyDnsName = Text -> ByteString
Text.encodeUtf8
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. DnsName -> Text
Shelley.dnsToText