Merge pull request #259 from IntersectMBO/paweljakubas/cip-105-core

CIP-0105 - core

core/lib/Cardano/Address/Derivation.hs

@@ -363,7 +363,7 @@ credentialHashSize = hashDigestSize Blake2b_224
 -- are no constructors for these.
 --
 -- @since 1.0.0
-data Depth = RootK | AccountK | PaymentK | DelegationK | ScriptK | PolicyK
+data Depth = RootK | AccountK | PaymentK | DelegationK | DRepK | CCColdK | CCHotK | ScriptK | PolicyK
 
 -- | A derivation index, with phantom-types to disambiguate derivation type.
 --

core/lib/Cardano/Address/Script.hs

@@ -222,7 +222,14 @@ scriptHashFromBytes bytes
     | BS.length bytes /= credentialHashSize = Nothing
     | otherwise = Just $ ScriptHash bytes
 
-data KeyRole = Payment | Delegation | Policy | Unknown
+data KeyRole =
+      Payment
+    | Delegation
+    | Policy
+    | Representative
+    | CommitteeCold
+    | CommitteeHot
+    | Unknown
     deriving (Generic, Show, Ord, Eq)
 instance NFData KeyRole
 
@@ -255,6 +262,12 @@ keyHashToText (KeyHash cred keyHash) = case cred of
         T.decodeUtf8 $ encode (EBech32 CIP5.stake_shared_vkh) keyHash
     Policy ->
         T.decodeUtf8 $ encode (EBech32 CIP5.policy_vkh) keyHash
+    Representative ->
+        T.decodeUtf8 $ encode (EBech32 CIP5.drep) keyHash
+    CommitteeCold ->
+        T.decodeUtf8 $ encode (EBech32 CIP5.cc_cold) keyHash
+    CommitteeHot ->
+        T.decodeUtf8 $ encode (EBech32 CIP5.cc_hot) keyHash
     Unknown ->
         T.decodeUtf8 $ encode EBase16 keyHash
 
@@ -265,16 +278,24 @@ keyHashToText (KeyHash cred keyHash) = case cred of
 -- - `addr_vkh`
 -- - `stake_vkh`
 -- - `policy_vkh`
+-- - `drep`
+-- - `cc_cold`
+-- - `cc_hot`
 -- - `addr_shared_vk`
 -- - `stake_shared_vk`
 -- - `addr_vk`
 -- - `stake_vk`
+-- - `policy_vk`
+-- - `cc_cold_vk`
+-- - `cc_hot_vk`
 -- - `addr_shared_xvk`
 -- - `stake_shared_xvk`
 -- - `addr_xvk`
 -- - `stake_xvk`
--- - `policy_vk`
 -- - `policy_xvk`
+-- - `drep_xvk`
+-- - `cc_cold_xvk`
+-- - `cc_hot_xvk`
 -- Raw keys will be hashed on the fly, whereas hash that are directly
 -- provided will remain as such.
 -- If if hex is encountered Unknown policy key is assumed
@@ -311,6 +332,12 @@ keyHashFromText txt =
               Just (Delegation, bytes)
         | hrp == CIP5.policy_vkh && checkBSLength bytes 28 =
               Just (Policy, bytes)
+        | hrp == CIP5.drep && checkBSLength bytes 28 =
+              Just (Representative, bytes)
+        | hrp == CIP5.cc_cold && checkBSLength bytes 28 =
+              Just (CommitteeCold, bytes)
+        | hrp == CIP5.cc_hot && checkBSLength bytes 28 =
+              Just (CommitteeHot, bytes)
         | hrp == CIP5.addr_shared_vk && checkBSLength bytes 32 =
               Just (Payment, hashCredential bytes)
         | hrp == CIP5.addr_vk && checkBSLength bytes 32 =
@@ -331,6 +358,18 @@ keyHashFromText txt =
               Just (Policy, hashCredential bytes)
         | hrp == CIP5.policy_xvk && checkBSLength bytes 64 =
               Just (Policy, hashCredential $ BS.take 32 bytes)
+        | hrp == CIP5.drep_vk && checkBSLength bytes 32 =
+              Just (Representative, hashCredential bytes)
+        | hrp == CIP5.drep_xvk && checkBSLength bytes 64 =
+              Just (Representative, hashCredential $ BS.take 32 bytes)
+        | hrp == CIP5.cc_cold_vk && checkBSLength bytes 32 =
+              Just (CommitteeCold, hashCredential bytes)
+        | hrp == CIP5.cc_cold_xvk && checkBSLength bytes 64 =
+              Just (CommitteeCold, hashCredential $ BS.take 32 bytes)
+        | hrp == CIP5.cc_hot_vk && checkBSLength bytes 32 =
+              Just (CommitteeHot, hashCredential bytes)
+        | hrp == CIP5.cc_hot_xvk && checkBSLength bytes 64 =
+              Just (CommitteeHot, hashCredential $ BS.take 32 bytes)
         | otherwise = Nothing
     checkBSLength bytes expLength =
         BS.length bytes == expLength

