Reinstate sign key deserialization

IntersectMBO · Jan 28, 2021 · 616e48b · 616e48b
1 parent 8ccc38c
commit 616e48b
Show file tree

Hide file tree

Showing 5 changed files with 51 additions and 22 deletions.
diff --git a/cardano-crypto-class/src/Cardano/Crypto/KES/Mock.hs b/cardano-crypto-class/src/Cardano/Crypto/KES/Mock.hs
@@ -160,6 +160,16 @@ instance KnownNat t => KESAlgorithm (MockKES t) where
       | otherwise
       = Nothing
 
+    rawDeserialiseSignKeyKES bs
+      | [vkb, tb] <- splitsAt [8, 8] bs
+      , Just vk   <- rawDeserialiseVerKeyKES vkb
+      , let t      = fromIntegral (readBinaryWord64 tb)
+      = return . Just $! SignKeyMockKES vk t
+
+      | otherwise
+      = return Nothing
+
+
 
 
 instance KnownNat t => ToCBOR (VerKeyKES (MockKES t)) where

diff --git a/cardano-crypto-class/src/Cardano/Crypto/KES/Simple.hs b/cardano-crypto-class/src/Cardano/Crypto/KES/Simple.hs
@@ -29,6 +29,7 @@ import qualified Data.Vector as Vec
 import           GHC.Generics (Generic)
 import           GHC.TypeNats (Nat, KnownNat, natVal, type (*))
 import           NoThunks.Class (NoThunks)
+import           Control.Monad.Trans.Maybe
 
 import           Cardano.Prelude (forceElemsToWHNF)
 import           Cardano.Binary (FromCBOR (..), ToCBOR (..))
@@ -177,6 +178,17 @@ instance (DSIGNAlgorithm d, Typeable d, KnownNat t, KnownNat (SeedSizeDSIGN d *
 
     rawDeserialiseSigKES = fmap SigSimpleKES . rawDeserialiseSigDSIGN
 
+    rawDeserialiseSignKeyKES bs
+      | let duration = fromIntegral (natVal (Proxy :: Proxy t))
+            sizeKey  = fromIntegral (sizeSignKeyDSIGN (Proxy :: Proxy d))
+      , skbs     <- splitsAt (replicate duration sizeKey) bs
+      , length skbs == duration
+      = runMaybeT $ do
+          sks <- mapM (MaybeT . return . rawDeserialiseSignKeyDSIGN) skbs
+          return $! SignKeySimpleKES (Vec.fromList sks)
+
+      | otherwise
+      = return Nothing
 
 deriving instance DSIGNAlgorithm d => Show (VerKeyKES (SimpleKES d t))
 deriving instance DSIGNAlgorithm d => Show (SignKeyKES (SimpleKES d t))

diff --git a/cardano-crypto-class/src/Cardano/Crypto/KES/Single.hs b/cardano-crypto-class/src/Cardano/Crypto/KES/Single.hs
@@ -147,6 +147,10 @@ instance ( NaCl.SodiumDSIGNAlgorithm d -- needed for secure forgetting
 
     rawDeserialiseVerKeyKES  = fmap VerKeySingleKES  . psbFromByteStringCheck
     rawDeserialiseSigKES     = fmap SigSingleKES     . psbFromByteStringCheck
+    rawDeserialiseSignKeyKES bs = do
+      case NaCl.mlsbFromByteStringCheck bs of
+        Nothing -> return Nothing
+        Just x -> Just . SignKeySingleKES <$> makeSafePinned x
 
 --
 -- VerKey instances

diff --git a/cardano-crypto-class/src/Cardano/Crypto/KES/Sum.hs b/cardano-crypto-class/src/Cardano/Crypto/KES/Sum.hs
@@ -260,28 +260,28 @@ instance ( KESAlgorithm d
 
     rawDeserialiseVerKeyKES = fmap VerKeySumKES  . hashFromBytes
 
-    -- rawDeserialiseSignKeyKES b = do
-    --     guard (BS.length b == fromIntegral size_total)
-    --     sk   <- rawDeserialiseSignKeyKES b_sk
-    --     let r = mkSeedFromBytes          b_r
-    --     vk_0 <- rawDeserialiseVerKeyKES  b_vk0
-    --     vk_1 <- rawDeserialiseVerKeyKES  b_vk1
-    --     return (SignKeySumKES sk r vk_0 vk_1)
-    --   where
-    --     b_sk  = slice off_sk  size_sk b
-    --     b_r   = slice off_r   size_r  b
-    --     b_vk0 = slice off_vk0 size_vk b
-    --     b_vk1 = slice off_vk1 size_vk b
-
-    --     size_sk    = sizeSignKeyKES (Proxy :: Proxy d)
-    --     size_r     = seedSizeKES    (Proxy :: Proxy d)
-    --     size_vk    = sizeVerKeyKES  (Proxy :: Proxy d)
-    --     size_total = sizeSignKeyKES (Proxy :: Proxy (SumKES h d))
-
-    --     off_sk     = 0 :: Word
-    --     off_r      = size_sk
-    --     off_vk0    = off_r + size_r
-    --     off_vk1    = off_vk0 + size_vk
+    rawDeserialiseSignKeyKES b = runMaybeT $ do
+        guard (BS.length b == fromIntegral size_total)
+        sk   <- MaybeT $ rawDeserialiseSignKeyKES b_sk
+        r <- MaybeT . return $ NaCl.mlsbFromByteStringCheck b_r
+        vk_0 <- MaybeT . return $ rawDeserialiseVerKeyKES  b_vk0
+        vk_1 <- MaybeT . return $ rawDeserialiseVerKeyKES  b_vk1
+        return (SignKeySumKES sk r vk_0 vk_1)
+      where
+        b_sk  = slice off_sk  size_sk b
+        b_r   = slice off_r   size_r  b
+        b_vk0 = slice off_vk0 size_vk b
+        b_vk1 = slice off_vk1 size_vk b
+
+        size_sk    = sizeSignKeyKES (Proxy :: Proxy d)
+        size_r     = seedSizeKES    (Proxy :: Proxy d)
+        size_vk    = sizeVerKeyKES  (Proxy :: Proxy d)
+        size_total = sizeSignKeyKES (Proxy :: Proxy (SumKES h d))
+
+        off_sk     = 0 :: Word
+        off_r      = size_sk
+        off_vk0    = off_r + size_r
+        off_vk1    = off_vk0 + size_vk
 
     rawDeserialiseSigKES b = do
         guard (BS.length b == fromIntegral size_total)

diff --git a/cardano-crypto-tests/src/Test/Crypto/KES.hs b/cardano-crypto-tests/src/Test/Crypto/KES.hs
@@ -231,6 +231,9 @@ testKESAlgorithm _p n =
         , testProperty "Sig"     $ prop_raw_serialise @(SigKES v)
                                                       rawSerialiseSigKES
                                                       rawDeserialiseSigKES
+        , testProperty "SignKey" $ prop_raw_serialise @(SignKeyKES v)
+                                                      (unsafePerformIO . io . rawSerialiseSignKeyKES)
+                                                      (unsafePerformIO . io . rawDeserialiseSignKeyKES)
         ]
 
       , testGroup "size"