{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Chain.UTxO.UTxOConfiguration (
  UTxOConfiguration (..),
  defaultUTxOConfiguration,
  mkUTxOConfiguration,
) where

import Cardano.Chain.Common.Address (Address)
import Cardano.Chain.Common.Compact (CompactAddress, toCompactAddress)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import qualified Data.Set as Set
import NoThunks.Class (NoThunks (..))

-- | Additional configuration for ledger validation.
data UTxOConfiguration = UTxOConfiguration
  { UTxOConfiguration -> Set CompactAddress
tcAssetLockedSrcAddrs :: !(Set CompactAddress)
  -- ^ Set of source address which are asset-locked. Transactions which
  -- use these addresses as transaction inputs will be deemed invalid.
  }
  deriving (UTxOConfiguration -> UTxOConfiguration -> Bool
(UTxOConfiguration -> UTxOConfiguration -> Bool)
-> (UTxOConfiguration -> UTxOConfiguration -> Bool)
-> Eq UTxOConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UTxOConfiguration -> UTxOConfiguration -> Bool
== :: UTxOConfiguration -> UTxOConfiguration -> Bool
$c/= :: UTxOConfiguration -> UTxOConfiguration -> Bool
/= :: UTxOConfiguration -> UTxOConfiguration -> Bool
Eq, Int -> UTxOConfiguration -> ShowS
[UTxOConfiguration] -> ShowS
UTxOConfiguration -> String
(Int -> UTxOConfiguration -> ShowS)
-> (UTxOConfiguration -> String)
-> ([UTxOConfiguration] -> ShowS)
-> Show UTxOConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UTxOConfiguration -> ShowS
showsPrec :: Int -> UTxOConfiguration -> ShowS
$cshow :: UTxOConfiguration -> String
show :: UTxOConfiguration -> String
$cshowList :: [UTxOConfiguration] -> ShowS
showList :: [UTxOConfiguration] -> ShowS
Show, (forall x. UTxOConfiguration -> Rep UTxOConfiguration x)
-> (forall x. Rep UTxOConfiguration x -> UTxOConfiguration)
-> Generic UTxOConfiguration
forall x. Rep UTxOConfiguration x -> UTxOConfiguration
forall x. UTxOConfiguration -> Rep UTxOConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UTxOConfiguration -> Rep UTxOConfiguration x
from :: forall x. UTxOConfiguration -> Rep UTxOConfiguration x
$cto :: forall x. Rep UTxOConfiguration x -> UTxOConfiguration
to :: forall x. Rep UTxOConfiguration x -> UTxOConfiguration
Generic, Context -> UTxOConfiguration -> IO (Maybe ThunkInfo)
Proxy UTxOConfiguration -> String
(Context -> UTxOConfiguration -> IO (Maybe ThunkInfo))
-> (Context -> UTxOConfiguration -> IO (Maybe ThunkInfo))
-> (Proxy UTxOConfiguration -> String)
-> NoThunks UTxOConfiguration
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UTxOConfiguration -> IO (Maybe ThunkInfo)
noThunks :: Context -> UTxOConfiguration -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UTxOConfiguration -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UTxOConfiguration -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UTxOConfiguration -> String
showTypeOf :: Proxy UTxOConfiguration -> String
NoThunks)

instance ToCBOR UTxOConfiguration where
  toCBOR :: UTxOConfiguration -> Encoding
toCBOR = UTxOConfiguration -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR UTxOConfiguration where
  fromCBOR :: forall s. Decoder s UTxOConfiguration
fromCBOR = Decoder s UTxOConfiguration
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR UTxOConfiguration where
  encCBOR :: UTxOConfiguration -> Encoding
encCBOR (UTxOConfiguration Set CompactAddress
tcAssetLockedSrcAddrs_) =
    Word -> Encoding
encodeListLen Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR @(Set CompactAddress) Set CompactAddress
tcAssetLockedSrcAddrs_

instance DecCBOR UTxOConfiguration where
  decCBOR :: forall s. Decoder s UTxOConfiguration
decCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"UTxOConfiguration" Int
1
    Set CompactAddress -> UTxOConfiguration
UTxOConfiguration (Set CompactAddress -> UTxOConfiguration)
-> Decoder s (Set CompactAddress) -> Decoder s UTxOConfiguration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR @(Set CompactAddress)

defaultUTxOConfiguration :: UTxOConfiguration
defaultUTxOConfiguration :: UTxOConfiguration
defaultUTxOConfiguration =
  UTxOConfiguration
    { tcAssetLockedSrcAddrs :: Set CompactAddress
tcAssetLockedSrcAddrs = Set CompactAddress
forall a. Set a
Set.empty
    }

mkUTxOConfiguration :: [Address] -> UTxOConfiguration
mkUTxOConfiguration :: [Address] -> UTxOConfiguration
mkUTxOConfiguration [Address]
lockedSrcAddrs =
  UTxOConfiguration
    { tcAssetLockedSrcAddrs :: Set CompactAddress
tcAssetLockedSrcAddrs = [CompactAddress] -> Set CompactAddress
forall a. Ord a => [a] -> Set a
Set.fromList ((Address -> CompactAddress) -> [Address] -> [CompactAddress]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Address -> CompactAddress
toCompactAddress [Address]
lockedSrcAddrs)
    }