{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveLift                 #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE TemplateHaskell            #-}

module Wallet.Rollup.Types where

import Cardano.Api qualified as C
import Control.Lens (makeLenses, makeLensesFor)
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
import Data.Map (Map)
import GHC.Generics
import Ledger (CardanoTx, PaymentPubKeyHash (PaymentPubKeyHash), TxOut, cardanoAddressCredential, txOutAddress)
import Plutus.V1.Ledger.Api (Credential (PubKeyCredential, ScriptCredential), ValidatorHash, Value)

data SequenceId =
    SequenceId
        { SequenceId -> Int
slotIndex :: Int
        , SequenceId -> Int
txIndex   :: Int
        }
    deriving (SequenceId -> SequenceId -> Bool
(SequenceId -> SequenceId -> Bool)
-> (SequenceId -> SequenceId -> Bool) -> Eq SequenceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SequenceId -> SequenceId -> Bool
$c/= :: SequenceId -> SequenceId -> Bool
== :: SequenceId -> SequenceId -> Bool
$c== :: SequenceId -> SequenceId -> Bool
Eq, Eq SequenceId
Eq SequenceId
-> (SequenceId -> SequenceId -> Ordering)
-> (SequenceId -> SequenceId -> Bool)
-> (SequenceId -> SequenceId -> Bool)
-> (SequenceId -> SequenceId -> Bool)
-> (SequenceId -> SequenceId -> Bool)
-> (SequenceId -> SequenceId -> SequenceId)
-> (SequenceId -> SequenceId -> SequenceId)
-> Ord SequenceId
SequenceId -> SequenceId -> Bool
SequenceId -> SequenceId -> Ordering
SequenceId -> SequenceId -> SequenceId
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
min :: SequenceId -> SequenceId -> SequenceId
$cmin :: SequenceId -> SequenceId -> SequenceId
max :: SequenceId -> SequenceId -> SequenceId
$cmax :: SequenceId -> SequenceId -> SequenceId
>= :: SequenceId -> SequenceId -> Bool
$c>= :: SequenceId -> SequenceId -> Bool
> :: SequenceId -> SequenceId -> Bool
$c> :: SequenceId -> SequenceId -> Bool
<= :: SequenceId -> SequenceId -> Bool
$c<= :: SequenceId -> SequenceId -> Bool
< :: SequenceId -> SequenceId -> Bool
$c< :: SequenceId -> SequenceId -> Bool
compare :: SequenceId -> SequenceId -> Ordering
$ccompare :: SequenceId -> SequenceId -> Ordering
$cp1Ord :: Eq SequenceId
Ord, Int -> SequenceId -> ShowS
[SequenceId] -> ShowS
SequenceId -> String
(Int -> SequenceId -> ShowS)
-> (SequenceId -> String)
-> ([SequenceId] -> ShowS)
-> Show SequenceId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SequenceId] -> ShowS
$cshowList :: [SequenceId] -> ShowS
show :: SequenceId -> String
$cshow :: SequenceId -> String
showsPrec :: Int -> SequenceId -> ShowS
$cshowsPrec :: Int -> SequenceId -> ShowS
Show, (forall x. SequenceId -> Rep SequenceId x)
-> (forall x. Rep SequenceId x -> SequenceId) -> Generic SequenceId
forall x. Rep SequenceId x -> SequenceId
forall x. SequenceId -> Rep SequenceId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SequenceId x -> SequenceId
$cfrom :: forall x. SequenceId -> Rep SequenceId x
Generic)
    deriving anyclass (Value -> Parser [SequenceId]
Value -> Parser SequenceId
(Value -> Parser SequenceId)
-> (Value -> Parser [SequenceId]) -> FromJSON SequenceId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SequenceId]
$cparseJSONList :: Value -> Parser [SequenceId]
parseJSON :: Value -> Parser SequenceId
$cparseJSON :: Value -> Parser SequenceId
FromJSON, [SequenceId] -> Encoding
[SequenceId] -> Value
SequenceId -> Encoding
SequenceId -> Value
(SequenceId -> Value)
-> (SequenceId -> Encoding)
-> ([SequenceId] -> Value)
-> ([SequenceId] -> Encoding)
-> ToJSON SequenceId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SequenceId] -> Encoding
$ctoEncodingList :: [SequenceId] -> Encoding
toJSONList :: [SequenceId] -> Value
$ctoJSONList :: [SequenceId] -> Value
toEncoding :: SequenceId -> Encoding
$ctoEncoding :: SequenceId -> Encoding
toJSON :: SequenceId -> Value
$ctoJSON :: SequenceId -> Value
ToJSON)

