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

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

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

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

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

    -- * Internal conversion functions
    toSophieCertificate,
    fromSophieCertificate,
    toSophiePoolParams,
    fromSophiePoolParams,

    -- * 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 Bcc.Crypto.Hash.Class as Crypto
import           Bcc.Slotting.Slot (EpochNo (..))

import           Bcc.Ledger.Crypto (StandardCrypto)

import           Bcc.Ledger.BaseTypes (maybeToStrictMaybe, strictMaybeToMaybe)
import qualified Bcc.Ledger.BaseTypes as Sophie
import qualified Bcc.Ledger.Coin as Sophie (toDeltaCoin)
import           Sophie.Spec.Ledger.TxBody (MIRPot (..))
import qualified Sophie.Spec.Ledger.TxBody as Sophie

import           Bcc.Api.Address
import           Bcc.Api.HasTypeProxy
import           Bcc.Api.Hash
import           Bcc.Api.KeysCole
import           Bcc.Api.KeysOptimum
import           Bcc.Api.KeysSophie
import           Bcc.Api.SerialiseCBOR
import           Bcc.Api.SerialiseTextEnvelope
import           Bcc.Api.StakePoolMetadata
import           Bcc.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)
     -- Vested certificate
   | VestedKeyDelegationCertificate (Hash VestedKey)
                                   (Hash VestedDelegateKey)
                                   (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
toSophieCertificate

instance FromCBOR Certificate where
    fromCBOR :: Decoder s Certificate
fromCBOR = DCert StandardCrypto -> Certificate
fromSophieCertificate (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
"CertificateSophie"
    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"
      VestedKeyDelegationCertificate{}         -> TextEnvelopeDescr
"Vested key delegation"
      MIRCertificate{}                        -> TextEnvelopeDescr
"MIR"

-- | The 'MIRTarget' determines the target of a 'MIRCertificate'.
-- A 'MIRCertificate' moves entropic 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 entropic.
     StakeAddressesMIR [(StakeCredential, Entropic)]

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

     -- | Use 'SendToTreasuryMIR' to make the target of a 'MIRCertificate'
     -- the treasury pot.
   | SendToTreasuryMIR Entropic
  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 -> Entropic
stakePoolCost          :: Entropic,
       StakePoolParameters -> Rational
stakePoolMargin        :: Rational,
       StakePoolParameters -> StakeAddress
stakePoolRewardAccount :: StakeAddress,
       StakePoolParameters -> Entropic
stakePoolPledge        :: Entropic,
       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

makeVestedKeyDelegationCertificate :: Hash VestedKey
                                  -> Hash VestedDelegateKey
                                  -> Hash VrfKey
                                  -> Certificate
makeVestedKeyDelegationCertificate :: Hash VestedKey
-> Hash VestedDelegateKey -> Hash VrfKey -> Certificate
makeVestedKeyDelegationCertificate = Hash VestedKey
-> Hash VestedDelegateKey -> Hash VrfKey -> Certificate
VestedKeyDelegationCertificate

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


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

toSophieCertificate :: Certificate -> Sophie.DCert StandardCrypto
toSophieCertificate :: Certificate -> DCert StandardCrypto
toSophieCertificate (StakeAddressRegistrationCertificate StakeCredential
stakecred) =
    DelegCert StandardCrypto -> DCert StandardCrypto
forall crypto. DelegCert crypto -> DCert crypto
Sophie.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
Sophie.RegKey
        (StakeCredential -> StakeCredential StandardCrypto
toSophieStakeCredential StakeCredential
stakecred)

toSophieCertificate (StakeAddressDeregistrationCertificate StakeCredential
stakecred) =
    DelegCert StandardCrypto -> DCert StandardCrypto
forall crypto. DelegCert crypto -> DCert crypto
Sophie.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
Sophie.DeRegKey
        (StakeCredential -> StakeCredential StandardCrypto
toSophieStakeCredential StakeCredential
stakecred)

toSophieCertificate (StakeAddressDelegationCertificate
                        StakeCredential
stakecred (StakePoolKeyHash poolid)) =
    DelegCert StandardCrypto -> DCert StandardCrypto
forall crypto. DelegCert crypto -> DCert crypto
Sophie.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
Sophie.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
Sophie.Delegation
        (StakeCredential -> StakeCredential StandardCrypto
toSophieStakeCredential StakeCredential
stakecred)
        KeyHash 'StakePool StandardCrypto
poolid

toSophieCertificate (StakePoolRegistrationCertificate StakePoolParameters
poolparams) =
    PoolCert StandardCrypto -> DCert StandardCrypto
forall crypto. PoolCert crypto -> DCert crypto
Sophie.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
Sophie.RegPool
        (StakePoolParameters -> PoolParams StandardCrypto
toSophiePoolParams StakePoolParameters
poolparams)

toSophieCertificate (StakePoolRetirementCertificate
                       (StakePoolKeyHash poolid) EpochNo
epochno) =
    PoolCert StandardCrypto -> DCert StandardCrypto
forall crypto. PoolCert crypto -> DCert crypto
Sophie.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
Sophie.RetirePool
        KeyHash 'StakePool StandardCrypto
poolid
        EpochNo
epochno

toSophieCertificate (GenesisKeyDelegationCertificate
                       (GenesisKeyHash         genesiskh)
                       (GenesisDelegateKeyHash delegatekh)
                       (VrfKeyHash             vrfkh)) =
    GenesisDelegCert StandardCrypto -> DCert StandardCrypto
forall crypto. GenesisDelegCert crypto -> DCert crypto
Sophie.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
Sophie.GenesisDelegCert
        KeyHash 'Genesis StandardCrypto
genesiskh
        KeyHash 'GenesisDelegate StandardCrypto
delegatekh
        Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh

toSophieCertificate (VestedKeyDelegationCertificate
                       (VestedKeyHash         vestedkh)
                       (VestedDelegateKeyHash vesteddelegatekh)
                       (VrfKeyHash             vrfkh)) =
    VestedDelegCert StandardCrypto -> DCert StandardCrypto
forall crypto. VestedDelegCert crypto -> DCert crypto
Sophie.DCertVested (VestedDelegCert StandardCrypto -> DCert StandardCrypto)
-> VestedDelegCert StandardCrypto -> DCert StandardCrypto
forall a b. (a -> b) -> a -> b
$
      KeyHash 'Vested StandardCrypto
-> KeyHash 'VestedDelegate StandardCrypto
-> Hash StandardCrypto (VerKeyVRF StandardCrypto)
-> VestedDelegCert StandardCrypto
forall crypto.
KeyHash 'Vested crypto
-> KeyHash 'VestedDelegate crypto
-> Hash crypto (VerKeyVRF crypto)
-> VestedDelegCert crypto
Sophie.VestedDelegCert
        KeyHash 'Vested StandardCrypto
vestedkh
        KeyHash 'VestedDelegate StandardCrypto
vesteddelegatekh
        Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh

toSophieCertificate (MIRCertificate MIRPot
mirpot (StakeAddressesMIR [(StakeCredential, Entropic)]
amounts)) =
    MIRCert StandardCrypto -> DCert StandardCrypto
forall crypto. MIRCert crypto -> DCert crypto
Sophie.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
Sophie.MIRCert
        MIRPot
mirpot
        (Map (StakeCredential StandardCrypto) DeltaCoin
-> MIRTarget StandardCrypto
forall crypto.
Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto
Sophie.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
toSophieStakeCredential StakeCredential
sc, Coin -> DeltaCoin
Sophie.toDeltaCoin (Coin -> DeltaCoin) -> (Entropic -> Coin) -> Entropic -> DeltaCoin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entropic -> Coin
toSophieEntropic (Entropic -> DeltaCoin) -> Entropic -> DeltaCoin
forall a b. (a -> b) -> a -> b
$ Entropic
v)
           | (StakeCredential
sc, Entropic
v) <- [(StakeCredential, Entropic)]
amounts ])

