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

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.HasTypeProxy
import           Cardano.Api.Hash
import           Cardano.Api.KeysByron
import           Cardano.Api.KeysPraos
import           Cardano.Api.KeysShelley
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
(Certificate -> Certificate -> Bool)
-> (Certificate -> Certificate -> Bool) -> Eq Certificate
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
(Int -> Certificate -> ShowS)
-> (Certificate -> String)
-> ([Certificate] -> ShowS)
-> Show Certificate
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
HasTypeProxy Certificate
-> (Certificate -> ByteString)
-> (AsType Certificate
    -> ByteString -> Either DecoderError Certificate)
-> SerialiseAsCBOR 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
$cp1SerialiseAsCBOR :: HasTypeProxy Certificate
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 = DCert StandardCrypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (DCert StandardCrypto -> Encoding)
-> (Certificate -> DCert StandardCrypto) -> Certificate -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Certificate -> DCert StandardCrypto
toShelleyCertificate

instance FromCBOR Certificate where
    fromCBOR :: Decoder s Certificate
fromCBOR = DCert StandardCrypto -> Certificate
fromShelleyCertificate (DCert StandardCrypto -> Certificate)
-> Decoder s (DCert StandardCrypto) -> Decoder s Certificate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (DCert StandardCrypto)
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
(MIRTarget -> MIRTarget -> Bool)
-> (MIRTarget -> MIRTarget -> Bool) -> Eq MIRTarget
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
(Int -> MIRTarget -> ShowS)
-> (MIRTarget -> String)
-> ([MIRTarget] -> ShowS)
-> Show MIRTarget
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
(StakePoolParameters -> StakePoolParameters -> Bool)
-> (StakePoolParameters -> StakePoolParameters -> Bool)
-> Eq StakePoolParameters
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
(Int -> StakePoolParameters -> ShowS)
-> (StakePoolParameters -> String)
-> ([StakePoolParameters] -> ShowS)
-> Show StakePoolParameters
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
(StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> Bool) -> Eq StakePoolRelay
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
(Int -> StakePoolRelay -> ShowS)
-> (StakePoolRelay -> String)
-> ([StakePoolRelay] -> ShowS)
-> Show StakePoolRelay
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
(StakePoolMetadataReference -> StakePoolMetadataReference -> Bool)
-> (StakePoolMetadataReference
    -> StakePoolMetadataReference -> Bool)
-> Eq StakePoolMetadataReference
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
(Int -> StakePoolMetadataReference -> ShowS)
-> (StakePoolMetadataReference -> String)
-> ([StakePoolMetadataReference] -> ShowS)
-> Show StakePoolMetadataReference
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) =
    DelegCert StandardCrypto -> DCert StandardCrypto
forall crypto. DelegCert crypto -> DCert crypto
Shelley.DCertDeleg (DelegCert StandardCrypto -> DCert StandardCrypto)
-> DelegCert StandardCrypto -> DCert StandardCrypto
forall a b. (a -> b) -> a -> b
$
      StakeCredential StandardCrypto -> DelegCert StandardCrypto
forall crypto. StakeCredential crypto -> DelegCert crypto
Shelley.RegKey
        (StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
stakecred)

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

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

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

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

toShelleyCertificate (GenesisKeyDelegationCertificate
                       (GenesisKeyHash         genesiskh)
                       (GenesisDelegateKeyHash delegatekh)
                       (VrfKeyHash             vrfkh)) =
    GenesisDelegCert StandardCrypto -> DCert StandardCrypto
forall crypto. GenesisDelegCert crypto -> DCert crypto
Shelley.DCertGenesis (GenesisDelegCert StandardCrypto -> DCert StandardCrypto)
-> GenesisDelegCert StandardCrypto -> DCert StandardCrypto
forall a b. (a -> b) -> a -> b
$
      KeyHash 'Genesis StandardCrypto
-> KeyHash 'GenesisDelegate StandardCrypto
-> Hash StandardCrypto (VerKeyVRF StandardCrypto)
-> GenesisDelegCert StandardCrypto
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)) =
    MIRCert StandardCrypto -> DCert StandardCrypto
forall crypto. MIRCert crypto -> DCert crypto
Shelley.DCertMir (MIRCert StandardCrypto -> DCert StandardCrypto)
-> MIRCert StandardCrypto -> DCert StandardCrypto
forall a b. (a -> b) -> a -> b
$
      MIRPot -> MIRTarget StandardCrypto -> MIRCert StandardCrypto
