{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Ledger.Plutus.ToPlutusData where

import Cardano.Ledger.BaseTypes (
  BoundedRational (boundRational, unboundRational),
  EpochInterval (..),
  HasZero,
  NonNegativeInterval,
  NonZero (..),
  Nonce,
  ProtVer (..),
  UnitInterval,
  nonZero,
  (%.),
 )
import Cardano.Ledger.Binary.Version (Version, getVersion, mkVersion)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Plutus.CostModels (
  CostModels,
  flattenCostModels,
  mkCostModelsLenient,
 )
import Cardano.Ledger.Plutus.ExUnits (ExUnits (..), Prices (..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Word
import GHC.Real (Ratio ((:%)))
import Numeric.Natural (Natural)
import PlutusLedgerApi.Common (Data (..))

-- ===============================================================

-- ToPlutusData class, and instances for parameterized data types List, Map.

class ToPlutusData x where
  toPlutusData :: x -> Data
  fromPlutusData :: Data -> Maybe x
  fromPlutusData Data
_ = Maybe x
forall a. Maybe a
Nothing

instance ToPlutusData a => ToPlutusData [a] where
  toPlutusData :: [a] -> Data
toPlutusData [a]
xs = [Data] -> Data
List ((a -> Data) -> [a] -> [Data]
forall a b. (a -> b) -> [a] -> [b]
map a -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData [a]
xs)
  fromPlutusData :: Data -> Maybe [a]
fromPlutusData (List [Data]
xs) = (Data -> Maybe a) -> [Data] -> Maybe [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Data -> Maybe a
forall x. ToPlutusData x => Data -> Maybe x
fromPlutusData [Data]
xs
  fromPlutusData Data
_ = Maybe [a]
forall a. Maybe a
Nothing

instance (Ord a, ToPlutusData a, ToPlutusData b) => ToPlutusData (Map a b) where
  toPlutusData :: Map a b -> Data
toPlutusData Map a b
m = [(Data, Data)] -> Data
Map ([(Data, Data)] -> Data) -> [(Data, Data)] -> Data
forall a b. (a -> b) -> a -> b
$ ((a, b) -> (Data, Data)) -> [(a, b)] -> [(Data, Data)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
a, b
b) -> (a -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData a
a, b -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData b
b)) (Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a b
m)
  fromPlutusData :: Data -> Maybe (Map a b)
fromPlutusData (Map [(Data, Data)]
pairs) =
    [(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      ([(a, b)] -> Map a b) -> Maybe [(a, b)] -> Maybe (Map a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Data, Data) -> Maybe (a, b)) -> [(Data, Data)] -> Maybe [(a, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Data
k, Data
v) -> (,) (a -> b -> (a, b)) -> Maybe a -> Maybe (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data -> Maybe a
forall x. ToPlutusData x => Data -> Maybe x
fromPlutusData Data
k Maybe (b -> (a, b)) -> Maybe b -> Maybe (a, b)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Data -> Maybe b
forall x. ToPlutusData x => Data -> Maybe x
fromPlutusData Data
v) [(Data, Data)]
pairs
  fromPlutusData Data
_ = Maybe (Map a b)
forall a. Maybe a
Nothing

-- ==========================================================
-- ToPlutusData instances for concrete types needed for PParamUpdates

instance ToPlutusData Version where
  toPlutusData :: Version -> Data
toPlutusData Version
v = Integer -> Data
I (forall i. Integral i => Version -> i
getVersion @Integer Version
v)
  fromPlutusData :: Data -> Maybe Version
fromPlutusData (I Integer
n) = forall i (m :: * -> *). (Integral i, MonadFail m) => i -> m Version
mkVersion @Integer Integer
n
  fromPlutusData Data
_ = Maybe Version
forall a. Maybe a
Nothing

instance ToPlutusData ProtVer where
  toPlutusData :: ProtVer -> Data
toPlutusData ProtVer
pv = [Data] -> Data
List [Version -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData (ProtVer -> Version
pvMajor ProtVer
pv), Natural -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData (ProtVer -> Natural
pvMinor ProtVer
pv)]
  fromPlutusData :: Data -> Maybe ProtVer
fromPlutusData (List [Data
major, Data
minor]) = Version -> Natural -> ProtVer
ProtVer (Version -> Natural -> ProtVer)
-> Maybe Version -> Maybe (Natural -> ProtVer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data -> Maybe Version
forall x. ToPlutusData x => Data -> Maybe x
fromPlutusData Data
major Maybe (Natural -> ProtVer) -> Maybe Natural -> Maybe ProtVer
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Data -> Maybe Natural
forall x. ToPlutusData x => Data -> Maybe x
fromPlutusData Data
minor
  fromPlutusData Data
_ = Maybe ProtVer
forall a. Maybe a
Nothing

instance ToPlutusData UnitInterval where
  toPlutusData :: UnitInterval -> Data
toPlutusData UnitInterval
x = [Data] -> Data
List [Integer -> Data
I Integer
num, Integer -> Data
I Integer
denom]
    where
      (Integer
num :% Integer
denom) = UnitInterval -> Ratio Integer
forall r. BoundedRational r => r -> Ratio Integer
unboundRational UnitInterval
x
  fromPlutusData :: Data -> Maybe UnitInterval
fromPlutusData (List [I Integer
num, I Integer
denom]) = Ratio Integer -> Maybe UnitInterval
forall r. BoundedRational r => Ratio Integer -> Maybe r
boundRational (Ratio Integer -> Maybe UnitInterval)
-> (NonZero Integer -> Ratio Integer)
-> NonZero Integer
-> Maybe UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
num Integer -> NonZero Integer -> Ratio Integer
forall a. Integral a => a -> NonZero a -> Ratio a
%.) (NonZero Integer -> Maybe UnitInterval)
-> Maybe (NonZero Integer) -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Integer -> Maybe (NonZero Integer)
forall a. HasZero a => a -> Maybe (NonZero a)
nonZero Integer
denom
  fromPlutusData Data
_ = Maybe UnitInterval
forall a. Maybe a
Nothing

instance ToPlutusData NonNegativeInterval where
  toPlutusData :: NonNegativeInterval -> Data
toPlutusData NonNegativeInterval
x = [Data] -> Data
List [Integer -> Data
I Integer
num, Integer -> Data
I Integer
denom]
    where
      (Integer
num :% Integer
denom) = NonNegativeInterval -> Ratio Integer
forall r. BoundedRational r => r -> Ratio Integer
unboundRational NonNegativeInterval
x
  fromPlutusData :: Data -> Maybe NonNegativeInterval
fromPlutusData (List [I Integer
num, I Integer
denom]) = Ratio Integer -> Maybe NonNegativeInterval
forall r. BoundedRational r => Ratio Integer -> Maybe r
boundRational (Ratio Integer -> Maybe NonNegativeInterval)
-> (NonZero Integer -> Ratio Integer)
-> NonZero Integer
-> Maybe NonNegativeInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
num Integer -> NonZero Integer -> Ratio Integer
forall a. Integral a => a -> NonZero a -> Ratio a
%.) (NonZero Integer -> Maybe NonNegativeInterval)
-> Maybe (NonZero Integer) -> Maybe NonNegativeInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Integer -> Maybe (NonZero Integer)
forall a. HasZero a => a -> Maybe (NonZero a)
nonZero Integer
denom
  fromPlutusData Data
_ = Maybe NonNegativeInterval
forall a. Maybe a
Nothing

instance ToPlutusData CostModels where
  toPlutusData :: CostModels -> Data
toPlutusData CostModels
costModels = Map Word8 [Integer] -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData (Map Word8 [Integer] -> Data) -> Map Word8 [Integer] -> Data
forall a b. (a -> b) -> a -> b
$ (Int64 -> Integer) -> [Int64] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger ([Int64] -> [Integer]) -> Map Word8 [Int64] -> Map Word8 [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostModels -> Map Word8 [Int64]
flattenCostModels CostModels
costModels
  fromPlutusData :: Data -> Maybe CostModels
fromPlutusData Data
costModelsData = do
    Map Word8 [Integer]
costModels :: Map.Map Word8 [Integer] <- Data -> Maybe (Map Word8 [Integer])
forall x. ToPlutusData x => Data -> Maybe x
fromPlutusData Data
costModelsData
    Map Word8 [Int64] -> Maybe CostModels
forall (m :: * -> *).
MonadFail m =>
Map Word8 [Int64] -> m CostModels
mkCostModelsLenient (([Integer] -> [Int64]) -> Map Word8 [Integer] -> Map Word8 [Int64]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Integer -> Int64) -> [Integer] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Int64
forall a. Num a => Integer -> a
fromInteger) Map Word8 [Integer]
costModels)

instance ToPlutusData ExUnits where
  toPlutusData :: ExUnits -> Data
toPlutusData (ExUnits Natural
a Natural
b) = [Data] -> Data
List [Natural -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData Natural
a, Natural -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData Natural
b]
  fromPlutusData :: Data -> Maybe ExUnits
fromPlutusData (List [Data
x, Data
y]) = Natural -> Natural -> ExUnits
ExUnits (Natural -> Natural -> ExUnits)
-> Maybe Natural -> Maybe (Natural -> ExUnits)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data -> Maybe Natural
forall x. ToPlutusData x => Data -> Maybe x
fromPlutusData Data
x Maybe (Natural -> ExUnits) -> Maybe Natural -> Maybe ExUnits
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Data -> Maybe Natural
forall x. ToPlutusData x => Data -> Maybe x
fromPlutusData Data
y
  fromPlutusData Data
_ = Maybe ExUnits
forall a. Maybe a
Nothing

instance ToPlutusData Prices where
  toPlutusData :: Prices -> Data
toPlutusData Prices
p = [Data] -> Data
List [NonNegativeInterval -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData (Prices -> NonNegativeInterval
prMem Prices
p), NonNegativeInterval -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData (Prices -> NonNegativeInterval
prSteps Prices
p)]
  fromPlutusData :: Data -> Maybe Prices
fromPlutusData (List [Data
x, Data
y]) = NonNegativeInterval -> NonNegativeInterval -> Prices
Prices (NonNegativeInterval -> NonNegativeInterval -> Prices)
-> Maybe NonNegativeInterval
-> Maybe (NonNegativeInterval -> Prices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data -> Maybe NonNegativeInterval
forall x. ToPlutusData x => Data -> Maybe x
fromPlutusData Data
x Maybe (NonNegativeInterval -> Prices)
-> Maybe NonNegativeInterval -> Maybe Prices
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Data -> Maybe NonNegativeInterval
forall x. ToPlutusData x => Data -> Maybe x
fromPlutusData Data
y
  fromPlutusData Data
_ = Maybe Prices
forall a. Maybe a
Nothing

deriving instance ToPlutusData Coin

instance ToPlutusData Word32 where
  toPlutusData :: Word32 -> Data
toPlutusData Word32
w32 = Integer -> Data
I (forall a. Integral a => a -> Integer
toInteger @Word32 Word32
w32)
  fromPlutusData :: Data -> Maybe Word32
fromPlutusData (I Integer
n)
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound @Word32) =
        Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Word32 -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger @Word32 Integer
n
  fromPlutusData Data
_ = Maybe Word32
forall a. Maybe a
Nothing

instance ToPlutusData Word16 where
  toPlutusData :: Word16 -> Data
toPlutusData Word16
w16 = Integer -> Data
I (forall a. Integral a => a -> Integer
toInteger @Word16 Word16
w16)
  fromPlutusData :: Data -> Maybe Word16
fromPlutusData (I Integer
n) | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound @Word16) = Word16 -> Maybe Word16
forall a. a -> Maybe a
Just (Word16 -> Maybe Word16) -> Word16 -> Maybe Word16
forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger @Word16 Integer
n
  fromPlutusData Data
_ = Maybe Word16
forall a. Maybe a
Nothing

instance ToPlutusData Word8 where
  toPlutusData :: Word8 -> Data
toPlutusData Word8
w8 = Integer -> Data
I (forall a. Integral a => a -> Integer
toInteger @Word8 Word8
w8)
  fromPlutusData :: Data -> Maybe Word8
fromPlutusData (I Integer
n) | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound @Word8) = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger @Word8 Integer
n
  fromPlutusData Data
_ = Maybe Word8
forall a. Maybe a
Nothing

deriving instance ToPlutusData EpochInterval

instance ToPlutusData Natural where
  toPlutusData :: Natural -> Data
toPlutusData Natural
nat = Integer -> Data
I (forall a. Integral a => a -> Integer
toInteger @Natural Natural
nat)
  fromPlutusData :: Data -> Maybe Natural
fromPlutusData (I Integer
n) | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural) -> Natural -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger @Natural Integer
n
  fromPlutusData Data
