{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

module Ledger.Blockchain (
    OnChainTx(..),
    Block,
    BlockId(..),
    Blockchain,
    Context(..),
    eitherTx,
    unOnChain,
    onChainTxIsValid,
    consumableInputs,
    outputsProduced,
    ) where

import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as JSON
import Data.Aeson.Extras qualified as JSON
import Data.ByteString qualified as BS
import Data.Either (fromRight)
import Data.Map (Map)
import Data.Text qualified as Text
import Data.Text.Encoding (decodeUtf8')
import GHC.Generics (Generic)
import Prettyprinter (Pretty (..))

import Cardano.Api qualified as C
import Ledger.Index.Internal (OnChainTx (..), eitherTx, unOnChain)
import Ledger.Tx (TxOut, getCardanoTxCollateralInputs, getCardanoTxInputs, getCardanoTxProducedOutputs,
                  getCardanoTxProducedReturnCollateral)
import Plutus.V1.Ledger.Scripts

-- | Block identifier (usually a hash)
newtype BlockId = BlockId { BlockId -> ByteString
getBlockId :: BS.ByteString }
    deriving stock (BlockId -> BlockId -> Bool
(BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool) -> Eq BlockId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockId -> BlockId -> Bool
$c/= :: BlockId -> BlockId -> Bool
== :: BlockId -> BlockId -> Bool
$c== :: BlockId -> BlockId -> Bool
Eq, Eq BlockId
Eq BlockId
-> (BlockId -> BlockId -> Ordering)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> BlockId)
-> (BlockId -> BlockId -> BlockId)
-> Ord BlockId
BlockId -> BlockId -> Bool
BlockId -> BlockId -> Ordering
BlockId -> BlockId -> BlockId
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 :: BlockId -> BlockId -> BlockId
$cmin :: BlockId -> BlockId -> BlockId
max :: BlockId -> BlockId -> BlockId
$cmax :: BlockId -> BlockId -> BlockId
>= :: BlockId -> BlockId -> Bool
$c>= :: BlockId -> BlockId -> Bool
> :: BlockId -> BlockId -> Bool
$c> :: BlockId -> BlockId -> Bool
<= :: BlockId -> BlockId -> Bool
$c<= :: BlockId -> BlockId -> Bool
< :: BlockId -> BlockId -> Bool
$c< :: BlockId -> BlockId -> Bool
compare :: BlockId -> BlockId -> Ordering
$ccompare :: BlockId -> BlockId -> Ordering
$cp1Ord :: Eq BlockId
Ord, (forall x. BlockId -> Rep BlockId x)
-> (forall x. Rep BlockId x -> BlockId) -> Generic BlockId
forall x. Rep BlockId x -> BlockId
forall x. BlockId -> Rep BlockId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockId x -> BlockId
$cfrom :: forall x. BlockId -> Rep BlockId x
Generic)

instance Show BlockId where
    show :: BlockId -> String
show = Text -> String
Text.unpack (Text -> String) -> (BlockId -> Text) -> BlockId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
JSON.encodeByteString (ByteString -> Text) -> (BlockId -> ByteString) -> BlockId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> ByteString
getBlockId

instance ToJSON BlockId where
    toJSON :: BlockId -> Value
toJSON = Text -> Value
JSON.String (Text -> Value) -> (BlockId -> Text) -> BlockId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
JSON.encodeByteString (ByteString -> Text) -> (BlockId -> ByteString) -> BlockId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> ByteString
getBlockId

instance FromJSON BlockId where
    parseJSON :: Value -> Parser BlockId
parseJSON Value
v = ByteString -> BlockId
BlockId (ByteString -> BlockId) -> Parser ByteString -> Parser BlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ByteString
JSON.decodeByteString Value
v

instance Pretty BlockId where
    pretty :: BlockId -> Doc ann
pretty (BlockId ByteString
blockId) =
        Doc ann
"BlockId "
     Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Either UnicodeException Text -> Text
forall b a. b -> Either a b -> b
fromRight (ByteString -> Text
JSON.encodeByteString ByteString
blockId) (Either UnicodeException Text -> Text)
-> Either UnicodeException Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
blockId)

-- | A block on the blockchain. This is just a list of transactions
-- following on from the chain so far.
type Block = [OnChainTx]
-- | A blockchain, which is just a list of blocks, starting with the newest.
type Blockchain = [Block]

onChainTxIsValid :: OnChainTx -> Bool
onChainTxIsValid :: OnChainTx -> Bool
onChainTxIsValid = (CardanoTx -> Bool) -> (CardanoTx -> Bool) -> OnChainTx -> Bool
forall r. (CardanoTx -> r) -> (CardanoTx -> r) -> OnChainTx -> r
eitherTx (Bool -> CardanoTx -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> CardanoTx -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Outputs consumed from the UTXO set by the 'OnChainTx'
consumableInputs :: OnChainTx -> [C.TxIn]
consumableInputs :: OnChainTx -> [TxIn]
consumableInputs = (CardanoTx -> [TxIn])
-> (CardanoTx -> [TxIn]) -> OnChainTx -> [TxIn]
forall r. (CardanoTx -> r) -> (CardanoTx -> r) -> OnChainTx -> r
eitherTx CardanoTx -> [TxIn]
getCardanoTxCollateralInputs CardanoTx -> [TxIn]
getCardanoTxInputs

-- | Outputs added to the UTXO set by the 'OnChainTx'
outputsProduced :: OnChainTx -> Map C.TxIn TxOut
outputsProduced :: OnChainTx -> Map TxIn TxOut
outputsProduced = (CardanoTx -> Map TxIn TxOut)
-> (CardanoTx -> Map TxIn TxOut) -> OnChainTx -> Map TxIn TxOut
forall r. (CardanoTx -> r) -> (CardanoTx -> r) -> OnChainTx -> r
eitherTx CardanoTx -> Map TxIn TxOut
getCardanoTxProducedReturnCollateral CardanoTx -> Map TxIn TxOut
getCardanoTxProducedOutputs