never executed always true always false

    1 {-# LANGUAGE FlexibleContexts #-}
    2 {-# LANGUAGE NamedFieldPuns #-}
    3 {-# LANGUAGE OverloadedStrings #-}
    4 
    5 {-# OPTIONS_HADDOCK hide #-}
    6 
    7 module Command.Script.Hash
    8     ( Cmd
    9     , mod
   10     , run
   11 
   12     ) where
   13 
   14 import Prelude hiding
   15     ( mod )
   16 
   17 import Cardano.Address.Script
   18     ( KeyHash, Script (..), ScriptHash (..), toScriptHash )
   19 import Codec.Binary.Encoding
   20     ( AbstractEncoding (..) )
   21 import Options.Applicative
   22     ( CommandFields, Mod, command, footerDoc, header, helper, info, progDesc )
   23 import Options.Applicative.Help.Pretty
   24     ( bold, indent, string, vsep )
   25 import Options.Applicative.Script
   26     ( scriptArg )
   27 import System.IO
   28     ( stdout )
   29 import System.IO.Extra
   30     ( hPutBytes, progName )
   31 
   32 import qualified Cardano.Codec.Bech32.Prefixes as CIP5
   33 
   34 newtype Cmd = Cmd
   35     { script :: Script KeyHash
   36     } deriving (Show)
   37 
   38 mod :: (Cmd -> parent) -> Mod CommandFields parent
   39 mod liftCmd = command "hash" $
   40     info (helper <*> fmap liftCmd parser) $ mempty
   41         <> progDesc "Create a script hash"
   42         <> header "Create a script hash that can be used in stake or payment address."
   43         <> footerDoc (Just $ vsep
   44             [ string "The script is taken as argument."
   45             , string ""
   46             , string "Example:"
   47             , indent 2 $ bold $ string $ progName<>" script hash 'all "
   48             , indent 4 $ bold $ string "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3"
   49             , indent 4 $ bold $ string ", addr_shared_vk1jthguyss2vffmszq63xsmxlpc9elxnvdyaqk7susl4sppp2s9xqsuszh44"
   50             , indent 4 $ bold $ string "]'"
   51             , indent 2 $ string "script1gr69m385thgvkrtspk73zmkwk537wxyxuevs2u9cukglvtlkz4k"
   52             ])
   53   where
   54     parser = Cmd
   55         <$> scriptArg
   56 
   57 run :: Cmd -> IO ()
   58 run Cmd{script} = do
   59     let (ScriptHash bytes) = toScriptHash script
   60     hPutBytes stdout bytes (EBech32 CIP5.script)