_ = Maybe Natural
forall a. Maybe a
Nothing

instance ToPlutusData Integer where
  toPlutusData :: Integer -> Data
toPlutusData Integer
n = Integer -> Data
I Integer
n
  fromPlutusData :: Data -> Maybe Integer
fromPlutusData (I Integer
n) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n
  fromPlutusData Data
_ = Maybe Integer
forall a. Maybe a
Nothing

instance ToPlutusData Word where
  toPlutusData :: Word -> Data
toPlutusData Word
w = Integer -> Data
I (forall a. Integral a => a -> Integer
toInteger @Word Word
w)
  fromPlutusData :: Data -> Maybe Word
fromPlutusData (I Integer
n) | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Integer
forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound @Word) = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> Word -> Maybe Word
forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger @Word Integer
n
  fromPlutusData Data
_ = Maybe Word
forall a. Maybe a
Nothing

instance (ToPlutusData a, HasZero a) => ToPlutusData (NonZero a) where
  toPlutusData :: NonZero a -> Data
toPlutusData = a -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData (a -> Data) -> (NonZero a -> a) -> NonZero a -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero a -> a
forall a. NonZero a -> a
unNonZero
  fromPlutusData :: Data -> Maybe (NonZero a)
fromPlutusData Data
x = a -> Maybe (NonZero a)
forall a. HasZero a => a -> Maybe (NonZero a)
nonZero (a -> Maybe (NonZero a)) -> Maybe a -> Maybe (NonZero a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Data -> Maybe a
forall x. ToPlutusData x => Data -> Maybe x
fromPlutusData Data
x

instance ToPlutusData Nonce where
  toPlutusData :: Nonce -> Data
toPlutusData = [Char] -> Nonce -> Data
forall a. HasCallStack => [Char] -> a
error [Char]
"unsupported"
  fromPlutusData :: Data -> Maybe Nonce
fromPlutusData = [Char] -> Data -> Maybe Nonce
forall a. HasCallStack => [Char] -> a
error [Char]
"unsupported"