{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Byron.Ledger.Orphans () where

import qualified Cardano.Chain.Block as CC
import qualified Cardano.Chain.Common as CC
import qualified Cardano.Chain.Delegation as CC
import qualified Cardano.Chain.MempoolPayload as CC
import qualified Cardano.Chain.Update as CC
import qualified Cardano.Chain.UTxO as CC
import           Cardano.Crypto (shortHashF)
import qualified Cardano.Crypto
import           Cardano.Ledger.Binary (Annotated (unAnnotated), fromByronCBOR,
                     toByronCBOR)
import           Codec.Serialise (Serialise, decode, encode)
import           Control.Monad (void)
import           Data.ByteString (ByteString)
import           Data.Coerce
import           Data.Text (unpack)
import           Formatting
import           NoThunks.Class (InspectHeap (..), NoThunks)
import           Ouroboros.Consensus.Util.Condense

{-------------------------------------------------------------------------------
  Serialise
-------------------------------------------------------------------------------}

instance Serialise CC.ChainValidationState where
  encode :: ChainValidationState -> Encoding
encode = ChainValidationState -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR
  decode :: forall s. Decoder s ChainValidationState
decode = Decoder s ChainValidationState
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance Serialise CC.KeyHash where
  encode :: KeyHash -> Encoding
encode = KeyHash -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR
  decode :: forall s. Decoder s KeyHash
decode = Decoder s KeyHash
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

{-------------------------------------------------------------------------------
  Condense
-------------------------------------------------------------------------------}

instance Condense CC.HeaderHash where
  condense :: HeaderHash -> String
condense = Format String (HeaderHash -> String) -> HeaderHash -> String
forall a. Format String a -> a
formatToString Format String (HeaderHash -> String)
forall r. Format r (HeaderHash -> r)
CC.headerHashF

instance Condense (CC.ABlock ByteString) where
  condense :: ABlock ByteString -> String
condense = Text -> String
unpack
           (Text -> String)
-> (ABlock ByteString -> Text) -> ABlock ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format Text ([Tx] -> Text) -> [Tx] -> Text
forall a. Format Text a -> a
sformat Format Text ([Tx] -> Text)
forall a r. Buildable a => Format r (a -> r)
build
           ([Tx] -> Text)
-> (ABlock ByteString -> [Tx]) -> ABlock ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATxPayload ByteString -> [Tx]
forall a. ATxPayload a -> [Tx]
CC.txpTxs
           (ATxPayload ByteString -> [Tx])
-> (ABlock ByteString -> ATxPayload ByteString)
-> ABlock ByteString
-> [Tx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABody ByteString -> ATxPayload ByteString
forall a. ABody a -> ATxPayload a
CC.bodyTxPayload
           (ABody ByteString -> ATxPayload ByteString)
-> (ABlock ByteString -> ABody ByteString)
-> ABlock ByteString
-> ATxPayload ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABlock ByteString -> ABody ByteString
forall a. ABlock a -> ABody a
CC.blockBody

instance Condense (CC.AHeader ByteString) where
  condense :: AHeader ByteString -> String
condense AHeader ByteString
hdr = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [
        String
"( hash: "         String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
condensedHash
      , String
", previousHash: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
condensedPrevHash
      , String
", slot: "         String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
condensedSlot
      , String
", issuer: "       String -> String -> String
forall a. Semigroup a => a -> a -> a
<> VerificationKey -> String
forall a. Condense a => a -> String
condense VerificationKey
issuer
      , String
", delegate: "     String -> String -> String
forall a. Semigroup a => a -> a -> a
<> VerificationKey -> String
forall a. Condense a => a -> String
condense VerificationKey
delegate
      , String
")"
      ]
    where
      psigCert :: ACertificate ByteString
psigCert = ABlockSignature ByteString -> ACertificate ByteString
forall a. ABlockSignature a -> ACertificate a
CC.delegationCertificate (ABlockSignature ByteString -> ACertificate ByteString)
-> ABlockSignature ByteString -> ACertificate ByteString
forall a b. (a -> b) -> a -> b
$ AHeader ByteString -> ABlockSignature ByteString
forall a. AHeader a -> ABlockSignature a
CC.headerSignature AHeader ByteString
hdr
      issuer :: VerificationKey
issuer   = ACertificate ByteString -> VerificationKey
forall a. ACertificate a -> VerificationKey
CC.issuerVK   ACertificate ByteString
psigCert
      delegate :: VerificationKey
delegate = ACertificate ByteString -> VerificationKey
forall a. ACertificate a -> VerificationKey
CC.delegateVK ACertificate ByteString
psigCert
      hdrHash :: HeaderHash
hdrHash  = AHeader ByteString -> HeaderHash
CC.headerHashAnnotated AHeader ByteString
hdr

      condensedHash :: Text
condensedHash     = Format Text (HeaderHash -> Text) -> HeaderHash -> Text
forall a. Format Text a -> a
sformat Format Text (HeaderHash -> Text)
forall r. Format r (HeaderHash -> r)
CC.headerHashF (HeaderHash -> Text) -> HeaderHash -> Text
forall a b. (a -> b) -> a -> b
$ HeaderHash
hdrHash
      condensedPrevHash :: Text
condensedPrevHash = Format Text (HeaderHash -> Text) -> HeaderHash -> Text
forall a. Format Text a -> a
sformat Format Text (HeaderHash -> Text)
forall r. Format r (HeaderHash -> r)
CC.headerHashF (HeaderHash -> Text) -> HeaderHash -> Text
forall a b. (a -> b) -> a -> b
$ AHeader ByteString -> HeaderHash
forall a. AHeader a -> HeaderHash
CC.headerPrevHash AHeader ByteString
hdr
      condensedSlot :: Text
condensedSlot     = Format Text (SlotNumber -> Text) -> SlotNumber -> Text
forall a. Format Text a -> a
sformat Format Text (SlotNumber -> Text)
forall a r. Buildable a => Format r (a -> r)
build (SlotNumber -> Text) -> SlotNumber -> Text
forall a b. (a -> b) -> a -> b
$ Annotated SlotNumber ByteString -> SlotNumber
forall b a. Annotated b a -> b
unAnnotated (AHeader ByteString -> Annotated SlotNumber ByteString
forall a. AHeader a -> Annotated SlotNumber a
CC.aHeaderSlot AHeader ByteString
hdr)

instance Condense (CC.ABoundaryBlock ByteString) where
  condense :: ABoundaryBlock ByteString -> String
condense = ABoundaryHeader ByteString -> String
forall a. Condense a => a -> String
condense (ABoundaryHeader ByteString -> String)
-> (ABoundaryBlock ByteString -> ABoundaryHeader ByteString)
-> ABoundaryBlock ByteString
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABoundaryBlock ByteString -> ABoundaryHeader ByteString
forall a. ABoundaryBlock a -> ABoundaryHeader a
CC.boundaryHeader

instance Condense (CC.ABlockOrBoundary ByteString) where
  condense :: ABlockOrBoundary ByteString -> String
condense (CC.ABOBBlock ABlock ByteString
blk) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [
        String
"( header: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> AHeader ByteString -> String
forall a. Condense a => a -> String
condense (ABlock ByteString -> AHeader ByteString
forall a. ABlock a -> AHeader a
CC.blockHeader ABlock ByteString
blk)
      , String
", body: "   String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ABlock ByteString -> String
forall a. Condense a => a -> String
condense ABlock ByteString
blk
      , String
")"
      ]
  condense (CC.ABOBBoundary ABoundaryBlock ByteString
ebb) =
      ABoundaryBlock ByteString -> String
forall a. Condense a => a -> String
condense ABoundaryBlock ByteString
ebb

instance Condense (CC.ABoundaryHeader ByteString) where
  condense :: ABoundaryHeader ByteString -> String
condense ABoundaryHeader ByteString
hdr = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [
        String
"( ebb: "          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Condense a => a -> String
condense (ABoundaryHeader ByteString -> Word64
forall a. ABoundaryHeader a -> Word64
CC.boundaryEpoch ABoundaryHeader ByteString
hdr)
      , String
", hash: "         String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
condensedHash
      , String
", previousHash: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
condensedPrevHash
      , String
")"
      ]
    where
      condensedHash :: String
condensedHash =
            Text -> String
unpack
          (Text -> String)
-> (ABoundaryHeader ByteString -> Text)
-> ABoundaryHeader ByteString
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format Text (HeaderHash -> Text) -> HeaderHash -> Text
forall a. Format Text a -> a
sformat Format Text (HeaderHash -> Text)
forall r. Format r (HeaderHash -> r)
CC.headerHashF
          (HeaderHash -> Text)
-> (ABoundaryHeader ByteString -> HeaderHash)
-> ABoundaryHeader ByteString
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (ABoundaryHeader ()) -> HeaderHash
forall a b. Coercible a b => a -> b
coerce
          (Hash (ABoundaryHeader ()) -> HeaderHash)
-> (ABoundaryHeader ByteString -> Hash (ABoundaryHeader ()))
-> ABoundaryHeader ByteString
-> HeaderHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABoundaryHeader ByteString
-> Hash (BaseType (ABoundaryHeader ByteString))
ABoundaryHeader ByteString -> Hash (ABoundaryHeader ())
forall t. Decoded t => t -> Hash (BaseType t)
Cardano.Crypto.hashDecoded (ABoundaryHeader ByteString -> Hash (ABoundaryHeader ()))
-> (ABoundaryHeader ByteString -> ABoundaryHeader ByteString)
-> ABoundaryHeader ByteString
-> Hash (ABoundaryHeader ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> ABoundaryHeader ByteString -> ABoundaryHeader ByteString
forall a b. (a -> b) -> ABoundaryHeader a -> ABoundaryHeader b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
CC.wrapBoundaryBytes
          (ABoundaryHeader ByteString -> String)
-> ABoundaryHeader ByteString -> String
forall a b. (a -> b) -> a -> b
$ ABoundaryHeader ByteString
hdr

      condensedPrevHash :: String
condensedPrevHash =
          Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ case ABoundaryHeader ByteString -> Either GenesisHash HeaderHash
forall a. ABoundaryHeader a -> Either GenesisHash HeaderHash
CC.boundaryPrevHash ABoundaryHeader ByteString
hdr of
            Left GenesisHash
_  -> Text
"Genesis"
            Right HeaderHash
h -> Format Text (HeaderHash -> Text) -> HeaderHash -> Text
forall a. Format Text a -> a
sformat Format Text (HeaderHash -> Text)
forall r. Format r (HeaderHash -> r)
CC.headerHashF HeaderHash
h

instance Condense CC.TxId where
  condense :: TxId -> String
condense TxId
hash = String
"txid:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (Format Text (TxId -> Text) -> TxId -> Text
forall a. Format Text a -> a
sformat Format Text (TxId -> Text)
forall r algo a. Format r (AbstractHash algo a -> r)
shortHashF TxId
hash)

instance Condense CC.UpId where
  condense :: UpId -> String
condense UpId
hash = String
"upid:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (Format Text (UpId -> Text) -> UpId -> Text
forall a. Format Text a -> a
sformat Format Text (UpId -> Text)
forall r algo a. Format r (AbstractHash algo a -> r)
shortHashF UpId
hash)

instance Condense CC.CertificateId where
  condense :: CertificateId -> String
condense CertificateId
hash = String
"certificateid: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (Format Text (CertificateId -> Text) -> CertificateId -> Text
forall a. Format Text a -> a
sformat Format Text (CertificateId -> Text)
forall r algo a. Format r (AbstractHash algo a -> r)
shortHashF CertificateId
hash)

