content: {-# 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.Prelude
  import Test.Cardano.Prelude
  
  import Data.List ((!!))
  import qualified Data.Map.Strict as Map
  
  import Cardano.Binary (Raw(..))
  import Cardano.Chain.Common
    ( mkKnownLovelace, rationalToLovelacePortion
    , TxFeePolicy(..), TxSizeLinear(..) )
  import Cardano.Chain.Slotting (EpochNumber(..), SlotNumber(..))
  import Cardano.Chain.Update
    ( ApplicationName(..)
    , Payload
    , Proof
    , Proposal
    , ProposalBody(..)
    , ProtocolParametersUpdate(..)
    , ProtocolParameters(..)
    , ProtocolVersion(..)
    , SoftforkRule(..)
    , SoftwareVersion(..)
    , SystemTag(..)
    , UpId
    , InstallerHash(..)
    , Vote
    , mkProof
    , signVote
    , payload
    , signProposal
    )
  import Cardano.Crypto (ProtocolMagicId(..), serializeCborHash)
  
  import Test.Cardano.Crypto.CBOR (getBytes)
  import Test.Cardano.Crypto.Example (exampleSafeSigner)
  
  
  exampleApplicationName :: ApplicationName
  exampleApplicationName = ApplicationName "Golden"
  
  exampleProtocolVersion :: ProtocolVersion
  exampleProtocolVersion = ProtocolVersion 1 1 1
  
  exampleProtocolParameters :: ProtocolParameters
  exampleProtocolParameters = ProtocolParameters
    (999 :: Word16)
    (999 :: Natural)
    (999 :: Natural)
    (999 :: Natural)
    (999 :: Natural)
    (999 :: Natural)
    (rationalToLovelacePortion 99e-15)
    (rationalToLovelacePortion 99e-15)
    (rationalToLovelacePortion 99e-15)
    (rationalToLovelacePortion 99e-15)
    (SlotNumber 99)
    sfrule
    (TxFeePolicyTxSizeLinear tslin)
    (EpochNumber 99)
   where
    tslin  = TxSizeLinear c1' c2'
    c1'    = mkKnownLovelace @999
    c2'    = 77 :: Rational
    sfrule = SoftforkRule
      (rationalToLovelacePortion 99e-15)
      (rationalToLovelacePortion 99e-15)
      (rationalToLovelacePortion 99e-15)
  
  exampleProtocolParametersUpdate :: ProtocolParametersUpdate
  exampleProtocolParametersUpdate = ProtocolParametersUpdate
    (Just (999 :: Word16))
    (Just (999 :: Natural))
    (Just (999 :: Natural))
    (Just (999 :: Natural))
    (Just (999 :: Natural))
    (Just (999 :: Natural))
    (Just $ rationalToLovelacePortion 99e-15)
    (Just $ rationalToLovelacePortion 99e-15)
    (Just $ rationalToLovelacePortion 99e-15)
    (Just $ rationalToLovelacePortion 99e-15)
    (Just $ SlotNumber 99)
    (Just sfrule')
    (Just $ TxFeePolicyTxSizeLinear tslin')
    (Just $ EpochNumber 99)
   where
    tslin'  = TxSizeLinear co1 co2
    co1     = mkKnownLovelace @999
    co2     = 77 :: Rational
    sfrule' = SoftforkRule
      (rationalToLovelacePortion 99e-15)
      (rationalToLovelacePortion 99e-15)
      (rationalToLovelacePortion 99e-15)
  
  exampleSystemTag :: SystemTag
  exampleSystemTag = exampleSystemTags 0 1 !! 0
  
  exampleSystemTags :: Int -> Int -> [SystemTag]
  exampleSystemTags offset count = map
    (toSystemTag . (* offset))
    [0 .. count - 1]
    where toSystemTag start = SystemTag (getText start 16)
  
  exampleInstallerHash :: InstallerHash
  exampleInstallerHash = exampleInstallerHashes 10 2 !! 1
  
  exampleInstallerHashes :: Int -> Int -> [InstallerHash]
  exampleInstallerHashes offset count = map
    (toInstallerHash . (* offset))
    [0 .. count - 1]
   where
    toInstallerHash start = InstallerHash . serializeCborHash . Raw $ getBytes start 128
  
  exampleUpId :: UpId
  exampleUpId = serializeCborHash exampleProposal
  
  examplePayload :: Payload
  examplePayload = payload up uv
   where
    up = Just exampleProposal
    uv = [exampleVote]
  
  exampleProof :: Proof
  exampleProof = mkProof examplePayload
  
  
  exampleProposal :: Proposal
  exampleProposal = signProposal pm exampleProposalBody ss
   where
    pm = ProtocolMagicId 0
    ss = exampleSafeSigner 0
  
  exampleProposalBody :: ProposalBody
  exampleProposalBody = ProposalBody bv bvm sv hm
   where
    bv  = exampleProtocolVersion
    bvm = exampleProtocolParametersUpdate
    sv  = exampleSoftwareVersion
    hm =
      Map.fromList $ zip (exampleSystemTags 10 5) (exampleInstallerHashes 10 5)
  
  exampleVote :: Vote
  exampleVote = signVote pm ui ar ss
   where
    pm = ProtocolMagicId 0
    ss = exampleSafeSigner 0
    ui = exampleUpId
    ar = True
  
  exampleSoftwareVersion :: SoftwareVersion
  exampleSoftwareVersion = SoftwareVersion (ApplicationName "Golden") 99
  