forall crypto. MIRPot -> MIRTarget crypto -> MIRCert crypto
Shelley.MIRCert
        MIRPot
mirpot
        (Map (StakeCredential StandardCrypto) DeltaCoin
-> MIRTarget StandardCrypto
forall crypto.
Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto
Shelley.StakeAddressesMIR (Map (StakeCredential StandardCrypto) DeltaCoin
 -> MIRTarget StandardCrypto)
-> Map (StakeCredential StandardCrypto) DeltaCoin
-> MIRTarget StandardCrypto
forall a b. (a -> b) -> a -> b
$ (DeltaCoin -> DeltaCoin -> DeltaCoin)
-> [(StakeCredential StandardCrypto, DeltaCoin)]
-> Map (StakeCredential StandardCrypto) DeltaCoin
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith DeltaCoin -> DeltaCoin -> DeltaCoin
forall a. Semigroup a => a -> a -> a
(<>)
           [ (StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
sc, Coin -> DeltaCoin
Shelley.toDeltaCoin (Coin -> DeltaCoin) -> (Lovelace -> Coin) -> Lovelace -> DeltaCoin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Coin
toShelleyLovelace (Lovelace -> DeltaCoin) -> Lovelace -> DeltaCoin
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 ->
        MIRCert StandardCrypto -> DCert StandardCrypto
forall crypto. MIRCert crypto -> DCert crypto
Shelley.DCertMir (MIRCert StandardCrypto -> DCert StandardCrypto)
-> MIRCert StandardCrypto -> DCert StandardCrypto
forall a b. (a -> b) -> a -> b
$
          MIRPot -> MIRTarget StandardCrypto -> MIRCert StandardCrypto
forall crypto. MIRPot -> MIRTarget crypto -> MIRCert crypto
Shelley.MIRCert
            MIRPot
TreasuryMIR
            (Coin -> MIRTarget StandardCrypto
forall crypto. Coin -> MIRTarget crypto
Shelley.SendToOppositePotMIR (Coin -> MIRTarget StandardCrypto)
-> Coin -> MIRTarget StandardCrypto
forall a b. (a -> b) -> a -> b
$ Lovelace -> Coin
toShelleyLovelace Lovelace
amount)
      MIRPot
ReservesMIR ->
        String -> DCert StandardCrypto
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 ->
        MIRCert StandardCrypto -> DCert StandardCrypto
forall crypto. MIRCert crypto -> DCert crypto
Shelley.DCertMir (MIRCert StandardCrypto -> DCert StandardCrypto)
-> MIRCert StandardCrypto -> DCert StandardCrypto
forall a b. (a -> b) -> a -> b
$
          MIRPot -> MIRTarget StandardCrypto -> MIRCert StandardCrypto
forall crypto. MIRPot -> MIRTarget crypto -> MIRCert crypto
Shelley.MIRCert
            MIRPot
ReservesMIR
            (Coin -> MIRTarget StandardCrypto
forall crypto. Coin -> MIRTarget crypto
Shelley.SendToOppositePotMIR (Coin -> MIRTarget StandardCrypto)
-> Coin -> MIRTarget StandardCrypto
forall a b. (a -> b) -> a -> b
$ Lovelace -> Coin
toShelleyLovelace Lovelace
amount)
      MIRPot
TreasuryMIR ->
        String -> DCert StandardCrypto
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 StakeCredential StandardCrypto
stakecred)) =
    StakeCredential -> Certificate
StakeAddressRegistrationCertificate
      (StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential StakeCredential StandardCrypto
stakecred)

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

fromShelleyCertificate (Shelley.DCertDeleg
                         (Shelley.Delegate (Shelley.Delegation StakeCredential StandardCrypto
stakecred KeyHash 'StakePool StandardCrypto
poolid))) =
    StakeCredential -> PoolId -> Certificate
StakeAddressDelegationCertificate
      (StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential StakeCredential 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 (StakeCredential StandardCrypto) DeltaCoin
amounts))) =
    MIRPot -> MIRTarget -> Certificate
MIRCertificate
      MIRPot
