{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE PatternSynonyms     #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}

-- | Intended for qualified import
--
-- > import Ouroboros.Consensus.Fragment.Validated (ValidatedFragment)
-- > import qualified Ouroboros.Consensus.Fragment.Validated as VF
module Ouroboros.Consensus.Fragment.Validated (
    ValidatedFragment (ValidatedFragment)
  , validatedFragment
  , validatedLedger
  , validatedTip
  ) where

import           GHC.Stack

import           Ouroboros.Network.AnchoredFragment (AnchoredFragment)
import qualified Ouroboros.Network.AnchoredFragment as AF

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Util.Assert

-- | Validated chain fragment along with the ledger state after validation
--
-- INVARIANT:
--
-- > AF.headPoint validatedFragment == ledgerTipPoint validatedLedger
data ValidatedFragment b l = UnsafeValidatedFragment {
      -- | Chain fragment
      ValidatedFragment b l -> AnchoredFragment b
validatedFragment :: !(AnchoredFragment b)

      -- | Ledger after after validation
    , ValidatedFragment b l -> l
validatedLedger   :: !l
    }
  deriving (a -> ValidatedFragment b b -> ValidatedFragment b a
(a -> b) -> ValidatedFragment b a -> ValidatedFragment b b
(forall a b.
 (a -> b) -> ValidatedFragment b a -> ValidatedFragment b b)
-> (forall a b.
    a -> ValidatedFragment b b -> ValidatedFragment b a)
-> Functor (ValidatedFragment b)
forall a b. a -> ValidatedFragment b b -> ValidatedFragment b a
forall a b.
(a -> b) -> ValidatedFragment b a -> ValidatedFragment b b
forall b a b. a -> ValidatedFragment b b -> ValidatedFragment b a
forall b a b.
(a -> b) -> ValidatedFragment b a -> ValidatedFragment b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ValidatedFragment b b -> ValidatedFragment b a
$c<$ :: forall b a b. a -> ValidatedFragment b b -> ValidatedFragment b a
fmap :: (a -> b) -> ValidatedFragment b a -> ValidatedFragment b b
$cfmap :: forall b a b.
(a -> b) -> ValidatedFragment b a -> ValidatedFragment b b
Functor)

{-# COMPLETE ValidatedFragment #-}

pattern ValidatedFragment ::
     (IsLedger l, HasHeader b, HeaderHash b ~ HeaderHash l, HasCallStack)
  => AnchoredFragment b -> l -> ValidatedFragment b l
pattern $bValidatedFragment :: AnchoredFragment b -> l -> ValidatedFragment b l
$mValidatedFragment :: forall r l b.
(IsLedger l, HasHeader b, HeaderHash b ~ HeaderHash l,
 HasCallStack) =>
ValidatedFragment b l
-> (AnchoredFragment b -> l -> r) -> (Void# -> r) -> r
ValidatedFragment f l <- UnsafeValidatedFragment f l
  where
    ValidatedFragment AnchoredFragment b
f l
l = AnchoredFragment b -> l -> ValidatedFragment b l
forall l b.
(IsLedger l, HasHeader b, HeaderHash b ~ HeaderHash l,
 HasCallStack) =>
AnchoredFragment b -> l -> ValidatedFragment b l
new AnchoredFragment b
f l
l

validatedTip :: HasHeader b => ValidatedFragment b l -> Point b
validatedTip :: ValidatedFragment b l -> Point b
validatedTip = AnchoredFragment b -> Point b
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint (AnchoredFragment b -> Point b)
-> (ValidatedFragment b l -> AnchoredFragment b)
-> ValidatedFragment b l
-> Point b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatedFragment b l -> AnchoredFragment b
forall b l. ValidatedFragment b l -> AnchoredFragment b
validatedFragment

invariant ::
     forall l b.
     (IsLedger l, HasHeader b, HeaderHash b ~ HeaderHash l)
  => ValidatedFragment b l
  -> Either String ()
invariant :: ValidatedFragment b l -> Either String ()
invariant (ValidatedFragment AnchoredFragment b
fragment l
ledger)
    | Point b
ledgerTip Point b -> Point b -> Bool
forall a. Eq a => a -> a -> Bool
/= Point b
headPoint
    = String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
          String
"ledger tip "
        , Point b -> String
forall a. Show a => a -> String
show Point b
ledgerTip
        , String
" /= head point "
        , Point b -> String
forall a. Show a => a -> String
show Point b
headPoint
        ]
    | Bool
otherwise
    = () -> Either String ()
forall a b. b -> Either a b
Right ()
  where
   ledgerTip, headPoint :: Point b
   ledgerTip :: Point b
ledgerTip = Point l -> Point b
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point l -> Point b) -> Point l -> Point b
forall a b. (a -> b) -> a -> b
$ l -> Point l
forall l. GetTip l => l -> Point l
getTip l
ledger
   headPoint :: Point b
headPoint = Point b -> Point b
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point b -> Point b) -> Point b -> Point b
forall a b. (a -> b) -> a -> b
$ AnchoredFragment b -> Point b
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment b
fragment

-- | Constructor for 'ValidatedFragment' that checks the invariant
new ::
     forall l b.
     (IsLedger l, HasHeader b, HeaderHash b ~ HeaderHash l, HasCallStack)
  => AnchoredFragment b
  -> l
  -> ValidatedFragment b l
new :: AnchoredFragment b -> l -> ValidatedFragment b l
new AnchoredFragment b
fragment l
ledger =
    Either String () -> ValidatedFragment b l -> ValidatedFragment b l
forall a. HasCallStack => Either String () -> a -> a
assertWithMsg (ValidatedFragment b l -> Either String ()
forall l b.
(IsLedger l, HasHeader b, HeaderHash b ~ HeaderHash l) =>
ValidatedFragment b l -> Either String ()
invariant ValidatedFragment b l
validated) (ValidatedFragment b l -> ValidatedFragment b l)
-> ValidatedFragment b l -> ValidatedFragment b l
forall a b. (a -> b) -> a -> b
$
      ValidatedFragment b l
validated
  where
    validated :: ValidatedFragment b l
    validated :: ValidatedFragment b l
validated = UnsafeValidatedFragment :: forall b l. AnchoredFragment b -> l -> ValidatedFragment b l
UnsafeValidatedFragment {
          validatedFragment :: AnchoredFragment b
validatedFragment = AnchoredFragment b
fragment
        , validatedLedger :: l
validatedLedger   = l
ledger
        }