{-# 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 (
Version,
getVersion,
MinVersion,
MaxVersion,
natVersion,
natVersionProxy,
succVersion,
mkVersion,
mkVersion64,
getVersion64,
allVersions,
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 (Word64)
import GHC.TypeLits (KnownNat, natVal, type (<=))
import NoThunks.Class (NoThunks)
newtype Version = Version Word64
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)
type MinVersion = 0
type MaxVersion = 12
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 Word64
v) = Word64 -> Int
forall a. Enum a => a -> Int
fromEnum Word64
v
instance Bounded Version where
minBound :: Version
minBound = Word64 -> Version
Version (Integer -> Word64
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 = Word64 -> Version
Version (Integer -> Word64
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 Word64
forall s. Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s Word64
-> (Word64 -> 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
>>= Word64 -> Decoder s Version
forall (m :: * -> *). MonadFail m => Word64 -> m Version
mkVersion64
{-# INLINE fromCBOR #-}
instance FromJSON Version where
parseJSON :: Value -> Parser Version
parseJSON Value
v = Value -> Parser Word64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser Word64 -> (Word64 -> 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
>>= Word64 -> Parser Version
forall (m :: * -> *). MonadFail m => Word64 -> m Version
mkVersion64
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 #-}
natVersionProxy :: (KnownNat v, MinVersion <= v, v <= MaxVersion) => Proxy v -> Version
natVersionProxy :: forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Proxy v -> Version
natVersionProxy = Word64 -> Version
Version (Word64 -> Version) -> (Proxy v -> Word64) -> Proxy v -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> (Proxy v -> Integer) -> Proxy v -> Word64
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 #-}
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
< Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
minBound :: Word64) = 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
> Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
maxBound :: Word64) = 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 = Word64 -> m Version
forall (m :: * -> *). MonadFail m => Word64 -> m Version
mkVersion64 (i -> Word64
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 #-}
mkVersion64 :: MonadFail m => Word64 -> m Version
mkVersion64 :: forall (m :: * -> *). MonadFail m => Word64 -> m Version
mkVersion64 Word64
v
| Word64
minVersion Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
v Bool -> Bool -> Bool
&& Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
maxVersion =
Version -> m Version
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Version
Version (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
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]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
v
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Expected value in bounds: ["
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
minVersion
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
maxVersion
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
where
Version Word64
minVersion = Version
forall a. Bounded a => a
minBound
Version Word64
maxVersion = Version
forall a. Bounded a => a
maxBound
{-# INLINE mkVersion64 #-}
getVersion :: Integral i => Version -> i
getVersion :: forall i. Integral i => Version -> i
getVersion (Version Word64
w64) = Word64 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64
{-# INLINE getVersion #-}
getVersion64 :: Version -> Word64
getVersion64 :: Version -> Word64
getVersion64 (Version Word64
w64) = Word64
w64
{-# INLINE getVersion64 #-}
succVersion :: MonadFail m => Version -> m Version
succVersion :: forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion (Version Word64
v64) = Word64 -> m Version
forall (m :: * -> *). MonadFail m => Word64 -> m Version
mkVersion64 (Word64
v64 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
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 #-}