mirpot
      ([(StakeCredential, Lovelace)] -> MIRTarget
StakeAddressesMIR
        [ (StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential StakeCredential StandardCrypto
sc, DeltaCoin -> Lovelace
fromShelleyDeltaLovelace DeltaCoin
v)
        | (StakeCredential StandardCrypto
sc, DeltaCoin
v) <- Map (StakeCredential StandardCrypto) DeltaCoin
-> [(StakeCredential StandardCrypto, DeltaCoin)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (StakeCredential StandardCrypto) DeltaCoin
amounts ]
      )
fromShelleyCertificate (Shelley.DCertMir
                         (Shelley.MIRCert MIRPot
ReservesMIR (Shelley.SendToOppositePotMIR Coin
amount))) =
    MIRPot -> MIRTarget -> Certificate
MIRCertificate MIRPot
ReservesMIR
      (Lovelace -> MIRTarget
SendToTreasuryMIR (Lovelace -> MIRTarget) -> Lovelace -> MIRTarget
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 (Lovelace -> MIRTarget) -> Lovelace -> MIRTarget
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 poolkh
                    , stakePoolVRF :: StakePoolParameters -> Hash VrfKey
stakePoolVRF           = VrfKeyHash 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
    PoolParams :: forall crypto.
KeyHash 'StakePool crypto
-> Hash crypto (VerKeyVRF crypto)
-> Coin
-> Coin
-> UnitInterval
-> RewardAcnt crypto
-> Set (KeyHash 'Staking crypto)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams crypto
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 = UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
                              (String -> UnitInterval
forall a. HasCallStack => String -> a
error String
"toShelleyPoolParams: invalid PoolMargin")
                              (Rational -> Maybe UnitInterval
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 = [KeyHash 'Staking StandardCrypto]
-> Set (KeyHash 'Staking StandardCrypto)
forall a. Ord a => [a] -> Set a
Set.fromList
                              [ KeyHash 'Staking StandardCrypto
kh | StakeKeyHash kh <- [Hash StakeKey]
stakePoolOwners ]
    , _poolRelays :: StrictSeq StakePoolRelay
Shelley._poolRelays = [StakePoolRelay] -> StrictSeq StakePoolRelay
forall a. [a] -> StrictSeq a
Seq.fromList
                              ((StakePoolRelay -> StakePoolRelay)
-> [StakePoolRelay] -> [StakePoolRelay]
forall a b. (a -> b) -> [a] -> [b]
map StakePoolRelay -> StakePoolRelay
toShelleyStakePoolRelay [StakePoolRelay]
stakePoolRelays)
    , _poolMD :: StrictMaybe PoolMetadata
Shelley._poolMD     = StakePoolMetadataReference -> PoolMetadata
toShelleyPoolMetadata (StakePoolMetadataReference -> PoolMetadata)
-> StrictMaybe StakePoolMetadataReference
-> StrictMaybe PoolMetadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                              Maybe StakePoolMetadataReference
-> StrictMaybe StakePoolMetadataReference
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
        (PortNumber -> Port
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PortNumber -> Port) -> StrictMaybe PortNumber -> StrictMaybe Port
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PortNumber -> StrictMaybe PortNumber
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe PortNumber
mport)
        (Maybe IPv4 -> StrictMaybe IPv4
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe IPv4
mipv4)
        (Maybe IPv6 -> StrictMaybe IPv6
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe IPv6
mipv6)

    toShelleyStakePoolRelay (StakePoolRelayDnsARecord ByteString
dnsname Maybe PortNumber
mport) =
      StrictMaybe Port -> DnsName -> StakePoolRelay
Shelley.SingleHostName
        (PortNumber -> Port
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PortNumber -> Port) -> StrictMaybe PortNumber -> StrictMaybe Port
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PortNumber -> StrictMaybe PortNumber
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 mdh
                          } =
      PoolMetadata :: Url -> ByteString -> PoolMetadata
Shelley.PoolMetadata {
        _poolMDUrl :: Url
Shelley._poolMDUrl  = Text -> Url
toShelleyUrl Text
stakePoolMetadataURL
      , _poolMDHash :: ByteString
Shelley._poolMDHash = Hash Blake2b_256 ByteString -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_256 ByteString
Hash StandardCrypto ByteString
mdh
      }

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

    toShelleyUrl :: Text -> Shelley.Url
    toShelleyUrl :: Text -> Url
toShelleyUrl = Url -> Maybe Url -> Url
forall a. a -> Maybe a -> a
fromMaybe (String -> Url
forall a. HasCallStack => String -> a
error String
"toShelleyUrl: invalid url. TODO: proper validation")
                 (Maybe Url -> Url) -> (Text -> Maybe Url) -> Text -> Url
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 :: PoolId
-> Hash VrfKey
-> Lovelace
-> Rational
-> StakeAddress
-> Lovelace
-> [Hash StakeKey]
-> [StakePoolRelay]
-> Maybe StakePoolMetadataReference
-> StakePoolParameters
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        = UnitInterval -> Rational
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        = (KeyHash 'Staking StandardCrypto -> Hash StakeKey)
-> [KeyHash 'Staking StandardCrypto] -> [Hash StakeKey]
forall a b. (a -> b) -> [a] -> [b]
map KeyHash 'Staking StandardCrypto -> Hash StakeKey
StakeKeyHash (Set (KeyHash 'Staking StandardCrypto)
-> [KeyHash 'Staking StandardCrypto]
forall a. Set a -> [a]
Set.toList Set (KeyHash 'Staking StandardCrypto)
_poolOwners)
    , stakePoolRelays :: [StakePoolRelay]
stakePoolRelays        = (StakePoolRelay -> StakePoolRelay)
-> [StakePoolRelay] -> [StakePoolRelay]
forall a b. (a -> b) -> [a] -> [b]
map StakePoolRelay -> StakePoolRelay
fromShelleyStakePoolRelay
                                   (StrictSeq StakePoolRelay -> [StakePoolRelay]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList StrictSeq StakePoolRelay
_poolRelays)
    , stakePoolMetadata :: Maybe StakePoolMetadataReference
stakePoolMetadata      = PoolMetadata -> StakePoolMetadataReference
fromShelleyPoolMetadata (PoolMetadata -> StakePoolMetadataReference)
-> Maybe PoolMetadata -> Maybe StakePoolMetadataReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                 StrictMaybe PoolMetadata -> Maybe PoolMetadata
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
        (StrictMaybe IPv4 -> Maybe IPv4
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe IPv4
mipv4)
        (StrictMaybe IPv6 -> Maybe IPv6
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe IPv6
mipv6)
        (Word16 -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> PortNumber) -> (Port -> Word16) -> Port -> PortNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Word16
Shelley.portToWord16 (Port -> PortNumber) -> Maybe Port -> Maybe PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe Port -> Maybe Port
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)
        (Word16 -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> PortNumber) -> (Port -> Word16) -> Port -> PortNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Word16
Shelley.portToWord16 (Port -> PortNumber) -> Maybe Port -> Maybe PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe Port -> Maybe Port
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 :: Text -> Hash StakePoolMetadata -> StakePoolMetadataReference
StakePoolMetadataReference {
        stakePoolMetadataURL :: Text
stakePoolMetadataURL  = Url -> Text
Shelley.urlToText Url
_poolMDUrl
      , stakePoolMetadataHash :: Hash StakePoolMetadata
stakePoolMetadataHash = Hash Blake2b_256 ByteString -> Hash StakePoolMetadata
Hash StandardCrypto ByteString -> Hash StakePoolMetadata
StakePoolMetadataHash
                              (Hash Blake2b_256 ByteString -> Hash StakePoolMetadata)
-> (ByteString -> Hash Blake2b_256 ByteString)
-> ByteString
-> Hash StakePoolMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 ByteString
-> Maybe (Hash Blake2b_256 ByteString)
-> Hash Blake2b_256 ByteString
forall a. a -> Maybe a -> a
fromMaybe (String -> Hash Blake2b_256 ByteString
forall a. HasCallStack => String -> a
error String
"fromShelleyPoolMetadata: invalid hash. TODO: proper validation")
                              (Maybe (Hash Blake2b_256 ByteString)
 -> Hash Blake2b_256 ByteString)
-> (ByteString -> Maybe (Hash Blake2b_256 ByteString))
-> ByteString
-> Hash Blake2b_256 ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Hash Blake2b_256 ByteString)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes
                              (ByteString -> Hash StakePoolMetadata)
-> ByteString -> Hash StakePoolMetadata
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
                       (Text -> ByteString) -> (DnsName -> Text) -> DnsName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DnsName -> Text
Shelley.dnsToText