{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE UndecidableInstances       #-}

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

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(..))

import Cardano.Binary (DecoderError)
import Cardano.Chain.Common
  ( Address
  , Lovelace
  , LovelaceError
  , addLovelace
  , decodeAddressBase58
  , integerToLovelace
  )


-- | 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

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)