{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

module Cardano.Ledger.State.Schema where

import Cardano.Ledger.Babbage.TxOut (BabbageTxOut)
import Cardano.Ledger.BaseTypes (TxIx (..))
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Core (PParams)
import qualified Cardano.Ledger.Credential as Credential
import qualified Cardano.Ledger.Keys as Keys
import qualified Cardano.Ledger.PoolParams as Shelley
import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
import qualified Cardano.Ledger.Shelley.PoolRank as Shelley
import Cardano.Ledger.State.Orphans (Enc, SnapShotType (..))
import Cardano.Ledger.State.UTxO
import qualified Cardano.Ledger.TxIn as TxIn
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Database.Persist.Sqlite
import Database.Persist.TH

type FGenDelegs = (Enc (Map.Map Shelley.FutureGenDeleg Keys.GenDelegPair))

type CredentialWitness = Credential.Credential 'Keys.Witness

type KeyHashWitness = Keys.KeyHash 'Keys.Witness

data DRepDelegation
  = DRepDelegationNone
  | DRepDelegationCredential
  | DRepDelegationAlwaysAbstain
  | DRepDelegationAlwaysNoConfidence
  deriving (DRepDelegation -> DRepDelegation -> Bool
(DRepDelegation -> DRepDelegation -> Bool)
-> (DRepDelegation -> DRepDelegation -> Bool) -> Eq DRepDelegation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DRepDelegation -> DRepDelegation -> Bool
== :: DRepDelegation -> DRepDelegation -> Bool
$c/= :: DRepDelegation -> DRepDelegation -> Bool
/= :: DRepDelegation -> DRepDelegation -> Bool
Eq, Int -> DRepDelegation -> ShowS
[DRepDelegation] -> ShowS
DRepDelegation -> String
(Int -> DRepDelegation -> ShowS)
-> (DRepDelegation -> String)
-> ([DRepDelegation] -> ShowS)
-> Show DRepDelegation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DRepDelegation -> ShowS
showsPrec :: Int -> DRepDelegation -> ShowS
$cshow :: DRepDelegation -> String
show :: DRepDelegation -> String
$cshowList :: [DRepDelegation] -> ShowS
showList :: [DRepDelegation] -> ShowS
Show, Int -> DRepDelegation
DRepDelegation -> Int
DRepDelegation -> [DRepDelegation]
DRepDelegation -> DRepDelegation
DRepDelegation -> DRepDelegation -> [DRepDelegation]
DRepDelegation
-> DRepDelegation -> DRepDelegation -> [DRepDelegation]
(DRepDelegation -> DRepDelegation)
-> (DRepDelegation -> DRepDelegation)
-> (Int -> DRepDelegation)
-> (DRepDelegation -> Int)
-> (DRepDelegation -> [DRepDelegation])
-> (DRepDelegation -> DRepDelegation -> [DRepDelegation])
-> (DRepDelegation -> DRepDelegation -> [DRepDelegation])
-> (DRepDelegation
    -> DRepDelegation -> DRepDelegation -> [DRepDelegation])
-> Enum DRepDelegation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DRepDelegation -> DRepDelegation
succ :: DRepDelegation -> DRepDelegation
$cpred :: DRepDelegation -> DRepDelegation
pred :: DRepDelegation -> DRepDelegation
$ctoEnum :: Int -> DRepDelegation
toEnum :: Int -> DRepDelegation
$cfromEnum :: DRepDelegation -> Int
fromEnum :: DRepDelegation -> Int
$cenumFrom :: DRepDelegation -> [DRepDelegation]
enumFrom :: DRepDelegation -> [DRepDelegation]
$cenumFromThen :: DRepDelegation -> DRepDelegation -> [DRepDelegation]
enumFromThen :: DRepDelegation -> DRepDelegation -> [DRepDelegation]
$cenumFromTo :: DRepDelegation -> DRepDelegation -> [DRepDelegation]
enumFromTo :: DRepDelegation -> DRepDelegation -> [DRepDelegation]
$cenumFromThenTo :: DRepDelegation
-> DRepDelegation -> DRepDelegation -> [DRepDelegation]
enumFromThenTo :: DRepDelegation
-> DRepDelegation -> DRepDelegation -> [DRepDelegation]
Enum, DRepDelegation
DRepDelegation -> DRepDelegation -> Bounded DRepDelegation
forall a. a -> a -> Bounded a
$cminBound :: DRepDelegation
minBound :: DRepDelegation
$cmaxBound :: DRepDelegation
maxBound :: DRepDelegation
Bounded)

instance PersistField DRepDelegation where
  toPersistValue :: DRepDelegation -> PersistValue
toPersistValue = \case
    DRepDelegation
DRepDelegationNone -> Int64 -> PersistValue
PersistInt64 Int64
0
    DRepDelegation
DRepDelegationCredential -> Int64 -> PersistValue
PersistInt64 Int64
1
    DRepDelegation
DRepDelegationAlwaysAbstain -> Int64 -> PersistValue
PersistInt64 Int64
2
    DRepDelegation
DRepDelegationAlwaysNoConfidence -> Int64 -> PersistValue
PersistInt64 Int64
3
  fromPersistValue :: PersistValue -> Either Text DRepDelegation
fromPersistValue = \case
    PersistInt64 Int64
0 -> DRepDelegation -> Either Text DRepDelegation
forall a b. b -> Either a b
Right DRepDelegation
DRepDelegationNone
    PersistInt64 Int64
1 -> DRepDelegation -> Either Text DRepDelegation
forall a b. b -> Either a b
Right DRepDelegation
DRepDelegationCredential
    PersistInt64 Int64
2 -> DRepDelegation -> Either Text DRepDelegation
forall a b. b -> Either a b
Right DRepDelegation
DRepDelegationAlwaysAbstain
    PersistInt64 Int64
3 -> DRepDelegation -> Either Text DRepDelegation
forall a b. b -> Either a b
Right DRepDelegation
DRepDelegationAlwaysNoConfidence
    PersistValue
persistValue -> Text -> Either Text DRepDelegation
forall a b. a -> Either a b
Left (Text -> Either Text DRepDelegation)
-> Text -> Either Text DRepDelegation
forall a b. (a -> b) -> a -> b
$ Text
"DRepDelegation - unrecognized persist value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
persistValue)

