never executed always true always false
    1 {-# LANGUAGE DataKinds #-}
    2 {-# LANGUAGE FlexibleContexts #-}
    3 
    4 {-# OPTIONS_HADDOCK hide #-}
    5 
    6 module Options.Applicative.Credential
    7     ( delegationCredentialArg
    8     ) where
    9 
   10 import Prelude
   11 
   12 import Cardano.Address.Derivation
   13     ( Depth (..) )
   14 import Cardano.Address.Internal
   15     ( orElse )
   16 import Cardano.Address.Script
   17     ( KeyRole (..) )
   18 import Cardano.Address.Style.Shelley
   19     ( Credential (..), liftPub, liftXPub )
   20 import Options.Applicative
   21     ( Parser, argument, eitherReader, help, metavar )
   22 import Options.Applicative.Derivation
   23     ( keyhashReader, pubReader, xpubReader )
   24 import Options.Applicative.Script
   25     ( scriptHashReader, scriptReader )
   26 
   27 import qualified Cardano.Codec.Bech32.Prefixes as CIP5
   28 
   29 --
   30 -- Applicative Parser
   31 --
   32 
   33 delegationCredentialArg  :: String -> Parser (Credential 'DelegationK)
   34 delegationCredentialArg helpDoc = argument (eitherReader reader) $ mempty
   35     <> metavar "EXTENDED KEY || NON-EXTENDED KEY || KEY HASH || SCRIPT || SCRIPT HASH"
   36     <> help helpDoc
   37   where
   38     reader :: String -> Either String (Credential 'DelegationK)
   39     reader str =
   40        (DelegationFromKey . liftPub <$> pubReader allowedPrefixesForPub str)
   41        `orElse`
   42        (DelegationFromExtendedKey . liftXPub <$> xpubReader allowedPrefixesForXPub str)
   43        `orElse`
   44        (DelegationFromKeyHash <$> keyhashReader (Delegation, allowedPrefixesForKeyHash) str)
   45        `orElse`
   46        (DelegationFromScriptHash <$> scriptHashReader str)
   47        `orElse`
   48        (DelegationFromScript <$> scriptReader str)
   49        `orElse`
   50        Left errMsg
   51 
   52     errMsg = mconcat
   53         [ "Couldn't parse delegation credentials. Neither an extended public key, "
   54         , "a non-extended public key, a public key hash, a script nor a script hash."
   55         ]
   56 
   57     allowedPrefixesForPub =
   58         [ CIP5.stake_vk
   59         ]
   60     allowedPrefixesForXPub =
   61         [ CIP5.stake_xvk
   62         ]
   63     allowedPrefixesForKeyHash =
   64         [ CIP5.stake_vkh
   65         ]