toSophieCertificate (MIRCertificate MIRPot
mirPot (SendToReservesMIR Entropic
amount)) =
    case MIRPot
mirPot of
      MIRPot
TreasuryMIR ->
        MIRCert StandardCrypto -> DCert StandardCrypto
forall crypto. MIRCert crypto -> DCert crypto
Sophie.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
Sophie.MIRCert
            MIRPot
TreasuryMIR
            (Coin -> MIRTarget StandardCrypto
forall crypto. Coin -> MIRTarget crypto
Sophie.SendToOppositePotMIR (Coin -> MIRTarget StandardCrypto)
-> Coin -> MIRTarget StandardCrypto
forall a b. (a -> b) -> a -> b
$ Entropic -> Coin
toSophieEntropic Entropic
amount)
      MIRPot
ReservesMIR ->
        String -> DCert StandardCrypto
forall a. HasCallStack => String -> a
error String
"toSophieCertificate: Incorrect MIRPot specified. Expected TreasuryMIR but got ReservesMIR"

toSophieCertificate (MIRCertificate MIRPot
mirPot (SendToTreasuryMIR Entropic
amount)) =
    case MIRPot
mirPot of
      MIRPot
ReservesMIR ->
        MIRCert StandardCrypto -> DCert StandardCrypto
forall crypto. MIRCert crypto -> DCert crypto
Sophie.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
Sophie.MIRCert
            MIRPot