makeLensesFor
     [ ("slotIndex", "slotIndexL")
     , ("txIndex", "txIndexL")
     ]
    ''SequenceId

data DereferencedInput
    = DereferencedInput
          { DereferencedInput -> TxIn
originalInput :: C.TxIn
          , DereferencedInput -> TxOut
refersTo      :: TxOut
          }
    | InputNotFound C.TxIn
    deriving (DereferencedInput -> DereferencedInput -> Bool
(DereferencedInput -> DereferencedInput -> Bool)
-> (DereferencedInput -> DereferencedInput -> Bool)
-> Eq DereferencedInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DereferencedInput -> DereferencedInput -> Bool
$c/= :: DereferencedInput -> DereferencedInput -> Bool
== :: DereferencedInput -> DereferencedInput -> Bool
$c== :: DereferencedInput -> DereferencedInput -> Bool
Eq, Int -> DereferencedInput -> ShowS
[DereferencedInput] -> ShowS
DereferencedInput -> String
(Int -> DereferencedInput -> ShowS)
-> (DereferencedInput -> String)
-> ([DereferencedInput] -> ShowS)
-> Show DereferencedInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DereferencedInput] -> ShowS
$cshowList :: [DereferencedInput] -> ShowS
show :: DereferencedInput -> String
$cshow :: DereferencedInput -> String
showsPrec :: Int -> DereferencedInput -> ShowS
$cshowsPrec :: Int -> DereferencedInput -> ShowS
Show, (forall x. DereferencedInput -> Rep DereferencedInput x)
-> (forall x. Rep DereferencedInput x -> DereferencedInput)
-> Generic DereferencedInput
forall x. Rep DereferencedInput x -> DereferencedInput
forall x. DereferencedInput -> Rep DereferencedInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DereferencedInput x -> DereferencedInput
$cfrom :: forall x. DereferencedInput -> Rep DereferencedInput x
Generic)
    deriving anyclass (Value -> Parser [DereferencedInput]
Value -> Parser DereferencedInput
(Value -> Parser DereferencedInput)
-> (Value -> Parser [DereferencedInput])
-> FromJSON DereferencedInput
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [DereferencedInput]
$cparseJSONList :: Value -> Parser [DereferencedInput]
parseJSON :: Value -> Parser DereferencedInput
$cparseJSON :: Value -> Parser DereferencedInput
FromJSON, [DereferencedInput] -> Encoding
[DereferencedInput] -> Value
DereferencedInput -> Encoding
DereferencedInput -> Value
(DereferencedInput -> Value)
-> (DereferencedInput -> Encoding)
-> ([DereferencedInput] -> Value)
-> ([DereferencedInput] -> Encoding)
-> ToJSON DereferencedInput
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [DereferencedInput] -> Encoding
$ctoEncodingList :: [DereferencedInput] -> Encoding
toJSONList :: [DereferencedInput] -> Value
$ctoJSONList :: [DereferencedInput] -> Value
toEncoding :: DereferencedInput -> Encoding
$ctoEncoding :: DereferencedInput -> Encoding
toJSON :: DereferencedInput -> Value
$ctoJSON :: DereferencedInput -> Value
ToJSON)

isFound :: DereferencedInput -> Bool
isFound :: DereferencedInput -> Bool
isFound DereferencedInput {} = Bool
True
isFound (InputNotFound TxIn
_)    = Bool
False

