apply suggestions

agora.cabal

@@ -78,6 +78,7 @@ common lang
     ViewPatterns
     OverloadedRecordDot
     QualifiedDo
+    UndecidableInstances
 
   default-language:   Haskell2010
 

bench/Main.hs

@@ -4,14 +4,24 @@ import Prelude
 
 --------------------------------------------------------------------------------
 
-import Plutarch.Benchmark
 import Plutus.V1.Ledger.Value qualified as Value
 
 --------------------------------------------------------------------------------
 
-import Agora.AuthorityToken qualified as Agora
+import Plutarch.Benchmark
-import Agora.SafeMoney qualified as Agora
+
-import Agora.Stake qualified as Agora
+--------------------------------------------------------------------------------
+
+import Agora.AuthorityToken (
+  AuthorityToken (AuthorityToken),
+  authorityTokenPolicy,
+ )
+import Agora.SafeMoney (LQ)
+import Agora.Stake (
+  Stake (Stake),
+  stakePolicy,
+  stakeValidator,
+ )
 
 --------------------------------------------------------------------------------
 
@@ -23,7 +33,10 @@ benchmarks :: [NamedBenchmark]
 benchmarks =
   benchGroup
     "full_scripts"
-    [ bench "authorityTokenPolicy" $ Agora.authorityTokenPolicy (Agora.AuthorityToken (Value.assetClass "" ""))
+    [ bench "authorityTokenPolicy" $ authorityTokenPolicy authorityToken
-    , bench "stakePolicy" $ Agora.stakePolicy (Agora.Stake @Agora.LQ)
+    , bench "stakePolicy" $ stakePolicy (Stake @LQ)
-    , bench "stakeValidator" $ Agora.stakeValidator (Agora.Stake @Agora.LQ)
+    , bench "stakeValidator" $ stakeValidator (Stake @LQ)
     ]
+
+authorityToken :: AuthorityToken
+authorityToken = AuthorityToken (Value.assetClass "" "")

src/Agora/AuthorityToken.hs

@@ -1,5 +1,8 @@
-{-# LANGUAGE PolyKinds #-}
+{- |
-
+Module     : Agora.AuthorityToken
+Maintainer : emi@haskell.fyi
+Description: Tokens acting as redeemable proofs of DAO authority
+-}
 module Agora.AuthorityToken (
   authorityTokenPolicy,
   AuthorityToken (..),
@@ -28,7 +31,7 @@ import Agora.Utils (passert, passetClassValueOf, passetClassValueOf')
      moved while this token was minted. In effect, this means that
      the validator that locked such a token must have approved
      said transaction. Said validator should be made aware of
-     _this_ token's existence in order to prevent incorrect minting.
+     *this* token's existence in order to prevent incorrect minting.
 -}
 newtype AuthorityToken = AuthorityToken
   { authority :: AssetClass
@@ -37,6 +40,7 @@ newtype AuthorityToken = AuthorityToken
 
 --------------------------------------------------------------------------------
 
+-- | Policy given 'AuthorityToken' params.
 authorityTokenPolicy ::
   AuthorityToken ->
   Term s (PData :--> PScriptContext :--> PUnit)

src/Agora/SafeMoney.hs

@@ -1,33 +1,40 @@
-{-# LANGUAGE PolyKinds #-}
+{- |
-{-# LANGUAGE StandaloneKindSignatures #-}
+Module     : Agora.SafeMoney
-{-# LANGUAGE UndecidableInstances #-}
+Maintainer : emi@haskell.fyi
-{-# OPTIONS_GHC -Wwarn=missing-methods #-}
+Description: Phantom-type protected types for handling money in Plutus
-{-# OPTIONS_GHC -Wwarn=unused-imports #-}
+-}
+module Agora.SafeMoney (
+  -- * Types
+  MoneyClass,
+  PDiscrete,
 
-module Agora.SafeMoney (module Agora.SafeMoney) where
+  -- * Utility functions
+  paddDiscrete,
+
+  -- * Conversions
+  pdiscreteValue,
+  pvalueDiscrete,
+
+  -- * Example MoneyClasses
+  LQ,
+  ADA,
+) where
 
 import Data.Proxy (Proxy (Proxy))
 import Data.String
 import GHC.TypeLits (
-  CmpNat,
-  KnownNat,
   KnownSymbol,
   Nat,
-  SomeNat (..),
-  SomeSymbol (..),
   Symbol,
-  natVal,
-  someNatVal,
-  someSymbolVal,
   symbolVal,
  )
 import Prelude
 
 --------------------------------------------------------------------------------
 
-import Plutarch.Api.V1
+import Plutarch.Api.V1 (PValue)
-import Plutarch.Builtin
+import Plutarch.Builtin ()
-import Plutarch.Internal
+import Plutarch.Internal ()
 import Plutarch.Monadic qualified as P
 
 --------------------------------------------------------------------------------
@@ -46,72 +53,59 @@ type MoneyClass =
     Nat
   )
 
-newtype Discrete (mc :: MoneyClass) (s :: S)
+-- | A PDiscrete amount of currency tagged on the type level with the MoneyClass it belong sto
-  = Discrete (Term s PInteger)
+newtype PDiscrete (mc :: MoneyClass) (s :: S)
-  deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype (Discrete mc) PInteger)
+  = PDiscrete (Term s PInteger)
+  deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype (PDiscrete mc) PInteger)
 
--- In the future, this should use plutarch-numeric
+-- | Add two `PDiscrete` values of the same MoneyClass.
-
+paddDiscrete :: Term s (PDiscrete mc :--> PDiscrete mc :--> PDiscrete mc)
--- | Add two `Discrete` values of the same MoneyClass
-paddDiscrete :: Term s (Discrete mc :--> Discrete mc :--> Discrete mc)
 paddDiscrete = phoistAcyclic $
+  -- In the future, this should use plutarch-numeric
   plam $ \x y -> P.do
-    Discrete x' <- pmatch x
+    PDiscrete x' <- pmatch x
-    Discrete y' <- pmatch y
+    PDiscrete y' <- pmatch y
-    pcon (Discrete $ x' + y')
+    pcon (PDiscrete $ x' + y')
-
-(^*) :: Term s (Discrete mc) -> Term s PInteger -> Term s (Discrete mc)
-(^*) x y = pcon $
-  Discrete . unTermCont $ do
-    Discrete x' <- tcont $ pmatch x
-    pure (x' * y)
 
+-- | The MoneyClass of LQ.
 type LQ :: MoneyClass
 type LQ = '("da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24", "LQ", 6)
 
+-- | The MoneyClass of ADA.
 type ADA :: MoneyClass
 type ADA = '("", "", 6)
 
 --------------------------------------------------------------------------------
 
--- | Downcast a 'PValue' to a 'Discrete' unit
+-- | Downcast a 'PValue' to a 'PDiscrete' unit.
-valueDiscrete ::
+pvalueDiscrete ::
   forall (moneyClass :: MoneyClass) (ac :: Symbol) (n :: Symbol) (scale :: Nat) s.
   ( KnownSymbol ac
   , KnownSymbol n
   , moneyClass ~ '(ac, n, scale)
   ) =>
-  Term s (PValue :--> Discrete moneyClass)
+  Term s (PValue :--> PDiscrete moneyClass)
-valueDiscrete = phoistAcyclic $
+pvalueDiscrete = phoistAcyclic $
   plam $ \f ->
-    pcon . Discrete $
+    pcon . PDiscrete $
       passetClassValueOf # pconstant (fromString $ symbolVal $ Proxy @ac)
         # pconstant (fromString $ symbolVal $ Proxy @n)
         # f
 
--- NOTE: discreteValue after valueDiscrete is loses information
+{- | Get a 'PValue' from a 'PDiscrete'.
-
+NOTE: pdiscreteValue after pvaluePDiscrete is loses information
--- | Get a 'PValue' from a 'Discrete'
+-}
-discreteValue ::
+pdiscreteValue ::
   forall (moneyClass :: MoneyClass) (ac :: Symbol) (n :: Symbol) (scale :: Nat) s.
   ( KnownSymbol ac
   , KnownSymbol n
   , moneyClass ~ '(ac, n, scale)
   ) =>
-  Term s (Discrete moneyClass :--> PValue)
+  Term s (PDiscrete moneyClass :--> PValue)
-discreteValue = phoistAcyclic $
+pdiscreteValue = phoistAcyclic $
   plam $ \f -> pmatch f $ \case
-    Discrete p ->
+    PDiscrete p ->
       psingletonValue
         # pconstant (fromString $ symbolVal $ Proxy @ac)
         # pconstant (fromString $ symbolVal $ Proxy @n)
         # p
-
--- | Create a value with a single asset class
-psingletonValue :: forall s. Term s (PCurrencySymbol :--> PTokenName :--> PInteger :--> PValue)
-psingletonValue = phoistAcyclic $
-  plam $ \sym tok int ->
-    let innerTup = pcon $ PMap $ psingleton #$ ppairDataBuiltin # pdata tok # pdata int
-        outerTup = pcon $ PMap $ psingleton #$ ppairDataBuiltin # pdata sym # pdata innerTup
-        res = pcon $ PValue outerTup
-     in res

src/Agora/SafeMoney/QQ.hs

@@ -1,7 +1,10 @@
 {-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -Wwarn=missing-methods #-}
-{-# OPTIONS_GHC -Wwarn=unused-imports #-}
 
+{- |
+Module     : Agora.SafeMoney.QQ
+Maintainer : emi@haskell.fyi
+Description: Quasiquoter for SafeMoney types
+-}
 module Agora.SafeMoney.QQ (discrete) where
 
 import GHC.Real (Ratio ((:%)))
@@ -28,12 +31,20 @@ import Prelude
 
 import Plutarch.Internal (punsafeCoerce)
 
-import Agora.SafeMoney
+import Agora.SafeMoney (MoneyClass, PDiscrete)
 
+--------------------------------------------------------------------------------
+
+{- | Generate 'PDiscrete' values tagged by a particular MoneyClass
+
+@
+  [discrete| 123.456 ADA |] :: 'Term' s ('PDiscrete' 'ADA')
+@
+-}
 discrete :: QuasiQuoter
 discrete = QuasiQuoter discreteExp errorDiscretePat errorDiscreteType errorDiscreteDiscretelaration
 
-discreteConstant :: forall (moneyClass :: MoneyClass) s. Integer -> Term s (Discrete moneyClass)
+discreteConstant :: forall (moneyClass :: MoneyClass) s. Integer -> Term s (PDiscrete moneyClass)
 discreteConstant n = punsafeCoerce (pconstant n :: Term s PInteger)
 
 fixedToInteger :: Integer -> (Integer, Integer) -> Integer

src/Agora/Stake.hs

@@ -1,8 +1,8 @@
-{-# LANGUAGE DeriveGeneric #-}
+{- |
-{-# LANGUAGE PolyKinds #-}
+Module     : Agora.Stake
-{-# LANGUAGE UndecidableInstances #-}
+Maintainer : emi@haskell.fyi
-
+Description: Vote-lockable stake UTXOs holding GT.
--- | Vote-lockable stake UTXOs holding GT
+-}
 module Agora.Stake (
   PStakeDatum (..),
   PStakeAction (..),
@@ -24,27 +24,52 @@ import Prelude
 --------------------------------------------------------------------------------
 
 import Plutarch (popaque)
-import Plutarch.Api.V1
+import Plutarch.Api.V1 (
+  PCredential (PPubKeyCredential, PScriptCredential),
+  PMintingPolicy,
+  PPubKeyHash,
+  PScriptPurpose (PMinting, PSpending),
+  PValidator,
+  mintingPolicySymbol,
+  mkMintingPolicy,
+ )
 import Plutarch.DataRepr (
   PDataFields,
   PIsDataReprInstances (PIsDataReprInstances),
  )
-import Plutarch.Internal
+import Plutarch.Internal (punsafeCoerce)
 import Plutarch.Monadic qualified as P
 
 --------------------------------------------------------------------------------
 
-import Agora.SafeMoney
+import Agora.SafeMoney (
-import Agora.Utils
+  MoneyClass,
+  PDiscrete,
+  paddDiscrete,
+  pdiscreteValue,
+ )
+import Agora.Utils (
+  anyInput,
+  anyOutput,
+  paddValue,
+  passert,
+  pfindTxInByTxOutRef,
+  psingletonValue,
+  psymbolValueOf,
+  ptxSignedBy,
+  pvalueSpent,
+ )
 
 --------------------------------------------------------------------------------
 
+-- | Parameters for creating Stake scripts.
 data Stake (gt :: MoneyClass) = Stake
 
+-- | Plutarch-level redeemer for Stake scripts.
 data PStakeAction (gt :: MoneyClass) (s :: S)
-  = -- | Deposit or withdraw a discrete amount of the staked governance token
+  = -- | Deposit or withdraw a discrete amount of the staked governance token.
-    PDepositWithdraw (Term s (PDataRecord '["delta" ':= Discrete gt]))
+    PDepositWithdraw (Term s (PDataRecord '["delta" ':= PDiscrete gt]))
-  | -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets
+  | -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets.
     PDestroy (Term s (PDataRecord '[]))
   deriving stock (GHC.Generic)
   deriving anyclass (Generic)
@@ -53,15 +78,10 @@ data PStakeAction (gt :: MoneyClass) (s :: S)
     (PlutusType, PIsData)
     via PIsDataReprInstances (PStakeAction gt)
 
+-- | Plutarch-level datum for Stake scripts.
 newtype PStakeDatum (gt :: MoneyClass) (s :: S) = PStakeDatum
   { getStakeDatum ::
-    Term
+    Term s (PDataRecord '["stakedAmount" ':= PDiscrete gt, "owner" ':= PPubKeyHash])
-      s
-      ( PDataRecord
-          '[ "stakedAmount" ':= Discrete gt
-           , "owner" ':= PPubKeyHash
-           ]
-      )
   }
   deriving stock (GHC.Generic)
   deriving anyclass (Generic)
@@ -71,20 +91,21 @@ newtype PStakeDatum (gt :: MoneyClass) (s :: S) = PStakeDatum
     via (PIsDataReprInstances (PStakeDatum gt))
 
 --------------------------------------------------------------------------------
---
+{- What this Policy does
--- What this Policy does
+
---
+   For minting:
--- For minting:
+     Check that exactly one state thread is minted
---   Check that exactly 1 state thread is minted
+     Check that an output exists with a state thread and a valid datum
---   Check that an output exists with a state thread and a valid datum
+     Check that no state thread is an input
---   Check that no state thread is an input
+     assert TokenName == ValidatorHash of the script that we pay to
---   assert TokenName == ValidatorHash of the script that we pay to
+
---
+   For burning:
--- For burning:
+     Check that exactly one state thread is burned
---   Check that exactly 1 state thread is burned
+     Check that datum at state thread is valid and not locked
---   Check that datum at state thread is valid and not locked
+-}
---
 --------------------------------------------------------------------------------
+
+-- | Policy for Stake state threads
 stakePolicy ::
   forall (gt :: MoneyClass) ac n scale s.
   ( KnownSymbol ac
@@ -148,9 +169,12 @@ stakePolicy _stake =
                             # 1
                     let expectedValue =
                           paddValue
-                            # (discreteValue # stakeDatum.stakedAmount)
+                            # (pdiscreteValue # stakeDatum.stakedAmount)
                             # stValue
-                    let ownerSignsTransaction = ptxSignedBy # ctx.txInfo # stakeDatum.owner
+                    let ownerSignsTransaction =
+                          ptxSignedBy
+                            # ctx.txInfo
+                            # stakeDatum.owner
 
                     -- TODO: Needs to be >=, rather than ==
                     let valueCorrect = pdata value #== pdata expectedValue
@@ -161,6 +185,8 @@ stakePolicy _stake =
     pif (0 #< mintedST) minting burning
 
 --------------------------------------------------------------------------------
+
+-- | Validator intended for Stake UTXOs to live in
 stakeValidator ::
   forall (gt :: MoneyClass) ac n scale s.
   ( KnownSymbol ac
@@ -174,8 +200,12 @@ stakeValidator stake =
     ctx <- pletFields @'["txInfo", "purpose"] ctx'
     txInfo' <- plet ctx.txInfo
     txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo'
-    let stakeAction = punsafeCoerce redeemer :: Term s (PStakeAction gt)
+
-    let stakeDatum' = punsafeCoerce datum :: Term s (PStakeDatum gt)
+    -- Coercion is safe in that if coercion fails we crash hard.
+    let stakeAction :: Term _ (PStakeAction gt)
+        stakeAction = pfromData $ punsafeCoerce redeemer
+        stakeDatum' :: Term _ (PStakeDatum gt)
+        stakeDatum' = pfromData $ punsafeCoerce datum
     stakeDatum <- pletFields @'["owner", "stakedAmount"] stakeDatum'
 
     PSpending txOutRef <- pmatch $ pfromData ctx.purpose
@@ -211,7 +241,7 @@ stakeValidator stake =
               let correctOutputDatum =
                     stakeDatum.owner #== newStakeDatum.owner
                       #&& (paddDiscrete # stakeDatum.stakedAmount # delta) #== newStakeDatum.stakedAmount
-              let expectedValue = paddValue # continuingValue # (discreteValue # delta)
+              let expectedValue = paddValue # continuingValue # (pdiscreteValue # delta)
 
               -- TODO: As above, needs to be >=, rather than ==
               let correctValue = pdata value #== pdata expectedValue

src/Agora/Utils.hs

@@ -1,4 +1,8 @@
--- | Plutarch utility functions that should be upstreamed or don't belong anywhere else
+{- |
+Module     : Agora.Utils
+Maintainer : emi@haskell.fyi
+Description: Plutarch utility functions that should be upstreamed or don't belong anywhere else
+-}
 module Agora.Utils (
   -- * Validator-level utility functions
   passert,
@@ -14,6 +18,7 @@ module Agora.Utils (
   passetClassValueOf,
   passetClassValueOf',
   pfindTxInByTxOutRef,
+  psingletonValue,
   pfindMap,
 
   -- * Functions which should (probably) not be upstreamed
@@ -50,7 +55,7 @@ import Plutarch.Monadic qualified as P
 --------------------------------------------------------------------------------
 -- Validator-level utility functions
 
--- | Assert a particular bool, trace on falsehood. Use in monadic context
+-- | Assert a particular 'PBool', trace if false. Use in monadic context.
 passert :: Term s PString -> Term s PBool -> Term s k -> Term s k
 passert errorMessage check k = pif check k (ptraceError errorMessage)
 
@@ -61,18 +66,20 @@ pfindDatum = phoistAcyclic $
     PTxInfo txInfo' <- pmatch txInfo''
     plookupTuple # datumHash #$ pfield @"data" # txInfo'
 
--- | Find a datum with the given hash. NOTE: this is unsafe in the sense that, if the data layout is wrong, this is UB.
+{- | Find a datum with the given hash.
+NOTE: this is unsafe in the sense that, if the data layout is wrong, this is UB.
+-}
 pfindDatum' :: PIsData a => Term s (PDatumHash :--> PTxInfo :--> PMaybe (PAsData a))
 pfindDatum' = phoistAcyclic $ plam $ \dh x -> punsafeCoerce $ pfindDatum # dh # x
 
--- | Check if a PubKeyHash signs this transaction
+-- | Check if a PubKeyHash signs this transaction.
 ptxSignedBy :: Term s (PTxInfo :--> PAsData PPubKeyHash :--> PBool)
 ptxSignedBy = phoistAcyclic $
   plam $ \txInfo' pkh -> P.do
     txInfo <- pletFields @'["signatories"] txInfo'
     pelem @PBuiltinList # pkh # txInfo.signatories
 
--- | Get the first element that matches a predicate or return Nothing
+-- | Get the first element that matches a predicate or return Nothing.
 pfind' ::
   PIsListLike list a =>
   (Term s a -> Term s PBool) ->
@@ -82,7 +89,7 @@ pfind' p =
     (\self x xs -> pif (p x) (pcon (PJust x)) (self # xs))
     (const $ pcon PNothing)
 
--- | Get the first element that maps to a PJust in a list
+-- | Get the first element that maps to a PJust in a list.
 pfindMap ::
   PIsListLike list a =>
   Term s ((a :--> PMaybe b) :--> list a :--> PMaybe b)
@@ -98,7 +105,7 @@ pfindMap =
         )
         (const $ pcon PNothing)
 
--- | Find the value for a given key in an assoclist
+-- | Find the value for a given key in an associative list.
 plookup ::
   (PEq a, PIsListLike list (PBuiltinPair a b)) =>
   Term s (a :--> list (PBuiltinPair a b) :--> PMaybe b)
@@ -109,7 +116,7 @@ plookup =
         PNothing -> pcon PNothing
         PJust p -> pcon (PJust (psndBuiltin # p))
 
--- | Find the value for a given key in an assoclist which uses 'PTuple's
+-- | Find the value for a given key in an assoclist which uses 'PTuple's.
 plookupTuple ::
   (PEq a, PIsListLike list (PAsData (PTuple a b)), PIsData a, PIsData b) =>
   Term s (a :--> list (PAsData (PTuple a b)) :--> PMaybe b)
@@ -120,7 +127,7 @@ plookupTuple =
         PNothing -> pcon PNothing
         PJust p -> pcon (PJust (pfield @"_1" # pfromData p))
 
--- | Extract a Maybe by providing a default value in case of Just
+-- | Extract a Maybe by providing a default value in case of Just.
 pfromMaybe :: forall a s. Term s (a :--> PMaybe a :--> a)
 pfromMaybe = phoistAcyclic $
   plam $ \e a ->
@@ -128,14 +135,19 @@ pfromMaybe = phoistAcyclic $
       PJust a' -> a'
       PNothing -> e
 
--- | Escape with a particular value on expecting 'Just'. For use in monadic context
+-- | Escape with a particular value on expecting 'Just'. For use in monadic context.
-pexpectJust :: forall r a s. Term s r -> Term s (PMaybe a) -> (Term s a -> Term s r) -> Term s r
+pexpectJust ::
+  forall r a s.
+  Term s r ->
+  Term s (PMaybe a) ->
+  (Term s a -> Term s r) ->
+  Term s r
 pexpectJust escape ma f =
   pmatch ma $ \case
     PJust v -> f v
     PNothing -> escape
 
--- | Get the sum of all values belonging to a particular CurrencySymbol
+-- | Get the sum of all values belonging to a particular CurrencySymbol.
 psymbolValueOf :: Term s (PCurrencySymbol :--> PValue :--> PInteger)
 psymbolValueOf =
   phoistAcyclic $
@@ -146,7 +158,7 @@ psymbolValueOf =
       PMap m <- pmatch (pfromData m')
       pfoldr # plam (\x v -> pfromData (psndBuiltin # x) + v) # 0 # m
 
--- | Extract amount from PValue belonging to a Plutarch-level asset class
+-- | Extract amount from PValue belonging to a Plutarch-level asset class.
 passetClassValueOf ::
   Term s (PCurrencySymbol :--> PTokenName :--> PValue :--> PInteger)
 passetClassValueOf =
@@ -159,12 +171,12 @@ passetClassValueOf =
       v <- pexpectJust 0 (plookup # pdata token # m)
       pfromData v
 
--- | Extract amount from PValue belonging to a Haskell-level AssetClass
+-- | Extract amount from PValue belonging to a Haskell-level AssetClass.
 passetClassValueOf' :: AssetClass -> Term s (PValue :--> PInteger)
 passetClassValueOf' (AssetClass (sym, token)) =
   passetClassValueOf # pconstant sym # pconstant token
 
--- | Union two maps using a merge function on collisions
+-- | Union two maps using a merge function on collisions.
 pmapUnionWith :: forall k v s. PIsData v => Term s ((v :--> v :--> v) :--> PMap k v :--> PMap k v :--> PMap k v)
 pmapUnionWith = phoistAcyclic $
   -- TODO: this function is kinda suspect. I feel like a lot of optimizations could be done here
@@ -204,7 +216,7 @@ paddValue = phoistAcyclic $
           pmapUnionWith # plam (\a' b' -> pmapUnionWith # plam (+) # a' # b') # a # b
       )
 
--- | Sum of all value at input
+-- | Sum of all value at input.
 pvalueSpent :: Term s (PTxInfo :--> PValue)
 pvalueSpent = phoistAcyclic $
   plam $ \txInfo' ->
@@ -216,13 +228,15 @@ pvalueSpent = phoistAcyclic $
                 (pfromData txInInfo')
                 $ \(PTxInInfo txInInfo) ->
                   paddValue
-                    # pmatch (pfield @"resolved" # txInInfo) (\(PTxOut o) -> pfromData $ pfield @"value" # o)
+                    # pmatch
+                      (pfield @"resolved" # txInInfo)
+                      (\(PTxOut o) -> pfromData $ pfield @"value" # o)
                     # v
           )
         # pconstant mempty
         # (pfield @"inputs" # txInfo)
 
--- | Find the TxInInfo by a TxOutRef
+-- | Find the TxInInfo by a TxOutRef.
 pfindTxInByTxOutRef :: Term s (PTxOutRef :--> PTxInfo :--> PMaybe PTxInInfo)
 pfindTxInByTxOutRef = phoistAcyclic $
   plam $ \txOutRef txInfo' ->
@@ -242,7 +256,7 @@ pfindTxInByTxOutRef = phoistAcyclic $
 --------------------------------------------------------------------------------
 -- Functions which should (probably) not be upstreamed
 
--- | Check if any output matches the predicate
+-- | Check if any output matches the predicate.
 anyOutput ::
   forall (datum :: PType) s.
   ( PIsData datum
@@ -264,7 +278,7 @@ anyOutput = phoistAcyclic $
         )
       # pfromData txInfo.outputs
 
--- | Check if any (resolved) input matches the predicate
+-- | Check if any (resolved) input matches the predicate.
 anyInput ::
   forall (datum :: PType) s.
   ( PIsData datum
@@ -287,3 +301,12 @@ anyInput = phoistAcyclic $
               PNothing -> pcon PFalse
         )
       # pfromData txInfo.inputs
+
+-- | Create a value with a single asset class.
+psingletonValue :: forall s. Term s (PCurrencySymbol :--> PTokenName :--> PInteger :--> PValue)
+psingletonValue = phoistAcyclic $
+  plam $ \sym tok int ->
+    let innerTup = pcon $ PMap $ psingleton #$ ppairDataBuiltin # pdata tok # pdata int
+        outerTup = pcon $ PMap $ psingleton #$ ppairDataBuiltin # pdata sym # pdata innerTup
+        res = pcon $ PValue outerTup
+     in res

src/Agora/Voting.hs

@@ -1,4 +1,11 @@
--- | Types for votes and vote counting
+{- |
-module Agora.Voting (Vote (..)) where
+Module     : Agora.Voting
+Maintainer : emi@haskell.fyi
+Description: Types for votes and vote counting
+-}
+module Agora.Voting (
+  Vote (..),
+) where
 
+-- | Type representing direction of vote.
 data Vote = InFavorOf | OpposedTo