{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeApplications   #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE TypeOperators      #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-spec-constr #-}
{-# OPTIONS_GHC -g -fplugin-opt PlutusTx.Plugin:coverage-all #-}
{-# LANGUAGE ViewPatterns       #-}
-- | A basic governance contract in Plutus.
module Plutus.Contracts.Governance (
    -- $governance
      contract
    , proposalContract
    , Params(..)
    , Proposal(..)
    , Schema
    , mkTokenName
    , typedValidator
    , mkValidator
    , GovState(..)
    , Law(..)
    , Voting(..)
    , votingValue
    , GovError
    , covIdx
    , covIdx'
    , getLaw
    ) where

import Control.Lens (makeClassyPrisms, review)
import Control.Monad
import Data.Aeson (FromJSON, ToJSON)
import Data.Semigroup (Sum (..))
import Data.String (fromString)
import Data.Text (Text)
import GHC.Generics (Generic)
import Ledger (Address, POSIXTime)
import Ledger.Tx.Constraints (TxConstraints)
import Ledger.Tx.Constraints qualified as Constraints
import Ledger.Tx.Constraints.ValidityInterval qualified as Interval
import Ledger.Typed.Scripts qualified as Scripts
import Plutus.Contract
import Plutus.Contract.StateMachine (AsSMContractError, State (..), StateMachine (..), Void)
import Plutus.Contract.StateMachine qualified as SM
import Plutus.Contract.Test.Coverage.Analysis
import Plutus.Script.Utils.Ada qualified as Ada
import Plutus.Script.Utils.V2.Scripts (MintingPolicyHash)
import Plutus.Script.Utils.V2.Typed.Scripts qualified as V2
import Plutus.Script.Utils.Value (TokenName)
import Plutus.Script.Utils.Value qualified as Value
import PlutusTx qualified
import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.Code
import PlutusTx.Coverage
import PlutusTx.Prelude
import Prelude qualified as Haskell

-- $governance
-- * When the contract starts it produces a number of tokens that represent voting rights.
-- * Holders of those tokens can propose changes to the state of the contract and vote on them.
-- * After a certain period of time the voting ends and the proposal is rejected or accepted.

newtype Law = Law { Law -> BuiltinByteString
unLaw :: BuiltinByteString }
    deriving stock (Law -> Law -> Bool
(Law -> Law -> Bool) -> (Law -> Law -> Bool) -> Eq Law
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Law -> Law -> Bool
$c/= :: Law -> Law -> Bool
== :: Law -> Law -> Bool
$c== :: Law -> Law -> Bool
Haskell.Eq, Int -> Law -> ShowS
[Law] -> ShowS
Law -> String
(Int -> Law -> ShowS)
-> (Law -> String) -> ([Law] -> ShowS) -> Show Law
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Law] -> ShowS
$cshowList :: [Law] -> ShowS
show :: Law -> String
$cshow :: Law -> String
showsPrec :: Int -> Law -> ShowS
$cshowsPrec :: Int -> Law -> ShowS
Haskell.Show, (forall x. Law -> Rep Law x)
-> (forall x. Rep Law x -> Law) -> Generic Law
forall x. Rep Law x -> Law
forall x. Law -> Rep Law x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Law x -> Law
$cfrom :: forall x. Law -> Rep Law x
Generic)
    deriving anyclass ([Law] -> Encoding
[Law] -> Value
Law -> Encoding
Law -> Value
(Law -> Value)
-> (Law -> Encoding)
-> ([Law] -> Value)
-> ([Law] -> Encoding)
-> ToJSON Law
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Law] -> Encoding
$ctoEncodingList :: [Law] -> Encoding
toJSONList :: [Law] -> Value
$ctoJSONList :: [Law] -> Value
toEncoding :: Law -> Encoding
$ctoEncoding :: Law -> Encoding
toJSON :: Law -> Value
$ctoJSON :: Law -> Value
ToJSON, Value -> Parser [Law]
Value -> Parser Law
(Value -> Parser Law) -> (Value -> Parser [Law]) -> FromJSON Law
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Law]
$cparseJSONList :: Value -> Parser [Law]
parseJSON :: Value -> Parser Law
$cparseJSON :: Value -> Parser Law
FromJSON)