data BeneficialOwner
    = OwnedByPaymentPubKey PaymentPubKeyHash
    | OwnedByScript ValidatorHash
    deriving (BeneficialOwner -> BeneficialOwner -> Bool
(BeneficialOwner -> BeneficialOwner -> Bool)
-> (BeneficialOwner -> BeneficialOwner -> Bool)
-> Eq BeneficialOwner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeneficialOwner -> BeneficialOwner -> Bool
$c/= :: BeneficialOwner -> BeneficialOwner -> Bool
== :: BeneficialOwner -> BeneficialOwner -> Bool
$c== :: BeneficialOwner -> BeneficialOwner -> Bool
Eq, Int -> BeneficialOwner -> ShowS
[BeneficialOwner] -> ShowS
BeneficialOwner -> String
(Int -> BeneficialOwner -> ShowS)
-> (BeneficialOwner -> String)
-> ([BeneficialOwner] -> ShowS)
-> Show BeneficialOwner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeneficialOwner] -> ShowS
$cshowList :: [BeneficialOwner] -> ShowS
show :: BeneficialOwner -> String
$cshow :: BeneficialOwner -> String
showsPrec :: Int -> BeneficialOwner -> ShowS
$cshowsPrec :: Int -> BeneficialOwner -> ShowS
Show, Eq BeneficialOwner
Eq BeneficialOwner
-> (BeneficialOwner -> BeneficialOwner -> Ordering)
-> (BeneficialOwner -> BeneficialOwner -> Bool)
-> (BeneficialOwner -> BeneficialOwner -> Bool)
-> (BeneficialOwner -> BeneficialOwner -> Bool)
-> (BeneficialOwner -> BeneficialOwner -> Bool)
-> (BeneficialOwner -> BeneficialOwner -> BeneficialOwner)
-> (BeneficialOwner -> BeneficialOwner -> BeneficialOwner)
-> Ord BeneficialOwner
BeneficialOwner -> BeneficialOwner -> Bool
BeneficialOwner -> BeneficialOwner -> Ordering
BeneficialOwner -> BeneficialOwner -> BeneficialOwner
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
min :: BeneficialOwner -> BeneficialOwner -> BeneficialOwner
$cmin :: BeneficialOwner -> BeneficialOwner -> BeneficialOwner
max :: BeneficialOwner -> BeneficialOwner -> BeneficialOwner
$cmax :: BeneficialOwner -> BeneficialOwner -> BeneficialOwner
>= :: BeneficialOwner -> BeneficialOwner -> Bool
$c>= :: BeneficialOwner -> BeneficialOwner -> Bool
> :: BeneficialOwner -> BeneficialOwner -> Bool
$c> :: BeneficialOwner -> BeneficialOwner -> Bool
<= :: BeneficialOwner -> BeneficialOwner -> Bool
$c<= :: BeneficialOwner -> BeneficialOwner -> Bool
< :: BeneficialOwner -> BeneficialOwner -> Bool
$c< :: BeneficialOwner -> BeneficialOwner -> Bool
compare :: BeneficialOwner -> BeneficialOwner -> Ordering
$ccompare :: BeneficialOwner -> BeneficialOwner -> Ordering
$cp1Ord :: Eq BeneficialOwner
Ord, (forall x. BeneficialOwner -> Rep BeneficialOwner x)
-> (forall x. Rep BeneficialOwner x -> BeneficialOwner)
-> Generic BeneficialOwner
forall x. Rep BeneficialOwner x -> BeneficialOwner
forall x. BeneficialOwner -> Rep BeneficialOwner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BeneficialOwner x -> BeneficialOwner
$cfrom :: forall x. BeneficialOwner -> Rep BeneficialOwner x
Generic)
    deriving anyclass (Value -> Parser [BeneficialOwner]
Value -> Parser BeneficialOwner
(Value -> Parser BeneficialOwner)
-> (Value -> Parser [BeneficialOwner]) -> FromJSON BeneficialOwner
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BeneficialOwner]
$cparseJSONList :: Value -> Parser [BeneficialOwner]
parseJSON :: Value -> Parser BeneficialOwner
$cparseJSON :: Value -> Parser BeneficialOwner
FromJSON, [BeneficialOwner] -> Encoding
[BeneficialOwner] -> Value
BeneficialOwner -> Encoding
BeneficialOwner -> Value
(BeneficialOwner -> Value)
-> (BeneficialOwner -> Encoding)
-> ([BeneficialOwner] -> Value)
-> ([BeneficialOwner] -> Encoding)
-> ToJSON BeneficialOwner
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BeneficialOwner] -> Encoding
$ctoEncodingList :: [BeneficialOwner] -> Encoding
toJSONList :: [BeneficialOwner] -> Value
$ctoJSONList :: [BeneficialOwner] -> Value
toEncoding :: BeneficialOwner -> Encoding
$ctoEncoding :: BeneficialOwner -> Encoding
toJSON :: BeneficialOwner -> Value
$ctoJSON :: BeneficialOwner -> Value
ToJSON, FromJSONKeyFunction [BeneficialOwner]
FromJSONKeyFunction BeneficialOwner
FromJSONKeyFunction BeneficialOwner
-> FromJSONKeyFunction [BeneficialOwner]
-> FromJSONKey BeneficialOwner
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [BeneficialOwner]
$cfromJSONKeyList :: FromJSONKeyFunction [BeneficialOwner]
fromJSONKey :: FromJSONKeyFunction BeneficialOwner
$cfromJSONKey :: FromJSONKeyFunction BeneficialOwner
FromJSONKey, ToJSONKeyFunction [BeneficialOwner]
ToJSONKeyFunction BeneficialOwner
ToJSONKeyFunction BeneficialOwner
-> ToJSONKeyFunction [BeneficialOwner] -> ToJSONKey BeneficialOwner
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [BeneficialOwner]
$ctoJSONKeyList :: ToJSONKeyFunction [BeneficialOwner]
toJSONKey :: ToJSONKeyFunction BeneficialOwner
$ctoJSONKey :: ToJSONKeyFunction BeneficialOwner
ToJSONKey)

