From b836feaf8028eaaf5109d4e9579860c928fabee0 Mon Sep 17 00:00:00 2001
From: mrBliss <thomas@well-typed.com>
Date: Tue, 16 Jul 2019 14:30:51 +0200
Subject: [PATCH] Remove more trace/output/demo related constraints from
 RunNode (#776)

* Remove more trace/output/demo related constraints from RunNode

Whenever a new constraint was needed in `cardano-node` to trace something, it
was added as a super-class constraint of `RunDemo`, which required updating
the `ouroboros-network` package.

A better approach:

In `cardano-node/Cardano/Node/CLI.hs` in `cardano-node`:

```
type DemoTracing blk =
    ( Condense blk
    , Condense [blk]
    , Condense (ChainHash blk)
    , Condense (Header blk)
    , Condense (HeaderHash blk)
    , Condense (GenTx blk)
    )

data SomeProtocol where
  SomeProtocol :: ( RunDemo blk
                  , DemoTracing blk
                  )
               => Consensus.Protocol blk -> SomeProtocol
```

Add `DemoTracing blk` to `app/Run.hs`:

```
handleSimpleNode :: forall blk. (RunDemo blk, DemoTracing blk)
..
```

Now, whenever you need an additional constraint for tracing/demo purposes,
just add it to `DemoTracing`. No changes to the consensus package will be
needed, unless the constraint is not satisfied for a block type.

* Remove left-over Ouroboros.Consensus.Demo.Ledger.Mock

This should have been removed in #727.
---
 .../Ouroboros/Consensus/Demo/Ledger/Mock.hs   | 61 -------------------
 .../Ouroboros/Consensus/Node/Run/Abstract.hs  |  7 +--
 2 files changed, 1 insertion(+), 67 deletions(-)
 delete mode 100644 ouroboros-consensus/src/Ouroboros/Consensus/Demo/Ledger/Mock.hs

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Demo/Ledger/Mock.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Demo/Ledger/Mock.hs
deleted file mode 100644
index 965b0f9dbcc..00000000000
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Demo/Ledger/Mock.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE UndecidableInstances  #-}
-
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Ouroboros.Consensus.Demo.Ledger.Mock () where
-
-import           Codec.Serialise (Serialise)
-import qualified Codec.Serialise as Serialise
-import           Data.Typeable (Typeable)
-
-import           Cardano.Crypto.Hash
-
-import           Ouroboros.Consensus.Block
-import           Ouroboros.Consensus.Demo.Run
-import           Ouroboros.Consensus.Ledger.Abstract
-import           Ouroboros.Consensus.Ledger.Mock
-import           Ouroboros.Consensus.Protocol.Abstract (ChainState)
-import           Ouroboros.Consensus.Util.Condense
-
-{-------------------------------------------------------------------------------
-  RunDemo instance for the mock ledger
--------------------------------------------------------------------------------}
-
-instance HashAlgorithm h => DemoHeaderHash (Hash h a) where
-  demoEncodeHeaderHash = Serialise.encode
-  demoDecodeHeaderHash = Serialise.decode
-
-instance ( ProtocolLedgerView (SimpleBlock SimpleMockCrypto ext)
-           -- The below constraint seems redundant but is not! When removed,
-           -- some of the tests loop, but only when compiled with @-O2@ ; with
-           -- @-O0@ it is perfectly fine. ghc bug?!
-         , SupportedBlock (SimpleBlock SimpleMockCrypto ext)
-         , Condense ext
-         , Show ext
-         , Typeable ext
-         , Serialise ext
-         , ForgeExt (BlockProtocol (SimpleBlock SimpleMockCrypto ext))
-                    SimpleMockCrypto
-                    ext
-         , Serialise (ChainState (BlockProtocol (SimpleBlock SimpleMockCrypto ext)))
-         ) => RunDemo (SimpleBlock  SimpleMockCrypto ext) where
-  demoForgeBlock         = forgeSimple
-  demoBlockMatchesHeader = matchesSimpleHeader
-  demoBlockFetchSize     = fromIntegral . simpleBlockSize . simpleHeaderStd
-  demoIsEBB              = const False
-  demoEpochSize          = \_ _ -> return 21600
-  demoEncodeBlock        = const Serialise.encode
-  demoEncodeHeader       = const Serialise.encode
-  demoEncodeGenTx        =       Serialise.encode
-  demoEncodeLedgerState  = const Serialise.encode
-  demoEncodeChainState   = const Serialise.encode
-  demoDecodeBlock        = const Serialise.decode
-  demoDecodeHeader       = const Serialise.decode
-  demoDecodeGenTx        =       Serialise.decode
-  demoDecodeLedgerState  = const Serialise.decode
-  demoDecodeChainState   = const Serialise.decode
-  demoMockTx             = \_ -> SimpleGenTx
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Abstract.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Abstract.hs
index cdb9845feba..653755c8d5e 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Abstract.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/Node/Run/Abstract.hs
@@ -26,12 +26,7 @@ import           Ouroboros.Consensus.Protocol.Abstract
 
 import           Ouroboros.Storage.Common (EpochNo, EpochSize)
 
-class ( ProtocolLedgerView blk
-      , ApplyTx blk
-      , Show blk
-      , Show (ApplyTxErr blk)
-      , Show (GenTx blk)
-      ) => RunNode blk where
+class (ProtocolLedgerView blk, ApplyTx blk) => RunNode blk where
 
   nodeForgeBlock         :: (HasNodeState (BlockProtocol blk) m, MonadRandom m)
                          => NodeConfig (BlockProtocol blk)