instance PersistFieldSql DRepDelegation where
  sqlType :: Proxy DRepDelegation -> SqlType
sqlType Proxy DRepDelegation
_ = SqlType
SqlInt32

share
  [mkPersist sqlSettings, mkMigrate "migrateAll"]
  [persistLowerCase|
EpochState
  treasury Coin
  reserves Coin
  prevPp (PParams CurrentEra)
  pp (PParams CurrentEra)
  nonMyopic Shelley.NonMyopic
  snapShotsFee Coin

SnapShot
  type SnapShotType
  epochStateId EpochStateId
  -- UniqueSnapShot type epochStateId
SnapShotStake
  snapShotId SnapShotId
  credentialId CredentialId
  coin (CompactForm Coin)
  UniqueSnapShotStake snapShotId credentialId
SnapShotDelegation
  snapShotId SnapShotId
  credentialId CredentialId
  keyHash KeyHashId
  UniqueSnapShotDelegation snapShotId credentialId
SnapShotPool
  snapShotId SnapShotId
  keyHashId KeyHashId
  params Shelley.PoolParams
  UniqueSnapShotPool snapShotId keyHashId

LedgerState
  utxoId UtxoStateId
  dstateId DStateId
  epochStateId EpochStateId
  pstateBin (Shelley.PState CurrentEra)
  UniqueLedgerStateUtxoId utxoId
  UniqueLedgerStateDStateId dstateId
  UniqueLedgerStateEpochStateId epochStateId
UtxoState
  deposited Coin
  fees Coin
  govState (ConwayGovState CurrentEra)
  donation Coin
DState
  fGenDelegs FGenDelegs
  genDelegs Keys.GenDelegs
  irDeltaReserves DeltaCoin
  irDeltaTreasury DeltaCoin

Credential
  witness CredentialWitness
  UniqueCredential witness
KeyHash
  witness KeyHashWitness
  UniqueKeyHash witness
Tx
  inIx TxIx
  inId TxIn.TxId
  out (BabbageTxOut CurrentEra)
  UniqueTx inIx inId
Txs
  inIx TxIx
  inId TxIn.TxId
  out (BabbageTxOut CurrentEra)
  stakeCredential CredentialId Maybe
  UniqueTxs inIx inId
UtxoEntry
  txId TxId
  txsId TxsId
  stateId UtxoStateId
Account
  dstateId DStateId
  credentialId CredentialId
  ptr Credential.Ptr Maybe
  balance (CompactForm Coin)
  deposit (CompactForm Coin)
  keyHashStakePoolId KeyHashId Maybe
  drep DRepDelegation
  credentialDRepId CredentialId Maybe
  UniqueAccount dstateId credentialId
IRReserves
  dstateId DStateId
  credentialId CredentialId
  coin Coin
  UniqueIRReserves dstateId credentialId
IRTreasury
  dstateId DStateId
  credentialId CredentialId
  coin Coin
  UniqueIRTreasury dstateId credentialId
|]