{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.CLI.Shelley.Orphans () where

import           Cardano.Api.Orphans ()
import qualified Cardano.Ledger.AuxiliaryData as Ledger
import qualified Cardano.Ledger.Credential as Ledger
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import qualified Cardano.Ledger.Mary.Value as Ledger.Mary
import qualified Cardano.Ledger.PoolDistr as Ledger
import qualified Cardano.Ledger.Shelley.EpochBoundary as Ledger
import qualified Cardano.Ledger.Shelley.PoolRank as Ledger
import           Cardano.Ledger.TxIn (TxId (..))
import           Cardano.Prelude (Bool(True), Category((.)))
import qualified Cardano.Protocol.TPraos.API as Ledger
import           Cardano.Protocol.TPraos.BHeader (HashHeader (..))
import qualified Cardano.Protocol.TPraos.Rules.Prtcl as Ledger
import qualified Cardano.Protocol.TPraos.Rules.Tickn as Ledger
import qualified Cardano.Slotting.Slot as Cardano
import qualified Control.SetAlgebra as SetAlgebra (BiMap, forwards)
import           Data.Aeson (FromJSON(..), KeyValue((.=)), ToJSON(..), ToJSONKey)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Short as SBS
import qualified Data.Text.Encoding as Text
import qualified Data.VMap as VMap
import           Ouroboros.Consensus.Byron.Ledger.Block (ByronHash (..))
import           Ouroboros.Consensus.HardFork.Combinator (OneEraHash (..))
import           Ouroboros.Consensus.Protocol.Praos (PraosState)
import qualified Ouroboros.Consensus.Protocol.Praos as Consensus
import           Ouroboros.Consensus.Protocol.TPraos (TPraosState)
import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus
import           Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
import           Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyHash (..))
import           Ouroboros.Network.Block (BlockNo (..), HeaderHash, Tip (..))

instance ToJSON (OneEraHash xs) where
  toJSON :: OneEraHash xs -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON
         (Text -> Value)
-> (OneEraHash xs -> Text) -> OneEraHash xs -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Text
Text.decodeLatin1
         (ByteString -> Text)
-> (OneEraHash xs -> ByteString) -> OneEraHash xs -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
Base16.encode
         (ByteString -> ByteString)
-> (OneEraHash xs -> ByteString) -> OneEraHash xs -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShortByteString -> ByteString
SBS.fromShort
         (ShortByteString -> ByteString)
-> (OneEraHash xs -> ShortByteString)
-> OneEraHash xs
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OneEraHash xs -> ShortByteString
forall k (xs :: [k]). OneEraHash xs -> ShortByteString
getOneEraHash

deriving newtype instance ToJSON ByronHash

-- This instance is temporarily duplicated in cardano-config

instance ToJSON (HeaderHash blk) => ToJSON (Tip blk) where
  toJSON :: Tip blk -> Value
toJSON Tip blk
TipGenesis = [Pair] -> Value
Aeson.object [ Key
"genesis" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True ]
  toJSON (Tip SlotNo
slotNo HeaderHash blk
headerHash BlockNo
blockNo) =
    [Pair] -> Value
Aeson.object
      [ Key
"slotNo"     Key -> SlotNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slotNo
      , Key
"headerHash" Key -> HeaderHash blk -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HeaderHash blk
headerHash
      , Key
"blockNo"    Key -> BlockNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BlockNo
blockNo
      ]

deriving newtype instance ToJSON BlockNo
deriving newtype instance FromJSON BlockNo

--
-- Simple newtype wrappers JSON conversion
--

deriving newtype instance CC.Crypto crypto => ToJSON (TxId crypto)

deriving newtype instance CC.Crypto crypto => ToJSON (ShelleyHash crypto)
deriving newtype instance CC.Crypto crypto => ToJSON (HashHeader crypto)

