{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE PatternSynonyms      #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# 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.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.TypeFamilyWrappers

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 ()

{-------------------------------------------------------------------------------
  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 $bDegenBlock :: b -> HardForkBlock '[b]
$mDegenBlock :: forall r b.
NoHardForks b =>
HardForkBlock '[b] -> (b -> r) -> (Void# -> r) -> r
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' (Proxy (I b)
forall k (t :: k). Proxy t
Proxy @(I b)) b
x

pattern DegenHeader ::
     NoHardForks b
  => Header b
  -> Header (HardForkBlock '[b])
pattern $bDegenHeader :: Header b -> Header (HardForkBlock '[b])
$mDegenHeader :: forall r b.
NoHardForks b =>
Header (HardForkBlock '[b]) -> (Header b -> r) -> (Void# -> r) -> r
DegenHeader x <- (project -> x)
  where
    DegenHeader Header b
x = 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 $bDegenGenTx :: GenTx b -> GenTx (HardForkBlock '[b])
$mDegenGenTx :: forall r b.
NoHardForks b =>
GenTx (HardForkBlock '[b]) -> (GenTx b -> r) -> (Void# -> r) -> r
DegenGenTx x <- (project -> x)
  where
    DegenGenTx GenTx b
x = 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 $bDegenGenTxId :: GenTxId b -> GenTxId (HardForkBlock '[b])
$mDegenGenTxId :: forall r b.
NoHardForks b =>
GenTxId (HardForkBlock '[b])
-> (GenTxId b -> r) -> (Void# -> r) -> r
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' (Proxy (WrapGenTxId b)
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 $bDegenApplyTxErr :: ApplyTxErr b -> HardForkApplyTxErr '[b]
$mDegenApplyTxErr :: forall r b.
NoHardForks b =>
HardForkApplyTxErr '[b] -> (ApplyTxErr b -> r) -> (Void# -> r) -> r
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' (Proxy (WrapApplyTxErr b)
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 $bDegenLedgerError :: LedgerError b -> HardForkLedgerError '[b]
$mDegenLedgerError :: forall r b.
NoHardForks b =>
HardForkLedgerError '[b]
-> (LedgerError b -> r) -> (Void# -> r) -> r
DegenLedgerError x <- (project' (Proxy @(WrapLedgerErr b)) -> x)
  where
    DegenLedgerError LedgerError b
x = Proxy (WrapLedgerErr b)
-> LedgerError 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' (Proxy (WrapLedgerErr b)
forall k (t :: k). Proxy t
Proxy @(WrapLedgerErr b)) LedgerError b
x

pattern DegenOtherHeaderEnvelopeError ::
     forall b. NoHardForks b
  => OtherHeaderEnvelopeError b
  -> HardForkEnvelopeErr '[b] -- OtherHeaderEnvelopeError (HardForkBlock '[b])
pattern $bDegenOtherHeaderEnvelopeError :: OtherHeaderEnvelopeError b -> HardForkEnvelopeErr '[b]
$mDegenOtherHeaderEnvelopeError :: forall r b.
NoHardForks b =>
HardForkEnvelopeErr '[b]
-> (OtherHeaderEnvelopeError b -> r) -> (Void# -> r) -> r
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' (Proxy (WrapEnvelopeErr b)
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 $bDegenTipInfo :: TipInfo b -> OneEraTipInfo '[b]
$mDegenTipInfo :: forall r b.
NoHardForks b =>
OneEraTipInfo '[b] -> (TipInfo b -> r) -> (Void# -> r) -> r
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' (Proxy (WrapTipInfo b)
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 $bDegenQuery :: BlockQuery b result -> BlockQuery (HardForkBlock '[b]) a
$mDegenQuery :: forall r b a.
BlockQuery (HardForkBlock '[b]) a
-> (forall result.
    (HardForkQueryResult '[b] result ~ a) =>
    BlockQuery b result -> r)
-> (Void# -> r)
-> r
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 $bDegenQueryResult :: result -> HardForkQueryResult '[b] result
$mDegenQueryResult :: forall r result b.
HardForkQueryResult '[b] result
-> (result -> r) -> (Void# -> r) -> r
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 $bDegenCodecConfig :: CodecConfig b -> CodecConfig (HardForkBlock '[b])
$mDegenCodecConfig :: forall r b.
NoHardForks b =>
CodecConfig (HardForkBlock '[b])
-> (CodecConfig b -> r) -> (Void# -> r) -> r
DegenCodecConfig x <- (project -> x)
  where
    DegenCodecConfig CodecConfig b
x = 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 $bDegenBlockConfig :: BlockConfig b -> BlockConfig (HardForkBlock '[b])
$mDegenBlockConfig :: forall r b.
NoHardForks b =>
BlockConfig (HardForkBlock '[b])
-> (BlockConfig b -> r) -> (Void# -> r) -> r
DegenBlockConfig x <- (project -> x)
  where
    DegenBlockConfig BlockConfig b
x = 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 $bDegenLedgerState :: LedgerState b -> LedgerState (HardForkBlock '[b])
$mDegenLedgerState :: forall r b.
NoHardForks b =>
LedgerState (HardForkBlock '[b])
-> (LedgerState b -> r) -> (Void# -> r) -> r
DegenLedgerState x <- (project -> x)
  where
    DegenLedgerState LedgerState b
x = 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)
-> (Void# -> 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) -> (Void# -> r) -> r
DegenLedgerConfig x <-
    HardForkLedgerConfig {
        hardForkLedgerConfigPerEra = PerEraLedgerConfig
          (   WrapPartialLedgerConfig x
           :* Nil
          )
      }

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