{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

module Cardano.Ledger.DRep (
  DRep (DRepCredential, DRepKeyHash, DRepScriptHash, DRepAlwaysAbstain, DRepAlwaysNoConfidence),
  DRepState (..),
  drepExpiryL,
  drepAnchorL,
  drepDepositL,
  drepDelegsL,
) where

import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  EncCBOR (..),
  Interns,
  decNoShareCBOR,
  interns,
  internsFromSet,
 )
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Credential (Credential (..), credToText, parseCredential)
import Cardano.Ledger.Hashes (ScriptHash)
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Control.DeepSeq (NFData (..))
import Data.Aeson (
  FromJSON (..),
  FromJSONKey (..),
  FromJSONKeyFunction (..),
  KeyValue (..),
  ToJSON (..),
  ToJSONKey (..),
  Value (..),
  object,
  withObject,
  withText,
  (.!=),
  (.:),
  (.:?),
 )
import Data.Aeson.Types (toJSONKeyText)
import Data.Set (Set)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

-- =======================================
-- DRep and DRepState

data DRep
  = DRepKeyHash !(KeyHash 'DRepRole)
  | DRepScriptHash !ScriptHash
  | DRepAlwaysAbstain
  | DRepAlwaysNoConfidence
  deriving (Int -> DRep -> ShowS
[DRep] -> ShowS
DRep -> String
(Int -> DRep -> ShowS)
-> (DRep -> String) -> ([DRep] -> ShowS) -> Show DRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DRep -> ShowS
showsPrec :: Int -> DRep -> ShowS
$cshow :: DRep -> String
show :: DRep -> String
$cshowList :: [DRep] -> ShowS
showList :: [DRep] -> ShowS
Show, DRep -> DRep -> Bool
(DRep -> DRep -> Bool) -> (DRep -> DRep -> Bool) -> Eq DRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DRep -> DRep -> Bool
== :: DRep -> DRep -> Bool
$c/= :: DRep -> DRep -> Bool
/= :: DRep -> DRep -> Bool
Eq, Eq DRep
Eq DRep =>
(DRep -> DRep -> Ordering)
-> (DRep -> DRep -> Bool)
-> (DRep -> DRep -> Bool)
-> (DRep -> DRep -> Bool)
-> (DRep -> DRep -> Bool)
-> (DRep -> DRep -> DRep)
-> (DRep -> DRep -> DRep)
-> Ord DRep
DRep -> DRep -> Bool
DRep -> DRep -> Ordering
DRep -> DRep -> DRep
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DRep -> DRep -> Ordering
compare :: DRep -> DRep -> Ordering
$c< :: DRep -> DRep -> Bool
< :: DRep -> DRep -> Bool
$c<= :: DRep -> DRep -> Bool
<= :: DRep -> DRep -> Bool
$c> :: DRep -> DRep -> Bool
> :: DRep -> DRep -> Bool
$c>= :: DRep -> DRep -> Bool
>= :: DRep -> DRep -> Bool
$cmax :: DRep -> DRep -> DRep
max :: DRep -> DRep -> DRep
$cmin :: DRep -> DRep -> DRep
min :: DRep -> DRep -> DRep
Ord, (forall x. DRep -> Rep DRep x)
-> (forall x. Rep DRep x -> DRep) -> Generic DRep
forall x. Rep DRep x -> DRep
forall x. DRep -> Rep DRep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DRep -> Rep DRep x
from :: forall x. DRep -> Rep DRep x
$cto :: forall x. Rep DRep x -> DRep
to :: forall x. Rep DRep x -> DRep
Generic, Context -> DRep -> IO (Maybe ThunkInfo)
Proxy DRep -> String
(Context -> DRep -> IO (Maybe ThunkInfo))
-> (Context -> DRep -> IO (Maybe ThunkInfo))
-> (Proxy DRep -> String)
-> NoThunks DRep
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> DRep -> IO (Maybe ThunkInfo)
noThunks :: Context -> DRep -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> DRep -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> DRep -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy DRep -> String
showTypeOf :: Proxy DRep -> String
NoThunks, DRep -> ()
(DRep -> ()) -> NFData DRep
forall a. (a -> ()) -> NFData a
$crnf :: DRep -> ()
rnf :: DRep -> ()
NFData)

instance EncCBOR DRep where
  encCBOR :: DRep -> Encoding
encCBOR (DRepKeyHash KeyHash 'DRepRole
kh) =
    Encode 'Open DRep -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open DRep -> Encoding) -> Encode 'Open DRep -> Encoding
forall a b. (a -> b) -> a -> b
$
      (KeyHash 'DRepRole -> DRep)
-> Word -> Encode 'Open (KeyHash 'DRepRole -> DRep)
forall t. t -> Word -> Encode 'Open t
Sum KeyHash 'DRepRole -> DRep
DRepKeyHash Word
0
        Encode 'Open (KeyHash 'DRepRole -> DRep)
