content: {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  {-# OPTIONS_HADDOCK hide #-}
  
  -- |
  -- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect
  -- License: Apache-2.0
  
  module Command.Script.Validation
      ( Cmd
      , mod
      , run
  
      ) where
  
  import Prelude hiding
      ( mod )
  
  import Cardano.Address.KeyHash
      ( KeyHash )
  import Cardano.Address.Script
      ( Script (..)
      , ValidationLevel (..)
      , prettyErrValidateScript
      , validateScript
      )
  import Data.Maybe
      ( fromMaybe )
  import Data.Text
      ( Text )
  import Options.Applicative
      ( CommandFields
      , Mod
      , command
      , footerDoc
      , header
      , helper
      , info
      , optional
      , progDesc
      )
  import Options.Applicative.Help.Pretty
      ( Doc, annotate, bold, indent, pretty, vsep )
  import Options.Applicative.Script
      ( levelOpt, scriptArg )
  import System.IO
      ( stderr, stdout )
  import System.IO.Extra
      ( hPutString, progName )
  
  data Cmd = Cmd
      { script :: Script KeyHash
      , validationLevel :: Maybe ValidationLevel
      } deriving (Show)
  
  mod :: (Cmd -> parent) -> Mod CommandFields parent
  mod liftCmd = command "validate" $
      info (helper <*> fmap liftCmd parser) $ mempty
          <> progDesc "Validate a script"
          <> header "Choose a required (default) or recommended validation of a script."
          <> footerDoc (Just $ vsep
              [ prettyText "The script is taken as argument. To have required validation pass '--required' or nothing."
              , prettyText "To have recommended validation pass '--recommended'. Recommended validation adds more validations"
              , prettyText "on top of the required one, in particular:"
              , prettyText " - check if 'all' is non-empty"
              , prettyText " - check if there are redundant timelocks in a given level"
              , prettyText " - check if there are no duplicated verification keys in a given level"
              , prettyText " - check if 'at_least' coeffcient is positive"
              , prettyText " - check if 'all', 'any' are non-empty and `'at_least' has no less elements in the list than the coeffcient after timelocks are filtered out. "
              , prettyText "The validation of the script does not take into account transaction validity. We assume that the user will take care of this."
              , prettyText ""
              , prettyText "Example:"
              , indent 2 $ annotate bold $  pretty $ progName<>" script validate 'all"
              , indent 4 $ annotate bold $  prettyText "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3"
              , indent 4 $ annotate bold $  prettyText ", addr_shared_vk1jthguyss2vffmszq63xsmxlpc9elxnvdyaqk7susl4sppp2s9xqsuszh44"
              , indent 4 $ annotate bold $  prettyText "]'"
              , indent 2 $ prettyText "Validated."
              , prettyText ""
              , indent 2 $ annotate bold $  pretty $ progName<>" script validate --required 'all"
              , indent 4 $ annotate bold $  prettyText "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3"
              , indent 4 $ annotate bold $  prettyText ", addr_shared_vk1jthguyss2vffmszq63xsmxlpc9elxnvdyaqk7susl4sppp2s9xqsuszh44"
              , indent 4 $ annotate bold $  prettyText "]'"
              , indent 2 $ prettyText "Validated."
              , prettyText ""
              , indent 2 $ annotate bold $  pretty $ progName<>" script validate --recommended 'all []'"
              , indent 2 $ prettyText "Not validated: The list inside a script is empty or only contains timelocks (which is not recommended)."
              , prettyText ""
              , indent 2 $ annotate bold $  pretty $ progName<>" script validate 'at_least 1 [active_from 11, active_until 16]'"
              , indent 2 $ prettyText "Validated."
              , prettyText ""
              , indent 2 $ annotate bold $  pretty $ progName<>" script validate 'all"
              , indent 4 $ annotate bold $  prettyText "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3"
              , indent 4 $ annotate bold $  prettyText ", addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3"
              , indent 4 $ annotate bold $  prettyText "]'"
              , indent 2 $ prettyText "Validated."
              , prettyText ""
              , indent 2 $ annotate bold $  pretty $ progName<>" script validate --recommended 'all"
              , indent 4 $ annotate bold $  prettyText "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3"
              , indent 4 $ annotate bold $  prettyText ", addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3"
              , indent 4 $ annotate bold $  prettyText "]'"
              , indent 2 $ prettyText "Not validated: The list inside a script has duplicate keys (which is not recommended)."
              ])
    where
      parser = Cmd
          <$> scriptArg
          <*> optional levelOpt
  
      prettyText :: Text -> Doc
      prettyText = pretty
  
  run :: Cmd -> IO ()
  run Cmd{script,validationLevel} =
      case validateScript (fromMaybe RequiredValidation validationLevel) script of
          Left err -> hPutString stderr $ "Not validated: " <> prettyErrValidateScript err
          Right _ -> hPutString stdout "Validated."
  