{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE OverloadedStrings #-}
module PlutusLedgerApi.Common.ProtocolVersions where

import Codec.Serialise (Serialise)
import GHC.Generics (Generic)
import Prettyprinter

-- | This represents the Cardano protocol version, with its major and minor components.
-- This relies on careful understanding between us and the ledger as to what this means.
data ProtocolVersion = ProtocolVersion { ProtocolVersion -> Int
pvMajor :: Int, ProtocolVersion -> Int
pvMinor :: Int }
  deriving stock (Int -> ProtocolVersion -> ShowS
[ProtocolVersion] -> ShowS
ProtocolVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolVersion] -> ShowS
$cshowList :: [ProtocolVersion] -> ShowS
show :: ProtocolVersion -> String
$cshow :: ProtocolVersion -> String
showsPrec :: Int -> ProtocolVersion -> ShowS
$cshowsPrec :: Int -> ProtocolVersion -> ShowS
Show, ProtocolVersion -> ProtocolVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolVersion -> ProtocolVersion -> Bool
$c/= :: ProtocolVersion -> ProtocolVersion -> Bool
== :: ProtocolVersion -> ProtocolVersion -> Bool
$c== :: ProtocolVersion -> ProtocolVersion -> Bool
Eq, forall x. Rep ProtocolVersion x -> ProtocolVersion
forall x. ProtocolVersion -> Rep ProtocolVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProtocolVersion x -> ProtocolVersion
$cfrom :: forall x. ProtocolVersion -> Rep ProtocolVersion x
Generic)
  deriving anyclass [ProtocolVersion] -> Encoding
ProtocolVersion -> Encoding
forall s. Decoder s [ProtocolVersion]
forall s. Decoder s ProtocolVersion
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: forall s. Decoder s [ProtocolVersion]
$cdecodeList :: forall s. Decoder s [ProtocolVersion]
encodeList :: [ProtocolVersion] -> Encoding
$cencodeList :: [ProtocolVersion] -> Encoding
decode :: forall s. Decoder s ProtocolVersion
$cdecode :: forall s. Decoder s ProtocolVersion
encode :: ProtocolVersion -> Encoding
$cencode :: ProtocolVersion -> Encoding
Serialise

instance Ord ProtocolVersion where
    -- same as deriving Ord, just for having it explicitly
    compare :: ProtocolVersion -> ProtocolVersion -> Ordering
compare (ProtocolVersion Int
major Int
minor) (ProtocolVersion Int
major' Int
minor') =
        forall a. Ord a => a -> a -> Ordering
compare Int
major Int
major' forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Int
minor Int
minor'

instance Pretty ProtocolVersion where
    pretty :: forall ann. ProtocolVersion -> Doc ann
pretty (ProtocolVersion Int
major Int
minor) = forall a ann. Pretty a => a -> Doc ann
pretty Int
major forall a. Semigroup a => a -> a -> a
<> Doc ann
"." forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
minor

-- Based on https://github.com/input-output-hk/cardano-ledger/wiki/First-Block-of-Each-Era

shelleyPV :: ProtocolVersion
shelleyPV :: ProtocolVersion
shelleyPV = Int -> Int -> ProtocolVersion
ProtocolVersion Int
2 Int
0

allegraPV :: ProtocolVersion
allegraPV :: ProtocolVersion
allegraPV = Int -> Int -> ProtocolVersion
ProtocolVersion Int
3 Int
0

maryPV :: ProtocolVersion
maryPV :: ProtocolVersion
maryPV = Int -> Int -> ProtocolVersion
ProtocolVersion Int
4 Int
0

alonzoPV :: ProtocolVersion
alonzoPV :: ProtocolVersion
alonzoPV = Int -> Int -> ProtocolVersion
ProtocolVersion Int
5 Int
0

vasilPV :: ProtocolVersion
vasilPV :: ProtocolVersion
vasilPV = Int -> Int -> ProtocolVersion
ProtocolVersion Int
7 Int
0

changPV :: ProtocolVersion
-- FIXME: exact version number TBD
changPV :: ProtocolVersion
changPV = Int -> Int -> ProtocolVersion
ProtocolVersion Int
1000 Int
0