-> Encode ('Closed 'Dense) (KeyHash 'DRepRole) -> Encode 'Open DRep
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> KeyHash 'DRepRole -> Encode ('Closed 'Dense) (KeyHash 'DRepRole)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'DRepRole
kh
  encCBOR (DRepScriptHash ScriptHash
sh) =
    Encode 'Open DRep -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open DRep -> Encoding) -> Encode 'Open DRep -> Encoding
forall a b. (a -> b) -> a -> b
$
      (ScriptHash -> DRep) -> Word -> Encode 'Open (ScriptHash -> DRep)
forall t. t -> Word -> Encode 'Open t
Sum ScriptHash -> DRep
DRepScriptHash Word
1
        Encode 'Open (ScriptHash -> DRep)
-> Encode ('Closed 'Dense) ScriptHash -> Encode 'Open DRep
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ScriptHash -> Encode ('Closed 'Dense) ScriptHash
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ScriptHash
sh
  encCBOR DRep
DRepAlwaysAbstain =
    Encode 'Open DRep -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open DRep -> Encoding) -> Encode 'Open DRep -> Encoding
forall a b. (a -> b) -> a -> b
$
      DRep -> Word -> Encode 'Open DRep
forall t. t -> Word -> Encode 'Open t
Sum DRep
DRepAlwaysAbstain Word
2
  encCBOR DRep
DRepAlwaysNoConfidence =
    Encode 'Open DRep -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open DRep -> Encoding) -> Encode 'Open DRep -> Encoding
forall a b. (a -> b) -> a -> b
$
      DRep -> Word -> Encode 'Open DRep
forall t. t -> Word -> Encode 'Open t
Sum DRep
DRepAlwaysNoConfidence Word
3

instance DecCBOR DRep where
  decCBOR :: forall s. Decoder s DRep