toBeneficialOwner :: TxOut -> BeneficialOwner
toBeneficialOwner :: TxOut -> BeneficialOwner
toBeneficialOwner TxOut
txOut =
    case AddressInEra BabbageEra -> Credential
forall era. AddressInEra era -> Credential
cardanoAddressCredential (TxOut -> AddressInEra BabbageEra
txOutAddress TxOut
txOut) of
        PubKeyCredential PubKeyHash
pkh -> PaymentPubKeyHash -> BeneficialOwner
OwnedByPaymentPubKey (PubKeyHash -> PaymentPubKeyHash
PaymentPubKeyHash PubKeyHash
pkh)
        ScriptCredential ValidatorHash
vh  -> ValidatorHash -> BeneficialOwner
OwnedByScript ValidatorHash
vh

data AnnotatedTx =
    AnnotatedTx
        { AnnotatedTx -> SequenceId
sequenceId         :: SequenceId
        , AnnotatedTx -> TxId
txId               :: C.TxId
        , AnnotatedTx -> CardanoTx
tx                 :: CardanoTx
        , AnnotatedTx -> [DereferencedInput]
dereferencedInputs :: [DereferencedInput]
        , AnnotatedTx -> Map BeneficialOwner Value
balances           :: Map BeneficialOwner Value
        , AnnotatedTx -> Bool
valid              :: Bool
        }
    deriving (AnnotatedTx -> AnnotatedTx -> Bool
(AnnotatedTx -> AnnotatedTx -> Bool)
-> (AnnotatedTx -> AnnotatedTx -> Bool) -> Eq AnnotatedTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnotatedTx -> AnnotatedTx -> Bool
$c/= :: AnnotatedTx -> AnnotatedTx -> Bool
== :: AnnotatedTx -> AnnotatedTx -> Bool
$c== :: AnnotatedTx -> AnnotatedTx -> Bool
Eq, Int -> AnnotatedTx -> ShowS
[AnnotatedTx] -> ShowS
AnnotatedTx -> String
(Int -> AnnotatedTx -> ShowS)
-> (AnnotatedTx -> String)
-> ([AnnotatedTx] -> ShowS)
-> Show AnnotatedTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnnotatedTx] -> ShowS
$cshowList :: [AnnotatedTx] -> ShowS
show :: AnnotatedTx -> String
$cshow :: AnnotatedTx -> String
showsPrec :: Int -> AnnotatedTx -> ShowS
$cshowsPrec :: Int -> AnnotatedTx -> ShowS
Show, (forall x. AnnotatedTx -> Rep AnnotatedTx x)
-> (forall x. Rep AnnotatedTx x -> AnnotatedTx)
-> Generic AnnotatedTx
forall x. Rep AnnotatedTx x -> AnnotatedTx
forall x. AnnotatedTx -> Rep AnnotatedTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AnnotatedTx x -> AnnotatedTx
$cfrom :: forall x. AnnotatedTx -> Rep AnnotatedTx x
Generic)
    deriving anyclass (Value -> Parser [AnnotatedTx]
Value -> Parser AnnotatedTx
(Value -> Parser AnnotatedTx)
-> (Value -> Parser [AnnotatedTx]) -> FromJSON AnnotatedTx
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AnnotatedTx]
$cparseJSONList :: Value -> Parser [AnnotatedTx]
parseJSON :: Value -> Parser AnnotatedTx
$cparseJSON :: Value -> Parser AnnotatedTx
FromJSON, [AnnotatedTx] -> Encoding
[AnnotatedTx] -> Value
AnnotatedTx -> Encoding
AnnotatedTx -> Value
(AnnotatedTx -> Value)
-> (AnnotatedTx -> Encoding)
-> ([AnnotatedTx] -> Value)
-> ([AnnotatedTx] -> Encoding)
-> ToJSON AnnotatedTx
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AnnotatedTx] -> Encoding
$ctoEncodingList :: [AnnotatedTx] -> Encoding
toJSONList :: [AnnotatedTx] -> Value
$ctoJSONList :: [AnnotatedTx] -> Value
toEncoding :: AnnotatedTx -> Encoding
$ctoEncoding :: AnnotatedTx -> Encoding
toJSON :: AnnotatedTx -> Value
$ctoJSON :: AnnotatedTx -> Value
ToJSON)

