{-# 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           Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
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 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 = forall a. ToJSON a => a -> Value
toJSON
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeLatin1
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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" 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"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slotNo
      , Key
"headerHash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HeaderHash blk
headerHash
      , Key
"blockNo"    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 = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall c. TPraosState c -> WithOrigin SlotNo
Consensus.tpraosStateLastSlot TPraosState StandardCrypto
s
    , Key
"chainDepState" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall c. PraosState c -> WithOrigin SlotNo
Consensus.praosStateLastSlot PraosState StandardCrypto
s
    , Key
"oCertCounters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall c. PraosState c -> Map (KeyHash 'BlockIssuer c) Word64
Consensus.praosStateOCertCounters PraosState StandardCrypto
s
    , Key
"evolvingNonce" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall c. PraosState c -> Nonce
Consensus.praosStateEvolvingNonce PraosState StandardCrypto
s
    , Key
"candidateNonce" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall c. PraosState c -> Nonce
Consensus.praosStateCandidateNonce PraosState StandardCrypto
s
    , Key
"epochNonce" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall c. PraosState c -> Nonce
Consensus.praosStateEpochNonce PraosState StandardCrypto
s
    , Key
"labNonce" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall c. PraosState c -> Nonce
Consensus.praosStateLabNonce PraosState StandardCrypto
s
    , Key
"lastEpochBlockNonce" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= 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) -> forall a. ToJSON a => a -> Value
toJSON Word64
n

-- This instance should be exported from ledger but is currently not,
instance CC.Crypto c => ToJSON (ConwayGenesis c) where
  toJSON :: ConwayGenesis c -> Value
toJSON (ConwayGenesis GenDelegs c
genDelegs) =
    [Pair] -> Value
Aeson.object [Key
"genDelegs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON GenDelegs c
genDelegs]