diff --git a/cardano-crypto-class/src/Cardano/Crypto/KES/Class.hs b/cardano-crypto-class/src/Cardano/Crypto/KES/Class.hs index 0c7eb93b2..fd2a5d1ae 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/KES/Class.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/KES/Class.hs @@ -318,6 +318,9 @@ class KESAlgorithm v => UnsoundPureKESAlgorithm v where => UnsoundPureSignKeyKES v -> m (SignKeyKES v) + rawSerialiseUnsoundPureSignKeyKES :: UnsoundPureSignKeyKES v -> ByteString + rawDeserialiseUnsoundPureSignKeyKES :: ByteString -> Maybe (UnsoundPureSignKeyKES v) + -- | Unsound operations on KES sign keys. These operations violate secure -- forgetting constraints by leaking secrets to unprotected memory. Consider diff --git a/cardano-crypto-class/src/Cardano/Crypto/KES/CompactSingle.hs b/cardano-crypto-class/src/Cardano/Crypto/KES/CompactSingle.hs index bfb67c2f6..a1935e211 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/KES/CompactSingle.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/KES/CompactSingle.hs @@ -195,6 +195,11 @@ instance ( KESAlgorithm (CompactSingleKES d) maybe (error "unsoundPureSignKeyKESToSoundSignKeyKES: deserialisation failure") (return . SignKeyCompactSingleKES) =<< (rawDeserialiseSignKeyDSIGNM . rawSerialiseSignKeyDSIGN $ sk) + rawSerialiseUnsoundPureSignKeyKES (UnsoundPureSignKeyCompactSingleKES sk) = + rawSerialiseSignKeyDSIGN sk + rawDeserialiseUnsoundPureSignKeyKES b = + UnsoundPureSignKeyCompactSingleKES <$> rawDeserialiseSignKeyDSIGN b + instance ( KESAlgorithm (CompactSingleKES d) , DSIGNMAlgorithm d ) => OptimizedKESAlgorithm (CompactSingleKES d) where diff --git a/cardano-crypto-class/src/Cardano/Crypto/KES/CompactSum.hs b/cardano-crypto-class/src/Cardano/Crypto/KES/CompactSum.hs index 994dc14e4..9eba67a8e 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/KES/CompactSum.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/KES/CompactSum.hs @@ -532,6 +532,38 @@ instance ( KESAlgorithm (CompactSumKES h d) <*> pure vk_0 <*> pure vk_1 + rawSerialiseUnsoundPureSignKeyKES (UnsoundPureSignKeyCompactSumKES sk r_1 vk_0 vk_1) = + let ssk = rawSerialiseUnsoundPureSignKeyKES sk + sr1 = getSeedBytes r_1 + in mconcat + [ ssk + , sr1 + , rawSerialiseVerKeyKES vk_0 + , rawSerialiseVerKeyKES vk_1 + ] + + rawDeserialiseUnsoundPureSignKeyKES b = do + guard (BS.length b == fromIntegral size_total) + sk <- rawDeserialiseUnsoundPureSignKeyKES b_sk + let r = mkSeedFromBytes b_r + vk_0 <- rawDeserialiseVerKeyKES b_vk0 + vk_1 <- rawDeserialiseVerKeyKES b_vk1 + return (UnsoundPureSignKeyCompactSumKES 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 (CompactSumKES h d)) + + off_sk = 0 :: Word + off_r = size_sk + off_vk0 = off_r + size_r + off_vk1 = off_vk0 + size_vk -- diff --git a/cardano-crypto-class/src/Cardano/Crypto/KES/Mock.hs b/cardano-crypto-class/src/Cardano/Crypto/KES/Mock.hs index 50d86a762..4a9f43e63 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/KES/Mock.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/KES/Mock.hs @@ -204,6 +204,13 @@ instance KnownNat t => UnsoundPureKESAlgorithm (MockKES t) where unsoundPureSignKeyKESToSoundSignKeyKES (UnsoundPureSignKeyMockKES vk t) = return $ SignKeyMockKES vk t + rawSerialiseUnsoundPureSignKeyKES (UnsoundPureSignKeyMockKES vk t) = + rawSerialiseSignKeyMockKES (SignKeyMockKES vk t) + + rawDeserialiseUnsoundPureSignKeyKES bs = do + SignKeyMockKES vt t <- rawDeserialiseSignKeyMockKES bs + return $ UnsoundPureSignKeyMockKES vt t + instance KnownNat t => UnsoundKESAlgorithm (MockKES t) where rawSerialiseSignKeyKES sk = return $ rawSerialiseSignKeyMockKES sk diff --git a/cardano-crypto-class/src/Cardano/Crypto/KES/NeverUsed.hs b/cardano-crypto-class/src/Cardano/Crypto/KES/NeverUsed.hs index a7ca88df9..43ab9561e 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/KES/NeverUsed.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/KES/NeverUsed.hs @@ -75,3 +75,5 @@ instance UnsoundPureKESAlgorithm NeverKES where unsoundPureDeriveVerKeyKES _ = NeverUsedVerKeyKES unsoundPureUpdateKES _ = error "KES not available" unsoundPureSignKeyKESToSoundSignKeyKES _ = return NeverUsedSignKeyKES + rawSerialiseUnsoundPureSignKeyKES _ = mempty + rawDeserialiseUnsoundPureSignKeyKES _ = Just NeverUsedUnsoundPureSignKeyKES diff --git a/cardano-crypto-class/src/Cardano/Crypto/KES/Simple.hs b/cardano-crypto-class/src/Cardano/Crypto/KES/Simple.hs index ccbb1e0e2..00de81d7c 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/KES/Simple.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/KES/Simple.hs @@ -230,6 +230,22 @@ instance ( KESAlgorithm (SimpleKES d t) . rawDeserialiseSignKeyDSIGNM . rawSerialiseSignKeyDSIGN + rawSerialiseUnsoundPureSignKeyKES (UnsoundPureSignKeySimpleKES sks) = + BS.concat $! map rawSerialiseSignKeyDSIGN (Vec.toList sks) + + + rawDeserialiseUnsoundPureSignKeyKES bs + | let duration = fromIntegral (natVal (Proxy :: Proxy t)) + sizeKey = fromIntegral (sizeSignKeyDSIGN (Proxy :: Proxy d)) + skbs = splitsAt (replicate duration sizeKey) bs + , length skbs == duration + = do + sks <- mapM rawDeserialiseSignKeyDSIGN skbs + return $! UnsoundPureSignKeySimpleKES (Vec.fromList sks) + + | otherwise + = Nothing + instance ( UnsoundDSIGNMAlgorithm d, KnownNat t, KESAlgorithm (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 index 356c2610d..5d63520a0 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/KES/Single.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/KES/Single.hs @@ -166,6 +166,11 @@ instance ( KESAlgorithm (SingleKES d) maybe (error "unsoundPureSignKeyKESToSoundSignKeyKES: deserialisation failure") (return . SignKeySingleKES) =<< (rawDeserialiseSignKeyDSIGNM . rawSerialiseSignKeyDSIGN $ sk) + rawSerialiseUnsoundPureSignKeyKES (UnsoundPureSignKeySingleKES sk) = + rawSerialiseSignKeyDSIGN sk + rawDeserialiseUnsoundPureSignKeyKES b = + UnsoundPureSignKeySingleKES <$> rawDeserialiseSignKeyDSIGN b + instance (KESAlgorithm (SingleKES d), UnsoundDSIGNMAlgorithm d) => UnsoundKESAlgorithm (SingleKES d) where rawSerialiseSignKeyKES (SignKeySingleKES sk) = diff --git a/cardano-crypto-class/src/Cardano/Crypto/KES/Sum.hs b/cardano-crypto-class/src/Cardano/Crypto/KES/Sum.hs index ca73e230d..4b314a2b0 100644 --- a/cardano-crypto-class/src/Cardano/Crypto/KES/Sum.hs +++ b/cardano-crypto-class/src/Cardano/Crypto/KES/Sum.hs @@ -451,6 +451,40 @@ instance ( KESAlgorithm (SumKES h d) <*> pure vk_0 <*> pure vk_1 + rawSerialiseUnsoundPureSignKeyKES (UnsoundPureSignKeySumKES sk r_1 vk_0 vk_1) = + let ssk = rawSerialiseUnsoundPureSignKeyKES sk + sr1 = getSeedBytes r_1 + in mconcat + [ ssk + , sr1 + , rawSerialiseVerKeyKES vk_0 + , rawSerialiseVerKeyKES vk_1 + ] + + rawDeserialiseUnsoundPureSignKeyKES b = do + guard (BS.length b == fromIntegral size_total) + sk <- rawDeserialiseUnsoundPureSignKeyKES b_sk + let r = mkSeedFromBytes b_r + vk_0 <- rawDeserialiseVerKeyKES b_vk0 + vk_1 <- rawDeserialiseVerKeyKES b_vk1 + return (UnsoundPureSignKeySumKES 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 + + -- -- Direct ser/deser