{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Cardano.Ledger.State.Orphans where

import Cardano.Crypto.Hash.Class
import Cardano.Ledger.Alonzo.TxBody
import Cardano.Ledger.Babbage.TxBody
import Cardano.Ledger.BaseTypes (TxIx (..))
import Cardano.Ledger.Binary
import Cardano.Ledger.Coin
import Cardano.Ledger.Core
import Cardano.Ledger.Credential
import Cardano.Ledger.Keys
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.SafeHash
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.PoolRank
import Cardano.Ledger.State.UTxO
import Cardano.Ledger.TxIn
import Data.ByteString.Short
import qualified Data.Text as T
import Data.Typeable
import Database.Persist
import Database.Persist.Sqlite

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

instance PersistField SnapShotType where
  toPersistValue :: SnapShotType -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
  fromPersistValue :: PersistValue -> Either Text SnapShotType
fromPersistValue (PersistInt64 Int64
i64) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i64
  fromPersistValue PersistValue
_ = forall a b. a -> Either a b
Left Text
"Unexpected type"

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

instance PersistField ShortByteString where
  toPersistValue :: ShortByteString -> PersistValue
toPersistValue = ByteString -> PersistValue
PersistByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort
  fromPersistValue :: PersistValue -> Either Text ShortByteString
fromPersistValue (PersistByteString ByteString
bs) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ByteString -> ShortByteString
toShort ByteString
bs
  fromPersistValue PersistValue
_ = forall a b. a -> Either a b
Left Text
"Unexpected type"

instance PersistFieldSql ShortByteString where
  sqlType :: Proxy ShortByteString -> SqlType
sqlType Proxy ShortByteString
_ = SqlType
SqlBlob

instance PersistField (TxId C) where
  toPersistValue :: TxId C -> PersistValue
toPersistValue = ByteString -> PersistValue
PersistByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. Hash h a -> ByteString
hashToBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c i. SafeHash c i -> Hash (HASH c) i
extractHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. TxId c -> SafeHash c EraIndependentTxBody
unTxId
  fromPersistValue :: PersistValue -> Either Text (TxId C)
fromPersistValue (PersistByteString ByteString
bs) =
    case forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs of
      Maybe (Hash Blake2b_256 EraIndependentTxBody)
Nothing -> forall a b. a -> Either a b
Left Text
"Invalid number of bytes for the hash"
      Just Hash Blake2b_256 EraIndependentTxBody
h -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall c. SafeHash c EraIndependentTxBody -> TxId c
TxId forall a b. (a -> b) -> a -> b
$ forall c index. Hash (HASH c) index -> SafeHash c index
unsafeMakeSafeHash Hash Blake2b_256 EraIndependentTxBody
h
  fromPersistValue PersistValue
_ = forall a b. a -> Either a b
Left Text
"Unexpected type"

instance PersistFieldSql (TxId C) where
  sqlType :: Proxy (TxId C) -> SqlType
sqlType Proxy (TxId C)
_ = SqlType
SqlBlob

deriving instance PersistField (CompactForm Coin)

deriving instance PersistFieldSql (CompactForm Coin)

deriving instance PersistField TxIx

deriving instance PersistFieldSql TxIx

instance PersistField Coin where
  toPersistValue :: Coin -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Integer
unCoin
  fromPersistValue :: PersistValue -> Either Text Coin
fromPersistValue (PersistInt64 Int64
i64) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i64
  fromPersistValue PersistValue
_ = forall a b. a -> Either a b
Left Text
"Unexpected type"

instance PersistFieldSql Coin where
  sqlType :: Proxy Coin -> SqlType
sqlType Proxy Coin
_ = SqlType
SqlInt64

instance PersistField DeltaCoin where
  toPersistValue :: DeltaCoin -> PersistValue
toPersistValue (DeltaCoin Integer
dc) = Int64 -> PersistValue
PersistInt64 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
dc
  fromPersistValue :: PersistValue -> Either Text DeltaCoin
fromPersistValue (PersistInt64 Int64
i64) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> DeltaCoin
DeltaCoin forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i64
  fromPersistValue PersistValue
_ = forall a b. a -> Either a b
Left Text
"Unexpected type"

instance PersistFieldSql DeltaCoin where
  sqlType :: Proxy DeltaCoin -> SqlType
sqlType Proxy DeltaCoin
_ = SqlType
SqlInt64

newtype Enc a = Enc {forall a. Enc a -> a
unEnc :: a}

instance (EncCBOR a, DecCBOR a) => PersistField (Enc a) where
  toPersistValue :: Enc a -> PersistValue
toPersistValue = ByteString -> PersistValue
PersistByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => Version -> a -> ByteString
serialize' (forall era. Era era => Version
eraProtVerHigh @CurrentEra) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enc a -> a
unEnc
  fromPersistValue :: PersistValue -> Either Text (Enc a)
fromPersistValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Enc a
Enc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. DecCBOR b => PersistValue -> Either Text b
decodePersistValue

instance (EncCBOR a, DecCBOR a) => PersistFieldSql (Enc a) where
  sqlType :: Proxy (Enc a) -> SqlType
sqlType Proxy (Enc a)
_ = SqlType
SqlBlob

decodePersistValue :: DecCBOR b => PersistValue -> Either T.Text b
decodePersistValue :: forall b. DecCBOR b => PersistValue -> Either Text b
decodePersistValue (PersistByteString ByteString
bs) =
  case forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' (forall era. Era era => Version
eraProtVerHigh @CurrentEra) ByteString
bs of
    Left DecoderError
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Could not decode: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show DecoderError
err)
    Right b
v -> forall a b. b -> Either a b
Right b
v
decodePersistValue PersistValue
_ = forall a b. a -> Either a b
Left Text
"Unexpected type"

deriving via Enc (KeyHash r C) instance Typeable r => PersistField (KeyHash r C)

deriving via Enc (KeyHash r C) instance Typeable r => PersistFieldSql (KeyHash r C)

deriving via Enc (Credential r C) instance Typeable r => PersistField (Credential r C)

deriving via Enc (Credential r C) instance Typeable r => PersistFieldSql (Credential r C)

deriving via Enc Ptr instance PersistField Ptr

deriving via Enc Ptr instance PersistFieldSql Ptr

deriving via Enc (ShelleyGovState CurrentEra) instance PersistField (ShelleyGovState CurrentEra)

deriving via Enc (ShelleyGovState CurrentEra) instance PersistFieldSql (ShelleyGovState CurrentEra)

deriving via Enc (AlonzoTxOut CurrentEra) instance PersistField (AlonzoTxOut CurrentEra)

deriving via Enc (AlonzoTxOut CurrentEra) instance PersistFieldSql (AlonzoTxOut CurrentEra)

deriving via Enc (BabbageTxOut CurrentEra) instance PersistField (BabbageTxOut CurrentEra)

deriving via Enc (BabbageTxOut CurrentEra) instance PersistFieldSql (BabbageTxOut CurrentEra)

instance DecCBOR (DState CurrentEra) where
  decCBOR :: forall s. Decoder s (DState CurrentEra)
decCBOR = forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR

deriving via Enc (DState CurrentEra) instance PersistField (DState CurrentEra)

deriving via Enc (DState CurrentEra) instance PersistFieldSql (DState CurrentEra)

deriving via Enc (PState CurrentEra) instance PersistField (PState CurrentEra)

deriving via Enc (PState CurrentEra) instance PersistFieldSql (PState CurrentEra)

deriving via Enc (GenDelegs C) instance PersistField (GenDelegs C)

deriving via Enc (GenDelegs C) instance PersistFieldSql (GenDelegs C)

deriving via Enc (PoolParams C) instance PersistField (PoolParams C)

deriving via Enc (PoolParams C) instance PersistFieldSql (PoolParams C)

instance DecCBOR (NonMyopic C) where
  decCBOR :: forall s. Decoder s (NonMyopic C)
decCBOR = forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR

deriving via Enc (NonMyopic C) instance PersistField (NonMyopic C)

deriving via Enc (NonMyopic C) instance PersistFieldSql (NonMyopic C)

deriving via Enc (PParams CurrentEra) instance PersistField (PParams CurrentEra)

deriving via Enc (PParams CurrentEra) instance PersistFieldSql (PParams CurrentEra)