{-# 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.Binary
  ( DecoderError,
    FromCBOR (..),
    ToCBOR (..),
    encodeListLen,
    enforceSize,
  )
import Cardano.Chain.Common
  ( Address,
    Lovelace,
    LovelaceError,
    addLovelace,
    decodeAddressBase58,
    integerToLovelace,
  )
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
(Int -> GenesisNonAvvmBalances -> ShowS)
-> (GenesisNonAvvmBalances -> String)
-> ([GenesisNonAvvmBalances] -> ShowS)
-> Show GenesisNonAvvmBalances
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
(GenesisNonAvvmBalances -> GenesisNonAvvmBalances -> Bool)
-> (GenesisNonAvvmBalances -> GenesisNonAvvmBalances -> Bool)
-> Eq GenesisNonAvvmBalances
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
(Context -> GenesisNonAvvmBalances -> IO (Maybe ThunkInfo))
-> (Context -> GenesisNonAvvmBalances -> IO (Maybe ThunkInfo))
-> (Proxy GenesisNonAvvmBalances -> String)
-> NoThunks GenesisNonAvvmBalances
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) =
    Format Builder (Map Address Lovelace -> Builder)
-> Map Address Lovelace -> Builder
forall a. Format Builder a -> a
bprint (Format
  (Map Address Lovelace -> Builder) (Map Address Lovelace -> Builder)
"GenesisNonAvvmBalances: " Format
  (Map Address Lovelace -> Builder) (Map Address Lovelace -> Builder)
-> Format Builder (Map Address Lovelace -> Builder)
-> Format Builder (Map Address Lovelace -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Map Address Lovelace -> Builder)
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 = Map Address Lovelace -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (Map Address Lovelace -> m JSValue)
-> (GenesisNonAvvmBalances -> Map Address Lovelace)
-> GenesisNonAvvmBalances
-> m JSValue
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 = (Map Address Lovelace -> GenesisNonAvvmBalances)
-> m (Map Address Lovelace) -> m GenesisNonAvvmBalances
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Address Lovelace -> GenesisNonAvvmBalances
GenesisNonAvvmBalances (m (Map Address Lovelace) -> m GenesisNonAvvmBalances)
-> (JSValue -> m (Map Address Lovelace))
-> JSValue
-> m GenesisNonAvvmBalances
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JSValue -> m (Map Address Lovelace)
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON

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

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

data NonAvvmBalancesError
  = NonAvvmBalancesLovelaceError LovelaceError
  | NonAvvmBalancesDecoderError DecoderError

instance B.Buildable NonAvvmBalancesError where
  build :: NonAvvmBalancesError -> Builder
build = \case
    NonAvvmBalancesLovelaceError LovelaceError
err ->
      Format Builder (LovelaceError -> Builder)
-> LovelaceError -> Builder
forall a. Format Builder a -> a
bprint
        (Format (LovelaceError -> Builder) (LovelaceError -> Builder)
"Failed to construct a lovelace in NonAvvmBalances.\n Error: " Format (LovelaceError -> Builder) (LovelaceError -> Builder)
-> Format Builder (LovelaceError -> Builder)
-> Format Builder (LovelaceError -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (LovelaceError -> Builder)
forall a r. Buildable a => Format r (a -> r)
build)
        LovelaceError
err
    NonAvvmBalancesDecoderError DecoderError
err ->
      Format Builder (DecoderError -> Builder) -> DecoderError -> Builder
forall a. Format Builder a -> a
bprint
        (Format (DecoderError -> Builder) (DecoderError -> Builder)
"Failed to decode NonAvvmBalances.\n Error: " Format (DecoderError -> Builder) (DecoderError -> Builder)
-> Format Builder (DecoderError -> Builder)
-> Format Builder (DecoderError -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (DecoderError -> Builder)
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 :: Map Text Integer -> m GenesisNonAvvmBalances
convertNonAvvmDataToBalances Map Text Integer
balances = (Map Address Lovelace -> GenesisNonAvvmBalances)
-> m (Map Address Lovelace) -> m GenesisNonAvvmBalances
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Address Lovelace -> GenesisNonAvvmBalances
GenesisNonAvvmBalances (m (Map Address Lovelace) -> m GenesisNonAvvmBalances)
-> m (Map Address Lovelace) -> m GenesisNonAvvmBalances
forall a b. (a -> b) -> a -> b
$ do
  [(Address, Lovelace)]
converted <- ((Text, Integer) -> m (Address, Lovelace))
-> [(Text, Integer)] -> m [(Address, Lovelace)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text, Integer) -> m (Address, Lovelace)
convert (Map Text Integer -> [(Text, Integer)]
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
      (Either LovelaceError (Map Address Lovelace)
-> (LovelaceError -> NonAvvmBalancesError)
-> m (Map Address Lovelace)
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` LovelaceError -> NonAvvmBalancesError
NonAvvmBalancesLovelaceError)
        (Either LovelaceError (Map Address Lovelace)
 -> m (Map Address Lovelace))
-> ([(Address, Lovelace)]
    -> Either LovelaceError (Map Address Lovelace))
-> [(Address, Lovelace)]
-> m (Map Address Lovelace)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map Address (Either LovelaceError Lovelace)
-> Either LovelaceError (Map Address Lovelace)
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'
        (Map Address (Either LovelaceError Lovelace)
 -> Either LovelaceError (Map Address Lovelace))
-> ([(Address, Lovelace)]
    -> Map Address (Either LovelaceError Lovelace))
-> [(Address, Lovelace)]
-> Either LovelaceError (Map Address Lovelace)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Either LovelaceError Lovelace
 -> Either LovelaceError Lovelace -> Either LovelaceError Lovelace)
-> [(Address, Either LovelaceError Lovelace)]
-> Map Address (Either LovelaceError Lovelace)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith (\Either LovelaceError Lovelace
c -> Either LovelaceError (Either LovelaceError Lovelace)
-> Either LovelaceError Lovelace
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either LovelaceError (Either LovelaceError Lovelace)
 -> Either LovelaceError Lovelace)
-> (Either LovelaceError Lovelace
    -> Either LovelaceError (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
. (Lovelace -> Lovelace -> Either LovelaceError Lovelace)
-> Either LovelaceError Lovelace
-> Either LovelaceError Lovelace
-> Either LovelaceError (Either LovelaceError Lovelace)
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
        ([(Address, Either LovelaceError Lovelace)]
 -> Map Address (Either LovelaceError Lovelace))
-> ([(Address, Lovelace)]
    -> [(Address, Either LovelaceError Lovelace)])
-> [(Address, Lovelace)]
-> Map Address (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
. ((Address, Lovelace) -> (Address, Either LovelaceError Lovelace))
-> [(Address, Lovelace)]
-> [(Address, Either LovelaceError Lovelace)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Lovelace -> Either LovelaceError Lovelace)
-> (Address, Lovelace) -> (Address, Either LovelaceError Lovelace)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Lovelace -> Either LovelaceError Lovelace
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 Either DecoderError Address
-> (DecoderError -> NonAvvmBalancesError) -> m Address
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 Either LovelaceError Lovelace
-> (LovelaceError -> NonAvvmBalancesError) -> m Lovelace
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` LovelaceError -> NonAvvmBalancesError
NonAvvmBalancesLovelaceError
      (Address, Lovelace) -> m (Address, Lovelace)
forall (m :: * -> *) a. Monad m => a -> m a
return (Address
addr, Lovelace
lovelace)