Simplify things more

- Get rid of ForgetMockKES (the corresponding tests are no longer truly
  meaningful)
- Remove tracing code from MLockedAllocator
- Get rid of LogT (we no longer need it, since we can just inject the
  tracing calls into the allocator, and pass the tracer around
  explicitly)

cardano-crypto-class/src/Cardano/Crypto/DSIGNM/Class.hs

@@ -197,7 +197,7 @@ genKeyDSIGNM ::
 genKeyDSIGNM = genKeyDSIGNMWith mlockedMalloc
 
 cloneKeyDSIGNM ::
-  (DSIGNMAlgorithm v, MonadST m, MonadThrow m) => SignKeyDSIGNM v -> m (SignKeyDSIGNM v)
+  (DSIGNMAlgorithm v, MonadST m) => SignKeyDSIGNM v -> m (SignKeyDSIGNM v)
 cloneKeyDSIGNM = cloneKeyDSIGNMWith mlockedMalloc
 
 getSeedDSIGNM ::

cardano-crypto-class/src/Cardano/Crypto/Libsodium/MLockedBytes/Internal.hs

@@ -42,7 +42,6 @@ module Cardano.Crypto.Libsodium.MLockedBytes.Internal (
 
 import Control.DeepSeq (NFData (..))
 import Control.Monad.Class.MonadST
-import Control.Monad.Class.MonadThrow
 import Control.Monad.ST.Unsafe (unsafeIOToST)
 import Data.Proxy (Proxy (..))
 import Data.Word (Word8)
@@ -130,7 +129,7 @@ mlsbSize mlsb = fromInteger (natVal mlsb)
 -- | Allocate a new 'MLockedSizedBytes'. The caller is responsible for
 -- deallocating it ('mlsbFinalize') when done with it. The contents of the
 -- memory block is undefined.
-mlsbNew :: forall n m. (KnownNat n, MonadST m, MonadThrow m) => m (MLockedSizedBytes n)
+mlsbNew :: forall n m. (KnownNat n, MonadST m) => m (MLockedSizedBytes n)
 mlsbNew = mlsbNewWith mlockedMalloc
 
 mlsbNewWith :: forall n m. MLockedAllocator m -> (KnownNat n, MonadST m) => m (MLockedSizedBytes n)
@@ -143,7 +142,7 @@ mlsbNewWith allocator =
 -- | Allocate a new 'MLockedSizedBytes', and pre-fill it with zeroes.
 -- The caller is responsible for deallocating it ('mlsbFinalize') when done
 -- with it. (See also 'mlsbNew').
-mlsbNewZero :: forall n m. (KnownNat n, MonadST m, MonadThrow m) => m (MLockedSizedBytes n)
+mlsbNewZero :: forall n m. (KnownNat n, MonadST m) => m (MLockedSizedBytes n)
 mlsbNewZero = mlsbNewZeroWith mlockedMalloc
 
 mlsbNewZeroWith :: forall n m. (KnownNat n, MonadST m) => MLockedAllocator m -> m (MLockedSizedBytes n)
@@ -158,7 +157,7 @@ mlsbZero mlsb = do
   withMLSB mlsb $ \ptr -> zeroMem ptr (mlsbSize mlsb)
 
 -- | Create a deep mlocked copy of an 'MLockedSizedBytes'.
-mlsbCopy :: forall n m. (KnownNat n, MonadST m, MonadThrow m)
+mlsbCopy :: forall n m. (KnownNat n, MonadST m)
          => MLockedSizedBytes n
          -> m (MLockedSizedBytes n)
 mlsbCopy = mlsbCopyWith mlockedMalloc
@@ -182,7 +181,7 @@ mlsbCopyWith allocator src = mlsbUseAsCPtr src $ \ptrSrc -> do
 -- 'mlsbNew' or 'mlsbNewZero' to create 'MLockedSizedBytes' values, and
 -- manipulate them through 'withMLSB', 'mlsbUseAsCPtr', or 'mlsbUseAsSizedPtr'.
 -- (See also 'mlsbFromByteStringCheck')
-mlsbFromByteString :: forall n m. (KnownNat n, MonadST m, MonadThrow m)
+mlsbFromByteString :: forall n m. (KnownNat n, MonadST m)
                    => BS.ByteString -> m (MLockedSizedBytes n)
 mlsbFromByteString = mlsbFromByteStringWith mlockedMalloc
 
@@ -204,7 +203,7 @@ mlsbFromByteStringWith allocator bs = do
 -- 'mlsbNew' or 'mlsbNewZero' to create 'MLockedSizedBytes' values, and
 -- manipulate them through 'withMLSB', 'mlsbUseAsCPtr', or 'mlsbUseAsSizedPtr'.
 -- (See also 'mlsbFromByteString')
-mlsbFromByteStringCheck :: forall n m. (KnownNat n, MonadST m, MonadThrow m)
+mlsbFromByteStringCheck :: forall n m. (KnownNat n, MonadST m)
                         => BS.ByteString
                         -> m (Maybe (MLockedSizedBytes n))
 mlsbFromByteStringCheck = mlsbFromByteStringCheckWith mlockedMalloc

cardano-crypto-class/src/Cardano/Crypto/Libsodium/MLockedSeed.hs

@@ -26,7 +26,6 @@ import Cardano.Crypto.MEqOrd (
 import Cardano.Foreign (SizedPtr)
 import Control.DeepSeq (NFData)
 import Control.Monad.Class.MonadST (MonadST)
-import Control.Monad.Class.MonadThrow (MonadThrow)
 import Data.Word (Word8)
 import Foreign.Ptr (Ptr)
 import GHC.TypeNats (KnownNat)
@@ -51,7 +50,7 @@ withMLockedSeedAsMLSB
 withMLockedSeedAsMLSB action =
   fmap MLockedSeed . action . mlockedSeedMLSB
 
-mlockedSeedCopy :: (KnownNat n, MonadST m, MonadThrow m) => MLockedSeed n -> m (MLockedSeed n)
+mlockedSeedCopy :: (KnownNat n, MonadST m) => MLockedSeed n -> m (MLockedSeed n)
 mlockedSeedCopy = mlockedSeedCopyWith mlockedMalloc
 
 mlockedSeedCopyWith
@@ -61,14 +60,14 @@ mlockedSeedCopyWith
   -> m (MLockedSeed n)
 mlockedSeedCopyWith allocator = withMLockedSeedAsMLSB (mlsbCopyWith allocator)
 
-mlockedSeedNew :: (KnownNat n, MonadST m, MonadThrow m) => m (MLockedSeed n)
+mlockedSeedNew :: (KnownNat n, MonadST m) => m (MLockedSeed n)
 mlockedSeedNew = mlockedSeedNewWith mlockedMalloc
 
 mlockedSeedNewWith :: (KnownNat n, MonadST m) => MLockedAllocator m -> m (MLockedSeed n)
 mlockedSeedNewWith allocator =
   MLockedSeed <$> mlsbNewWith allocator
 
-mlockedSeedNewZero :: (KnownNat n, MonadST m, MonadThrow m) => m (MLockedSeed n)
+mlockedSeedNewZero :: (KnownNat n, MonadST m) => m (MLockedSeed n)
 mlockedSeedNewZero = mlockedSeedNewZeroWith mlockedMalloc
 
 mlockedSeedNewZeroWith :: (KnownNat n, MonadST m) => MLockedAllocator m -> m (MLockedSeed n)

cardano-crypto-class/src/Cardano/Crypto/Libsodium/Memory/Internal.hs

@@ -47,7 +47,7 @@ import Control.DeepSeq (NFData (..), rwhnf)
 import Control.Exception (Exception, mask_)
 import Control.Monad (when, void)
 import Control.Monad.Class.MonadST
-import Control.Monad.Class.MonadThrow (MonadThrow (bracket, throwIO))
+import Control.Monad.Class.MonadThrow (MonadThrow (bracket))
 import Control.Monad.ST
 import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
 import Data.ByteString (ByteString)
@@ -143,12 +143,9 @@ data AllocatorException =
 
 instance Exception AllocatorException
 
-mlockedMalloc :: (MonadST m, MonadThrow m) => MLockedAllocator m
-mlockedMalloc = MLockedAllocator {
-  mlAllocate = \ size -> withLiftST ($ unsafeIOToST (mlockedMallocIO size))
-  , mlTrace = \_ -> throwIO AllocatorNoTracer
-  , mlUniformWord = \_ -> throwIO AllocatorNoGenerator
-  }
+mlockedMalloc :: MonadST m => MLockedAllocator m
+mlockedMalloc =
+  MLockedAllocator { mlAllocate = \ size -> withLiftST ($ unsafeIOToST (mlockedMallocIO size)) }
 
 mlockedMallocIO :: CSize -> IO (MLockedForeignPtr a)
 mlockedMallocIO size = SFP <$> do
@@ -219,12 +216,10 @@ instance Show AllocatorEvent where
 getAllocatorEvent :: forall e. Typeable e => AllocatorEvent -> Maybe e
 getAllocatorEvent (AllocatorEvent e) = cast e
 
-data MLockedAllocator m where
-  MLockedAllocator ::
+newtype MLockedAllocator m =
+  MLockedAllocator
     { mlAllocate :: forall a. CSize -> m (MLockedForeignPtr a)
-    , mlTrace :: AllocatorEvent -> m ()
-    , mlUniformWord :: (Word, Word) -> m Word
-    } -> MLockedAllocator m
+    }
 
 mlockedAllocaSized :: forall m n b. (MonadST m, MonadThrow m, KnownNat n) => (SizedPtr n -> m b) -> m b
 mlockedAllocaSized = mlockedAllocaSizedWith mlockedMalloc
@@ -238,7 +233,7 @@ mlockedAllocaSizedWith allocator k = mlockedAllocaWith allocator size (k . Sized
     size :: CSize
     size = fromInteger (natVal (Proxy @n))
 
-mlockedAllocForeignPtrBytes :: (MonadST m, MonadThrow m) => CSize -> CSize -> m (MLockedForeignPtr a)
+mlockedAllocForeignPtrBytes :: MonadST m => CSize -> CSize -> m (MLockedForeignPtr a)
 mlockedAllocForeignPtrBytes = mlockedAllocForeignPtrBytesWith mlockedMalloc
 
 mlockedAllocForeignPtrBytesWith :: MLockedAllocator m -> CSize -> CSize -> m (MLockedForeignPtr a)
@@ -252,7 +247,7 @@ mlockedAllocForeignPtrBytesWith allocator size align = do
       where
         (q,m) = size `quotRem` align
 
-mlockedAllocForeignPtr :: forall a m . (MonadST m, MonadThrow m, Storable a) => m (MLockedForeignPtr a)
+mlockedAllocForeignPtr :: forall a m . (MonadST m, Storable a) => m (MLockedForeignPtr a)
 mlockedAllocForeignPtr = mlockedAllocForeignPtrWith mlockedMalloc
 
 mlockedAllocForeignPtrWith ::

cardano-crypto-tests/cardano-crypto-tests.cabal

@@ -49,7 +49,6 @@ library
                         Test.Crypto.VRF
                         Test.Crypto.Regressions
                         Test.Crypto.Instances
-                        Cardano.Crypto.KES.ForgetMock
                         Bench.Crypto.DSIGN
                         Bench.Crypto.VRF
                         Bench.Crypto.KES