-- | The parameters for the proposal contract.
data Proposal = Proposal
    { Proposal -> Law
newLaw         :: Law
    -- ^ The new contents of the law
    , Proposal -> TokenName
tokenName      :: TokenName
    -- ^ The name of the voting tokens. Only voting token owners are allowed to propose changes.
    , Proposal -> POSIXTime
votingDeadline :: POSIXTime
    -- ^ The time when voting ends and the votes are tallied.
    }
    deriving stock (Int -> Proposal -> ShowS
[Proposal] -> ShowS
Proposal -> String
(Int -> Proposal -> ShowS)
-> (Proposal -> String) -> ([Proposal] -> ShowS) -> Show Proposal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Proposal] -> ShowS
$cshowList :: [Proposal] -> ShowS
show :: Proposal -> String
$cshow :: Proposal -> String
showsPrec :: Int -> Proposal -> ShowS
$cshowsPrec :: Int -> Proposal -> ShowS
Haskell.Show, (forall x. Proposal -> Rep Proposal x)
-> (forall x. Rep Proposal x -> Proposal) -> Generic Proposal
forall x. Rep Proposal x -> Proposal
forall x. Proposal -> Rep Proposal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Proposal x -> Proposal
$cfrom :: forall x. Proposal -> Rep Proposal x
Generic)
    deriving anyclass ([Proposal] -> Encoding
[Proposal] -> Value
Proposal -> Encoding
Proposal -> Value
(Proposal -> Value)
-> (Proposal -> Encoding)
-> ([Proposal] -> Value)
-> ([Proposal] -> Encoding)
-> ToJSON Proposal
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Proposal] -> Encoding
$ctoEncodingList :: [Proposal] -> Encoding
toJSONList :: [Proposal] -> Value
$ctoJSONList :: [Proposal] -> Value
toEncoding :: Proposal -> Encoding
$ctoEncoding :: Proposal -> Encoding
toJSON :: Proposal -> Value
$ctoJSON :: Proposal -> Value
ToJSON, Value -> Parser [Proposal]
Value -> Parser Proposal
(Value -> Parser Proposal)
-> (Value -> Parser [Proposal]) -> FromJSON Proposal
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Proposal]
$cparseJSONList :: Value -> Parser [Proposal]
parseJSON :: Value -> Parser Proposal
$cparseJSON :: Value -> Parser Proposal
FromJSON)

data Voting = Voting
    { Voting -> Proposal
proposal :: Proposal
    , Voting -> Map TokenName Bool
votes    :: AssocMap.Map TokenName Bool
    }
    deriving stock (Int -> Voting -> ShowS
[Voting] -> ShowS
Voting -> String
(Int -> Voting -> ShowS)
-> (Voting -> String) -> ([Voting] -> ShowS) -> Show Voting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Voting] -> ShowS
$cshowList :: [Voting] -> ShowS
show :: Voting -> String
$cshow :: Voting -> String
showsPrec :: Int -> Voting -> ShowS
$cshowsPrec :: Int -> Voting -> ShowS
Haskell.Show, (forall x. Voting -> Rep Voting x)
-> (forall x. Rep Voting x -> Voting) -> Generic Voting
forall x. Rep Voting x -> Voting
forall x. Voting -> Rep Voting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Voting x -> Voting
$cfrom :: forall x. Voting -> Rep Voting x
Generic)
    deriving anyclass ([Voting] -> Encoding
[Voting] -> Value
Voting -> Encoding
Voting -> Value
(Voting -> Value)
-> (Voting -> Encoding)
-> ([Voting] -> Value)
-> ([Voting] -> Encoding)
-> ToJSON Voting
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Voting] -> Encoding
$ctoEncodingList :: [Voting] -> Encoding
toJSONList :: [Voting] -> Value
$ctoJSONList :: [Voting] -> Value
toEncoding :: Voting -> Encoding
$ctoEncoding :: Voting -> Encoding
toJSON :: Voting -> Value
$ctoJSON :: Voting -> Value
ToJSON, Value -> Parser [Voting]
Value -> Parser Voting
(Value -> Parser Voting)
-> (Value -> Parser [Voting]) -> FromJSON Voting
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Voting]
$cparseJSONList :: Value -> Parser [Voting]
parseJSON :: Value -> Parser Voting
$cparseJSON :: Value -> Parser Voting
FromJSON)

data GovState = GovState
    { GovState -> Law
law    :: Law
    , GovState -> MintingPolicyHash
mph    :: MintingPolicyHash
    , GovState -> Maybe Voting
voting :: Maybe Voting
    }
    deriving stock (Int -> GovState -> ShowS
[GovState] -> ShowS
GovState -> String
(Int -> GovState -> ShowS)
-> (GovState -> String) -> ([GovState] -> ShowS) -> Show GovState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GovState] -> ShowS
$cshowList :: [GovState] -> ShowS
show :: GovState -> String
$cshow :: GovState -> String
showsPrec :: Int -> GovState -> ShowS
$cshowsPrec :: Int -> GovState -> ShowS
Haskell.Show, (forall x. GovState -> Rep GovState x)
-> (forall x. Rep GovState x -> GovState) -> Generic GovState
forall x. Rep GovState x -> GovState
forall x. GovState -> Rep GovState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GovState x -> GovState
$cfrom :: forall x. GovState -> Rep GovState x
Generic)
    deriving anyclass ([GovState] -> Encoding
[GovState] -> Value
GovState -> Encoding
GovState -> Value
(GovState -> Value)
-> (GovState -> Encoding)
-> ([GovState] -> Value)
-> ([GovState] -> Encoding)
-> ToJSON GovState
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GovState] -> Encoding
$ctoEncodingList :: [GovState] -> Encoding
toJSONList :: [GovState] -> Value
$ctoJSONList :: [GovState] -> Value
toEncoding :: GovState -> Encoding
$ctoEncoding :: GovState -> Encoding
toJSON :: GovState -> Value
$ctoJSON :: GovState -> Value
ToJSON, Value -> Parser [GovState]
Value -> Parser GovState
(Value -> Parser GovState)
-> (Value -> Parser [GovState]) -> FromJSON GovState
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GovState]
$cparseJSONList :: Value -> Parser [GovState]
parseJSON :: Value -> Parser GovState
$cparseJSON :: Value -> Parser GovState
FromJSON)

