Allow to generate reward account addresses

command-line/cardano-addresses-cli.cabal

@@ -38,6 +38,7 @@ library
       Command.Address.Inspect
       Command.Address.Payment
       Command.Address.Pointer
+      Command.Address.Reward
       Command.Key
       Command.Key.Child
       Command.Key.FromRecoveryPhrase

command-line/lib/Command/Address.hs

@@ -29,6 +29,7 @@ import qualified Command.Address.Delegation as Delegation
 import qualified Command.Address.Inspect as Inspect
 import qualified Command.Address.Payment as Payment
 import qualified Command.Address.Pointer as Pointer
+import qualified Command.Address.Reward as Reward
 
 
 data Cmd
@@ -37,6 +38,7 @@ data Cmd
     | Delegation Delegation.Cmd
     | Pointer Pointer.Cmd
     | Inspect Inspect.Cmd
+    | Reward Reward.Cmd
     deriving (Show)
 
 mod :: (Cmd -> parent) -> Mod CommandFields parent
@@ -57,6 +59,7 @@ mod liftCmd = command "address" $
         , Delegation.mod Delegation
         , Pointer.mod Pointer
         , Inspect.mod Inspect
+        , Reward.mod Reward
         ]
 
 run :: Cmd -> IO ()
@@ -66,3 +69,4 @@ run = \case
     Delegation sub -> Delegation.run sub
     Pointer sub -> Pointer.run sub
     Inspect sub -> Inspect.run sub
+    Reward sub -> Reward.run sub

command-line/lib/Command/Address/Reward.hs

@@ -0,0 +1,75 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+{-# OPTIONS_HADDOCK hide #-}
+
+module Command.Address.Reward
+    ( Cmd
+    , mod
+    , run
+    ) where
+
+import Prelude hiding
+    ( mod )
+
+import Cardano.Address
+    ( NetworkTag (..), bech32 )
+import Cardano.Address.Style.Shelley
+    ( MkNetworkDiscriminantError (..), mkNetworkDiscriminant )
+import Options.Applicative
+    ( CommandFields, Mod, command, footerDoc, header, helper, info, progDesc )
+import Options.Applicative.Discrimination
+    ( networkTagOpt )
+import Options.Applicative.Help.Pretty
+    ( bold, indent, string, vsep )
+import Options.Applicative.Style
+    ( Style (..) )
+import System.IO
+    ( stdin, stdout )
+import System.IO.Extra
+    ( hGetXPub, progName )
+
+import qualified Cardano.Address.Style.Shelley as Shelley
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.Text.Encoding as T
+
+
+newtype Cmd = Cmd
+    { networkTag :: NetworkTag
+    } deriving (Show)
+
+mod :: (Cmd -> parent) -> Mod CommandFields parent
+mod liftCmd = command "reward" $
+    info (helper <*> fmap liftCmd parser) $ mempty
+        <> progDesc "Create a reward account address"
+        <> header "Create a reward account address \
+            \that references a staking key (1-1)."
+        <> footerDoc (Just $ vsep
+            [ string "The is read from stdin."
+            , string ""
+            , string "Example:"
+            , indent 2 $ bold $ string $ "$ "<>progName<>" recovery-phrase generate --size 15 \\"
+            , indent 4 $ bold $ string $ "| "<>progName<>" key from-recovery-phrase Shelley > root.prv"
+            , indent 2 $ string ""
+            , indent 2 $ bold $ string "$ cat root.prv \\"
+            , indent 4 $ bold $ string $ "| "<>progName<>" key child 1852H/1815H/0H/2/0 > stake.prv"
+            , indent 2 $ string ""
+            , indent 2 $ bold $ string "$ cat stake.prv \\"
+            , indent 4 $ bold $ string $ "| "<>progName<>" key public \\"
+            , indent 4 $ bold $ string $ "| "<>progName<>" address reward --network-tag 0"
+            , indent 2 $ string "addr1uqly0fjvrgguywze067gwhsexggtj8rrdnxczgp5vexe8zgxqns3g"
+            ])
+  where
+    parser = Cmd
+        <$> networkTagOpt Shelley
+
+run :: Cmd -> IO ()
+run Cmd{networkTag} = do
+    xpub <- hGetXPub stdin
+    case (mkNetworkDiscriminant . fromIntegral . unNetworkTag) networkTag of
+        Left ErrWrongNetworkTag{} -> do
+            fail "Invalid network tag. Must be between [0, 15]"
+        Right discriminant -> do
+            let addr = Shelley.rewardAccAddress discriminant (Shelley.liftXPub xpub)
+            B8.hPutStr stdout $ T.encodeUtf8 $ bech32 addr
+
+

core/lib/Cardano/Address.hs

@@ -14,6 +14,7 @@ module Cardano.Address
     ( -- * Address
       Address
     , PaymentAddress (..)
+    , RewardAccAddress (..)
     , DelegationAddress (..)
     , PointerAddress (..)
     , ChainPointer (..)
@@ -121,6 +122,16 @@ fromBech32 :: Text -> Maybe Address
 fromBech32 =
     eitherToMaybe . fmap unsafeMkAddress. E.fromBech32 (const id) . T.encodeUtf8
 
+-- | Encoding of addresses for certain key types and backend targets.
+--
+-- @since 1.0.0
+class HasNetworkDiscriminant key => RewardAccAddress key where
+    -- | Convert a staking key to a reward account 'Address' valid for the given
+    -- network discrimination.
+    --
+    -- @since 1.0.0
+    rewardAccAddress :: NetworkDiscriminant key -> key 'StakingK XPub -> Address
+
 -- | Encoding of addresses for certain key types and backend targets.
 --
 -- @since 1.0.0

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

@@ -39,6 +39,7 @@ module Cardano.Address.Style.Shelley
     , paymentAddress
     , delegationAddress
     , pointerAddress
+    , rewardAccAddress
     , extendAddress
     , ErrExtendAddress (..)
 
@@ -375,6 +376,19 @@ deriveStakingPrivateKey =
 -- > bech32 $ pointerAddress tag (toXPub <$> addrK) ptr
 -- > "addr1gxpfffuj3zkp5g7ct6h4va89caxx9ayq2gvkyfvww48sdnmmqypqfcp5um"
 
+instance Internal.RewardAccAddress Shelley where
+    rewardAccAddress discrimination k = unsafeMkAddress $
+        invariantSize expectedLength $ BL.toStrict $ runPut $ do
+            putWord8 firstByte
+            putByteString (blake2b224 k)
+      where
+          -- First 4 bits are `1110` for keyhash28 reward account address.
+          -- Next 4 bits are network discriminator.
+          -- `1110 0000` is 224 in decimal.
+          firstByte =
+              224 + invariantNetworkTag 16 (networkTag @Shelley discrimination)
+          expectedLength = 1 + pubkeyHashSize
+
 instance Internal.PaymentAddress Shelley where
     paymentAddress discrimination k = unsafeMkAddress $
         invariantSize expectedLength $ BL.toStrict $ runPut $ do
@@ -634,6 +648,20 @@ pointerAddress
 pointerAddress =
     Internal.pointerAddress
 
+-- Re-export from 'Cardano.Address' to have it documented specialized in Haddock.
+--
+-- | Convert a staking key to a
+-- reward account 'Address' valid for the given network discrimination.
+--
+-- @since 2.0.0 ??
+rewardAccAddress
+    :: NetworkDiscriminant Shelley
+    -> Shelley 'StakingK XPub
+    -> Address
+rewardAccAddress =
+    Internal.rewardAccAddress
+
+
 --
 -- Network Discriminant
 --