diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,15 @@ +## [1.0.0] - 2020-04-21 + +### Added + +- Module 'Data.UTxO.Transaction' which defines a state-machine abstraction for constructing, signing and serializing payments. +- Module 'Data.UTxO.Transaction.Cardano.Byron' which implements the abstraction from 'Data.UTxO.Transaction' for Byron. +- A command-line tool 'cardano-tx' which offers a manual handle on the Byron implementation. + +### Changed + +N/A + +### Removed + +N/A diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright © 2020 Input Output (Hong Kong) Ltd. + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,147 @@ +

+ Cardano Transactions +

+ +

+ + + + +

+ +## Overview + +This library provides a simple interface for building transactions on Cardano. It also +provides a small command-line interface for playing around in a terminal. + +## Payment + +We call _Payment_ a simple UTxO transactions with no metadata, moving funds from a set of inputs to a set of outputs. + +Payments are constructed from a small set of primitives, following the given state-machine: + +![](https://mermaid.ink/img/eyJjb2RlIjoic3RhdGVEaWFncmFtXG5cdFsqXSAtLT4gQ29pblNlbGVjdGlvbjogZW1wdHlcbiAgICBDb2luU2VsZWN0aW9uIC0tPiBDb2luU2VsZWN0aW9uOiBhZGRJbnB1dFxuICAgIENvaW5TZWxlY3Rpb24gLS0-IENvaW5TZWxlY3Rpb246IGFkZE91dHB1dFxuICAgIENvaW5TZWxlY3Rpb24gLS0-IFRyYW5zYWN0aW9uOiBsb2NrXG4gICAgVHJhbnNhY3Rpb24gLS0-IFRyYW5zYWN0aW9uOiBzaWduV2l0aFxuICAgIFRyYW5zYWN0aW9uIC0tPiBbKl06IHNlcmlhbGl6ZSIsIm1lcm1haWQiOnsidGhlbWUiOiJkZWZhdWx0In0sInVwZGF0ZUVkaXRvciI6ZmFsc2V9) + +### Example (Haskell) + +
+ Imports + +```hs +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} + +import Data.Function + ( (&) ) +import Data.Maybe + ( fromMaybe ) +import Data.UTxO.Transaction.Cardano.Byron + ( fromBase16 + , fromBase58 + , mkInput + , mkOutput + , mkSignKey + , testnetMagic + ) + +import qualified Data.ByteString as BS +import qualified Data.UTxO.Transaction as Tx +``` +
+ +
+ Constructing Inputs / Outputs + +```hs +-- Say we want to construct a transaction from a known input to two +-- different addresses. Let's start by constructing the primitive types +-- for /Byron/ by using the smart-constructors from: +-- +-- 'Data.UTxO.Transaction.Cardano.Byron' + +let (Just input0) = mkInput 0 =<< fromBase16 + "3b40265111d8bb3c3c608d95b3a0bf83461ace32d79336579a1939b3aad1c0b7" + +let Just key0 = mkSignKey =<< fromBase16 + "e0860dab46f13e74ab834142e8877b80bf22044cae8ebab7a21ed1b8dc00c155\ + \f6b78eee2a5bbd453ce7e7711b2964abb6a36837e475271f18ff36ae5fc8af73\ + \e25db39fb78e74d4b53fb51776d0f5eb360e62d09b853f3a87ac25bf834ee1fb" + +let oneAda = 1_000_000 + +let (Just output0) = mkOutput oneAda =<< fromBase58 + "2cWKMJemoBajc46Wu4Z7e6bG48myZWfB7Z6pD77L6PrJQWt9HZ3Yv7o8CYZTBMqHTPTkv" + +let (Just output1) = mkOutput oneAda =<< fromBase58 + "2cWKMJemoBaiLiNB8QpHKjkQhnPdQSyxaLb8JJFUQYpiVzgEJE59fN7V7StqnyDuDjHYJ" +``` +
+ +
+ Constructing The Transaction + +```hs +-- Next, we can construct the transaction using the DSL provided by: +-- +-- 'Data.UTxO.Transaction#MkPayment' + +let eitherTx = Tx.empty testnetMagic + & Tx.addInput input0 + & Tx.addOutput output0 + & Tx.addOutput output1 + & Tx.lock + & Tx.signWith key0 + & Tx.serialize +``` +
+ +
+ Writing Binary Transaction to a File + +```hs +-- Finally, let's export the binary transaction to a file, if we didn't screw +-- up the in the above example ^^" + +case eitherTx of + Left e -> + fail $ show e + Right bytes -> + BS.writeFile "transaction.bin" bytes +``` +
+ +### Example (CLI) + +```shell +cardano-tx empty 764824073 \ + | cardano-tx add-input 0 3b40265111d8bb3c3c608d95b3a0bf83461ace32d79336579a1939b3aad1c0b7 \ + | cardano-tx add-output 42 Ae2tdPwUPEZETXfbQxKMkMJQY1MoHCBS7bkw6TmhLjRvi9LZh1uDnXy319f \ + | cardano-tx lock \ + | cardano-tx sign-with e0860dab46f13e74ab834142e8877b80bf22044cae8ebab7a21ed1b8dc00c155f6b78eee2a5bbd453ce7e7711b2964abb6a36837e475271f18ff36ae5fc8af73e25db39fb78e74d4b53fb51776d0f5eb360e62d09b853f3a87ac25bf834ee1fb \ + | cardano-tx serialize +``` + +## About Library Dependencies + +This library requires quite a few exotic dependencies from the cardano realm which aren't +necessarily on hackage nor stackage. The dependencies are listed in [stack.yaml](https://github.com/input-output-hk/cardano-transactions/blob/master/stack.yaml#L7-L33), +make sure to also include those for importing `cardano-transactions`. + +## Documentation + +API documentation is available [here](https://input-output-hk.github.io/cardano-transactions/haddock). + +[End-to-end example](https://github.com/input-output-hk/cardano-transactions/wiki/How-to-submit-transaction-via-cardano-tx-CLI) of constructing transaction via `cardano-tx` and then submitting it. + +## Contributing + +Pull requests are welcome. + +When creating a pull request, please make sure that your code adheres to our +[coding standards](https://github.com/input-output-hk/adrestia/wiki/Coding-Standards). + +
+ +

+ +

diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,461 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Main where + +import Prelude + +import Control.Applicative + ( (<|>) ) +import Control.Exception + ( bracket ) +import Control.Monad + ( guard, void ) +import Data.ByteArray.Encoding + ( Base (..), convertFromBase, convertToBase ) +import Data.ByteString + ( ByteString ) +import Data.Maybe + ( isNothing ) +import Data.Text + ( Text ) +import Data.UTxO.Transaction + ( MkPayment (..) ) +import Data.UTxO.Transaction.Cardano.Byron + ( Byron + , decodeCoinSel + , decodeTx + , encodeCoinSel + , encodeTx + , fromBase16 + , fromBase58 + , mkInit + , mkInput + , mkOutput + , mkSignKey + ) +import Data.Word + ( Word32 ) +import Numeric.Natural + ( Natural ) +import Options.Applicative + ( ArgumentFields + , CommandFields + , Mod + , Parser + , ParserInfo + , argument + , auto + , command + , customExecParser + , flag + , flag' + , footerDoc + , header + , headerDoc + , helper + , info + , long + , maybeReader + , metavar + , prefs + , progDesc + , showHelpOnEmpty + , subparser + ) +import Options.Applicative.Help.Pretty + ( hardline, indent, string, vsep ) +import System.Console.ANSI + ( Color (..) + , ColorIntensity (..) + , ConsoleLayer (..) + , SGR (..) + , hSetSGR + , hSupportsANSIWithoutEmulation + ) +import System.Exit + ( exitFailure ) +import System.IO + ( Handle, hIsTerminalDevice, stderr, stdin, stdout ) + +import qualified Codec.CBOR.Decoding as CBOR +import qualified Codec.CBOR.Encoding as CBOR +import qualified Codec.CBOR.Read as CBOR +import qualified Codec.CBOR.Write as CBOR +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.IO as TIO +import qualified Data.UTxO.Transaction as Tx + + +main :: IO () +main = setup >> parseCmd >>= \case + CmdEmpty Empty{protocolMagic} -> do + let state0 = Tx.empty protocolMagic + hPutState stdout (encodeCoinSel state0) + + CmdAddInput AddInput{inputIx,inputTxId} -> do + state <- hGetState stdin decodeCoinSel + case mkInput inputIx inputTxId of + Nothing -> failWith "Invalid input index or transaction id." + Just input -> do + let state' = Tx.addInput input state + hPutState stdout (encodeCoinSel state') + + CmdAddOutput AddOutput{coin,address} -> do + state <- hGetState stdin decodeCoinSel + case mkOutput coin address of + Nothing -> failWith "Invalid output value or address." + Just output -> do + let state' = Tx.addOutput output state + hPutState stdout (encodeCoinSel state') + + CmdLock -> do + state <- hGetState stdin decodeCoinSel + let state' = Tx.lock state + hPutState stdout (encodeTx state') + + CmdSignWith SignWith{prvKey} -> do + state <- hGetState stdin decodeTx + case mkSignKey prvKey of + Nothing -> failWith "Invalid signing key." + Just signKey -> do + let state' = Tx.signWith signKey state + hPutState stdout (encodeTx state') + + CmdSerialize Serialize{base} -> do + state <- hGetState stdin decodeTx + case Tx.serialize state of + Left e -> failWith (show e) + Right bytes -> TIO.putStr $ T.decodeUtf8 $ convertToBase base bytes + where + setup :: IO () + setup = do + -- Enable ANSI colors on Windows. + void $ hSupportsANSIWithoutEmulation stderr + +parseCmd :: IO Cmd +parseCmd = customExecParser (prefs showHelpOnEmpty) cmd + +data Cmd + = CmdEmpty Empty + | CmdAddInput AddInput + | CmdAddOutput AddOutput + | CmdLock + | CmdSignWith SignWith + | CmdSerialize Serialize + deriving (Show) + +cmd :: ParserInfo Cmd +cmd = info (helper <*> cmds) $ progDesc "cardano-tx" + <> headerDoc (Just $ vsep + [ string "Construct and sign transactions according to the following state-machine:" + , hardline + , string " empty " + , string " | " + , string " *------------------* | *-----------------*" + , string " | | | | |" + , string " | v v v |" + , string " *--- add-output ---=========--- add-input ---*" + , string " | " + , string " | " + , string " lock *----------------*" + , string " | | |" + , string " | v |" + , string " =========--- sign-with ---*" + , string " | " + , string " | " + , string " serialize " + , string " | " + , string " | " + , string " v " + , hardline + , string "/!\\ Except 'serialize', every command outputs an intermediate \ + \state that is of little use and shouldn't be tempered with." + , string "Redirect the output to a file, or use Unix pipes as shown below." + ]) + <> footerDoc (Just $ vsep + [ "Example:" + , indent 2 $ string "cardano-tx empty 764824073 \\" + , indent 2 $ string " | cardano-tx add-input 0 \\" + , indent 2 $ string " 3b40265111d8bb3c3c608d95b3a0bf83461ace32d79336579a1939b3aad1c0b7 \\" + , indent 2 $ string " | cardano-tx add-output 42 \\" + , indent 2 $ string " Ae2tdPwUPEZETXfbQxKMkMJQY1MoHCBS7bkw6TmhLjRvi9LZh1uDnXy319f \\" + , indent 2 $ string " | cardano-tx lock \\" + , indent 2 $ string " | cardano-tx sign-with \\" + , indent 2 $ string " e0860dab46f13e74ab834142e8877b80bf22044cae8ebab7a21ed1b8dc00c155 \\" + , indent 2 $ string " f6b78eee2a5bbd453ce7e7711b2964abb6a36837e475271f18ff36ae5fc8af73 \\" + , indent 2 $ string " e25db39fb78e74d4b53fb51776d0f5eb360e62d09b853f3a87ac25bf834ee1fb \\" + , indent 2 $ string " | cardano-tx serialize" + ]) + where + cmds = subparser $ mconcat + [ cmdEmpty + , cmdAddInput + , cmdAddOutput + , cmdLock + , cmdSignWith + , cmdSerialize + ] + +-- _ +-- | | +-- ___ _ __ ___ _ __ | |_ _ _ +-- / _ \ '_ ` _ \| '_ \| __| | | | +-- | __/ | | | | | |_) | |_| |_| | +-- \___|_| |_| |_| .__/ \__|\__, | +-- | | __/ | +-- |_| |___/ + +newtype Empty = Empty + { protocolMagic :: Init Byron + } deriving (Show) + +cmdEmpty :: Mod CommandFields Cmd +cmdEmpty = command "empty" $ + info (helper <*> fmap CmdEmpty subCmd) mempty + where + subCmd = Empty <$> protocolMagicArg + +protocolMagicArg :: Parser (Init Byron) +protocolMagicArg = fmap mkInit $ argument auto $ + metavar "PROTOCOL MAGIC" + +-- _ _ _ _ +-- | | | | (_) | | +-- __ _ __| | __| |______ _ _ __ _ __ _ _| |_ +-- / _` |/ _` |/ _` |______| | '_ \| '_ \| | | | __| +-- | (_| | (_| | (_| | | | | | | |_) | |_| | |_ +-- \__,_|\__,_|\__,_| |_|_| |_| .__/ \__,_|\__| +-- | | +-- |_| + +data AddInput = AddInput + { inputIx :: Word32 + , inputTxId :: ByteString + } deriving (Show) + +cmdAddInput :: Mod CommandFields Cmd +cmdAddInput = command "add-input" $ + info (helper <*> fmap CmdAddInput subCmd) $ mconcat + [ progDesc "Add a new input to the transaction." + , headerDoc (Just $ vsep + [ string "An input is made of:" + , indent 2 $ string "- A input index." + , indent 2 $ string "- An transaction id, 32 bytes, base16-encoded." + ]) + , footerDoc (Just $ vsep + [ string "Example:" + , indent 2 $ string "add-input 0 3b40265...aad1c0b7" + , indent 2 $ string " <--- 64 CHARS --->" + ]) + ] + where + subCmd = AddInput <$> inputIxArg <*> inputTxIdArg + +inputIxArg :: Parser Word32 +inputIxArg = argument auto $ + metavar "INDEX" + +inputTxIdArg :: Parser ByteString +inputTxIdArg = bytesArgument (Just 32) fromBase16 $ + metavar "TXID" + +-- _ _ _ _ +-- | | | | | | | | +-- __ _ __| | __| |______ ___ _ _| |_ _ __ _ _| |_ +-- / _` |/ _` |/ _` |______/ _ \| | | | __| '_ \| | | | __| +-- | (_| | (_| | (_| | | (_) | |_| | |_| |_) | |_| | |_ +-- \__,_|\__,_|\__,_| \___/ \__,_|\__| .__/ \__,_|\__| +-- | | +-- |_| + +data AddOutput = AddOutput + { coin :: Natural + , address :: ByteString + } deriving (Show) + +cmdAddOutput :: Mod CommandFields Cmd +cmdAddOutput = command "add-output" $ + info (helper <*> fmap CmdAddOutput subCmd) $ mconcat + [ progDesc "Add a new output to the transaction." + , headerDoc (Just $ vsep + [ string "An output is made of:" + , indent 2 $ string "- A coin value in Lovelace (1 Ada = 1e6 Lovelace)." + , indent 2 $ string "- A target address, base58-encoded." + ]) + , footerDoc (Just $ vsep + [ string "Example:" + , indent 2 $ string "add-output 1000000 2cWKMJemo...ZTBMqHTPTkv" + ]) + ] + where + subCmd = AddOutput <$> coinArg <*> addressArg + +coinArg :: Parser Natural +coinArg = argument auto $ + metavar "LOVELACE" + +addressArg :: Parser ByteString +addressArg = bytesArgument Nothing fromBase58 $ + metavar "ADDRESS" + +-- _ _ +-- | | | | +-- | | ___ ___| | __ +-- | |/ _ \ / __| |/ / +-- | | (_) | (__| < +-- |_|\___/ \___|_|\_\ + +cmdLock :: Mod CommandFields Cmd +cmdLock = command "lock" $ + info (helper <*> pure CmdLock) $ mconcat + [ progDesc "Lock the transaction and start signing inputs." + , header + "Once locked, it is no longer possible to add inputs or outputs to \ + \a transaction. This is a necessary step to be able to sign the \ + \transaction with private keys corresponding to inputs." + ] + +-- _ _ _ _ _ _ +-- (_) | | | (_) | | | +-- ___ _ __ _ _ __ | | | |_| |_| |__ +-- / __| |/ _` | '_ \| |/\| | | __| '_ \ +-- \__ \ | (_| | | | \ /\ / | |_| | | | +-- |___/_|\__, |_| |_|\/ \/|_|\__|_| |_| +-- __/ | +-- |___/ + +newtype SignWith = SignWith + { prvKey :: ByteString + } deriving (Show) + +cmdSignWith :: Mod CommandFields Cmd +cmdSignWith = command "sign-with" $ + info (helper <*> fmap CmdSignWith subCmd) $ mconcat + [ progDesc "Add a signature." + ] + where + subCmd = SignWith <$> prvKeyArg + +prvKeyArg :: Parser ByteString +prvKeyArg = bytesArgument (Just 96) fromBase16 $ + metavar "XPRV" + +-- _ _ _ +-- (_) | (_) +-- ___ ___ _ __ _ __ _| |_ _______ +-- / __|/ _ \ '__| |/ _` | | |_ / _ \ +-- \__ \ __/ | | | (_| | | |/ / __/ +-- |___/\___|_| |_|\__,_|_|_/___\___| +-- + +newtype Serialize = Serialize + { base :: Base + } deriving Show + +cmdSerialize :: Mod CommandFields Cmd +cmdSerialize = command "serialize" $ + info (helper <*> fmap CmdSerialize subCmd) $ mconcat + [ progDesc "Serialize the signed transaction to binary." + ] + where + subCmd = serializeArg + +serializeArg :: Parser Serialize +serializeArg = base16Flag <|> base64Flag + where + base16Flag = flag' (Serialize Base16) (long "base16") + base64Flag = flag (Serialize Base64) (Serialize Base64) (long "base64") + +-- _ _ _ +-- | | | | | | +-- | |_| | ___| |_ __ ___ _ __ ___ +-- | _ |/ _ \ | '_ \ / _ \ '__/ __| +-- | | | | __/ | |_) | __/ | \__ \ +-- \_| |_/\___|_| .__/ \___|_| |___/ +-- | | +-- |_| + +-- | Parse a encoded 'Bytestring' argument. +bytesArgument + :: Maybe Int -- ^ Number of bytes that are expected, if known. + -> (Text -> Maybe ByteString) -- ^ A base conversion + -> Mod ArgumentFields ByteString + -> Parser ByteString +bytesArgument len fromBase = + argument (maybeReader readerT) + where + readerT :: String -> Maybe ByteString + readerT str = do + bytes <- fromBase $ T.pack str + guard (isNothing len || Just (BS.length bytes) == len) + pure bytes + +-- | Convert a 'ByteString' to 'Base64' +base64 :: ByteString -> Text +base64 = T.decodeUtf8 . convertToBase Base64 + +-- | Convert a /Base64/ 'Text' into a 'ByteString' +fromBase64 :: Text -> Maybe ByteString +fromBase64 = either (const Nothing) Just . convertFromBase Base64 . T.encodeUtf8 + +-- | Deserialize data from a /Base64/ CBOR 'ByteString', or fail. +hGetState :: Handle -> (forall s. CBOR.Decoder s a) -> IO a +hGetState h decoder = do + bytes <- stripPEM . T.decodeUtf8 <$> BS.hGetContents h + case fromBase64 bytes of + Nothing -> failWith + "Unable to decode intermediate buffer. Did you manually crafted one?" + Just cbor -> case CBOR.deserialiseFromBytes decoder (BL.fromStrict cbor) of + Left e -> failWith (show e) + Right (_, a) -> pure a + where + stripPEM = + T.replace "\n" "" . T.unlines . dropFromEnd 1 . drop 2 . T.lines + dropFromEnd n = + reverse . drop n . reverse + +-- | Helper to output a given state to the console +hPutState :: Handle -> CBOR.Encoding -> IO () +hPutState h = + TIO.hPutStr h . encodePEM . base64 . CBOR.toStrictByteString + where + encodePEM :: Text -> Text + encodePEM body = T.unlines + [ "-----BEGIN CARDANO TX-----" + , "version: 1.0.0" + , T.intercalate "\n" (mkGroupsOf 64 body) + , "-----END CARDANO TX-----" + ] + + mkGroupsOf :: Int -> Text -> [Text] + mkGroupsOf n xs + | T.null xs = [] + | otherwise = (T.take n xs) : mkGroupsOf n (T.drop n xs) + + +-- | Fail with a colored red error message. +failWith :: String -> IO a +failWith msg = do + withSGR stderr (SetColor Foreground Vivid Red) $ do + TIO.hPutStrLn stderr (T.pack msg) + exitFailure + +-- | Bracket-style constructor for applying ANSI Select Graphic Rendition to an +-- action and revert back to normal after. +-- +-- This does nothing if the device isn't an ANSI terminal. +withSGR :: Handle -> SGR -> IO a -> IO a +withSGR h sgr action = hIsTerminalDevice h >>= \case + True -> bracket aFirst aLast aBetween + False -> action + where + aFirst = ([] <$ hSetSGR h [sgr]) + aLast = hSetSGR h + aBetween = const action diff --git a/cardano-transactions.cabal b/cardano-transactions.cabal new file mode 100644 --- /dev/null +++ b/cardano-transactions.cabal @@ -0,0 +1,109 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: b9405fb4feb0c9a4a545e76859db770d6ce65af4316862025cd7466c9e29eb69 + +name: cardano-transactions +version: 1.0.0 +synopsis: Library utilities for constructing and signing Cardano transactions. +description: Please see the README on GitHub at +category: Cardano +homepage: https://github.com/input-output-hk/cardano-transactions#readme +bug-reports: https://github.com/input-output-hk/cardano-transactions/issues +author: IOHK +maintainer: operations@iohk.io +copyright: 2020 IOHK +license: Apache-2.0 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/input-output-hk/cardano-transactions + +flag release + description: Compile executables for a release. + manual: True + default: False + +library + exposed-modules: + Data.UTxO.Transaction + Data.UTxO.Transaction.Cardano.Byron + other-modules: + Paths_cardano_transactions + hs-source-dirs: + src + ghc-options: -Wcompat -fwarn-redundant-constraints + build-depends: + base >=4.7 && <5 + , base58-bytestring + , bytestring + , cardano-binary + , cardano-crypto + , cardano-crypto-wrapper + , cardano-ledger + , cborg + , cryptonite + , extra + , memory + , text + if flag(release) + ghc-options: -Werror -Wall + default-language: Haskell2010 + +executable cardano-tx + main-is: Main.hs + other-modules: + Paths_cardano_transactions + hs-source-dirs: + app + ghc-options: -Wcompat -fwarn-redundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + ansi-terminal + , base >=4.7 && <5 + , bytestring + , cardano-transactions + , cborg + , memory + , optparse-applicative + , text + if flag(release) + ghc-options: -Werror -Wall -static -O2 + cc-options: -static + ld-options: -static -pthread + default-language: Haskell2010 + +test-suite unit + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Data.UTxO.Transaction.Cardano.ByronSpec + Paths_cardano_transactions + hs-source-dirs: + test + ghc-options: -Wcompat -fwarn-redundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-tools: + cardano-tx + build-depends: + QuickCheck + , base >=4.7 && <5 + , bytestring + , cardano-crypto-wrapper + , cardano-ledger + , cardano-ledger-test + , cardano-transactions + , cborg + , hedgehog-quickcheck + , hspec + , process + , text + if flag(release) + ghc-options: -Werror -Wall + default-language: Haskell2010 diff --git a/src/Data/UTxO/Transaction.hs b/src/Data/UTxO/Transaction.hs new file mode 100644 --- /dev/null +++ b/src/Data/UTxO/Transaction.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilyDependencies #-} + +module Data.UTxO.Transaction + ( + -- * Overview + -- $overview + + -- * Abstraction + MkPayment (..) + , ErrMkPayment (..) + + -- * Note about type-level constraints + -- $note + ) where + +import Prelude + +import Data.ByteString + ( ByteString ) + +-- $overview +-- +-- This module offers an abstraction over the construction of simple UTxO +-- transactions. Such a transaction is called a /Payment/. Payments are +-- constructed by selecting inputs and outputs, and signing each input +-- independently. +-- +-- This can be represented as a state machine, such as: +-- +-- @ +-- empty +-- | +-- *-----------------* | *----------------* +-- | | | | | +-- | v v v | +-- *--- addOutput ---=========--- addInput ---* +-- | +-- | +-- lock *----------------* +-- | | | +-- | v | +-- =========--- signWith ---* +-- | +-- | +-- serialize +-- | +-- | +-- v +-- ... +-- @ +-- +-- Functions from the 'MkPayment' interfaces are designed to be easy to chain +-- like pipes. To give a concrete example, let's see how to construct a +-- transaction with /one input/ and /two outputs/: +-- +-- @ +-- import Data.Function +-- ( (&) ) +-- import qualified Data.UTxO.Transaction as Tx +-- +-- bytes = Tx.empty +-- & Tx.addInput input0 +-- & Tx.addOutput output0 +-- & Tx.addOutput output1 +-- & Tx.lock +-- & Tx.signWith key0 +-- & Tx.serialize +-- @ +-- +-- The reason why the 'lock' step is required is because, in order to create +-- witnesses, one must produce signatures of the whole transaction body (inputs +-- + outputs). Hence, signatures can only be added once all inputs and all +-- outputs have already been addded. +-- +-- This is correct-by-construction thanks to the 'lock' step and the distinction +-- between 'CoinSel' and 'Tx'. + +-- | Abstract interface for constructing a /Payment/. +class MkPayment dom where + -- | Some initial extra data needed to construct and or serialize the + -- transaction. This is a free-type which is implementation-specific. + -- + -- For example, Byron transactions requires the underlying protocol magic in + -- order to produce witnesses. This is an appropriate place for. + type Init dom :: * + + -- | Type representation of transaction 'Input' + type Input dom = inp | inp -> dom + + -- | Type representation of transaction 'Output' + type Output dom = out | out -> dom + + -- | Type representation of transaction 'SignKey' + type SignKey dom = key | key -> dom + + -- | An intermediate type for representing a transaction under construction. + -- 'Input' and 'Output' can still be added to a 'CoinSel' and must be added + -- before trying to sign any of the inputs. + type CoinSel dom = sel | sel -> dom + + -- | A transaction is a locked 'CoinSel' to which it is no longer possible + -- to add new 'Input' and or 'Output'. Only 'Tx' can be serialized. + type Tx dom = tx | tx -> dom + + -- * Transaction construction + empty :: Init dom -> CoinSel dom + addInput :: Input dom -> CoinSel dom -> CoinSel dom + addOutput :: Output dom -> CoinSel dom -> CoinSel dom + + -- * Transaction signature + lock :: CoinSel dom -> Tx dom + signWith :: SignKey dom -> Tx dom -> Tx dom + + -- * Transaction serialization + serialize :: Tx dom -> Either ErrMkPayment ByteString + +-- | Possible errors occuring when constructing a /Payment/. This can in +-- practice be safely ignored if the transaction is known to be well-formed. +data ErrMkPayment + = MissingInput + -- ^ Payments must have at least one input. + | MissingOutput + -- ^ Payments must have at least one output + | MissingSignature + -- ^ Payments must have a signature for each input. + deriving (Show, Read, Eq) + +-- $note +-- +-- It is relatively easy to tweak the interface below to get it fully type-safe +-- by using an inductive type, such as: +-- +-- @ +-- data N = Zero | Some N +-- +-- class MkPayment dom where +-- type Init dom :: * +-- +-- type Input dom = inp | inp -> dom +-- type Output dom = out | out -> dom +-- type SignKey dom = key | key -> dom +-- +-- type CoinSel dom = (sel :: N -> N -> *) | sel -> dom +-- type Tx dom = (tx :: N -> *) | tx -> dom +-- +-- empty :: Init dom -> CoinSel dom Zero Zero +-- +-- addInput :: Input dom -> CoinSel dom n m -> CoinSel dom (Some n) m +-- addOutput :: Output dom -> CoinSel dom n m -> CoinSel dom n (Some m) +-- +-- lock :: CoinSel dom (Some n) (Some m) -> Tx dom (Some n) +-- +-- signWith :: SignKey dom -> Tx dom (Some n) -> Tx dom n +-- +-- serialize :: Tx dom Zero -> ByteString +-- @ +-- +-- Such approach is great for ensuring that the transaction can't be ill-formed +-- and works well when manually constructing the transaction as shown above. +-- +-- It gets however quite complex when one wants to start folding or mapping on a +-- list of inputs or outputs where their numbers isn't known at compile-time! +-- Indeed, each call to 'addInput' does actually return a new type! +-- +-- Let's say we want to write the following function: +-- +-- @ +-- addMany :: [Input dom] -> CoinSel dom n m -> CoinSel dom ? m +-- @ +-- +-- What should be the type of `?`. This can't possibly known at compile-time. diff --git a/src/Data/UTxO/Transaction/Cardano/Byron.hs b/src/Data/UTxO/Transaction/Cardano/Byron.hs new file mode 100644 --- /dev/null +++ b/src/Data/UTxO/Transaction/Cardano/Byron.hs @@ -0,0 +1,360 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_HADDOCK prune #-} + +module Data.UTxO.Transaction.Cardano.Byron + ( + -- * Initialization + mkInit + , mainnetMagic + , testnetMagic + + -- * Constructing Primitives + , mkInput + , mkOutput + , mkSignKey + + -- * Converting From Bases + , fromBase16 + , fromBase58 + , fromBase64 + + -- Internal + , Byron + , encodeCoinSel + , decodeCoinSel + , encodeTx + , decodeTx + ) where + +import Cardano.Binary + ( FromCBOR (..), ToCBOR (..) ) +import Cardano.Chain.Common + ( mkAttributes, mkLovelace ) +import Cardano.Chain.UTxO + ( TxIn (..), TxInWitness (..), TxOut (..), TxSigData (..), mkTxAux ) +import Cardano.Crypto.Hashing + ( AbstractHash (..), hash ) +import Cardano.Crypto.ProtocolMagic + ( ProtocolMagicId (..) ) +import Cardano.Crypto.Signing + ( SignTag (..), Signature, SigningKey (..), VerificationKey (..) ) +import Cardano.Crypto.Wallet + ( toXPub, xprv ) +import Codec.CBOR.Read + ( deserialiseFromBytes ) +import Crypto.Error + ( eitherCryptoError ) +import Crypto.Hash + ( Blake2b_256, digestFromByteString ) +import Data.ByteArray.Encoding + ( Base (..), convertFromBase ) +import Data.ByteString + ( ByteString ) +import Data.ByteString.Base58 + ( bitcoinAlphabet, decodeBase58 ) +import Data.Either.Extra + ( eitherToMaybe ) +import Data.List.NonEmpty + ( NonEmpty, nonEmpty ) +import Data.Text + ( Text ) +import Data.UTxO.Transaction + ( ErrMkPayment (..), MkPayment (..) ) +import Data.Word + ( Word32 ) +import GHC.Exts + ( IsList (fromList) ) +import Numeric.Natural + ( Natural ) + +import qualified Cardano.Chain.UTxO as CC +import qualified Cardano.Crypto.Signing as CC +import qualified Codec.CBOR.Decoding as CBOR +import qualified Codec.CBOR.Encoding as CBOR +import qualified Codec.CBOR.Write as CBOR +import qualified Crypto.ECC.Edwards25519 as Ed25519 +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +-- | Construct a payment 'Init' for /Byron/ from primitive types. +-- +-- __examples__: +-- +-- >>> mkInit 764824073 == mainnetMagic +-- True +-- +-- >>> mkInit 1097911063 == testnetMagic +-- True +-- +-- @since 1.0.0 +mkInit + :: Word32 + -- ^ A protocol magic id + -> Init Byron +mkInit = + ProtocolMagicId + +-- | Pre-defined 'Init' magic for /Byron/ MainNet. +-- +-- @since 1.0.0 +mainnetMagic :: Init Byron +mainnetMagic = mkInit 764824073 + +-- | Pre-defined 'Init' magic for /Byron/ TestNet. +-- +-- @since 1.0.0 +testnetMagic :: Init Byron +testnetMagic = mkInit 1097911063 + +-- | Construct a payment 'Input' for /Byron/ from primitive types. +-- +-- __example__: +-- +-- >>> mkInput 14 =<< fromBase16 "3b402651...aad1c0b7" +-- Just (Input ...) +-- +-- @since 1.0.0 +mkInput + :: Word32 + -- ^ Input index. + -> ByteString + -- ^ Input transaction id. See also: 'fromBase16'. + -> Maybe (Input Byron) +mkInput ix bytes = + case digestFromByteString @Blake2b_256 bytes of + Just txId -> Just $ TxInUtxo (AbstractHash txId) ix + Nothing -> Nothing + +-- | Construct a payment 'Output' for /Byron/ from primitive types. +-- +-- __example__: +-- +-- >>> mkOutput 42 =<< fromBase58 "Ae2tdPwU...DnXy319f" +-- Just (Output ...) +-- +-- @since 1.0.0 +mkOutput + :: Natural + -- ^ Output value, in Lovelace (1 Ada = 1e6 Lovelace). + -> ByteString + -- ^ Output Address. See also: 'fromBase58'. + -> Maybe (Output Byron) +mkOutput n bytes = + case (fromCBOR' bytes, mkLovelace (fromIntegral n)) of + (Right addr, Right coin) -> Just $ TxOut addr coin + _ -> Nothing + where + fromCBOR' = fmap snd . deserialiseFromBytes fromCBOR . BL.fromStrict + +-- | Construct a 'SignKey' for /Byron/ from primitive types. +-- +-- __example__: +-- +-- >>> mkSignKey =<< fromBase16 "3b402651...aad1c0b7" +-- Just (SignKey ...) +-- +-- @since 1.0.0 +mkSignKey + :: ByteString + -- ^ A extended address private key and its chain code. + -- The key __must be 96 bytes__ long, internally made of two concatenated parts: + -- + -- @ + -- BYTES = PRV | CC + -- PRV = 64OCTET # a 64 bytes Ed25519 extended private key + -- CC = 32OCTET # a 32 bytes chain code + -- @ + -- + -- See also: 'fromBase16'. + -> Maybe (SignKey Byron) +mkSignKey bytes + | BS.length bytes /= 96 = Nothing + | otherwise = do + let (prv, cc) = BS.splitAt 64 bytes + pub <- ed25519ScalarMult (BS.take 32 prv) + fmap SigningKey $ eitherToMaybe $ xprv $ prv <> pub <> cc + where + ed25519ScalarMult :: ByteString -> Maybe ByteString + ed25519ScalarMult bs = do + scalar <- eitherToMaybe $ eitherCryptoError $ Ed25519.scalarDecodeLong bs + pure $ Ed25519.pointEncode $ Ed25519.toPoint scalar + +-- +-- ByteString Decoding +-- + +-- | Convert a base16 encoded 'Text' into a raw 'ByteString' +-- +-- @since 1.0.0 +fromBase16 :: Text -> Maybe ByteString +fromBase16 = eitherToMaybe . convertFromBase Base16 . T.encodeUtf8 + +-- | Convert a base58 encoded 'Text' into a raw 'ByteString' +-- +-- @since 1.0.0 +fromBase58 :: Text -> Maybe ByteString +fromBase58 = decodeBase58 bitcoinAlphabet . T.encodeUtf8 + + +-- | Convert a base64 encoded 'Text' into a raw 'ByteString' +-- +-- @since 1.0.0 +fromBase64 :: Text -> Maybe ByteString +fromBase64 = eitherToMaybe . convertFromBase Base64 . T.encodeUtf8 + +-- +-- MkPayment instance +-- + +-- Type-level constructor capturing types for 'Byron'. +data Byron + +instance MkPayment Byron where + type Init Byron = ProtocolMagicId + + type Input Byron = TxIn + type Output Byron = TxOut + type SignKey Byron = SigningKey + + type CoinSel Byron = + (ProtocolMagicId, [TxIn], [TxOut]) + + type Tx Byron = Either + ErrMkPayment + (ProtocolMagicId, NonEmpty TxIn, NonEmpty TxOut, TxSigData, [TxInWitness]) + + empty :: ProtocolMagicId -> CoinSel Byron + empty pm = (pm, mempty, mempty) + + addInput :: TxIn -> CoinSel Byron -> CoinSel Byron + addInput inp (pm, inps, outs) = (pm, inp : inps, outs) + + addOutput :: TxOut -> CoinSel Byron -> CoinSel Byron + addOutput out (pm, inps, outs) = (pm, inps, out : outs) + + lock :: CoinSel Byron -> Tx Byron + lock (_pm, [], _outs) = Left MissingInput + lock (_pm, _inps, []) = Left MissingOutput + lock (pm, inps, outs) = + Right (pm, neInps, neOuts, sigData, mempty) + where + sigData = TxSigData $ hash $ CC.UnsafeTx neInps neOuts (mkAttributes ()) + neInps = NE.fromList $ reverse inps + neOuts = NE.fromList $ reverse outs + + signWith :: SigningKey -> Tx Byron -> Tx Byron + signWith _ (Left e) = Left e + signWith (SigningKey prv) (Right (pm, inps, outs, sigData, wits)) = + Right (pm, inps, outs, sigData, VKWitness vk sig : wits) + where + vk :: VerificationKey + vk = VerificationKey (toXPub prv) + + sig :: Signature TxSigData + sig = CC.sign pm SignTx (SigningKey prv) sigData + + serialize :: Tx Byron -> Either ErrMkPayment ByteString + serialize (Left e) = Left e + serialize (Right (_pm, inps, outs, _sigData, wits)) + | NE.length inps /= length wits = Left MissingSignature + | otherwise = Right $ CBOR.toStrictByteString $ toCBOR $ mkTxAux + (CC.UnsafeTx inps outs (mkAttributes ())) + (fromList $ reverse wits) + + +-- Internal +-- +-- For running the Payment DSL as a command-line, we need to be able to produce +-- a text output representing the internal state. +-- +-- There's no point about obfuscating this more than necessary; this should +-- remain mainly invisible to users if used properly through pipes. Yet, it can +-- be useful to have a human-friendly representation that is base16 or base64 +-- encoded. Three possible obvious choice: +-- +-- - CBOR, since most data above can already be serialized to CBOR +-- - JSON, instances exists on most type and are derived generically from CBOR +-- - Show, although here most types don't have a corresponding 'Read' instance. +-- +-- Since we also need to decode an encoded state, CBOR will be path of least +-- resistance. + +-- __Internal__: Encode a 'CoinSel Byron' to CBOR. +encodeCoinSel :: CoinSel Byron -> CBOR.Encoding +encodeCoinSel (pm, inps, outs) = mconcat + [ toCBOR pm + , CBOR.encodeListLenIndef + , mconcat (toCBOR <$> inps) + , CBOR.encodeBreak + , CBOR.encodeListLenIndef + , mconcat (toCBOR <$> outs) + , CBOR.encodeBreak + ] + +-- __Internal__: Decode a 'CoinSel Byron' from CBOR. +decodeCoinSel :: CBOR.Decoder s (CoinSel Byron) +decodeCoinSel = (,,) + <$> fromCBOR + <*> decodeListIndef fromCBOR + <*> decodeListIndef fromCBOR + +-- __Internal__: Encode a 'Tx Byron' to CBOR. +encodeTx :: Tx Byron -> CBOR.Encoding +encodeTx (Left e) = mconcat + [ CBOR.encodeWord8 0 + , CBOR.encodeString $ T.pack $ show e + ] +encodeTx (Right (pm, inps, outs, sigData, wits)) = mconcat + [ CBOR.encodeWord8 1 + , encodeCoinSel (pm, NE.toList inps, NE.toList outs) + , toCBOR sigData + , CBOR.encodeListLenIndef + , mconcat (toCBOR <$> wits) + , CBOR.encodeBreak + ] + +-- __Internal__: Decode a 'Tx Byron' from CBOR. +decodeTx :: CBOR.Decoder s (Tx Byron) +decodeTx = do + CBOR.decodeWord8 >>= \case + 0 -> fmap T.unpack CBOR.decodeString >>= \case + str | str == show MissingInput -> pure $ Left MissingInput + str | str == show MissingOutput -> pure $ Left MissingOutput + str | str == show MissingSignature -> pure $ Left MissingSignature + _ -> fail $ + "Invalid error constructor found in 'Tx Byron'. Constructor must \ + \be one of: " <> unwords (show <$> + [ MissingInput, MissingOutput, MissingSignature]) + 1 -> do + (pm, inps, outs) <- decodeCoinSel + sigData <- fromCBOR + wits <- decodeListIndef fromCBOR + case (nonEmpty inps, nonEmpty outs) of + (Nothing, _) -> fail + "Empty list of inputs found in 'Tx Byron'. This is impossible \ + \unless the data has been modified by hand." + (_, Nothing) -> fail + "Empty list of outputs found in 'Tx Byron'. This is impossible \ + \unless the data has been modified by hand." + (Just neInps, Just neOuts) -> + pure $ Right (pm, neInps, neOuts, sigData, wits) + + _ -> fail + "'Tx Byron' has been modified with and is now invalid. The first \ + \byte must be either 0 or 1, followed by respectively an error \ + \constructor or constituants of the intermediate transaction." + +-- __Internal__ Decode an arbitrary long list 'sandwiched' by markers. +decodeListIndef :: forall s a. CBOR.Decoder s a -> CBOR.Decoder s [a] +decodeListIndef decodeOne = do + _ <- CBOR.decodeListLenIndef + CBOR.decodeSequenceLenIndef (flip (:)) [] reverse decodeOne diff --git a/test/Data/UTxO/Transaction/Cardano/ByronSpec.hs b/test/Data/UTxO/Transaction/Cardano/ByronSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/UTxO/Transaction/Cardano/ByronSpec.hs @@ -0,0 +1,588 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.UTxO.Transaction.Cardano.ByronSpec + ( spec + ) where + +import Prelude + +import Cardano.Chain.UTxO + ( TxIn (..), TxInWitness (..), TxOut (..), TxSigData (..) ) +import Cardano.Crypto.ProtocolMagic + ( ProtocolMagicId (..) ) +import Control.Monad + ( foldM ) +import Data.ByteString + ( ByteString ) +import Data.Function + ( (&) ) +import Data.List.NonEmpty + ( NonEmpty ) +import Data.Maybe + ( fromJust, fromMaybe, isNothing ) +import Data.Text + ( Text ) +import Data.UTxO.Transaction + ( ErrMkPayment (..), MkPayment (..) ) +import Data.UTxO.Transaction.Cardano.Byron + ( Byron + , decodeCoinSel + , decodeTx + , encodeCoinSel + , encodeTx + , fromBase16 + , fromBase58 + , fromBase64 + , mainnetMagic + , mkInit + , mkInput + , mkOutput + , mkSignKey + , testnetMagic + ) +import Data.Word + ( Word32, Word64 ) +import Numeric.Natural + ( Natural ) +import System.Process + ( readProcess ) +import Test.Cardano.Chain.UTxO.Gen + ( genTxIn, genTxInWitness, genTxOut, genTxSigData ) +import Test.Hspec + ( Spec, describe, expectationFailure, it, shouldBe ) +import Test.Hspec.QuickCheck + ( prop ) +import Test.QuickCheck + ( Arbitrary (..) + , NonEmptyList (..) + , Property + , conjoin + , counterexample + , elements + , forAll + , listOf + , oneof + , property + , quickCheck + , suchThat + , withMaxSuccess + , (===) + ) +import Test.QuickCheck.Hedgehog + ( hedgehog ) + +import qualified Codec.CBOR.Decoding as CBOR +import qualified Codec.CBOR.Encoding as CBOR +import qualified Codec.CBOR.Pretty as CBOR +import qualified Codec.CBOR.Read as CBOR +import qualified Codec.CBOR.Write as CBOR +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T +import qualified Data.UTxO.Transaction as Tx + +{-# ANN spec ("HLint: ignore Use head" :: String) #-} + +spec :: Spec +spec = do + describe "CBOR roundtrips" $ do + it "CoinSel Byron" $ withMaxSuccess 500 $ property $ + prop_RoundTripCBOR encodeCoinSel decodeCoinSel + + it "Tx Byron" $ withMaxSuccess 500 $ property $ + prop_RoundTripCBOR encodeTx decodeTx + + describe "(Mainnet) Golden Tests Transaction Construction" $ do + it "1 input, 1 output (DSL)" $ do + compareGolden goldenMainnet__1_1 $ Tx.empty mainnetMagic + & Tx.addInput (unsafeMkInput 0 (txids !! 0)) + & Tx.addOutput (unsafeMkOutput 42 (addrs !! 0)) + & Tx.lock + & Tx.signWith (unsafeMkSignKey (keys !! 0)) + & Tx.serialize + + it "1 input, 1 output (CLI)" $ do + state <- cardanoTx [ "empty", mainnetMagicT ] "" + >>= cardanoTx [ "add-input", "0", txids !! 0 ] + >>= cardanoTx [ "add-output", "42", addrs !! 0 ] + >>= cardanoTx [ "lock" ] + >>= cardanoTx [ "sign-with", keys !! 0 ] + + defaul <- fromBase64E <$> cardanoTx [ "serialize" ] state + base16 <- fromBase16E <$> cardanoTx [ "serialize", "--base16" ] state + base64 <- fromBase64E <$> cardanoTx [ "serialize", "--base64" ] state + compareGolden goldenMainnet__1_1 base16 + compareGolden goldenMainnet__1_1 base64 + compareGolden goldenMainnet__1_1 defaul + + it "2 inputs, 2 outputs (DSL)" $ do + compareGolden goldenMainnet__2_2 $ Tx.empty mainnetMagic + & Tx.addInput (unsafeMkInput 0 (txids !! 0)) + & Tx.addInput (unsafeMkInput 1 (txids !! 0)) + & Tx.addOutput (unsafeMkOutput 42 (addrs !! 0)) + & Tx.addOutput (unsafeMkOutput 14 (addrs !! 1)) + & Tx.lock + & Tx.signWith (unsafeMkSignKey (keys !! 0)) + & Tx.signWith (unsafeMkSignKey (keys !! 1)) + & Tx.serialize + + it "2 inputs, 2 outputs (CLI)" $ do + state <- cardanoTx [ "empty", mainnetMagicT ] "" + >>= cardanoTx [ "add-input", "0", txids !! 0 ] + >>= cardanoTx [ "add-input", "1", txids !! 0 ] + >>= cardanoTx [ "add-output", "42", addrs !! 0 ] + >>= cardanoTx [ "add-output", "14", addrs !! 1 ] + >>= cardanoTx [ "lock" ] + >>= cardanoTx [ "sign-with", keys !! 0 ] + >>= cardanoTx [ "sign-with", keys !! 1 ] + + defaul <- fromBase64E <$> cardanoTx [ "serialize" ] state + base16 <- fromBase16E <$> cardanoTx [ "serialize", "--base16" ] state + base64 <- fromBase64E <$> cardanoTx [ "serialize", "--base64" ] state + compareGolden goldenMainnet__2_2 base16 + compareGolden goldenMainnet__2_2 base64 + compareGolden goldenMainnet__2_2 defaul + + it "1 input, 25 outputs (DSL)" $ do + compareGolden goldenMainnet__25_1 $ Tx.empty mainnetMagic + & Tx.addInput (unsafeMkInput 0 (txids !! 0)) + & flip (foldr Tx.addOutput) (replicate 25 $ unsafeMkOutput 14 (addrs !! 0)) + & Tx.lock + & Tx.signWith (unsafeMkSignKey (keys !! 0)) + & Tx.serialize + + it "1 input, 25 outputs (CLI)" $ do + state <- cardanoTx [ "empty", mainnetMagicT ] "" + >>= cardanoTx [ "add-input", "0", txids !! 0 ] + >>= flip (foldM (&)) (replicate 25 $ cardanoTx [ "add-output", "14", addrs !! 0]) + >>= cardanoTx [ "lock" ] + >>= cardanoTx [ "sign-with", keys !! 0 ] + + defaul <- fromBase64E <$> cardanoTx [ "serialize" ] state + base16 <- fromBase16E <$> cardanoTx [ "serialize", "--base16" ] state + base64 <- fromBase64E <$> cardanoTx [ "serialize", "--base64" ] state + compareGolden goldenMainnet__25_1 base16 + compareGolden goldenMainnet__25_1 base64 + compareGolden goldenMainnet__25_1 defaul + + describe "(Testnet) Golden Tests Transaction Construction" $ do + it "1 input, 1 output (DSL)" $ do + compareGolden goldenTestnet__1_1 $ Tx.empty testnetMagic + & Tx.addInput (unsafeMkInput 0 (txids !! 0)) + & Tx.addOutput (unsafeMkOutput 42 (addrs !! 2)) + & Tx.lock + & Tx.signWith (unsafeMkSignKey (keys !! 0)) + & Tx.serialize + + it "1 input, 1 output (CLI)" $ do + state <- cardanoTx [ "empty", testnetMagicT ] "" + >>= cardanoTx [ "add-input", "0", txids !! 0 ] + >>= cardanoTx [ "add-output", "42", addrs !! 2 ] + >>= cardanoTx [ "lock" ] + >>= cardanoTx [ "sign-with", keys !! 0 ] + + defaul <- fromBase64E <$> cardanoTx [ "serialize" ] state + base16 <- fromBase16E <$> cardanoTx [ "serialize", "--base16" ] state + base64 <- fromBase64E <$> cardanoTx [ "serialize", "--base64" ] state + compareGolden goldenTestnet__1_1 base16 + compareGolden goldenTestnet__1_1 base64 + compareGolden goldenTestnet__1_1 defaul + + + it "2 inputs, 2 outputs (DSL)" $ do + compareGolden goldenTestnet__2_2 $ Tx.empty testnetMagic + & Tx.addInput (unsafeMkInput 0 (txids !! 0)) + & Tx.addInput (unsafeMkInput 1 (txids !! 0)) + & Tx.addOutput (unsafeMkOutput 42 (addrs !! 2)) + & Tx.addOutput (unsafeMkOutput 14 (addrs !! 3)) + & Tx.lock + & Tx.signWith (unsafeMkSignKey (keys !! 0)) + & Tx.signWith (unsafeMkSignKey (keys !! 1)) + & Tx.serialize + + it "2 inputs, 2 outputs (CLI)" $ do + state <- cardanoTx [ "empty", testnetMagicT ] "" + >>= cardanoTx [ "add-input", "0", txids !! 0 ] + >>= cardanoTx [ "add-input", "1", txids !! 0 ] + >>= cardanoTx [ "add-output", "42", addrs !! 2 ] + >>= cardanoTx [ "add-output", "14", addrs !! 3 ] + >>= cardanoTx [ "lock" ] + >>= cardanoTx [ "sign-with", keys !! 0 ] + >>= cardanoTx [ "sign-with", keys !! 1 ] + + defaul <- fromBase64E <$> cardanoTx [ "serialize" ] state + base16 <- fromBase16E <$> cardanoTx [ "serialize", "--base16" ] state + base64 <- fromBase64E <$> cardanoTx [ "serialize", "--base64" ] state + compareGolden goldenTestnet__2_2 base16 + compareGolden goldenTestnet__2_2 base64 + compareGolden goldenTestnet__2_2 defaul + + it "1 input, 25 outputs (DSL)" $ do + compareGolden goldenTestnet__25_1 $ Tx.empty testnetMagic + & Tx.addInput (unsafeMkInput 0 (txids !! 0)) + & flip (foldr Tx.addOutput) (replicate 25 $ unsafeMkOutput 14 (addrs !! 2)) + & Tx.lock + & Tx.signWith (unsafeMkSignKey (keys !! 0)) + & Tx.serialize + + + it "1 input, 25 outputs (CLI)" $ do + state <- cardanoTx [ "empty", testnetMagicT ] "" + >>= cardanoTx [ "add-input", "0", txids !! 0 ] + >>= flip (foldM (&)) (replicate 25 $ cardanoTx [ "add-output", "14", addrs !! 2]) + >>= cardanoTx [ "lock" ] + >>= cardanoTx [ "sign-with", keys !! 0 ] + + defaul <- fromBase64E <$> cardanoTx [ "serialize" ] state + base16 <- fromBase16E <$> cardanoTx [ "serialize", "--base16" ] state + base64 <- fromBase64E <$> cardanoTx [ "serialize", "--base64" ] state + compareGolden goldenTestnet__25_1 base16 + compareGolden goldenTestnet__25_1 base64 + compareGolden goldenTestnet__25_1 defaul + + + describe "Negative tests" $ do + prop "Invalid Input" $ \ix -> do + let len = 32 + let genInvalidId = oneof + [ pure "" + , pure $ BS.replicate (len - 1) 0 + , pure $ BS.replicate (len + 1) 0 + , (BS.pack <$> arbitrary) `suchThat` ((/= len) . BS.length) + ] + forAll genInvalidId (isNothing . mkInput ix) + + prop "Invalid Output" $ \(coin :: Word64) -> do + let genInvalidAddress = BS.pack <$> arbitrary + forAll genInvalidAddress (isNothing . mkOutput (fromIntegral coin)) + + prop "Invalid SignKey" $ do + let len = 96 + let genInvalidSignKey = + (BS.pack <$> arbitrary) `suchThat` ((/= len) . BS.length) + forAll genInvalidSignKey (isNothing . mkSignKey) + + it "Missing Input" $ do + let result = Tx.empty mainnetMagic + & Tx.addOutput (unsafeMkOutput 14 (addrs !! 0)) + & Tx.lock + & Tx.serialize + result `shouldBe` Left MissingInput + + it "Missing Output" $ do + let result = Tx.empty mainnetMagic + & Tx.addInput (unsafeMkInput 0 (txids !! 0)) + & Tx.lock + & Tx.serialize + result `shouldBe` Left MissingOutput + + it "Missing Signature" $ do + let result = Tx.empty mainnetMagic + & Tx.addInput (unsafeMkInput 0 (txids !! 0)) + & Tx.addOutput (unsafeMkOutput 14 (addrs !! 0)) + & Tx.lock + & Tx.serialize + result `shouldBe` Left MissingSignature + +-- +-- Property: Roundtrip CBOR +-- + +prop_RoundTripCBOR + :: (Show a, Eq a) + => (a -> CBOR.Encoding) + -> (forall s. CBOR.Decoder s a) + -> a + -> Property +prop_RoundTripCBOR encode decode a = + result === Right (mempty, a) + where + bytes = CBOR.toStrictByteString (encode a) + result = CBOR.deserialiseFromBytes decode (BL.fromStrict bytes) + +instance Arbitrary ProtocolMagicId where + arbitrary = mkInit <$> arbitrary + +instance Arbitrary TxIn where + arbitrary = hedgehog genTxIn + +instance Arbitrary TxOut where + arbitrary = hedgehog genTxOut + +instance Arbitrary TxSigData where + arbitrary = hedgehog genTxSigData + +instance Arbitrary ErrMkPayment where + arbitrary = elements [ MissingInput, MissingOutput, MissingSignature ] + +instance {-# OVERLAPS #-} + ( Arbitrary a, Arbitrary b, Arbitrary c) + => Arbitrary (ProtocolMagicId, NonEmpty a, NonEmpty b, c, [TxInWitness]) + where + arbitrary = do + pm <- arbitrary + wits <- listOf (hedgehog $ genTxInWitness pm) + (,,,,) + <$> pure pm + <*> fmap (NE.fromList . getNonEmpty) arbitrary + <*> fmap (NE.fromList . getNonEmpty) arbitrary + <*> arbitrary + <*> pure wits + +-- +-- Golden +-- + +compareGolden + :: Show e + => ByteString + -- ^ An expected encoded result + -> Either e ByteString + -- ^ The actual string received + -> IO () +compareGolden _want (Left e) = expectationFailure (show e) +compareGolden want (Right got) = quickCheck $ withMaxSuccess 1 $ + -- NOTE Using QuickCheck here simply for getting better counter examples + -- than HSpec in case of failure... + conjoin (uncurry (===) <$> zip (lines prettyWant) (lines prettyGot)) + & counterexample ("Got: " <> prettyGot) + & counterexample ("Want: " <> prettyWant) + where + prettyWant = + CBOR.prettyHexEnc $ CBOR.encodePreEncoded want + prettyGot = + CBOR.prettyHexEnc $ CBOR.encodePreEncoded got + +-- +-- Internal +-- + +unsafeMkInput :: Word32 -> Text -> Input Byron +unsafeMkInput ix str = fromJust $ mkInput ix (unsafeB16 str) + +unsafeMkOutput :: Natural -> Text -> Output Byron +unsafeMkOutput n str = fromJust $ mkOutput n (unsafeB58 str) + +unsafeMkSignKey :: Text -> SignKey Byron +unsafeMkSignKey str = fromJust $ mkSignKey (unsafeB16 str) + +unsafeB16 :: Text -> ByteString +unsafeB16 = fromMaybe (error msg) . fromBase16 + where msg = "unable to decode base16 string." + +unsafeB58 :: Text -> ByteString +unsafeB58 = fromMaybe (error msg) . fromBase58 + where msg = "unable to decode base58 string." + +fromBase64E :: Text -> Either String ByteString +fromBase64E = maybe (Left msg) Right . fromBase64 + where msg = "unable to decode base64 string." + +fromBase16E :: Text -> Either String ByteString +fromBase16E = maybe (Left msg) Right . fromBase16 + where msg = "unable to decode base16 string." + +mainnetMagicT :: Text +mainnetMagicT = T.pack $ show $ unProtocolMagicId mainnetMagic + +testnetMagicT :: Text +testnetMagicT = T.pack $ show $ unProtocolMagicId testnetMagic + +cardanoTx + :: [Text] + -- ^ Arguments + -> Text + -- ^ stdin + -> IO Text + -- ^ stdout +cardanoTx args = + fmap T.pack . readProcess "cardano-tx" (T.unpack <$> args) . T.unpack + +-- +-- Test Vectors +-- + +txids :: [Text] +txids = + [ "3b40265111d8bb3c3c608d95b3a0bf83461ace32d79336579a1939b3aad1c0b7" + ] + +addrs :: [Text] +addrs = + -- Mainnet + [ "Ae2tdPwUPEZETXfbQxKMkMJQY1MoHCBS7bkw6TmhLjRvi9LZh1uDnXy319f" + , "Ae2tdPwUPEZ69HTPqLpnFFw2MAfwdEoV5cpVQP5Uy1bPijSEHQmMXUfT3q5" + + -- Testnet + , "2cWKMJemoBajc46Wu4Z7e6bG48myZWfB7Z6pD77L6PrJQWt9HZ3Yv7o8CYZTBMqHTPTkv" + , "2cWKMJemoBaiLiNB8QpHKjkQhnPdQSyxaLb8JJFUQYpiVzgEJE59fN7V7StqnyDuDjHYJ" + ] + +keys :: [Text] +keys = + [ "e0860dab46f13e74ab834142e8877b80bf22044cae8ebab7a21ed1b8dc00c155\ + \f6b78eee2a5bbd453ce7e7711b2964abb6a36837e475271f18ff36ae5fc8af73\ + \e25db39fb78e74d4b53fb51776d0f5eb360e62d09b853f3a87ac25bf834ee1fb" + + , "00bc08703e4bb4d9fe6edf4ad2ccb1ffc6fb8d555d96805d643e5d06afde605c\ + \e7d41d056def11417b17d3fb7415392b5f329877f372e55b0959c71b2bd2b447\ + \1bbf1c6081545b1ab140578d7b5c035bf904d05dd8e9b79b34d3160f86206bfc" + ] + +goldenMainnet__1_1 :: ByteString +goldenMainnet__1_1 = unsafeB16 + "82839f8200d81858248258203b40265111d8bb3c3c608d95b3a0bf83461ace3\ + \2d79336579a1939b3aad1c0b700ff9f8282d818582183581cb0e693cbc97272\ + \bd42aacf3b443ecac68b96b4fa20159186a4a38883a0001a497c15c6182affa\ + \0818200d81858858258408e620235b2a427259cc1a1c63af9ef179cb3b6e396\ + \da182e01d65dd3ed7be94be25db39fb78e74d4b53fb51776d0f5eb360e62d09\ + \b853f3a87ac25bf834ee1fb58403684501a21346ba3c19a6dc3479180e80a14\ + \e5edc0ffb4b1469abe0332e7e1caf291d50cb8d2c47ee37f6b44b7fbfcc5a1b\ + \01bc262038e93969b9a728a2b3500" + +goldenMainnet__2_2 :: ByteString +goldenMainnet__2_2 = unsafeB16 + "82839f8200d81858248258203b40265111d8bb3c3c608d95b3a0bf83461ace32\ + \d79336579a1939b3aad1c0b7008200d81858248258203b40265111d8bb3c3c60\ + \8d95b3a0bf83461ace32d79336579a1939b3aad1c0b701ff9f8282d818582183\ + \581cb0e693cbc97272bd42aacf3b443ecac68b96b4fa20159186a4a38883a000\ + \1a497c15c6182a8282d818582183581c5d9254c4b41dbdc10f9c3b4517630497\ + \6e5e210decc38792ab2b50c9a0001ab537acfc0effa0828200d8185885825840\ + \8e620235b2a427259cc1a1c63af9ef179cb3b6e396da182e01d65dd3ed7be94b\ + \e25db39fb78e74d4b53fb51776d0f5eb360e62d09b853f3a87ac25bf834ee1fb\ + \5840a214bef8191aca0b41c109101c420deb131f5eff63394285dc18fc39726f\ + \b24a7bc34adce5a6e234360aae398b431a47d9b9d9a71cdcea6bd21bac7ed816\ + \53068200d81858858258402cf36a269802da7cc0408308bda9a0015e7e819121\ + \17013c93edeefa9b62bbb61bbf1c6081545b1ab140578d7b5c035bf904d05dd8\ + \e9b79b34d3160f86206bfc58403cb09514f2d27f5dab76480ec010b4e89c0c50\ + \f583c00bca487e0a45643e4c2854842c57d87f93961efad7037be8de5100d0fc\ + \e2383e8a11e20cb9762731da0c" + +goldenMainnet__25_1 :: ByteString +goldenMainnet__25_1 = unsafeB16 + "82839f8200d81858248258203b40265111d8bb3c3c608d95b3a0bf83461ace32\ + \d79336579a1939b3aad1c0b700ff9f8282d818582183581cb0e693cbc97272bd\ + \42aacf3b443ecac68b96b4fa20159186a4a38883a0001a497c15c60e8282d818\ + \582183581cb0e693cbc97272bd42aacf3b443ecac68b96b4fa20159186a4a388\ + \83a0001a497c15c60e8282d818582183581cb0e693cbc97272bd42aacf3b443e\ + \cac68b96b4fa20159186a4a38883a0001a497c15c60e8282d818582183581cb0\ + \e693cbc97272bd42aacf3b443ecac68b96b4fa20159186a4a38883a0001a497c\ + \15c60e8282d818582183581cb0e693cbc97272bd42aacf3b443ecac68b96b4fa\ + \20159186a4a38883a0001a497c15c60e8282d818582183581cb0e693cbc97272\ + \bd42aacf3b443ecac68b96b4fa20159186a4a38883a0001a497c15c60e8282d8\ + \18582183581cb0e693cbc97272bd42aacf3b443ecac68b96b4fa20159186a4a3\ + \8883a0001a497c15c60e8282d818582183581cb0e693cbc97272bd42aacf3b44\ + \3ecac68b96b4fa20159186a4a38883a0001a497c15c60e8282d818582183581c\ + \b0e693cbc97272bd42aacf3b443ecac68b96b4fa20159186a4a38883a0001a49\ + \7c15c60e8282d818582183581cb0e693cbc97272bd42aacf3b443ecac68b96b4\ + \fa20159186a4a38883a0001a497c15c60e8282d818582183581cb0e693cbc972\ + \72bd42aacf3b443ecac68b96b4fa20159186a4a38883a0001a497c15c60e8282\ + \d818582183581cb0e693cbc97272bd42aacf3b443ecac68b96b4fa20159186a4\ + \a38883a0001a497c15c60e8282d818582183581cb0e693cbc97272bd42aacf3b\ + \443ecac68b96b4fa20159186a4a38883a0001a497c15c60e8282d81858218358\ + \1cb0e693cbc97272bd42aacf3b443ecac68b96b4fa20159186a4a38883a0001a\ + \497c15c60e8282d818582183581cb0e693cbc97272bd42aacf3b443ecac68b96\ + \b4fa20159186a4a38883a0001a497c15c60e8282d818582183581cb0e693cbc9\ + \7272bd42aacf3b443ecac68b96b4fa20159186a4a38883a0001a497c15c60e82\ + \82d818582183581cb0e693cbc97272bd42aacf3b443ecac68b96b4fa20159186\ + \a4a38883a0001a497c15c60e8282d818582183581cb0e693cbc97272bd42aacf\ + \3b443ecac68b96b4fa20159186a4a38883a0001a497c15c60e8282d818582183\ + \581cb0e693cbc97272bd42aacf3b443ecac68b96b4fa20159186a4a38883a000\ + \1a497c15c60e8282d818582183581cb0e693cbc97272bd42aacf3b443ecac68b\ + \96b4fa20159186a4a38883a0001a497c15c60e8282d818582183581cb0e693cb\ + \c97272bd42aacf3b443ecac68b96b4fa20159186a4a38883a0001a497c15c60e\ + \8282d818582183581cb0e693cbc97272bd42aacf3b443ecac68b96b4fa201591\ + \86a4a38883a0001a497c15c60e8282d818582183581cb0e693cbc97272bd42aa\ + \cf3b443ecac68b96b4fa20159186a4a38883a0001a497c15c60e8282d8185821\ + \83581cb0e693cbc97272bd42aacf3b443ecac68b96b4fa20159186a4a38883a0\ + \001a497c15c60e8282d818582183581cb0e693cbc97272bd42aacf3b443ecac6\ + \8b96b4fa20159186a4a38883a0001a497c15c60effa0818200d8185885825840\ + \8e620235b2a427259cc1a1c63af9ef179cb3b6e396da182e01d65dd3ed7be94b\ + \e25db39fb78e74d4b53fb51776d0f5eb360e62d09b853f3a87ac25bf834ee1fb\ + \58402b01895a50681f18418da48bf6cf9d70ad465018bb9276f6f0aa9b58ff2d\ + \2f273d584e4f27e228cd57a6f96009d5c27525fd92647db708185e488713d40d\ + \d402" + +goldenTestnet__1_1 :: ByteString +goldenTestnet__1_1 = unsafeB16 + "82839f8200d81858248258203b40265111d8bb3c3c608d95b3a0bf83461ace32d7\ + \9336579a1939b3aad1c0b700ff9f8282d818582883581c946480eb45fa900e84d1\ + \f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb17001a16bbe0ab18\ + \2affa0818200d81858858258408e620235b2a427259cc1a1c63af9ef179cb3b6e3\ + \96da182e01d65dd3ed7be94be25db39fb78e74d4b53fb51776d0f5eb360e62d09b\ + \853f3a87ac25bf834ee1fb584081b55eff4aa66b01c339ba2ec04dbad9d14bd049\ + \f6e8ae46211a2870c839966bfc721ca80c3b71d3719e468dcd16c877ff68a3cff8\ + \887ac9f3546da99e6bba00" + +goldenTestnet__2_2 :: ByteString +goldenTestnet__2_2 = unsafeB16 + "82839f8200d81858248258203b40265111d8bb3c3c608d95b3a0bf83461ace32d7\ + \9336579a1939b3aad1c0b7008200d81858248258203b40265111d8bb3c3c608d95\ + \b3a0bf83461ace32d79336579a1939b3aad1c0b701ff9f8282d818582883581c94\ + \6480eb45fa900e84d1f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a4170\ + \cb17001a16bbe0ab182a8282d818582883581c48a08edee8a9f586263d5f4e2288\ + \ac1a6e33656bfa2570fb8618c5c4a102451a4170cb17001ab30d9d270effa08282\ + \00d81858858258408e620235b2a427259cc1a1c63af9ef179cb3b6e396da182e01\ + \d65dd3ed7be94be25db39fb78e74d4b53fb51776d0f5eb360e62d09b853f3a87ac\ + \25bf834ee1fb5840fb812923b3b5a15a9d7005ef0b2ef714ed188c48f0ec16a7ef\ + \5e3661f92aebb203d3717fafbb10b4de6bf4fa6ad064b5ad65434a449983741182\ + \1af434d0280f8200d81858858258402cf36a269802da7cc0408308bda9a0015e7e\ + \81912117013c93edeefa9b62bbb61bbf1c6081545b1ab140578d7b5c035bf904d0\ + \5dd8e9b79b34d3160f86206bfc5840a57a996c2a1185f117db5e21aed47c54eccf\ + \263bf1e978114b1a2731086b4e8d189700c918b1ce04cd77316a15fb22f3a2cbed\ + \7de16fb4fc83d4cc4b11a3860b" + +goldenTestnet__25_1 :: ByteString +goldenTestnet__25_1 = unsafeB16 + "82839f8200d81858248258203b40265111d8bb3c3c608d95b3a0bf83461ace32d7\ + \9336579a1939b3aad1c0b700ff9f8282d818582883581c946480eb45fa900e84d1\ + \f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb17001a16bbe0ab0e\ + \8282d818582883581c946480eb45fa900e84d1f25141589468ca1d38bbb4e6c3ab\ + \ec7d1ea0a102451a4170cb17001a16bbe0ab0e8282d818582883581c946480eb45\ + \fa900e84d1f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb17001a\ + \16bbe0ab0e8282d818582883581c946480eb45fa900e84d1f25141589468ca1d38\ + \bbb4e6c3abec7d1ea0a102451a4170cb17001a16bbe0ab0e8282d818582883581c\ + \946480eb45fa900e84d1f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a41\ + \70cb17001a16bbe0ab0e8282d818582883581c946480eb45fa900e84d1f2514158\ + \9468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb17001a16bbe0ab0e8282d818\ + \582883581c946480eb45fa900e84d1f25141589468ca1d38bbb4e6c3abec7d1ea0\ + \a102451a4170cb17001a16bbe0ab0e8282d818582883581c946480eb45fa900e84\ + \d1f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb17001a16bbe0ab\ + \0e8282d818582883581c946480eb45fa900e84d1f25141589468ca1d38bbb4e6c3\ + \abec7d1ea0a102451a4170cb17001a16bbe0ab0e8282d818582883581c946480eb\ + \45fa900e84d1f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb1700\ + \1a16bbe0ab0e8282d818582883581c946480eb45fa900e84d1f25141589468ca1d\ + \38bbb4e6c3abec7d1ea0a102451a4170cb17001a16bbe0ab0e8282d81858288358\ + \1c946480eb45fa900e84d1f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a\ + \4170cb17001a16bbe0ab0e8282d818582883581c946480eb45fa900e84d1f25141\ + \589468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb17001a16bbe0ab0e8282d8\ + \18582883581c946480eb45fa900e84d1f25141589468ca1d38bbb4e6c3abec7d1e\ + \a0a102451a4170cb17001a16bbe0ab0e8282d818582883581c946480eb45fa900e\ + \84d1f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb17001a16bbe0\ + \ab0e8282d818582883581c946480eb45fa900e84d1f25141589468ca1d38bbb4e6\ + \c3abec7d1ea0a102451a4170cb17001a16bbe0ab0e8282d818582883581c946480\ + \eb45fa900e84d1f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb17\ + \001a16bbe0ab0e8282d818582883581c946480eb45fa900e84d1f25141589468ca\ + \1d38bbb4e6c3abec7d1ea0a102451a4170cb17001a16bbe0ab0e8282d818582883\ + \581c946480eb45fa900e84d1f25141589468ca1d38bbb4e6c3abec7d1ea0a10245\ + \1a4170cb17001a16bbe0ab0e8282d818582883581c946480eb45fa900e84d1f251\ + \41589468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb17001a16bbe0ab0e8282\ + \d818582883581c946480eb45fa900e84d1f25141589468ca1d38bbb4e6c3abec7d\ + \1ea0a102451a4170cb17001a16bbe0ab0e8282d818582883581c946480eb45fa90\ + \0e84d1f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb17001a16bb\ + \e0ab0e8282d818582883581c946480eb45fa900e84d1f25141589468ca1d38bbb4\ + \e6c3abec7d1ea0a102451a4170cb17001a16bbe0ab0e8282d818582883581c9464\ + \80eb45fa900e84d1f25141589468ca1d38bbb4e6c3abec7d1ea0a102451a4170cb\ + \17001a16bbe0ab0e8282d818582883581c946480eb45fa900e84d1f25141589468\ + \ca1d38bbb4e6c3abec7d1ea0a102451a4170cb17001a16bbe0ab0effa0818200d8\ + \1858858258408e620235b2a427259cc1a1c63af9ef179cb3b6e396da182e01d65d\ + \d3ed7be94be25db39fb78e74d4b53fb51776d0f5eb360e62d09b853f3a87ac25bf\ + \834ee1fb5840e0f9591bfd7b67738db6b689d514bba1fe8c730491f9bdad7fbe05\ + \58974e57c1ef62c331da2ad528ff829b5406638d384a0b4d0b40b378f4063acb73\ + \851d3906" diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}