Skip to content

Commit

Permalink
Prevent negative script data constructor integers in arbitrary instance
Browse files Browse the repository at this point in the history
  • Loading branch information
@jhbertra
jhbertra committed Sep 14, 2023
1 parent 18f05d3 commit 3d746ad
Show file tree
Hide file tree
Showing 3 changed files with 120 additions and 4 deletions.
2 changes: 1 addition & 1 deletion marlowe-chain-sync/gen/Language/Marlowe/Runtime/ChainSync/Gen.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -169,7 +169,7 @@ instance Arbitrary TokenName where
instance Arbitrary Datum where
arbitrary =
oneofStructured
[ (Node, Constr <$> arbitrary <*> listOf (resized (`div` 10) arbitrary))
[ (Node, Constr . abs <$> arbitrary <*> listOf (resized (`div` 10) arbitrary))
, (Node, Map <$> listOf (resized (`div` 10) arbitrary))
, (Node, List <$> listOf (resized (`div` 10) arbitrary))
, (Leaf, I <$> arbitrary)
Expand Down
7 changes: 4 additions & 3 deletions marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -84,7 +84,7 @@ import Language.Marlowe.Protocol.Query.Types (

import Cardano.Ledger.Alonzo.Core (TxWits)
import Cardano.Ledger.Binary (Annotator, DecCBOR (..), Decoder, decodeFullAnnotator, serialize')
import Cardano.Ledger.Core (EraTxWits)
import Cardano.Ledger.Core (EraTxWits, eraProtVerLow)
import Data.Bitraversable (Bitraversable (..))
import Data.Function (on)
import Data.Kind (Type)
Expand Down Expand Up @@ -705,15 +705,16 @@ instance
)
=> SerialiseAsCBOR (ShelleyTxWitness era)
where
serialiseToCBOR (ShelleyTxWitness wit) = serialize' maxBound wit
serialiseToCBOR (ShelleyTxWitness wit) = serialize' (eraProtVerLow @(ShelleyLedgerEra era)) wit

deserialiseFromCBOR _ bs = do
let lbs = BSL.fromStrict bs

annotator :: forall s. Decoder s (Annotator (TxWits (ShelleyLedgerEra era)))
annotator = decCBOR

(w :: TxWits (ShelleyLedgerEra era)) <- decodeFullAnnotator maxBound "Shelley Tx Witness" annotator lbs
(w :: TxWits (ShelleyLedgerEra era)) <-
decodeFullAnnotator (eraProtVerLow @(ShelleyLedgerEra era)) "Shelley Tx Witness" annotator lbs
pure $ ShelleyTxWitness w

instance
Expand Down
115 changes: 115 additions & 0 deletions marlowe-runtime/marlowe-runtime.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,9 +17,124 @@ maintainer: [email protected]
stability: experimental
category: Language
data-files:
.golden/GetHeadersSQL[]/golden
.golden/GetHeadersSQL[SetRangeAscending]/golden
".golden/GetHeadersSQL[SetRangeStart,SetRangeAscending]/golden"
.golden/GetHeadersSQL[SetRangeStart]/golden
".golden/GetHeadersSQL[SpecifyPartyAddress,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyPartyAddress,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyPartyAddress,SetRangeStart]/golden"
.golden/GetHeadersSQL[SpecifyPartyAddress]/golden
".golden/GetHeadersSQL[SpecifyPartyRole,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyPartyRole,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyPartyRole,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyPartyRole,SpecifyPartyAddress,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyPartyRole,SpecifyPartyAddress,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyPartyRole,SpecifyPartyAddress,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyPartyRole,SpecifyPartyAddress]/golden"
.golden/GetHeadersSQL[SpecifyPartyRole]/golden
".golden/GetHeadersSQL[SpecifyRolesCurrency,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyAddress,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyAddress,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyAddress,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyAddress]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyRole,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyRole,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyRole,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyRole,SpecifyPartyAddress,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyRole,SpecifyPartyAddress,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyRole,SpecifyPartyAddress,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyRole,SpecifyPartyAddress]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyPartyRole]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyAddress,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyAddress,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyAddress,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyAddress]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyRole,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyRole,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyRole,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyRole,SpecifyPartyAddress,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyRole,SpecifyPartyAddress,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyRole,SpecifyPartyAddress,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyRole,SpecifyPartyAddress]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag,SpecifyPartyRole]/golden"
".golden/GetHeadersSQL[SpecifyRolesCurrency,SpecifyTag]/golden"
.golden/GetHeadersSQL[SpecifyRolesCurrency]/golden
".golden/GetHeadersSQL[SpecifyTag,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyTag,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyTag,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyAddress,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyAddress,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyAddress,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyAddress]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyRole,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyRole,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyRole,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyRole,SpecifyPartyAddress,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyRole,SpecifyPartyAddress,SetRangeStart,SetRangeAscending]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyRole,SpecifyPartyAddress,SetRangeStart]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyRole,SpecifyPartyAddress]/golden"
".golden/GetHeadersSQL[SpecifyTag,SpecifyPartyRole]/golden"
.golden/GetHeadersSQL[SpecifyTag]/golden
.golden/GetPayoutsSQL[]/golden
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SetRangeStart,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SetRangeStart]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyContractId,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyContractId,SetRangeStart,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyContractId,SetRangeStart]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyContractId,SpecifyRoleToken,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyContractId,SpecifyRoleToken,SetRangeStart,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyContractId,SpecifyRoleToken,SetRangeStart]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyContractId,SpecifyRoleToken]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyContractId]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyRoleToken,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyRoleToken,SetRangeStart,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyRoleToken,SetRangeStart]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnFalse,SpecifyRoleToken]/golden"
.golden/GetPayoutsSQL[SetIsWithdrawnFalse]/golden
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SetRangeStart,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SetRangeStart]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyContractId,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyContractId,SetRangeStart,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyContractId,SetRangeStart]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyContractId,SpecifyRoleToken,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyContractId,SpecifyRoleToken,SetRangeStart,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyContractId,SpecifyRoleToken,SetRangeStart]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyContractId,SpecifyRoleToken]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyContractId]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyRoleToken,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyRoleToken,SetRangeStart,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyRoleToken,SetRangeStart]/golden"
".golden/GetPayoutsSQL[SetIsWithdrawnTrue,SpecifyRoleToken]/golden"
.golden/GetPayoutsSQL[SetIsWithdrawnTrue]/golden
.golden/GetPayoutsSQL[SetRangeAscending]/golden
".golden/GetPayoutsSQL[SetRangeStart,SetRangeAscending]/golden"
.golden/GetPayoutsSQL[SetRangeStart]/golden
".golden/GetPayoutsSQL[SpecifyContractId,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SpecifyContractId,SetRangeStart,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SpecifyContractId,SetRangeStart]/golden"
".golden/GetPayoutsSQL[SpecifyContractId,SpecifyRoleToken,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SpecifyContractId,SpecifyRoleToken,SetRangeStart,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SpecifyContractId,SpecifyRoleToken,SetRangeStart]/golden"
".golden/GetPayoutsSQL[SpecifyContractId,SpecifyRoleToken]/golden"
.golden/GetPayoutsSQL[SpecifyContractId]/golden
".golden/GetPayoutsSQL[SpecifyRoleToken,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SpecifyRoleToken,SetRangeStart,SetRangeAscending]/golden"
".golden/GetPayoutsSQL[SpecifyRoleToken,SetRangeStart]/golden"
.golden/GetPayoutsSQL[SpecifyRoleToken]/golden
".golden/Job MarloweTxCommand/golden"
.golden/MarloweHeaderSync/golden
.golden/MarloweLoad/golden
.golden/MarloweQuery/golden
.golden/MarloweSync/golden
.golden/MarloweTransfer/golden

license-files:
LICENSE
Expand Down

0 comments on commit 3d746ad

Please sign in to comment.