module Cardano.Api.Rewards
  ( DelegationsAndRewards (..)
  , mergeDelegsAndRewards
  )
where

import           Cardano.Api.Address
import           Cardano.Api.Certificate

import qualified Cardano.Ledger.Coin as L

import           Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import           Data.List (nub)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           GHC.Exts (IsList (..))

-- | A mapping of Shelley reward accounts to both the stake pool that they
-- delegate to and their reward account balance.
-- TODO: Move to cardano-api
newtype DelegationsAndRewards
  = DelegationsAndRewards (Map StakeAddress L.Coin, Map StakeAddress PoolId)
  deriving (DelegationsAndRewards -> DelegationsAndRewards -> Bool
(DelegationsAndRewards -> DelegationsAndRewards -> Bool)
-> (DelegationsAndRewards -> DelegationsAndRewards -> Bool)
-> Eq DelegationsAndRewards
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DelegationsAndRewards -> DelegationsAndRewards -> Bool
== :: DelegationsAndRewards -> DelegationsAndRewards -> Bool
$c/= :: DelegationsAndRewards -> DelegationsAndRewards -> Bool
/= :: DelegationsAndRewards -> DelegationsAndRewards -> Bool
Eq, Int -> DelegationsAndRewards -> ShowS
[DelegationsAndRewards] -> ShowS
DelegationsAndRewards -> String
(Int -> DelegationsAndRewards -> ShowS)
-> (DelegationsAndRewards -> String)
-> ([DelegationsAndRewards] -> ShowS)
-> Show DelegationsAndRewards
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DelegationsAndRewards -> ShowS
showsPrec :: Int -> DelegationsAndRewards -> ShowS
$cshow :: DelegationsAndRewards -> String
show :: DelegationsAndRewards -> String
$cshowList :: [DelegationsAndRewards] -> ShowS
showList :: [DelegationsAndRewards] -> ShowS
Show)

instance ToJSON DelegationsAndRewards where
  toJSON :: DelegationsAndRewards -> Value
toJSON DelegationsAndRewards
delegsAndRwds =
    Array -> Value
Aeson.Array
      (Array -> Value)
-> ([(StakeAddress, Maybe Coin, Maybe PoolId)] -> Array)
-> [(StakeAddress, Maybe Coin, Maybe PoolId)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item Array] -> Array
[Value] -> Array
forall l. IsList l => [Item l] -> l
fromList
      ([Value] -> Array)
