never executed always true always false

    1 {-# LANGUAGE FlexibleContexts #-}
    2 {-# LANGUAGE NamedFieldPuns #-}
    3 {-# LANGUAGE OverloadedStrings #-}
    4 
    5 {-# OPTIONS_HADDOCK hide #-}
    6 
    7 module Command.Key.Public
    8     ( Cmd (..)
    9     , mod
   10     , run
   11     ) where
   12 
   13 import Prelude hiding
   14     ( mod )
   15 
   16 import Cardano.Address.Derivation
   17     ( toXPub, xpubPublicKey, xpubToBytes )
   18 import Codec.Binary.Encoding
   19     ( AbstractEncoding (..) )
   20 import Data.Maybe
   21     ( fromJust )
   22 import Options.Applicative
   23     ( CommandFields, Mod, command, footerDoc, helper, info, progDesc )
   24 import Options.Applicative.Help.Pretty
   25     ( string )
   26 import Options.Applicative.Public
   27     ( PublicType (..), publicOpt )
   28 import System.IO
   29     ( stdin, stdout )
   30 import System.IO.Extra
   31     ( hGetXPrv, hPutBytes )
   32 
   33 import qualified Cardano.Codec.Bech32.Prefixes as CIP5
   34 
   35 newtype Cmd = Public
   36     { chainCode :: PublicType
   37     } deriving (Show)
   38 
   39 mod :: (Cmd -> parent) -> Mod CommandFields parent
   40 mod liftCmd = command "public" $
   41     info (helper <*> fmap liftCmd parser) $ mempty
   42         <> progDesc "Get the public counterpart of a private key"
   43         <> footerDoc (Just $ string $ mconcat
   44             [ "The private key is read from stdin."
   45             , "To get extended public key pass '--with-chain-code'."
   46             , "To get public key pass '--without-chain-code'."
   47             ])
   48   where
   49     parser = Public
   50         <$> publicOpt
   51 
   52 run :: Cmd -> IO ()
   53 run Public{chainCode} = do
   54     (hrp, xprv) <- hGetXPrv stdin allowedPrefixes
   55     let xpub = toXPub xprv
   56     let bytes = case chainCode of
   57             WithChainCode    -> xpubToBytes xpub
   58             WithoutChainCode -> xpubPublicKey xpub
   59     hPutBytes stdout bytes (EBech32 $ prefixFor chainCode hrp)
   60   where
   61     prefixes =
   62         [ (CIP5.root_xsk, (CIP5.root_xvk, CIP5.root_vk) )
   63         , (CIP5.acct_xsk, (CIP5.acct_xvk, CIP5.acct_vk) )
   64         , (CIP5.addr_xsk, (CIP5.addr_xvk, CIP5.addr_vk) )
   65         , (CIP5.stake_xsk, (CIP5.stake_xvk, CIP5.stake_vk) )
   66         , (CIP5.root_shared_xsk, (CIP5.root_shared_xvk, CIP5.root_shared_vk) )
   67         , (CIP5.acct_shared_xsk, (CIP5.acct_shared_xvk, CIP5.acct_shared_vk) )
   68         , (CIP5.addr_shared_xsk, (CIP5.addr_shared_xvk, CIP5.addr_shared_vk) )
   69         , (CIP5.stake_shared_xsk, (CIP5.stake_shared_xvk, CIP5.stake_shared_vk) )
   70         , (CIP5.policy_xsk, (CIP5.policy_xvk, CIP5.policy_vk) )
   71         ]
   72     allowedPrefixes = map fst prefixes
   73     getCC WithChainCode = fst
   74     getCC WithoutChainCode = snd
   75     prefixFor cc = getCC cc . fromJust . flip lookup prefixes