-- | Information about produced blocks

module Blockfrost.Types.Cardano.Blocks
  ( Block (..)
  ) where

import Data.Text (Text)
import Deriving.Aeson
import Servant.Docs (ToSample (..), singleSample)

import Blockfrost.Types.Shared

-- | Information about a block
data Block = Block
  { Block -> POSIXTime
_blockTime          :: POSIXTime -- ^ Block creation time in UNIX time
  , Block -> Maybe Integer
_blockHeight        :: Maybe Integer -- ^ Block number
  , Block -> BlockHash
_blockHash          :: BlockHash -- ^ Hash of the block
  , Block -> Maybe Slot
_blockSlot          :: Maybe Slot -- ^ Slot number
  , Block -> Maybe Epoch
_blockEpoch         :: Maybe Epoch -- ^ Epoch number
  , Block -> Maybe Integer
_blockEpochSlot     :: Maybe Integer -- ^ Slot within the epoch
  , Block -> Text
_blockSlotLeader    :: Text -- ^ Bech32 ID of the slot leader or specific block description in case there is no slot leader
  , Block -> Integer
_blockSize          :: Integer -- ^ Block size in Bytes
  , Block -> Integer
_blockTxCount       :: Integer -- ^ Number of transactions in the block
  , Block -> Maybe Lovelaces
_blockOutput        :: Maybe Lovelaces -- ^ Total output within the block in Lovelaces
  , Block -> Maybe Lovelaces
_blockFees          :: Maybe Lovelaces -- ^ Total fees within the block in Lovelaces
  , Block -> Maybe Text
_blockBlockVrf      :: Maybe Text -- ^ VRF key of the block
  , Block -> Maybe BlockHash
_blockPreviousBlock :: Maybe BlockHash -- ^ Hash of the previous block
  , Block -> Maybe BlockHash
_blockNextBlock     :: Maybe BlockHash -- ^ Hash of the next block
  , Block -> Integer
_blockConfirmations :: Integer -- ^ Number of block confirmations
  }
  deriving stock (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: Block -> Block -> Bool
Eq, (forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic)
  deriving (Value -> Parser [Block]
Value -> Parser Block
(Value -> Parser Block)
-> (Value -> Parser [Block]) -> FromJSON Block
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Block]
$cparseJSONList :: Value -> Parser [Block]
parseJSON :: Value -> Parser Block
$cparseJSON :: Value -> Parser Block
FromJSON, [Block] -> Encoding
[Block] -> Value
Block -> Encoding
Block -> Value
(Block -> Value)
-> (Block -> Encoding)
-> ([Block] -> Value)
-> ([Block] -> Encoding)
-> ToJSON Block
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Block] -> Encoding
$ctoEncodingList :: [Block] -> Encoding
toJSONList :: [Block] -> Value
$ctoJSONList :: [Block] -> Value
toEncoding :: Block -> Encoding
$ctoEncoding :: Block -> Encoding
toJSON :: Block -> Value
$ctoJSON :: Block -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_block", CamelToSnake]] Block

instance ToSample Block where
  toSamples :: Proxy Block -> [(Text, Block)]
toSamples Proxy Block
_ = Block -> [(Text, Block)]
forall a. a -> [(Text, a)]
singleSample (Block -> [(Text, Block)]) -> Block -> [(Text, Block)]
forall a b. (a -> b) -> a -> b
$ Block :: POSIXTime
-> Maybe Integer
-> BlockHash
-> Maybe Slot
-> Maybe Epoch
-> Maybe Integer
-> Text
-> Integer
-> Integer
-> Maybe Lovelaces
-> Maybe Lovelaces
-> Maybe Text
-> Maybe BlockHash
-> Maybe BlockHash
-> Integer
-> Block
Block
    { _blockTime :: POSIXTime
_blockTime = POSIXTime
1641338934
    , _blockHeight :: Maybe Integer
_blockHeight = Integer -> Maybe Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
15243593
    , _blockHash :: BlockHash
_blockHash = BlockHash
"4ea1ba291e8eef538635a53e59fddba7810d1679631cc3aed7c8e6c4091a516a"
    , _blockSlot :: Maybe Slot
_blockSlot = Slot -> Maybe Slot
forall (f :: * -> *) a. Applicative f => a -> f a
pure Slot
412162133
    , _blockEpoch :: Maybe Epoch
_blockEpoch = Epoch -> Maybe Epoch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Epoch
425
    , _blockEpochSlot :: Maybe Integer
_blockEpochSlot = Integer -> Maybe Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
12
    , _blockSlotLeader :: Text
_blockSlotLeader = Text
"pool1pu5jlj4q9w9jlxeu370a3c9myx47md5j5m2str0naunn2qnikdy"
    , _blockSize :: Integer
_blockSize = Integer
3
    , _blockTxCount :: Integer
_blockTxCount = Integer
1
    , _blockOutput :: Maybe Lovelaces
_blockOutput = Discrete' "ADA" '(1000000, 1)
-> Maybe (Discrete' "ADA" '(1000000, 1))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Discrete' "ADA" '(1000000, 1)
128314491794
    , _blockFees :: Maybe Lovelaces
_blockFees = Discrete' "ADA" '(1000000, 1)
-> Maybe (Discrete' "ADA" '(1000000, 1))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Discrete' "ADA" '(1000000, 1)
592661
    , _blockBlockVrf :: Maybe Text
_blockBlockVrf = Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"vrf_vk1wf2k6lhujezqcfe00l6zetxpnmh9n6mwhpmhm0dvfh3fxgmdnrfqkms8ty"
    , _blockPreviousBlock :: Maybe BlockHash
_blockPreviousBlock = BlockHash -> Maybe BlockHash
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlockHash
"43ebccb3ac72c7cebd0d9b755a4b08412c9f5dcb81b8a0ad1e3c197d29d47b05"
    , _blockNextBlock :: Maybe BlockHash
_blockNextBlock = BlockHash -> Maybe BlockHash
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlockHash
"8367f026cf4b03e116ff8ee5daf149b55ba5a6ec6dec04803b8dc317721d15fa"
    , _blockConfirmations :: Integer
_blockConfirmations = Integer
4698
    }