deriving newtype instance ToJSON (Ledger.AuxiliaryDataHash StandardCrypto)
deriving newtype instance ToJSON Ledger.LogWeight
deriving newtype instance ToJSON (Ledger.PoolDistr StandardCrypto)

deriving newtype instance ToJSON (Ledger.Stake StandardCrypto)

deriving instance ToJSON (Ledger.StakeReference StandardCrypto)

deriving instance ToJSON (Ledger.PrtclState StandardCrypto)
deriving instance ToJSON Ledger.TicknState
deriving instance ToJSON (Ledger.ChainDepState StandardCrypto)

deriving newtype  instance ToJSON    (Ledger.Mary.PolicyID StandardCrypto)

instance (ToJSONKey k, ToJSON v) => ToJSON (SetAlgebra.BiMap v k v) where
  toJSON :: BiMap v k v -> Value
toJSON = Map k v -> Value
forall a. ToJSON a => a -> Value
toJSON (Map k v -> Value)
-> (BiMap v k v -> Map k v) -> BiMap v k v -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BiMap v k v -> Map k v
forall v k. BiMap v k v -> Map k v
SetAlgebra.forwards -- to normal Map

instance ToJSON (TPraosState StandardCrypto) where
  toJSON :: TPraosState StandardCrypto -> Value
toJSON TPraosState StandardCrypto
s = [Pair] -> Value
Aeson.object
    [ Key
"lastSlot" Key -> WithOrigin SlotNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TPraosState StandardCrypto -> WithOrigin SlotNo
forall c. TPraosState c -> WithOrigin SlotNo
Consensus.tpraosStateLastSlot TPraosState StandardCrypto
s
    , Key
"chainDepState" Key -> ChainDepState StandardCrypto -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TPraosState StandardCrypto -> ChainDepState StandardCrypto
forall c. TPraosState c -> ChainDepState c
Consensus.tpraosStateChainDepState TPraosState StandardCrypto
s
    ]

instance ToJSON (PraosState StandardCrypto) where
  toJSON :: PraosState StandardCrypto -> Value
toJSON PraosState StandardCrypto
s = [Pair] -> Value
Aeson.object
    [ Key
"lastSlot" Key -> WithOrigin SlotNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> WithOrigin SlotNo
forall c. PraosState c -> WithOrigin SlotNo
Consensus.praosStateLastSlot PraosState StandardCrypto
s
    , Key
"oCertCounters" Key -> Map (KeyHash 'BlockIssuer StandardCrypto) Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto
-> Map (KeyHash 'BlockIssuer StandardCrypto) Word64
forall c. PraosState c -> Map (KeyHash 'BlockIssuer c) Word64
Consensus.praosStateOCertCounters PraosState StandardCrypto
s
    , Key
"evolvingNonce" Key -> Nonce -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> Nonce
forall c. PraosState c -> Nonce
Consensus.praosStateEvolvingNonce PraosState StandardCrypto
s
    , Key
"candidateNonce" Key -> Nonce -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> Nonce
forall c. PraosState c -> Nonce
Consensus.praosStateCandidateNonce PraosState StandardCrypto
s
    , Key
"epochNonce" Key -> Nonce -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> Nonce
forall c. PraosState c -> Nonce
Consensus.praosStateEpochNonce PraosState StandardCrypto
s
    , Key
"labNonce" Key -> Nonce -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> Nonce
forall c. PraosState c -> Nonce
Consensus.praosStateLabNonce PraosState StandardCrypto
s
    , Key
"lastEpochBlockNonce" Key -> Nonce -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> Nonce
forall c. PraosState c -> Nonce
Consensus.praosStateLastEpochBlockNonce PraosState StandardCrypto
s
    ]


instance ToJSON (Cardano.WithOrigin Cardano.SlotNo) where
  toJSON :: WithOrigin SlotNo -> Value
toJSON = \case
    WithOrigin SlotNo
Cardano.Origin -> Text -> Value
Aeson.String Text
"origin"
    Cardano.At (Cardano.SlotNo Word64
n) -> Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Word64
n