{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}

module Bcc.CLI.Sophie.Output
  ( QueryTipOutput(..)
  , QueryTipLocalState(..)
  , QueryTipLocalStateOutput(..)
  ) where

import           Bcc.Api

import           Bcc.CLI.Sophie.Orphans ()
import           Bcc.Prelude (Either, Text)
import           Bcc.Slotting.EpochInfo (EpochInfo)
import           Bcc.Slotting.Time (SystemStart (..))
import           Control.Monad
import           Data.Aeson (KeyValue, ToJSON (..), (.=))
import           Data.Function (id, ($), (.))
import           Data.Maybe
import           Data.Monoid (mconcat)
import           Sophie.Spec.Ledger.Scripts ()

import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE

data QueryTipOutput localState = QueryTipOutput
  { QueryTipOutput localState -> ChainTip
chainTip :: ChainTip
  , QueryTipOutput localState -> Maybe localState
mLocalState :: Maybe localState
  }

data QueryTipLocalState = QueryTipLocalState
  { QueryTipLocalState -> AnyBccEra
era :: AnyBccEra
  , QueryTipLocalState -> EraHistory BccMode
eraHistory :: EraHistory BccMode
  , QueryTipLocalState -> Maybe SystemStart
mSystemStart :: Maybe SystemStart
  , QueryTipLocalState
-> EpochInfo (Either TransactionValidityIntervalError)
epochInfo :: EpochInfo (Either TransactionValidityIntervalError)
  }

data QueryTipLocalStateOutput = QueryTipLocalStateOutput
  { QueryTipLocalStateOutput -> Maybe AnyBccEra
mEra :: Maybe AnyBccEra
  , QueryTipLocalStateOutput -> Maybe EpochNo
mEpoch :: Maybe EpochNo
  , QueryTipLocalStateOutput -> Maybe Text
mSyncProgress :: Maybe Text
  }

-- | A key-value pair difference list for encoding a JSON object.
(..=) :: (KeyValue kv, ToJSON v) => Text -> v -> [kv] -> [kv]
..= :: Text -> v -> [kv] -> [kv]
(..=) Text
n v
v = (Text
n Text -> v -> kv
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= v
vkv -> [kv] -> [kv]
forall a. a -> [a] -> [a]
:)

-- | A key-value pair difference list for encoding a JSON object where Nothing encodes absence of the key-value pair.
(..=?) :: (KeyValue kv, ToJSON v) => Text -> Maybe v -> [kv] -> [kv]
..=? :: Text -> Maybe v -> [kv] -> [kv]
(..=?) Text
n Maybe v
mv = case Maybe v
mv of
  Just v
v -> (Text
n Text -> v -> kv
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= v
vkv -> [kv] -> [kv]
forall a. a -> [a] -> [a]
:)
  Maybe v
Nothing -> [kv] -> [kv]
forall a. a -> a
id

instance ToJSON (QueryTipOutput QueryTipLocalStateOutput) where
  toJSON :: QueryTipOutput QueryTipLocalStateOutput -> Value
toJSON QueryTipOutput QueryTipLocalStateOutput
a = case QueryTipOutput QueryTipLocalStateOutput -> ChainTip
forall localState. QueryTipOutput localState -> ChainTip
chainTip QueryTipOutput QueryTipLocalStateOutput
a of
    ChainTip
ChainTipAtGenesis -> Value
J.Null
    ChainTip SlotNo
slot Hash BlockHeader
headerHash (BlockNo Word64
bNum) ->
      [Pair] -> Value
J.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        ( (Text
"slot" Text -> SlotNo -> [Pair] -> [Pair]
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> [kv] -> [kv]
..= SlotNo
slot)
        ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"hash" Text -> Text -> [Pair] -> [Pair]
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> [kv] -> [kv]
..= Hash BlockHeader -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash BlockHeader
headerHash)
        ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"block" Text -> Word64 -> [Pair] -> [Pair]
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> [kv] -> [kv]
..= Word64
bNum)
        ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"era" Text -> Maybe AnyBccEra -> [Pair] -> [Pair]
forall kv v.
(KeyValue kv, ToJSON v) =>
Text -> Maybe v -> [kv] -> [kv]
..=? (QueryTipOutput QueryTipLocalStateOutput
-> Maybe QueryTipLocalStateOutput
forall localState. QueryTipOutput localState -> Maybe localState
mLocalState QueryTipOutput QueryTipLocalStateOutput
a Maybe QueryTipLocalStateOutput
-> (QueryTipLocalStateOutput -> Maybe AnyBccEra) -> Maybe AnyBccEra
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QueryTipLocalStateOutput -> Maybe AnyBccEra
mEra))
        ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"epoch" Text -> Maybe EpochNo -> [Pair] -> [Pair]
