{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Cardano.Ledger.Binary.Version (
  -- * Versioning
  Version,
  getVersion,
  MinVersion,
  MaxVersion,
  natVersion,
  natVersionProxy,
  succVersion,
  mkVersion,
  mkVersion32,
  mkVersion64,
  getVersion32,
  getVersion64,
  allVersions,

  -- ** Concrete era versions
  byronProtVer,
  shelleyProtVer,
) where

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Control.DeepSeq (NFData)
import Control.Monad.Trans.Fail.String (errorFail)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Proxy (Proxy (..))
import Data.Word (Word32, Word64)
import GHC.TypeLits (KnownNat, natVal, type (<=))
import NoThunks.Class (NoThunks)
import System.Random (Random)

--------------------------------------------------------------------------------
-- Version
--------------------------------------------------------------------------------

-- | Protocol version number that is used during encoding and decoding. All supported
-- versions are in the range from `MinVersion` to `MaxVersion`.
newtype Version = Version Word32
  deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq, Eq Version
Eq Version =>
(Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Version -> Version -> Ordering
compare :: Version -> Version -> Ordering
$c< :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
>= :: Version -> Version -> Bool
$cmax :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
min :: Version -> Version -> Version
Ord, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> String
show :: Version -> String
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show, Version -> ()
(Version -> ()) -> NFData Version
forall a. (a -> ()) -> NFData a
$crnf :: Version -> ()
rnf :: Version -> ()
NFData, Context -> Version -> IO (Maybe ThunkInfo)
Proxy Version -> String
(Context -> Version -> IO (Maybe ThunkInfo))
-> (Context -> Version -> IO (Maybe ThunkInfo))
-> (Proxy Version -> String)
-> NoThunks Version
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Version -> IO (Maybe ThunkInfo)
noThunks :: Context -> Version -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Version -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Version -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Version -> String
showTypeOf :: Proxy Version -> String
NoThunks, Typeable Version
Typeable Version =>
(Version -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy Version -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Version] -> Size)
-> ToCBOR Version
Version -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Version] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy Version -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Version -> Encoding
toCBOR :: Version -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Version -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Version -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Version] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Version] -> Size
ToCBOR, [Version] -> Value
[Version] -> Encoding
Version -> Bool
Version -> Value
Version -> Encoding
(Version -> Value)
-> (Version -> Encoding)
-> ([Version] -> Value)
-> ([Version] -> Encoding)
-> (Version -> Bool)
-> ToJSON Version
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Version -> Value
toJSON :: Version -> Value
$ctoEncoding :: Version -> Encoding
toEncoding :: Version -> Encoding
$ctoJSONList :: [Version] -> Value
toJSONList :: [Version] -> Value
$ctoEncodingList :: [Version] -> Encoding
toEncodingList :: [Version] -> Encoding
$comitField :: Version -> Bool
omitField :: Version -> Bool
ToJSON, (forall g. RandomGen g => (Version, Version) -> g -> (Version, g))
-> (forall g. RandomGen g => g -> (Version, g))
-> (forall g. RandomGen g => (Version, Version) -> g -> [Version])
-> (forall g. RandomGen g => g -> [Version])
-> Random Version
forall g. RandomGen g => g -> [Version]
forall g. RandomGen g => g -> (Version, g)
forall g. RandomGen g => (Version, Version) -> g -> [Version]
forall g. RandomGen g => (Version, Version) -> g -> (Version, g)
forall a.
(forall g. RandomGen g => (a, a) -> g -> (a, g))
-> (forall g. RandomGen g => g -> (a, g))
-> (forall g. RandomGen g => (a, a) -> g -> [a])
-> (forall g. RandomGen g => g -> [a])
-> Random a
$crandomR :: forall g. RandomGen g => (Version, Version) -> g -> (Version, g)
randomR :: forall g. RandomGen g => (Version, Version) -> g -> (Version, g)
$crandom :: forall g. RandomGen g => g -> (Version, g)
random :: forall g. RandomGen g => g -> (Version, g)
$crandomRs :: forall g. RandomGen g => (Version, Version) -> g -> [Version]
randomRs :: forall g. RandomGen g => (Version, Version) -> g -> [Version]
$crandoms :: forall g. RandomGen g => g -> [Version]
randoms :: forall g. RandomGen g => g -> [Version]
Random)

-- | Minimum supported version
type MinVersion = 0

-- | Maximum supported version. This is the major protocol version of the latest known
-- protocol version that we want to support, including for development and testing.
type MaxVersion = 13

instance Enum Version where
  toEnum :: Int -> Version
toEnum = Fail Version -> Version
forall a. HasCallStack => Fail a -> a
errorFail (Fail Version -> Version)
-> (Int -> Fail Version) -> Int -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Fail Version
forall i (m :: * -> *). (Integral i, MonadFail m) => i -> m Version
mkVersion
  fromEnum :: Version -> Int
fromEnum (Version Word32
v) = Word32 -> Int
forall a. Enum a => a -> Int
fromEnum Word32
v

instance Bounded Version where
  minBound :: Version
minBound = Word32 -> Version
Version (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger (Proxy MinVersion -> Integer
forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @MinVersion)))
  maxBound :: Version
maxBound = Word32 -> Version
Version (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger (Proxy MaxVersion -> Integer
forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @MaxVersion)))

instance FromCBOR Version where
  fromCBOR :: forall s. Decoder s Version
