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.Preimage
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 (..), serializeScript )
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 newtype Cmd = Cmd
33 { script :: Script KeyHash
34 } deriving (Show)
35
36 mod :: (Cmd -> parent) -> Mod CommandFields parent
37 mod liftCmd = command "preimage" $
38 info (helper <*> fmap liftCmd parser) $ mempty
39 <> progDesc "Create a script preimage"
40 <> header "Create a script preimage that is CBOR-encoded script."
41 <> footerDoc (Just $ vsep
42 [ string "The script is taken as argument."
43 , string ""
44 , string "Example:"
45 , indent 2 $ bold $ string $ progName<>" script preimage 'all "
46 , indent 4 $ bold $ string "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3"
47 , indent 4 $ bold $ string ", addr_shared_vk1jthguyss2vffmszq63xsmxlpc9elxnvdyaqk7susl4sppp2s9xqsuszh44"
48 , indent 4 $ bold $ string "]'"
49 , indent 2 $ string "008201828200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10d8200581c2445facc08d975d9d965d360dbe0fa63688ccc8f70fd7e1f01135380"
50 , string ""
51 , indent 2 $ bold $ string $ progName<>" script preimage 'all "
52 , indent 4 $ bold $ string "[ addr_shared_vk1wgj79fxw2vmxkp85g88nhwlflkxevd77t6wy0nsktn2f663wdcmqcd4fp3"
53 , indent 4 $ bold $ string ", active_from 100, active_until 150"
54 , indent 4 $ bold $ string "]'"
55 , indent 2 $ string "008201838200581c1196fe3062e96b78dd959058f5adad44dd663519200f2495d17ef10d8204186482051896"
56 ])
57 where
58 parser = Cmd
59 <$> scriptArg
60
61 run :: Cmd -> IO ()
62 run Cmd{script} = do
63 hPutBytes stdout (serializeScript script) EBase16