ReservesMIR
            (Coin -> MIRTarget StandardCrypto
forall crypto. Coin -> MIRTarget crypto
Sophie.SendToOppositePotMIR (Coin -> MIRTarget StandardCrypto)
-> Coin -> MIRTarget StandardCrypto
forall a b. (a -> b) -> a -> b
$ Entropic -> Coin
toSophieEntropic Entropic
amount)
      MIRPot
TreasuryMIR ->
        String -> DCert StandardCrypto
forall a. HasCallStack => String -> a
error String
"toSophieCertificate: Incorrect MIRPot specified. Expected ReservesMIR but got TreasuryMIR"


fromSophieCertificate :: Sophie.DCert StandardCrypto -> Certificate
fromSophieCertificate :: DCert StandardCrypto -> Certificate
fromSophieCertificate (Sophie.DCertDeleg (Sophie.RegKey StakeCredential StandardCrypto
stakecred)) =
    StakeCredential -> Certificate
StakeAddressRegistrationCertificate
      (StakeCredential StandardCrypto -> StakeCredential
fromSophieStakeCredential StakeCredential StandardCrypto
stakecred)

fromSophieCertificate (Sophie.DCertDeleg (Sophie.DeRegKey StakeCredential StandardCrypto
stakecred)) =
    StakeCredential -> Certificate
StakeAddressDeregistrationCertificate
      (StakeCredential StandardCrypto -> StakeCredential
fromSophieStakeCredential StakeCredential StandardCrypto
stakecred)

fromSophieCertificate (Sophie.DCertDeleg
                         (Sophie.Delegate (Sophie.Delegation StakeCredential StandardCrypto
stakecred KeyHash 'StakePool StandardCrypto
poolid))) =
    StakeCredential -> PoolId -> Certificate
StakeAddressDelegationCertificate
      (StakeCredential StandardCrypto -> StakeCredential
fromSophieStakeCredential StakeCredential StandardCrypto
stakecred)
      (KeyHash 'StakePool StandardCrypto -> PoolId
StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolid)

fromSophieCertificate (Sophie.DCertPool (Sophie.RegPool PoolParams StandardCrypto
poolparams)) =
    StakePoolParameters -> Certificate
StakePoolRegistrationCertificate
      (PoolParams StandardCrypto -> StakePoolParameters
fromSophiePoolParams PoolParams StandardCrypto
poolparams)

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