fromCBOR = Decoder s Word32
forall s. Decoder s Word32
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s Word32
-> (Word32 -> Decoder s Version) -> Decoder s Version
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> Decoder s Version
forall (m :: * -> *). MonadFail m => Word32 -> m Version
mkVersion32
  {-# INLINE fromCBOR #-}

instance FromJSON Version where
  parseJSON :: Value -> Parser Version
parseJSON Value
v = Value -> Parser Word32
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser Word32 -> (Word32 -> Parser Version) -> Parser Version
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> Parser Version
forall (m :: * -> *). MonadFail m => Word32 -> m Version
mkVersion32

-- | Same as `natVersionProxy`, construct a version from a type level `Nat`, except it can be
-- supplied through @TypeApplications@.
natVersion :: forall v. (KnownNat v, MinVersion <= v, v <= MaxVersion) => Version
natVersion :: forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion = Proxy v -> Version
forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Proxy v -> Version
natVersionProxy (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)
{-# INLINE natVersion #-}

-- | Safely construct a `Version` from a type level `Nat`, which is supplied as a `Proxy`
natVersionProxy :: (KnownNat v, MinVersion <= v, v <= MaxVersion) => Proxy v -> Version
natVersionProxy :: forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Proxy v -> Version
natVersionProxy = Word32 -> Version
Version (Word32 -> Version) -> (Proxy v -> Word32) -> Proxy v -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word32
forall a. Num a => Integer -> a
fromInteger (Integer -> Word32) -> (Proxy v -> Integer) -> Proxy v -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy v -> Integer
forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal
{-# INLINE natVersionProxy #-}

-- | Construct a `Version` and fail if the supplied value is not a supported version number.
mkVersion :: (Integral i, MonadFail m) => i -> m Version
mkVersion :: forall i (m :: * -> *). (Integral i, MonadFail m) => i -> m Version
mkVersion i
v
  | Integer
vi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32
forall a. Bounded a => a
minBound :: Word32) = String -> m Version
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Version) -> String -> m Version
forall a b. (a -> b) -> a -> b
$ String
"Version is too small: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
vi
  | Integer
vi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32
forall a. Bounded a => a
maxBound :: Word32) = String -> m Version
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Version) -> String -> m Version
forall a b. (a -> b) -> a -> b
$ String
"Version is too big: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
vi
  | Bool
otherwise = Word32 -> m Version
forall (m :: * -> *). MonadFail m => Word32 -> m Version
mkVersion32 (i -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
v)
  where
    vi :: Integer
vi = i -> Integer
forall a. Integral a => a -> Integer
toInteger i
v
{-# INLINE mkVersion #-}

-- | Construct a `Version` and fail if the supplied value is not supported version number.
mkVersion32 :: MonadFail m => Word32 -> m Version
mkVersion32 :: forall (m :: * -> *). MonadFail m => Word32 -> m Version
mkVersion32 Word32
v
  | Word32
minVersion Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
v Bool -> Bool -> Bool
&& Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
maxVersion =
      Version -> m Version
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version -> m Version) -> Version -> m Version
forall a b. (a -> b) -> a -> b
$ Word32 -> Version
Version Word32
v
  | Bool
otherwise =
      String -> m Version
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Version) -> String -> m Version
forall a b. (a -> b) -> a -> b
$
        String
"Unsupported version value: "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
v
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Expected value in bounds: ["
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
minVersion
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
maxVersion
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
  where
    Version Word32
minVersion = Version
forall a. Bounded a => a
minBound
    Version Word32
maxVersion = Version
forall a. Bounded a => a
maxBound
{-# INLINE mkVersion32 #-}

-- | Construct a `Version` and fail if the supplied value is not supported version number.
mkVersion64 :: MonadFail m => Word64 -> m Version
mkVersion64 :: forall (m :: * -> *). MonadFail m => Word64 -> m Version
mkVersion64 = Word64 -> m Version
forall i (m :: * -> *). (Integral i, MonadFail m) => i -> m Version
mkVersion
{-# INLINE mkVersion64 #-}

-- | Convert a `Version` to an `Integral` value.
--
-- /Note/ - Version spans a fairly small range of non-negative numbers, so this should be
-- safe even for smallest integral types.
getVersion :: Integral i => Version -> i
getVersion :: forall i. Integral i => Version -> i
getVersion (Version Word32
w32) = Word32 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w32
{-# INLINE getVersion #-}

-- | Extract `Word32` representation of the `Version`
getVersion32 :: Version -> Word32
getVersion32 :: Version -> Word32
getVersion32 (Version Word32
w32) = Word32
w32
{-# INLINE getVersion32 #-}

-- | Extract `Word64` representation of the `Version`
getVersion64 :: Version -> Word64
getVersion64 :: Version -> Word64
getVersion64 = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> (Version -> Word32) -> Version -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Word32
getVersion32
{-# INLINE getVersion64 #-}

-- | Increment version by 1.
succVersion :: MonadFail m => Version -> m Version
succVersion :: forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion (Version Word32
v32) =
  -- Assumes that `maxBound :: Version` is at least one number lower than `maxBound :: Word32`
  Word32 -> m Version
forall (m :: * -> *). MonadFail m => Word32 -> m Version
mkVersion32 (Word32 -> m Version) -> Word32 -> m Version
forall a b. (a -> b) -> a -> b
$ Word32
v32 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1
{-# INLINE succVersion #-}

allVersions :: [Version]
allVersions :: [Version]
allVersions = [Version
forall a. Bounded a => a
minBound .. Version
forall a. Bounded a => a
maxBound]

byronProtVer :: Version
byronProtVer :: Version
byronProtVer = forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @1
{-# INLINE byronProtVer #-}

shelleyProtVer :: Version
shelleyProtVer :: Version
shelleyProtVer = forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2
{-# INLINE shelleyProtVer #-}