-> ([(StakeAddress, Maybe Coin, Maybe PoolId)] -> [Value])
-> [(StakeAddress, Maybe Coin, Maybe PoolId)]
-> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((StakeAddress, Maybe Coin, Maybe PoolId) -> Value)
-> [(StakeAddress, Maybe Coin, Maybe PoolId)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (StakeAddress, Maybe Coin, Maybe PoolId) -> Value
delegAndRwdToJson
      ([(StakeAddress, Maybe Coin, Maybe PoolId)] -> Value)
-> [(StakeAddress, Maybe Coin, Maybe PoolId)] -> Value
forall a b. (a -> b) -> a -> b
$ DelegationsAndRewards -> [(StakeAddress, Maybe Coin, Maybe PoolId)]
mergeDelegsAndRewards DelegationsAndRewards
delegsAndRwds
   where
    delegAndRwdToJson :: (StakeAddress, Maybe L.Coin, Maybe PoolId) -> Aeson.Value
    delegAndRwdToJson :: (StakeAddress, Maybe Coin, Maybe PoolId) -> Value
delegAndRwdToJson (StakeAddress
addr, Maybe Coin
mRewards, Maybe PoolId
mPoolId) =
      [Pair] -> Value
Aeson.object
        [ Key
"address" Key -> StakeAddress -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StakeAddress
addr
        , Key
"delegation" Key -> Maybe PoolId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe PoolId
mPoolId
        , Key
"rewardAccountBalance" Key -> Maybe Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Coin
mRewards
        ]

instance FromJSON DelegationsAndRewards where
  parseJSON :: Value -> Parser DelegationsAndRewards
parseJSON = String
-> (Array -> Parser DelegationsAndRewards)
-> Value
-> Parser DelegationsAndRewards
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"DelegationsAndRewards" ((Array -> Parser DelegationsAndRewards)
 -> Value -> Parser DelegationsAndRewards)
-> (Array -> Parser DelegationsAndRewards)
-> Value
-> Parser DelegationsAndRewards
forall a b. (a -> b) -> a -> b
$ \Array
arr -> do
    let vals :: [Item Array]
vals = Array -> [Item Array]
forall l. IsList l => l -> [Item l]
toList Array
arr
    [(StakeAddress, Maybe Coin, Maybe PoolId)]
decoded <- (Value -> Parser (StakeAddress, Maybe Coin, Maybe PoolId))
-> [Value] -> Parser [(StakeAddress, Maybe Coin, Maybe PoolId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser (StakeAddress, Maybe Coin, Maybe PoolId)
decodeObject [Value]
vals
    DelegationsAndRewards -> Parser DelegationsAndRewards
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DelegationsAndRewards -> Parser DelegationsAndRewards)
-> DelegationsAndRewards -> Parser DelegationsAndRewards
forall a b. (a -> b) -> a -> b
$ [(StakeAddress, Maybe Coin, Maybe PoolId)] -> DelegationsAndRewards
zipper [(StakeAddress, Maybe Coin, Maybe PoolId)]
decoded
   where
    zipper
      :: [(StakeAddress, Maybe L.Coin, Maybe PoolId)]
      -> DelegationsAndRewards
    zipper :: [(StakeAddress, Maybe Coin, Maybe PoolId)] -> DelegationsAndRewards
zipper [(StakeAddress, Maybe Coin, Maybe PoolId)]
l = do
      let maps :: [(Map StakeAddress Coin, Map StakeAddress PoolId)]
maps =
            [ ( Map StakeAddress Coin
-> (Coin -> Map StakeAddress Coin)
-> Maybe Coin
-> Map StakeAddress Coin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map StakeAddress Coin
forall a. Monoid a => a
mempty (StakeAddress -> Coin -> Map StakeAddress Coin
forall k a. k -> a -> Map k a
Map.singleton StakeAddress
sa) Maybe Coin
delegAmt
              , Map StakeAddress PoolId
-> (PoolId -> Map StakeAddress PoolId)
-> Maybe PoolId
-> Map StakeAddress PoolId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map StakeAddress PoolId
forall a. Monoid a => a
mempty (StakeAddress -> PoolId -> Map StakeAddress PoolId
forall k a. k -> a -> Map k a
Map.singleton StakeAddress
sa) Maybe PoolId
mPool
              )
            | (StakeAddress
sa, Maybe Coin
delegAmt, Maybe PoolId
mPool) <- [(StakeAddress, Maybe Coin, Maybe PoolId)]
l
            ]
      (Map StakeAddress Coin, Map StakeAddress PoolId)
-> DelegationsAndRewards
DelegationsAndRewards ((Map StakeAddress Coin, Map StakeAddress PoolId)
 -> DelegationsAndRewards)
-> (Map StakeAddress Coin, Map StakeAddress PoolId)
-> DelegationsAndRewards
forall a b. (a -> b) -> a -> b
$
        ((Map StakeAddress Coin, Map StakeAddress PoolId)
 -> (Map StakeAddress Coin, Map StakeAddress PoolId)
 -> (Map StakeAddress Coin, Map StakeAddress PoolId))
-> (Map StakeAddress Coin, Map StakeAddress PoolId)
-> [(Map StakeAddress Coin, Map StakeAddress PoolId)]
-> (Map StakeAddress Coin, Map StakeAddress PoolId)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
          (\(Map StakeAddress Coin
amtA, Map StakeAddress PoolId
delegA) (Map StakeAddress Coin
amtB, Map StakeAddress PoolId
delegB) -> (Map StakeAddress Coin
amtA Map StakeAddress Coin
-> Map StakeAddress Coin -> Map StakeAddress Coin
forall a. Semigroup a => a -> a -> a
<> Map StakeAddress Coin
amtB, Map StakeAddress PoolId
delegA Map StakeAddress PoolId
-> Map StakeAddress PoolId -> Map StakeAddress PoolId
forall a. Semigroup a => a -> a -> a
<> Map StakeAddress PoolId
delegB))
          (Map StakeAddress Coin
forall a. Monoid a => a
mempty, Map StakeAddress PoolId
forall a. Monoid a => a
mempty)
          [(Map StakeAddress Coin, Map StakeAddress PoolId)]
maps

    decodeObject
      :: Aeson.Value
      -> Aeson.Parser (StakeAddress, Maybe L.Coin, Maybe PoolId)
    decodeObject :: Value -> Parser (StakeAddress, Maybe Coin, Maybe PoolId)
decodeObject = String
-> (Object -> Parser (StakeAddress, Maybe Coin, Maybe PoolId))
-> Value
-> Parser (StakeAddress, Maybe Coin, Maybe PoolId)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DelegationsAndRewards" ((Object -> Parser (StakeAddress, Maybe Coin, Maybe PoolId))
 -> Value -> Parser (StakeAddress, Maybe Coin, Maybe PoolId))
-> (Object -> Parser (StakeAddress, Maybe Coin, Maybe PoolId))
-> Value
-> Parser (StakeAddress, Maybe Coin, Maybe PoolId)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      StakeAddress
address <- Object
o Object -> Key -> Parser StakeAddress
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
      Maybe PoolId
delegation <- Object
o Object -> Key -> Parser (Maybe PoolId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"delegation"
      Maybe Coin
rewardAccountBalance <- Object
o Object -> Key -> Parser (Maybe Coin)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rewardAccountBalance"
      (StakeAddress, Maybe Coin, Maybe PoolId)
-> Parser (StakeAddress, Maybe Coin, Maybe PoolId)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StakeAddress
address, Maybe Coin
rewardAccountBalance, Maybe PoolId
delegation)

mergeDelegsAndRewards :: DelegationsAndRewards -> [(StakeAddress, Maybe L.Coin, Maybe PoolId)]
mergeDelegsAndRewards :: DelegationsAndRewards -> [(StakeAddress, Maybe Coin, Maybe PoolId)]
mergeDelegsAndRewards (DelegationsAndRewards (Map StakeAddress Coin
rewardsMap, Map StakeAddress PoolId
delegMap)) =
  [ (StakeAddress
stakeAddr, StakeAddress -> Map StakeAddress Coin -> Maybe Coin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
stakeAddr Map StakeAddress Coin
rewardsMap, StakeAddress -> Map StakeAddress PoolId -> Maybe PoolId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
stakeAddr Map StakeAddress PoolId
delegMap)
  | StakeAddress
stakeAddr <- [StakeAddress] -> [StakeAddress]
forall a. Eq a => [a] -> [a]
nub ([StakeAddress] -> [StakeAddress])
-> [StakeAddress] -> [StakeAddress]
forall a b. (a -> b) -> a -> b
$ Map StakeAddress Coin -> [StakeAddress]
forall k a. Map k a -> [k]
Map.keys Map StakeAddress Coin
rewardsMap [StakeAddress] -> [StakeAddress] -> [StakeAddress]
forall a. [a] -> [a] -> [a]
++ Map StakeAddress PoolId -> [StakeAddress]
forall k a. Map k a -> [k]
Map.keys Map StakeAddress PoolId
delegMap
  ]