never executed always true always false

    1 {-# LANGUAGE FlexibleContexts #-}
    2 {-# LANGUAGE NamedFieldPuns #-}
    3 {-# LANGUAGE OverloadedStrings #-}
    4 {-# LANGUAGE TypeSynonymInstances #-}
    5 
    6 {-# OPTIONS_HADDOCK hide #-}
    7 
    8 module Command.Key.WalletId
    9     ( Cmd (..)
   10     , mod
   11     , run
   12     ) where
   13 
   14 import Prelude hiding
   15     ( mod )
   16 
   17 import Cardano.Address.Derivation
   18     ( hashWalletId, toXPub, xprvFromBytes, xpubToBytes )
   19 import Cardano.Address.Script
   20     ( Cosigner, Script )
   21 import Cardano.Address.Style.Shared
   22     ( sharedWalletId )
   23 import Codec.Binary.Encoding
   24     ( AbstractEncoding (..) )
   25 import Control.Monad
   26     ( when )
   27 import Data.Maybe
   28     ( fromJust, isNothing )
   29 import Options.Applicative
   30     ( CommandFields
   31     , Mod
   32     , command
   33     , footerDoc
   34     , helper
   35     , info
   36     , optional
   37     , progDesc
   38     )
   39 import Options.Applicative.Help.Pretty
   40     ( string )
   41 import Options.Applicative.Script
   42     ( scriptTemplateSpendingArg, scriptTemplateStakingArg )
   43 import System.IO
   44     ( stdin, stdout )
   45 import System.IO.Extra
   46     ( hGetBech32, hPutBytes )
   47 
   48 import qualified Cardano.Codec.Bech32.Prefixes as CIP5
   49 import qualified Data.ByteString as BS
   50 
   51 data Cmd = WalletId
   52     { spending :: Maybe (Script Cosigner)
   53     , staking :: Maybe (Script Cosigner)
   54     } deriving (Show)
   55 
   56 mod :: (Cmd -> parent) -> Mod CommandFields parent
   57 mod liftCmd = command "walletid" $
   58     info (helper <*> fmap liftCmd parser) $ mempty
   59         <> progDesc "Shows the cardano-wallet wallet ID for a given key"
   60         <> footerDoc (Just $ string $ mconcat
   61             [ "A wallet ID is a 40-digit hexadecimal string derived "
   62             , "from the wallet’s key. It is used by the cardano-wallet "
   63             , "server to refer to specific wallets.\n\n"
   64             , "For shelley wallets the key can be either an extended root key "
   65             , "(full multi-account wallets), or an extended account key "
   66             , "(single-account wallets).\n\n"
   67             , "In the latter case either private or public extended key is accepted "
   68             , "-- they will have the same wallet ID.\n\n"
   69             , "The bech32-encoded key is read from standard input.\n\n"
   70             , "In case of a shared wallet, the wallet id is calculated based on "
   71             , "private extended account key, payment template script and "
   72             , "staking template script - if specified. Each signature in "
   73             , "any template script is denoted by cosigner#number.\n"
   74             ])
   75   where
   76     parser = WalletId
   77         <$> optional scriptTemplateSpendingArg
   78         <*> optional scriptTemplateStakingArg
   79 
   80 run :: Cmd -> IO ()
   81 run WalletId{spending,staking} = do
   82     (hrp, bytes) <- hGetBech32 stdin allowedPrefixes
   83     guardBytes hrp bytes
   84     let bs = payloadToHash hrp bytes
   85     when ( hrp `elem` [CIP5.acct_shared_xvk, CIP5.acct_shared_xsk] &&
   86            isNothing spending ) $
   87         fail "shared wallet needs to have at least spending script specified"
   88     let walletid =
   89             if hrp `elem` [CIP5.acct_shared_xvk, CIP5.acct_shared_xsk] then
   90                 sharedWalletId bs (fromJust spending) staking
   91             else
   92                 hashWalletId bs
   93     hPutBytes stdout walletid EBase16
   94   where
   95     allowedPrefixes =
   96         [ CIP5.root_xsk
   97         , CIP5.root_xvk
   98         , CIP5.acct_xvk
   99         , CIP5.acct_xsk
  100         , CIP5.acct_shared_xvk
  101         , CIP5.acct_shared_xsk
  102         ]
  103 
  104     payloadToHash hrp bs
  105         | hrp `elem` [CIP5.root_xsk, CIP5.acct_xsk, CIP5.acct_shared_xsk] =
  106               case xprvFromBytes bs of
  107                   Just xprv ->  xpubToBytes . toXPub $ xprv
  108                   Nothing -> "96-byte extended private key is invalid due to 'scalarDecodeLong' failure from cryptonite"
  109         | otherwise =
  110               bs
  111 
  112     guardBytes hrp bytes
  113         | hrp `elem` [CIP5.root_xsk, CIP5.root_shared_xsk, CIP5.acct_xsk, CIP5.acct_shared_xsk] = do
  114             when (BS.length bytes /= 96) $
  115                 fail "data should be a 96-byte private key."
  116 
  117         | otherwise = do
  118             when (BS.length bytes /= 64) $
  119                 fail "data should be a 32-byte public key with a 32-byte chain-code appended."