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

module Cardano.Chain.Genesis.NonAvvmBalances (
  GenesisNonAvvmBalances (..),
  convertNonAvvmDataToBalances,
)
where

import Cardano.Chain.Common (
  Address,
  Lovelace,
  LovelaceError,
  addLovelace,
  decodeAddressBase58,
  integerToLovelace,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecoderError,
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import qualified Data.Map.Strict as M
import Formatting (bprint, build)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))
import Text.JSON.Canonical (FromJSON (..), ToJSON (..))

-- | Predefined balances of non avvm entries.
newtype GenesisNonAvvmBalances = GenesisNonAvvmBalances
  { GenesisNonAvvmBalances -> Map Address Lovelace
unGenesisNonAvvmBalances :: Map Address Lovelace
  }
  deriving (Int -> GenesisNonAvvmBalances -> ShowS
[GenesisNonAvvmBalances] -> ShowS
GenesisNonAvvmBalances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisNonAvvmBalances] -> ShowS
$cshowList :: [GenesisNonAvvmBalances] -> ShowS
show :: GenesisNonAvvmBalances -> String
$cshow :: GenesisNonAvvmBalances -> String
showsPrec :: Int -> GenesisNonAvvmBalances -> ShowS
$cshowsPrec :: Int -> GenesisNonAvvmBalances -> ShowS
Show, GenesisNonAvvmBalances -> GenesisNonAvvmBalances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenesisNonAvvmBalances -> GenesisNonAvvmBalances -> Bool
$c/= :: GenesisNonAvvmBalances -> GenesisNonAvvmBalances -> Bool
== :: GenesisNonAvvmBalances -> GenesisNonAvvmBalances -> Bool
$c== :: GenesisNonAvvmBalances -> GenesisNonAvvmBalances -> Bool
Eq, Context -> GenesisNonAvvmBalances -> IO (Maybe ThunkInfo)
Proxy GenesisNonAvvmBalances -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy GenesisNonAvvmBalances -> String
$cshowTypeOf :: Proxy GenesisNonAvvmBalances -> String
wNoThunks :: Context -> GenesisNonAvvmBalances -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenesisNonAvvmBalances -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenesisNonAvvmBalances -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> GenesisNonAvvmBalances -> IO (Maybe ThunkInfo)
NoThunks)

instance B.Buildable GenesisNonAvvmBalances where
  build :: GenesisNonAvvmBalances -> Builder
build (GenesisNonAvvmBalances Map Address Lovelace
m) =
    forall a. Format Builder a -> a
bprint (Format
  (Map Address Lovelace -> Builder) (Map Address Lovelace -> Builder)
"GenesisNonAvvmBalances: " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t k v r.
(IsList t, Item t ~ (k, v), Buildable k, Buildable v) =>
Format r (t -> r)
mapJson) Map Address Lovelace
m

deriving instance Semigroup GenesisNonAvvmBalances

deriving instance Monoid GenesisNonAvvmBalances

instance Monad m => ToJSON m GenesisNonAvvmBalances where
  toJSON :: GenesisNonAvvmBalances -> 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
. GenesisNonAvvmBalances -> Map Address Lovelace
unGenesisNonAvvmBalances

instance MonadError SchemaError m => FromJSON m GenesisNonAvvmBalances where
  fromJSON :: JSValue -> m GenesisNonAvvmBalances
fromJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Address Lovelace -> GenesisNonAvvmBalances
GenesisNonAvvmBalances 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 GenesisNonAvvmBalances where
  toCBOR :: GenesisNonAvvmBalances -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

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

instance EncCBOR GenesisNonAvvmBalances where
  encCBOR :: GenesisNonAvvmBalances -> Encoding
encCBOR (GenesisNonAvvmBalances Map Address Lovelace
gnab) =
    Word -> Encoding
encodeListLen Word
1
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR @(Map Address Lovelace) Map Address Lovelace
gnab

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

data NonAvvmBalancesError
  = NonAvvmBalancesLovelaceError LovelaceError
  | NonAvvmBalancesDecoderError DecoderError

instance B.Buildable NonAvvmBalancesError where
  build :: NonAvvmBalancesError -> Builder
build = \case
    NonAvvmBalancesLovelaceError LovelaceError
err ->
      forall a. Format Builder a -> a
bprint
        (Format (LovelaceError -> Builder) (LovelaceError -> Builder)
"Failed to construct a lovelace in NonAvvmBalances.\n Error: " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build)
        LovelaceError
err
    NonAvvmBalancesDecoderError DecoderError
err ->
      forall a. Format Builder a -> a
bprint
        (Format (DecoderError -> Builder) (DecoderError -> Builder)
"Failed to decode NonAvvmBalances.\n Error: " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build)
        DecoderError
err

-- | Generate genesis address distribution out of avvm parameters. Txdistr of
--   the utxo is all empty. Redelegate it in calling function.
convertNonAvvmDataToBalances ::
  forall m.
  MonadError NonAvvmBalancesError m =>
  Map Text Integer ->
  m GenesisNonAvvmBalances
convertNonAvvmDataToBalances :: forall (m :: * -> *).
MonadError NonAvvmBalancesError m =>
Map Text Integer -> m GenesisNonAvvmBalances
convertNonAvvmDataToBalances Map Text Integer
balances = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Address Lovelace -> GenesisNonAvvmBalances
GenesisNonAvvmBalances forall a b. (a -> b) -> a -> b
$ do
  [(Address, Lovelace)]
converted <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text, Integer) -> m (Address, Lovelace)
convert (forall k a. Map k a -> [(k, a)]
M.toList Map Text Integer
balances)
  [(Address, Lovelace)] -> m (Map Address Lovelace)
mkBalances [(Address, Lovelace)]
converted
  where
    mkBalances :: [(Address, Lovelace)] -> m (Map Address Lovelace)
    mkBalances :: [(Address, Lovelace)] -> m (Map Address Lovelace)
mkBalances =
      -- Pull 'LovelaceError's out of the 'Map' and lift them to
      -- 'NonAvvmBalancesError's
      (forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` LovelaceError -> NonAvvmBalancesError
NonAvvmBalancesLovelaceError)
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        -- Make map joining duplicate keys with 'addLovelace' lifted from 'Lovelace ->
        -- Lovelace -> Either LovelaceError Lovelace' to 'Either LovelaceError Lovelace -> Either
        -- LovelaceError Lovelace -> Either LovelaceError Lovelace'
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith (\Either LovelaceError Lovelace
c -> forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Lovelace -> Lovelace -> Either LovelaceError Lovelace
addLovelace Either LovelaceError Lovelace
c)
        -- Lift the 'Lovelace's to 'Either LovelaceError Lovelace's
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a b. b -> Either a b
Right)

    convert :: (Text, Integer) -> m (Address, Lovelace)
    convert :: (Text, Integer) -> m (Address, Lovelace)
convert (Text
txt, Integer
i) = do
      Address
addr <- Text -> Either DecoderError Address
decodeAddressBase58 Text
txt forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` DecoderError -> NonAvvmBalancesError
NonAvvmBalancesDecoderError
      Lovelace
lovelace <- Integer -> Either LovelaceError Lovelace
integerToLovelace Integer
i forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` LovelaceError -> NonAvvmBalancesError
NonAvvmBalancesLovelaceError
      forall (m :: * -> *) a. Monad m => a -> m a
return (Address
addr, Lovelace
lovelace)