{-# OPTIONS_GHC -Wno-orphans #-}

module Hydra.Cardano.Api.ChainPoint where

import Hydra.Cardano.Api.Prelude

import Hydra.Cardano.Api.BlockHeader (genBlockHeaderHash)
import Test.QuickCheck (frequency)

-- | Get the chain point corresponding to a given 'BlockHeader'.
getChainPoint :: BlockHeader -> ChainPoint
getChainPoint :: BlockHeader -> ChainPoint
getChainPoint BlockHeader
header =
  SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint SlotNo
slotNo Hash BlockHeader
headerHash
 where
  (BlockHeader SlotNo
slotNo Hash BlockHeader
headerHash BlockNo
_) = BlockHeader
header

-- * Generators

-- | Generate a chain point with a likely invalid block header hash.
genChainPoint :: Gen ChainPoint
genChainPoint :: Gen ChainPoint
genChainPoint =
  [(Int, Gen ChainPoint)] -> Gen ChainPoint
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
1, ChainPoint -> Gen ChainPoint
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainPoint
ChainPointAtGenesis)
    , (Int
5, Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen Word64 -> (Word64 -> Gen ChainPoint) -> Gen ChainPoint
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SlotNo -> Gen ChainPoint
genChainPointAt (SlotNo -> Gen ChainPoint)
-> (Word64 -> SlotNo) -> Word64 -> Gen ChainPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo)
    ]

-- | Generate a chain point at given slot with a likely invalid block header hash.
genChainPointAt :: SlotNo -> Gen ChainPoint
genChainPointAt :: SlotNo -> Gen ChainPoint
genChainPointAt SlotNo
s =
  SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint SlotNo
s (Hash BlockHeader -> ChainPoint)
-> Gen (Hash BlockHeader) -> Gen ChainPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash BlockHeader)
genBlockHeaderHash

-- * Orphans

instance Arbitrary ChainPoint where
  arbitrary :: Gen ChainPoint
arbitrary = Gen ChainPoint
genChainPoint