core/lib/Cardano/Address/Style/Icarus.hs

@@ -14,6 +14,7 @@
 {-# LANGUAGE TypeFamilies #-}
 
 {-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 -- |
 -- Copyright: © 2018-2020 IOHK

core/lib/Cardano/Address/Style/Shelley.hs

@@ -16,6 +16,7 @@
 {-# LANGUAGE ViewPatterns #-}
 
 {-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 -- |
 -- Copyright: © 2018-2021 IOHK
@@ -40,6 +41,9 @@ module Cardano.Address.Style.Shelley
     , deriveAccountPrivateKey
     , deriveAddressPrivateKey
     , deriveDelegationPrivateKey
+    , deriveDRepPrivateKey
+    , deriveCCColdPrivateKey
+    , deriveCCHotPrivateKey
     , deriveAddressPublicKey
     , derivePolicyPrivateKey
 
@@ -209,12 +213,18 @@ instance (NFData key) => NFData (Shelley depth key)
 -- - UTxOExternal: used for public addresses sent to other parties for receiving money.
 -- - UTxOInternal: generated by wallet software to send change back to the wallet.
 -- - Stake: used for stake key(s) and delegation.
+-- - DRep: used for DRep key derivation
+-- - CCCold: used for constitutional committee cold key derivation
+-- - CCHot: used for constitutional committee hot key derivation
 --
 -- @since 3.0.0
 data Role
     = UTxOExternal
     | UTxOInternal
     | Stake
+    | DRep
+    | CCCold
+    | CCHot
     deriving (Generic, Typeable, Show, Eq, Ord, Bounded)
 
 instance NFData Role
@@ -224,13 +234,19 @@ roleFromIndex ix = case indexToWord32 ix of
     0 -> Just UTxOExternal
     1 -> Just UTxOInternal
     2 -> Just Stake
+    3 -> Just DRep
+    4 -> Just CCCold
+    5 -> Just CCHot
     _ -> Nothing
 
 roleToIndex :: Role -> Index 'Soft depth
 roleToIndex = unsafeMkIndex . \case
     UTxOExternal -> 0
     UTxOInternal -> 1
     Stake -> 2
+    DRep -> 3
+    CCCold -> 4
+    CCHot -> 5
 
 --
 -- Key Derivation
@@ -370,6 +386,60 @@ deriveDelegationPrivateKey accXPrv =
             deriveAddressPrivateKey accXPrv Stake (minBound @(Index 'Soft _))
     in Shelley stakeXPrv
 
+-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
+--
+-- | Derive a DRep key for a corresponding 'AccountK'. Note that wallet
+-- software are by convention only using one delegation key per account, and always
+-- the first account (with index 0').
+--
+-- Deriving DRep keys for something else than the initial account is not
+-- recommended and can lead to incompatibility with existing wallet softwares
+-- (Daedalus, Yoroi, Adalite...).
+--
+deriveDRepPrivateKey
+    :: Shelley 'AccountK XPrv
+    -> Shelley 'DRepK XPrv
+deriveDRepPrivateKey accXPrv =
+    let (Shelley drepXPrv) =
+            deriveAddressPrivateKey accXPrv DRep (minBound @(Index 'Soft _))
+    in Shelley drepXPrv
+
+-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
+--
+-- | Derive a CCCold key for a corresponding 'AccountK'. Note that wallet
+-- software are by convention only using one delegation key per account, and always
+-- the first account (with index 0').
+--
+-- Deriving CCCold keys for something else than the initial account is not
+-- recommended and can lead to incompatibility with existing wallet softwares
+-- (Daedalus, Yoroi, Adalite...).
+--
+deriveCCColdPrivateKey
+    :: Shelley 'AccountK XPrv
+    -> Shelley 'CCColdK XPrv
+deriveCCColdPrivateKey accXPrv =
+    let (Shelley ccColdXPrv) =
+            deriveAddressPrivateKey accXPrv CCCold (minBound @(Index 'Soft _))
+    in Shelley ccColdXPrv
+
+-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
+--
+-- | Derive a CCHot key for a corresponding 'AccountK'. Note that wallet
+-- software are by convention only using one delegation key per account, and always
+-- the first account (with index 0').
+--
+-- Deriving CCHot keys for something else than the initial account is not
+-- recommended and can lead to incompatibility with existing wallet softwares
+-- (Daedalus, Yoroi, Adalite...).
+--
+deriveCCHotPrivateKey
+    :: Shelley 'AccountK XPrv
+    -> Shelley 'CCHotK XPrv
+deriveCCHotPrivateKey accXPrv =
+    let (Shelley ccHotXPrv) =
+            deriveAddressPrivateKey accXPrv CCHot (minBound @(Index 'Soft _))
+    in Shelley ccHotXPrv
+
 --
 -- Addresses
 --

core/lib/Cardano/Codec/Bech32/Prefixes.hs

@@ -7,6 +7,7 @@
 -- | List common bech32 prefixes used for objects in the Cardano eco-systems.
 --
 -- As specified in [CIP-5](https://github.com/cardano-foundation/CIPs/tree/master/CIP5)
+-- and in [CIP-0105](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0105)
 module Cardano.Codec.Bech32.Prefixes
     ( -- * Addresses
       addr
@@ -62,6 +63,28 @@ module Cardano.Codec.Bech32.Prefixes
     , policy_xvk
     , policy_vkh
     , policy_xsk
+
+      -- * Keys/hashes for CIP-0105
+    , drep_vk
+    , drep_sk
+    , drep_xvk
+    , drep_xsk
+    , drep
+    , drep_script
+
+    , cc_cold_vk
+    , cc_cold_sk
+    , cc_cold_xvk
+    , cc_cold_xsk
+    , cc_cold
+    , cc_cold_script
+
+    , cc_hot_vk
+    , cc_hot_sk
+    , cc_hot_xvk
+    , cc_hot_xsk
+    , cc_hot
+    , cc_hot_script
     ) where
 
 import Codec.Binary.Bech32
@@ -212,3 +235,58 @@ policy_vkh = [humanReadablePart|policy_vkh|]
 
 policy_xsk :: HumanReadablePart
 policy_xsk = [humanReadablePart|policy_xsk|]
+
+-- Keys/hashes for CIP-0105
+drep_vk :: HumanReadablePart
+drep_vk = [humanReadablePart|drep_vk|]
+
+drep_sk :: HumanReadablePart
+drep_sk = [humanReadablePart|drep_sk|]
+
+drep_xvk :: HumanReadablePart
+drep_xvk = [humanReadablePart|drep_xvk|]
+
+drep_xsk :: HumanReadablePart
+drep_xsk = [humanReadablePart|drep_xsk|]
+
+drep :: HumanReadablePart
+drep = [humanReadablePart|drep|]
+
+drep_script :: HumanReadablePart
+drep_script = [humanReadablePart|drep_script|]
+
+cc_cold_vk :: HumanReadablePart
+cc_cold_vk = [humanReadablePart|cc_cold_vk|]
+
+cc_cold_sk :: HumanReadablePart
+cc_cold_sk = [humanReadablePart|cc_cold_sk|]
+
+cc_cold_xvk :: HumanReadablePart
+cc_cold_xvk = [humanReadablePart|cc_cold_xvk|]
+
+cc_cold_xsk :: HumanReadablePart
+cc_cold_xsk = [humanReadablePart|cc_cold_xsk|]
+
+cc_cold :: HumanReadablePart
+cc_cold = [humanReadablePart|cc_cold|]
+
+cc_cold_script :: HumanReadablePart
+cc_cold_script = [humanReadablePart|cc_cold_script|]
+
+cc_hot_vk :: HumanReadablePart
+cc_hot_vk = [humanReadablePart|cc_hot_vk|]
+
+cc_hot_sk :: HumanReadablePart
+cc_hot_sk = [humanReadablePart|cc_hot_sk|]
+
+cc_hot_xvk :: HumanReadablePart
+cc_hot_xvk = [humanReadablePart|cc_hot_xvk|]
+
+cc_hot_xsk :: HumanReadablePart
+cc_hot_xsk = [humanReadablePart|cc_hot_xsk|]
+
+cc_hot :: HumanReadablePart
+cc_hot = [humanReadablePart|cc_hot|]
+
+cc_hot_script :: HumanReadablePart
+cc_hot_script = [humanReadablePart|cc_hot_script|]

core/test/Cardano/Address/Script/ParserSpec.hs

@@ -2,6 +2,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
 module Cardano.Address.Script.ParserSpec
     ( spec
     ) where

core/test/Cardano/Address/ScriptSpec.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE TypeFamilies #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 module Cardano.Address.ScriptSpec
     ( spec
@@ -63,14 +64,7 @@ import Data.Text
 import Test.Arbitrary
     ()
 import Test.Hspec
-    ( Spec
-    , describe
-    , expectationFailure
-    , it
-    , shouldBe
-    , shouldContain
-    , shouldStartWith
-    )
+    ( Spec, describe, expectationFailure, it, shouldBe, shouldContain )
 import Test.QuickCheck
     ( Arbitrary (..)
     , Gen
@@ -781,7 +775,9 @@ instance Arbitrary KeyHash where
     arbitrary = do
         payload' <- BS.pack <$> vectorOf 28 arbitrary
         flip KeyHash payload' <$>
-            oneof [pure Payment, pure Delegation, pure Policy, pure Unknown]
+            oneof [ pure Payment, pure Delegation, pure Policy
+                  , pure Representative, pure CommitteeCold
+                  , pure CommitteeHot,  pure Unknown]
 
 instance Arbitrary Cosigner where
     arbitrary = Cosigner <$> arbitrary

core/test/Cardano/Address/Style/ByronSpec.hs

@@ -11,6 +11,7 @@
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 module Cardano.Address.Style.ByronSpec
     ( spec

core/test/Cardano/Address/Style/IcarusSpec.hs

@@ -11,6 +11,7 @@
 {-# LANGUAGE TypeOperators #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 module Cardano.Address.Style.IcarusSpec
     ( spec