Refactor MonadSodium into MonadMLock etc.

cardano-crypto-class/cardano-crypto-class.cabal

@@ -80,11 +80,11 @@ library
     Cardano.Crypto.Libsodium.MLockedBytes
     Cardano.Crypto.Libsodium.MLockedBytes.Internal
     Cardano.Crypto.Libsodium.UnsafeC
+    Cardano.Crypto.MonadMLock
+    Cardano.Crypto.MonadMLock.Class
+    Cardano.Crypto.MonadMLock.Alloc
     Cardano.Crypto.MEqOrd
     Cardano.Crypto.MLockedSeed
-    Cardano.Crypto.MonadSodium
-    Cardano.Crypto.MonadSodium.Class
-    Cardano.Crypto.MonadSodium.Alloc
     Cardano.Crypto.PinnedSizedBytes
     Cardano.Crypto.Seed
     Cardano.Crypto.Util

cardano-crypto-class/src/Cardano/Crypto/DSIGN/Ed25519ML.hs

@@ -39,18 +39,23 @@ import Control.Monad.ST.Unsafe (unsafeIOToST)
 import Cardano.Binary (FromCBOR (..), ToCBOR (..))
 
 import Cardano.Foreign
-import Cardano.Crypto.PinnedSizedBytes
 import Cardano.Crypto.Libsodium.C
 import Cardano.Crypto.Libsodium (MLockedSizedBytes)
