never executed always true always false

    1 {-# LANGUAGE DataKinds #-}
    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.Delegation
   10     ( Cmd
   11     , mod
   12     , run
   13     ) where
   14 
   15 import Prelude hiding
   16     ( mod )
   17 
   18 import Cardano.Address
   19     ( bech32, unsafeMkAddress )
   20 import Cardano.Address.Derivation
   21     ( Depth (..) )
   22 import Cardano.Address.Style.Shelley
   23     ( Credential (..), ErrExtendAddress (..) )
   24 import Options.Applicative
   25     ( CommandFields, Mod, command, footerDoc, helper, info, progDesc )
   26 import Options.Applicative.Credential
   27     ( delegationCredentialArg )
   28 import Options.Applicative.Help.Pretty
   29     ( bold, indent, string, vsep )
   30 import System.IO
   31     ( stdin, stdout )
   32 import System.IO.Extra
   33     ( hGetBech32, progName )
   34 
   35 import qualified Cardano.Address.Style.Shelley as Shelley
   36 import qualified Cardano.Codec.Bech32.Prefixes as CIP5
   37 import qualified Data.ByteString.Char8 as B8
   38 import qualified Data.Text.Encoding as T
   39 
   40 newtype Cmd = Cmd
   41     { credential :: Credential 'DelegationK
   42     } deriving Show
   43 
   44 mod :: (Cmd -> parent) -> Mod CommandFields parent
   45 mod liftCmd = command "delegation" $
   46     info (helper <*> fmap liftCmd parser) $ mempty
   47         <> progDesc "Create a delegation address"
   48         <> footerDoc (Just $ vsep
   49             [ string "The payment address is read from stdin."
   50             , string ""
   51             , string "Example:"
   52             , indent 2 $ bold $ string $ "$ "<>progName<>" recovery-phrase generate --size 15 \\"
   53             , indent 4 $ bold $ string $ "| "<>progName<>" key from-recovery-phrase Shelley > root.prv"
   54             , indent 2 $ string ""
   55             , indent 2 $ bold $ string "$ cat root.prv \\"
   56             , indent 4 $ bold $ string $ "| "<>progName<>" key child 1852H/1815H/0H/2/0 > stake.prv"
   57             , indent 2 $ string ""
   58             , indent 2 $ bold $ string "$ cat root.prv \\"
   59             , indent 4 $ bold $ string $ "| "<>progName<>" key child 1852H/1815H/0H/0/0 > addr.prv"
   60             , indent 2 $ string ""
   61             , indent 2 $ bold $ string "$ cat addr.prv \\"
   62             , indent 4 $ bold $ string $ "| "<>progName<>" key public --with-chain-code \\"
   63             , indent 4 $ bold $ string $ "| "<>progName<>" address payment --network-tag testnet \\"
   64             , indent 4 $ bold $ string $ "| "<>progName<>" address delegation $(cat stake.prv | "<>progName<>" key public --with-chain-code)"
   65             , indent 2 $ string "addr1qpj2d4dqzds5p3mmlu95v9pex2d72cdvyjh2u3dtj4yqesv27k..."
   66             ])
   67   where
   68     msg = "An extended stake public key, a non-extended stake public key, a script or a script hash."
   69     parser = Cmd
   70         <$> delegationCredentialArg msg
   71 
   72 run :: Cmd -> IO ()
   73 run Cmd{credential} = do
   74     (_, bytes) <- hGetBech32 stdin allowedPrefixes
   75     case Shelley.extendAddress (unsafeMkAddress bytes) credential of
   76         Left (ErrInvalidAddressStyle msg) ->
   77             fail msg
   78         Left (ErrInvalidAddressType  msg) ->
   79             fail msg
   80         Left (ErrInvalidKeyHashType msg) ->
   81             fail msg
   82         Right addr ->
   83             B8.hPutStr stdout $ T.encodeUtf8 $ bech32 addr
   84   where
   85     allowedPrefixes =
   86         [ CIP5.addr
   87         , CIP5.addr_test
   88         ]