instance Condense CC.VoteId where
  condense :: VoteId -> String
condense VoteId
hash = String
"voteid: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (Format Text (VoteId -> Text) -> VoteId -> Text
forall a. Format Text a -> a
sformat Format Text (VoteId -> Text)
forall r algo a. Format r (AbstractHash algo a -> r)
shortHashF VoteId
hash)

instance Condense (CC.AMempoolPayload a) where
    condense :: AMempoolPayload a -> String
condense (CC.MempoolTx ATxAux a
tx) =
      String
"tx: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (Format Text (ATxAux () -> Text) -> ATxAux () -> Text
forall a. Format Text a -> a
sformat Format Text (ATxAux () -> Text)
forall a r. Buildable a => Format r (a -> r)
build (ATxAux a -> ATxAux ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ATxAux a
tx))
    condense (CC.MempoolDlg ACertificate a
cert) =
      String
"dlg: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (Format Text (ACertificate () -> Text) -> ACertificate () -> Text
forall a. Format Text a -> a
sformat Format Text (ACertificate () -> Text)
forall a r. Buildable a => Format r (a -> r)
build (ACertificate a -> ACertificate ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ACertificate a
cert))
    condense (CC.MempoolUpdateProposal AProposal a
p) =
      String
"updateproposal: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (Format Text (AProposal () -> Text) -> AProposal () -> Text
forall a. Format Text a -> a
sformat Format Text (AProposal () -> Text)
forall a r. Buildable a => Format r (a -> r)
build (AProposal a -> AProposal ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void AProposal a
p))
    condense (CC.MempoolUpdateVote AVote a
vote) =
      String
"updatevote: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (Format Text (AVote () -> Text) -> AVote () -> Text
forall a. Format Text a -> a
sformat Format Text (AVote () -> Text)
forall a r. Buildable a => Format r (a -> r)
build (AVote a -> AVote ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void AVote a
vote))

instance Condense Cardano.Crypto.VerificationKey where
  condense :: VerificationKey -> String
condense = Text -> String
unpack (Text -> String)
-> (VerificationKey -> Text) -> VerificationKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format Text (VerificationKey -> Text) -> VerificationKey -> Text
forall a. Format Text a -> a
sformat Format Text (VerificationKey -> Text)
forall a r. Buildable a => Format r (a -> r)
build

{-------------------------------------------------------------------------------
  NoThunks
-------------------------------------------------------------------------------}

-- TODO <https://github.com/input-output-hk/cardano-ledger-byron/issues/685>
--
-- Cardano.Chain.Delegation.Validation.Registration.TooLarge is not exported,
-- but occurs somewhere in CC.ChainValidationError, so we use
-- 'InspectHeap' instead of deriving one using Generics.
deriving via InspectHeap CC.ChainValidationError
  instance NoThunks CC.ChainValidationError