never executed always true always false

    1 {-# LANGUAGE FlexibleContexts #-}
    2 {-# LANGUAGE OverloadedStrings #-}
    3 
    4 {-# OPTIONS_HADDOCK hide #-}
    5 
    6 module Command.Key.Inspect
    7     ( Cmd (..)
    8     , mod
    9     , run
   10     ) where
   11 
   12 import Prelude hiding
   13     ( mod )
   14 
   15 import Cardano.Address.Derivation
   16     ( XPrv, XPub, xprvChainCode, xprvPrivateKey, xpubChainCode, xpubPublicKey )
   17 import Codec.Binary.Bech32
   18     ( HumanReadablePart )
   19 import Codec.Binary.Encoding
   20     ( AbstractEncoding (..), encode )
   21 import Data.Aeson
   22     ( (.=) )
   23 import Data.ByteString
   24     ( ByteString )
   25 import Data.Text
   26     ( Text )
   27 import Options.Applicative
   28     ( CommandFields, Mod, command, footerDoc, helper, info, progDesc )
   29 import Options.Applicative.Help.Pretty
   30     ( string )
   31 import System.IO
   32     ( stdin, stdout )
   33 import System.IO.Extra
   34     ( hGetXP__ )
   35 
   36 import qualified Cardano.Codec.Bech32.Prefixes as CIP5
   37 import qualified Data.Aeson as Json
   38 import qualified Data.Aeson.Encode.Pretty as Json
   39 import qualified Data.ByteString.Lazy.Char8 as BL8
   40 import qualified Data.Text.Encoding as T
   41 
   42 
   43 data Cmd = Inspect
   44     deriving (Show)
   45 
   46 mod :: (Cmd -> parent) -> Mod CommandFields parent
   47 mod liftCmd = command "inspect" $
   48     info (helper <*> fmap liftCmd parser) $ mempty
   49         <> progDesc "Show information about a key"
   50         <> footerDoc (Just $ string $ mconcat
   51             [ "The parent key is read from stdin."
   52             ])
   53   where
   54     parser = pure Inspect
   55 
   56 run :: Cmd -> IO ()
   57 run Inspect = do
   58     either inspectXPub inspectXPrv =<< hGetXP__ stdin allowedPrefixes
   59   where
   60     allowedPrefixes :: [HumanReadablePart]
   61     allowedPrefixes =
   62         [ CIP5.root_xvk
   63         , CIP5.root_xsk
   64         , CIP5.acct_xvk
   65         , CIP5.acct_xsk
   66         , CIP5.addr_xvk
   67         , CIP5.addr_xsk
   68         , CIP5.stake_xvk
   69         , CIP5.stake_xsk
   70         , CIP5.policy_xvk
   71         , CIP5.policy_xsk
   72         , CIP5.root_shared_xvk
   73         , CIP5.root_shared_xsk
   74         , CIP5.acct_shared_xvk
   75         , CIP5.acct_shared_xsk
   76         , CIP5.addr_shared_xvk
   77         , CIP5.addr_shared_xsk
   78         , CIP5.stake_shared_xvk
   79         , CIP5.stake_shared_xsk
   80         ]
   81 
   82     base16 :: ByteString -> Text
   83     base16 = T.decodeUtf8 . encode EBase16
   84 
   85     inspectXPub :: (HumanReadablePart, XPub) -> IO ()
   86     inspectXPub (_, xpub) = do
   87         BL8.hPutStrLn stdout $ Json.encodePretty $ Json.object
   88             [ "key_type" .= Json.String "public"
   89             , "extended_key" .= Json.String (base16 pub)
   90             , "chain_code" .= Json.String (base16 cc)
   91             ]
   92       where
   93         pub = xpubPublicKey xpub
   94         cc  = xpubChainCode xpub
   95 
   96     inspectXPrv :: (HumanReadablePart, XPrv) -> IO ()
   97     inspectXPrv (_, xprv) =
   98         BL8.hPutStrLn stdout $ Json.encodePretty $ Json.object
   99             [ "key_type" .= Json.String "private"
  100             , "extended_key" .= Json.String (base16 prv)
  101             , "chain_code" .= Json.String (base16 cc)
  102             ]
  103       where
  104         prv = xprvPrivateKey xprv
  105         cc  = xprvChainCode  xprv