makeLenses 'AnnotatedTx

data Rollup =
    Rollup
        { Rollup -> Map TxIn TxOut
_previousOutputs :: Map C.TxIn TxOut
        , Rollup -> Map BeneficialOwner Value
_rollingBalances :: Map BeneficialOwner Value
        }
    deriving (Int -> Rollup -> ShowS
[Rollup] -> ShowS
Rollup -> String
(Int -> Rollup -> ShowS)
-> (Rollup -> String) -> ([Rollup] -> ShowS) -> Show Rollup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rollup] -> ShowS
$cshowList :: [Rollup] -> ShowS
show :: Rollup -> String
$cshow :: Rollup -> String
showsPrec :: Int -> Rollup -> ShowS
$cshowsPrec :: Int -> Rollup -> ShowS
Show, Rollup -> Rollup -> Bool
(Rollup -> Rollup -> Bool)
-> (Rollup -> Rollup -> Bool) -> Eq Rollup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rollup -> Rollup -> Bool
$c/= :: Rollup -> Rollup -> Bool
== :: Rollup -> Rollup -> Bool
$c== :: Rollup -> Rollup -> Bool
Eq, (forall x. Rollup -> Rep Rollup x)
-> (forall x. Rep Rollup x -> Rollup) -> Generic Rollup
forall x. Rep Rollup x -> Rollup
forall x. Rollup -> Rep Rollup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rollup x -> Rollup
$cfrom :: forall x. Rollup -> Rep Rollup x
Generic)

makeLenses 'Rollup

data RollupState =
    RollupState
        { RollupState -> SequenceId
_currentSequenceId     :: SequenceId
        , RollupState -> Rollup
_rollup                :: Rollup
        , RollupState -> [AnnotatedTx]
_annotatedTransactions :: [AnnotatedTx] -- reverse order
        }

makeLenses ''RollupState