Skip to content

Commit fee95da

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

File tree

4 files changed

+191
-79
lines changed

4 files changed

+191
-79
lines changed

‎cardano-api/cardano-api.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -235,7 +235,9 @@ 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
238239
Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
240+
Cardano.Api.Experimental.Tx.Internal.Type
239241
Cardano.Api.Genesis.Internal
240242
Cardano.Api.Genesis.Internal.Parameters
241243
Cardano.Api.Governance.Internal.Action.ProposalProcedure

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

0 commit comments

Comments
 (0)