{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-specialize #-}

module Hydra.Contract.HeadState where

import PlutusTx.Prelude

import GHC.Generics (Generic)
import Hydra.Data.ContestationPeriod (ContestationPeriod)
import Hydra.Data.Party (Party)
import PlutusLedgerApi.V2 (CurrencySymbol, POSIXTime, PubKeyHash, TxOutRef)
import PlutusTx qualified
import Text.Show (Show)

type SnapshotNumber = Integer

type Hash = BuiltinByteString

type Signature = BuiltinByteString

data State
  = Initial
      { State -> ContestationPeriod
contestationPeriod :: ContestationPeriod
      , State -> [Party]
parties :: [Party]
      , State -> CurrencySymbol
headId :: CurrencySymbol
      , State -> TxOutRef
seed :: TxOutRef
      }
  | Open
      { contestationPeriod :: ContestationPeriod
      , parties :: [Party]
      , State -> Hash
utxoHash :: Hash
      , headId :: CurrencySymbol
      }
  | Closed
      { parties :: [Party]
      , State -> SnapshotNumber
snapshotNumber :: SnapshotNumber
      , utxoHash :: Hash
      , State -> POSIXTime
contestationDeadline :: POSIXTime
      , contestationPeriod :: ContestationPeriod
      , headId :: CurrencySymbol
      , State -> [PubKeyHash]
contesters :: [PubKeyHash]
      }
  | Final
  deriving stock ((forall x. State -> Rep State x)
-> (forall x. Rep State x -> State) -> Generic State
forall x. Rep State x -> State
forall x. State -> Rep State x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. State -> Rep State x
from :: forall x. State -> Rep State x
$cto :: forall x. Rep State x -> State
to :: forall x. Rep State x -> State
Generic, Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> State -> ShowS
showsPrec :: Int -> State -> ShowS
$cshow :: State -> String
show :: State -> String
$cshowList :: [State] -> ShowS
showList :: [State] -> ShowS
Show)

PlutusTx.unstableMakeIsData ''State

data Input
  = CollectCom
  | Close
      { Input -> [Hash]
signature :: [Signature]
      }
  | Contest
      { signature :: [Signature]
      }
  | Abort
  | Fanout {Input -> SnapshotNumber
numberOfFanoutOutputs :: Integer}
  deriving stock ((forall x. Input -> Rep Input x)
-> (forall x. Rep Input x -> Input) -> Generic Input
forall x. Rep Input x -> Input
forall x. Input -> Rep Input x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Input -> Rep Input x
from :: forall x. Input -> Rep Input x
$cto :: forall x. Rep Input x -> Input
to :: forall x. Rep Input x -> Input
Generic, Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Input -> ShowS
showsPrec :: Int -> Input -> ShowS
$cshow :: Input -> String
show :: Input -> String
$cshowList :: [Input] -> ShowS
showList :: [Input] -> ShowS
Show)

PlutusTx.unstableMakeIsData ''Input