never executed always true always false

    1 {-# LANGUAGE FlexibleContexts #-}
    2 
    3 {-# OPTIONS_HADDOCK hide #-}
    4 
    5 module Options.Applicative.Script
    6     (
    7     -- ** Applicative Parser
    8       scriptArg
    9     , scriptReader
   10     , scriptHashArg
   11     , scriptHashReader
   12     , levelOpt
   13     , scriptTemplateReader
   14     , scriptTemplateSpendingArg
   15     , scriptTemplateStakingArg
   16     ) where
   17 
   18 import Prelude
   19 
   20 import Cardano.Address.Script
   21     ( Cosigner (..)
   22     , KeyHash
   23     , Script (..)
   24     , ScriptHash
   25     , ValidationLevel (..)
   26     , prettyErrValidateScript
   27     , scriptHashFromBytes
   28     )
   29 import Cardano.Address.Script.Parser
   30     ( requireCosignerOfParser, requireSignatureOfParser, scriptFromString )
   31 import Control.Applicative
   32     ( (<|>) )
   33 import Control.Arrow
   34     ( left )
   35 import Options.Applicative
   36     ( Parser, argument, eitherReader, flag', help, long, metavar, option )
   37 import Options.Applicative.Derivation
   38     ( bech32Reader )
   39 
   40 
   41 import qualified Cardano.Codec.Bech32.Prefixes as CIP5
   42 
   43 --
   44 -- Applicative Parsers
   45 --
   46 
   47 scriptArg :: Parser (Script KeyHash)
   48 scriptArg = argument (eitherReader scriptReader) $ mempty
   49     <> metavar "SCRIPT"
   50     -- TODO: Provides a bigger help text explaining how to construct a script
   51     -- address.
   52     <> help "Script string."
   53 
   54 scriptReader :: String -> Either String (Script KeyHash)
   55 scriptReader =
   56     left prettyErrValidateScript . (scriptFromString requireSignatureOfParser)
   57 
   58 scriptHashArg :: String -> Parser ScriptHash
   59 scriptHashArg helpDoc =
   60     argument (eitherReader scriptHashReader) $ mempty
   61         <> metavar "SCRIPT HASH"
   62         <> help helpDoc
   63 
   64 scriptHashReader :: String -> Either String ScriptHash
   65 scriptHashReader str = do
   66     (_hrp, bytes) <- bech32Reader allowedPrefixes str
   67     case scriptHashFromBytes bytes of
   68         Just scriptHash -> pure scriptHash
   69         Nothing -> Left "Failed to convert bytes into a valid script hash."
   70   where
   71     allowedPrefixes =
   72         [ CIP5.script
   73         ]
   74 
   75 levelOpt :: Parser ValidationLevel
   76 levelOpt = required <|> recommended
   77   where
   78     required = flag' RequiredValidation (long "required")
   79     recommended = flag' RecommendedValidation (long "recommended")
   80 
   81 scriptTemplateReader :: String -> Either String (Script Cosigner)
   82 scriptTemplateReader =
   83     left prettyErrValidateScript . (scriptFromString requireCosignerOfParser)
   84 
   85 scriptTemplateSpendingArg :: Parser (Script Cosigner)
   86 scriptTemplateSpendingArg = option (eitherReader scriptTemplateReader) $ mempty
   87     <> long "spending"
   88     <> metavar "SPENDING SCRIPT TEMPLATE"
   89     <> help "Spending script template string."
   90 
   91 scriptTemplateStakingArg :: Parser (Script Cosigner)
   92 scriptTemplateStakingArg = option (eitherReader scriptTemplateReader) $ mempty
   93     <> long "staking"
   94     <> metavar "STAKING SCRIPT TEMPLATE"
   95     <> help "Staking script template string."