forall kv v.
(KeyValue kv, ToJSON v) =>
Text -> Maybe v -> [kv] -> [kv]
..=? (QueryTipOutput QueryTipLocalStateOutput
-> Maybe QueryTipLocalStateOutput
forall localState. QueryTipOutput localState -> Maybe localState
mLocalState QueryTipOutput QueryTipLocalStateOutput
a Maybe QueryTipLocalStateOutput
-> (QueryTipLocalStateOutput -> Maybe EpochNo) -> Maybe EpochNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QueryTipLocalStateOutput -> Maybe EpochNo
mEpoch))
        ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"syncProgress" Text -> Maybe Text -> [Pair] -> [Pair]
forall kv v.
(KeyValue kv, ToJSON v) =>
Text -> Maybe v -> [kv] -> [kv]
..=? (QueryTipOutput QueryTipLocalStateOutput
-> Maybe QueryTipLocalStateOutput
forall localState. QueryTipOutput localState -> Maybe localState
mLocalState QueryTipOutput QueryTipLocalStateOutput
a Maybe QueryTipLocalStateOutput
-> (QueryTipLocalStateOutput -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QueryTipLocalStateOutput -> Maybe Text
mSyncProgress))
        ) []
  toEncoding :: QueryTipOutput QueryTipLocalStateOutput -> Encoding
toEncoding QueryTipOutput QueryTipLocalStateOutput
a = case QueryTipOutput QueryTipLocalStateOutput -> ChainTip
forall localState. QueryTipOutput localState -> ChainTip
chainTip QueryTipOutput QueryTipLocalStateOutput
a of
    ChainTip
ChainTipAtGenesis -> Encoding
JE.null_
    ChainTip SlotNo
slot Hash BlockHeader
headerHash (BlockNo Word64
bNum) ->
      Series -> Encoding
J.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> [Series] -> Series
forall a b. (a -> b) -> a -> b
$
        ( (Text
"slot" Text -> SlotNo -> [Series] -> [Series]
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> [kv] -> [kv]
..= SlotNo
slot)
        ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"hash" Text -> Text -> [Series] -> [Series]
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> [kv] -> [kv]
..= Hash BlockHeader -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash BlockHeader
headerHash)
        ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"block" Text -> Word64 -> [Series] -> [Series]
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> [kv] -> [kv]
..= Word64
bNum)
        ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"era" Text -> Maybe AnyBccEra -> [Series] -> [Series]
forall kv v.
(KeyValue kv, ToJSON v) =>
Text -> Maybe v -> [kv] -> [kv]
..=? (QueryTipOutput QueryTipLocalStateOutput
-> Maybe QueryTipLocalStateOutput
forall localState. QueryTipOutput localState -> Maybe localState
mLocalState QueryTipOutput QueryTipLocalStateOutput
a Maybe QueryTipLocalStateOutput
-> (QueryTipLocalStateOutput -> Maybe AnyBccEra) -> Maybe AnyBccEra
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QueryTipLocalStateOutput -> Maybe AnyBccEra
mEra))
        ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"epoch" Text -> Maybe EpochNo -> [Series] -> [Series]
forall kv v.
(KeyValue kv, ToJSON v) =>
Text -> Maybe v -> [kv] -> [kv]
..=? (QueryTipOutput QueryTipLocalStateOutput
-> Maybe QueryTipLocalStateOutput
forall localState. QueryTipOutput localState -> Maybe localState
mLocalState QueryTipOutput QueryTipLocalStateOutput
a Maybe QueryTipLocalStateOutput
-> (QueryTipLocalStateOutput -> Maybe EpochNo) -> Maybe EpochNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QueryTipLocalStateOutput -> Maybe EpochNo
mEpoch))
        ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"syncProgress" Text -> Maybe Text -> [Series] -> [Series]
forall kv v.
(KeyValue kv, ToJSON v) =>
Text -> Maybe v -> [kv] -> [kv]
..=? (QueryTipOutput QueryTipLocalStateOutput
-> Maybe QueryTipLocalStateOutput
forall localState. QueryTipOutput localState -> Maybe localState
mLocalState QueryTipOutput QueryTipLocalStateOutput
a Maybe QueryTipLocalStateOutput
-> (QueryTipLocalStateOutput -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QueryTipLocalStateOutput -> Maybe Text
mSyncProgress))
        ) []