Skip to content

Commit

Permalink
Rename MEq to EqST
Browse files Browse the repository at this point in the history
This better reflects what it is currently about.
  • Loading branch information
tdammers committed May 10, 2023
1 parent 7062df7 commit 1c1fdfb
Show file tree
Hide file tree
Showing 8 changed files with 41 additions and 41 deletions.
2 changes: 1 addition & 1 deletion cardano-crypto-class/cardano-crypto-class.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -81,7 +81,7 @@ library
Cardano.Crypto.Libsodium.MLockedBytes.Internal
Cardano.Crypto.Libsodium.MLockedSeed
Cardano.Crypto.Libsodium.UnsafeC
Cardano.Crypto.MEqOrd
Cardano.Crypto.EqST
Cardano.Crypto.PinnedSizedBytes
Cardano.Crypto.Seed
Cardano.Crypto.Util
Expand Down
6 changes: 3 additions & 3 deletions cardano-crypto-class/src/Cardano/Crypto/DSIGN/Ed25519ML.hs
Original file line number Diff line number Diff line change
Expand Up @@ -56,8 +56,8 @@ import Cardano.Crypto.PinnedSizedBytes
, psbFromByteStringCheck
, psbCreateSizedResult
)
import Cardano.Crypto.MEqOrd
( MEq (..)
import Cardano.Crypto.EqST
( EqST (..)
)

import Cardano.Crypto.DSIGNM.Class
Expand Down Expand Up @@ -257,7 +257,7 @@ instance DSIGNMAlgorithm Ed25519DSIGNM where
forgetSignKeyDSIGNMWith _ (SignKeyEd25519DSIGNM sk) = mlsbFinalize sk

deriving via (MLockedSizedBytes (SizeSignKeyDSIGNM Ed25519DSIGNM))
instance MEq (SignKeyDSIGNM Ed25519DSIGNM)
instance EqST (SignKeyDSIGNM Ed25519DSIGNM)

instance UnsoundDSIGNMAlgorithm Ed25519DSIGNM where
--
Expand Down
Original file line number Diff line number Diff line change
@@ -1,58 +1,58 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
module Cardano.Crypto.MEqOrd where
module Cardano.Crypto.EqST where

import Control.Monad.Class.MonadST (MonadST)

-- | Monadic flavor of 'Eq', for things that can only be compared in a monadic
-- context.
-- context that satisfies 'MonadST'.
-- This is needed because we cannot have a sound 'Eq' instance on mlocked
-- memory types.
class MEq a where
-- memory types, but we do need to compare them for equality in tests.
class EqST a where
equalsM :: MonadST m => a -> a -> m Bool

nequalsM :: (MonadST m, MEq a) => a -> a -> m Bool
nequalsM :: (MonadST m, EqST a) => a -> a -> m Bool
nequalsM a b = not <$> equalsM a b

-- | Infix version of 'equalsM'
(==!) :: (MonadST m, MEq a) => a -> a -> m Bool
(==!) :: (MonadST m, EqST a) => a -> a -> m Bool
(==!) = equalsM
infix 4 ==!

-- | Infix version of 'nequalsM'
(!=!) :: (MonadST m, MEq a) => a -> a -> m Bool
(!=!) :: (MonadST m, EqST a) => a -> a -> m Bool
(!=!) = nequalsM
infix 4 !=!

instance MEq a => MEq (Maybe a) where
instance EqST a => EqST (Maybe a) where
equalsM Nothing Nothing = pure True
equalsM (Just a) (Just b) = equalsM a b
equalsM _ _ = pure False

instance (MEq a, MEq b) => MEq (Either a b) where
instance (EqST a, EqST b) => EqST (Either a b) where
equalsM (Left x) (Left y) = equalsM x y
equalsM (Right x) (Right y) = equalsM x y
equalsM _ _ = pure False

instance (MEq a, MEq b) => MEq (a, b) where
instance (EqST a, EqST b) => EqST (a, b) where
equalsM (a, b) (a', b') = (&&) <$> equalsM a a' <*> equalsM b b'

instance (MEq a, MEq b, MEq c) => MEq (a, b, c) where
instance (EqST a, EqST b, EqST c) => EqST (a, b, c) where
equalsM (a, b, c) (a', b', c') = equalsM ((a, b), c) ((a', b'), c')

instance (MEq a, MEq b, MEq c, MEq d) => MEq (a, b, c, d) where
instance (EqST a, EqST b, EqST c, EqST d) => EqST (a, b, c, d) where
equalsM (a, b, c, d) (a', b', c', d') = equalsM ((a, b, c), d) ((a', b', c'), d')

-- TODO: If anyone needs larger tuples, add more instances here...

-- | Helper newtype, useful for defining 'MEq' in terms of 'Eq' for types that
-- | Helper newtype, useful for defining 'EqST' in terms of 'Eq' for types that
-- have sound 'Eq' instances, using @DerivingVia@. An 'Applicative' context
-- must be provided for such instances to work, so this will generally require
-- @StandaloneDeriving@ as well.
--
-- Ex.: @deriving via PureEq Int instance Applicative m => MEq m Int@
newtype PureMEq a = PureMEq a
-- Ex.: @deriving via PureEq Int instance Applicative m => EqST m Int@
newtype PureEqST a = PureEqST a

instance Eq a => MEq (PureMEq a) where
equalsM (PureMEq a) (PureMEq b) = pure (a == b)
instance Eq a => EqST (PureEqST a) where
equalsM (PureEqST a) (PureEqST b) = pure (a == b)
4 changes: 2 additions & 2 deletions cardano-crypto-class/src/Cardano/Crypto/KES/Simple.hs
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ import Cardano.Crypto.Libsodium.MLockedSeed
import Cardano.Crypto.Libsodium.MLockedBytes
import Cardano.Crypto.Util
import Data.Unit.Strict (forceElemsToWHNF)
import Cardano.Crypto.MEqOrd (MEq (..))
import Cardano.Crypto.EqST (EqST (..))


data SimpleKES d (t :: Nat)
Expand Down Expand Up @@ -213,7 +213,7 @@ deriving instance DSIGNMAlgorithmBase d => Show (SigKES (SimpleKES d t))
deriving instance DSIGNMAlgorithmBase d => Eq (VerKeyKES (SimpleKES d t))
deriving instance DSIGNMAlgorithmBase d => Eq (SigKES (SimpleKES d t))

instance MEq (SignKeyDSIGNM d) => MEq (SignKeyKES (SimpleKES d t)) where
instance EqST (SignKeyDSIGNM d) => EqST (SignKeyKES (SimpleKES d t)) where
equalsM (ThunkySignKeySimpleKES a) (ThunkySignKeySimpleKES b) =
-- No need to check that lengths agree, the types already guarantee this.
Vec.and <$> Vec.zipWithM equalsM a b
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,7 @@ import Cardano.Foreign
import Cardano.Crypto.Libsodium.Memory
import Cardano.Crypto.Libsodium.Memory.Internal (MLockedForeignPtr (..))
import Cardano.Crypto.Libsodium.C
import Cardano.Crypto.MEqOrd
import Cardano.Crypto.EqST

import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BSI
Expand Down Expand Up @@ -84,7 +84,7 @@ instance KnownNat n => Show (MLockedSizedBytes n) where
-- hexstr = concatMap (printf "%02x") bytes
-- in "MLSB " ++ hexstr

instance KnownNat n => MEq (MLockedSizedBytes n) where
instance KnownNat n => EqST (MLockedSizedBytes n) where
equalsM = mlsbEq

nextPowerOf2 :: forall n. (Num n, Ord n, Bits n) => n -> n
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,8 @@ import Cardano.Crypto.Libsodium.Memory (
MLockedAllocator,
mlockedMalloc,
)
import Cardano.Crypto.MEqOrd (
MEq (..),
import Cardano.Crypto.EqST (
EqST (..),
)
import Cardano.Foreign (SizedPtr)
import Control.DeepSeq (NFData)
Expand All @@ -40,7 +40,7 @@ newtype MLockedSeed n = MLockedSeed {mlockedSeedMLSB :: MLockedSizedBytes n}
deriving via
MLockedSizedBytes n
instance
KnownNat n => MEq (MLockedSeed n)
KnownNat n => EqST (MLockedSeed n)

withMLockedSeedAsMLSB
:: Functor m
Expand Down
4 changes: 2 additions & 2 deletions cardano-crypto-tests/src/Test/Crypto/DSIGN.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,7 @@ import Test.Tasty.QuickCheck (testProperty, QuickCheckTests)

import qualified Data.ByteString as BS
import Cardano.Crypto.Libsodium
import Cardano.Crypto.MEqOrd (MEq (..), (==!))
import Cardano.Crypto.EqST (EqST (..), (==!))

import Text.Show.Pretty (ppShow)

Expand Down Expand Up @@ -371,7 +371,7 @@ testDSIGNMAlgorithm
-- test direct encoding/decoding for 'SignKeyDSIGNM'.
-- , ToCBOR (SignKeyDSIGNM v)
-- , FromCBOR (SignKeyDSIGNM v)
, MEq (SignKeyDSIGNM v) -- only monadic MEq for signing keys
, EqST (SignKeyDSIGNM v) -- only monadic EqST for signing keys
, ToCBOR (SigDSIGNM v)
, FromCBOR (SigDSIGNM v)
, ContextDSIGNM v ~ ()
Expand Down
22 changes: 11 additions & 11 deletions cardano-crypto-tests/src/Test/Crypto/KES.hs
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ import Cardano.Crypto.Util (SignableRepresentation(..))
import Cardano.Crypto.Libsodium
import Cardano.Crypto.Libsodium.MLockedSeed
import Cardano.Crypto.PinnedSizedBytes
import Cardano.Crypto.MEqOrd
import Cardano.Crypto.EqST

import Test.QuickCheck
import Test.Tasty (TestTree, testGroup, adjustOption)
Expand Down Expand Up @@ -116,25 +116,25 @@ instance Show (SignKeyKES (CompactSingleKES Ed25519DSIGNM)) where
instance Show (SignKeyKES (CompactSumKES h d)) where
show _ = "<SignKeyCompactSumKES>"

deriving via (PureMEq (SignKeyKES (MockKES t))) instance MEq (SignKeyKES (MockKES t))
deriving via (PureEqST (SignKeyKES (MockKES t))) instance EqST (SignKeyKES (MockKES t))

deriving newtype instance (MEq (SignKeyDSIGNM d)) => MEq (SignKeyKES (SingleKES d))
deriving newtype instance (EqST (SignKeyDSIGNM d)) => EqST (SignKeyKES (SingleKES d))

instance ( MEq (SignKeyKES d)
instance ( EqST (SignKeyKES d)
, Eq (VerKeyKES d)
, KnownNat (SeedSizeKES d)
) => MEq (SignKeyKES (SumKES h d)) where
) => EqST (SignKeyKES (SumKES h d)) where
equalsM (SignKeySumKES s r v1 v2) (SignKeySumKES s' r' v1' v2') =
(s, r, PureMEq v1, PureMEq v2) ==! (s', r', PureMEq v1', PureMEq v2')
(s, r, PureEqST v1, PureEqST v2) ==! (s', r', PureEqST v1', PureEqST v2')

deriving newtype instance (MEq (SignKeyDSIGNM d)) => MEq (SignKeyKES (CompactSingleKES d))
deriving newtype instance (EqST (SignKeyDSIGNM d)) => EqST (SignKeyKES (CompactSingleKES d))

instance ( MEq (SignKeyKES d)
instance ( EqST (SignKeyKES d)
, Eq (VerKeyKES d)
, KnownNat (SeedSizeKES d)
) => MEq (SignKeyKES (CompactSumKES h d)) where
) => EqST (SignKeyKES (CompactSumKES h d)) where
equalsM (SignKeyCompactSumKES s r v1 v2) (SignKeyCompactSumKES s' r' v1' v2') =
(s, r, PureMEq v1, PureMEq v2) ==! (s', r', PureMEq v1', PureMEq v2')
(s, r, PureEqST v1, PureEqST v2) ==! (s', r', PureEqST v1', PureEqST v2')

testKESAlloc
:: forall v.
Expand Down Expand Up @@ -190,7 +190,7 @@ testKESAlgorithm
:: forall v.
( ToCBOR (VerKeyKES v)
, FromCBOR (VerKeyKES v)
, MEq (SignKeyKES v) -- only monadic MEq for signing keys
, EqST (SignKeyKES v) -- only monadic EqST for signing keys
, Show (SignKeyKES v) -- fake instance defined locally
, ToCBOR (SigKES v)
, FromCBOR (SigKES v)
Expand Down

0 comments on commit 1c1fdfb

Please sign in to comment.