-import Cardano.Crypto.MonadSodium
-  ( MonadSodium (..)
+import Cardano.Crypto.MonadMLock
+  ( MonadMLock (..)
+  , MonadPSB (..)
   , mlsbToByteString
   , mlsbFromByteStringCheck
   , mlsbUseAsSizedPtr
   , mlsbNew
   , mlsbFinalize
   , mlsbCopy
   , MEq (..)
+  , PinnedSizedBytes
+  , psbUseAsSizedPtr
+  , psbToByteString
+  , psbFromByteStringCheck
+  , psbCreateSizedResult
   )
 
 import Cardano.Crypto.DSIGNM.Class
@@ -171,7 +176,7 @@ instance DSIGNMAlgorithmBase Ed25519DSIGNM where
 -- reflects this.
 --
 -- Various libsodium primitives, particularly 'MLockedSizedBytes' primitives,
--- are used via the 'MonadSodium' typeclass, which is responsible for
+-- are used via the 'MonadMLock' typeclass, which is responsible for
 -- guaranteeing orderly execution of these actions. We avoid using these
 -- primitives inside 'unsafeIOToST', as well as any 'IO' actions that would be
 -- unsafe to use inside 'unsafePerformIO'.
@@ -188,12 +193,13 @@ instance DSIGNMAlgorithmBase Ed25519DSIGNM where
 --   we use 'getErrno', so this is fine.
 -- - 'BS.useAsCStringLen', which is fine and shouldn't require 'IO' to begin
 --   with, but unfortunately, for historical reasons, does.
-instance (MonadST m, MonadSodium m, MonadThrow m) => DSIGNMAlgorithm m Ed25519DSIGNM where
+instance (MonadST m, MonadMLock m, MonadPSB m, MonadThrow m) => DSIGNMAlgorithm m Ed25519DSIGNM where
     deriveVerKeyDSIGNM (SignKeyEd25519DSIGNM sk) =
       VerKeyEd25519DSIGNM <$!> do
         mlsbUseAsSizedPtr sk $ \skPtr -> do
-          (psb, maybeErrno) <- withLiftST $ \fromST -> fromST $ do
-              psbCreateSizedResult $ \pkPtr ->
+          (psb, maybeErrno) <-
+            psbCreateSizedResult $ \pkPtr ->
+              withLiftST $ \fromST -> fromST $ do
                 cOrError $ unsafeIOToST $
                   c_crypto_sign_ed25519_sk_to_pk pkPtr skPtr
           throwOnErrno "deriveVerKeyDSIGNM @Ed25519DSIGNM" "c_crypto_sign_ed25519_sk_to_pk" maybeErrno
@@ -204,8 +210,9 @@ instance (MonadST m, MonadSodium m, MonadThrow m) => DSIGNMAlgorithm m Ed25519DS
       let bs = getSignableRepresentation a
       in SigEd25519DSIGNM <$!> do
           mlsbUseAsSizedPtr sk $ \skPtr -> do
-            (psb, maybeErrno) <- withLiftST $ \fromST -> fromST $ do
-                psbCreateSizedResult $ \sigPtr -> do
+            (psb, maybeErrno) <-
+              psbCreateSizedResult $ \sigPtr -> do
+                withLiftST $ \fromST -> fromST $ do
                   cOrError $ unsafeIOToST $ do
                     BS.useAsCStringLen bs $ \(ptr, len) ->
                       c_crypto_sign_ed25519_detached sigPtr nullPtr (castPtr ptr) (fromIntegral len) skPtr
@@ -251,9 +258,9 @@ instance (MonadST m, MonadSodium m, MonadThrow m) => DSIGNMAlgorithm m Ed25519DS
       mlsbFinalize sk
 
 deriving via (MLockedSizedBytes (SizeSignKeyDSIGNM Ed25519DSIGNM))
-  instance (MonadST m, MonadSodium m) => MEq m (SignKeyDSIGNM Ed25519DSIGNM)
+  instance (MonadST m, MonadMLock m) => MEq m (SignKeyDSIGNM Ed25519DSIGNM)
 
-instance (MonadST m, MonadSodium m, MonadThrow m) => UnsoundDSIGNMAlgorithm m Ed25519DSIGNM where
+instance (MonadST m, MonadMLock m, MonadPSB m, MonadThrow m) => UnsoundDSIGNMAlgorithm m Ed25519DSIGNM where
     --
     -- Ser/deser (dangerous - do not use in production code)
     --

cardano-crypto-class/src/Cardano/Crypto/KES/CompactSum.hs

@@ -98,7 +98,7 @@ import           Cardano.Crypto.KES.Class
 import           Cardano.Crypto.KES.CompactSingle (CompactSingleKES)
 import           Cardano.Crypto.Util
 import           Cardano.Crypto.MLockedSeed
-import qualified Cardano.Crypto.MonadSodium as NaCl
+import           Cardano.Crypto.MonadMLock
 import           Control.Monad.Class.MonadST (MonadST)
 import           Control.Monad.Class.MonadThrow (MonadThrow)
 import           Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
@@ -150,7 +150,7 @@ instance (NFData (SignKeyKES d), NFData (VerKeyKES d)) =>
       rnf (sk, r, vk1, vk2)
 
 instance ( OptimizedKESAlgorithm d
-         , NaCl.SodiumHashAlgorithm h -- needed for secure forgetting
+         , SodiumHashAlgorithm h -- needed for secure forgetting
          , SizeHash h ~ SeedSizeKES d -- can be relaxed
          , NoThunks (VerKeyKES (CompactSumKES h d))
          , KnownNat (SizeVerKeyKES (CompactSumKES h d))
@@ -250,9 +250,9 @@ instance ( OptimizedKESAlgorithm d
 
 instance ( OptimizedKESAlgorithm d
          , KESSignAlgorithm m d
-         , NaCl.SodiumHashAlgorithm h -- needed for secure forgetting
+         , SodiumHashAlgorithm h -- needed for secure forgetting
          , SizeHash h ~ SeedSizeKES d -- can be relaxed
-         , NaCl.MonadSodium m
+         , MonadMLock m
          , MonadST m -- only needed for unsafe raw ser/deser
          , MonadThrow m
          , NoThunks (VerKeyKES (CompactSumKES h d))
@@ -310,7 +310,7 @@ instance ( OptimizedKESAlgorithm d
 
     {-# NOINLINE genKeyKES #-}
     genKeyKES r = do
-      (r0raw, r1raw) <- NaCl.expandHash (Proxy :: Proxy h) (mlockedSeedMLSB r)
+      (r0raw, r1raw) <- expandHash (Proxy :: Proxy h) (mlockedSeedMLSB r)
       let r0 = MLockedSeed r0raw
           r1 = MLockedSeed r1raw
       sk_0 <- genKeyKES r0
@@ -330,7 +330,7 @@ instance ( OptimizedKESAlgorithm d
 
 instance ( KESSignAlgorithm m (CompactSumKES h d)
          , UnsoundKESSignAlgorithm m d
-         , NaCl.MonadSodium m
+         , MonadMLock m
          , MonadST m
          ) => UnsoundKESSignAlgorithm m (CompactSumKES h d) where
     --
@@ -340,7 +340,7 @@ instance ( KESSignAlgorithm m (CompactSumKES h d)
     {-# NOINLINE rawSerialiseSignKeyKES #-}
     rawSerialiseSignKeyKES (SignKeyCompactSumKES sk r_1 vk_0 vk_1) = do
       ssk <- rawSerialiseSignKeyKES sk
-      sr1 <- NaCl.mlsbToByteString . mlockedSeedMLSB $ r_1
+      sr1 <- mlsbToByteString . mlockedSeedMLSB $ r_1
       return $ mconcat
                   [ ssk
                   , sr1
@@ -352,7 +352,7 @@ instance ( KESSignAlgorithm m (CompactSumKES h d)
     rawDeserialiseSignKeyKES b = runMaybeT $ do
         guard (BS.length b == fromIntegral size_total)
         sk   <- MaybeT $ rawDeserialiseSignKeyKES b_sk
-        r <- MaybeT $ NaCl.mlsbFromByteStringCheck b_r
+        r <- MaybeT $ mlsbFromByteStringCheck b_r
         vk_0 <- MaybeT . return $ rawDeserialiseVerKeyKES  b_vk0
         vk_1 <- MaybeT . return $ rawDeserialiseVerKeyKES  b_vk1
         return (SignKeyCompactSumKES sk (MLockedSeed r) vk_0 vk_1)
@@ -406,7 +406,7 @@ deriving via OnlyCheckWhnfNamed "SignKeyKES (CompactSumKES h d)" (SignKeyKES (Co
 instance (KESAlgorithm d) => NoThunks (VerKeyKES (CompactSumKES h d))
 
 instance ( OptimizedKESAlgorithm d
-         , NaCl.SodiumHashAlgorithm h
+         , SodiumHashAlgorithm h
          , SizeHash h ~ SeedSizeKES d
          , NoThunks (VerKeyKES (CompactSumKES h d))
          , KnownNat (SizeVerKeyKES (CompactSumKES h d))
@@ -418,7 +418,7 @@ instance ( OptimizedKESAlgorithm d
   encodedSizeExpr _size = encodedVerKeyKESSizeExpr
 
 instance ( OptimizedKESAlgorithm d
-         , NaCl.SodiumHashAlgorithm h
+         , SodiumHashAlgorithm h
          , SizeHash h ~ SeedSizeKES d
          , NoThunks (VerKeyKES (CompactSumKES h d))
          , KnownNat (SizeVerKeyKES (CompactSumKES h d))
@@ -458,7 +458,7 @@ deriving instance KESAlgorithm d => Eq   (SigKES (CompactSumKES h d))
 instance KESAlgorithm d => NoThunks (SigKES (CompactSumKES h d))
 
 instance ( OptimizedKESAlgorithm d
-         , NaCl.SodiumHashAlgorithm h
+         , SodiumHashAlgorithm h
          , SizeHash h ~ SeedSizeKES d
          , NoThunks (VerKeyKES (CompactSumKES h d))
          , KnownNat (SizeVerKeyKES (CompactSumKES h d))
@@ -470,7 +470,7 @@ instance ( OptimizedKESAlgorithm d
   encodedSizeExpr _size = encodedSigKESSizeExpr
 
 instance ( OptimizedKESAlgorithm d
-         , NaCl.SodiumHashAlgorithm h
+         , SodiumHashAlgorithm h
          , SizeHash h ~ SeedSizeKES d
          , NoThunks (VerKeyKES (CompactSumKES h d))
          , KnownNat (SizeVerKeyKES (CompactSumKES h d))

cardano-crypto-class/src/Cardano/Crypto/KES/Mock.hs

@@ -34,7 +34,9 @@ import Cardano.Crypto.Seed
 import Cardano.Crypto.KES.Class
 import Cardano.Crypto.Util
 import Cardano.Crypto.MLockedSeed
-import Cardano.Crypto.MonadSodium (mlsbAsByteString)
+import Cardano.Crypto.MonadMLock
+  ( mlsbAsByteString
+  )
 
 data MockKES (t :: Nat)
 

cardano-crypto-class/src/Cardano/Crypto/KES/Simple.hs

@@ -40,7 +40,7 @@ import           Cardano.Crypto.MLockedSeed
 import           Cardano.Crypto.Libsodium.MLockedBytes
 import           Cardano.Crypto.Util
 import           Data.Unit.Strict (forceElemsToWHNF)
-import           Cardano.Crypto.MonadSodium (MonadSodium (..), MEq (..))
+import           Cardano.Crypto.MonadMLock (MonadMLock (..), MEq (..))
 
 
 data SimpleKES d (t :: Nat)
@@ -143,7 +143,7 @@ instance ( KESAlgorithm (SimpleKES d t)
          , KnownNat t
          , KnownNat (SeedSizeDSIGNM d * t)
          , MonadEvaluate m
-         , MonadSodium m
+         , MonadMLock m
          , MonadST m
          ) =>
          KESSignAlgorithm m (SimpleKES d t) where

cardano-crypto-class/src/Cardano/Crypto/KES/Sum.hs

@@ -64,13 +64,14 @@ import           Cardano.Crypto.KES.Class
 import           Cardano.Crypto.KES.Single (SingleKES)
 import           Cardano.Crypto.Util
 import           Cardano.Crypto.MLockedSeed
-import qualified Cardano.Crypto.MonadSodium as NaCl
-import           Control.Monad.Class.MonadST (MonadST)
+import           Cardano.Crypto.MonadMLock
+import           Control.Monad.Class.MonadST (MonadST (..))
 import           Control.Monad.Class.MonadThrow (MonadThrow)
 import           Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
 import           Control.DeepSeq (NFData (..))
 import           GHC.TypeLits (KnownNat, type (+), type (*))
 
+
 -- | A 2^0 period KES
 type Sum0KES d   = SingleKES d
 
@@ -115,7 +116,7 @@ instance (NFData (SignKeyKES d), NFData (VerKeyKES d)) =>
       rnf (sk, r, vk1, vk2)
 
 instance ( KESAlgorithm d
-         , NaCl.SodiumHashAlgorithm h -- needed for secure forgetting
+         , SodiumHashAlgorithm h -- needed for secure forgetting
          , SizeHash h ~ SeedSizeKES d -- can be relaxed
          , KnownNat ((SizeSignKeyKES d + SeedSizeKES d) + (2 * SizeVerKeyKES d))
          , KnownNat (SizeSigKES d + (SizeVerKeyKES d * 2))
@@ -220,9 +221,9 @@ instance ( KESAlgorithm d
         off_vk1    = off_vk0 + size_vk
 
 instance ( KESSignAlgorithm m d
-         , NaCl.SodiumHashAlgorithm h -- needed for secure forgetting
+         , SodiumHashAlgorithm h -- needed for secure forgetting
          , SizeHash h ~ SeedSizeKES d -- can be relaxed
-         , NaCl.MonadSodium m
+         , MonadMLock m
          , MonadST m -- only needed for unsafe raw ser/deser
          , MonadThrow m
          , KnownNat ((SizeSignKeyKES d + SeedSizeKES d) + (2 * SizeVerKeyKES d))
@@ -276,7 +277,7 @@ instance ( KESSignAlgorithm m d
 
     {-# NOINLINE genKeyKES #-}
     genKeyKES r = do
-      (r0raw, r1raw) <- NaCl.expandHash (Proxy :: Proxy h) (mlockedSeedMLSB r)
+      (r0raw, r1raw) <- expandHash (Proxy :: Proxy h) (mlockedSeedMLSB r)
       let r0 = MLockedSeed r0raw
           r1 = MLockedSeed r1raw
       sk_0 <- genKeyKES r0
@@ -296,7 +297,7 @@ instance ( KESSignAlgorithm m d
 
 instance ( KESSignAlgorithm m (SumKES h d)
          , UnsoundKESSignAlgorithm m d
-         , NaCl.MonadSodium m
+         , MonadMLock m
          , MonadST m
          ) => UnsoundKESSignAlgorithm m (SumKES h d) where
     --
@@ -306,7 +307,7 @@ instance ( KESSignAlgorithm m (SumKES h d)
     {-# NOINLINE rawSerialiseSignKeyKES #-}
     rawSerialiseSignKeyKES (SignKeySumKES sk r_1 vk_0 vk_1) = do
       ssk <- rawSerialiseSignKeyKES sk
-      sr1 <- NaCl.mlsbToByteString . mlockedSeedMLSB $ r_1
+      sr1 <- mlsbToByteString . mlockedSeedMLSB $ r_1
       return $ mconcat
                   [ ssk
                   , sr1
@@ -318,7 +319,7 @@ instance ( KESSignAlgorithm m (SumKES h d)
     rawDeserialiseSignKeyKES b = runMaybeT $ do
         guard (BS.length b == fromIntegral size_total)
         sk   <- MaybeT $ rawDeserialiseSignKeyKES b_sk
-        r <- MaybeT $ NaCl.mlsbFromByteStringCheck b_r
+        r <- MaybeT $ mlsbFromByteStringCheck b_r
         vk_0 <- MaybeT . return $ rawDeserialiseVerKeyKES  b_vk0
         vk_1 <- MaybeT . return $ rawDeserialiseVerKeyKES  b_vk1
         return (SignKeySumKES sk (MLockedSeed r) vk_0 vk_1)
@@ -346,12 +347,12 @@ instance ( KESSignAlgorithm m (SumKES h d)
 deriving instance HashAlgorithm h => Show (VerKeyKES (SumKES h d))
 deriving instance Eq   (VerKeyKES (SumKES h d))
 
-instance (KESAlgorithm (SumKES h d), NaCl.SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d)
+instance (KESAlgorithm (SumKES h d), SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d)
       => ToCBOR (VerKeyKES (SumKES h d)) where
   toCBOR = encodeVerKeyKES
   encodedSizeExpr _size = encodedVerKeyKESSizeExpr
 
-instance (KESAlgorithm (SumKES h d), NaCl.SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d)
+instance (KESAlgorithm (SumKES h d), SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d)
       => FromCBOR (VerKeyKES (SumKES h d)) where
   fromCBOR = decodeVerKeyKES
 
@@ -385,11 +386,11 @@ deriving instance (KESAlgorithm d, KESAlgorithm (SumKES h d)) => Eq (SigKES (Sum
 
 instance KESAlgorithm d => NoThunks (SigKES (SumKES h d))
 
-instance (KESAlgorithm (SumKES h d), NaCl.SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d)
+instance (KESAlgorithm (SumKES h d), SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d)
       => ToCBOR (SigKES (SumKES h d)) where
   toCBOR = encodeSigKES
   encodedSizeExpr _size = encodedSigKESSizeExpr
 
-instance (KESAlgorithm (SumKES h d), NaCl.SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d)
+instance (KESAlgorithm (SumKES h d), SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d)
       => FromCBOR (SigKES (SumKES h d)) where
   fromCBOR = decodeSigKES

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

@@ -23,4 +23,4 @@ module Cardano.Crypto.Libsodium (
 ) where
 
 import Cardano.Crypto.Libsodium.Init
-import Cardano.Crypto.MonadSodium
+import Cardano.Crypto.MonadMLock

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

@@ -21,8 +21,8 @@ import GHC.TypeLits
 import Cardano.Crypto.Hash (HashAlgorithm(SizeHash))
 import Cardano.Crypto.Libsodium.Hash.Class
 import Cardano.Crypto.Libsodium.MLockedBytes.Internal
-import Cardano.Crypto.MonadSodium.Class
-import Cardano.Crypto.MonadSodium.Alloc
+import Cardano.Crypto.MonadMLock.Class
+import Cardano.Crypto.MonadMLock.Alloc
 import Control.Monad.Class.MonadST (MonadST (..))
 import Control.Monad.Class.MonadThrow (MonadThrow)
 import Control.Monad.ST.Unsafe (unsafeIOToST)
@@ -33,7 +33,7 @@ import Control.Monad.ST.Unsafe (unsafeIOToST)
 
 expandHash
     :: forall h m proxy.
-       (SodiumHashAlgorithm h, MonadSodium m, MonadST m, MonadThrow m)
+       (SodiumHashAlgorithm h, MonadMLock m, MonadST m, MonadThrow m)
     => proxy h
     -> MLockedSizedBytes (SizeHash h)
     -> m (MLockedSizedBytes (SizeHash h), MLockedSizedBytes (SizeHash h))