{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-missed-specialisations #-}

module Cardano.Chain.Genesis.AvvmBalances (
  GenesisAvvmBalances (..),
)
where

import Cardano.Chain.Common (Lovelace)
import Cardano.Crypto.Signing.Redeem (CompactRedeemVerificationKey)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import NoThunks.Class (NoThunks (..))
import Text.JSON.Canonical (FromJSON (..), ToJSON (..))

-- | Predefined balances of AVVM (Ada Voucher Vending Machine) entries.
-- People who purchased Ada at a pre-sale were issued a certificate during
-- the pre-sale period. These certificates allow customers to redeem ADA.
newtype GenesisAvvmBalances = GenesisAvvmBalances
  { GenesisAvvmBalances -> Map CompactRedeemVerificationKey Lovelace
unGenesisAvvmBalances :: Map CompactRedeemVerificationKey Lovelace
  }
  deriving (Int -> GenesisAvvmBalances -> ShowS
[GenesisAvvmBalances] -> ShowS
GenesisAvvmBalances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisAvvmBalances] -> ShowS
$cshowList :: [GenesisAvvmBalances] -> ShowS
show :: GenesisAvvmBalances -> String
$cshow :: GenesisAvvmBalances -> String
showsPrec :: Int -> GenesisAvvmBalances -> ShowS
$cshowsPrec :: Int -> GenesisAvvmBalances -> ShowS
Show, GenesisAvvmBalances -> GenesisAvvmBalances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenesisAvvmBalances -> GenesisAvvmBalances -> Bool
$c/= :: GenesisAvvmBalances -> GenesisAvvmBalances -> Bool
== :: GenesisAvvmBalances -> GenesisAvvmBalances -> Bool
$c== :: GenesisAvvmBalances -> GenesisAvvmBalances -> Bool
Eq, NonEmpty GenesisAvvmBalances -> GenesisAvvmBalances
GenesisAvvmBalances -> GenesisAvvmBalances -> GenesisAvvmBalances
forall b.
Integral b =>
b -> GenesisAvvmBalances -> GenesisAvvmBalances
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b.
Integral b =>
b -> GenesisAvvmBalances -> GenesisAvvmBalances
$cstimes :: forall b.
Integral b =>
b -> GenesisAvvmBalances -> GenesisAvvmBalances
sconcat :: NonEmpty GenesisAvvmBalances -> GenesisAvvmBalances
$csconcat :: NonEmpty GenesisAvvmBalances -> GenesisAvvmBalances
<> :: GenesisAvvmBalances -> GenesisAvvmBalances -> GenesisAvvmBalances
$c<> :: GenesisAvvmBalances -> GenesisAvvmBalances -> GenesisAvvmBalances
Semigroup, Context -> GenesisAvvmBalances -> IO (Maybe ThunkInfo)
Proxy GenesisAvvmBalances -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy GenesisAvvmBalances -> String
$cshowTypeOf :: Proxy GenesisAvvmBalances -> String
wNoThunks :: Context -> GenesisAvvmBalances -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenesisAvvmBalances -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenesisAvvmBalances -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> GenesisAvvmBalances -> IO (Maybe ThunkInfo)
NoThunks)

instance Monad m => ToJSON m GenesisAvvmBalances where
  toJSON :: GenesisAvvmBalances -> m JSValue
toJSON = forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. GenesisAvvmBalances -> Map CompactRedeemVerificationKey Lovelace
unGenesisAvvmBalances

instance MonadError SchemaError m => FromJSON m GenesisAvvmBalances where
  fromJSON :: JSValue -> m GenesisAvvmBalances
fromJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map CompactRedeemVerificationKey Lovelace -> GenesisAvvmBalances
GenesisAvvmBalances forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON

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

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

instance EncCBOR GenesisAvvmBalances where
  encCBOR :: GenesisAvvmBalances -> Encoding
encCBOR (GenesisAvvmBalances Map CompactRedeemVerificationKey Lovelace
gab) =
    Word -> Encoding
encodeListLen Word
1
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR @(Map CompactRedeemVerificationKey Lovelace) Map CompactRedeemVerificationKey Lovelace
gab

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