data GovInput
    = MintTokens [TokenName]
    | ProposeChange Address Proposal
    | AddVote Address TokenName Bool
    | FinishVoting
    | Check
    deriving stock (Int -> GovInput -> ShowS
[GovInput] -> ShowS
GovInput -> String
(Int -> GovInput -> ShowS)
-> (GovInput -> String) -> ([GovInput] -> ShowS) -> Show GovInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GovInput] -> ShowS
$cshowList :: [GovInput] -> ShowS
show :: GovInput -> String
$cshow :: GovInput -> String
showsPrec :: Int -> GovInput -> ShowS
$cshowsPrec :: Int -> GovInput -> ShowS
Haskell.Show, (forall x. GovInput -> Rep GovInput x)
-> (forall x. Rep GovInput x -> GovInput) -> Generic GovInput
forall x. Rep GovInput x -> GovInput
forall x. GovInput -> Rep GovInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GovInput x -> GovInput
$cfrom :: forall x. GovInput -> Rep GovInput x
Generic)
    deriving anyclass ([GovInput] -> Encoding
[GovInput] -> Value
GovInput -> Encoding
GovInput -> Value
(GovInput -> Value)
-> (GovInput -> Encoding)
-> ([GovInput] -> Value)
-> ([GovInput] -> Encoding)
-> ToJSON GovInput
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GovInput] -> Encoding
$ctoEncodingList :: [GovInput] -> Encoding
toJSONList :: [GovInput] -> Value
$ctoJSONList :: [GovInput] -> Value
toEncoding :: GovInput -> Encoding
$ctoEncoding :: GovInput -> Encoding
toJSON :: GovInput -> Value
$ctoJSON :: GovInput -> Value
ToJSON, Value -> Parser [GovInput]
Value -> Parser GovInput
(Value -> Parser GovInput)
-> (Value -> Parser [GovInput]) -> FromJSON GovInput
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GovInput]
$cparseJSONList :: Value -> Parser [GovInput]
parseJSON :: Value -> Parser GovInput
$cparseJSON :: Value -> Parser GovInput
FromJSON)

getLaw :: GovState -> BuiltinByteString
getLaw :: GovState -> BuiltinByteString
getLaw (GovState (Law BuiltinByteString
l) MintingPolicyHash
_ Maybe Voting
_) = BuiltinByteString
l

-- | The endpoints of governance contracts are
--
-- * @new-law@ to create a new law and distribute voting tokens
-- * @add-vote@ to vote on a proposal with the name of the voting token and a boolean to vote in favor or against.
type Schema =
    Endpoint "new-law" Law
        .\/ Endpoint "add-vote" (Address, TokenName, Bool)

-- | The governace contract parameters.
data Params = Params
    { Params -> TokenName
baseTokenName  :: TokenName
    -- ^ The token names that allow voting are generated by adding an increasing number to the base token name. See `mkTokenName`.
    , Params -> [Address]
initialHolders :: [Address]
    -- ^ The public key hashes of the initial holders of the voting tokens.
    , Params -> Integer
requiredVotes  :: Integer
    -- ^ The number of votes in favor required for a proposal to be accepted.
    }

data GovError =
    GovContractError ContractError
    | GovStateMachineError SM.SMContractError
    deriving stock (GovError -> GovError -> Bool
(GovError -> GovError -> Bool)
-> (GovError -> GovError -> Bool) -> Eq GovError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GovError -> GovError -> Bool
$c/= :: GovError -> GovError -> Bool
== :: GovError -> GovError -> Bool
$c== :: GovError -> GovError -> Bool
Haskell.Eq, Int -> GovError -> ShowS
[GovError] -> ShowS
GovError -> String
(Int -> GovError -> ShowS)
-> (GovError -> String) -> ([GovError] -> ShowS) -> Show GovError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GovError] -> ShowS
$cshowList :: [GovError] -> ShowS
show :: GovError -> String
$cshow :: GovError -> String
showsPrec :: Int -> GovError -> ShowS
$cshowsPrec :: Int -> GovError -> ShowS
Haskell.Show, (forall x. GovError -> Rep GovError x)
-> (forall x. Rep GovError x -> GovError) -> Generic GovError
forall x. Rep GovError x -> GovError
forall x. GovError -> Rep GovError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GovError x -> GovError
$cfrom :: forall x. GovError -> Rep GovError x
Generic)
    deriving anyclass ([GovError] -> Encoding
[GovError] -> Value
GovError -> Encoding
GovError -> Value
(GovError -> Value)
-> (GovError -> Encoding)
-> ([GovError] -> Value)
-> ([GovError] -> Encoding)
-> ToJSON GovError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GovError] -> Encoding
$ctoEncodingList :: [GovError] -> Encoding
toJSONList :: [GovError] -> Value
$ctoJSONList :: [GovError] -> Value
toEncoding :: GovError -> Encoding
$ctoEncoding :: GovError -> Encoding
toJSON :: GovError -> Value
$ctoJSON :: GovError -> Value
ToJSON, Value -> Parser [GovError]
Value -> Parser GovError
(Value -> Parser GovError)
-> (Value -> Parser [GovError]) -> FromJSON GovError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GovError]
$cparseJSONList :: Value -> Parser [GovError]
parseJSON :: Value -> Parser GovError
$cparseJSON :: Value -> Parser GovError
FromJSON)

makeClassyPrisms ''GovError

instance AsContractError GovError where
    _ContractError :: p ContractError (f ContractError) -> p GovError (f GovError)
_ContractError = p ContractError (f ContractError) -> p GovError (f GovError)
forall r. AsGovError r => Prism' r ContractError
_GovContractError

instance AsSMContractError GovError where
    _SMContractError :: p SMContractError (f SMContractError) -> p GovError (f GovError)
_SMContractError = p SMContractError (f SMContractError) -> p GovError (f GovError)
forall r. AsGovError r => Prism' r SMContractError
_GovStateMachineError

type GovernanceMachine = StateMachine GovState GovInput

{-# INLINABLE machine #-}
machine :: Params -> GovernanceMachine
machine :: Params -> GovernanceMachine
machine Params
params = Maybe ThreadToken
-> (State GovState
    -> GovInput -> Maybe (TxConstraints Void Void, State GovState))
-> (GovState -> Bool)
-> GovernanceMachine
forall s i.
Maybe ThreadToken
-> (State s -> i -> Maybe (TxConstraints Void Void, State s))
-> (s -> Bool)
-> StateMachine s i
SM.mkStateMachine Maybe ThreadToken
forall a. Maybe a
Nothing (Params
-> State GovState
-> GovInput
-> Maybe (TxConstraints Void Void, State GovState)
transition Params
params) GovState -> Bool
forall p. p -> Bool
isFinal where
    {-# INLINABLE isFinal #-}
    isFinal :: p -> Bool
isFinal p
_ = Bool
False

{-# INLINABLE mkValidator #-}
mkValidator :: Params -> V2.ValidatorType GovernanceMachine
mkValidator :: Params -> ValidatorType GovernanceMachine
mkValidator Params
params = GovernanceMachine -> GovState -> GovInput -> ScriptContext -> Bool
forall s i.
ToData s =>
StateMachine s i -> ValidatorType (StateMachine s i)
SM.mkValidator (GovernanceMachine
 -> GovState -> GovInput -> ScriptContext -> Bool)
-> GovernanceMachine
-> GovState
-> GovInput
-> ScriptContext
-> Bool
forall a b. (a -> b) -> a -> b
$ Params -> GovernanceMachine
machine Params
params

typedValidator :: Params -> V2.TypedValidator GovernanceMachine
typedValidator :: Params -> TypedValidator GovernanceMachine
typedValidator = CompiledCode (Params -> ValidatorType GovernanceMachine)
-> CompiledCode
     (ValidatorType GovernanceMachine -> UntypedValidator)
-> Params
-> TypedValidator GovernanceMachine
forall a param.
Lift DefaultUni param =>
CompiledCode (param -> ValidatorType a)
-> CompiledCode (ValidatorType a -> UntypedValidator)
-> param
-> TypedValidator a
V2.mkTypedValidatorParam @GovernanceMachine
    $$(PlutusTx.compile [|| mkValidator ||])
    $$(PlutusTx.compile [|| wrap ||])
    where
        wrap :: (GovState -> GovInput -> ScriptContext -> Bool) -> UntypedValidator
wrap = (GovState -> GovInput -> ScriptContext -> Bool) -> UntypedValidator
forall sc d r.
(IsScriptContext sc, UnsafeFromData d, UnsafeFromData r) =>
(d -> r -> sc -> Bool) -> UntypedValidator
Scripts.mkUntypedValidator

client :: Params -> SM.StateMachineClient GovState GovInput
client :: Params -> StateMachineClient GovState GovInput
client Params
params = StateMachineInstance GovState GovInput
-> StateMachineClient GovState GovInput
forall state input.
StateMachineInstance state input -> StateMachineClient state input
SM.mkStateMachineClient (StateMachineInstance GovState GovInput
 -> StateMachineClient GovState GovInput)
-> StateMachineInstance GovState GovInput
-> StateMachineClient GovState GovInput
forall a b. (a -> b) -> a -> b
$ GovernanceMachine
-> TypedValidator GovernanceMachine
-> StateMachineInstance GovState GovInput
forall s i.
StateMachine s i
-> TypedValidator (StateMachine s i) -> StateMachineInstance s i
SM.StateMachineInstance (Params -> GovernanceMachine
machine Params
params) (Params -> TypedValidator GovernanceMachine
typedValidator Params
params)

-- | Generate a voting token name by tagging on a number after the base token name.
mkTokenName :: TokenName -> Integer -> TokenName
mkTokenName :: TokenName -> Integer -> TokenName
mkTokenName TokenName
base Integer
ix = String -> TokenName
forall a. IsString a => String -> a
fromString (TokenName -> String
Value.toString TokenName
base String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
Haskell.show Integer
ix)

{-# INLINABLE votingValue #-}
votingValue :: MintingPolicyHash -> TokenName -> Value.Value
votingValue :: MintingPolicyHash -> TokenName -> Value
votingValue MintingPolicyHash
mph TokenName
tokenName =
    CurrencySymbol -> TokenName -> Integer -> Value
Value.singleton (MintingPolicyHash -> CurrencySymbol
Value.mpsSymbol MintingPolicyHash
mph) TokenName
tokenName Integer
1

{-# INLINABLE ownsVotingToken #-}
ownsVotingToken :: Address -> MintingPolicyHash -> TokenName -> TxConstraints Void Void
ownsVotingToken :: Address
-> MintingPolicyHash -> TokenName -> TxConstraints Void Void
ownsVotingToken Address
owner MintingPolicyHash
mph TokenName
tokenName = Address -> Value -> TxConstraints Void Void
forall i o. Address -> Value -> TxConstraints i o
Constraints.mustPayToAddress Address
owner (MintingPolicyHash -> TokenName -> Value
votingValue MintingPolicyHash
mph TokenName
tokenName)

{-# INLINABLE transition #-}
transition :: Params -> State GovState -> GovInput -> Maybe (TxConstraints Void Void, State GovState)
transition :: Params
-> State GovState
-> GovInput
-> Maybe (TxConstraints Void Void, State GovState)
transition Params{Integer
[Address]
TokenName
requiredVotes :: Integer
initialHolders :: [Address]
baseTokenName :: TokenName
requiredVotes :: Params -> Integer
initialHolders :: Params -> [Address]
baseTokenName :: Params -> TokenName
..} State{ stateData :: forall s. State s -> s
stateData = GovState
s, Value
stateValue :: forall s. State s -> Value
stateValue :: Value
stateValue} GovInput
i = case (GovState
s, GovInput
i) of

    (GovState{MintingPolicyHash
mph :: MintingPolicyHash
mph :: GovState -> MintingPolicyHash
mph}, MintTokens [TokenName]
tokenNames) ->
        let (Value
total, TxConstraints Void Void
constraints) = ((Address, TokenName) -> (Value, TxConstraints Void Void))
-> [(Address, TokenName)] -> (Value, TxConstraints Void Void)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                (\(Address
addr, TokenName
nm) -> let v :: Value
v = MintingPolicyHash -> TokenName -> Value
votingValue MintingPolicyHash
mph TokenName
nm in (Value
v, Address -> Value -> TxConstraints Void Void
forall i o. Address -> Value -> TxConstraints i o
Constraints.mustPayToAddress Address
addr Value
v))
                ([Address] -> [TokenName] -> [(Address, TokenName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Address]
initialHolders [TokenName]
tokenNames)
        in (TxConstraints Void Void, State GovState)
-> Maybe (TxConstraints Void Void, State GovState)
forall a. a -> Maybe a
Just (TxConstraints Void Void
constraints TxConstraints Void Void
-> TxConstraints Void Void -> TxConstraints Void Void
forall a. Semigroup a => a -> a -> a
<> Value -> TxConstraints Void Void
forall i o. Value -> TxConstraints i o
Constraints.mustMintValue (Value -> Value
Value.noAdaValue Value
total), GovState -> Value -> State GovState
forall s. s -> Value -> State s
State GovState
s Value
stateValue)

    (GovState Law
law MintingPolicyHash
mph Maybe Voting
Nothing, ProposeChange Address
owner proposal :: Proposal
proposal@Proposal{TokenName
tokenName :: TokenName
tokenName :: Proposal -> TokenName
tokenName}) ->
        let constraints :: TxConstraints Void Void
constraints = Address
-> MintingPolicyHash -> TokenName -> TxConstraints Void Void
ownsVotingToken Address
owner MintingPolicyHash
mph TokenName
tokenName
        in (TxConstraints Void Void, State GovState)
-> Maybe (TxConstraints Void Void, State GovState)
forall a. a -> Maybe a
Just (TxConstraints Void Void
constraints, GovState -> Value -> State GovState
forall s. s -> Value -> State s
State (Law -> MintingPolicyHash -> Maybe Voting -> GovState
GovState Law
law MintingPolicyHash
mph (Voting -> Maybe Voting
forall a. a -> Maybe a
Just (Proposal -> Map TokenName Bool -> Voting
Voting Proposal
proposal Map TokenName Bool
forall k v. Map k v
AssocMap.empty))) Value
stateValue)

    (GovState Law
law MintingPolicyHash
mph (Just (Voting Proposal
p Map TokenName Bool
oldMap)), AddVote Address
owner TokenName
tokenName Bool
vote) ->
        let newMap :: Map TokenName Bool
newMap = TokenName -> Bool -> Map TokenName Bool -> Map TokenName Bool
forall k v. Eq k => k -> v -> Map k v -> Map k v
AssocMap.insert TokenName
tokenName Bool
vote Map TokenName Bool
oldMap
            validityTimeRange :: ValidityInterval POSIXTime
validityTimeRange = POSIXTime -> ValidityInterval POSIXTime
forall a. a -> ValidityInterval a
Interval.lessThan (POSIXTime -> ValidityInterval POSIXTime)
-> POSIXTime -> ValidityInterval POSIXTime
forall a b. (a -> b) -> a -> b
$ Proposal -> POSIXTime
votingDeadline Proposal
p POSIXTime -> POSIXTime -> POSIXTime
forall a. AdditiveGroup a => a -> a -> a
- POSIXTime
1
            constraints :: TxConstraints Void Void
constraints = Address
-> MintingPolicyHash -> TokenName -> TxConstraints Void Void
ownsVotingToken Address
owner MintingPolicyHash
mph TokenName
tokenName
                        TxConstraints Void Void
-> TxConstraints Void Void -> TxConstraints Void Void
forall a. Semigroup a => a -> a -> a
<> ValidityInterval POSIXTime -> TxConstraints Void Void
forall i o. ValidityInterval POSIXTime -> TxConstraints i o
Constraints.mustValidateInTimeRange ValidityInterval POSIXTime
validityTimeRange
        in (TxConstraints Void Void, State GovState)
-> Maybe (TxConstraints Void Void, State GovState)
forall a. a -> Maybe a
Just (TxConstraints Void Void
constraints, GovState -> Value -> State GovState
forall s. s -> Value -> State s
State (Law -> MintingPolicyHash -> Maybe Voting -> GovState
GovState Law
law MintingPolicyHash
mph (Voting -> Maybe Voting
forall a. a -> Maybe a
Just (Proposal -> Map TokenName Bool -> Voting
Voting Proposal
p Map TokenName Bool
newMap))) Value
stateValue)

    (GovState Law
oldLaw MintingPolicyHash
mph (Just (Voting Proposal
p Map TokenName Bool
votes)), GovInput
FinishVoting) ->
        let Sum Integer
ayes = (Bool -> Sum Integer) -> Map TokenName Bool -> Sum Integer
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Bool
b -> Integer -> Sum Integer
forall a. a -> Sum a
Sum (Integer -> Sum Integer) -> Integer -> Sum Integer
forall a b. (a -> b) -> a -> b
$ if Bool
b then Integer
1 else Integer
0) Map TokenName Bool
votes
        in (TxConstraints Void Void, State GovState)
-> Maybe (TxConstraints Void Void, State GovState)
forall a. a -> Maybe a
Just (TxConstraints Void Void
forall a. Monoid a => a
mempty, GovState -> Value -> State GovState
forall s. s -> Value -> State s
State (Law -> MintingPolicyHash -> Maybe Voting -> GovState
GovState (if Integer
ayes Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
requiredVotes then Proposal -> Law
newLaw Proposal
p else Law
oldLaw) MintingPolicyHash
mph Maybe Voting
forall a. Maybe a
Nothing) Value
stateValue)

    (GovState, GovInput)
_ -> Maybe (TxConstraints Void Void, State GovState)
forall a. Maybe a
Nothing

-- | The main contract for creating a new law and for voting on proposals.
contract ::
    AsGovError e
    => Params
    -> Contract () Schema e ()
contract :: Params -> Contract () Schema e ()
contract Params
params = Contract
  ()
  ('R
     '[ "add-vote"
        ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
        "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
  e
  ()
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     e
     ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Contract
   ()
   ('R
      '[ "add-vote"
         ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
         "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
   e
   ()
 -> Contract
      ()
      ('R
         '[ "add-vote"
            ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
            "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
      e
      ())
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     e
     ()
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     e
     ()
forall a b. (a -> b) -> a -> b
$ (GovError -> e)
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     ()
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     e
     ()
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError (AReview e GovError -> GovError -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e GovError
forall r. AsGovError r => Prism' r GovError
_GovError) Contract
  ()
  ('R
     '[ "add-vote"
        ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
        "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
  GovError
  ()
endpoints where
    theClient :: StateMachineClient GovState GovInput
theClient = Params -> StateMachineClient GovState GovInput
client Params
params
    endpoints :: Contract
  ()
  ('R
     '[ "add-vote"
        ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
        "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
  GovError
  ()
endpoints = [Promise
   ()
   ('R
      '[ "add-vote"
         ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
         "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
   GovError
   ()]
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     ()
forall w (s :: Row *) e a. [Promise w s e a] -> Contract w s e a
selectList [Promise
  ()
  ('R
     '[ "add-vote"
        ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
        "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
  GovError
  ()
initLaw, Promise
  ()
  ('R
     '[ "add-vote"
        ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
        "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
  GovError
  ()
addVote]

    addVote :: Promise
  ()
  ('R
     '[ "add-vote"
        ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
        "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
  GovError
  ()
addVote = forall a w (s :: Row *) e b.
(HasEndpoint "add-vote" a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
forall (l :: Symbol) a w (s :: Row *) e b.
(HasEndpoint l a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
endpoint @"add-vote" (((Address, TokenName, Bool)
  -> Contract
       ()
       ('R
          '[ "add-vote"
             ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
             "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
       GovError
       ())
 -> Promise
      ()
      ('R
         '[ "add-vote"
            ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
            "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
      GovError
      ())
-> ((Address, TokenName, Bool)
    -> Contract
         ()
         ('R
            '[ "add-vote"
               ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
               "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
         GovError
         ())
-> Promise
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     ()
forall a b. (a -> b) -> a -> b
$ \(Address
owner, TokenName
tokenName, Bool
vote) ->
        Contract
  ()
  ('R
     '[ "add-vote"
        ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
        "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
  GovError
  (TransitionResult GovState GovInput)
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract
   ()
   ('R
      '[ "add-vote"
         ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
         "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
   GovError
   (TransitionResult GovState GovInput)
 -> Contract
      ()
      ('R
         '[ "add-vote"
            ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
            "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
      GovError
      ())
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     (TransitionResult GovState GovInput)
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     ()
forall a b. (a -> b) -> a -> b
$ StateMachineClient GovState GovInput
-> GovInput
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     (TransitionResult GovState GovInput)
forall w e state (schema :: Row *) input.
(AsSMContractError e, FromData state, ToData state,
 ToData input) =>
StateMachineClient state input
-> input -> Contract w schema e (TransitionResult state input)
SM.runStep StateMachineClient GovState GovInput
theClient (Address -> TokenName -> Bool -> GovInput
AddVote Address
owner TokenName
tokenName Bool
vote)

    initLaw :: Promise
  ()
  ('R
     '[ "add-vote"
        ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
        "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
  GovError
  ()
initLaw = forall a w (s :: Row *) e b.
(HasEndpoint "new-law" a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
forall (l :: Symbol) a w (s :: Row *) e b.
(HasEndpoint l a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
endpoint @"new-law" ((Law
  -> Contract
       ()
       ('R
          '[ "add-vote"
             ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
             "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
       GovError
       ())
 -> Promise
      ()
      ('R
         '[ "add-vote"
            ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
            "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
      GovError
      ())
-> (Law
    -> Contract
         ()
         ('R
            '[ "add-vote"
               ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
               "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
         GovError
         ())
-> Promise
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     ()
forall a b. (a -> b) -> a -> b
$ \Law
law -> do
        let mph :: MintingPolicyHash
mph = TypedValidator GovernanceMachine -> MintingPolicyHash
forall a. TypedValidator a -> MintingPolicyHash
Scripts.forwardingMintingPolicyHash (Params -> TypedValidator GovernanceMachine
typedValidator Params
params)
        Contract
  ()
  ('R
     '[ "add-vote"
        ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
        "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
  GovError
  GovState
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract
   ()
   ('R
      '[ "add-vote"
         ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
         "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
   GovError
   GovState
 -> Contract
      ()
      ('R
         '[ "add-vote"
            ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
            "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
      GovError
      ())
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     GovState
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     ()
forall a b. (a -> b) -> a -> b
$ StateMachineClient GovState GovInput
-> GovState
-> Value
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     GovState
forall w e state (schema :: Row *) input.
(FromData state, ToData state, ToData input,
 AsSMContractError e) =>
StateMachineClient state input
-> state -> Value -> Contract w schema e state
SM.runInitialise StateMachineClient GovState GovInput
theClient (Law -> MintingPolicyHash -> Maybe Voting -> GovState
GovState Law
law MintingPolicyHash
mph Maybe Voting
forall a. Maybe a
Nothing) (Integer -> Value
Ada.lovelaceValueOf Integer
1)
        let tokens :: [TokenName]
tokens = (Address -> Integer -> TokenName)
-> [Address] -> [Integer] -> [TokenName]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Haskell.zipWith ((Integer -> TokenName) -> Address -> Integer -> TokenName
forall a b. a -> b -> a
const (TokenName -> Integer -> TokenName
mkTokenName (Params -> TokenName
baseTokenName Params
params))) (Params -> [Address]
initialHolders Params
params) [Integer
1..]
        Contract
  ()
  ('R
     '[ "add-vote"
        ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
        "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
  GovError
  (TransitionResult GovState GovInput)
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract
   ()
   ('R
      '[ "add-vote"
         ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
         "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
   GovError
   (TransitionResult GovState GovInput)
 -> Contract
      ()
      ('R
         '[ "add-vote"
            ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
            "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
      GovError
      ())
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     (TransitionResult GovState GovInput)
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     ()
forall a b. (a -> b) -> a -> b
$ StateMachineClient GovState GovInput
-> GovInput
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     (TransitionResult GovState GovInput)
forall w e state (schema :: Row *) input.
(AsSMContractError e, FromData state, ToData state,
 ToData input) =>
StateMachineClient state input
-> input -> Contract w schema e (TransitionResult state input)
SM.runStep StateMachineClient GovState GovInput
theClient (GovInput
 -> Contract
      ()
      ('R
         '[ "add-vote"
            ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
            "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
      GovError
      (TransitionResult GovState GovInput))
-> GovInput
-> Contract
     ()
     ('R
        '[ "add-vote"
           ':-> (EndpointValue (Address, TokenName, Bool), ActiveEndpoint),
           "new-law" ':-> (EndpointValue Law, ActiveEndpoint)])
     GovError
     (TransitionResult GovState GovInput)
forall a b. (a -> b) -> a -> b
$ [TokenName] -> GovInput
MintTokens [TokenName]
tokens

-- | The contract for proposing changes to a law.
proposalContract ::
    AsGovError e
    => Params
    -> Address
    -> Proposal
    -> Contract () EmptySchema e ()
proposalContract :: Params -> Address -> Proposal -> Contract () EmptySchema e ()
proposalContract Params
params Address
owner Proposal
proposal = (GovError -> e)
-> Contract () EmptySchema GovError ()
-> Contract () EmptySchema e ()
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError (AReview e GovError -> GovError -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e GovError
forall r. AsGovError r => Prism' r GovError
_GovError) Contract () EmptySchema GovError ()
propose where
    theClient :: StateMachineClient GovState GovInput
theClient = Params -> StateMachineClient GovState GovInput
client Params
params
    propose :: Contract () EmptySchema GovError ()
propose = do
        Contract
  () EmptySchema GovError (TransitionResult GovState GovInput)
-> Contract () EmptySchema GovError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract
   () EmptySchema GovError (TransitionResult GovState GovInput)
 -> Contract () EmptySchema GovError ())
-> Contract
     () EmptySchema GovError (TransitionResult GovState GovInput)
-> Contract () EmptySchema GovError ()
forall a b. (a -> b) -> a -> b
$ StateMachineClient GovState GovInput
-> GovInput
-> Contract
     () EmptySchema GovError (TransitionResult GovState GovInput)
forall w e state (schema :: Row *) input.
(AsSMContractError e, FromData state, ToData state,
 ToData input) =>
StateMachineClient state input
-> input -> Contract w schema e (TransitionResult state input)
SM.runStep StateMachineClient GovState GovInput
theClient (Address -> Proposal -> GovInput
ProposeChange Address
owner Proposal
proposal)

        Text -> Contract () EmptySchema GovError ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Text Text
"Voting started. Waiting for the voting deadline to count the votes."
        Contract () EmptySchema GovError POSIXTime
-> Contract () EmptySchema GovError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract () EmptySchema GovError POSIXTime
 -> Contract () EmptySchema GovError ())
-> Contract () EmptySchema GovError POSIXTime
-> Contract () EmptySchema GovError ()
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Contract () EmptySchema GovError POSIXTime
forall w (s :: Row *) e.
AsContractError e =>
POSIXTime -> Contract w s e POSIXTime
awaitTime (POSIXTime -> Contract () EmptySchema GovError POSIXTime)
-> POSIXTime -> Contract () EmptySchema GovError POSIXTime
forall a b. (a -> b) -> a -> b
$ Proposal -> POSIXTime
votingDeadline Proposal
proposal

        Text -> Contract () EmptySchema GovError ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Text Text
"Voting finished. Counting the votes."
        Contract
  () EmptySchema GovError (TransitionResult GovState GovInput)
-> Contract () EmptySchema GovError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract
   () EmptySchema GovError (TransitionResult GovState GovInput)
 -> Contract () EmptySchema GovError ())
-> Contract
     () EmptySchema GovError (TransitionResult GovState GovInput)
-> Contract () EmptySchema GovError ()
forall a b. (a -> b) -> a -> b
$ StateMachineClient GovState GovInput
-> GovInput
-> Contract
     () EmptySchema GovError (TransitionResult GovState GovInput)
forall w e state (schema :: Row *) input.
(AsSMContractError e, FromData state, ToData state,
 ToData input) =>
StateMachineClient state input
-> input -> Contract w schema e (TransitionResult state input)
SM.runStep StateMachineClient GovState GovInput
theClient GovInput
FinishVoting

PlutusTx.makeLift ''Params
PlutusTx.unstableMakeIsData ''Law
PlutusTx.makeLift ''Law
PlutusTx.unstableMakeIsData ''Proposal
PlutusTx.makeLift ''Proposal
PlutusTx.unstableMakeIsData ''Voting
PlutusTx.makeLift ''Voting
PlutusTx.unstableMakeIsData ''GovState
PlutusTx.makeLift ''GovState
PlutusTx.unstableMakeIsData ''GovInput
PlutusTx.makeLift ''GovInput

covIdx :: CoverageIndex
covIdx :: CoverageIndex
covIdx =  CompiledCode
  (Params -> GovState -> GovInput -> ScriptContext -> Bool)
-> CoverageIndex
forall (uni :: * -> *) fun a.
CompiledCodeIn uni fun a -> CoverageIndex
getCovIdx $$(PlutusTx.compile [|| mkValidator ||])

covIdx' :: CoverageIndex
covIdx' :: CoverageIndex
covIdx' = CompiledCodeIn
  DefaultUni
  DefaultFun
  (Params -> GovState -> GovInput -> ScriptContext -> ())
-> CoverageIndex
forall a. CompiledCodeIn DefaultUni DefaultFun a -> CoverageIndex
computeRefinedCoverageIndex $$(PlutusTx.compile [|| \a b c d -> check (mkValidator a b c d) ||])