diff --git a/.github/workflows/integrate.yaml b/.github/workflows/integrate.yaml index 10b425d..662e290 100644 --- a/.github/workflows/integrate.yaml +++ b/.github/workflows/integrate.yaml @@ -56,7 +56,7 @@ jobs: name: mlabs authToken: ${{ secrets.CACHIX_KEY }} - - run: nix run nixpkgs#hlint -- $(git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.hs') + - run: nix run nixpkgs#haskell.packages.ghc921.hlint -- $(git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.hs') name: Run hlint check-build: diff --git a/bench.csv b/bench.csv index a82edf2..a467473 100644 --- a/bench.csv +++ b/bench.csv @@ -1,3 +1,4 @@ name,cpu,mem,size full_scripts:authorityTokenPolicy,1399431,4800,421 -full_scripts:stakePolicy,3662179,12400,1572 +full_scripts:stakePolicy,3751498,12700,1610 +full_scripts:stakeValidator,3126265,10600,1500 diff --git a/flake.nix b/flake.nix index e574172..103fea2 100644 --- a/flake.nix +++ b/flake.nix @@ -76,15 +76,18 @@ let pkgs = nixpkgsFor system; pkgs' = nixpkgsFor' system; + inherit (pkgs.haskell-nix.tools ghcVersion { + inherit (plutarch.tools) fourmolu hlint; + }) + fourmolu hlint; in pkgs.runCommand "format-check" { nativeBuildInputs = [ pkgs'.git pkgs'.fd pkgs'.haskellPackages.cabal-fmt pkgs'.nixpkgs-fmt - (pkgs.haskell-nix.tools ghcVersion { - inherit (plutarch.tools) fourmolu; - }).fourmolu + fourmolu + hlint ]; } '' export LC_CTYPE=C.UTF-8 diff --git a/src/Agora/AuthorityToken.hs b/src/Agora/AuthorityToken.hs index e32906e..041633a 100644 --- a/src/Agora/AuthorityToken.hs +++ b/src/Agora/AuthorityToken.hs @@ -20,7 +20,7 @@ import Prelude -------------------------------------------------------------------------------- -import Agora.Utils (passetClassValueOf, passetClassValueOf') +import Agora.Utils (passert, passetClassValueOf, passetClassValueOf') -------------------------------------------------------------------------------- @@ -46,9 +46,9 @@ authorityTokenPolicy params = ctx <- pletFields @'["txInfo", "purpose"] ctx' PTxInfo txInfo' <- pmatch $ pfromData ctx.txInfo txInfo <- pletFields @'["inputs", "mint"] txInfo' - let inputs = txInfo.inputs :: Term _ (PBuiltinList (PAsData PTxInInfo)) + let inputs = txInfo.inputs let authorityTokenInputs = - pfoldr' + pfoldr' @PBuiltinList ( \txInInfo' acc -> P.do PTxInInfo txInInfo <- pmatch (pfromData txInInfo') PTxOut txOut' <- pmatch $ pfromData $ pfield @"resolved" # txInInfo @@ -60,17 +60,10 @@ authorityTokenPolicy params = # inputs let mintedValue = pfromData txInfo.mint let tokenMoved = 0 #< authorityTokenInputs - PMinting sym' <- pmatch $ pfromData ctx.purpose - let sym = pfromData $ pfield @"_0" # sym' - let mintedATs = passetClassValueOf # sym # pconstant "" # mintedValue + PMinting ownSymbol' <- pmatch $ pfromData ctx.purpose + let ownSymbol = pfromData $ pfield @"_0" # ownSymbol' + let mintedATs = passetClassValueOf # ownSymbol # pconstant "" # mintedValue pif (0 #< mintedATs) - ( pif - tokenMoved - -- The authority token moved, we are good to go for minting. - (pconstant ()) - (ptraceError "Authority token did not move in minting GATs") - ) - -- We minted 0 or less Authority Tokens, we are good to go. - -- Burning is always allowed. + (passert "Authority token did not move in minting GATs" tokenMoved (pconstant ())) (pconstant ()) diff --git a/src/Agora/SafeMoney.hs b/src/Agora/SafeMoney.hs index 6124773..019c179 100644 --- a/src/Agora/SafeMoney.hs +++ b/src/Agora/SafeMoney.hs @@ -85,8 +85,8 @@ valueDiscrete :: valueDiscrete = phoistAcyclic $ plam $ \f -> pcon . Discrete $ - passetClassValueOf # (pconstant $ fromString $ symbolVal $ Proxy @ac) - # (pconstant $ fromString $ symbolVal $ Proxy @n) + passetClassValueOf # pconstant (fromString $ symbolVal $ Proxy @ac) + # pconstant (fromString $ symbolVal $ Proxy @n) # f -- NOTE: discreteValue after valueDiscrete is loses information @@ -103,8 +103,8 @@ discreteValue = phoistAcyclic $ plam $ \f -> pmatch f $ \case Discrete p -> psingletonValue - # (pconstant $ fromString $ symbolVal $ Proxy @ac) - # (pconstant $ fromString $ symbolVal $ Proxy @n) + # pconstant (fromString $ symbolVal $ Proxy @ac) + # pconstant (fromString $ symbolVal $ Proxy @n) # p -- | Create a value with a single asset class diff --git a/src/Agora/SafeMoney/QQ.hs b/src/Agora/SafeMoney/QQ.hs index 8219fa4..35d3d85 100644 --- a/src/Agora/SafeMoney/QQ.hs +++ b/src/Agora/SafeMoney/QQ.hs @@ -34,7 +34,7 @@ discrete :: QuasiQuoter discrete = QuasiQuoter discreteExp errorDiscretePat errorDiscreteType errorDiscreteDiscretelaration discreteConstant :: forall (moneyClass :: MoneyClass) s. Integer -> Term s (Discrete moneyClass) -discreteConstant n = punsafeCoerce ((pconstant n) :: Term s PInteger) +discreteConstant n = punsafeCoerce (pconstant n :: Term s PInteger) fixedToInteger :: Integer -> (Integer, Integer) -> Integer fixedToInteger places (i, f) = i * 10 ^ places + f diff --git a/src/Agora/Stake.hs b/src/Agora/Stake.hs index c9aac0a..f5834a6 100644 --- a/src/Agora/Stake.hs +++ b/src/Agora/Stake.hs @@ -55,14 +55,13 @@ data PStakeAction (gt :: MoneyClass) (s :: S) newtype PStakeDatum (gt :: MoneyClass) (s :: S) = PStakeDatum { getStakeDatum :: - ( Term - s - ( PDataRecord - '[ "stakedAmount" ':= Discrete gt - , "owner" ':= PPubKeyHash - ] - ) - ) + Term + s + ( PDataRecord + '[ "stakedAmount" ':= Discrete gt + , "owner" ':= PPubKeyHash + ] + ) } deriving stock (GHC.Generic) deriving anyclass (Generic) diff --git a/src/Agora/Utils.hs b/src/Agora/Utils.hs index 47160a6..b320339 100644 --- a/src/Agora/Utils.hs +++ b/src/Agora/Utils.hs @@ -144,7 +144,7 @@ psymbolValueOf = PMap value <- pmatch value' m' <- pexpectJust 0 (plookup # pdata sym # value) PMap m <- pmatch (pfromData m') - pfoldr # (plam $ \x v -> (pfromData $ psndBuiltin # x) + v) # 0 # m + pfoldr # plam (\x v -> pfromData (psndBuiltin # x) + v) # 0 # m -- | Extract amount from PValue belonging to a Plutarch-level asset class passetClassValueOf :: @@ -173,20 +173,22 @@ pmapUnionWith = phoistAcyclic $ PMap ys <- pmatch ys' let ls = pmap - # ( plam $ \p -> P.do + # plam + ( \p -> P.do pf <- plet $ pfstBuiltin # p ps <- plet $ psndBuiltin # p pmatch (plookup # pf # ys) $ \case PJust v -> -- Data conversions here are silly, aren't they? - ppairDataBuiltin # pf # (pdata (f # pfromData ps # pfromData v)) + ppairDataBuiltin # pf # pdata (f # pfromData ps # pfromData v) PNothing -> p ) # xs rs = pfilter - # ( plam $ \p -> - pnot # (pany # (plam $ \p' -> pfstBuiltin # p' #== pfstBuiltin # p) # xs) + # plam + ( \p -> + pnot #$ pany # plam (\p' -> pfstBuiltin # p' #== pfstBuiltin # p) # xs ) # ys pcon (PMap $ pconcat # ls # rs) @@ -199,7 +201,7 @@ paddValue = phoistAcyclic $ PValue b <- pmatch b' pcon ( PValue $ - pmapUnionWith # (plam $ \a' b' -> pmapUnionWith # (plam (+)) # a' # b') # a # b + pmapUnionWith # plam (\a' b' -> pmapUnionWith # plam (+) # a' # b') # a # b ) -- | Sum of all value at input @@ -208,12 +210,13 @@ pvalueSpent = phoistAcyclic $ plam $ \txInfo' -> pmatch txInfo' $ \(PTxInfo txInfo) -> pfoldr - # ( plam $ \txInInfo' v -> + # plam + ( \txInInfo' v -> pmatch (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 @@ -225,7 +228,8 @@ pfindTxInByTxOutRef = phoistAcyclic $ plam $ \txOutRef txInfo' -> pmatch txInfo' $ \(PTxInfo txInfo) -> pfindMap - # ( plam $ \txInInfo' -> + # plam + ( \txInInfo' -> plet (pfromData txInInfo') $ \r -> pmatch r $ \(PTxInInfo txInInfo) -> pif @@ -248,7 +252,8 @@ anyOutput = phoistAcyclic $ plam $ \txInfo' predicate -> P.do txInfo <- pletFields @'["outputs"] txInfo' pany - # ( plam $ \txOut'' -> P.do + # plam + ( \txOut'' -> P.do PTxOut txOut' <- pmatch (pfromData txOut'') txOut <- pletFields @'["value", "datumHash", "address"] txOut' PDJust dh <- pmatch txOut.datumHash @@ -269,7 +274,8 @@ anyInput = phoistAcyclic $ plam $ \txInfo' predicate -> P.do txInfo <- pletFields @'["inputs"] txInfo' pany - # ( plam $ \txInInfo'' -> P.do + # plam + ( \txInInfo'' -> P.do PTxInInfo txInInfo' <- pmatch (pfromData txInInfo'') let txOut'' = pfield @"resolved" # txInInfo' PTxOut txOut' <- pmatch (pfromData txOut'')