{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Mock.Node.Abstract
  ( CodecConfig (..)
  , RunMockBlock (..)
  , constructMockNetworkMagic
  ) where

import Data.Hashable (hash)
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (UTCTime (..))
import GHC.Stack
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime (SystemStart (..))
import Ouroboros.Consensus.Config.SupportsNode
import Ouroboros.Consensus.Mock.Ledger.Block
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Network.Magic (NetworkMagic (..))

-- | Protocol specific functionality required to run consensus with mock blocks
class
  ( MockProtocolSpecific c ext
  , EncodeDisk (SimpleBlock c ext) (ChainDepState (BlockProtocol (SimpleBlock c ext)))
  , DecodeDisk (SimpleBlock c ext) (ChainDepState (BlockProtocol (SimpleBlock c ext)))
  ) =>
  RunMockBlock c ext
  where
  mockNetworkMagic ::
    BlockConfig (SimpleBlock c ext) ->
    NetworkMagic

-- | Construct protocol magic ID depending on where in the code this is called
--
-- The sole purpose of this is to make sure that these mock protocols have
-- different IDs from each other and from regular protocols.
constructMockNetworkMagic :: HasCallStack => NetworkMagic
constructMockNetworkMagic :: HasCallStack => NetworkMagic
constructMockNetworkMagic =
  Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> Word32 -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Hashable a => a -> Int
hash (CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack)

instance
  RunMockBlock c ext =>
  ConfigSupportsNode (SimpleBlock c ext)
  where
  getSystemStart :: BlockConfig (SimpleBlock c ext) -> SystemStart
getSystemStart = SystemStart -> BlockConfig (SimpleBlock c ext) -> SystemStart
forall a b. a -> b -> a
const (SystemStart -> BlockConfig (SimpleBlock c ext) -> SystemStart)
-> SystemStart -> BlockConfig (SimpleBlock c ext) -> SystemStart
forall a b. (a -> b) -> a -> b
$ UTCTime -> SystemStart
SystemStart UTCTime
dummyDate
   where
    --  This doesn't matter much
    dummyDate :: UTCTime
dummyDate = Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
2019 Int
8 Int
13) DiffTime
0

  getNetworkMagic :: BlockConfig (SimpleBlock c ext) -> NetworkMagic
getNetworkMagic = BlockConfig (SimpleBlock c ext) -> NetworkMagic
forall c ext.
RunMockBlock c ext =>
BlockConfig (SimpleBlock c ext) -> NetworkMagic
mockNetworkMagic