{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.HardFork.Combinator.Degenerate (
    -- * Pattern synonyms
    BlockConfig (DegenBlockConfig)
  , BlockQuery (DegenQuery)
  , CodecConfig (DegenCodecConfig)
  , ConsensusConfig (DegenConsensusConfig)
  , Either (DegenQueryResult)
  , GenTx (DegenGenTx)
  , HardForkApplyTxErr (DegenApplyTxErr)
  , HardForkBlock (DegenBlock)
  , HardForkEnvelopeErr (DegenOtherHeaderEnvelopeError)
  , HardForkLedgerConfig (DegenLedgerConfig)
  , HardForkLedgerError (DegenLedgerError)
  , Header (DegenHeader)
  , LedgerState (DegenLedgerState)
  , OneEraTipInfo (DegenTipInfo)
  , TopLevelConfig (DegenTopLevelConfig)
  , TxId (DegenGenTxId)
  ) where

import           Data.SOP.Strict
import           Ouroboros.Consensus.Block.Abstract
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.HardFork.Combinator.Abstract.NoHardForks
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.HardFork.Combinator.Embed.Unary
import           Ouroboros.Consensus.HardFork.Combinator.Ledger
import           Ouroboros.Consensus.HardFork.Combinator.Ledger.CommonProtocolParams ()
import           Ouroboros.Consensus.HardFork.Combinator.Ledger.Query
import           Ouroboros.Consensus.HardFork.Combinator.Mempool
import           Ouroboros.Consensus.HardFork.Combinator.Node ()
import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import           Ouroboros.Consensus.HardFork.Combinator.Serialisation.SerialiseDisk ()
import           Ouroboros.Consensus.HardFork.Combinator.Serialisation.SerialiseNodeToClient ()
import           Ouroboros.Consensus.HardFork.Combinator.Serialisation.SerialiseNodeToNode ()
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.TypeFamilyWrappers

{-------------------------------------------------------------------------------
  Simple patterns
-------------------------------------------------------------------------------}

{-# COMPLETE DegenApplyTxErr               #-}
{-# COMPLETE DegenBlock                    #-}
{-# COMPLETE DegenBlockConfig              #-}
{-# COMPLETE DegenCodecConfig              #-}
{-# COMPLETE DegenGenTx                    #-}
{-# COMPLETE DegenGenTxId                  #-}
{-# COMPLETE DegenHeader                   #-}
{-# COMPLETE DegenLedgerError              #-}
{-# COMPLETE DegenLedgerState              #-}
{-# COMPLETE DegenOtherHeaderEnvelopeError #-}
{-# COMPLETE DegenQuery                    #-}
{-# COMPLETE DegenQueryResult              #-}
{-# COMPLETE DegenTipInfo                  #-}

pattern DegenBlock ::
     forall b. NoHardForks b
  => b
  -> HardForkBlock '[b]
pattern $mDegenBlock :: forall {r} {b}.
NoHardForks b =>
HardForkBlock '[b] -> (b -> r) -> ((# #) -> r) -> r
$bDegenBlock :: forall b. NoHardForks b => b -> HardForkBlock '[b]
DegenBlock x <- (project' (Proxy @(I b)) -> x)
  where
    DegenBlock b
x = Proxy (I b) -> b -> HardForkBlock '[b]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(I b)) b
x

pattern DegenHeader ::
     NoHardForks b
  => Header b
  -> Header (HardForkBlock '[b])
pattern $mDegenHeader :: forall {r} {b}.
NoHardForks b =>
Header (HardForkBlock '[b]) -> (Header b -> r) -> ((# #) -> r) -> r
$bDegenHeader :: forall b. NoHardForks b => Header b -> Header (HardForkBlock '[b])
DegenHeader x <- (project -> x)
  where
    DegenHeader Header b
x = Header b -> Header (HardForkBlock '[b])
forall b. NoHardForks b => Header b -> Header (HardForkBlock '[b])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject Header b
x

pattern DegenGenTx ::
     NoHardForks b
  => GenTx b
  -> GenTx (HardForkBlock '[b])
pattern $mDegenGenTx :: forall {r} {b}.
NoHardForks b =>
GenTx (HardForkBlock '[b]) -> (GenTx b -> r) -> ((# #) -> r) -> r
$bDegenGenTx :: forall b. NoHardForks b => GenTx b -> GenTx (HardForkBlock '[b])
DegenGenTx x <- (project -> x)
  where
    DegenGenTx GenTx b
x = GenTx b -> GenTx (HardForkBlock '[b])
forall b. NoHardForks b => GenTx b -> GenTx (HardForkBlock '[b])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject GenTx b
x

pattern DegenGenTxId ::
     forall b. NoHardForks b
  => GenTxId b
  -> GenTxId (HardForkBlock '[b])
pattern $mDegenGenTxId :: forall {r} {b}.
NoHardForks b =>
GenTxId (HardForkBlock '[b])
-> (GenTxId b -> r) -> ((# #) -> r) -> r
$bDegenGenTxId :: forall b.
NoHardForks b =>
GenTxId b -> GenTxId (HardForkBlock '[b])
DegenGenTxId x <- (project' (Proxy @(WrapGenTxId b)) -> x)
  where
    DegenGenTxId GenTxId b
x = Proxy (WrapGenTxId b) -> GenTxId b -> GenTxId (HardForkBlock '[b])
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapGenTxId b)) GenTxId b
x

pattern DegenApplyTxErr ::
     forall b. NoHardForks b
  => ApplyTxErr b
  -> HardForkApplyTxErr '[b] -- ApplyTxErr (HardForkBlock '[b])
pattern $mDegenApplyTxErr :: forall {r} {b}.
NoHardForks b =>
HardForkApplyTxErr '[b] -> (ApplyTxErr b -> r) -> ((# #) -> r) -> r
$bDegenApplyTxErr :: forall b. NoHardForks b => ApplyTxErr b -> HardForkApplyTxErr '[b]
DegenApplyTxErr x <- (project' (Proxy @(WrapApplyTxErr b)) -> x)
  where
    DegenApplyTxErr ApplyTxErr b
x = Proxy (WrapApplyTxErr b) -> ApplyTxErr b -> HardForkApplyTxErr '[b]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapApplyTxErr b)) ApplyTxErr b
x

pattern DegenLedgerError ::
     forall b. NoHardForks b
  => LedgerError b
  -> HardForkLedgerError '[b] -- LedgerError (HardForkBlock '[b])
pattern $mDegenLedgerError :: forall {r} {b}.
NoHardForks b =>
HardForkLedgerError '[b]
-> (LedgerError b -> r) -> ((# #) -> r) -> r
$bDegenLedgerError :: forall b.
NoHardForks b =>
LedgerError b -> HardForkLedgerError '[b]
DegenLedgerError x <- (project' (Proxy @(WrapLedgerErr b)) -> x)
  where
    DegenLedgerError LedgerErr (LedgerState b)
x = Proxy (WrapLedgerErr b)
-> LedgerErr (LedgerState b) -> HardForkLedgerError '[b]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapLedgerErr b)) LedgerErr (LedgerState b)
x

pattern DegenOtherHeaderEnvelopeError ::
     forall b. NoHardForks b
  => OtherHeaderEnvelopeError b
  -> HardForkEnvelopeErr '[b] -- OtherHeaderEnvelopeError (HardForkBlock '[b])
pattern $mDegenOtherHeaderEnvelopeError :: forall {r} {b}.
NoHardForks b =>
HardForkEnvelopeErr '[b]
-> (OtherHeaderEnvelopeError b -> r) -> ((# #) -> r) -> r
$bDegenOtherHeaderEnvelopeError :: forall b.
NoHardForks b =>
OtherHeaderEnvelopeError b -> HardForkEnvelopeErr '[b]
DegenOtherHeaderEnvelopeError x <- (project' (Proxy @(WrapEnvelopeErr b)) -> x)
  where
    DegenOtherHeaderEnvelopeError OtherHeaderEnvelopeError b
x = Proxy (WrapEnvelopeErr b)
-> OtherHeaderEnvelopeError b -> HardForkEnvelopeErr '[b]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapEnvelopeErr b)) OtherHeaderEnvelopeError b
x

pattern DegenTipInfo ::
     forall b. NoHardForks b
  => TipInfo b
  -> OneEraTipInfo '[b] -- TipInfo (HardForkBlock '[b])
pattern $mDegenTipInfo :: forall {r} {b}.
NoHardForks b =>
OneEraTipInfo '[b] -> (TipInfo b -> r) -> ((# #) -> r) -> r
$bDegenTipInfo :: forall b. NoHardForks b => TipInfo b -> OneEraTipInfo '[b]
DegenTipInfo x <- (project' (Proxy @(WrapTipInfo b)) -> x)
  where
    DegenTipInfo TipInfo b
x = Proxy (WrapTipInfo b) -> TipInfo b -> OneEraTipInfo '[b]
forall (proxy :: * -> *) (f :: * -> *) x y blk.
(Isomorphic f, NoHardForks blk, Coercible x (f blk),
 Coercible y (f (HardForkBlock '[blk]))) =>
proxy (f blk) -> x -> y
inject' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(WrapTipInfo b)) TipInfo b
x

pattern DegenQuery ::
     ()
  => HardForkQueryResult '[b] result ~ a
  => BlockQuery b result
  -> BlockQuery (HardForkBlock '[b]) a
pattern $mDegenQuery :: forall {r} {b} {a}.
BlockQuery (HardForkBlock '[b]) a
-> (forall {result}.
    (HardForkQueryResult '[b] result ~ a) =>
    BlockQuery b result -> r)
-> ((# #) -> r)
-> r
$bDegenQuery :: forall b a result.
(HardForkQueryResult '[b] result ~ a) =>
BlockQuery b result -> BlockQuery (HardForkBlock '[b]) a
DegenQuery x <- (projQuery' -> ProjHardForkQuery x)
  where
    DegenQuery BlockQuery b result
x = BlockQuery b result
-> BlockQuery
     (HardForkBlock '[b]) (HardForkQueryResult '[b] result)
forall b result.
BlockQuery b result
-> BlockQuery
     (HardForkBlock '[b]) (HardForkQueryResult '[b] result)
injQuery BlockQuery b result
x

pattern DegenQueryResult ::
     result
  -> HardForkQueryResult '[b] result
pattern $mDegenQueryResult :: forall {r} {result} {b}.
HardForkQueryResult '[b] result
-> (result -> r) -> ((# #) -> r) -> r
$bDegenQueryResult :: forall result b. result -> HardForkQueryResult '[b] result
DegenQueryResult x <- (projQueryResult -> x)
  where
    DegenQueryResult result
x = result -> HardForkQueryResult '[b] result
forall result b. result -> HardForkQueryResult '[b] result
injQueryResult result
x

pattern DegenCodecConfig ::
     NoHardForks b
  => CodecConfig b
  -> CodecConfig (HardForkBlock '[b])
pattern $mDegenCodecConfig :: forall {r} {b}.
NoHardForks b =>
CodecConfig (HardForkBlock '[b])
-> (CodecConfig b -> r) -> ((# #) -> r) -> r
$bDegenCodecConfig :: forall b.
NoHardForks b =>
CodecConfig b -> CodecConfig (HardForkBlock '[b])
DegenCodecConfig x <- (project -> x)
  where
    DegenCodecConfig CodecConfig b
x = CodecConfig b -> CodecConfig (HardForkBlock '[b])
forall b.
NoHardForks b =>
CodecConfig b -> CodecConfig (HardForkBlock '[b])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject CodecConfig b
x

pattern DegenBlockConfig ::
     NoHardForks b
  => BlockConfig b
  -> BlockConfig (HardForkBlock '[b])
pattern $mDegenBlockConfig :: forall {r} {b}.
NoHardForks b =>
BlockConfig (HardForkBlock '[b])
-> (BlockConfig b -> r) -> ((# #) -> r) -> r
$bDegenBlockConfig :: forall b.
NoHardForks b =>
BlockConfig b -> BlockConfig (HardForkBlock '[b])
DegenBlockConfig x <- (project -> x)
  where
    DegenBlockConfig BlockConfig b
x = BlockConfig b -> BlockConfig (HardForkBlock '[b])
forall b.
NoHardForks b =>
BlockConfig b -> BlockConfig (HardForkBlock '[b])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject BlockConfig b
x

pattern DegenLedgerState ::
     NoHardForks b
  => LedgerState b
  -> LedgerState (HardForkBlock '[b])
pattern $mDegenLedgerState :: forall {r} {b}.
NoHardForks b =>
LedgerState (HardForkBlock '[b])
-> (LedgerState b -> r) -> ((# #) -> r) -> r
$bDegenLedgerState :: forall b.
NoHardForks b =>
LedgerState b -> LedgerState (HardForkBlock '[b])
DegenLedgerState x <- (project -> x)
  where
    DegenLedgerState LedgerState b
x = LedgerState b -> LedgerState (HardForkBlock '[b])
forall b.
NoHardForks b =>
LedgerState b -> LedgerState (HardForkBlock '[b])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject LedgerState b
x

{-------------------------------------------------------------------------------
  Dealing with the config

  NOTE: The pattern synonyms for 'ConsensusConfig' and 'LedgerConfig'
  give you a /partial/ config. The pattern synonym for the 'TopLevelConfig'
  /does/ give you a full config.
-------------------------------------------------------------------------------}

{-# COMPLETE DegenConsensusConfig #-}
{-# COMPLETE DegenLedgerConfig    #-}
{-# COMPLETE DegenTopLevelConfig  #-}

pattern DegenConsensusConfig ::
     PartialConsensusConfig (BlockProtocol b)
  -> ConsensusConfig (BlockProtocol (HardForkBlock '[b]))
pattern $mDegenConsensusConfig :: forall {r} {b}.
ConsensusConfig (BlockProtocol (HardForkBlock '[b]))
-> (PartialConsensusConfig (BlockProtocol b) -> r)
-> ((# #) -> r)
-> r
DegenConsensusConfig x <-
    HardForkConsensusConfig {
        hardForkConsensusConfigPerEra = PerEraConsensusConfig
          (   WrapPartialConsensusConfig x
           :* Nil
          )
      }

pattern DegenLedgerConfig ::
     PartialLedgerConfig b
  -> HardForkLedgerConfig '[b] -- LedgerConfig (HardForkBlock '[b])
pattern $mDegenLedgerConfig :: forall {r} {b}.
HardForkLedgerConfig '[b]
-> (PartialLedgerConfig b -> r) -> ((# #) -> r) -> r
DegenLedgerConfig x <-
    HardForkLedgerConfig {
        hardForkLedgerConfigPerEra = PerEraLedgerConfig
          (   WrapPartialLedgerConfig x
           :* Nil
          )
      }

pattern DegenTopLevelConfig ::
     NoHardForks b
  => TopLevelConfig b
  -> TopLevelConfig (HardForkBlock '[b])
pattern $mDegenTopLevelConfig :: forall {r} {b}.
NoHardForks b =>
TopLevelConfig (HardForkBlock '[b])
-> (TopLevelConfig b -> r) -> ((# #) -> r) -> r
$bDegenTopLevelConfig :: forall b.
NoHardForks b =>
TopLevelConfig b -> TopLevelConfig (HardForkBlock '[b])
DegenTopLevelConfig x <- (project -> x)
  where
    DegenTopLevelConfig TopLevelConfig b
x = TopLevelConfig b -> TopLevelConfig (HardForkBlock '[b])
forall b.
NoHardForks b =>
TopLevelConfig b -> TopLevelConfig (HardForkBlock '[b])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject TopLevelConfig b
x