fromSophieCertificate (Sophie.DCertGenesis
                         (Sophie.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)

fromSophieCertificate (Sophie.DCertVested
                         (Sophie.VestedDelegCert KeyHash 'Vested StandardCrypto
vestedkh KeyHash 'VestedDelegate StandardCrypto
vesteddelegatekh Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh)) =
    Hash VestedKey
-> Hash VestedDelegateKey -> Hash VrfKey -> Certificate
VestedKeyDelegationCertificate
      (KeyHash 'Vested StandardCrypto -> Hash VestedKey
VestedKeyHash         KeyHash 'Vested StandardCrypto
vestedkh)
      (KeyHash 'VestedDelegate StandardCrypto -> Hash VestedDelegateKey
VestedDelegateKeyHash KeyHash 'VestedDelegate StandardCrypto
vesteddelegatekh)
      (Hash StandardCrypto (VerKeyVRF StandardCrypto) -> Hash VrfKey
VrfKeyHash             Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh)

fromSophieCertificate (Sophie.DCertMir
                         (Sophie.MIRCert MIRPot
mirpot (Sophie.StakeAddressesMIR Map (StakeCredential StandardCrypto) DeltaCoin
amounts))) =
    MIRPot -> MIRTarget -> Certificate
MIRCertificate
      MIRPot
mirpot
      ([(StakeCredential, Entropic)] -> MIRTarget
StakeAddressesMIR
        [ (StakeCredential StandardCrypto -> StakeCredential
fromSophieStakeCredential StakeCredential StandardCrypto
sc, DeltaCoin -> Entropic
fromSophieDeltaEntropic 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 ]
      )
fromSophieCertificate (Sophie.DCertMir
                         (Sophie.MIRCert MIRPot
ReservesMIR (Sophie.SendToOppositePotMIR Coin
amount))) =
    MIRPot -> MIRTarget -> Certificate
MIRCertificate MIRPot
ReservesMIR
      (Entropic -> MIRTarget
SendToTreasuryMIR (Entropic -> MIRTarget) -> Entropic -> MIRTarget
forall a b. (a -> b) -> a -> b
$ Coin -> Entropic
fromSophieEntropic Coin
amount)

fromSophieCertificate (Sophie.DCertMir
                         (Sophie.MIRCert MIRPot
TreasuryMIR (Sophie.SendToOppositePotMIR Coin
amount))) =
    MIRPot -> MIRTarget -> Certificate
MIRCertificate MIRPot
TreasuryMIR
      (Entropic -> MIRTarget
SendToReservesMIR (Entropic -> MIRTarget) -> Entropic -> MIRTarget
forall a b. (a -> b) -> a -> b
$ Coin -> Entropic
fromSophieEntropic Coin
amount)

toSophiePoolParams :: StakePoolParameters -> Sophie.PoolParams StandardCrypto
toSophiePoolParams :: StakePoolParameters -> PoolParams StandardCrypto
toSophiePoolParams StakePoolParameters {
                      stakePoolId :: StakePoolParameters -> PoolId
stakePoolId            = StakePoolKeyHash poolkh
                    , stakePoolVRF :: StakePoolParameters -> Hash VrfKey
stakePoolVRF           = VrfKeyHash vrfkh
                    , Entropic
stakePoolCost :: Entropic
stakePoolCost :: StakePoolParameters -> Entropic
stakePoolCost
                    , Rational
stakePoolMargin :: Rational
stakePoolMargin :: StakePoolParameters -> Rational
stakePoolMargin
                    , StakeAddress
stakePoolRewardAccount :: StakeAddress
stakePoolRewardAccount :: StakePoolParameters -> StakeAddress
stakePoolRewardAccount
                    , Entropic
stakePoolPledge :: Entropic
stakePoolPledge :: StakePoolParameters -> Entropic
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
Sophie.PoolParams {
      _poolId :: KeyHash 'StakePool StandardCrypto
Sophie._poolId     = KeyHash 'StakePool StandardCrypto
poolkh
    , _poolVrf :: Hash StandardCrypto (VerKeyVRF StandardCrypto)
Sophie._poolVrf    = Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh
    , _poolPledge :: Coin
Sophie._poolPledge = Entropic -> Coin
toSophieEntropic Entropic
stakePoolPledge
    , _poolCost :: Coin
Sophie._poolCost   = Entropic -> Coin
toSophieEntropic Entropic
stakePoolCost
    , _poolMargin :: UnitInterval
Sophie._poolMargin = UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
                              (String -> UnitInterval
forall a. HasCallStack => String -> a
error String
"toSophiePoolParams: invalid PoolMargin")
                              (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Sophie.boundRational Rational
stakePoolMargin)
    , _poolRAcnt :: RewardAcnt StandardCrypto
Sophie._poolRAcnt  = StakeAddress -> RewardAcnt StandardCrypto
toSophieStakeAddr StakeAddress
stakePoolRewardAccount
    , _poolOwners :: Set (KeyHash 'Staking StandardCrypto)
Sophie._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
Sophie._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
toSophieStakePoolRelay [StakePoolRelay]
stakePoolRelays)
    , _poolMD :: StrictMaybe PoolMetadata
Sophie._poolMD     = StakePoolMetadataReference -> PoolMetadata
toSophiePoolMetadata (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
    toSophieStakePoolRelay :: StakePoolRelay -> Sophie.StakePoolRelay
    toSophieStakePoolRelay :: StakePoolRelay -> StakePoolRelay
toSophieStakePoolRelay (StakePoolRelayIp Maybe IPv4
mipv4 Maybe IPv6
mipv6 Maybe PortNumber
mport) =
      StrictMaybe Port
-> StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay
Sophie.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)

    toSophieStakePoolRelay (StakePoolRelayDnsARecord ByteString
dnsname Maybe PortNumber
mport) =
      StrictMaybe Port -> DnsName -> StakePoolRelay
Sophie.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
toSophieDnsName ByteString
dnsname)

    toSophieStakePoolRelay (StakePoolRelayDnsSrvRecord ByteString
dnsname) =
      DnsName -> StakePoolRelay
Sophie.MultiHostName
        (ByteString -> DnsName
toSophieDnsName ByteString
dnsname)

    toSophiePoolMetadata :: StakePoolMetadataReference -> Sophie.PoolMetadata
    toSophiePoolMetadata :: StakePoolMetadataReference -> PoolMetadata
toSophiePoolMetadata StakePoolMetadataReference {
                            Text
stakePoolMetadataURL :: Text
stakePoolMetadataURL :: StakePoolMetadataReference -> Text
stakePoolMetadataURL
                          , stakePoolMetadataHash :: StakePoolMetadataReference -> Hash StakePoolMetadata
stakePoolMetadataHash = StakePoolMetadataHash mdh
                          } =
      PoolMetadata :: Url -> ByteString -> PoolMetadata
Sophie.PoolMetadata {
        _poolMDUrl :: Url
Sophie._poolMDUrl  = Text -> Url
toSophieUrl Text
stakePoolMetadataURL
      , _poolMDHash :: ByteString
Sophie._poolMDHash = Hash Blake2b_256 ByteString -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash StandardCrypto ByteString
Hash Blake2b_256 ByteString
mdh
      }

    toSophieDnsName :: ByteString -> Sophie.DnsName
    toSophieDnsName :: ByteString -> DnsName
toSophieDnsName = DnsName -> Maybe DnsName -> DnsName
forall a. a -> Maybe a -> a
fromMaybe (String -> DnsName
forall a. HasCallStack => String -> a
error String
"toSophieDnsName: 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
Sophie.textToDns
                     (Text -> Maybe DnsName)
-> (ByteString -> Text) -> ByteString -> Maybe DnsName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeLatin1

    toSophieUrl :: Text -> Sophie.Url
    toSophieUrl :: Text -> Url
toSophieUrl = Url -> Maybe Url -> Url
forall a. a -> Maybe a -> a
fromMaybe (String -> Url
forall a. HasCallStack => String -> a
error String
"toSophieUrl: 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
Sophie.textToUrl


fromSophiePoolParams :: Sophie.PoolParams StandardCrypto
                      -> StakePoolParameters
fromSophiePoolParams :: PoolParams StandardCrypto -> StakePoolParameters
fromSophiePoolParams
    Sophie.PoolParams {
      KeyHash 'StakePool StandardCrypto
_poolId :: KeyHash 'StakePool StandardCrypto
_poolId :: forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
Sophie._poolId
    , Hash StandardCrypto (VerKeyVRF StandardCrypto)
_poolVrf :: Hash StandardCrypto (VerKeyVRF StandardCrypto)
_poolVrf :: forall crypto. PoolParams crypto -> Hash crypto (VerKeyVRF crypto)
Sophie._poolVrf
    , Coin
_poolPledge :: Coin
_poolPledge :: forall crypto. PoolParams crypto -> Coin
Sophie._poolPledge
    , Coin
_poolCost :: Coin
_poolCost :: forall crypto. PoolParams crypto -> Coin
Sophie._poolCost
    , UnitInterval
_poolMargin :: UnitInterval
_poolMargin :: forall crypto. PoolParams crypto -> UnitInterval
Sophie._poolMargin
    , RewardAcnt StandardCrypto
_poolRAcnt :: RewardAcnt StandardCrypto
_poolRAcnt :: forall crypto. PoolParams crypto -> RewardAcnt crypto
Sophie._poolRAcnt
    , Set (KeyHash 'Staking StandardCrypto)
_poolOwners :: Set (KeyHash 'Staking StandardCrypto)
_poolOwners :: forall crypto. PoolParams crypto -> Set (KeyHash 'Staking crypto)
Sophie._poolOwners
    , StrictSeq StakePoolRelay
_poolRelays :: StrictSeq StakePoolRelay
_poolRelays :: forall crypto. PoolParams crypto -> StrictSeq StakePoolRelay
Sophie._poolRelays
    , StrictMaybe PoolMetadata
_poolMD :: StrictMaybe PoolMetadata
_poolMD :: forall crypto. PoolParams crypto -> StrictMaybe PoolMetadata
Sophie._poolMD
    } =
    StakePoolParameters :: PoolId
-> Hash VrfKey
-> Entropic
-> Rational
-> StakeAddress
-> Entropic
-> [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 :: Entropic
stakePoolCost          = Coin -> Entropic
fromSophieEntropic Coin
_poolCost
    , stakePoolMargin :: Rational
stakePoolMargin        = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Sophie.unboundRational UnitInterval
_poolMargin
    , stakePoolRewardAccount :: StakeAddress
stakePoolRewardAccount = RewardAcnt StandardCrypto -> StakeAddress
fromSophieStakeAddr RewardAcnt StandardCrypto
_poolRAcnt
    , stakePoolPledge :: Entropic
stakePoolPledge        = Coin -> Entropic
fromSophieEntropic 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
fromSophieStakePoolRelay
                                   (StrictSeq StakePoolRelay -> [StakePoolRelay]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList StrictSeq StakePoolRelay
_poolRelays)
    , stakePoolMetadata :: Maybe StakePoolMetadataReference
stakePoolMetadata      = PoolMetadata -> StakePoolMetadataReference
fromSophiePoolMetadata (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
    fromSophieStakePoolRelay :: Sophie.StakePoolRelay -> StakePoolRelay
    fromSophieStakePoolRelay :: StakePoolRelay -> StakePoolRelay
fromSophieStakePoolRelay (Sophie.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
Sophie.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)

    fromSophieStakePoolRelay (Sophie.SingleHostName StrictMaybe Port
mport DnsName
dnsname) =
      ByteString -> Maybe PortNumber -> StakePoolRelay
StakePoolRelayDnsARecord
        (DnsName -> ByteString
fromSophieDnsName 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
Sophie.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)

    fromSophieStakePoolRelay (Sophie.MultiHostName DnsName
dnsname) =
      ByteString -> StakePoolRelay
StakePoolRelayDnsSrvRecord
        (DnsName -> ByteString
fromSophieDnsName DnsName
dnsname)

    fromSophiePoolMetadata :: Sophie.PoolMetadata -> StakePoolMetadataReference
    fromSophiePoolMetadata :: PoolMetadata -> StakePoolMetadataReference
fromSophiePoolMetadata Sophie.PoolMetadata {
                              Url
_poolMDUrl :: Url
_poolMDUrl :: PoolMetadata -> Url
Sophie._poolMDUrl
                            , ByteString
_poolMDHash :: ByteString
_poolMDHash :: PoolMetadata -> ByteString
Sophie._poolMDHash
                            } =
      StakePoolMetadataReference :: Text -> Hash StakePoolMetadata -> StakePoolMetadataReference
StakePoolMetadataReference {
        stakePoolMetadataURL :: Text
stakePoolMetadataURL  = Url -> Text
Sophie.urlToText Url
_poolMDUrl
      , stakePoolMetadataHash :: Hash StakePoolMetadata
stakePoolMetadataHash = Hash StandardCrypto ByteString -> Hash StakePoolMetadata
Hash Blake2b_256 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
"fromSophiePoolMetadata: 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
    fromSophieDnsName :: Sophie.DnsName -> ByteString
    fromSophieDnsName :: DnsName -> ByteString
fromSophieDnsName = Text -> ByteString
Text.encodeUtf8
                       (Text -> ByteString) -> (DnsName -> Text) -> DnsName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DnsName -> Text
Sophie.dnsToText