{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Missing instances for standard type classes in the Byron spec
module Ouroboros.Consensus.ByronSpec.Ledger.Orphans () where

import qualified Byron.Spec.Chain.STS.Block as Spec
import qualified Byron.Spec.Chain.STS.Rule.BBody as Spec
import qualified Byron.Spec.Chain.STS.Rule.Bupi as Spec
import qualified Byron.Spec.Chain.STS.Rule.Chain as Spec
import qualified Byron.Spec.Chain.STS.Rule.Epoch as Spec
import qualified Byron.Spec.Chain.STS.Rule.Pbft as Spec
import qualified Byron.Spec.Chain.STS.Rule.SigCnt as Spec
import qualified Byron.Spec.Ledger.Core as Spec
import qualified Byron.Spec.Ledger.Delegation as Spec
import qualified Byron.Spec.Ledger.STS.UTXO as Spec
import qualified Byron.Spec.Ledger.STS.UTXOW as Spec
import qualified Byron.Spec.Ledger.STS.UTXOWS as Spec
import qualified Byron.Spec.Ledger.Update as Spec
import qualified Byron.Spec.Ledger.UTxO as Spec
import           Cardano.Ledger.Binary.Plain (FromCBOR (..), ToCBOR (..),
                     enforceSize)
import           Codec.CBOR.Encoding (encodeListLen)
import           Codec.Serialise
import qualified Control.State.Transition as Spec
import           Data.Bimap (Bimap)
import qualified Data.Bimap as Bimap
import           GHC.Generics (Generic)
import           Test.Cardano.Chain.Elaboration.Block as Spec.Test

{-------------------------------------------------------------------------------
  Serialise

  We just use generic serializers, as this is for testing only anyway.
-------------------------------------------------------------------------------}

instance Serialise Spec.Addr
instance Serialise Spec.ApName
instance Serialise Spec.ApVer
instance Serialise Spec.BkSgnCntT
instance Serialise Spec.Block
instance Serialise Spec.BlockBody
instance Serialise Spec.BlockHeader
instance Serialise Spec.DCert
instance Serialise Spec.DIState
instance Serialise Spec.Epoch
instance Serialise Spec.EpochDiff
instance Serialise Spec.FactorA
instance Serialise Spec.FactorB
instance Serialise Spec.Hash
instance Serialise Spec.Lovelace
instance Serialise Spec.Metadata
instance Serialise Spec.Owner
instance Serialise Spec.PParams
instance Serialise Spec.ProtVer
instance Serialise Spec.Slot
instance Serialise Spec.SlotCount
instance Serialise Spec.SwVer
instance Serialise Spec.TxBody
instance Serialise Spec.TxId
instance Serialise Spec.TxIn
instance Serialise Spec.TxOut
instance Serialise Spec.Tx
instance Serialise Spec.UpAdptThd
instance Serialise Spec.UpdateConstraintViolation
instance Serialise Spec.UpId
instance Serialise Spec.UProp
instance Serialise Spec.UTxO
instance Serialise Spec.UTxOState
instance Serialise Spec.VKey
instance Serialise Spec.VKeyGenesis
instance Serialise Spec.Vote
instance Serialise Spec.Wit

instance Serialise Spec.AddvotePredicateFailure
instance Serialise Spec.AdelegPredicateFailure
instance Serialise Spec.AdelegsPredicateFailure
instance Serialise Spec.ApplyVotesPredicateFailure
instance Serialise Spec.BbodyPredicateFailure
instance Serialise Spec.BupiPredicateFailure
instance Serialise Spec.ChainPredicateFailure
instance Serialise Spec.DelegPredicateFailure
instance Serialise Spec.EpochPredicateFailure
instance Serialise Spec.PbftPredicateFailure
instance Serialise Spec.PvbumpPredicateFailure
instance Serialise Spec.SdelegPredicateFailure
instance Serialise Spec.SdelegsPredicateFailure
instance Serialise Spec.SigcntPredicateFailure
instance Serialise Spec.UpendPredicateFailure
instance Serialise Spec.UpiecPredicateFailure
instance Serialise Spec.UpiendPredicateFailure
instance Serialise Spec.UpiregPredicateFailure
instance Serialise Spec.UpivotePredicateFailure
instance Serialise Spec.UpivotesPredicateFailure
instance Serialise Spec.UppvvPredicateFailure
instance Serialise Spec.UpregPredicateFailure
instance Serialise Spec.UpsvvPredicateFailure
instance Serialise Spec.UpvPredicateFailure
instance Serialise Spec.UpvotePredicateFailure
instance Serialise Spec.UtxoPredicateFailure
instance Serialise Spec.UtxowPredicateFailure
instance Serialise Spec.UtxowsPredicateFailure

instance Serialise a => Serialise (Spec.Sig       a)
instance Serialise a => Serialise (Spec.Threshold a)

{-------------------------------------------------------------------------------
  Test infrastructure
-------------------------------------------------------------------------------}

instance Serialise Spec.Test.AbstractToConcreteIdMaps where
  encode :: AbstractToConcreteIdMaps -> Encoding
encode AbstractToConcreteIdMaps{Map UpId UpId
Map TxId TxId
transactionIds :: Map TxId TxId
proposalIds :: Map UpId UpId
transactionIds :: AbstractToConcreteIdMaps -> Map TxId TxId
proposalIds :: AbstractToConcreteIdMaps -> Map UpId UpId
..} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
        Word -> Encoding
encodeListLen Word
2
      , Map TxId (ToFromCBOR TxId) -> Encoding
forall a. Serialise a => a -> Encoding
encode (TxId -> ToFromCBOR TxId
forall a. a -> ToFromCBOR a
ToFromCBOR (TxId -> ToFromCBOR TxId)
-> Map TxId TxId -> Map TxId (ToFromCBOR TxId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxId TxId
transactionIds)
      , Map UpId (ToFromCBOR UpId) -> Encoding
forall a. Serialise a => a -> Encoding
encode (UpId -> ToFromCBOR UpId
forall a. a -> ToFromCBOR a
ToFromCBOR (UpId -> ToFromCBOR UpId)
-> Map UpId UpId -> Map UpId (ToFromCBOR UpId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map UpId UpId
proposalIds)
      ]

  decode :: forall s. Decoder s AbstractToConcreteIdMaps
decode = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"AbstractToConcreteIdMaps" Int
2
    Map TxId TxId
transactionIds <- (ToFromCBOR TxId -> TxId)
-> Map TxId (ToFromCBOR TxId) -> Map TxId TxId
forall a b. (a -> b) -> Map TxId a -> Map TxId b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ToFromCBOR TxId -> TxId
forall a. ToFromCBOR a -> a
unToFromCBOR (Map TxId (ToFromCBOR TxId) -> Map TxId TxId)
-> Decoder s (Map TxId (ToFromCBOR TxId))
-> Decoder s (Map TxId TxId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map TxId (ToFromCBOR TxId))
forall s. Decoder s (Map TxId (ToFromCBOR TxId))
forall a s. Serialise a => Decoder s a
decode
    Map UpId UpId
proposalIds    <- (ToFromCBOR UpId -> UpId)
-> Map UpId (ToFromCBOR UpId) -> Map UpId UpId
forall a b. (a -> b) -> Map UpId a -> Map UpId b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ToFromCBOR UpId -> UpId
forall a. ToFromCBOR a -> a
unToFromCBOR (Map UpId (ToFromCBOR UpId) -> Map UpId UpId)
-> Decoder s (Map UpId (ToFromCBOR UpId))
-> Decoder s (Map UpId UpId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map UpId (ToFromCBOR UpId))
forall s. Decoder s (Map UpId (ToFromCBOR UpId))
forall a s. Serialise a => Decoder s a
decode
    AbstractToConcreteIdMaps -> Decoder s AbstractToConcreteIdMaps
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbstractToConcreteIdMaps -> Decoder s AbstractToConcreteIdMaps)
-> AbstractToConcreteIdMaps -> Decoder s AbstractToConcreteIdMaps
forall a b. (a -> b) -> a -> b
$ AbstractToConcreteIdMaps{Map UpId UpId
Map TxId TxId
transactionIds :: Map TxId TxId
proposalIds :: Map UpId UpId
transactionIds :: Map TxId TxId
proposalIds :: Map UpId UpId
..}

{-------------------------------------------------------------------------------
  Missing Eq instances

  We require Eq on the block to check common prefix.
-------------------------------------------------------------------------------}

deriving instance Eq Spec.Block
deriving instance Eq Spec.BlockBody

{-------------------------------------------------------------------------------
  Not all types in cardano-ledger-specs have generic instances
-------------------------------------------------------------------------------}

deriving instance Generic Spec.UTxO

deriving instance Generic (Spec.Threshold a)

deriving instance Generic Spec.BbodyPredicateFailure
deriving instance Generic Spec.BupiPredicateFailure
deriving instance Generic Spec.ChainPredicateFailure
deriving instance Generic Spec.EpochPredicateFailure
deriving instance Generic Spec.PbftPredicateFailure
deriving instance Generic Spec.SigcntPredicateFailure

{-------------------------------------------------------------------------------
  Orphans for generic types

  TODO: Unlike the spec types above, this could actually lead to incoherence :/
  TODO: This should move someplace else.
-------------------------------------------------------------------------------}

instance ( Ord k, Ord v
         , Serialise k, Serialise v
         ) => Serialise (Bimap k v) where
  encode :: Bimap k v -> Encoding
encode = [(k, v)] -> Encoding
forall a. Serialise a => a -> Encoding
encode ([(k, v)] -> Encoding)
-> (Bimap k v -> [(k, v)]) -> Bimap k v -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bimap k v -> [(k, v)]
forall a b. Bimap a b -> [(a, b)]
Bimap.toList
  decode :: forall s. Decoder s (Bimap k v)
decode = [(k, v)] -> Bimap k v
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
Bimap.fromList ([(k, v)] -> Bimap k v)
-> Decoder s [(k, v)] -> Decoder s (Bimap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [(k, v)]
forall s. Decoder s [(k, v)]
forall a s. Serialise a => Decoder s a
decode

{-------------------------------------------------------------------------------
  Auxiliary: Cardano.Binary.ToCBOR/FromCBOR to Serialise bridge
-------------------------------------------------------------------------------}

newtype ToFromCBOR a = ToFromCBOR { forall a. ToFromCBOR a -> a
unToFromCBOR :: a }

instance (ToCBOR a, FromCBOR a) => Serialise (ToFromCBOR a) where
  encode :: ToFromCBOR a -> Encoding
encode = a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (a -> Encoding) -> (ToFromCBOR a -> a) -> ToFromCBOR a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToFromCBOR a -> a
forall a. ToFromCBOR a -> a
unToFromCBOR
  decode :: forall s. Decoder s (ToFromCBOR a)
decode = a -> ToFromCBOR a
forall a. a -> ToFromCBOR a
ToFromCBOR (a -> ToFromCBOR a) -> Decoder s a -> Decoder s (ToFromCBOR a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall s. Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR