Skip to content

Commit d2cc9b6

Browse files
Man-JainMan-Jain
authored
Merge pull request #4 from dOrgTech/lambda-patch
Fix Froze Extra value bug
2 parents 99c2271 + 7d60e8b commit d2cc9b6

File tree

24 files changed

+200
-102
lines changed

24 files changed

+200
-102
lines changed

‎ligo/haskell/baseDAO-ligo-meta.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -233,6 +233,7 @@ test-suite baseDAO-test
233233
Test.Ligo.RegistryDAO.Tests.Common
234234
Test.Ligo.RegistryDAO.Tests.EmptyProposal
235235
Test.Ligo.RegistryDAO.Tests.ExecuteWonProposal
236+
Test.Ligo.RegistryDAO.Tests.FlushConfigUpdates
236237
Test.Ligo.RegistryDAO.Tests.FlushRegistryUpdates
237238
Test.Ligo.RegistryDAO.Tests.FlushTransferProposal
238239
Test.Ligo.RegistryDAO.Tests.LargeProposal

‎ligo/haskell/src/Ligo/BaseDAO/LambdaDAO/Types.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -124,8 +124,7 @@ instance Buildable HandlerInfo where
124124
build = genericF
125125

126126
customGeneric "LambdaExtra" ligoLayout
127-
-- TODO [morley#922]: remove droRecursive=False here
128-
deriveRPCWithOptions "LambdaExtra" def{droStrategy=ligoLayout, droRecursive=False}
127+
deriveRPCWithOptions "LambdaExtra" def{droStrategy=ligoLayout}
129128
deriving anyclass instance IsoValue LambdaExtra
130129

131130
instance HasAnnotation LambdaExtra where

‎ligo/haskell/src/Ligo/BaseDAO/RegistryDAO/Types.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -78,8 +78,7 @@ instance Default RegistryExtra where
7878
def = RegistryExtra (mkBigMap @(Map RegistryKey RegistryValue) M.empty) (mkBigMap @(Map RegistryKey ProposalKey) M.empty) S.empty 1 0 1000 1 1 zeroMutez [tz|1u|]
7979

8080
customGeneric "RegistryExtra" ligoLayout
81-
-- TODO [morley#922]: remove droRecursive=False here
82-
deriveRPCWithOptions "RegistryExtra" def{droStrategy=ligoLayout, droRecursive=False}
81+
deriveRPCWithOptions "RegistryExtra" def{droStrategy=ligoLayout}
8382

8483
instance Buildable RegistryExtra where
8584
build = genericF

‎ligo/haskell/src/Ligo/BaseDAO/TreasuryDAO/Types.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -45,4 +45,3 @@ instance Buildable TreasuryExtra where
4545

4646
instance HasRPCRepr TreasuryExtra where
4747
type AsRPC TreasuryExtra = TreasuryExtra
48-

‎ligo/haskell/src/Ligo/BaseDAO/Types.hs

Lines changed: 6 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -95,15 +95,15 @@ import Lorentz hiding (div, now)
9595
import Lorentz.Annotation ()
9696
import Lorentz.Contracts.Spec.FA2Interface qualified as FA2
9797
import Lorentz.Contracts.Spec.TZIP16Interface qualified as TZIP16
98-
import Morley.AsRPC (HasRPCRepr(..), deriveRPCWithOptions, DeriveRPCOptions(..))
98+
import Morley.AsRPC (DeriveRPCOptions(..), HasRPCRepr(..), deriveRPCWithOptions, deriveRPC)
9999
import Morley.Michelson.Typed.Annotation
100100
import Morley.Michelson.Typed.Scope
101101
(HasNoBigMap, HasNoContract, HasNoNestedBigMaps, HasNoOp, HasNoTicket)
102102
import Morley.Michelson.Typed.T (T(TUnit))
103103
import Morley.Michelson.Untyped.Annotation
104+
import Morley.Tezos.Address
104105
import Morley.Util.Markdown
105106
import Morley.Util.Named
106-
import Morley.Tezos.Address
107107
import Test.Cleveland.Instances ()
108108

109109
-- | A data type to track and specify the different DAO variants in existence
@@ -147,8 +147,8 @@ instance HasAnnotation FA2.Parameter
147147
frozenTokenId :: FA2.TokenId
148148
frozenTokenId = FA2.TokenId 0
149149

150-
baseDaoAnnOptions :: AnnOptions
151-
baseDaoAnnOptions = defaultAnnOptions { fieldAnnModifier = dropPrefixThen toSnake }
150+
baseDaoAnnOptions :: Maybe AnnOptions
151+
baseDaoAnnOptions = Just def { fieldAnnModifier = toSnake . dropPrefix }
152152

153153
------------------------------------------------------------------------
154154
-- Proposals
@@ -316,7 +316,7 @@ instance HasAnnotation Delegate where
316316
instance Buildable Delegate where
317317
build = genericF
318318

319-
type Delegates' big_map = big_map Delegate ()
319+
type Delegates' (big_map :: Type -> Type -> Type) = big_map Delegate ()
320320

321321
type Delegates = Delegates' BigMap
322322

@@ -658,8 +658,7 @@ instance Buildable ProposalDoublyLinkedList where
658658
instance HasAnnotation ProposalDoublyLinkedList where
659659
annOptions = baseDaoAnnOptions
660660

661-
-- TODO [morley#922]: remove droRecursive=False here
662-
deriveRPCWithOptions "ProposalDoublyLinkedList" def{droRecursive=False}
661+
deriveRPC "ProposalDoublyLinkedList"
663662

664663
instance HasRPCRepr (DynamicRec s) where
665664
type AsRPC (DynamicRec s) = DynamicRecView s
@@ -758,7 +757,6 @@ instance HasAnnotation ce => HasAnnotation (StorageSkeleton ce) where
758757
annOptions = baseDaoAnnOptions
759758
deriving anyclass instance IsoValue ce => IsoValue (StorageSkeleton ce)
760759

761-
-- TODO [morley#922]: remove droRecursive=False here
762760
deriveRPCWithOptions "StorageSkeleton" def{droStrategy=ligoLayout, droRecursive=False}
763761
type StorageRPC = StorageSkeletonRPC (VariantToExtra 'Base)
764762

‎ligo/haskell/src/Ligo/Typescript.hs

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,6 @@ nToType (NTChest _) = toType $ U.TChest
7676
nToType (NTChestKey _) = toType $ U.TChestKey
7777
nToType (NTSaplingState _ a) = toType $ U.TSaplingState (singNatToNatural a)
7878
nToType (NTSaplingTransaction _ a) = toType $ U.TSaplingTransaction (singNatToNatural a)
79-
nToType (NTTxRollupL2Address _ ) = toType $ U.TTxRollupL2Address
8079

8180
singNatToNatural :: SingNat n -> Natural
8281
singNatToNatural SZ = 0
@@ -336,8 +335,6 @@ mkTypesFor typename epType = case U.unwrapT epType of
336335
error "In Ligo.Typescript.mkTypesFor: sappling state values not yet supported"
337336
U.TSaplingTransaction _ ->
338337
error "In Ligo.Typescript.mkTypesFor: sappling transaction values not yet supported"
339-
U.TTxRollupL2Address -> [TsType typename (TsAlias TsString)]
340-
341338
where
342339

343340
-- Mostly same as mkTypesFor, but check if the given type

‎ligo/haskell/test/SMT/Common/Gen.hs

Lines changed: 12 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -15,15 +15,18 @@ import Data.Map qualified as Map
1515
import Hedgehog.Gen qualified as Gen
1616
import Hedgehog.Gen.Tezos.Address (genAddress)
1717
import Hedgehog.Range qualified as Range
18+
import Fmt (pretty)
1819

1920
import Hedgehog.Gen.Tezos.Crypto (genSecretKey)
2021
import Lorentz hiding (cast, concat, get, not)
2122
import Lorentz.Contracts.Spec.FA2Interface qualified as FA2
2223
import Morley.Michelson.Typed.Haskell.Value (BigMap(..))
2324
import Morley.Tezos.Address
25+
import Morley.Tezos.Address.Alias
2426
import Morley.Tezos.Core (dummyChainId)
2527
import Morley.Tezos.Crypto (SecretKey, sign, toPublic)
2628
import Morley.Util.Named
29+
import Test.Cleveland (AddressWithAlias(..), ImplicitAddressWithAlias)
2730

2831
import Ligo.BaseDAO.Common.Types
2932
import Ligo.BaseDAO.Types
@@ -35,7 +38,12 @@ genMkModelInput option@SmtOption{..} = do
3538

3639
-- Initial
3740
addrs <- genSecretKey
38-
<&> (\secret -> (mkKeyAddress . toPublic $ secret, secret))
41+
<&> (\secret ->
42+
( AddressWithAlias
43+
{ awaAddress = mkKeyAddress $ toPublic secret
44+
, awaAlias = mkAlias . ("addr_" <>) . pretty $ toPublic secret
45+
}
46+
, secret))
3947
& vectorOf poolSize
4048
startLevel <- Gen.integral (Range.constant 0 10)
4149

@@ -209,13 +217,13 @@ genRandomCalls = do
209217
>>= Gen.subsequence
210218

211219
where
212-
genTransferContractTokensCall :: ImplicitAddress -> GeneratorT cep (Address -> ModelCall cep)
220+
genTransferContractTokensCall :: ImplicitAddressWithAlias -> GeneratorT cep (Address -> ModelCall cep)
213221
genTransferContractTokensCall sender1 = do
214222
f <- genTransferContractTokens @cep
215223
pure $ \govAddr -> mkSimpleContractCall sender1 $ f govAddr
216224

217225

218-
mkSimpleContractCall :: ImplicitAddress -> Parameter' (VariantToParam var) -> ModelCall var
226+
mkSimpleContractCall :: ImplicitAddressWithAlias -> Parameter' (VariantToParam var) -> ModelCall var
219227
mkSimpleContractCall sender1 param = do
220228
ModelCall
221229
{ mcAdvanceLevel = Nothing
@@ -344,8 +352,7 @@ genVote = do
344352
sign' :: SecretKey -> GeneratorT cep ( ByteString -> Signature)
345353
sign' addr = do
346354
seed <- drgNewSeed . seedFromInteger <$> Gen.integral (Range.linearFrom 0 -1000 1000)
347-
pure $ \bytes -> fst $ withDRG seed $ do
348-
sign addr bytes
355+
pure $ fst . withDRG seed . sign addr
349356

350357
type Parameter'' var = Parameter' (VariantToParam var)
351358

‎ligo/haskell/test/SMT/Common/Types.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,8 @@ import Text.Show (show)
2323

2424
import Test.Cleveland.Lorentz.Types
2525
import Lorentz hiding (cast, not)
26-
import Morley.Tezos.Address
2726
import Morley.Tezos.Crypto (SecretKey)
27+
import Test.Cleveland (ImplicitAddressWithAlias)
2828

2929
import Ligo.BaseDAO.Types
3030
import SMT.Model.BaseDAO.Types
@@ -85,7 +85,7 @@ data SmtOption (var :: Variants) = SmtOption
8585

8686
-- | Generator state, contains commonly used value that shared between generators.
8787
data GeneratorState cep = GeneratorState
88-
{ gsAddresses :: [(ImplicitAddress, SecretKey)]
88+
{ gsAddresses :: [(ImplicitAddressWithAlias, SecretKey)]
8989
, gsLevel :: Natural
9090
, gsMkGenPropose :: MkGenPropose cep
9191
, gsMkCustomCalls :: MkGenCustomCalls cep

‎ligo/haskell/test/SMT/Model/BaseDAO/Permit.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ import Control.Monad.Except (throwError)
1111
import Lorentz hiding (cast, checkSignature, get, not)
1212
import Morley.Tezos.Address (ImplicitAddress, mkKeyAddress)
1313
import Morley.Tezos.Crypto (checkSignature)
14+
import Test.Cleveland (toImplicitAddress)
1415

1516
import Ligo.BaseDAO.Types
1617
import SMT.Model.BaseDAO.Types
@@ -21,7 +22,7 @@ verifyPermitProtectedVote mso permited = do
2122
case (permited & ppPermit) of
2223
Nothing ->
2324
-- if there is no permit to check, return the votingParam and the sender
24-
pure (permited & ppArgument, mso & msoSender)
25+
pure (permited & ppArgument, mso & msoSender & toImplicitAddress)
2526
Just permit -> do
2627
-- if there is a permit, check that its correct
2728
permitCounter <- getStore <&> sPermitsCounter

‎ligo/haskell/test/SMT/Model/BaseDAO/Types.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ import Lorentz.Contracts.Spec.FA2Interface qualified as FA2
3737
import Morley.Tezos.Address
3838
import Morley.Tezos.Core
3939
import Morley.Tezos.Crypto (HashTag)
40+
import Test.Cleveland (ImplicitAddressWithAlias)
4041

4142
import Ligo.BaseDAO.ErrorCodes
4243
import Ligo.BaseDAO.Types
@@ -213,8 +214,8 @@ instance Buildable (Parameter' (VariantToParam var)) => Buildable (ModelCall var
213214

214215
-- | Definition of an @source@ and @sender@ for a call to emulate in the SMTs
215216
data ModelSource = ModelSource
216-
{ msoSender :: ImplicitAddress
217-
, msoSource :: ImplicitAddress
217+
{ msoSender :: ImplicitAddressWithAlias
218+
, msoSource :: ImplicitAddressWithAlias
218219
} deriving stock (Eq, Show, Generic)
219220

220221
instance Buildable ModelSource where

0 commit comments

Comments
 (0)