Skip to content

Commit 00d933e

Browse files
Jimbo4350Jimbo4350
committed
Implement writeTxFileTextEnvelope and writeTxFileTextEnvelopeCanonical
for SignedTx
1 parent a2df13b commit 00d933e

File tree

4 files changed

+198
-79
lines changed

4 files changed

+198
-79
lines changed

‎cardano-api/cardano-api.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -235,6 +235,8 @@ library
235235
Cardano.Api.Experimental.Tx.Internal.Certificate.Type
236236
Cardano.Api.Experimental.Tx.Internal.Compatible
237237
Cardano.Api.Experimental.Tx.Internal.Fee
238+
Cardano.Api.Experimental.Tx.Internal.Serialise
239+
Cardano.Api.Experimental.Tx.Internal.Type
238240
Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
239241
Cardano.Api.Genesis.Internal
240242
Cardano.Api.Genesis.Internal.Parameters

‎cardano-api/src/Cardano/Api/Experimental/Tx.hs‎

Lines changed: 6 additions & 79 deletions
Original file line numberDiff line numberDiff line change
@@ -3,11 +3,8 @@
33
{-# LANGUAGE FlexibleContexts #-}
44
{-# LANGUAGE FlexibleInstances #-}
55
{-# LANGUAGE GADTs #-}
6-
{-# LANGUAGE InstanceSigs #-}
76
{-# LANGUAGE RankNTypes #-}
87
{-# LANGUAGE ScopedTypeVariables #-}
9-
{-# LANGUAGE StandaloneDeriving #-}
10-
{-# LANGUAGE TypeApplications #-}
118
{-# LANGUAGE TypeFamilies #-}
129
{-# LANGUAGE UndecidableInstances #-}
1310

@@ -140,6 +137,10 @@ module Cardano.Api.Experimental.Tx
140137
, getTxScriptWitnessesRequirements
141138
, obtainMonoidConstraint
142139

140+
-- ** Serialisation
141+
, writeTxFileTextEnvelope
142+
, writeTxFileTextEnvelopeCanonical
143+
143144
-- ** Internal functions
144145
, extractExecutionUnits
145146
, getTxScriptWitnessRequirements
@@ -153,67 +154,26 @@ import Cardano.Api.Era.Internal.Feature
153154
import Cardano.Api.Experimental.Era
154155
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
155156
import Cardano.Api.Experimental.Tx.Internal.Body
157+
import Cardano.Api.Experimental.Tx.Internal.Serialise
156158
import Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
157-
import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy, asType)
159+
import Cardano.Api.Experimental.Tx.Internal.Type
158160
import Cardano.Api.Ledger.Internal.Reexport (StrictMaybe (..), maybeToStrictMaybe)
159161
import Cardano.Api.Ledger.Internal.Reexport qualified as L
160162
import Cardano.Api.Pretty (docToString, pretty)
161-
import Cardano.Api.Serialise.Raw
162-
( SerialiseAsRawBytes (..)
163-
, SerialiseAsRawBytesError (SerialiseAsRawBytesError)
164-
)
165163
import Cardano.Api.Tx.Internal.Body
166164
import Cardano.Api.Tx.Internal.Sign
167165

168166
import Cardano.Crypto.Hash qualified as Hash
169167
import Cardano.Ledger.Alonzo.TxBody qualified as L
170168
import Cardano.Ledger.Api qualified as L
171-
import Cardano.Ledger.Binary qualified as Ledger
172169
import Cardano.Ledger.Core qualified as Ledger
173170
import Cardano.Ledger.Hashes qualified as L hiding (Hash)
174171

175-
import Control.Exception (displayException)
176-
import Data.Bifunctor (bimap)
177-
import Data.ByteString.Lazy (fromStrict)
178172
import Data.Set qualified as Set
179173
import GHC.Exts (IsList (..))
180174
import GHC.Stack
181175
import Lens.Micro
182176

183-
-- | A transaction that can contain everything
184-
-- except key witnesses.
185-
data UnsignedTx era
186-
= L.EraTx (LedgerEra era) => UnsignedTx (Ledger.Tx (LedgerEra era))
187-
188-
instance HasTypeProxy era => HasTypeProxy (UnsignedTx era) where
189-
data AsType (UnsignedTx era) = AsUnsignedTx (AsType era)
190-
proxyToAsType :: Proxy (UnsignedTx era) -> AsType (UnsignedTx era)
191-
proxyToAsType _ = AsUnsignedTx (asType @era)
192-
193-
instance
194-
( HasTypeProxy era
195-
, L.EraTx (LedgerEra era)
196-
)
197-
=> SerialiseAsRawBytes (UnsignedTx era)
198-
where
199-
serialiseToRawBytes (UnsignedTx tx) =
200-
Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx
201-
deserialiseFromRawBytes _ =
202-
bimap wrapError UnsignedTx
203-
. Ledger.decodeFullAnnotator
204-
(Ledger.eraProtVerHigh @(LedgerEra era))
205-
"UnsignedTx"
206-
Ledger.decCBOR
207-
. fromStrict
208-
where
209-
wrapError
210-
:: Ledger.DecoderError -> SerialiseAsRawBytesError
211-
wrapError = SerialiseAsRawBytesError . displayException
212-
213-
deriving instance Eq (UnsignedTx era)
214-
215-
deriving instance Show (UnsignedTx era)
216-
217177
newtype UnsignedTxError
218178
= UnsignedTxError TxBodyError
219179

@@ -341,39 +301,6 @@ makeKeyWitness era (UnsignedTx unsignedTx) wsk =
341301
signature = makeShelleySignature txhash sk
342302
in L.WitVKey vk signature
343303

344-
-- | A transaction that has been witnesssed
345-
data SignedTx era
346-
= L.EraTx (LedgerEra era) => SignedTx (Ledger.Tx (LedgerEra era))
347-
348-
deriving instance Eq (SignedTx era)
349-
350-
deriving instance Show (SignedTx era)
351-
352-
instance HasTypeProxy era => HasTypeProxy (SignedTx era) where
353-
data AsType (SignedTx era) = AsSignedTx (AsType era)
354-
proxyToAsType :: Proxy (SignedTx era) -> AsType (SignedTx era)
355-
proxyToAsType _ = AsSignedTx (asType @era)
356-
357-
instance
358-
( HasTypeProxy era
359-
, L.EraTx (LedgerEra era)
360-
)
361-
=> SerialiseAsRawBytes (SignedTx era)
362-
where
363-
serialiseToRawBytes (SignedTx tx) =
364-
Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx
365-
deserialiseFromRawBytes _ =
366-
bimap wrapError SignedTx
367-
. Ledger.decodeFullAnnotator
368-
(Ledger.eraProtVerHigh @(LedgerEra era))
369-
"SignedTx"
370-
Ledger.decCBOR
371-
. fromStrict
372-
where
373-
wrapError
374-
:: Ledger.DecoderError -> SerialiseAsRawBytesError
375-
wrapError = SerialiseAsRawBytesError . displayException
376-
377304
signTx
378305
:: Era era
379306
-> [L.BootstrapWitness]

‎cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Serialise.hs‎

Lines changed: 62 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE RankNTypes #-}
3+
{-# LANGUAGE ScopedTypeVariables #-}
4+
{-# LANGUAGE TypeApplications #-}
5+
6+
module Cardano.Api.Experimental.Tx.Internal.Serialise
7+
( writeTxFileTextEnvelope
8+
, writeTxFileTextEnvelopeCanonical
9+
)
10+
where
11+
12+
import Cardano.Api.Error
13+
import Cardano.Api.Experimental.Era
14+
import Cardano.Api.Experimental.Tx.Internal.Type
15+
import Cardano.Api.IO
16+
import Cardano.Api.Serialise.Cbor.Canonical
17+
import Cardano.Api.Serialise.TextEnvelope.Internal
18+
19+
writeTxFileTextEnvelope
20+
:: IsEra era
21+
=> File content Out
22+
-> SignedTx era
23+
-> IO (Either (FileError ()) ())
24+
writeTxFileTextEnvelope path =
25+
writeLazyByteStringFile path
26+
. serialiseTextEnvelope
27+
. serialiseTxToTextEnvelope
28+
29+
serialiseTxToTextEnvelope :: forall era. IsEra era => SignedTx era -> TextEnvelope
30+
serialiseTxToTextEnvelope tx' =
31+
obtainCommonConstraints (useEra @era) $
32+
serialiseToTextEnvelope (Just "Ledger Cddl Format") tx'
33+
34+
-- | Write transaction in the text envelope format. The CBOR will be in canonical format according
35+
-- to RFC 7049. It is also a requirement of CIP-21, which is not fully implemented.
36+
--
37+
-- 1. RFC 7049: https://datatracker.ietf.org/doc/html/rfc7049#section-3.9
38+
-- 2. CIP-21: https://github.com/cardano-foundation/CIPs/blob/master/CIP-0021/README.md#canonical-cbor-serialization-format
39+
writeTxFileTextEnvelopeCanonical
40+
:: IsEra era
41+
=> File content Out
42+
-> SignedTx era
43+
-> IO (Either (FileError ()) ())
44+
writeTxFileTextEnvelopeCanonical path =
45+
writeLazyByteStringFile path
46+
. serialiseTextEnvelope
47+
. canonicaliseTextEnvelopeCbor
48+
. serialiseTxToTextEnvelope
49+
where
50+
canonicaliseTextEnvelopeCbor :: TextEnvelope -> TextEnvelope
51+
canonicaliseTextEnvelopeCbor te = do
52+
let canonicalisedTxBs =
53+
either
54+
( \err ->
55+
error $
56+
"writeTxFileTextEnvelopeCanonical: Impossible - deserialisation of just serialised bytes failed "
57+
<> show err
58+
)
59+
id
60+
. canonicaliseCborBs
61+
$ teRawCBOR te
62+
te{teRawCBOR = canonicalisedTxBs}

‎cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Type.hs‎

Lines changed: 128 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,128 @@
1+
2+
{-# LANGUAGE ConstraintKinds #-}
3+
{-# LANGUAGE DataKinds #-}
4+
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE FlexibleInstances #-}
6+
{-# LANGUAGE GADTs #-}
7+
{-# LANGUAGE InstanceSigs #-}
8+
{-# LANGUAGE RankNTypes #-}
9+
{-# LANGUAGE ScopedTypeVariables #-}
10+
{-# LANGUAGE StandaloneDeriving #-}
11+
{-# LANGUAGE TypeApplications #-}
12+
{-# LANGUAGE TypeFamilies #-}
13+
{-# LANGUAGE UndecidableInstances #-}
14+
15+
module Cardano.Api.Experimental.Tx.Internal.Type
16+
( SignedTx(..)
17+
, UnsignedTx (..)
18+
)
19+
where
20+
21+
22+
import Cardano.Api.Experimental.Era
23+
24+
import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy, asType)
25+
import Cardano.Api.Ledger.Internal.Reexport qualified as L
26+
import Cardano.Api.Serialise.Raw
27+
( SerialiseAsRawBytes (..)
28+
, SerialiseAsRawBytesError (SerialiseAsRawBytesError)
29+
)
30+
import Cardano.Api.Serialise.TextEnvelope.Internal
31+
32+
import Cardano.Ledger.Binary qualified as Ledger
33+
import Cardano.Ledger.Core qualified as Ledger
34+
35+
36+
import Cardano.Api.Serialise.Cbor
37+
38+
import Control.Exception (displayException)
39+
import Data.Bifunctor (bimap)
40+
import Data.ByteString.Lazy (fromStrict)
41+
42+
-- | A transaction that has been witnesssed
43+
data SignedTx era
44+
= L.EraTx (LedgerEra era) => SignedTx (Ledger.Tx (LedgerEra era))
45+
46+
deriving instance Eq (SignedTx era)
47+
48+
deriving instance Show (SignedTx era)
49+
50+
instance
51+
( HasTypeProxy era
52+
, L.EraTx (LedgerEra era)
53+
)
54+
=> SerialiseAsCBOR (SignedTx era)
55+
where
56+
serialiseToCBOR (SignedTx tx) =
57+
Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx
58+
deserialiseFromCBOR _ =
59+
fmap SignedTx
60+
. Ledger.decodeFullAnnotator
61+
(Ledger.eraProtVerHigh @(LedgerEra era))
62+
"UnsignedTx"
63+
Ledger.decCBOR
64+
. fromStrict
65+
66+
instance (L.EraTx (LedgerEra era), HasTypeProxy era) => HasTextEnvelope (SignedTx era) where
67+
textEnvelopeType _ = "Tx"
68+
69+
instance HasTypeProxy era => HasTypeProxy (SignedTx era) where
70+
data AsType (SignedTx era) = AsSignedTx (AsType era)
71+
proxyToAsType :: Proxy (SignedTx era) -> AsType (SignedTx era)
72+
proxyToAsType _ = AsSignedTx (asType @era)
73+
74+
instance
75+
( HasTypeProxy era
76+
, L.EraTx (LedgerEra era)
77+
)
78+
=> SerialiseAsRawBytes (SignedTx era)
79+
where
80+
serialiseToRawBytes (SignedTx tx) =
81+
Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx
82+
deserialiseFromRawBytes _ =
83+
bimap wrapError SignedTx
84+
. Ledger.decodeFullAnnotator
85+
(Ledger.eraProtVerHigh @(LedgerEra era))
86+
"SignedTx"
87+
Ledger.decCBOR
88+
. fromStrict
89+
where
90+
wrapError
91+
:: Ledger.DecoderError -> SerialiseAsRawBytesError
92+
wrapError = SerialiseAsRawBytesError . displayException
93+
94+
95+
96+
-- | A transaction that can contain everything
97+
-- except key witnesses.
98+
data UnsignedTx era
99+
= L.EraTx (LedgerEra era) => UnsignedTx (Ledger.Tx (LedgerEra era))
100+
101+
instance HasTypeProxy era => HasTypeProxy (UnsignedTx era) where
102+
data AsType (UnsignedTx era) = AsUnsignedTx (AsType era)
103+
proxyToAsType :: Proxy (UnsignedTx era) -> AsType (UnsignedTx era)
104+
proxyToAsType _ = AsUnsignedTx (asType @era)
105+
106+
instance
107+
( HasTypeProxy era
108+
, L.EraTx (LedgerEra era)
109+
)
110+
=> SerialiseAsRawBytes (UnsignedTx era)
111+
where
112+
serialiseToRawBytes (UnsignedTx tx) =
113+
Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx
114+
deserialiseFromRawBytes _ =
115+
bimap wrapError UnsignedTx
116+
. Ledger.decodeFullAnnotator
117+
(Ledger.eraProtVerHigh @(LedgerEra era))
118+
"UnsignedTx"
119+
Ledger.decCBOR
120+
. fromStrict
121+
where
122+
wrapError
123+
:: Ledger.DecoderError -> SerialiseAsRawBytesError
124+
wrapError = SerialiseAsRawBytesError . displayException
125+
126+
deriving instance Eq (UnsignedTx era)
127+
128+
deriving instance Show (UnsignedTx era)

0 commit comments

Comments
 (0)