Merge pull request #2 from gnumonik/ctl-cleanup
Ctl cleanup
Ctl cleanup
import Data.Unfoldable (class Unfoldable)
import Helpers (bigIntToUInt)
import Prelude
( class EuclideanRing
, class Ord
, class Show
, Unit
, Void
, bind
, discard
, one
, pure
, unit
, zero
, ($)
, (<$>)
, (<*>)
, (<<<)
, (=<<)
, (==)
)
import Prim.Row as Row
import Prim.RowList as RL
import Prim.TypeError (class Fail, Text)
import Record as Record
import Type.Proxy (Proxy(Proxy))
import TypeLevel.DataSchema (class HasPlutusSchema, class ValidPlutusSchema)
import Plutus.Types.DataSchema (class HasPlutusSchema, class ValidPlutusSchema)
import TypeLevel.Nat (class KnownNat, natVal)
import TypeLevel.RowList.Unordered.Indexed
( class GetIndexWithLabel
module TypeLevel.DataSchema
module Plutus.Types.DataSchema
( PSchema
, class HasPlutusSchema
, PNil
, Field
, MkField
, MkField_
-- , NoRec
, type (:=)
, class SchemaToRowList
, class PlutusSchemaToRowListI
, toDataWithSchema
) where
import Prelude (Unit, Void, absurd, identity, map, one, zero, ($), (<<<), (<>), (>>>))
import Prelude
import Data.Array (cons, sortWith)
import Data.Array as Array
import Data.NonEmpty (NonEmpty)
import Record as Record
import Type.RowList as RL
import TypeLevel.DataSchema (class HasPlutusSchema, class ValidPlutusSchema)
import Plutus.Types.DataSchema (class HasPlutusSchema, class ValidPlutusSchema)
import TypeLevel.Nat (class KnownNat, natVal)
import TypeLevel.RowList.Unordered.Indexed
( class GetIndexWithLabel
module TypeLevel.RowList
( class AllUniqueLabels
, tests
) where
import Prim.TypeError (class Fail, Text)
) =>
AllUniqueLabels (Cons k a (Cons k' a' xs))
-- | Poor man's type level tests
tests ∷ Array String
tests =
[ testNil
, testSingleton
, testUniques
-- , testDupsUnordered
-- , testDups
]
where
testNil :: AllUniqueLabels Nil => String
testNil = "Empty list has all unique labels"
testSingleton
:: forall (a :: Type). AllUniqueLabels (Cons "A" a Nil) => String
testSingleton = "Singleton list has all unique labels"
testUniques
:: forall (a :: Type)
. AllUniqueLabels
( Cons "A" a
(Cons "B" a (Cons "C" a Nil))
)
=> String
testUniques = "[A, B, C] is all unique and should compile"
_testDupsUnordered
:: forall (a :: Type)
. AllUniqueLabels (Cons "A" a (Cons "B" a (Cons "A" a (Cons "B" a Nil))))
=> String
_testDupsUnordered = "[A, B, A, B] has duplicates but should compile"
_testDups
:: forall (a :: Type)
. AllUniqueLabels (Cons "A" a (Cons "A" a Nil))
=> String
_testDups = "[A, A] has duplicates and shouldn't compile"
, class IndexRowList
, class IndexRowListWithAcc
, class UniqueIndices
, uniqueIndicesTests
) where
import TypeLevel.Nat (class KnownNat, Nat, S, Z)
) =>
UniqueIndices (ConsI k a n (ConsI k' a' n' xs))
uniqueIndicesTests ∷ Array String
uniqueIndicesTests =
[ testNil
, testSingletonZ
, testSingletonSSZ
, testUniques
-- , _testDups
-- , _testDups2
]
where
testNil :: UniqueIndices NilI => String
testNil = "Empty list has all unique indices"
testSingletonZ
:: forall (a :: Type). UniqueIndices (ConsI "A" a Z NilI) => String
testSingletonZ = "Singleton list has all unique indices"
testSingletonSSZ
:: forall (a :: Type). UniqueIndices (ConsI "A" a (S (S Z)) NilI) => String
testSingletonSSZ = "Singleton list has all unique indices"
testUniques
:: forall (a :: Type)
. UniqueIndices
( ConsI "A" a Z
(ConsI "B" a (S Z) (ConsI "C" a (S (S Z)) NilI))
)
=> String
testUniques = "[0, 1, 2] have all unique indices"
_testDups
:: forall (a :: Type)
. UniqueIndices
( ConsI "A" a (S Z)
(ConsI "B" a (S Z) (ConsI "C" a (S (S Z)) NilI))
)
=> String
_testDups = "[1, 1, 2] has dups and shouldn't compile"
_testDups2
:: forall (a :: Type)
. UniqueIndices
( ConsI "A" a (S Z)
(ConsI "B" a Z (ConsI "C" a (S Z) NilI))
)
=> String
_testDups2 = "[1, 0, 1] has dups and shouldn't compile"
-- | Uniqueness constraint on the labels of a RowListI which asserts that all labels are unique.
-- Again, this is needed so that the lookup functions perform in the expected manner.
class AllUniqueLabelsI :: forall (k :: Type). RowListI k -> Constraint
import Partial.Unsafe (unsafePartial)
import Prelude
import Serialization.Address (Slot(Slot))
import Plutus.Types.DataSchema (class HasPlutusSchema, type (:+), type (:=), type (@@), I, PNil)
import TypeLevel.Nat (S, Z)
import ToData (class ToData, genericToData)
import FromData (class FromData, genericFromData)
--------------------------------------------------------------------------------
-- Interval Type and related
--------------------------------------------------------------------------------
-- | A set extended with a positive and negative infinity.
data Extended a = NegInf | Finite a | PosInf
instance
HasPlutusSchema
(Extended a)
("NegInf" := PNil @@ Z
:+ "Finite" := PNil @@ (S Z)
:+ "PosInf" := PNil @@ (S (S Z))
:+ PNil)
instance ToData a => ToData (Extended a) where
toData e = genericToData e
instance FromData a => FromData (Extended a) where
fromData e = genericFromData e
derive instance Generic (Extended a) _
derive instance Eq a => Eq (Extended a)
-- Don't change order of Extended of deriving Ord as below
-- | The lower bound of an interval.
data LowerBound a = LowerBound (Extended a) Closure
instance HasPlutusSchema (LowerBound a) ("LowerBound" := PNil @@ Z
:+ PNil)
instance ToData a => ToData (LowerBound a) where
toData lb = genericToData lb
instance FromData a => FromData (LowerBound a) where
fromData lb = genericFromData lb
derive instance Generic (LowerBound a) _
derive instance Eq a => Eq (LowerBound a)
derive instance Functor LowerBound
EQ -> in2 `compare` in1
-- | The upper bound of an interval.
data UpperBound :: Type -> Type
data UpperBound a = UpperBound (Extended a) Closure
instance HasPlutusSchema (UpperBound a) ("UpperBound" := PNil @@ Z
:+ PNil)
instance ToData a => ToData (UpperBound a) where
toData ub = genericToData ub
instance FromData a => FromData (UpperBound a) where
fromData ub = genericFromData ub
derive instance Generic (UpperBound a) _
derive instance Eq a => Eq (UpperBound a)
-- Ord is safe to derive because a closed (true) upper bound is greater than
-- | that the endpoints may or may not be included in the interval.
-- |
-- | The interval can also be unbounded on either side.
newtype Interval :: Type -> Type
newtype Interval a = Interval { from :: LowerBound a, to :: UpperBound a }
instance
HasPlutusSchema (Interval a)
("Interval" :=
("from" := I (LowerBound a)
:+ "to" := I (UpperBound a)
:+ PNil)
@@ Z
:+ PNil)
derive instance Generic (Interval a) _
derive newtype instance Eq a => Eq (Interval a)
derive instance Functor Interval
instance Ord a => BoundedMeetSemilattice (Interval a) where
top = always
instance ToData a => ToData (Interval a) where
toData i = genericToData i
instance FromData a => FromData (Interval a) where
fromData i = genericFromData i
--------------------------------------------------------------------------------
-- POSIXTIME Type and related
--------------------------------------------------------------------------------
-- | Tests for `ToData`/`FromData`
module Test.Data (suite) where
module Test.Data (suite, tests, uniqueIndicesTests) where
import Prelude
( class Eq
, class Show
, Unit
, bind
, discard
, map
, negate
, pure
, show
, unit
, ($)
, (<<<)
, (<>)
, (=<<)
)
import Contract.PlutusData (PlutusData(Constr, Integer))
import Control.Lazy (fix)
import Test.Spec.Assertions (shouldEqual)
import TestM (TestPlanM)
import ToData (class ToData, genericToData, toData)
import Type.RowList (Cons,Nil)
import Types.ByteArray (hexToByteArrayUnsafe)
import TypeLevel.Nat (Z, S)
import Untagged.Union (asOneOf)
import TypeLevel.DataSchema
import Plutus.Types.DataSchema
( class HasPlutusSchema
, type (:+)
, type (:=)
, type (@@)
, I
, PNil
)
import TypeLevel.RowList (class AllUniqueLabels)
import TypeLevel.RowList.Unordered.Indexed (NilI, ConsI, class UniqueIndices)
suite :: TestPlanM Unit
suite = do
map (toBytes <<< asOneOf) (PDS.convertPlutusData (toData value))
`shouldEqual` Just
(hexToByteArrayUnsafe binaryFixture)
-- | Poor man's type level tests
tests ∷ Array String
tests =
[ testNil
, testSingleton
, testUniques
]
where
testNil :: AllUniqueLabels Nil => String
testNil = "Empty list has all unique labels"
testSingleton
:: forall (a :: Type). AllUniqueLabels (Cons "A" a Nil) => String
testSingleton = "Singleton list has all unique labels"
testUniques
:: forall (a :: Type)
. AllUniqueLabels
( Cons "A" a
(Cons "B" a (Cons "C" a Nil))
)
=> String
testUniques = "[A, B, C] is all unique and should compile"
uniqueIndicesTests ∷ Array String
uniqueIndicesTests =
[ testNil
, testSingletonZ
, testSingletonSSZ
, testUniques
]
where
testNil :: UniqueIndices NilI => String
testNil = "Empty list has all unique indices"
testSingletonZ
:: forall (a :: Type). UniqueIndices (ConsI "A" a Z NilI) => String
testSingletonZ = "Singleton list has all unique indices"
testSingletonSSZ
:: forall (a :: Type). UniqueIndices (ConsI "A" a (S (S Z)) NilI) => String
testSingletonSSZ = "Singleton list has all unique indices"
testUniques
:: forall (a :: Type)
. UniqueIndices
( ConsI "A" a Z
(ConsI "B" a (S Z) (ConsI "C" a (S (S Z)) NilI))
)
=> String
testUniques = "[0, 1, 2] have all unique indices"
Other small changes include: * Added a trace event `TDBInitialisingFromLMDBDone`. * Initialisation from an existing LMDB database does not rely on the default `LMDBLimits` anymore, and is passed a limits argument instead. TODO: We should decide whether we want to hardcode these limits to a a substantially large one, or possibly we could link these limits to a versioning number?
add cwbtc
attempt implementation
Other small changes include: * Added a trace event `TDBInitialisingFromLMDBDone`. * Initialisation from an existing LMDB database does not rely on the default `LMDBLimits` anymore, and is passed a limits argument instead. TODO: We should decide whether we want to hardcode these limits to a a substantially large one, or possibly we could link these limits to a versioning number?
Updated crypto exchange rates chapter. I tried my best to address @rdlrt concerns. I would like to add that English is just my 3rd language, so I hope it is not too bad.
Previously, the sequence number of the database is written to disk as part of the on-disk database settings on every flush/write. Conceptually however, the settings of a database should not change on every flush or write. Instead, we make a dinstinction between on-disk database "settings" and "state", where the state can be updated in every write/flush, but the settings should generally be left untouched after database initialisation or node start-up.
Fixes #217.
This works because (a) JavaScript is ultimately single-threaded, (b) there's no execution preemption happening between a 'send' and a 'wait'.
This was using the raw Show instance of queries, which looks real bad for constructors with arity > 1 like HasTx.