never executed always true always false

    1 {-# LANGUAGE DuplicateRecordFields #-}
    2 {-# LANGUAGE FlexibleContexts #-}
    3 {-# LANGUAGE NamedFieldPuns #-}
    4 {-# LANGUAGE OverloadedStrings #-}
    5 
    6 {-# OPTIONS_HADDOCK hide #-}
    7 {-# OPTIONS_GHC -fno-warn-deprecations #-}
    8 
    9 module Command.Address.Pointer
   10     ( Cmd
   11     , mod
   12     , run
   13     ) where
   14 
   15 import Prelude hiding
   16     ( mod )
   17 
   18 import Cardano.Address
   19     ( ChainPointer (..), bech32, unsafeMkAddress )
   20 import Cardano.Address.Style.Shelley
   21     ( Credential (..), ErrExtendAddress (..) )
   22 import Numeric.Natural
   23     ( Natural )
   24 import Options.Applicative
   25     ( CommandFields
   26     , Mod
   27     , argument
   28     , auto
   29     , command
   30     , footerDoc
   31     , header
   32     , help
   33     , helper
   34     , info
   35     , metavar
   36     , progDesc
   37     )
   38 import Options.Applicative.Help.Pretty
   39     ( bold, indent, string, vsep )
   40 import System.IO
   41     ( stdin, stdout )
   42 import System.IO.Extra
   43     ( hGetBech32, progName )
   44 
   45 import qualified Cardano.Address.Style.Shelley as Shelley
   46 import qualified Cardano.Codec.Bech32.Prefixes as CIP5
   47 import qualified Data.ByteString.Char8 as B8
   48 import qualified Data.Text.Encoding as T
   49 
   50 data Cmd = Cmd
   51     { slotNum :: Natural
   52     , transactionIndex :: Natural
   53     , outputIndex :: Natural
   54     } deriving (Show)
   55 
   56 mod :: (Cmd -> parent) -> Mod CommandFields parent
   57 mod liftCmd = command "pointer" $
   58     info (helper <*> fmap liftCmd parser) $ mempty
   59         <> progDesc "Create a pointer address"
   60         <> header "Create addresses with a pointer that indicate the position \
   61             \of a registered stake address on the chain."
   62         <> footerDoc (Just $ vsep
   63             [ string "The payment address is read from stdin."
   64             , string ""
   65             , string "Example:"
   66             , indent 2 $ bold $ string $ "$ "<>progName<>" recovery-phrase generate --size 15 \\"
   67             , indent 4 $ bold $ string $ "| "<>progName<>" key from-recovery-phrase Shelley > root.prv"
   68             , indent 2 $ string ""
   69             , indent 2 $ bold $ string "$ cat root.prv \\"
   70             , indent 4 $ bold $ string $ "| "<>progName<>" key child 1852H/1815H/0H/0/0 > addr.prv"
   71             , indent 2 $ string ""
   72             , indent 2 $ bold $ string "$ cat addr.prv \\"
   73             , indent 4 $ bold $ string $ "| "<>progName<>" key public --with-chain-code \\"
   74             , indent 4 $ bold $ string $ "| "<>progName<>" address payment --network-tag 0\\"
   75             , indent 4 $ bold $ string $ "| "<>progName<>" address pointer 42 14 0"
   76             , indent 2 $ string "addr1grq8e0smk44luyl897e24gn6qfkx4ax734r6pzq29zcew032pcqqef7zzu"
   77             ])
   78   where
   79     parser = Cmd
   80         <$> argument auto (metavar "SLOT" <> help "A slot number")
   81         <*> argument auto (metavar "TX"   <> help "A transaction index within that slot")
   82         <*> argument auto (metavar "OUT"  <> help "An output index within that transaction")
   83 
   84 run :: Cmd -> IO ()
   85 run Cmd{slotNum,transactionIndex,outputIndex} = do
   86     (_, bytes) <- hGetBech32 stdin allowedPrefixes
   87     case Shelley.extendAddress (unsafeMkAddress bytes) (DelegationFromPointer ptr) of
   88         Left (ErrInvalidAddressStyle msg) ->
   89             fail msg
   90         Left (ErrInvalidAddressType msg) ->
   91             fail msg
   92         Left (ErrInvalidKeyHashType msg) ->
   93             fail msg
   94         Right addr ->
   95             B8.hPutStr stdout $ T.encodeUtf8 $ bech32 addr
   96   where
   97     allowedPrefixes =
   98         [ CIP5.addr
   99         , CIP5.addr_test
  100         ]
  101 
  102     ptr = ChainPointer { slotNum, transactionIndex, outputIndex  }