decCBOR = Decode ('Closed 'Dense) DRep -> Decoder s DRep
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) DRep -> Decoder s DRep)
-> Decode ('Closed 'Dense) DRep -> Decoder s DRep
forall a b. (a -> b) -> a -> b
$
    Text -> (Word -> Decode 'Open DRep) -> Decode ('Closed 'Dense) DRep
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"DRep" ((Word -> Decode 'Open DRep) -> Decode ('Closed 'Dense) DRep)
-> (Word -> Decode 'Open DRep) -> Decode ('Closed 'Dense) DRep
forall a b. (a -> b) -> a -> b
$ \case
      Word
0 -> (KeyHash 'DRepRole -> DRep)
-> Decode 'Open (KeyHash 'DRepRole -> DRep)
forall t. t -> Decode 'Open t
SumD KeyHash 'DRepRole -> DRep
DRepKeyHash Decode 'Open (KeyHash 'DRepRole -> DRep)
-> Decode ('Closed Any) (KeyHash 'DRepRole) -> Decode 'Open DRep
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (KeyHash 'DRepRole)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
1 -> (ScriptHash -> DRep) -> Decode 'Open (ScriptHash -> DRep)
forall t. t -> Decode 'Open t
SumD ScriptHash -> DRep
DRepScriptHash Decode 'Open (ScriptHash -> DRep)
-> Decode ('Closed Any) ScriptHash -> Decode 'Open DRep
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ScriptHash
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
2 -> DRep -> Decode 'Open DRep
forall t. t -> Decode 'Open t
SumD DRep
DRepAlwaysAbstain
      Word
3 -> DRep -> Decode 'Open DRep
forall t. t -> Decode 'Open t
SumD DRep
DRepAlwaysNoConfidence
      Word
k -> Word -> Decode 'Open DRep
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k

instance DecShareCBOR DRep where
  type Share DRep = Interns (Credential 'DRepRole)
  decShareCBOR :: forall s. Share DRep -> Decoder s DRep
decShareCBOR Share DRep
cd = do
    DRep
dRep <- Decoder s DRep
forall s. Decoder s DRep
forall a s. DecCBOR a => Decoder s a
decCBOR
    DRep -> Decoder s DRep
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DRep -> Decoder s DRep) -> DRep -> Decoder s DRep
forall a b. (a -> b) -> a -> b
$!
      case DRep -> Maybe (Credential 'DRepRole)
dRepToCred DRep
dRep of
        Maybe (Credential 'DRepRole)
Nothing -> DRep
dRep
        Just Credential 'DRepRole
cred -> Credential 'DRepRole -> DRep
credToDRep (Credential 'DRepRole -> DRep) -> Credential 'DRepRole -> DRep
forall a b. (a -> b) -> a -> b
$ Interns (Credential 'DRepRole)
-> Credential 'DRepRole -> Credential 'DRepRole
forall k. Interns k -> k -> k
interns Share DRep
Interns (Credential 'DRepRole)
cd Credential 'DRepRole
cred

dRepToCred :: DRep -> Maybe (Credential 'DRepRole)
dRepToCred :: DRep -> Maybe (Credential 'DRepRole)
dRepToCred (DRepKeyHash KeyHash 'DRepRole
kh) = Credential 'DRepRole -> Maybe (Credential 'DRepRole)
forall a. a -> Maybe a
Just (Credential 'DRepRole -> Maybe (Credential 'DRepRole))
-> Credential 'DRepRole -> Maybe (Credential 'DRepRole)
forall a b. (a -> b) -> a -> b
$ KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'DRepRole
kh
dRepToCred (DRepScriptHash ScriptHash
sh) = Credential 'DRepRole -> Maybe (Credential 'DRepRole)
forall a. a -> Maybe a
Just (Credential 'DRepRole -> Maybe (Credential 'DRepRole))
-> Credential 'DRepRole -> Maybe (Credential 'DRepRole)
forall a b. (a -> b) -> a -> b
$ ScriptHash -> Credential 'DRepRole
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
sh
dRepToCred DRep
_ = Maybe (Credential 'DRepRole)
forall a. Maybe a
Nothing

credToDRep :: Credential 'DRepRole -> DRep
credToDRep :: Credential 'DRepRole -> DRep
credToDRep (KeyHashObj KeyHash 'DRepRole
kh) = KeyHash 'DRepRole -> DRep
DRepKeyHash KeyHash 'DRepRole
kh
credToDRep (ScriptHashObj ScriptHash
sh) = ScriptHash -> DRep
DRepScriptHash ScriptHash
sh

instance ToJSON DRep where
  toJSON :: DRep -> Value
toJSON = Text -> Value
String (Text -> Value) -> (DRep -> Text) -> DRep -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRep -> Text
dRepToText

instance ToJSONKey DRep where
  toJSONKey :: ToJSONKeyFunction DRep
toJSONKey = (DRep -> Text) -> ToJSONKeyFunction DRep
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText DRep -> Text
dRepToText

dRepToText :: DRep -> T.Text
dRepToText :: DRep -> Text
dRepToText = \case
  DRep
DRepAlwaysAbstain -> Text
"drep-alwaysAbstain"
  DRep
DRepAlwaysNoConfidence -> Text
"drep-alwaysNoConfidence"
  DRepCredential Credential 'DRepRole
cred -> Text
"drep-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Credential 'DRepRole -> Text
forall (kr :: KeyRole). Credential kr -> Text
credToText Credential 'DRepRole
cred

instance FromJSON DRep where
  parseJSON :: Value -> Parser DRep
parseJSON = String -> (Text -> Parser DRep) -> Value -> Parser DRep
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"DRep" Text -> Parser DRep
forall (f :: * -> *). MonadFail f => Text -> f DRep
parseDRep

instance FromJSONKey DRep where
  fromJSONKey :: FromJSONKeyFunction DRep
fromJSONKey = (Text -> Parser DRep) -> FromJSONKeyFunction DRep
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser Text -> Parser DRep
forall (f :: * -> *). MonadFail f => Text -> f DRep
parseDRep

parseDRep :: MonadFail f => T.Text -> f DRep
parseDRep :: forall (f :: * -> *). MonadFail f => Text -> f DRep
parseDRep Text
t = case (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') Text
t of
  (Text
"drep", Text
restWithDash)
    | Text
restWithDash Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"-alwaysAbstain" -> DRep -> f DRep
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRep
DRepAlwaysAbstain
    | Text
restWithDash Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"-alwaysNoConfidence" -> DRep -> f DRep
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRep
DRepAlwaysNoConfidence
    | (Text
"-", Text
rest) <- (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
restWithDash ->
        Credential 'DRepRole -> DRep
DRepCredential (Credential 'DRepRole -> DRep)
-> f (Credential 'DRepRole) -> f DRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f (Credential 'DRepRole)
forall (m :: * -> *) (kr :: KeyRole).
MonadFail m =>
Text -> m (Credential kr)
parseCredential Text
rest
  (Text, Text)
_ -> String -> f DRep
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f DRep) -> String -> f DRep
forall a b. (a -> b) -> a -> b
$ String
"Invalid DRep: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t

pattern DRepCredential :: Credential 'DRepRole -> DRep
pattern $mDRepCredential :: forall {r}.
DRep -> (Credential 'DRepRole -> r) -> ((# #) -> r) -> r
$bDRepCredential :: Credential 'DRepRole -> DRep
DRepCredential c <- (dRepToCred -> Just c)
  where
    DRepCredential Credential 'DRepRole
c = case Credential 'DRepRole
c of
      ScriptHashObj ScriptHash
sh -> ScriptHash -> DRep
DRepScriptHash ScriptHash
sh
      KeyHashObj KeyHash 'DRepRole
kh -> KeyHash 'DRepRole -> DRep
DRepKeyHash KeyHash 'DRepRole
kh

{-# COMPLETE DRepCredential, DRepAlwaysAbstain, DRepAlwaysNoConfidence :: DRep #-}

data DRepState = DRepState
  { DRepState -> EpochNo
drepExpiry :: !EpochNo
  , DRepState -> StrictMaybe Anchor
drepAnchor :: !(StrictMaybe Anchor)
  , DRepState -> Coin
drepDeposit :: !Coin
  , DRepState -> Set (Credential 'Staking)
drepDelegs :: !(Set (Credential 'Staking))
  }
  deriving (Int -> DRepState -> ShowS
[DRepState] -> ShowS
DRepState -> String
(Int -> DRepState -> ShowS)
-> (DRepState -> String)
-> ([DRepState] -> ShowS)
-> Show DRepState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DRepState -> ShowS
showsPrec :: Int -> DRepState -> ShowS
$cshow :: DRepState -> String
show :: DRepState -> String
$cshowList :: [DRepState] -> ShowS
showList :: [DRepState] -> ShowS
Show, DRepState -> DRepState -> Bool
(DRepState -> DRepState -> Bool)
-> (DRepState -> DRepState -> Bool) -> Eq DRepState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DRepState -> DRepState -> Bool
== :: DRepState -> DRepState -> Bool
$c/= :: DRepState -> DRepState -> Bool
/= :: DRepState -> DRepState -> Bool
Eq, Eq DRepState
Eq DRepState =>
(DRepState -> DRepState -> Ordering)
-> (DRepState -> DRepState -> Bool)
-> (DRepState -> DRepState -> Bool)
-> (DRepState -> DRepState -> Bool)
-> (DRepState -> DRepState -> Bool)
-> (DRepState -> DRepState -> DRepState)
-> (DRepState -> DRepState -> DRepState)
-> Ord DRepState
DRepState -> DRepState -> Bool
DRepState -> DRepState -> Ordering
DRepState -> DRepState -> DRepState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DRepState -> DRepState -> Ordering
compare :: DRepState -> DRepState -> Ordering
$c< :: DRepState -> DRepState -> Bool
< :: DRepState -> DRepState -> Bool
$c<= :: DRepState -> DRepState -> Bool
<= :: DRepState -> DRepState -> Bool
$c> :: DRepState -> DRepState -> Bool
> :: DRepState -> DRepState -> Bool
$c>= :: DRepState -> DRepState -> Bool
>= :: DRepState -> DRepState -> Bool
$cmax :: DRepState -> DRepState -> DRepState
max :: DRepState -> DRepState -> DRepState
$cmin :: DRepState -> DRepState -> DRepState
min :: DRepState -> DRepState -> DRepState
Ord, (forall x. DRepState -> Rep DRepState x)
-> (forall x. Rep DRepState x -> DRepState) -> Generic DRepState
forall x. Rep DRepState x -> DRepState
forall x. DRepState -> Rep DRepState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DRepState -> Rep DRepState x
from :: forall x. DRepState -> Rep DRepState x
$cto :: forall x. Rep DRepState x -> DRepState
to :: forall x. Rep DRepState x -> DRepState
Generic)

instance NoThunks DRepState

instance NFData DRepState

instance DecCBOR DRepState where
  decCBOR :: forall s. Decoder s DRepState
decCBOR = Decoder s DRepState
forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR

instance DecShareCBOR DRepState where
  type Share DRepState = Interns (Credential 'Staking)
  getShare :: DRepState -> Share DRepState
getShare = Set (Credential 'Staking) -> Interns (Credential 'Staking)
forall k. Ord k => Set k -> Interns k
internsFromSet (Set (Credential 'Staking) -> Interns (Credential 'Staking))
-> (DRepState -> Set (Credential 'Staking))
-> DRepState
-> Interns (Credential 'Staking)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRepState -> Set (Credential 'Staking)
drepDelegs
  decShareCBOR :: forall s. Share DRepState -> Decoder s DRepState
decShareCBOR Share DRepState
is = do
    Decode ('Closed 'Dense) DRepState -> Decoder s DRepState
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) DRepState -> Decoder s DRepState)
-> Decode ('Closed 'Dense) DRepState -> Decoder s DRepState
forall a b. (a -> b) -> a -> b
$
      (EpochNo
 -> StrictMaybe Anchor
 -> Coin
 -> Set (Credential 'Staking)
 -> DRepState)
-> Decode
     ('Closed 'Dense)
     (EpochNo
      -> StrictMaybe Anchor
      -> Coin
      -> Set (Credential 'Staking)
      -> DRepState)
forall t. t -> Decode ('Closed 'Dense) t
RecD EpochNo
-> StrictMaybe Anchor
-> Coin
-> Set (Credential 'Staking)
-> DRepState
DRepState
        Decode
  ('Closed 'Dense)
  (EpochNo
   -> StrictMaybe Anchor
   -> Coin
   -> Set (Credential 'Staking)
   -> DRepState)
-> Decode ('Closed Any) EpochNo
-> Decode
     ('Closed 'Dense)
     (StrictMaybe Anchor
      -> Coin -> Set (Credential 'Staking) -> DRepState)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) EpochNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (StrictMaybe Anchor
   -> Coin -> Set (Credential 'Staking) -> DRepState)
-> Decode ('Closed Any) (StrictMaybe Anchor)
-> Decode
     ('Closed 'Dense) (Coin -> Set (Credential 'Staking) -> DRepState)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (StrictMaybe Anchor)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense) (Coin -> Set (Credential 'Staking) -> DRepState)
-> Decode ('Closed Any) Coin
-> Decode ('Closed 'Dense) (Set (Credential 'Staking) -> DRepState)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode ('Closed 'Dense) (Set (Credential 'Staking) -> DRepState)
-> Decode ('Closed 'Dense) (Set (Credential 'Staking))
-> Decode ('Closed 'Dense) DRepState
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (Set (Credential 'Staking)))
-> Decode ('Closed 'Dense) (Set (Credential 'Staking))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Share (Set (Credential 'Staking))
-> Decoder s (Set (Credential 'Staking))
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (Set (Credential 'Staking))
-> Decoder s (Set (Credential 'Staking))
decShareCBOR Share (Set (Credential 'Staking))
Share DRepState
is)

instance EncCBOR DRepState where
  encCBOR :: DRepState -> Encoding
encCBOR DRepState {Set (Credential 'Staking)
StrictMaybe Anchor
EpochNo
Coin
drepExpiry :: DRepState -> EpochNo
drepAnchor :: DRepState -> StrictMaybe Anchor
drepDeposit :: DRepState -> Coin
drepDelegs :: DRepState -> Set (Credential 'Staking)
drepExpiry :: EpochNo
drepAnchor :: StrictMaybe Anchor
drepDeposit :: Coin
drepDelegs :: Set (Credential 'Staking)
..} =
    Encode ('Closed 'Dense) DRepState -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) DRepState -> Encoding)
-> Encode ('Closed 'Dense) DRepState -> Encoding
forall a b. (a -> b) -> a -> b
$
      (EpochNo
 -> StrictMaybe Anchor
 -> Coin
 -> Set (Credential 'Staking)
 -> DRepState)
-> Encode
     ('Closed 'Dense)
     (EpochNo
      -> StrictMaybe Anchor
      -> Coin
      -> Set (Credential 'Staking)
      -> DRepState)
forall t. t -> Encode ('Closed 'Dense) t
Rec EpochNo
-> StrictMaybe Anchor
-> Coin
-> Set (Credential 'Staking)
-> DRepState
DRepState
        Encode
  ('Closed 'Dense)
  (EpochNo
   -> StrictMaybe Anchor
   -> Coin
   -> Set (Credential 'Staking)
   -> DRepState)
-> Encode ('Closed 'Dense) EpochNo
-> Encode
     ('Closed 'Dense)
     (StrictMaybe Anchor
      -> Coin -> Set (Credential 'Staking) -> DRepState)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> EpochNo -> Encode ('Closed 'Dense) EpochNo
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EpochNo
drepExpiry
        Encode
  ('Closed 'Dense)
  (StrictMaybe Anchor
   -> Coin -> Set (Credential 'Staking) -> DRepState)
-> Encode ('Closed 'Dense) (StrictMaybe Anchor)
-> Encode
     ('Closed 'Dense) (Coin -> Set (Credential 'Staking) -> DRepState)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictMaybe Anchor -> Encode ('Closed 'Dense) (StrictMaybe Anchor)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe Anchor
drepAnchor
        Encode
  ('Closed 'Dense) (Coin -> Set (Credential 'Staking) -> DRepState)
-> Encode ('Closed 'Dense) Coin
-> Encode ('Closed 'Dense) (Set (Credential 'Staking) -> DRepState)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
drepDeposit
        Encode ('Closed 'Dense) (Set (Credential 'Staking) -> DRepState)
-> Encode ('Closed 'Dense) (Set (Credential 'Staking))
-> Encode ('Closed 'Dense) DRepState
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Set (Credential 'Staking)
-> Encode ('Closed 'Dense) (Set (Credential 'Staking))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (Credential 'Staking)
drepDelegs

instance ToJSON DRepState where
  toJSON :: DRepState -> Value
toJSON x :: DRepState
x@(DRepState EpochNo
_ StrictMaybe Anchor
_ Coin
_ Set (Credential 'Staking)
_) =
    let DRepState {Set (Credential 'Staking)
StrictMaybe Anchor
EpochNo
Coin
drepExpiry :: DRepState -> EpochNo
drepAnchor :: DRepState -> StrictMaybe Anchor
drepDeposit :: DRepState -> Coin
drepDelegs :: DRepState -> Set (Credential 'Staking)
drepExpiry :: EpochNo
drepAnchor :: StrictMaybe Anchor
drepDeposit :: Coin
drepDelegs :: Set (Credential 'Staking)
..} = DRepState
x
     in Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$
          [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            [ Key
"expiry" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochNo -> Value
forall a. ToJSON a => a -> Value
toJSON EpochNo
drepExpiry
            , Key
"deposit" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin -> Value
forall a. ToJSON a => a -> Value
toJSON Coin
drepDeposit
            -- Since the corresponding `FromJSON` instance ignores the `delegators` field,
            -- we omit it from the `ToJSON` instance, ensuring that round-tripping behaves as expected.
            ]
              [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"anchor" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Anchor -> Value
forall a. ToJSON a => a -> Value
toJSON Anchor
anchor | SJust Anchor
anchor <- [StrictMaybe Anchor
drepAnchor]]

instance FromJSON DRepState where
  parseJSON :: Value -> Parser DRepState
parseJSON = String -> (Object -> Parser DRepState) -> Value -> Parser DRepState
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DRepState" ((Object -> Parser DRepState) -> Value -> Parser DRepState)
-> (Object -> Parser DRepState) -> Value -> Parser DRepState
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    EpochNo
-> StrictMaybe Anchor
-> Coin
-> Set (Credential 'Staking)
-> DRepState
DRepState
      (EpochNo
 -> StrictMaybe Anchor
 -> Coin
 -> Set (Credential 'Staking)
 -> DRepState)
-> Parser EpochNo
-> Parser
     (StrictMaybe Anchor
      -> Coin -> Set (Credential 'Staking) -> DRepState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser EpochNo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expiry"
      Parser
  (StrictMaybe Anchor
   -> Coin -> Set (Credential 'Staking) -> DRepState)
-> Parser (StrictMaybe Anchor)
-> Parser (Coin -> Set (Credential 'Staking) -> DRepState)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (StrictMaybe Anchor))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"anchor" Parser (Maybe (StrictMaybe Anchor))
-> StrictMaybe Anchor -> Parser (StrictMaybe Anchor)
forall a. Parser (Maybe a) -> a -> Parser a
.!= StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
      Parser (Coin -> Set (Credential 'Staking) -> DRepState)
-> Parser Coin -> Parser (Set (Credential 'Staking) -> DRepState)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deposit"
      -- Construction of DRep state with delegations is intentionally prohibited, since
      -- there is a requirement to retain the invariant of delegations in the UMap
      Parser (Set (Credential 'Staking) -> DRepState)
-> Parser (Set (Credential 'Staking)) -> Parser DRepState
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set (Credential 'Staking) -> Parser (Set (Credential 'Staking))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (Credential 'Staking)
forall a. Monoid a => a
mempty

drepExpiryL :: Lens' DRepState EpochNo
drepExpiryL :: Lens' DRepState EpochNo
drepExpiryL = (DRepState -> EpochNo)
-> (DRepState -> EpochNo -> DRepState) -> Lens' DRepState EpochNo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DRepState -> EpochNo
drepExpiry (\DRepState
x EpochNo
y -> DRepState
x {drepExpiry = y})

drepAnchorL :: Lens' DRepState (StrictMaybe Anchor)
drepAnchorL :: Lens' DRepState (StrictMaybe Anchor)
drepAnchorL = (DRepState -> StrictMaybe Anchor)
-> (DRepState -> StrictMaybe Anchor -> DRepState)
-> Lens' DRepState (StrictMaybe Anchor)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DRepState -> StrictMaybe Anchor
drepAnchor (\DRepState
x StrictMaybe Anchor
y -> DRepState
x {drepAnchor = y})

drepDepositL :: Lens' DRepState Coin
drepDepositL :: Lens' DRepState Coin
drepDepositL = (DRepState -> Coin)
-> (DRepState -> Coin -> DRepState) -> Lens' DRepState Coin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DRepState -> Coin
drepDeposit (\DRepState
x Coin
y -> DRepState
x {drepDeposit = y})

drepDelegsL :: Lens' DRepState (Set (Credential 'Staking))
drepDelegsL :: Lens' DRepState (Set (Credential 'Staking))
drepDelegsL = (DRepState -> Set (Credential 'Staking))
-> (DRepState -> Set (Credential 'Staking) -> DRepState)
-> Lens' DRepState (Set (Credential 'Staking))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DRepState -> Set (Credential 'Staking)
drepDelegs (\DRepState
x Set (Credential 'Staking)
y -> DRepState
x {drepDelegs = y})