{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Chain.Update.Example (
  exampleApplicationName,
  exampleProtocolVersion,
  exampleProtocolParameters,
  exampleProtocolParametersUpdate,
  exampleSoftwareVersion,
  exampleSystemTag,
  exampleInstallerHash,
  examplePayload,
  exampleProof,
  exampleProposal,
  exampleProposalBody,
  exampleUpId,
  exampleVote,
)
where

import Cardano.Chain.Common (
  TxFeePolicy (..),
  TxSizeLinear (..),
  mkKnownLovelace,
  rationalToLovelacePortion,
 )
import Cardano.Chain.Slotting (EpochNumber (..), SlotNumber (..))
import Cardano.Chain.Update (
  ApplicationName (..),
  InstallerHash (..),
  Payload,
  Proof,
  Proposal,
  ProposalBody (..),
  ProtocolParameters (..),
  ProtocolParametersUpdate (..),
  ProtocolVersion (..),
  SoftforkRule (..),
  SoftwareVersion (..),
  SystemTag (..),
  UpId,
  Vote,
  mkProof,
  payload,
  signProposal,
  signVote,
 )
import Cardano.Crypto (ProtocolMagicId (..), serializeCborHash)
import Cardano.Crypto.Raw (Raw (..))
import Cardano.Prelude
import Data.List ((!!))
import qualified Data.Map.Strict as Map
import Test.Cardano.Crypto.CBOR (getBytes)
import Test.Cardano.Crypto.Example (exampleSafeSigner)
import Test.Cardano.Prelude

exampleApplicationName :: ApplicationName
exampleApplicationName :: ApplicationName
exampleApplicationName = Text -> ApplicationName
ApplicationName Text
"Golden"

exampleProtocolVersion :: ProtocolVersion
exampleProtocolVersion :: ProtocolVersion
exampleProtocolVersion = Word16 -> Word16 -> Word8 -> ProtocolVersion
ProtocolVersion Word16
1 Word16
1 Word8
1

exampleProtocolParameters :: ProtocolParameters
exampleProtocolParameters :: ProtocolParameters
exampleProtocolParameters =
  Word16
-> Natural
-> Natural
-> Natural
-> Natural
-> Natural
-> LovelacePortion
-> LovelacePortion
-> LovelacePortion
-> LovelacePortion
-> SlotNumber
-> SoftforkRule
-> TxFeePolicy
-> EpochNumber
-> ProtocolParameters
ProtocolParameters
    (Word16
999 :: Word16)
    (Natural
999 :: Natural)
    (Natural
999 :: Natural)
    (Natural
999 :: Natural)
    (Natural
999 :: Natural)
    (Natural
999 :: Natural)
    (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
    (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
    (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
    (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
    (Word64 -> SlotNumber
SlotNumber Word64
99)
    SoftforkRule
sfrule
    (TxSizeLinear -> TxFeePolicy
TxFeePolicyTxSizeLinear TxSizeLinear
tslin)
    (Word64 -> EpochNumber
EpochNumber Word64
99)
  where
    tslin :: TxSizeLinear
tslin = Lovelace -> Rational -> TxSizeLinear
TxSizeLinear Lovelace
c1' Rational
c2'
    c1' :: Lovelace
c1' = forall (n :: Natural).
(KnownNat n, n <= 45000000000000000) =>
Lovelace
mkKnownLovelace @999
    c2' :: Rational
c2' = Rational
77 :: Rational
    sfrule :: SoftforkRule
sfrule =
      LovelacePortion
-> LovelacePortion -> LovelacePortion -> SoftforkRule
SoftforkRule
        (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
        (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
        (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)

exampleProtocolParametersUpdate :: ProtocolParametersUpdate
exampleProtocolParametersUpdate :: ProtocolParametersUpdate
exampleProtocolParametersUpdate =
  Maybe Word16
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe SlotNumber
-> Maybe SoftforkRule
-> Maybe TxFeePolicy
-> Maybe EpochNumber
-> ProtocolParametersUpdate
ProtocolParametersUpdate
    (forall a. a -> Maybe a
Just (Word16
999 :: Word16))
    (forall a. a -> Maybe a
Just (Natural
999 :: Natural))
    (forall a. a -> Maybe a
Just (Natural
999 :: Natural))
    (forall a. a -> Maybe a
Just (Natural
999 :: Natural))
    (forall a. a -> Maybe a
Just (Natural
999 :: Natural))
    (forall a. a -> Maybe a
Just (Natural
999 :: Natural))
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNumber
SlotNumber Word64
99)
    (forall a. a -> Maybe a
Just SoftforkRule
sfrule')
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TxSizeLinear -> TxFeePolicy
TxFeePolicyTxSizeLinear TxSizeLinear
tslin')
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word64 -> EpochNumber
EpochNumber Word64
99)
  where
    tslin' :: TxSizeLinear
tslin' = Lovelace -> Rational -> TxSizeLinear
TxSizeLinear Lovelace
co1 Rational
co2
    co1 :: Lovelace
co1 = forall (n :: Natural).
(KnownNat n, n <= 45000000000000000) =>
Lovelace
mkKnownLovelace @999
    co2 :: Rational
co2 = Rational
77 :: Rational
    sfrule' :: SoftforkRule
sfrule' =
      LovelacePortion
-> LovelacePortion -> LovelacePortion -> SoftforkRule
SoftforkRule
        (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
        (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
        (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)

exampleSystemTag :: SystemTag
exampleSystemTag :: SystemTag
exampleSystemTag = Int -> Int -> [SystemTag]
exampleSystemTags Int
0 Int
1 forall a. [a] -> Int -> a
!! Int
0

exampleSystemTags :: Int -> Int -> [SystemTag]
exampleSystemTags :: Int -> Int -> [SystemTag]
exampleSystemTags Int
offset Int
count =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map
    (Int -> SystemTag
toSystemTag forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. Num a => a -> a -> a
* Int
offset))
    [Int
0 .. Int
count forall a. Num a => a -> a -> a
- Int
1]
  where
    toSystemTag :: Int -> SystemTag
toSystemTag Int
start = Text -> SystemTag
SystemTag (Int -> Int -> Text
getText Int
start Int
16)

exampleInstallerHash :: InstallerHash
exampleInstallerHash :: InstallerHash
exampleInstallerHash = Int -> Int -> [InstallerHash]
exampleInstallerHashes Int
10 Int
2 forall a. [a] -> Int -> a
!! Int
1

exampleInstallerHashes :: Int -> Int -> [InstallerHash]
exampleInstallerHashes :: Int -> Int -> [InstallerHash]
exampleInstallerHashes Int
offset Int
count =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map
    (Int -> InstallerHash
toInstallerHash forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. Num a => a -> a -> a
* Int
offset))
    [Int
0 .. Int
count forall a. Num a => a -> a -> a
- Int
1]
  where
    toInstallerHash :: Int -> InstallerHash
toInstallerHash Int
start = Hash Raw -> InstallerHash
InstallerHash forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. EncCBOR a => a -> Hash a
serializeCborHash forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Raw
Raw forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteString
getBytes Int
start Int
128

exampleUpId :: UpId
exampleUpId :: UpId
exampleUpId = forall a. EncCBOR a => a -> Hash a
serializeCborHash Proposal
exampleProposal

examplePayload :: Payload
examplePayload :: Payload
examplePayload = Maybe Proposal -> [Vote] -> Payload
payload Maybe Proposal
up [Vote]
uv
  where
    up :: Maybe Proposal
up = forall a. a -> Maybe a
Just Proposal
exampleProposal
    uv :: [Vote]
uv = [Vote
exampleVote]

exampleProof :: Proof
exampleProof :: Proof
exampleProof = Payload -> Proof
mkProof Payload
examplePayload

exampleProposal :: Proposal
exampleProposal :: Proposal
exampleProposal = ProtocolMagicId -> ProposalBody -> SafeSigner -> Proposal
signProposal ProtocolMagicId
pm ProposalBody
exampleProposalBody SafeSigner
ss
  where
    pm :: ProtocolMagicId
pm = NumSoftwareVersion -> ProtocolMagicId
ProtocolMagicId NumSoftwareVersion
0
    ss :: SafeSigner
ss = Int -> SafeSigner
exampleSafeSigner Int
0

exampleProposalBody :: ProposalBody
exampleProposalBody :: ProposalBody
exampleProposalBody = ProtocolVersion
-> ProtocolParametersUpdate
-> SoftwareVersion
-> Map SystemTag InstallerHash
-> ProposalBody
ProposalBody ProtocolVersion
bv ProtocolParametersUpdate
bvm SoftwareVersion
sv Map SystemTag InstallerHash
hm
  where
    bv :: ProtocolVersion
bv = ProtocolVersion
exampleProtocolVersion
    bvm :: ProtocolParametersUpdate
bvm = ProtocolParametersUpdate
exampleProtocolParametersUpdate
    sv :: SoftwareVersion
sv = SoftwareVersion
exampleSoftwareVersion
    hm :: Map SystemTag InstallerHash
hm =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> Int -> [SystemTag]
exampleSystemTags Int
10 Int
5) (Int -> Int -> [InstallerHash]
exampleInstallerHashes Int
10 Int
5)

exampleVote :: Vote
exampleVote :: Vote
exampleVote = ProtocolMagicId -> UpId -> Bool -> SafeSigner -> Vote
signVote ProtocolMagicId
pm UpId
ui Bool
ar SafeSigner
ss
  where
    pm :: ProtocolMagicId
pm = NumSoftwareVersion -> ProtocolMagicId
ProtocolMagicId NumSoftwareVersion
0
    ss :: SafeSigner
ss = Int -> SafeSigner
exampleSafeSigner Int
0
    ui :: UpId
ui = UpId
exampleUpId
    ar :: Bool
ar = Bool
True

exampleSoftwareVersion :: SoftwareVersion
exampleSoftwareVersion :: SoftwareVersion
exampleSoftwareVersion = ApplicationName -> NumSoftwareVersion -> SoftwareVersion
SoftwareVersion (Text -> ApplicationName
ApplicationName Text
"Golden") NumSoftwareVersion
99