{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- API type representations of various types. We define here pretty much all our
-- user-facing types that are mostly composed with internal / primitive types.
--
-- This module also define required API instances (JSON, HttpApiData...) for all
-- those types, making sure to match the specification document:
--
-- <https://github.com/input-output-hk/cardano-wallet/blob/master/specifications/api/swagger.yaml Wallet API Specification>

module Cardano.Wallet.Api.Types
    (
    -- * Wallet Styles
      WalletStyle (..)
    , ByronWalletStyle (..)
    , StyleSymbol
    , AllowedMnemonics
    , fmtAllowedWords

    -- * API Types
    , ApiAsset (..)
    , toApiAsset
    , ApiAssetMetadata (..)
    , toApiAssetMetadata
    , ApiAddress (..)
    , ApiCredential (..)
    , ApiAddressData (..)
    , ApiAddressDataPayload (..)
    , AnyAddress (..)
    , AnyAddressType (..)
    , ApiCertificate (..)
    , ApiDelegationAction (..)
    , ApiEpochInfo (..)
    , toApiEpochInfo
    , ApiSelectCoinsData (..)
    , ApiSelectCoinsPayments (..)
    , ApiSelectCoinsAction (..)
    , ApiMintBurnOperation (..)
    , ApiMintData(..)
    , ApiBurnData(..)
    , ApiCoinSelection (..)
    , ApiCoinSelectionChange (..)
    , ApiCoinSelectionCollateral (..)
    , ApiCoinSelectionOutput (..)
    , ApiCoinSelectionWithdrawal (..)
    , ApiBase64
    , ApiMintBurnData (..)
    , ApiStakePool (..)
    , ApiStakePoolMetrics (..)
    , ApiStakePoolFlag (..)
    , ApiWallet (..)
    , ApiWalletBalance (..)
    , ApiWalletAssetsBalance (..)
    , ApiWalletMode (..)
    , ApiWalletPassphrase (..)
    , ApiWalletPassphraseInfo (..)
    , ApiWalletUtxoSnapshot (..)
    , ApiWalletUtxoSnapshotEntry (..)
    , ApiUtxoStatistics (..)
    , toApiUtxoStatistics
    , WalletPostData (..)
    , WalletPutData (..)
    , SettingsPutData (..)
    , WalletPutPassphraseData (..)
    , WalletPutPassphraseOldPassphraseData (..)
    , WalletPutPassphraseMnemonicData (..)
    , ApiSignTransactionPostData (..)
    , PostTransactionOldData (..)
    , PostTransactionFeeOldData (..)
    , ApiSerialisedTransaction (..)
    , ApiTransaction (..)
    , ApiWithdrawalPostData (..)
    , ApiMaintenanceAction (..)
    , ApiMaintenanceActionPostData (..)
    , MaintenanceAction (..)
    , ApiFee (..)
    , ApiTxCollateral (..)
    , ApiTxId (..)
    , ApiTxInput (..)
    , ApiTxMetadata (..)
    , AddressAmount (..)
    , AddressAmountNoAssets (..)
    , ApiAddressInspect (..)
    , ApiAddressInspectData (..)
    , ApiErrorCode (..)
    , ApiNetworkInformation (..)
    , ApiEra (..)
    , toApiEra
    , fromApiEra
    , ApiNtpStatus (..)
    , NtpSyncingStatus (..)
    , ApiNetworkClock (..)
    , ApiSlotReference (..)
    , ApiSlotId (..)
    , ApiBlockReference (..)
    , ApiBlockInfo (..)
    , ApiStakeKeys (..)
    , ApiOurStakeKey (..)
    , ApiForeignStakeKey (..)
    , ApiNullStakeKey (..)
    , Iso8601Time (..)
    , MinWithdrawal (..)
    , ApiNetworkParameters (..)
    , ApiNetworkInfo (..)
    , toApiNetworkParameters
    , ApiEraInfo (..)
    , ApiWalletDelegation (..)
    , ApiWalletDelegationStatus (..)
    , ApiWalletDelegationNext (..)
    , ApiPoolId (..)
    , ApiWalletMigrationPlanPostData (..)
    , ApiWalletMigrationPostData (..)
    , ApiWalletMigrationBalance (..)
    , ApiWalletMigrationPlan (..)
    , ApiWithdrawal (..)
    , ApiWalletSignData (..)
    , ApiVerificationKeyShelley (..)
    , ApiPolicyKey (..)
    , ApiPolicyId (..)
    , ApiPostPolicyIdData (..)
    , ApiPostPolicyKeyData (..)
    , ApiVerificationKeyShared (..)
    , ApiScriptTemplateEntry (..)
    , XPubOrSelf (..)
    , VerificationKeyHashing (..)
    , ApiAccountKey (..)
    , ApiAccountKeyShared (..)
    , KeyFormat (..)
    , ApiPostAccountKeyData (..)
    , ApiPostAccountKeyDataWithPurpose (..)
    , ApiConstructTransaction (..)
    , ApiConstructTransactionData (..)
    , ApiMultiDelegationAction (..)
    , ApiStakeKeyIndex (..)
    , ApiPaymentDestination (..)
    , ApiValidityInterval (..)
    , ApiValidityBound (..)
    , ApiBalanceTransactionPostData (..)
    , ApiExternalInput (..)
    , ApiRedeemer (..)
    , ApiDecodedTransaction (..)
    , ApiWalletInput (..)
    , ApiTxInputGeneral (..)
    , ResourceContext (..)
    , ApiWithdrawalGeneral (..)
    , ApiWalletOutput (..)
    , ApiTxOutputGeneral (..)
    , ApiAnyCertificate (..)
    , ApiExternalCertificate (..)
    , ApiRegisterPool (..)
    , ApiDeregisterPool (..)
    , ApiAssetMintBurn (..)
    , ApiTokenAmountFingerprint (..)
    , ApiTokens (..)

    -- * API Types (Byron)
    , ApiByronWallet (..)
    , ApiByronWalletBalance (..)
    , ByronWalletPostData (..)
    , SomeByronWalletPostData (..)
    , ByronWalletFromXPrvPostData (..)
    , ByronWalletPutPassphraseData (..)
    , ApiPostRandomAddressData (..)
    , ApiWalletDiscovery (..)
    , KnownDiscovery(..)
    , ApiPutAddressesData (..)

    -- * API Types (Hardware)
    , AccountPostData (..)
    , ApiAccountPublicKey (..)
    , WalletOrAccountPostData (..)

    -- * User-Facing Address Encoding/Decoding
    , EncodeAddress (..)
    , DecodeAddress (..)
    , EncodeStakeAddress (..)
    , DecodeStakeAddress (..)

    -- * Shared Wallets
    , ApiSharedWallet (..)
    , ApiPendingSharedWallet (..)
    , ApiActiveSharedWallet (..)
    , ApiSharedWalletPostData (..)
    , ApiSharedWalletPostDataFromMnemonics (..)
    , ApiSharedWalletPostDataFromAccountPubX (..)
    , ApiSharedWalletPatchData (..)

    -- * Polymorphic Types
    , ApiT (..)
    , ApiMnemonicT (..)
    , ApiBytesT (..)

    -- * Type families
    , ApiAddressT
    , ApiStakeKeysT
    , ApiPutAddressesDataT
    , ApiAddressIdT
    , ApiCoinSelectionT
    , ApiSelectCoinsDataT
    , ApiTransactionT
    , ApiConstructTransactionT
    , ApiConstructTransactionDataT
    , PostTransactionOldDataT
    , PostTransactionFeeOldDataT
    , ApiWalletMigrationPlanPostDataT
    , ApiWalletMigrationPostDataT
    , ApiBalanceTransactionPostDataT
    , ApiDecodedTransactionT

    -- * API Type Conversions
    , coinToQuantity
    , coinFromQuantity

    -- * Others
    , defaultRecordTypeOptions
    , strictRecordTypeOptions
    , HealthStatusSMASH (..)
    , HealthCheckSMASH (..)
    , ApiHealthCheck (..)
    , ApiAsArray (..)

    -- * Re-exports
    , Base (Base16, Base64)
    ) where

import Prelude

import Cardano.Address.Derivation
    ( XPrv, XPub, xpubFromBytes, xpubToBytes )
import Cardano.Address.Script
    ( Cosigner (..)
    , KeyHash (..)
    , Script
    , ScriptTemplate
    , ValidationLevel (..)
    )
import Cardano.Api
    ( AnyCardanoEra (..)
    , CardanoEra (..)
    , StakeAddress
    , TxMetadataJsonSchema (..)
    , deserialiseFromBech32
    , displayError
    , metadataFromJson
    , metadataToJson
    , proxyToAsType
    , serialiseToBech32
    )
import Cardano.Mnemonic
    ( MkSomeMnemonic (..)
    , MkSomeMnemonicError (..)
    , SomeMnemonic (..)
    , mnemonicToText
    , natVals
    )
import Cardano.Wallet.Api.Aeson.Variant
    ( variant, variants )
import Cardano.Wallet.Api.Types.SchemaMetadata
    ( TxMetadataWithSchema )
import Cardano.Wallet.Primitive.AddressDerivation
    ( Depth (..)
    , DerivationIndex (..)
    , DerivationType (..)
    , Index (..)
    , NetworkDiscriminant (..)
    , Role (..)
    , fromHex
    , hex
    )
import Cardano.Wallet.Primitive.AddressDerivation.SharedKey
    ( purposeCIP1854 )
import Cardano.Wallet.Primitive.AddressDiscovery.Random
    ( RndState )
import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
    ( AddressPoolGap, SeqState, getAddressPoolGap, purposeCIP1852 )
import Cardano.Wallet.Primitive.Passphrase.Types
    ( Passphrase (..)
    , PassphraseHash (..)
    , PassphraseMaxLength (..)
    , PassphraseMinLength (..)
    )
import Cardano.Wallet.Primitive.Slotting
    ( Qry, timeOfEpoch )
import Cardano.Wallet.Primitive.SyncProgress
    ( SyncProgress (..) )
import Cardano.Wallet.Primitive.Types
    ( ActiveSlotCoefficient (..)
    , EpochLength (..)
    , EpochNo (..)
    , ExecutionUnitPrices (..)
    , GenesisParameters (..)
    , NetworkParameters (..)
    , NonWalletCertificate (..)
    , PoolId (..)
    , PoolMetadataGCStatus (..)
    , SlotInEpoch (..)
    , SlotLength (..)
    , SlotNo (..)
    , SlottingParameters (..)
    , SmashServer (..)
    , StakePoolMetadata
    , StartTime (..)
    , WalletId (..)
    , WalletName (..)
    , decodePoolIdBech32
    , encodePoolIdBech32
    , getDecentralizationLevel
    , unsafeEpochNo
    )
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..), AddressState (..) )
import Cardano.Wallet.Primitive.Types.Address.Constants
    ( minLengthAddress )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.Hash
    ( Hash (..) )
import Cardano.Wallet.Primitive.Types.Tx
    ( Direction (..)
    , SealedTx (..)
    , SerialisedTx (..)
    , TxConstraints (..)
    , TxIn (..)
    , TxMetadata
    , TxScriptValidity (..)
    , TxStatus (..)
    , coinIsValidForTxOut
    , sealedTxFromBytes
    , txMetadataIsNull
    , txOutMaxCoin
    )
import Cardano.Wallet.Primitive.Types.UTxO
    ( BoundType, HistogramBar (..), UTxOStatistics (..) )
import Cardano.Wallet.TokenMetadata
    ( TokenMetadataError (..) )
import Cardano.Wallet.Transaction
    ( AnyScript (..), ValidityIntervalExplicit )
import Cardano.Wallet.Util
    ( ShowFmt (..) )
import Codec.Binary.Bech32
    ( dataPartFromBytes, dataPartToBytes )
import Codec.Binary.Bech32.TH
    ( humanReadablePart )
import "cardano-addresses" Codec.Binary.Encoding
    ( AbstractEncoding (..), detectEncoding, encode, fromBase16 )
import Control.Applicative
    ( optional, (<|>) )
import Control.Arrow
    ( left )
import Control.DeepSeq
    ( NFData (..) )
import Control.Monad
    ( guard, when, (<=<), (>=>) )
import Data.Aeson.Types
    ( FromJSON (..)
    , Parser
    , SumEncoding (..)
    , ToJSON (..)
    , Value (Object, String)
    , camelTo2
    , constructorTagModifier
    , fieldLabelModifier
    , genericParseJSON
    , genericToJSON
    , object
    , omitNothingFields
    , prependFailure
    , rejectUnknownFields
    , sumEncoding
    , tagSingleConstructors
    , withObject
    , withText
    , (.!=)
    , (.:)
    , (.:?)
    , (.=)
    )
import Data.Bifunctor
    ( bimap, first )
import Data.ByteArray
    ( ByteArray, ByteArrayAccess )
import Data.ByteArray.Encoding
    ( Base (..), convertFromBase, convertToBase )
import Data.ByteString
    ( ByteString )
import Data.Char
    ( toLower )
import Data.Data
    ( Data )
import Data.Either.Combinators
    ( maybeToRight )
import Data.Either.Extra
    ( eitherToMaybe, maybeToEither )
import Data.Function
    ( (&) )
import Data.Generics.Internal.VL.Lens
    ( view, (^.) )
import Data.Hashable
    ( Hashable )
import Data.Kind
    ( Type )
import Data.List
    ( intercalate )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Map.Strict
    ( Map )
import Data.Maybe
    ( maybeToList )
import Data.Proxy
    ( Proxy (..) )
import Data.Quantity
    ( Percentage, Quantity (..) )
import Data.String
    ( IsString )
import Data.Text
    ( Text, split )
import Data.Text.Class
    ( CaseStyle (..)
    , FromText (..)
    , TextDecodingError (..)
    , ToText (..)
    , fromTextToBoundedEnum
    , toTextFromBoundedEnum
    )
import Data.Time.Clock
    ( NominalDiffTime, UTCTime )
import Data.Time.Clock.POSIX
    ( posixSecondsToUTCTime, utcTimeToPOSIXSeconds )
import Data.Time.Text
    ( iso8601, iso8601ExtendedUtc, utcTimeFromText, utcTimeToText )
import Data.Traversable
    ( for )
import Data.Typeable
    ( Typeable, typeRep )
import Data.Word
    ( Word16, Word32, Word64 )
import Data.Word.Odd
    ( Word31 )
import Fmt
    ( pretty )
import GHC.Generics
    ( Generic, Rep )
import GHC.TypeLits
    ( KnownSymbol, Nat, Symbol, symbolVal )
import Numeric.Natural
    ( Natural )
import Quiet
    ( Quiet (..) )
import Servant.API
    ( MimeRender (..), MimeUnrender (..), OctetStream )
import Web.HttpApiData
    ( FromHttpApiData (..), ToHttpApiData (..) )

import qualified Cardano.Crypto.Wallet as CC
import qualified Cardano.Wallet.Primitive.AddressDerivation as AD
import qualified Cardano.Wallet.Primitive.Types as W
import qualified Cardano.Wallet.Primitive.Types.RewardAccount as W
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as W
import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
import qualified Cardano.Wallet.Primitive.Types.TokenMap as W
import qualified Cardano.Wallet.Primitive.Types.TokenPolicy as W
import qualified Codec.Binary.Bech32 as Bech32
import qualified Codec.Binary.Bech32.TH as Bech32
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Aeson
import qualified Data.Aeson.KeyMap as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as BL
import qualified Data.List as L
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Read as T

{-------------------------------------------------------------------------------
                               Styles of Wallets
-------------------------------------------------------------------------------}

data WalletStyle
    = Shelley
    | Byron
    | Shared

data ByronWalletStyle
    = Random
    | Icarus
    | Trezor
    | Ledger
    deriving (Int -> ByronWalletStyle -> ShowS
[ByronWalletStyle] -> ShowS
ByronWalletStyle -> String
(Int -> ByronWalletStyle -> ShowS)
-> (ByronWalletStyle -> String)
-> ([ByronWalletStyle] -> ShowS)
-> Show ByronWalletStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByronWalletStyle] -> ShowS
$cshowList :: [ByronWalletStyle] -> ShowS
show :: ByronWalletStyle -> String
$cshow :: ByronWalletStyle -> String
showsPrec :: Int -> ByronWalletStyle -> ShowS
$cshowsPrec :: Int -> ByronWalletStyle -> ShowS
Show, (forall x. ByronWalletStyle -> Rep ByronWalletStyle x)
-> (forall x. Rep ByronWalletStyle x -> ByronWalletStyle)
-> Generic ByronWalletStyle
forall x. Rep ByronWalletStyle x -> ByronWalletStyle
forall x. ByronWalletStyle -> Rep ByronWalletStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ByronWalletStyle x -> ByronWalletStyle
$cfrom :: forall x. ByronWalletStyle -> Rep ByronWalletStyle x
Generic, ByronWalletStyle -> ByronWalletStyle -> Bool
(ByronWalletStyle -> ByronWalletStyle -> Bool)
-> (ByronWalletStyle -> ByronWalletStyle -> Bool)
-> Eq ByronWalletStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByronWalletStyle -> ByronWalletStyle -> Bool
$c/= :: ByronWalletStyle -> ByronWalletStyle -> Bool
== :: ByronWalletStyle -> ByronWalletStyle -> Bool
$c== :: ByronWalletStyle -> ByronWalletStyle -> Bool
Eq, ByronWalletStyle
ByronWalletStyle -> ByronWalletStyle -> Bounded ByronWalletStyle
forall a. a -> a -> Bounded a
maxBound :: ByronWalletStyle
$cmaxBound :: ByronWalletStyle
minBound :: ByronWalletStyle
$cminBound :: ByronWalletStyle
Bounded, Int -> ByronWalletStyle
ByronWalletStyle -> Int
ByronWalletStyle -> [ByronWalletStyle]
ByronWalletStyle -> ByronWalletStyle
ByronWalletStyle -> ByronWalletStyle -> [ByronWalletStyle]
ByronWalletStyle
-> ByronWalletStyle -> ByronWalletStyle -> [ByronWalletStyle]
(ByronWalletStyle -> ByronWalletStyle)
-> (ByronWalletStyle -> ByronWalletStyle)
-> (Int -> ByronWalletStyle)
-> (ByronWalletStyle -> Int)
-> (ByronWalletStyle -> [ByronWalletStyle])
-> (ByronWalletStyle -> ByronWalletStyle -> [ByronWalletStyle])
-> (ByronWalletStyle -> ByronWalletStyle -> [ByronWalletStyle])
-> (ByronWalletStyle
    -> ByronWalletStyle -> ByronWalletStyle -> [ByronWalletStyle])
-> Enum ByronWalletStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ByronWalletStyle
-> ByronWalletStyle -> ByronWalletStyle -> [ByronWalletStyle]
$cenumFromThenTo :: ByronWalletStyle
-> ByronWalletStyle -> ByronWalletStyle -> [ByronWalletStyle]
enumFromTo :: ByronWalletStyle -> ByronWalletStyle -> [ByronWalletStyle]
$cenumFromTo :: ByronWalletStyle -> ByronWalletStyle -> [ByronWalletStyle]
enumFromThen :: ByronWalletStyle -> ByronWalletStyle -> [ByronWalletStyle]
$cenumFromThen :: ByronWalletStyle -> ByronWalletStyle -> [ByronWalletStyle]
enumFrom :: ByronWalletStyle -> [ByronWalletStyle]
$cenumFrom :: ByronWalletStyle -> [ByronWalletStyle]
fromEnum :: ByronWalletStyle -> Int
$cfromEnum :: ByronWalletStyle -> Int
toEnum :: Int -> ByronWalletStyle
$ctoEnum :: Int -> ByronWalletStyle
pred :: ByronWalletStyle -> ByronWalletStyle
$cpred :: ByronWalletStyle -> ByronWalletStyle
succ :: ByronWalletStyle -> ByronWalletStyle
$csucc :: ByronWalletStyle -> ByronWalletStyle
Enum)

instance FromText ByronWalletStyle where
    fromText :: Text -> Either TextDecodingError ByronWalletStyle
fromText = CaseStyle -> Text -> Either TextDecodingError ByronWalletStyle
forall a.
(Bounded a, Enum a, Show a) =>
CaseStyle -> Text -> Either TextDecodingError a
fromTextToBoundedEnum CaseStyle
SnakeLowerCase

instance ToText ByronWalletStyle where
    toText :: ByronWalletStyle -> Text
toText = CaseStyle -> ByronWalletStyle -> Text
forall a. (Bounded a, Enum a, Show a) => CaseStyle -> a -> Text
toTextFromBoundedEnum CaseStyle
SnakeLowerCase

data SndFactor
    = SndFactor

type family StyleSymbol (style :: ByronWalletStyle) :: Symbol where
    StyleSymbol 'Random  = "random"
    StyleSymbol 'Icarus  = "icarus"
    StyleSymbol 'Trezor  = "trezor"
    StyleSymbol 'Ledger  = "ledger"

type family AllowedMnemonics (style :: k) :: [Nat]

type instance AllowedMnemonics 'Random    = '[12,15,18,21,24]
type instance AllowedMnemonics 'Icarus    = '[12,15,18,21,24]
type instance AllowedMnemonics 'Trezor    = '[12,15,18,21,24]
type instance AllowedMnemonics 'Ledger    = '[12,15,18,21,24]
type instance AllowedMnemonics 'Shelley   = '[15,18,21,24]
type instance AllowedMnemonics 'SndFactor = '[9,12]

fmtAllowedWords :: ByronWalletStyle -> String
fmtAllowedWords :: ByronWalletStyle -> String
fmtAllowedWords =
    (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" mnemonic words") ShowS -> (ByronWalletStyle -> String) -> ByronWalletStyle -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
formatEnglishEnumeration ([String] -> String)
-> (ByronWalletStyle -> [String]) -> ByronWalletStyle -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByronWalletStyle -> [String]
allowedWordLengths
  where
    allowedWordLengths :: ByronWalletStyle -> [String]
allowedWordLengths = \case
        ByronWalletStyle
Random -> (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show ([Integer] -> [String]) -> [Integer] -> [String]
forall a b. (a -> b) -> a -> b
$ Proxy '[12, 15, 18, 21, 24] -> [Integer]
forall (ns :: [Nat]). NatVals ns => Proxy ns -> [Integer]
natVals (Proxy '[12, 15, 18, 21, 24] -> [Integer])
-> Proxy '[12, 15, 18, 21, 24] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Proxy (AllowedMnemonics 'Random)
forall k (t :: k). Proxy t
Proxy @(AllowedMnemonics 'Random)
        ByronWalletStyle
Icarus -> (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show ([Integer] -> [String]) -> [Integer] -> [String]
forall a b. (a -> b) -> a -> b
$ Proxy '[12, 15, 18, 21, 24] -> [Integer]
forall (ns :: [Nat]). NatVals ns => Proxy ns -> [Integer]
natVals (Proxy '[12, 15, 18, 21, 24] -> [Integer])
-> Proxy '[12, 15, 18, 21, 24] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Proxy (AllowedMnemonics 'Icarus)
forall k (t :: k). Proxy t
Proxy @(AllowedMnemonics 'Icarus)
        ByronWalletStyle
Trezor -> (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show ([Integer] -> [String]) -> [Integer] -> [String]
forall a b. (a -> b) -> a -> b
$ Proxy '[12, 15, 18, 21, 24] -> [Integer]
forall (ns :: [Nat]). NatVals ns => Proxy ns -> [Integer]
natVals (Proxy '[12, 15, 18, 21, 24] -> [Integer])
-> Proxy '[12, 15, 18, 21, 24] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Proxy (AllowedMnemonics 'Trezor)
forall k (t :: k). Proxy t
Proxy @(AllowedMnemonics 'Trezor)
        ByronWalletStyle
Ledger -> (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show ([Integer] -> [String]) -> [Integer] -> [String]
forall a b. (a -> b) -> a -> b
$ Proxy '[12, 15, 18, 21, 24] -> [Integer]
forall (ns :: [Nat]). NatVals ns => Proxy ns -> [Integer]
natVals (Proxy '[12, 15, 18, 21, 24] -> [Integer])
-> Proxy '[12, 15, 18, 21, 24] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Proxy (AllowedMnemonics 'Ledger)
forall k (t :: k). Proxy t
Proxy @(AllowedMnemonics 'Ledger)

      -- >>> formatEnglishEnumeration ["a", "b", "c"]
      -- "a, b or c"
      --
      -- >>> formatEnglishEnumeration ["a", "b"]
      -- "a or b"
      --
      -- >>> formatEnglishEnumeration ["a"]
      -- "a"
    formatEnglishEnumeration :: [String] -> String
formatEnglishEnumeration = [String] -> String
formatEnglishEnumerationRev ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse
    formatEnglishEnumerationRev :: [String] -> String
formatEnglishEnumerationRev [String
ult, String
penult]
       = String
penult String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" or " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ult
    formatEnglishEnumerationRev (String
ult:String
penult:[String]
revBeginning)
       = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
revBeginning)
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", "
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
penult
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" or "
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ult
    formatEnglishEnumerationRev [String]
xs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
xs)

{-------------------------------------------------------------------------------
                                  API Types
-------------------------------------------------------------------------------}

data MaintenanceAction = GcStakePools
    deriving (MaintenanceAction -> MaintenanceAction -> Bool
(MaintenanceAction -> MaintenanceAction -> Bool)
-> (MaintenanceAction -> MaintenanceAction -> Bool)
-> Eq MaintenanceAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaintenanceAction -> MaintenanceAction -> Bool
$c/= :: MaintenanceAction -> MaintenanceAction -> Bool
== :: MaintenanceAction -> MaintenanceAction -> Bool
$c== :: MaintenanceAction -> MaintenanceAction -> Bool
Eq, (forall x. MaintenanceAction -> Rep MaintenanceAction x)
-> (forall x. Rep MaintenanceAction x -> MaintenanceAction)
-> Generic MaintenanceAction
forall x. Rep MaintenanceAction x -> MaintenanceAction
forall x. MaintenanceAction -> Rep MaintenanceAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MaintenanceAction x -> MaintenanceAction
$cfrom :: forall x. MaintenanceAction -> Rep MaintenanceAction x
Generic, Int -> MaintenanceAction -> ShowS
[MaintenanceAction] -> ShowS
MaintenanceAction -> String
(Int -> MaintenanceAction -> ShowS)
-> (MaintenanceAction -> String)
-> ([MaintenanceAction] -> ShowS)
-> Show MaintenanceAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaintenanceAction] -> ShowS
$cshowList :: [MaintenanceAction] -> ShowS
show :: MaintenanceAction -> String
$cshow :: MaintenanceAction -> String
showsPrec :: Int -> MaintenanceAction -> ShowS
$cshowsPrec :: Int -> MaintenanceAction -> ShowS
Show)

newtype ApiMaintenanceActionPostData = ApiMaintenanceActionPostData
    { ApiMaintenanceActionPostData -> MaintenanceAction
maintenanceAction :: MaintenanceAction
    }
    deriving (ApiMaintenanceActionPostData
-> ApiMaintenanceActionPostData -> Bool
(ApiMaintenanceActionPostData
 -> ApiMaintenanceActionPostData -> Bool)
-> (ApiMaintenanceActionPostData
    -> ApiMaintenanceActionPostData -> Bool)
-> Eq ApiMaintenanceActionPostData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiMaintenanceActionPostData
-> ApiMaintenanceActionPostData -> Bool
$c/= :: ApiMaintenanceActionPostData
-> ApiMaintenanceActionPostData -> Bool
== :: ApiMaintenanceActionPostData
-> ApiMaintenanceActionPostData -> Bool
$c== :: ApiMaintenanceActionPostData
-> ApiMaintenanceActionPostData -> Bool
Eq, (forall x.
 ApiMaintenanceActionPostData -> Rep ApiMaintenanceActionPostData x)
-> (forall x.
    Rep ApiMaintenanceActionPostData x -> ApiMaintenanceActionPostData)
-> Generic ApiMaintenanceActionPostData
forall x.
Rep ApiMaintenanceActionPostData x -> ApiMaintenanceActionPostData
forall x.
ApiMaintenanceActionPostData -> Rep ApiMaintenanceActionPostData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiMaintenanceActionPostData x -> ApiMaintenanceActionPostData
$cfrom :: forall x.
ApiMaintenanceActionPostData -> Rep ApiMaintenanceActionPostData x
Generic)
    deriving Int -> ApiMaintenanceActionPostData -> ShowS
[ApiMaintenanceActionPostData] -> ShowS
ApiMaintenanceActionPostData -> String
(Int -> ApiMaintenanceActionPostData -> ShowS)
-> (ApiMaintenanceActionPostData -> String)
-> ([ApiMaintenanceActionPostData] -> ShowS)
-> Show ApiMaintenanceActionPostData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiMaintenanceActionPostData] -> ShowS
$cshowList :: [ApiMaintenanceActionPostData] -> ShowS
show :: ApiMaintenanceActionPostData -> String
$cshow :: ApiMaintenanceActionPostData -> String
showsPrec :: Int -> ApiMaintenanceActionPostData -> ShowS
$cshowsPrec :: Int -> ApiMaintenanceActionPostData -> ShowS
Show via (Quiet ApiMaintenanceActionPostData)

newtype ApiMaintenanceAction = ApiMaintenanceAction
    { ApiMaintenanceAction -> ApiT PoolMetadataGCStatus
gcStakePools :: ApiT PoolMetadataGCStatus
    }
    deriving (ApiMaintenanceAction -> ApiMaintenanceAction -> Bool
(ApiMaintenanceAction -> ApiMaintenanceAction -> Bool)
-> (ApiMaintenanceAction -> ApiMaintenanceAction -> Bool)
-> Eq ApiMaintenanceAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiMaintenanceAction -> ApiMaintenanceAction -> Bool
$c/= :: ApiMaintenanceAction -> ApiMaintenanceAction -> Bool
== :: ApiMaintenanceAction -> ApiMaintenanceAction -> Bool
$c== :: ApiMaintenanceAction -> ApiMaintenanceAction -> Bool
Eq, (forall x. ApiMaintenanceAction -> Rep ApiMaintenanceAction x)
-> (forall x. Rep ApiMaintenanceAction x -> ApiMaintenanceAction)
-> Generic ApiMaintenanceAction
forall x. Rep ApiMaintenanceAction x -> ApiMaintenanceAction
forall x. ApiMaintenanceAction -> Rep ApiMaintenanceAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiMaintenanceAction x -> ApiMaintenanceAction
$cfrom :: forall x. ApiMaintenanceAction -> Rep ApiMaintenanceAction x
Generic)
    deriving Int -> ApiMaintenanceAction -> ShowS
[ApiMaintenanceAction] -> ShowS
ApiMaintenanceAction -> String
(Int -> ApiMaintenanceAction -> ShowS)
-> (ApiMaintenanceAction -> String)
-> ([ApiMaintenanceAction] -> ShowS)
-> Show ApiMaintenanceAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiMaintenanceAction] -> ShowS
$cshowList :: [ApiMaintenanceAction] -> ShowS
show :: ApiMaintenanceAction -> String
$cshow :: ApiMaintenanceAction -> String
showsPrec :: Int -> ApiMaintenanceAction -> ShowS
$cshowsPrec :: Int -> ApiMaintenanceAction -> ShowS
Show via (Quiet ApiMaintenanceAction)

newtype ApiPolicyId = ApiPolicyId
    {  ApiPolicyId -> ApiT TokenPolicyId
policyId :: ApiT W.TokenPolicyId
    } deriving (ApiPolicyId -> ApiPolicyId -> Bool
(ApiPolicyId -> ApiPolicyId -> Bool)
-> (ApiPolicyId -> ApiPolicyId -> Bool) -> Eq ApiPolicyId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiPolicyId -> ApiPolicyId -> Bool
$c/= :: ApiPolicyId -> ApiPolicyId -> Bool
== :: ApiPolicyId -> ApiPolicyId -> Bool
$c== :: ApiPolicyId -> ApiPolicyId -> Bool
Eq, (forall x. ApiPolicyId -> Rep ApiPolicyId x)
-> (forall x. Rep ApiPolicyId x -> ApiPolicyId)
-> Generic ApiPolicyId
forall x. Rep ApiPolicyId x -> ApiPolicyId
forall x. ApiPolicyId -> Rep ApiPolicyId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiPolicyId x -> ApiPolicyId
$cfrom :: forall x. ApiPolicyId -> Rep ApiPolicyId x
Generic, Int -> ApiPolicyId -> ShowS
[ApiPolicyId] -> ShowS
ApiPolicyId -> String
(Int -> ApiPolicyId -> ShowS)
-> (ApiPolicyId -> String)
-> ([ApiPolicyId] -> ShowS)
-> Show ApiPolicyId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiPolicyId] -> ShowS
$cshowList :: [ApiPolicyId] -> ShowS
show :: ApiPolicyId -> String
$cshow :: ApiPolicyId -> String
showsPrec :: Int -> ApiPolicyId -> ShowS
$cshowsPrec :: Int -> ApiPolicyId -> ShowS
Show)

newtype ApiPostPolicyIdData = ApiPostPolicyIdData
    { ApiPostPolicyIdData -> ApiT (Script Cosigner)
policyScriptTemplate :: (ApiT (Script Cosigner))
    } deriving (ApiPostPolicyIdData -> ApiPostPolicyIdData -> Bool
(ApiPostPolicyIdData -> ApiPostPolicyIdData -> Bool)
-> (ApiPostPolicyIdData -> ApiPostPolicyIdData -> Bool)
-> Eq ApiPostPolicyIdData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiPostPolicyIdData -> ApiPostPolicyIdData -> Bool
$c/= :: ApiPostPolicyIdData -> ApiPostPolicyIdData -> Bool
== :: ApiPostPolicyIdData -> ApiPostPolicyIdData -> Bool
$c== :: ApiPostPolicyIdData -> ApiPostPolicyIdData -> Bool
Eq, (forall x. ApiPostPolicyIdData -> Rep ApiPostPolicyIdData x)
-> (forall x. Rep ApiPostPolicyIdData x -> ApiPostPolicyIdData)
-> Generic ApiPostPolicyIdData
forall x. Rep ApiPostPolicyIdData x -> ApiPostPolicyIdData
forall x. ApiPostPolicyIdData -> Rep ApiPostPolicyIdData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiPostPolicyIdData x -> ApiPostPolicyIdData
$cfrom :: forall x. ApiPostPolicyIdData -> Rep ApiPostPolicyIdData x
Generic, Int -> ApiPostPolicyIdData -> ShowS
[ApiPostPolicyIdData] -> ShowS
ApiPostPolicyIdData -> String
(Int -> ApiPostPolicyIdData -> ShowS)
-> (ApiPostPolicyIdData -> String)
-> ([ApiPostPolicyIdData] -> ShowS)
-> Show ApiPostPolicyIdData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiPostPolicyIdData] -> ShowS
$cshowList :: [ApiPostPolicyIdData] -> ShowS
show :: ApiPostPolicyIdData -> String
$cshow :: ApiPostPolicyIdData -> String
showsPrec :: Int -> ApiPostPolicyIdData -> ShowS
$cshowsPrec :: Int -> ApiPostPolicyIdData -> ShowS
Show)

data ApiAsset = ApiAsset
    { ApiAsset -> ApiT TokenPolicyId
policyId :: ApiT W.TokenPolicyId
    , ApiAsset -> ApiT TokenName
assetName :: ApiT W.TokenName
    , ApiAsset -> ApiT TokenFingerprint
fingerprint :: ApiT W.TokenFingerprint
    , ApiAsset -> Maybe ApiAssetMetadata
metadata :: Maybe ApiAssetMetadata
    , ApiAsset -> Maybe ApiMetadataError
metadataError :: Maybe ApiMetadataError
    } deriving (ApiAsset -> ApiAsset -> Bool
(ApiAsset -> ApiAsset -> Bool)
-> (ApiAsset -> ApiAsset -> Bool) -> Eq ApiAsset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiAsset -> ApiAsset -> Bool
$c/= :: ApiAsset -> ApiAsset -> Bool
== :: ApiAsset -> ApiAsset -> Bool
$c== :: ApiAsset -> ApiAsset -> Bool
Eq, (forall x. ApiAsset -> Rep ApiAsset x)
-> (forall x. Rep ApiAsset x -> ApiAsset) -> Generic ApiAsset
forall x. Rep ApiAsset x -> ApiAsset
forall x. ApiAsset -> Rep ApiAsset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiAsset x -> ApiAsset
$cfrom :: forall x. ApiAsset -> Rep ApiAsset x
Generic, Int -> ApiAsset -> ShowS
[ApiAsset] -> ShowS
ApiAsset -> String
(Int -> ApiAsset -> ShowS)
-> (ApiAsset -> String) -> ([ApiAsset] -> ShowS) -> Show ApiAsset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiAsset] -> ShowS
$cshowList :: [ApiAsset] -> ShowS
show :: ApiAsset -> String
$cshow :: ApiAsset -> String
showsPrec :: Int -> ApiAsset -> ShowS
$cshowsPrec :: Int -> ApiAsset -> ShowS
Show)
      deriving anyclass ApiAsset -> ()
(ApiAsset -> ()) -> NFData ApiAsset
forall a. (a -> ()) -> NFData a
rnf :: ApiAsset -> ()
$crnf :: ApiAsset -> ()
NFData

data ApiMetadataError = Fetch | Parse
    deriving (ApiMetadataError -> ApiMetadataError -> Bool
(ApiMetadataError -> ApiMetadataError -> Bool)
-> (ApiMetadataError -> ApiMetadataError -> Bool)
-> Eq ApiMetadataError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiMetadataError -> ApiMetadataError -> Bool
$c/= :: ApiMetadataError -> ApiMetadataError -> Bool
== :: ApiMetadataError -> ApiMetadataError -> Bool
$c== :: ApiMetadataError -> ApiMetadataError -> Bool
Eq, (forall x. ApiMetadataError -> Rep ApiMetadataError x)
-> (forall x. Rep ApiMetadataError x -> ApiMetadataError)
-> Generic ApiMetadataError
forall x. Rep ApiMetadataError x -> ApiMetadataError
forall x. ApiMetadataError -> Rep ApiMetadataError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiMetadataError x -> ApiMetadataError
$cfrom :: forall x. ApiMetadataError -> Rep ApiMetadataError x
Generic, Int -> ApiMetadataError -> ShowS
[ApiMetadataError] -> ShowS
ApiMetadataError -> String
(Int -> ApiMetadataError -> ShowS)
-> (ApiMetadataError -> String)
-> ([ApiMetadataError] -> ShowS)
-> Show ApiMetadataError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiMetadataError] -> ShowS
$cshowList :: [ApiMetadataError] -> ShowS
show :: ApiMetadataError -> String
$cshow :: ApiMetadataError -> String
showsPrec :: Int -> ApiMetadataError -> ShowS
$cshowsPrec :: Int -> ApiMetadataError -> ShowS
Show)
    deriving anyclass ApiMetadataError -> ()
(ApiMetadataError -> ()) -> NFData ApiMetadataError
forall a. (a -> ()) -> NFData a
rnf :: ApiMetadataError -> ()
$crnf :: ApiMetadataError -> ()
NFData

data ApiAssetMetadata = ApiAssetMetadata
    { ApiAssetMetadata -> Text
name :: Text
    , ApiAssetMetadata -> Text
description :: Text
    , ApiAssetMetadata -> Maybe Text
ticker :: Maybe Text
    , ApiAssetMetadata -> Maybe (ApiT AssetURL)
url :: Maybe (ApiT W.AssetURL)
    , ApiAssetMetadata -> Maybe (ApiT AssetLogo)
logo :: Maybe (ApiT W.AssetLogo)
    , ApiAssetMetadata -> Maybe (ApiT AssetDecimals)
decimals :: Maybe (ApiT W.AssetDecimals)
    } deriving (ApiAssetMetadata -> ApiAssetMetadata -> Bool
(ApiAssetMetadata -> ApiAssetMetadata -> Bool)
-> (ApiAssetMetadata -> ApiAssetMetadata -> Bool)
-> Eq ApiAssetMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
$c/= :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
== :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
$c== :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
Eq, (forall x. ApiAssetMetadata -> Rep ApiAssetMetadata x)
-> (forall x. Rep ApiAssetMetadata x -> ApiAssetMetadata)
-> Generic ApiAssetMetadata
forall x. Rep ApiAssetMetadata x -> ApiAssetMetadata
forall x. ApiAssetMetadata -> Rep ApiAssetMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiAssetMetadata x -> ApiAssetMetadata
$cfrom :: forall x. ApiAssetMetadata -> Rep ApiAssetMetadata x
Generic, Eq ApiAssetMetadata
Eq ApiAssetMetadata
-> (ApiAssetMetadata -> ApiAssetMetadata -> Ordering)
-> (ApiAssetMetadata -> ApiAssetMetadata -> Bool)
-> (ApiAssetMetadata -> ApiAssetMetadata -> Bool)
-> (ApiAssetMetadata -> ApiAssetMetadata -> Bool)
-> (ApiAssetMetadata -> ApiAssetMetadata -> Bool)
-> (ApiAssetMetadata -> ApiAssetMetadata -> ApiAssetMetadata)
-> (ApiAssetMetadata -> ApiAssetMetadata -> ApiAssetMetadata)
-> Ord ApiAssetMetadata
ApiAssetMetadata -> ApiAssetMetadata -> Bool
ApiAssetMetadata -> ApiAssetMetadata -> Ordering
ApiAssetMetadata -> ApiAssetMetadata -> ApiAssetMetadata
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ApiAssetMetadata -> ApiAssetMetadata -> ApiAssetMetadata
$cmin :: ApiAssetMetadata -> ApiAssetMetadata -> ApiAssetMetadata
max :: ApiAssetMetadata -> ApiAssetMetadata -> ApiAssetMetadata
$cmax :: ApiAssetMetadata -> ApiAssetMetadata -> ApiAssetMetadata
>= :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
$c>= :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
> :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
$c> :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
<= :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
$c<= :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
< :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
$c< :: ApiAssetMetadata -> ApiAssetMetadata -> Bool
compare :: ApiAssetMetadata -> ApiAssetMetadata -> Ordering
$ccompare :: ApiAssetMetadata -> ApiAssetMetadata -> Ordering
$cp1Ord :: Eq ApiAssetMetadata
Ord, Int -> ApiAssetMetadata -> ShowS
[ApiAssetMetadata] -> ShowS
ApiAssetMetadata -> String
(Int -> ApiAssetMetadata -> ShowS)
-> (ApiAssetMetadata -> String)
-> ([ApiAssetMetadata] -> ShowS)
-> Show ApiAssetMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiAssetMetadata] -> ShowS
$cshowList :: [ApiAssetMetadata] -> ShowS
show :: ApiAssetMetadata -> String
$cshow :: ApiAssetMetadata -> String
showsPrec :: Int -> ApiAssetMetadata -> ShowS
$cshowsPrec :: Int -> ApiAssetMetadata -> ShowS
Show)
      deriving anyclass ApiAssetMetadata -> ()
(ApiAssetMetadata -> ()) -> NFData ApiAssetMetadata
forall a. (a -> ()) -> NFData a
rnf :: ApiAssetMetadata -> ()
$crnf :: ApiAssetMetadata -> ()
NFData

toApiAsset
    :: Either TokenMetadataError (Maybe W.AssetMetadata)
    -> W.AssetId
    -> ApiAsset
toApiAsset :: Either TokenMetadataError (Maybe AssetMetadata)
-> AssetId -> ApiAsset
toApiAsset Either TokenMetadataError (Maybe AssetMetadata)
metadata_ (W.AssetId TokenPolicyId
policyId_ TokenName
assetName_) = ApiAsset :: ApiT TokenPolicyId
-> ApiT TokenName
-> ApiT TokenFingerprint
-> Maybe ApiAssetMetadata
-> Maybe ApiMetadataError
-> ApiAsset
ApiAsset
    { $sel:policyId:ApiAsset :: ApiT TokenPolicyId
policyId = TokenPolicyId -> ApiT TokenPolicyId
forall a. a -> ApiT a
ApiT TokenPolicyId
policyId_
    , $sel:assetName:ApiAsset :: ApiT TokenName
assetName = TokenName -> ApiT TokenName
forall a. a -> ApiT a
ApiT TokenName
assetName_
    , $sel:fingerprint:ApiAsset :: ApiT TokenFingerprint
fingerprint = TokenFingerprint -> ApiT TokenFingerprint
forall a. a -> ApiT a
ApiT (TokenFingerprint -> ApiT TokenFingerprint)
-> TokenFingerprint -> ApiT TokenFingerprint
forall a b. (a -> b) -> a -> b
$ TokenPolicyId -> TokenName -> TokenFingerprint
W.mkTokenFingerprint TokenPolicyId
policyId_ TokenName
assetName_
    , $sel:metadata:ApiAsset :: Maybe ApiAssetMetadata
metadata = (TokenMetadataError -> Maybe ApiAssetMetadata)
-> (Maybe AssetMetadata -> Maybe ApiAssetMetadata)
-> Either TokenMetadataError (Maybe AssetMetadata)
-> Maybe ApiAssetMetadata
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ApiAssetMetadata
-> TokenMetadataError -> Maybe ApiAssetMetadata
forall a b. a -> b -> a
const Maybe ApiAssetMetadata
forall a. Maybe a
Nothing) ((AssetMetadata -> ApiAssetMetadata)
-> Maybe AssetMetadata -> Maybe ApiAssetMetadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AssetMetadata -> ApiAssetMetadata
toApiAssetMetadata) Either TokenMetadataError (Maybe AssetMetadata)
metadata_
    , $sel:metadataError:ApiAsset :: Maybe ApiMetadataError
metadataError = (TokenMetadataError -> Maybe ApiMetadataError)
-> (Maybe AssetMetadata -> Maybe ApiMetadataError)
-> Either TokenMetadataError (Maybe AssetMetadata)
-> Maybe ApiMetadataError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ApiMetadataError -> Maybe ApiMetadataError
forall a. a -> Maybe a
Just (ApiMetadataError -> Maybe ApiMetadataError)
-> (TokenMetadataError -> ApiMetadataError)
-> TokenMetadataError
-> Maybe ApiMetadataError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMetadataError -> ApiMetadataError
category) (Maybe ApiMetadataError
-> Maybe AssetMetadata -> Maybe ApiMetadataError
forall a b. a -> b -> a
const Maybe ApiMetadataError
forall a. Maybe a
Nothing) Either TokenMetadataError (Maybe AssetMetadata)
metadata_
    }
  where
    category :: TokenMetadataError -> ApiMetadataError
category = \case
        TokenMetadataClientError LoggedException SomeException
_ -> ApiMetadataError
Fetch
        TokenMetadataFetchError LoggedException HttpException
_ -> ApiMetadataError
Fetch
        TokenMetadataJSONParseError ByteString
_ String
_ -> ApiMetadataError
Parse

toApiAssetMetadata :: W.AssetMetadata -> ApiAssetMetadata
toApiAssetMetadata :: AssetMetadata -> ApiAssetMetadata
toApiAssetMetadata W.AssetMetadata{Text
$sel:name:AssetMetadata :: AssetMetadata -> Text
name :: Text
name,Text
$sel:description:AssetMetadata :: AssetMetadata -> Text
description :: Text
description,Maybe Text
$sel:ticker:AssetMetadata :: AssetMetadata -> Maybe Text
ticker :: Maybe Text
ticker,Maybe AssetURL
$sel:url:AssetMetadata :: AssetMetadata -> Maybe AssetURL
url :: Maybe AssetURL
url,Maybe AssetLogo
$sel:logo:AssetMetadata :: AssetMetadata -> Maybe AssetLogo
logo :: Maybe AssetLogo
logo,Maybe AssetDecimals
$sel:decimals:AssetMetadata :: AssetMetadata -> Maybe AssetDecimals
decimals :: Maybe AssetDecimals
decimals} =
    Text
-> Text
-> Maybe Text
-> Maybe (ApiT AssetURL)
-> Maybe (ApiT AssetLogo)
-> Maybe (ApiT AssetDecimals)
-> ApiAssetMetadata
ApiAssetMetadata Text
name Text
description Maybe Text
ticker
        (AssetURL -> ApiT AssetURL
forall a. a -> ApiT a
ApiT (AssetURL -> ApiT AssetURL)
-> Maybe AssetURL -> Maybe (ApiT AssetURL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AssetURL
url) (AssetLogo -> ApiT AssetLogo
forall a. a -> ApiT a
ApiT (AssetLogo -> ApiT AssetLogo)
-> Maybe AssetLogo -> Maybe (ApiT AssetLogo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AssetLogo
logo) (AssetDecimals -> ApiT AssetDecimals
forall a. a -> ApiT a
ApiT (AssetDecimals -> ApiT AssetDecimals)
-> Maybe AssetDecimals -> Maybe (ApiT AssetDecimals)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AssetDecimals
decimals)

data ApiAddress (n :: NetworkDiscriminant) = ApiAddress
    { ApiAddress n -> (ApiT Address, Proxy n)
id :: !(ApiT Address, Proxy n)
    , ApiAddress n -> ApiT AddressState
state :: !(ApiT AddressState)
    , ApiAddress n -> NonEmpty (ApiT DerivationIndex)
derivationPath :: NonEmpty (ApiT DerivationIndex)
    } deriving (ApiAddress n -> ApiAddress n -> Bool
(ApiAddress n -> ApiAddress n -> Bool)
-> (ApiAddress n -> ApiAddress n -> Bool) -> Eq (ApiAddress n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiAddress n -> ApiAddress n -> Bool
/= :: ApiAddress n -> ApiAddress n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiAddress n -> ApiAddress n -> Bool
== :: ApiAddress n -> ApiAddress n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiAddress n -> ApiAddress n -> Bool
Eq, (forall x. ApiAddress n -> Rep (ApiAddress n) x)
-> (forall x. Rep (ApiAddress n) x -> ApiAddress n)
-> Generic (ApiAddress n)
forall x. Rep (ApiAddress n) x -> ApiAddress n
forall x. ApiAddress n -> Rep (ApiAddress n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiAddress n) x -> ApiAddress n
forall (n :: NetworkDiscriminant) x.
ApiAddress n -> Rep (ApiAddress n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiAddress n) x -> ApiAddress n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiAddress n -> Rep (ApiAddress n) x
Generic, Int -> ApiAddress n -> ShowS
[ApiAddress n] -> ShowS
ApiAddress n -> String
(Int -> ApiAddress n -> ShowS)
-> (ApiAddress n -> String)
-> ([ApiAddress n] -> ShowS)
-> Show (ApiAddress n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant). Int -> ApiAddress n -> ShowS
forall (n :: NetworkDiscriminant). [ApiAddress n] -> ShowS
forall (n :: NetworkDiscriminant). ApiAddress n -> String
showList :: [ApiAddress n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiAddress n] -> ShowS
show :: ApiAddress n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiAddress n -> String
showsPrec :: Int -> ApiAddress n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant). Int -> ApiAddress n -> ShowS
Show, Typeable)
      deriving anyclass ApiAddress n -> ()
(ApiAddress n -> ()) -> NFData (ApiAddress n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiAddress n -> ()
rnf :: ApiAddress n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiAddress n -> ()
NFData

data ApiCredential =
      CredentialExtendedPubKey ByteString
    | CredentialPubKey ByteString
    | CredentialKeyHash ByteString
    | CredentialScript (Script KeyHash)
    deriving (ApiCredential -> ApiCredential -> Bool
(ApiCredential -> ApiCredential -> Bool)
-> (ApiCredential -> ApiCredential -> Bool) -> Eq ApiCredential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiCredential -> ApiCredential -> Bool
$c/= :: ApiCredential -> ApiCredential -> Bool
== :: ApiCredential -> ApiCredential -> Bool
$c== :: ApiCredential -> ApiCredential -> Bool
Eq, (forall x. ApiCredential -> Rep ApiCredential x)
-> (forall x. Rep ApiCredential x -> ApiCredential)
-> Generic ApiCredential
forall x. Rep ApiCredential x -> ApiCredential
forall x. ApiCredential -> Rep ApiCredential x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiCredential x -> ApiCredential
$cfrom :: forall x. ApiCredential -> Rep ApiCredential x
Generic, Int -> ApiCredential -> ShowS
[ApiCredential] -> ShowS
ApiCredential -> String
(Int -> ApiCredential -> ShowS)
-> (ApiCredential -> String)
-> ([ApiCredential] -> ShowS)
-> Show ApiCredential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiCredential] -> ShowS
$cshowList :: [ApiCredential] -> ShowS
show :: ApiCredential -> String
$cshow :: ApiCredential -> String
showsPrec :: Int -> ApiCredential -> ShowS
$cshowsPrec :: Int -> ApiCredential -> ShowS
Show)

data ApiAddressData = ApiAddressData
    { ApiAddressData -> ApiAddressDataPayload
address :: !ApiAddressDataPayload
    , ApiAddressData -> Maybe (ApiT ValidationLevel)
validationLevel :: !(Maybe (ApiT ValidationLevel))
    } deriving (ApiAddressData -> ApiAddressData -> Bool
(ApiAddressData -> ApiAddressData -> Bool)
-> (ApiAddressData -> ApiAddressData -> Bool) -> Eq ApiAddressData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiAddressData -> ApiAddressData -> Bool
$c/= :: ApiAddressData -> ApiAddressData -> Bool
== :: ApiAddressData -> ApiAddressData -> Bool
$c== :: ApiAddressData -> ApiAddressData -> Bool
Eq, (forall x. ApiAddressData -> Rep ApiAddressData x)
-> (forall x. Rep ApiAddressData x -> ApiAddressData)
-> Generic ApiAddressData
forall x. Rep ApiAddressData x -> ApiAddressData
forall x. ApiAddressData -> Rep ApiAddressData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiAddressData x -> ApiAddressData
$cfrom :: forall x. ApiAddressData -> Rep ApiAddressData x
Generic, Int -> ApiAddressData -> ShowS
[ApiAddressData] -> ShowS
ApiAddressData -> String
(Int -> ApiAddressData -> ShowS)
-> (ApiAddressData -> String)
-> ([ApiAddressData] -> ShowS)
-> Show ApiAddressData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiAddressData] -> ShowS
$cshowList :: [ApiAddressData] -> ShowS
show :: ApiAddressData -> String
$cshow :: ApiAddressData -> String
showsPrec :: Int -> ApiAddressData -> ShowS
$cshowsPrec :: Int -> ApiAddressData -> ShowS
Show)

data ApiAddressDataPayload =
      AddrEnterprise ApiCredential
    | AddrRewardAccount ApiCredential
    | AddrBase ApiCredential ApiCredential
    deriving (ApiAddressDataPayload -> ApiAddressDataPayload -> Bool
(ApiAddressDataPayload -> ApiAddressDataPayload -> Bool)
-> (ApiAddressDataPayload -> ApiAddressDataPayload -> Bool)
-> Eq ApiAddressDataPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiAddressDataPayload -> ApiAddressDataPayload -> Bool
$c/= :: ApiAddressDataPayload -> ApiAddressDataPayload -> Bool
== :: ApiAddressDataPayload -> ApiAddressDataPayload -> Bool
$c== :: ApiAddressDataPayload -> ApiAddressDataPayload -> Bool
Eq, (forall x. ApiAddressDataPayload -> Rep ApiAddressDataPayload x)
-> (forall x. Rep ApiAddressDataPayload x -> ApiAddressDataPayload)
-> Generic ApiAddressDataPayload
forall x. Rep ApiAddressDataPayload x -> ApiAddressDataPayload
forall x. ApiAddressDataPayload -> Rep ApiAddressDataPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiAddressDataPayload x -> ApiAddressDataPayload
$cfrom :: forall x. ApiAddressDataPayload -> Rep ApiAddressDataPayload x
Generic, Int -> ApiAddressDataPayload -> ShowS
[ApiAddressDataPayload] -> ShowS
ApiAddressDataPayload -> String
(Int -> ApiAddressDataPayload -> ShowS)
-> (ApiAddressDataPayload -> String)
-> ([ApiAddressDataPayload] -> ShowS)
-> Show ApiAddressDataPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiAddressDataPayload] -> ShowS
$cshowList :: [ApiAddressDataPayload] -> ShowS
show :: ApiAddressDataPayload -> String
$cshow :: ApiAddressDataPayload -> String
showsPrec :: Int -> ApiAddressDataPayload -> ShowS
$cshowsPrec :: Int -> ApiAddressDataPayload -> ShowS
Show)

data AnyAddressType =
      EnterpriseDelegating
    | RewardAccount
    deriving (AnyAddressType -> AnyAddressType -> Bool
(AnyAddressType -> AnyAddressType -> Bool)
-> (AnyAddressType -> AnyAddressType -> Bool) -> Eq AnyAddressType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnyAddressType -> AnyAddressType -> Bool
$c/= :: AnyAddressType -> AnyAddressType -> Bool
== :: AnyAddressType -> AnyAddressType -> Bool
$c== :: AnyAddressType -> AnyAddressType -> Bool
Eq, Int -> AnyAddressType -> ShowS
[AnyAddressType] -> ShowS
AnyAddressType -> String
(Int -> AnyAddressType -> ShowS)
-> (AnyAddressType -> String)
-> ([AnyAddressType] -> ShowS)
-> Show AnyAddressType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnyAddressType] -> ShowS
$cshowList :: [AnyAddressType] -> ShowS
show :: AnyAddressType -> String
$cshow :: AnyAddressType -> String
showsPrec :: Int -> AnyAddressType -> ShowS
$cshowsPrec :: Int -> AnyAddressType -> ShowS
Show, AnyAddressType
AnyAddressType -> AnyAddressType -> Bounded AnyAddressType
forall a. a -> a -> Bounded a
maxBound :: AnyAddressType
$cmaxBound :: AnyAddressType
minBound :: AnyAddressType
$cminBound :: AnyAddressType
Bounded, Int -> AnyAddressType
AnyAddressType -> Int
AnyAddressType -> [AnyAddressType]
AnyAddressType -> AnyAddressType
AnyAddressType -> AnyAddressType -> [AnyAddressType]
AnyAddressType
-> AnyAddressType -> AnyAddressType -> [AnyAddressType]
(AnyAddressType -> AnyAddressType)
-> (AnyAddressType -> AnyAddressType)
-> (Int -> AnyAddressType)
-> (AnyAddressType -> Int)
-> (AnyAddressType -> [AnyAddressType])
-> (AnyAddressType -> AnyAddressType -> [AnyAddressType])
-> (AnyAddressType -> AnyAddressType -> [AnyAddressType])
-> (AnyAddressType
    -> AnyAddressType -> AnyAddressType -> [AnyAddressType])
-> Enum AnyAddressType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AnyAddressType
-> AnyAddressType -> AnyAddressType -> [AnyAddressType]
$cenumFromThenTo :: AnyAddressType
-> AnyAddressType -> AnyAddressType -> [AnyAddressType]
enumFromTo :: AnyAddressType -> AnyAddressType -> [AnyAddressType]
$cenumFromTo :: AnyAddressType -> AnyAddressType -> [AnyAddressType]
enumFromThen :: AnyAddressType -> AnyAddressType -> [AnyAddressType]
$cenumFromThen :: AnyAddressType -> AnyAddressType -> [AnyAddressType]
enumFrom :: AnyAddressType -> [AnyAddressType]
$cenumFrom :: AnyAddressType -> [AnyAddressType]
fromEnum :: AnyAddressType -> Int
$cfromEnum :: AnyAddressType -> Int
toEnum :: Int -> AnyAddressType
$ctoEnum :: Int -> AnyAddressType
pred :: AnyAddressType -> AnyAddressType
$cpred :: AnyAddressType -> AnyAddressType
succ :: AnyAddressType -> AnyAddressType
$csucc :: AnyAddressType -> AnyAddressType
Enum)

data AnyAddress = AnyAddress
    { AnyAddress -> ByteString
payload :: ByteString
    , AnyAddress -> AnyAddressType
flavour :: AnyAddressType
    , AnyAddress -> Int
network :: Int
    } deriving (AnyAddress -> AnyAddress -> Bool
(AnyAddress -> AnyAddress -> Bool)
-> (AnyAddress -> AnyAddress -> Bool) -> Eq AnyAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnyAddress -> AnyAddress -> Bool
$c/= :: AnyAddress -> AnyAddress -> Bool
== :: AnyAddress -> AnyAddress -> Bool
$c== :: AnyAddress -> AnyAddress -> Bool
Eq, (forall x. AnyAddress -> Rep AnyAddress x)
-> (forall x. Rep AnyAddress x -> AnyAddress) -> Generic AnyAddress
forall x. Rep AnyAddress x -> AnyAddress
forall x. AnyAddress -> Rep AnyAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AnyAddress x -> AnyAddress
$cfrom :: forall x. AnyAddress -> Rep AnyAddress x
Generic, Int -> AnyAddress -> ShowS
[AnyAddress] -> ShowS
AnyAddress -> String
(Int -> AnyAddress -> ShowS)
-> (AnyAddress -> String)
-> ([AnyAddress] -> ShowS)
-> Show AnyAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnyAddress] -> ShowS
$cshowList :: [AnyAddress] -> ShowS
show :: AnyAddress -> String
$cshow :: AnyAddress -> String
showsPrec :: Int -> AnyAddress -> ShowS
$cshowsPrec :: Int -> AnyAddress -> ShowS
Show)

data ApiEpochInfo = ApiEpochInfo
    { ApiEpochInfo -> ApiT EpochNo
epochNumber :: !(ApiT EpochNo)
    , ApiEpochInfo -> UTCTime
epochStartTime :: !UTCTime
    } deriving (ApiEpochInfo -> ApiEpochInfo -> Bool
(ApiEpochInfo -> ApiEpochInfo -> Bool)
-> (ApiEpochInfo -> ApiEpochInfo -> Bool) -> Eq ApiEpochInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiEpochInfo -> ApiEpochInfo -> Bool
$c/= :: ApiEpochInfo -> ApiEpochInfo -> Bool
== :: ApiEpochInfo -> ApiEpochInfo -> Bool
$c== :: ApiEpochInfo -> ApiEpochInfo -> Bool
Eq, (forall x. ApiEpochInfo -> Rep ApiEpochInfo x)
-> (forall x. Rep ApiEpochInfo x -> ApiEpochInfo)
-> Generic ApiEpochInfo
forall x. Rep ApiEpochInfo x -> ApiEpochInfo
forall x. ApiEpochInfo -> Rep ApiEpochInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiEpochInfo x -> ApiEpochInfo
$cfrom :: forall x. ApiEpochInfo -> Rep ApiEpochInfo x
Generic, Int -> ApiEpochInfo -> ShowS
[ApiEpochInfo] -> ShowS
ApiEpochInfo -> String
(Int -> ApiEpochInfo -> ShowS)
-> (ApiEpochInfo -> String)
-> ([ApiEpochInfo] -> ShowS)
-> Show ApiEpochInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiEpochInfo] -> ShowS
$cshowList :: [ApiEpochInfo] -> ShowS
show :: ApiEpochInfo -> String
$cshow :: ApiEpochInfo -> String
showsPrec :: Int -> ApiEpochInfo -> ShowS
$cshowsPrec :: Int -> ApiEpochInfo -> ShowS
Show)
      deriving anyclass ApiEpochInfo -> ()
(ApiEpochInfo -> ()) -> NFData ApiEpochInfo
forall a. (a -> ()) -> NFData a
rnf :: ApiEpochInfo -> ()
$crnf :: ApiEpochInfo -> ()
NFData

toApiEpochInfo :: EpochNo -> Qry ApiEpochInfo
toApiEpochInfo :: EpochNo -> Qry ApiEpochInfo
toApiEpochInfo EpochNo
ep = ApiT EpochNo -> UTCTime -> ApiEpochInfo
ApiEpochInfo (EpochNo -> ApiT EpochNo
forall a. a -> ApiT a
ApiT EpochNo
ep) (UTCTime -> ApiEpochInfo)
-> ((UTCTime, UTCTime) -> UTCTime)
-> (UTCTime, UTCTime)
-> ApiEpochInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime, UTCTime) -> UTCTime
forall a b. (a, b) -> a
fst ((UTCTime, UTCTime) -> ApiEpochInfo)
-> Qry (UTCTime, UTCTime) -> Qry ApiEpochInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochNo -> Qry (UTCTime, UTCTime)
timeOfEpoch EpochNo
ep

data ApiSelectCoinsData (n :: NetworkDiscriminant)
    = ApiSelectForPayment (ApiSelectCoinsPayments n)
    | ApiSelectForDelegation ApiSelectCoinsAction
    deriving (ApiSelectCoinsData n -> ApiSelectCoinsData n -> Bool
(ApiSelectCoinsData n -> ApiSelectCoinsData n -> Bool)
-> (ApiSelectCoinsData n -> ApiSelectCoinsData n -> Bool)
-> Eq (ApiSelectCoinsData n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiSelectCoinsData n -> ApiSelectCoinsData n -> Bool
/= :: ApiSelectCoinsData n -> ApiSelectCoinsData n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiSelectCoinsData n -> ApiSelectCoinsData n -> Bool
== :: ApiSelectCoinsData n -> ApiSelectCoinsData n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiSelectCoinsData n -> ApiSelectCoinsData n -> Bool
Eq, (forall x. ApiSelectCoinsData n -> Rep (ApiSelectCoinsData n) x)
-> (forall x. Rep (ApiSelectCoinsData n) x -> ApiSelectCoinsData n)
-> Generic (ApiSelectCoinsData n)
forall x. Rep (ApiSelectCoinsData n) x -> ApiSelectCoinsData n
forall x. ApiSelectCoinsData n -> Rep (ApiSelectCoinsData n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiSelectCoinsData n) x -> ApiSelectCoinsData n
forall (n :: NetworkDiscriminant) x.
ApiSelectCoinsData n -> Rep (ApiSelectCoinsData n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiSelectCoinsData n) x -> ApiSelectCoinsData n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiSelectCoinsData n -> Rep (ApiSelectCoinsData n) x
Generic, Int -> ApiSelectCoinsData n -> ShowS
[ApiSelectCoinsData n] -> ShowS
ApiSelectCoinsData n -> String
(Int -> ApiSelectCoinsData n -> ShowS)
-> (ApiSelectCoinsData n -> String)
-> ([ApiSelectCoinsData n] -> ShowS)
-> Show (ApiSelectCoinsData n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiSelectCoinsData n -> ShowS
forall (n :: NetworkDiscriminant). [ApiSelectCoinsData n] -> ShowS
forall (n :: NetworkDiscriminant). ApiSelectCoinsData n -> String
showList :: [ApiSelectCoinsData n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiSelectCoinsData n] -> ShowS
show :: ApiSelectCoinsData n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiSelectCoinsData n -> String
showsPrec :: Int -> ApiSelectCoinsData n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiSelectCoinsData n -> ShowS
Show, Typeable)

data ApiSelectCoinsPayments (n :: NetworkDiscriminant) = ApiSelectCoinsPayments
    { ApiSelectCoinsPayments n -> NonEmpty (ApiTxOutput n)
payments :: NonEmpty (ApiTxOutput n)
    , ApiSelectCoinsPayments n -> Maybe ApiWithdrawalPostData
withdrawal :: !(Maybe ApiWithdrawalPostData)
    , ApiSelectCoinsPayments n -> Maybe (ApiT TxMetadata)
metadata :: !(Maybe (ApiT TxMetadata))
    } deriving (ApiSelectCoinsPayments n -> ApiSelectCoinsPayments n -> Bool
(ApiSelectCoinsPayments n -> ApiSelectCoinsPayments n -> Bool)
-> (ApiSelectCoinsPayments n -> ApiSelectCoinsPayments n -> Bool)
-> Eq (ApiSelectCoinsPayments n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiSelectCoinsPayments n -> ApiSelectCoinsPayments n -> Bool
/= :: ApiSelectCoinsPayments n -> ApiSelectCoinsPayments n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiSelectCoinsPayments n -> ApiSelectCoinsPayments n -> Bool
== :: ApiSelectCoinsPayments n -> ApiSelectCoinsPayments n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiSelectCoinsPayments n -> ApiSelectCoinsPayments n -> Bool
Eq, (forall x.
 ApiSelectCoinsPayments n -> Rep (ApiSelectCoinsPayments n) x)
-> (forall x.
    Rep (ApiSelectCoinsPayments n) x -> ApiSelectCoinsPayments n)
-> Generic (ApiSelectCoinsPayments n)
forall x.
Rep (ApiSelectCoinsPayments n) x -> ApiSelectCoinsPayments n
forall x.
ApiSelectCoinsPayments n -> Rep (ApiSelectCoinsPayments n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiSelectCoinsPayments n) x -> ApiSelectCoinsPayments n
forall (n :: NetworkDiscriminant) x.
ApiSelectCoinsPayments n -> Rep (ApiSelectCoinsPayments n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiSelectCoinsPayments n) x -> ApiSelectCoinsPayments n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiSelectCoinsPayments n -> Rep (ApiSelectCoinsPayments n) x
Generic, Int -> ApiSelectCoinsPayments n -> ShowS
[ApiSelectCoinsPayments n] -> ShowS
ApiSelectCoinsPayments n -> String
(Int -> ApiSelectCoinsPayments n -> ShowS)
-> (ApiSelectCoinsPayments n -> String)
-> ([ApiSelectCoinsPayments n] -> ShowS)
-> Show (ApiSelectCoinsPayments n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiSelectCoinsPayments n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiSelectCoinsPayments n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiSelectCoinsPayments n -> String
showList :: [ApiSelectCoinsPayments n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiSelectCoinsPayments n] -> ShowS
show :: ApiSelectCoinsPayments n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiSelectCoinsPayments n -> String
showsPrec :: Int -> ApiSelectCoinsPayments n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiSelectCoinsPayments n -> ShowS
Show, Typeable)

newtype ApiSelectCoinsAction = ApiSelectCoinsAction
    { ApiSelectCoinsAction -> ApiDelegationAction
delegationAction :: ApiDelegationAction
    }
    deriving (ApiSelectCoinsAction -> ApiSelectCoinsAction -> Bool
(ApiSelectCoinsAction -> ApiSelectCoinsAction -> Bool)
-> (ApiSelectCoinsAction -> ApiSelectCoinsAction -> Bool)
-> Eq ApiSelectCoinsAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiSelectCoinsAction -> ApiSelectCoinsAction -> Bool
$c/= :: ApiSelectCoinsAction -> ApiSelectCoinsAction -> Bool
== :: ApiSelectCoinsAction -> ApiSelectCoinsAction -> Bool
$c== :: ApiSelectCoinsAction -> ApiSelectCoinsAction -> Bool
Eq, (forall x. ApiSelectCoinsAction -> Rep ApiSelectCoinsAction x)
-> (forall x. Rep ApiSelectCoinsAction x -> ApiSelectCoinsAction)
-> Generic ApiSelectCoinsAction
forall x. Rep ApiSelectCoinsAction x -> ApiSelectCoinsAction
forall x. ApiSelectCoinsAction -> Rep ApiSelectCoinsAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiSelectCoinsAction x -> ApiSelectCoinsAction
$cfrom :: forall x. ApiSelectCoinsAction -> Rep ApiSelectCoinsAction x
Generic)
    deriving Int -> ApiSelectCoinsAction -> ShowS
[ApiSelectCoinsAction] -> ShowS
ApiSelectCoinsAction -> String
(Int -> ApiSelectCoinsAction -> ShowS)
-> (ApiSelectCoinsAction -> String)
-> ([ApiSelectCoinsAction] -> ShowS)
-> Show ApiSelectCoinsAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiSelectCoinsAction] -> ShowS
$cshowList :: [ApiSelectCoinsAction] -> ShowS
show :: ApiSelectCoinsAction -> String
$cshow :: ApiSelectCoinsAction -> String
showsPrec :: Int -> ApiSelectCoinsAction -> ShowS
$cshowsPrec :: Int -> ApiSelectCoinsAction -> ShowS
Show via (Quiet ApiSelectCoinsAction)

data ApiCertificate
    = RegisterRewardAccount
        { ApiCertificate -> NonEmpty (ApiT DerivationIndex)
rewardAccountPath :: NonEmpty (ApiT DerivationIndex)
        }
    | JoinPool
        { rewardAccountPath :: NonEmpty (ApiT DerivationIndex)
        , ApiCertificate -> ApiT PoolId
pool :: ApiT PoolId
        }
    | QuitPool
        { rewardAccountPath :: NonEmpty (ApiT DerivationIndex)
        }
    deriving (ApiCertificate -> ApiCertificate -> Bool
(ApiCertificate -> ApiCertificate -> Bool)
-> (ApiCertificate -> ApiCertificate -> Bool) -> Eq ApiCertificate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiCertificate -> ApiCertificate -> Bool
$c/= :: ApiCertificate -> ApiCertificate -> Bool
== :: ApiCertificate -> ApiCertificate -> Bool
$c== :: ApiCertificate -> ApiCertificate -> Bool
Eq, (forall x. ApiCertificate -> Rep ApiCertificate x)
-> (forall x. Rep ApiCertificate x -> ApiCertificate)
-> Generic ApiCertificate
forall x. Rep ApiCertificate x -> ApiCertificate
forall x. ApiCertificate -> Rep ApiCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiCertificate x -> ApiCertificate
$cfrom :: forall x. ApiCertificate -> Rep ApiCertificate x
Generic, Int -> ApiCertificate -> ShowS
[ApiCertificate] -> ShowS
ApiCertificate -> String
(Int -> ApiCertificate -> ShowS)
-> (ApiCertificate -> String)
-> ([ApiCertificate] -> ShowS)
-> Show ApiCertificate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiCertificate] -> ShowS
$cshowList :: [ApiCertificate] -> ShowS
show :: ApiCertificate -> String
$cshow :: ApiCertificate -> String
showsPrec :: Int -> ApiCertificate -> ShowS
$cshowsPrec :: Int -> ApiCertificate -> ShowS
Show)
    deriving anyclass ApiCertificate -> ()
(ApiCertificate -> ()) -> NFData ApiCertificate
forall a. (a -> ()) -> NFData a
rnf :: ApiCertificate -> ()
$crnf :: ApiCertificate -> ()
NFData

data ApiDelegationAction = Join (ApiT PoolId) | Quit
    deriving (ApiDelegationAction -> ApiDelegationAction -> Bool
(ApiDelegationAction -> ApiDelegationAction -> Bool)
-> (ApiDelegationAction -> ApiDelegationAction -> Bool)
-> Eq ApiDelegationAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiDelegationAction -> ApiDelegationAction -> Bool
$c/= :: ApiDelegationAction -> ApiDelegationAction -> Bool
== :: ApiDelegationAction -> ApiDelegationAction -> Bool
$c== :: ApiDelegationAction -> ApiDelegationAction -> Bool
Eq, (forall x. ApiDelegationAction -> Rep ApiDelegationAction x)
-> (forall x. Rep ApiDelegationAction x -> ApiDelegationAction)
-> Generic ApiDelegationAction
forall x. Rep ApiDelegationAction x -> ApiDelegationAction
forall x. ApiDelegationAction -> Rep ApiDelegationAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiDelegationAction x -> ApiDelegationAction
$cfrom :: forall x. ApiDelegationAction -> Rep ApiDelegationAction x
Generic, Int -> ApiDelegationAction -> ShowS
[ApiDelegationAction] -> ShowS
ApiDelegationAction -> String
(Int -> ApiDelegationAction -> ShowS)
-> (ApiDelegationAction -> String)
-> ([ApiDelegationAction] -> ShowS)
-> Show ApiDelegationAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiDelegationAction] -> ShowS
$cshowList :: [ApiDelegationAction] -> ShowS
show :: ApiDelegationAction -> String
$cshow :: ApiDelegationAction -> String
showsPrec :: Int -> ApiDelegationAction -> ShowS
$cshowsPrec :: Int -> ApiDelegationAction -> ShowS
Show)
    deriving anyclass ApiDelegationAction -> ()
(ApiDelegationAction -> ()) -> NFData ApiDelegationAction
forall a. (a -> ()) -> NFData a
rnf :: ApiDelegationAction -> ()
$crnf :: ApiDelegationAction -> ()
NFData

data ApiCoinSelection (n :: NetworkDiscriminant) = ApiCoinSelection
    { ApiCoinSelection n -> [ApiWalletInput n]
inputs :: ![ApiWalletInput n]
    , ApiCoinSelection n -> [ApiCoinSelectionOutput n]
outputs :: ![ApiCoinSelectionOutput n]
    , ApiCoinSelection n -> [ApiCoinSelectionChange n]
change :: ![ApiCoinSelectionChange n]
    , ApiCoinSelection n -> [ApiCoinSelectionCollateral n]
collateral :: ![ApiCoinSelectionCollateral n]
    , ApiCoinSelection n -> [ApiCoinSelectionWithdrawal n]
withdrawals :: ![ApiCoinSelectionWithdrawal n]
    , ApiCoinSelection n -> Maybe (NonEmpty ApiCertificate)
certificates :: Maybe (NonEmpty ApiCertificate)
    , ApiCoinSelection n -> [Quantity "lovelace" Natural]
depositsTaken :: ![Quantity "lovelace" Natural]
    , ApiCoinSelection n -> [Quantity "lovelace" Natural]
depositsReturned :: ![Quantity "lovelace" Natural]
    , ApiCoinSelection n -> Maybe ApiBase64
metadata :: !(Maybe ApiBase64)
    } deriving (ApiCoinSelection n -> ApiCoinSelection n -> Bool
(ApiCoinSelection n -> ApiCoinSelection n -> Bool)
-> (ApiCoinSelection n -> ApiCoinSelection n -> Bool)
-> Eq (ApiCoinSelection n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiCoinSelection n -> ApiCoinSelection n -> Bool
/= :: ApiCoinSelection n -> ApiCoinSelection n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiCoinSelection n -> ApiCoinSelection n -> Bool
== :: ApiCoinSelection n -> ApiCoinSelection n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiCoinSelection n -> ApiCoinSelection n -> Bool
Eq, (forall x. ApiCoinSelection n -> Rep (ApiCoinSelection n) x)
-> (forall x. Rep (ApiCoinSelection n) x -> ApiCoinSelection n)
-> Generic (ApiCoinSelection n)
forall x. Rep (ApiCoinSelection n) x -> ApiCoinSelection n
forall x. ApiCoinSelection n -> Rep (ApiCoinSelection n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiCoinSelection n) x -> ApiCoinSelection n
forall (n :: NetworkDiscriminant) x.
ApiCoinSelection n -> Rep (ApiCoinSelection n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiCoinSelection n) x -> ApiCoinSelection n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiCoinSelection n -> Rep (ApiCoinSelection n) x
Generic, Int -> ApiCoinSelection n -> ShowS
[ApiCoinSelection n] -> ShowS
ApiCoinSelection n -> String
(Int -> ApiCoinSelection n -> ShowS)
-> (ApiCoinSelection n -> String)
-> ([ApiCoinSelection n] -> ShowS)
-> Show (ApiCoinSelection n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiCoinSelection n -> ShowS
forall (n :: NetworkDiscriminant). [ApiCoinSelection n] -> ShowS
forall (n :: NetworkDiscriminant). ApiCoinSelection n -> String
showList :: [ApiCoinSelection n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiCoinSelection n] -> ShowS
show :: ApiCoinSelection n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiCoinSelection n -> String
showsPrec :: Int -> ApiCoinSelection n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiCoinSelection n -> ShowS
Show, Typeable)
      deriving anyclass ApiCoinSelection n -> ()
(ApiCoinSelection n -> ()) -> NFData (ApiCoinSelection n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiCoinSelection n -> ()
rnf :: ApiCoinSelection n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiCoinSelection n -> ()
NFData

data ApiCoinSelectionChange (n :: NetworkDiscriminant) = ApiCoinSelectionChange
    { ApiCoinSelectionChange n -> (ApiT Address, Proxy n)
address :: !(ApiT Address, Proxy n)
    , ApiCoinSelectionChange n -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
    , ApiCoinSelectionChange n -> ApiT TokenMap
assets :: !(ApiT W.TokenMap)
    , ApiCoinSelectionChange n -> NonEmpty (ApiT DerivationIndex)
derivationPath :: NonEmpty (ApiT DerivationIndex)
    } deriving (ApiCoinSelectionChange n -> ApiCoinSelectionChange n -> Bool
(ApiCoinSelectionChange n -> ApiCoinSelectionChange n -> Bool)
-> (ApiCoinSelectionChange n -> ApiCoinSelectionChange n -> Bool)
-> Eq (ApiCoinSelectionChange n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiCoinSelectionChange n -> ApiCoinSelectionChange n -> Bool
/= :: ApiCoinSelectionChange n -> ApiCoinSelectionChange n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiCoinSelectionChange n -> ApiCoinSelectionChange n -> Bool
== :: ApiCoinSelectionChange n -> ApiCoinSelectionChange n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiCoinSelectionChange n -> ApiCoinSelectionChange n -> Bool
Eq, (forall x.
 ApiCoinSelectionChange n -> Rep (ApiCoinSelectionChange n) x)
-> (forall x.
    Rep (ApiCoinSelectionChange n) x -> ApiCoinSelectionChange n)
-> Generic (ApiCoinSelectionChange n)
forall x.
Rep (ApiCoinSelectionChange n) x -> ApiCoinSelectionChange n
forall x.
ApiCoinSelectionChange n -> Rep (ApiCoinSelectionChange n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiCoinSelectionChange n) x -> ApiCoinSelectionChange n
forall (n :: NetworkDiscriminant) x.
ApiCoinSelectionChange n -> Rep (ApiCoinSelectionChange n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiCoinSelectionChange n) x -> ApiCoinSelectionChange n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiCoinSelectionChange n -> Rep (ApiCoinSelectionChange n) x
Generic, Int -> ApiCoinSelectionChange n -> ShowS
[ApiCoinSelectionChange n] -> ShowS
ApiCoinSelectionChange n -> String
(Int -> ApiCoinSelectionChange n -> ShowS)
-> (ApiCoinSelectionChange n -> String)
-> ([ApiCoinSelectionChange n] -> ShowS)
-> Show (ApiCoinSelectionChange n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiCoinSelectionChange n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiCoinSelectionChange n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiCoinSelectionChange n -> String
showList :: [ApiCoinSelectionChange n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiCoinSelectionChange n] -> ShowS
show :: ApiCoinSelectionChange n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiCoinSelectionChange n -> String
showsPrec :: Int -> ApiCoinSelectionChange n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiCoinSelectionChange n -> ShowS
Show, Typeable)
      deriving anyclass ApiCoinSelectionChange n -> ()
(ApiCoinSelectionChange n -> ())
-> NFData (ApiCoinSelectionChange n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiCoinSelectionChange n -> ()
rnf :: ApiCoinSelectionChange n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiCoinSelectionChange n -> ()
NFData

data ApiCoinSelectionOutput (n :: NetworkDiscriminant) = ApiCoinSelectionOutput
    { ApiCoinSelectionOutput n -> (ApiT Address, Proxy n)
address :: !(ApiT Address, Proxy n)
    , ApiCoinSelectionOutput n -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
    , ApiCoinSelectionOutput n -> ApiT TokenMap
assets :: !(ApiT W.TokenMap)
    } deriving (ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
(ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool)
-> (ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool)
-> Eq (ApiCoinSelectionOutput n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
/= :: ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
== :: ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
Eq, Eq (ApiCoinSelectionOutput n)
Eq (ApiCoinSelectionOutput n)
-> (ApiCoinSelectionOutput n
    -> ApiCoinSelectionOutput n -> Ordering)
-> (ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool)
-> (ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool)
-> (ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool)
-> (ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool)
-> (ApiCoinSelectionOutput n
    -> ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n)
-> (ApiCoinSelectionOutput n
    -> ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n)
-> Ord (ApiCoinSelectionOutput n)
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Ordering
ApiCoinSelectionOutput n
-> ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (n :: NetworkDiscriminant).
(TypeError ...) =>
Eq (ApiCoinSelectionOutput n)
forall (n :: NetworkDiscriminant).
(TypeError ...) =>
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
forall (n :: NetworkDiscriminant).
(TypeError ...) =>
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Ordering
forall (n :: NetworkDiscriminant).
(TypeError ...) =>
ApiCoinSelectionOutput n
-> ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n
min :: ApiCoinSelectionOutput n
-> ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n
$cmin :: forall (n :: NetworkDiscriminant).
(TypeError ...) =>
ApiCoinSelectionOutput n
-> ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n
max :: ApiCoinSelectionOutput n
-> ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n
$cmax :: forall (n :: NetworkDiscriminant).
(TypeError ...) =>
ApiCoinSelectionOutput n
-> ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n
>= :: ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
$c>= :: forall (n :: NetworkDiscriminant).
(TypeError ...) =>
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
> :: ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
$c> :: forall (n :: NetworkDiscriminant).
(TypeError ...) =>
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
<= :: ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
$c<= :: forall (n :: NetworkDiscriminant).
(TypeError ...) =>
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
< :: ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
$c< :: forall (n :: NetworkDiscriminant).
(TypeError ...) =>
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Bool
compare :: ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Ordering
$ccompare :: forall (n :: NetworkDiscriminant).
(TypeError ...) =>
ApiCoinSelectionOutput n -> ApiCoinSelectionOutput n -> Ordering
$cp1Ord :: forall (n :: NetworkDiscriminant).
(TypeError ...) =>
Eq (ApiCoinSelectionOutput n)
Ord, (forall x.
 ApiCoinSelectionOutput n -> Rep (ApiCoinSelectionOutput n) x)
-> (forall x.
    Rep (ApiCoinSelectionOutput n) x -> ApiCoinSelectionOutput n)
-> Generic (ApiCoinSelectionOutput n)
forall x.
Rep (ApiCoinSelectionOutput n) x -> ApiCoinSelectionOutput n
forall x.
ApiCoinSelectionOutput n -> Rep (ApiCoinSelectionOutput n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiCoinSelectionOutput n) x -> ApiCoinSelectionOutput n
forall (n :: NetworkDiscriminant) x.
ApiCoinSelectionOutput n -> Rep (ApiCoinSelectionOutput n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiCoinSelectionOutput n) x -> ApiCoinSelectionOutput n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiCoinSelectionOutput n -> Rep (ApiCoinSelectionOutput n) x
Generic, Int -> ApiCoinSelectionOutput n -> ShowS
[ApiCoinSelectionOutput n] -> ShowS
ApiCoinSelectionOutput n -> String
(Int -> ApiCoinSelectionOutput n -> ShowS)
-> (ApiCoinSelectionOutput n -> String)
-> ([ApiCoinSelectionOutput n] -> ShowS)
-> Show (ApiCoinSelectionOutput n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiCoinSelectionOutput n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiCoinSelectionOutput n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiCoinSelectionOutput n -> String
showList :: [ApiCoinSelectionOutput n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiCoinSelectionOutput n] -> ShowS
show :: ApiCoinSelectionOutput n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiCoinSelectionOutput n -> String
showsPrec :: Int -> ApiCoinSelectionOutput n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiCoinSelectionOutput n -> ShowS
Show, Typeable)
      deriving anyclass (ApiCoinSelectionOutput n -> ()
(ApiCoinSelectionOutput n -> ())
-> NFData (ApiCoinSelectionOutput n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiCoinSelectionOutput n -> ()
rnf :: ApiCoinSelectionOutput n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiCoinSelectionOutput n -> ()
NFData, Int -> ApiCoinSelectionOutput n -> Int
ApiCoinSelectionOutput n -> Int
(Int -> ApiCoinSelectionOutput n -> Int)
-> (ApiCoinSelectionOutput n -> Int)
-> Hashable (ApiCoinSelectionOutput n)
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (n :: NetworkDiscriminant).
Int -> ApiCoinSelectionOutput n -> Int
forall (n :: NetworkDiscriminant). ApiCoinSelectionOutput n -> Int
hash :: ApiCoinSelectionOutput n -> Int
$chash :: forall (n :: NetworkDiscriminant). ApiCoinSelectionOutput n -> Int
hashWithSalt :: Int -> ApiCoinSelectionOutput n -> Int
$chashWithSalt :: forall (n :: NetworkDiscriminant).
Int -> ApiCoinSelectionOutput n -> Int
Hashable)

data ApiCoinSelectionCollateral (n :: NetworkDiscriminant) =
    ApiCoinSelectionCollateral
        { ApiCoinSelectionCollateral n -> ApiT (Hash "Tx")
id :: !(ApiT (Hash "Tx"))
        , ApiCoinSelectionCollateral n -> Word32
index :: !Word32
        , ApiCoinSelectionCollateral n -> (ApiT Address, Proxy n)
address :: !(ApiT Address, Proxy n)
        , ApiCoinSelectionCollateral n -> NonEmpty (ApiT DerivationIndex)
derivationPath :: NonEmpty (ApiT DerivationIndex)
        , ApiCoinSelectionCollateral n -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
        }
    deriving (ApiCoinSelectionCollateral n
-> ApiCoinSelectionCollateral n -> Bool
(ApiCoinSelectionCollateral n
 -> ApiCoinSelectionCollateral n -> Bool)
-> (ApiCoinSelectionCollateral n
    -> ApiCoinSelectionCollateral n -> Bool)
-> Eq (ApiCoinSelectionCollateral n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiCoinSelectionCollateral n
-> ApiCoinSelectionCollateral n -> Bool
/= :: ApiCoinSelectionCollateral n
-> ApiCoinSelectionCollateral n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiCoinSelectionCollateral n
-> ApiCoinSelectionCollateral n -> Bool
== :: ApiCoinSelectionCollateral n
-> ApiCoinSelectionCollateral n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiCoinSelectionCollateral n
-> ApiCoinSelectionCollateral n -> Bool
Eq, (forall x.
 ApiCoinSelectionCollateral n
 -> Rep (ApiCoinSelectionCollateral n) x)
-> (forall x.
    Rep (ApiCoinSelectionCollateral n) x
    -> ApiCoinSelectionCollateral n)
-> Generic (ApiCoinSelectionCollateral n)
forall x.
Rep (ApiCoinSelectionCollateral n) x
-> ApiCoinSelectionCollateral n
forall x.
ApiCoinSelectionCollateral n
-> Rep (ApiCoinSelectionCollateral n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiCoinSelectionCollateral n) x
-> ApiCoinSelectionCollateral n
forall (n :: NetworkDiscriminant) x.
ApiCoinSelectionCollateral n
-> Rep (ApiCoinSelectionCollateral n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiCoinSelectionCollateral n) x
-> ApiCoinSelectionCollateral n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiCoinSelectionCollateral n
-> Rep (ApiCoinSelectionCollateral n) x
Generic, Int -> ApiCoinSelectionCollateral n -> ShowS
[ApiCoinSelectionCollateral n] -> ShowS
ApiCoinSelectionCollateral n -> String
(Int -> ApiCoinSelectionCollateral n -> ShowS)
-> (ApiCoinSelectionCollateral n -> String)
-> ([ApiCoinSelectionCollateral n] -> ShowS)
-> Show (ApiCoinSelectionCollateral n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiCoinSelectionCollateral n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiCoinSelectionCollateral n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiCoinSelectionCollateral n -> String
showList :: [ApiCoinSelectionCollateral n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiCoinSelectionCollateral n] -> ShowS
show :: ApiCoinSelectionCollateral n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiCoinSelectionCollateral n -> String
showsPrec :: Int -> ApiCoinSelectionCollateral n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiCoinSelectionCollateral n -> ShowS
Show, Typeable)
    deriving anyclass ApiCoinSelectionCollateral n -> ()
(ApiCoinSelectionCollateral n -> ())
-> NFData (ApiCoinSelectionCollateral n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant).
ApiCoinSelectionCollateral n -> ()
rnf :: ApiCoinSelectionCollateral n -> ()
$crnf :: forall (n :: NetworkDiscriminant).
ApiCoinSelectionCollateral n -> ()
NFData

data ApiWallet = ApiWallet
    { ApiWallet -> ApiT WalletId
id :: !(ApiT WalletId)
    , ApiWallet -> ApiT AddressPoolGap
addressPoolGap :: !(ApiT AddressPoolGap)
    , ApiWallet -> ApiWalletBalance
balance :: !ApiWalletBalance
    , ApiWallet -> ApiWalletAssetsBalance
assets :: !ApiWalletAssetsBalance
    , ApiWallet -> ApiWalletDelegation
delegation :: !ApiWalletDelegation
    , ApiWallet -> ApiT WalletName
name :: !(ApiT WalletName)
    , ApiWallet -> Maybe ApiWalletPassphraseInfo
passphrase :: !(Maybe ApiWalletPassphraseInfo)
    , ApiWallet -> ApiT SyncProgress
state :: !(ApiT SyncProgress)
    , ApiWallet -> ApiBlockReference
tip :: !ApiBlockReference
    } deriving (ApiWallet -> ApiWallet -> Bool
(ApiWallet -> ApiWallet -> Bool)
-> (ApiWallet -> ApiWallet -> Bool) -> Eq ApiWallet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWallet -> ApiWallet -> Bool
$c/= :: ApiWallet -> ApiWallet -> Bool
== :: ApiWallet -> ApiWallet -> Bool
$c== :: ApiWallet -> ApiWallet -> Bool
Eq, (forall x. ApiWallet -> Rep ApiWallet x)
-> (forall x. Rep ApiWallet x -> ApiWallet) -> Generic ApiWallet
forall x. Rep ApiWallet x -> ApiWallet
forall x. ApiWallet -> Rep ApiWallet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWallet x -> ApiWallet
$cfrom :: forall x. ApiWallet -> Rep ApiWallet x
Generic, Int -> ApiWallet -> ShowS
[ApiWallet] -> ShowS
ApiWallet -> String
(Int -> ApiWallet -> ShowS)
-> (ApiWallet -> String)
-> ([ApiWallet] -> ShowS)
-> Show ApiWallet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWallet] -> ShowS
$cshowList :: [ApiWallet] -> ShowS
show :: ApiWallet -> String
$cshow :: ApiWallet -> String
showsPrec :: Int -> ApiWallet -> ShowS
$cshowsPrec :: Int -> ApiWallet -> ShowS
Show)
      deriving anyclass ApiWallet -> ()
(ApiWallet -> ()) -> NFData ApiWallet
forall a. (a -> ()) -> NFData a
rnf :: ApiWallet -> ()
$crnf :: ApiWallet -> ()
NFData

data ApiWalletBalance = ApiWalletBalance
    { ApiWalletBalance -> Quantity "lovelace" Natural
available :: !(Quantity "lovelace" Natural)
    , ApiWalletBalance -> Quantity "lovelace" Natural
total :: !(Quantity "lovelace" Natural)
    , ApiWalletBalance -> Quantity "lovelace" Natural
reward :: !(Quantity "lovelace" Natural)
    } deriving (ApiWalletBalance -> ApiWalletBalance -> Bool
(ApiWalletBalance -> ApiWalletBalance -> Bool)
-> (ApiWalletBalance -> ApiWalletBalance -> Bool)
-> Eq ApiWalletBalance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletBalance -> ApiWalletBalance -> Bool
$c/= :: ApiWalletBalance -> ApiWalletBalance -> Bool
== :: ApiWalletBalance -> ApiWalletBalance -> Bool
$c== :: ApiWalletBalance -> ApiWalletBalance -> Bool
Eq, (forall x. ApiWalletBalance -> Rep ApiWalletBalance x)
-> (forall x. Rep ApiWalletBalance x -> ApiWalletBalance)
-> Generic ApiWalletBalance
forall x. Rep ApiWalletBalance x -> ApiWalletBalance
forall x. ApiWalletBalance -> Rep ApiWalletBalance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWalletBalance x -> ApiWalletBalance
$cfrom :: forall x. ApiWalletBalance -> Rep ApiWalletBalance x
Generic, Int -> ApiWalletBalance -> ShowS
[ApiWalletBalance] -> ShowS
ApiWalletBalance -> String
(Int -> ApiWalletBalance -> ShowS)
-> (ApiWalletBalance -> String)
-> ([ApiWalletBalance] -> ShowS)
-> Show ApiWalletBalance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletBalance] -> ShowS
$cshowList :: [ApiWalletBalance] -> ShowS
show :: ApiWalletBalance -> String
$cshow :: ApiWalletBalance -> String
showsPrec :: Int -> ApiWalletBalance -> ShowS
$cshowsPrec :: Int -> ApiWalletBalance -> ShowS
Show)
      deriving anyclass ApiWalletBalance -> ()
(ApiWalletBalance -> ()) -> NFData ApiWalletBalance
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletBalance -> ()
$crnf :: ApiWalletBalance -> ()
NFData

data ApiWalletAssetsBalance = ApiWalletAssetsBalance
    { ApiWalletAssetsBalance -> ApiT TokenMap
available :: !(ApiT W.TokenMap)
    , ApiWalletAssetsBalance -> ApiT TokenMap
total :: !(ApiT W.TokenMap)
    } deriving (ApiWalletAssetsBalance -> ApiWalletAssetsBalance -> Bool
(ApiWalletAssetsBalance -> ApiWalletAssetsBalance -> Bool)
-> (ApiWalletAssetsBalance -> ApiWalletAssetsBalance -> Bool)
-> Eq ApiWalletAssetsBalance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletAssetsBalance -> ApiWalletAssetsBalance -> Bool
$c/= :: ApiWalletAssetsBalance -> ApiWalletAssetsBalance -> Bool
== :: ApiWalletAssetsBalance -> ApiWalletAssetsBalance -> Bool
$c== :: ApiWalletAssetsBalance -> ApiWalletAssetsBalance -> Bool
Eq, (forall x. ApiWalletAssetsBalance -> Rep ApiWalletAssetsBalance x)
-> (forall x.
    Rep ApiWalletAssetsBalance x -> ApiWalletAssetsBalance)
-> Generic ApiWalletAssetsBalance
forall x. Rep ApiWalletAssetsBalance x -> ApiWalletAssetsBalance
forall x. ApiWalletAssetsBalance -> Rep ApiWalletAssetsBalance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWalletAssetsBalance x -> ApiWalletAssetsBalance
$cfrom :: forall x. ApiWalletAssetsBalance -> Rep ApiWalletAssetsBalance x
Generic, Int -> ApiWalletAssetsBalance -> ShowS
[ApiWalletAssetsBalance] -> ShowS
ApiWalletAssetsBalance -> String
(Int -> ApiWalletAssetsBalance -> ShowS)
-> (ApiWalletAssetsBalance -> String)
-> ([ApiWalletAssetsBalance] -> ShowS)
-> Show ApiWalletAssetsBalance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletAssetsBalance] -> ShowS
$cshowList :: [ApiWalletAssetsBalance] -> ShowS
show :: ApiWalletAssetsBalance -> String
$cshow :: ApiWalletAssetsBalance -> String
showsPrec :: Int -> ApiWalletAssetsBalance -> ShowS
$cshowsPrec :: Int -> ApiWalletAssetsBalance -> ShowS
Show)
      deriving anyclass ApiWalletAssetsBalance -> ()
(ApiWalletAssetsBalance -> ()) -> NFData ApiWalletAssetsBalance
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletAssetsBalance -> ()
$crnf :: ApiWalletAssetsBalance -> ()
NFData

newtype ApiWalletPassphraseInfo = ApiWalletPassphraseInfo
    { ApiWalletPassphraseInfo -> UTCTime
lastUpdatedAt :: UTCTime
    }
    deriving (ApiWalletPassphraseInfo -> ApiWalletPassphraseInfo -> Bool
(ApiWalletPassphraseInfo -> ApiWalletPassphraseInfo -> Bool)
-> (ApiWalletPassphraseInfo -> ApiWalletPassphraseInfo -> Bool)
-> Eq ApiWalletPassphraseInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletPassphraseInfo -> ApiWalletPassphraseInfo -> Bool
$c/= :: ApiWalletPassphraseInfo -> ApiWalletPassphraseInfo -> Bool
== :: ApiWalletPassphraseInfo -> ApiWalletPassphraseInfo -> Bool
$c== :: ApiWalletPassphraseInfo -> ApiWalletPassphraseInfo -> Bool
Eq, (forall x.
 ApiWalletPassphraseInfo -> Rep ApiWalletPassphraseInfo x)
-> (forall x.
    Rep ApiWalletPassphraseInfo x -> ApiWalletPassphraseInfo)
-> Generic ApiWalletPassphraseInfo
forall x. Rep ApiWalletPassphraseInfo x -> ApiWalletPassphraseInfo
forall x. ApiWalletPassphraseInfo -> Rep ApiWalletPassphraseInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWalletPassphraseInfo x -> ApiWalletPassphraseInfo
$cfrom :: forall x. ApiWalletPassphraseInfo -> Rep ApiWalletPassphraseInfo x
Generic)
    deriving anyclass ApiWalletPassphraseInfo -> ()
(ApiWalletPassphraseInfo -> ()) -> NFData ApiWalletPassphraseInfo
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletPassphraseInfo -> ()
$crnf :: ApiWalletPassphraseInfo -> ()
NFData
    deriving Int -> ApiWalletPassphraseInfo -> ShowS
[ApiWalletPassphraseInfo] -> ShowS
ApiWalletPassphraseInfo -> String
(Int -> ApiWalletPassphraseInfo -> ShowS)
-> (ApiWalletPassphraseInfo -> String)
-> ([ApiWalletPassphraseInfo] -> ShowS)
-> Show ApiWalletPassphraseInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletPassphraseInfo] -> ShowS
$cshowList :: [ApiWalletPassphraseInfo] -> ShowS
show :: ApiWalletPassphraseInfo -> String
$cshow :: ApiWalletPassphraseInfo -> String
showsPrec :: Int -> ApiWalletPassphraseInfo -> ShowS
$cshowsPrec :: Int -> ApiWalletPassphraseInfo -> ShowS
Show via (Quiet ApiWalletPassphraseInfo)

data ApiWalletDelegation = ApiWalletDelegation
    { ApiWalletDelegation -> ApiWalletDelegationNext
active :: !ApiWalletDelegationNext
    , ApiWalletDelegation -> [ApiWalletDelegationNext]
next :: ![ApiWalletDelegationNext]
    } deriving (ApiWalletDelegation -> ApiWalletDelegation -> Bool
(ApiWalletDelegation -> ApiWalletDelegation -> Bool)
-> (ApiWalletDelegation -> ApiWalletDelegation -> Bool)
-> Eq ApiWalletDelegation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletDelegation -> ApiWalletDelegation -> Bool
$c/= :: ApiWalletDelegation -> ApiWalletDelegation -> Bool
== :: ApiWalletDelegation -> ApiWalletDelegation -> Bool
$c== :: ApiWalletDelegation -> ApiWalletDelegation -> Bool
Eq, (forall x. ApiWalletDelegation -> Rep ApiWalletDelegation x)
-> (forall x. Rep ApiWalletDelegation x -> ApiWalletDelegation)
-> Generic ApiWalletDelegation
forall x. Rep ApiWalletDelegation x -> ApiWalletDelegation
forall x. ApiWalletDelegation -> Rep ApiWalletDelegation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWalletDelegation x -> ApiWalletDelegation
$cfrom :: forall x. ApiWalletDelegation -> Rep ApiWalletDelegation x
Generic, Int -> ApiWalletDelegation -> ShowS
[ApiWalletDelegation] -> ShowS
ApiWalletDelegation -> String
(Int -> ApiWalletDelegation -> ShowS)
-> (ApiWalletDelegation -> String)
-> ([ApiWalletDelegation] -> ShowS)
-> Show ApiWalletDelegation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletDelegation] -> ShowS
$cshowList :: [ApiWalletDelegation] -> ShowS
show :: ApiWalletDelegation -> String
$cshow :: ApiWalletDelegation -> String
showsPrec :: Int -> ApiWalletDelegation -> ShowS
$cshowsPrec :: Int -> ApiWalletDelegation -> ShowS
Show)
      deriving anyclass ApiWalletDelegation -> ()
(ApiWalletDelegation -> ()) -> NFData ApiWalletDelegation
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletDelegation -> ()
$crnf :: ApiWalletDelegation -> ()
NFData

data ApiWalletDelegationNext = ApiWalletDelegationNext
    { ApiWalletDelegationNext -> ApiWalletDelegationStatus
status :: !ApiWalletDelegationStatus
    , ApiWalletDelegationNext -> Maybe (ApiT PoolId)
target :: !(Maybe (ApiT PoolId))
    , ApiWalletDelegationNext -> Maybe ApiEpochInfo
changesAt :: !(Maybe ApiEpochInfo)
    } deriving (ApiWalletDelegationNext -> ApiWalletDelegationNext -> Bool
(ApiWalletDelegationNext -> ApiWalletDelegationNext -> Bool)
-> (ApiWalletDelegationNext -> ApiWalletDelegationNext -> Bool)
-> Eq ApiWalletDelegationNext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletDelegationNext -> ApiWalletDelegationNext -> Bool
$c/= :: ApiWalletDelegationNext -> ApiWalletDelegationNext -> Bool
== :: ApiWalletDelegationNext -> ApiWalletDelegationNext -> Bool
$c== :: ApiWalletDelegationNext -> ApiWalletDelegationNext -> Bool
Eq, (forall x.
 ApiWalletDelegationNext -> Rep ApiWalletDelegationNext x)
-> (forall x.
    Rep ApiWalletDelegationNext x -> ApiWalletDelegationNext)
-> Generic ApiWalletDelegationNext
forall x. Rep ApiWalletDelegationNext x -> ApiWalletDelegationNext
forall x. ApiWalletDelegationNext -> Rep ApiWalletDelegationNext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWalletDelegationNext x -> ApiWalletDelegationNext
$cfrom :: forall x. ApiWalletDelegationNext -> Rep ApiWalletDelegationNext x
Generic, Int -> ApiWalletDelegationNext -> ShowS
[ApiWalletDelegationNext] -> ShowS
ApiWalletDelegationNext -> String
(Int -> ApiWalletDelegationNext -> ShowS)
-> (ApiWalletDelegationNext -> String)
-> ([ApiWalletDelegationNext] -> ShowS)
-> Show ApiWalletDelegationNext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletDelegationNext] -> ShowS
$cshowList :: [ApiWalletDelegationNext] -> ShowS
show :: ApiWalletDelegationNext -> String
$cshow :: ApiWalletDelegationNext -> String
showsPrec :: Int -> ApiWalletDelegationNext -> ShowS
$cshowsPrec :: Int -> ApiWalletDelegationNext -> ShowS
Show)
      deriving anyclass ApiWalletDelegationNext -> ()
(ApiWalletDelegationNext -> ()) -> NFData ApiWalletDelegationNext
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletDelegationNext -> ()
$crnf :: ApiWalletDelegationNext -> ()
NFData

data ApiWalletDelegationStatus
    = NotDelegating
    | Delegating
    deriving (ApiWalletDelegationStatus -> ApiWalletDelegationStatus -> Bool
(ApiWalletDelegationStatus -> ApiWalletDelegationStatus -> Bool)
-> (ApiWalletDelegationStatus -> ApiWalletDelegationStatus -> Bool)
-> Eq ApiWalletDelegationStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletDelegationStatus -> ApiWalletDelegationStatus -> Bool
$c/= :: ApiWalletDelegationStatus -> ApiWalletDelegationStatus -> Bool
== :: ApiWalletDelegationStatus -> ApiWalletDelegationStatus -> Bool
$c== :: ApiWalletDelegationStatus -> ApiWalletDelegationStatus -> Bool
Eq, (forall x.
 ApiWalletDelegationStatus -> Rep ApiWalletDelegationStatus x)
-> (forall x.
    Rep ApiWalletDelegationStatus x -> ApiWalletDelegationStatus)
-> Generic ApiWalletDelegationStatus
forall x.
Rep ApiWalletDelegationStatus x -> ApiWalletDelegationStatus
forall x.
ApiWalletDelegationStatus -> Rep ApiWalletDelegationStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiWalletDelegationStatus x -> ApiWalletDelegationStatus
$cfrom :: forall x.
ApiWalletDelegationStatus -> Rep ApiWalletDelegationStatus x
Generic, Int -> ApiWalletDelegationStatus -> ShowS
[ApiWalletDelegationStatus] -> ShowS
ApiWalletDelegationStatus -> String
(Int -> ApiWalletDelegationStatus -> ShowS)
-> (ApiWalletDelegationStatus -> String)
-> ([ApiWalletDelegationStatus] -> ShowS)
-> Show ApiWalletDelegationStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletDelegationStatus] -> ShowS
$cshowList :: [ApiWalletDelegationStatus] -> ShowS
show :: ApiWalletDelegationStatus -> String
$cshow :: ApiWalletDelegationStatus -> String
showsPrec :: Int -> ApiWalletDelegationStatus -> ShowS
$cshowsPrec :: Int -> ApiWalletDelegationStatus -> ShowS
Show)
    deriving anyclass ApiWalletDelegationStatus -> ()
(ApiWalletDelegationStatus -> ())
-> NFData ApiWalletDelegationStatus
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletDelegationStatus -> ()
$crnf :: ApiWalletDelegationStatus -> ()
NFData

newtype ApiWalletPassphrase = ApiWalletPassphrase
    { ApiWalletPassphrase -> ApiT (Passphrase "lenient")
passphrase :: ApiT (Passphrase "lenient")
    }
    deriving (ApiWalletPassphrase -> ApiWalletPassphrase -> Bool
(ApiWalletPassphrase -> ApiWalletPassphrase -> Bool)
-> (ApiWalletPassphrase -> ApiWalletPassphrase -> Bool)
-> Eq ApiWalletPassphrase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletPassphrase -> ApiWalletPassphrase -> Bool
$c/= :: ApiWalletPassphrase -> ApiWalletPassphrase -> Bool
== :: ApiWalletPassphrase -> ApiWalletPassphrase -> Bool
$c== :: ApiWalletPassphrase -> ApiWalletPassphrase -> Bool
Eq, (forall x. ApiWalletPassphrase -> Rep ApiWalletPassphrase x)
-> (forall x. Rep ApiWalletPassphrase x -> ApiWalletPassphrase)
-> Generic ApiWalletPassphrase
forall x. Rep ApiWalletPassphrase x -> ApiWalletPassphrase
forall x. ApiWalletPassphrase -> Rep ApiWalletPassphrase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWalletPassphrase x -> ApiWalletPassphrase
$cfrom :: forall x. ApiWalletPassphrase -> Rep ApiWalletPassphrase x
Generic)
    deriving anyclass ApiWalletPassphrase -> ()
(ApiWalletPassphrase -> ()) -> NFData ApiWalletPassphrase
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletPassphrase -> ()
$crnf :: ApiWalletPassphrase -> ()
NFData
    deriving Int -> ApiWalletPassphrase -> ShowS
[ApiWalletPassphrase] -> ShowS
ApiWalletPassphrase -> String
(Int -> ApiWalletPassphrase -> ShowS)
-> (ApiWalletPassphrase -> String)
-> ([ApiWalletPassphrase] -> ShowS)
-> Show ApiWalletPassphrase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletPassphrase] -> ShowS
$cshowList :: [ApiWalletPassphrase] -> ShowS
show :: ApiWalletPassphrase -> String
$cshow :: ApiWalletPassphrase -> String
showsPrec :: Int -> ApiWalletPassphrase -> ShowS
$cshowsPrec :: Int -> ApiWalletPassphrase -> ShowS
Show via (Quiet ApiWalletPassphrase)

newtype ApiWalletUtxoSnapshot = ApiWalletUtxoSnapshot
    { ApiWalletUtxoSnapshot -> [ApiWalletUtxoSnapshotEntry]
entries :: [ApiWalletUtxoSnapshotEntry]
    }
    deriving (ApiWalletUtxoSnapshot -> ApiWalletUtxoSnapshot -> Bool
(ApiWalletUtxoSnapshot -> ApiWalletUtxoSnapshot -> Bool)
-> (ApiWalletUtxoSnapshot -> ApiWalletUtxoSnapshot -> Bool)
-> Eq ApiWalletUtxoSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletUtxoSnapshot -> ApiWalletUtxoSnapshot -> Bool
$c/= :: ApiWalletUtxoSnapshot -> ApiWalletUtxoSnapshot -> Bool
== :: ApiWalletUtxoSnapshot -> ApiWalletUtxoSnapshot -> Bool
$c== :: ApiWalletUtxoSnapshot -> ApiWalletUtxoSnapshot -> Bool
Eq, (forall x. ApiWalletUtxoSnapshot -> Rep ApiWalletUtxoSnapshot x)
-> (forall x. Rep ApiWalletUtxoSnapshot x -> ApiWalletUtxoSnapshot)
-> Generic ApiWalletUtxoSnapshot
forall x. Rep ApiWalletUtxoSnapshot x -> ApiWalletUtxoSnapshot
forall x. ApiWalletUtxoSnapshot -> Rep ApiWalletUtxoSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWalletUtxoSnapshot x -> ApiWalletUtxoSnapshot
$cfrom :: forall x. ApiWalletUtxoSnapshot -> Rep ApiWalletUtxoSnapshot x
Generic)
    deriving anyclass ApiWalletUtxoSnapshot -> ()
(ApiWalletUtxoSnapshot -> ()) -> NFData ApiWalletUtxoSnapshot
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletUtxoSnapshot -> ()
$crnf :: ApiWalletUtxoSnapshot -> ()
NFData
    deriving Int -> ApiWalletUtxoSnapshot -> ShowS
[ApiWalletUtxoSnapshot] -> ShowS
ApiWalletUtxoSnapshot -> String
(Int -> ApiWalletUtxoSnapshot -> ShowS)
-> (ApiWalletUtxoSnapshot -> String)
-> ([ApiWalletUtxoSnapshot] -> ShowS)
-> Show ApiWalletUtxoSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletUtxoSnapshot] -> ShowS
$cshowList :: [ApiWalletUtxoSnapshot] -> ShowS
show :: ApiWalletUtxoSnapshot -> String
$cshow :: ApiWalletUtxoSnapshot -> String
showsPrec :: Int -> ApiWalletUtxoSnapshot -> ShowS
$cshowsPrec :: Int -> ApiWalletUtxoSnapshot -> ShowS
Show via (Quiet ApiWalletUtxoSnapshot)

data ApiWalletUtxoSnapshotEntry = ApiWalletUtxoSnapshotEntry
    { ApiWalletUtxoSnapshotEntry -> Quantity "lovelace" Natural
ada :: !(Quantity "lovelace" Natural)
    , ApiWalletUtxoSnapshotEntry -> Quantity "lovelace" Natural
adaMinimum :: !(Quantity "lovelace" Natural)
    , ApiWalletUtxoSnapshotEntry -> ApiT TokenMap
assets :: !(ApiT W.TokenMap)
    }
    deriving (ApiWalletUtxoSnapshotEntry -> ApiWalletUtxoSnapshotEntry -> Bool
(ApiWalletUtxoSnapshotEntry -> ApiWalletUtxoSnapshotEntry -> Bool)
-> (ApiWalletUtxoSnapshotEntry
    -> ApiWalletUtxoSnapshotEntry -> Bool)
-> Eq ApiWalletUtxoSnapshotEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletUtxoSnapshotEntry -> ApiWalletUtxoSnapshotEntry -> Bool
$c/= :: ApiWalletUtxoSnapshotEntry -> ApiWalletUtxoSnapshotEntry -> Bool
== :: ApiWalletUtxoSnapshotEntry -> ApiWalletUtxoSnapshotEntry -> Bool
$c== :: ApiWalletUtxoSnapshotEntry -> ApiWalletUtxoSnapshotEntry -> Bool
Eq, (forall x.
 ApiWalletUtxoSnapshotEntry -> Rep ApiWalletUtxoSnapshotEntry x)
-> (forall x.
    Rep ApiWalletUtxoSnapshotEntry x -> ApiWalletUtxoSnapshotEntry)
-> Generic ApiWalletUtxoSnapshotEntry
forall x.
Rep ApiWalletUtxoSnapshotEntry x -> ApiWalletUtxoSnapshotEntry
forall x.
ApiWalletUtxoSnapshotEntry -> Rep ApiWalletUtxoSnapshotEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiWalletUtxoSnapshotEntry x -> ApiWalletUtxoSnapshotEntry
$cfrom :: forall x.
ApiWalletUtxoSnapshotEntry -> Rep ApiWalletUtxoSnapshotEntry x
Generic, Int -> ApiWalletUtxoSnapshotEntry -> ShowS
[ApiWalletUtxoSnapshotEntry] -> ShowS
ApiWalletUtxoSnapshotEntry -> String
(Int -> ApiWalletUtxoSnapshotEntry -> ShowS)
-> (ApiWalletUtxoSnapshotEntry -> String)
-> ([ApiWalletUtxoSnapshotEntry] -> ShowS)
-> Show ApiWalletUtxoSnapshotEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletUtxoSnapshotEntry] -> ShowS
$cshowList :: [ApiWalletUtxoSnapshotEntry] -> ShowS
show :: ApiWalletUtxoSnapshotEntry -> String
$cshow :: ApiWalletUtxoSnapshotEntry -> String
showsPrec :: Int -> ApiWalletUtxoSnapshotEntry -> ShowS
$cshowsPrec :: Int -> ApiWalletUtxoSnapshotEntry -> ShowS
Show)
    deriving anyclass ApiWalletUtxoSnapshotEntry -> ()
(ApiWalletUtxoSnapshotEntry -> ())
-> NFData ApiWalletUtxoSnapshotEntry
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletUtxoSnapshotEntry -> ()
$crnf :: ApiWalletUtxoSnapshotEntry -> ()
NFData

data ApiStakePool = ApiStakePool
    { ApiStakePool -> ApiT PoolId
id :: !(ApiT PoolId)
    , ApiStakePool -> ApiStakePoolMetrics
metrics :: !ApiStakePoolMetrics
    , ApiStakePool -> Maybe (ApiT StakePoolMetadata)
metadata :: !(Maybe (ApiT StakePoolMetadata))
    , ApiStakePool -> Quantity "lovelace" Natural
cost :: !(Quantity "lovelace" Natural)
    , ApiStakePool -> Quantity "percent" Percentage
margin :: !(Quantity "percent" Percentage)
    , ApiStakePool -> Quantity "lovelace" Natural
pledge :: !(Quantity "lovelace" Natural)
    , ApiStakePool -> Maybe ApiEpochInfo
retirement :: !(Maybe ApiEpochInfo)
    , ApiStakePool -> [ApiStakePoolFlag]
flags :: ![ApiStakePoolFlag]
    } deriving (ApiStakePool -> ApiStakePool -> Bool
(ApiStakePool -> ApiStakePool -> Bool)
-> (ApiStakePool -> ApiStakePool -> Bool) -> Eq ApiStakePool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiStakePool -> ApiStakePool -> Bool
$c/= :: ApiStakePool -> ApiStakePool -> Bool
== :: ApiStakePool -> ApiStakePool -> Bool
$c== :: ApiStakePool -> ApiStakePool -> Bool
Eq, (forall x. ApiStakePool -> Rep ApiStakePool x)
-> (forall x. Rep ApiStakePool x -> ApiStakePool)
-> Generic ApiStakePool
forall x. Rep ApiStakePool x -> ApiStakePool
forall x. ApiStakePool -> Rep ApiStakePool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiStakePool x -> ApiStakePool
$cfrom :: forall x. ApiStakePool -> Rep ApiStakePool x
Generic, Int -> ApiStakePool -> ShowS
[ApiStakePool] -> ShowS
ApiStakePool -> String
(Int -> ApiStakePool -> ShowS)
-> (ApiStakePool -> String)
-> ([ApiStakePool] -> ShowS)
-> Show ApiStakePool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiStakePool] -> ShowS
$cshowList :: [ApiStakePool] -> ShowS
show :: ApiStakePool -> String
$cshow :: ApiStakePool -> String
showsPrec :: Int -> ApiStakePool -> ShowS
$cshowsPrec :: Int -> ApiStakePool -> ShowS
Show)

data ApiStakePoolFlag
    = Delisted
    deriving stock (ApiStakePoolFlag -> ApiStakePoolFlag -> Bool
(ApiStakePoolFlag -> ApiStakePoolFlag -> Bool)
-> (ApiStakePoolFlag -> ApiStakePoolFlag -> Bool)
-> Eq ApiStakePoolFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiStakePoolFlag -> ApiStakePoolFlag -> Bool
$c/= :: ApiStakePoolFlag -> ApiStakePoolFlag -> Bool
== :: ApiStakePoolFlag -> ApiStakePoolFlag -> Bool
$c== :: ApiStakePoolFlag -> ApiStakePoolFlag -> Bool
Eq, (forall x. ApiStakePoolFlag -> Rep ApiStakePoolFlag x)
-> (forall x. Rep ApiStakePoolFlag x -> ApiStakePoolFlag)
-> Generic ApiStakePoolFlag
forall x. Rep ApiStakePoolFlag x -> ApiStakePoolFlag
forall x. ApiStakePoolFlag -> Rep ApiStakePoolFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiStakePoolFlag x -> ApiStakePoolFlag
$cfrom :: forall x. ApiStakePoolFlag -> Rep ApiStakePoolFlag x
Generic, Int -> ApiStakePoolFlag -> ShowS
[ApiStakePoolFlag] -> ShowS
ApiStakePoolFlag -> String
(Int -> ApiStakePoolFlag -> ShowS)
-> (ApiStakePoolFlag -> String)
-> ([ApiStakePoolFlag] -> ShowS)
-> Show ApiStakePoolFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiStakePoolFlag] -> ShowS
$cshowList :: [ApiStakePoolFlag] -> ShowS
show :: ApiStakePoolFlag -> String
$cshow :: ApiStakePoolFlag -> String
showsPrec :: Int -> ApiStakePoolFlag -> ShowS
$cshowsPrec :: Int -> ApiStakePoolFlag -> ShowS
Show)
    deriving anyclass ApiStakePoolFlag -> ()
(ApiStakePoolFlag -> ()) -> NFData ApiStakePoolFlag
forall a. (a -> ()) -> NFData a
rnf :: ApiStakePoolFlag -> ()
$crnf :: ApiStakePoolFlag -> ()
NFData

data ApiStakePoolMetrics = ApiStakePoolMetrics
    { ApiStakePoolMetrics -> Quantity "lovelace" Natural
nonMyopicMemberRewards :: !(Quantity "lovelace" Natural)
    , ApiStakePoolMetrics -> Quantity "percent" Percentage
relativeStake :: !(Quantity "percent" Percentage)
    , ApiStakePoolMetrics -> Double
saturation :: !Double
    , ApiStakePoolMetrics -> Quantity "block" Natural
producedBlocks :: !(Quantity "block" Natural)
    } deriving (ApiStakePoolMetrics -> ApiStakePoolMetrics -> Bool
(ApiStakePoolMetrics -> ApiStakePoolMetrics -> Bool)
-> (ApiStakePoolMetrics -> ApiStakePoolMetrics -> Bool)
-> Eq ApiStakePoolMetrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiStakePoolMetrics -> ApiStakePoolMetrics -> Bool
$c/= :: ApiStakePoolMetrics -> ApiStakePoolMetrics -> Bool
== :: ApiStakePoolMetrics -> ApiStakePoolMetrics -> Bool
$c== :: ApiStakePoolMetrics -> ApiStakePoolMetrics -> Bool
Eq, (forall x. ApiStakePoolMetrics -> Rep ApiStakePoolMetrics x)
-> (forall x. Rep ApiStakePoolMetrics x -> ApiStakePoolMetrics)
-> Generic ApiStakePoolMetrics
forall x. Rep ApiStakePoolMetrics x -> ApiStakePoolMetrics
forall x. ApiStakePoolMetrics -> Rep ApiStakePoolMetrics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiStakePoolMetrics x -> ApiStakePoolMetrics
$cfrom :: forall x. ApiStakePoolMetrics -> Rep ApiStakePoolMetrics x
Generic, Int -> ApiStakePoolMetrics -> ShowS
[ApiStakePoolMetrics] -> ShowS
ApiStakePoolMetrics -> String
(Int -> ApiStakePoolMetrics -> ShowS)
-> (ApiStakePoolMetrics -> String)
-> ([ApiStakePoolMetrics] -> ShowS)
-> Show ApiStakePoolMetrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiStakePoolMetrics] -> ShowS
$cshowList :: [ApiStakePoolMetrics] -> ShowS
show :: ApiStakePoolMetrics -> String
$cshow :: ApiStakePoolMetrics -> String
showsPrec :: Int -> ApiStakePoolMetrics -> ShowS
$cshowsPrec :: Int -> ApiStakePoolMetrics -> ShowS
Show)
      deriving anyclass ApiStakePoolMetrics -> ()
(ApiStakePoolMetrics -> ()) -> NFData ApiStakePoolMetrics
forall a. (a -> ()) -> NFData a
rnf :: ApiStakePoolMetrics -> ()
$crnf :: ApiStakePoolMetrics -> ()
NFData

data ApiUtxoStatistics = ApiUtxoStatistics
    { ApiUtxoStatistics -> Quantity "lovelace" Natural
total :: !(Quantity "lovelace" Natural)
    , ApiUtxoStatistics -> ApiT BoundType
scale :: !(ApiT BoundType)
    , ApiUtxoStatistics -> Map Word64 Word64
distribution :: !(Map Word64 Word64)
    } deriving (ApiUtxoStatistics -> ApiUtxoStatistics -> Bool
(ApiUtxoStatistics -> ApiUtxoStatistics -> Bool)
-> (ApiUtxoStatistics -> ApiUtxoStatistics -> Bool)
-> Eq ApiUtxoStatistics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiUtxoStatistics -> ApiUtxoStatistics -> Bool
$c/= :: ApiUtxoStatistics -> ApiUtxoStatistics -> Bool
== :: ApiUtxoStatistics -> ApiUtxoStatistics -> Bool
$c== :: ApiUtxoStatistics -> ApiUtxoStatistics -> Bool
Eq, (forall x. ApiUtxoStatistics -> Rep ApiUtxoStatistics x)
-> (forall x. Rep ApiUtxoStatistics x -> ApiUtxoStatistics)
-> Generic ApiUtxoStatistics
forall x. Rep ApiUtxoStatistics x -> ApiUtxoStatistics
forall x. ApiUtxoStatistics -> Rep ApiUtxoStatistics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiUtxoStatistics x -> ApiUtxoStatistics
$cfrom :: forall x. ApiUtxoStatistics -> Rep ApiUtxoStatistics x
Generic, Int -> ApiUtxoStatistics -> ShowS
[ApiUtxoStatistics] -> ShowS
ApiUtxoStatistics -> String
(Int -> ApiUtxoStatistics -> ShowS)
-> (ApiUtxoStatistics -> String)
-> ([ApiUtxoStatistics] -> ShowS)
-> Show ApiUtxoStatistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiUtxoStatistics] -> ShowS
$cshowList :: [ApiUtxoStatistics] -> ShowS
show :: ApiUtxoStatistics -> String
$cshow :: ApiUtxoStatistics -> String
showsPrec :: Int -> ApiUtxoStatistics -> ShowS
$cshowsPrec :: Int -> ApiUtxoStatistics -> ShowS
Show)
      deriving anyclass ApiUtxoStatistics -> ()
(ApiUtxoStatistics -> ()) -> NFData ApiUtxoStatistics
forall a. (a -> ()) -> NFData a
rnf :: ApiUtxoStatistics -> ()
$crnf :: ApiUtxoStatistics -> ()
NFData

toApiUtxoStatistics :: UTxOStatistics -> ApiUtxoStatistics
toApiUtxoStatistics :: UTxOStatistics -> ApiUtxoStatistics
toApiUtxoStatistics (UTxOStatistics [HistogramBar]
histo Word64
totalStakes BoundType
bType) =
    ApiUtxoStatistics :: Quantity "lovelace" Natural
-> ApiT BoundType -> Map Word64 Word64 -> ApiUtxoStatistics
ApiUtxoStatistics
    { $sel:total:ApiUtxoStatistics :: Quantity "lovelace" Natural
total = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalStakes)
    , $sel:scale:ApiUtxoStatistics :: ApiT BoundType
scale = BoundType -> ApiT BoundType
forall a. a -> ApiT a
ApiT BoundType
bType
    , $sel:distribution:ApiUtxoStatistics :: Map Word64 Word64
distribution = [(Word64, Word64)] -> Map Word64 Word64
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Word64, Word64)] -> Map Word64 Word64)
-> [(Word64, Word64)] -> Map Word64 Word64
forall a b. (a -> b) -> a -> b
$ (HistogramBar -> (Word64, Word64))
-> [HistogramBar] -> [(Word64, Word64)]
forall a b. (a -> b) -> [a] -> [b]
map (\(HistogramBar Word64
k Word64
v)-> (Word64
k,Word64
v)) [HistogramBar]
histo
    }

data WalletPostData = WalletPostData
    { WalletPostData -> Maybe (ApiT AddressPoolGap)
addressPoolGap :: !(Maybe (ApiT AddressPoolGap))
    , WalletPostData -> ApiMnemonicT (AllowedMnemonics 'Shelley)
mnemonicSentence :: !(ApiMnemonicT (AllowedMnemonics 'Shelley))
    , WalletPostData
-> Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor))
mnemonicSecondFactor :: !(Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor)))
    , WalletPostData -> ApiT WalletName
name :: !(ApiT WalletName)
    , WalletPostData -> ApiT (Passphrase "user")
passphrase :: !(ApiT (Passphrase "user"))
    } deriving (WalletPostData -> WalletPostData -> Bool
(WalletPostData -> WalletPostData -> Bool)
-> (WalletPostData -> WalletPostData -> Bool) -> Eq WalletPostData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletPostData -> WalletPostData -> Bool
$c/= :: WalletPostData -> WalletPostData -> Bool
== :: WalletPostData -> WalletPostData -> Bool
$c== :: WalletPostData -> WalletPostData -> Bool
Eq, (forall x. WalletPostData -> Rep WalletPostData x)
-> (forall x. Rep WalletPostData x -> WalletPostData)
-> Generic WalletPostData
forall x. Rep WalletPostData x -> WalletPostData
forall x. WalletPostData -> Rep WalletPostData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalletPostData x -> WalletPostData
$cfrom :: forall x. WalletPostData -> Rep WalletPostData x
Generic, Int -> WalletPostData -> ShowS
[WalletPostData] -> ShowS
WalletPostData -> String
(Int -> WalletPostData -> ShowS)
-> (WalletPostData -> String)
-> ([WalletPostData] -> ShowS)
-> Show WalletPostData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletPostData] -> ShowS
$cshowList :: [WalletPostData] -> ShowS
show :: WalletPostData -> String
$cshow :: WalletPostData -> String
showsPrec :: Int -> WalletPostData -> ShowS
$cshowsPrec :: Int -> WalletPostData -> ShowS
Show)

data SomeByronWalletPostData
    = RandomWalletFromMnemonic (ByronWalletPostData (AllowedMnemonics 'Random))
    | RandomWalletFromXPrv ByronWalletFromXPrvPostData
    | SomeIcarusWallet (ByronWalletPostData (AllowedMnemonics 'Icarus))
    | SomeTrezorWallet (ByronWalletPostData (AllowedMnemonics 'Trezor))
    | SomeLedgerWallet (ByronWalletPostData (AllowedMnemonics 'Ledger))
    | SomeAccount AccountPostData
    deriving (SomeByronWalletPostData -> SomeByronWalletPostData -> Bool
(SomeByronWalletPostData -> SomeByronWalletPostData -> Bool)
-> (SomeByronWalletPostData -> SomeByronWalletPostData -> Bool)
-> Eq SomeByronWalletPostData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SomeByronWalletPostData -> SomeByronWalletPostData -> Bool
$c/= :: SomeByronWalletPostData -> SomeByronWalletPostData -> Bool
== :: SomeByronWalletPostData -> SomeByronWalletPostData -> Bool
$c== :: SomeByronWalletPostData -> SomeByronWalletPostData -> Bool
Eq, (forall x.
 SomeByronWalletPostData -> Rep SomeByronWalletPostData x)
-> (forall x.
    Rep SomeByronWalletPostData x -> SomeByronWalletPostData)
-> Generic SomeByronWalletPostData
forall x. Rep SomeByronWalletPostData x -> SomeByronWalletPostData
forall x. SomeByronWalletPostData -> Rep SomeByronWalletPostData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SomeByronWalletPostData x -> SomeByronWalletPostData
$cfrom :: forall x. SomeByronWalletPostData -> Rep SomeByronWalletPostData x
Generic, Int -> SomeByronWalletPostData -> ShowS
[SomeByronWalletPostData] -> ShowS
SomeByronWalletPostData -> String
(Int -> SomeByronWalletPostData -> ShowS)
-> (SomeByronWalletPostData -> String)
-> ([SomeByronWalletPostData] -> ShowS)
-> Show SomeByronWalletPostData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SomeByronWalletPostData] -> ShowS
$cshowList :: [SomeByronWalletPostData] -> ShowS
show :: SomeByronWalletPostData -> String
$cshow :: SomeByronWalletPostData -> String
showsPrec :: Int -> SomeByronWalletPostData -> ShowS
$cshowsPrec :: Int -> SomeByronWalletPostData -> ShowS
Show)

data ByronWalletPostData mw = ByronWalletPostData
    { ByronWalletPostData mw -> ApiMnemonicT mw
mnemonicSentence :: !(ApiMnemonicT mw)
    , ByronWalletPostData mw -> ApiT WalletName
name :: !(ApiT WalletName)
    , ByronWalletPostData mw -> ApiT (Passphrase "user")
passphrase :: !(ApiT (Passphrase "user"))
    } deriving (ByronWalletPostData mw -> ByronWalletPostData mw -> Bool
(ByronWalletPostData mw -> ByronWalletPostData mw -> Bool)
-> (ByronWalletPostData mw -> ByronWalletPostData mw -> Bool)
-> Eq (ByronWalletPostData mw)
forall (mw :: [Nat]).
ByronWalletPostData mw -> ByronWalletPostData mw -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByronWalletPostData mw -> ByronWalletPostData mw -> Bool
$c/= :: forall (mw :: [Nat]).
ByronWalletPostData mw -> ByronWalletPostData mw -> Bool
== :: ByronWalletPostData mw -> ByronWalletPostData mw -> Bool
$c== :: forall (mw :: [Nat]).
ByronWalletPostData mw -> ByronWalletPostData mw -> Bool
Eq, (forall x.
 ByronWalletPostData mw -> Rep (ByronWalletPostData mw) x)
-> (forall x.
    Rep (ByronWalletPostData mw) x -> ByronWalletPostData mw)
-> Generic (ByronWalletPostData mw)
forall (mw :: [Nat]) x.
Rep (ByronWalletPostData mw) x -> ByronWalletPostData mw
forall (mw :: [Nat]) x.
ByronWalletPostData mw -> Rep (ByronWalletPostData mw) x
forall x. Rep (ByronWalletPostData mw) x -> ByronWalletPostData mw
forall x. ByronWalletPostData mw -> Rep (ByronWalletPostData mw) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (mw :: [Nat]) x.
Rep (ByronWalletPostData mw) x -> ByronWalletPostData mw
$cfrom :: forall (mw :: [Nat]) x.
ByronWalletPostData mw -> Rep (ByronWalletPostData mw) x
Generic, Int -> ByronWalletPostData mw -> ShowS
[ByronWalletPostData mw] -> ShowS
ByronWalletPostData mw -> String
(Int -> ByronWalletPostData mw -> ShowS)
-> (ByronWalletPostData mw -> String)
-> ([ByronWalletPostData mw] -> ShowS)
-> Show (ByronWalletPostData mw)
forall (mw :: [Nat]). Int -> ByronWalletPostData mw -> ShowS
forall (mw :: [Nat]). [ByronWalletPostData mw] -> ShowS
forall (mw :: [Nat]). ByronWalletPostData mw -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByronWalletPostData mw] -> ShowS
$cshowList :: forall (mw :: [Nat]). [ByronWalletPostData mw] -> ShowS
show :: ByronWalletPostData mw -> String
$cshow :: forall (mw :: [Nat]). ByronWalletPostData mw -> String
showsPrec :: Int -> ByronWalletPostData mw -> ShowS
$cshowsPrec :: forall (mw :: [Nat]). Int -> ByronWalletPostData mw -> ShowS
Show)

data ByronWalletFromXPrvPostData = ByronWalletFromXPrvPostData
    { ByronWalletFromXPrvPostData -> ApiT WalletName
name :: !(ApiT WalletName)
    , ByronWalletFromXPrvPostData -> ApiT XPrv
encryptedRootPrivateKey :: !(ApiT XPrv)
    -- ^ A root private key hex-encoded, encrypted using a given passphrase.
    -- The underlying key should contain: private key, chain code, and public key
    , ByronWalletFromXPrvPostData -> ApiT PassphraseHash
passphraseHash :: !(ApiT PassphraseHash)
    -- ^ A hash of master passphrase. The hash should be an output of a
    -- Scrypt function with the following parameters:
    -- - logN = 14
    -- - r = 8
    -- - p = 1
    } deriving (ByronWalletFromXPrvPostData -> ByronWalletFromXPrvPostData -> Bool
(ByronWalletFromXPrvPostData
 -> ByronWalletFromXPrvPostData -> Bool)
-> (ByronWalletFromXPrvPostData
    -> ByronWalletFromXPrvPostData -> Bool)
-> Eq ByronWalletFromXPrvPostData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByronWalletFromXPrvPostData -> ByronWalletFromXPrvPostData -> Bool
$c/= :: ByronWalletFromXPrvPostData -> ByronWalletFromXPrvPostData -> Bool
== :: ByronWalletFromXPrvPostData -> ByronWalletFromXPrvPostData -> Bool
$c== :: ByronWalletFromXPrvPostData -> ByronWalletFromXPrvPostData -> Bool
Eq, (forall x.
 ByronWalletFromXPrvPostData -> Rep ByronWalletFromXPrvPostData x)
-> (forall x.
    Rep ByronWalletFromXPrvPostData x -> ByronWalletFromXPrvPostData)
-> Generic ByronWalletFromXPrvPostData
forall x.
Rep ByronWalletFromXPrvPostData x -> ByronWalletFromXPrvPostData
forall x.
ByronWalletFromXPrvPostData -> Rep ByronWalletFromXPrvPostData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ByronWalletFromXPrvPostData x -> ByronWalletFromXPrvPostData
$cfrom :: forall x.
ByronWalletFromXPrvPostData -> Rep ByronWalletFromXPrvPostData x
Generic, Int -> ByronWalletFromXPrvPostData -> ShowS
[ByronWalletFromXPrvPostData] -> ShowS
ByronWalletFromXPrvPostData -> String
(Int -> ByronWalletFromXPrvPostData -> ShowS)
-> (ByronWalletFromXPrvPostData -> String)
-> ([ByronWalletFromXPrvPostData] -> ShowS)
-> Show ByronWalletFromXPrvPostData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByronWalletFromXPrvPostData] -> ShowS
$cshowList :: [ByronWalletFromXPrvPostData] -> ShowS
show :: ByronWalletFromXPrvPostData -> String
$cshow :: ByronWalletFromXPrvPostData -> String
showsPrec :: Int -> ByronWalletFromXPrvPostData -> ShowS
$cshowsPrec :: Int -> ByronWalletFromXPrvPostData -> ShowS
Show)
      deriving anyclass ByronWalletFromXPrvPostData -> ()
(ByronWalletFromXPrvPostData -> ())
-> NFData ByronWalletFromXPrvPostData
forall a. (a -> ()) -> NFData a
rnf :: ByronWalletFromXPrvPostData -> ()
$crnf :: ByronWalletFromXPrvPostData -> ()
NFData

newtype ApiAccountPublicKey = ApiAccountPublicKey
    { ApiAccountPublicKey -> ApiT XPub
key :: (ApiT XPub)
    }
    deriving (ApiAccountPublicKey -> ApiAccountPublicKey -> Bool
(ApiAccountPublicKey -> ApiAccountPublicKey -> Bool)
-> (ApiAccountPublicKey -> ApiAccountPublicKey -> Bool)
-> Eq ApiAccountPublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiAccountPublicKey -> ApiAccountPublicKey -> Bool
$c/= :: ApiAccountPublicKey -> ApiAccountPublicKey -> Bool
== :: ApiAccountPublicKey -> ApiAccountPublicKey -> Bool
$c== :: ApiAccountPublicKey -> ApiAccountPublicKey -> Bool
Eq, (forall x. ApiAccountPublicKey -> Rep ApiAccountPublicKey x)
-> (forall x. Rep ApiAccountPublicKey x -> ApiAccountPublicKey)
-> Generic ApiAccountPublicKey
forall x. Rep ApiAccountPublicKey x -> ApiAccountPublicKey
forall x. ApiAccountPublicKey -> Rep ApiAccountPublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiAccountPublicKey x -> ApiAccountPublicKey
$cfrom :: forall x. ApiAccountPublicKey -> Rep ApiAccountPublicKey x
Generic)
    deriving anyclass ApiAccountPublicKey -> ()
(ApiAccountPublicKey -> ()) -> NFData ApiAccountPublicKey
forall a. (a -> ()) -> NFData a
rnf :: ApiAccountPublicKey -> ()
$crnf :: ApiAccountPublicKey -> ()
NFData
    deriving Int -> ApiAccountPublicKey -> ShowS
[ApiAccountPublicKey] -> ShowS
ApiAccountPublicKey -> String
(Int -> ApiAccountPublicKey -> ShowS)
-> (ApiAccountPublicKey -> String)
-> ([ApiAccountPublicKey] -> ShowS)
-> Show ApiAccountPublicKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiAccountPublicKey] -> ShowS
$cshowList :: [ApiAccountPublicKey] -> ShowS
show :: ApiAccountPublicKey -> String
$cshow :: ApiAccountPublicKey -> String
showsPrec :: Int -> ApiAccountPublicKey -> ShowS
$cshowsPrec :: Int -> ApiAccountPublicKey -> ShowS
Show via (Quiet ApiAccountPublicKey)

newtype WalletOrAccountPostData = WalletOrAccountPostData
    { WalletOrAccountPostData -> Either WalletPostData AccountPostData
postData :: Either WalletPostData AccountPostData
    }
    deriving (WalletOrAccountPostData -> WalletOrAccountPostData -> Bool
(WalletOrAccountPostData -> WalletOrAccountPostData -> Bool)
-> (WalletOrAccountPostData -> WalletOrAccountPostData -> Bool)
-> Eq WalletOrAccountPostData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletOrAccountPostData -> WalletOrAccountPostData -> Bool
$c/= :: WalletOrAccountPostData -> WalletOrAccountPostData -> Bool
== :: WalletOrAccountPostData -> WalletOrAccountPostData -> Bool
$c== :: WalletOrAccountPostData -> WalletOrAccountPostData -> Bool
Eq, (forall x.
 WalletOrAccountPostData -> Rep WalletOrAccountPostData x)
-> (forall x.
    Rep WalletOrAccountPostData x -> WalletOrAccountPostData)
-> Generic WalletOrAccountPostData
forall x. Rep WalletOrAccountPostData x -> WalletOrAccountPostData
forall x. WalletOrAccountPostData -> Rep WalletOrAccountPostData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalletOrAccountPostData x -> WalletOrAccountPostData
$cfrom :: forall x. WalletOrAccountPostData -> Rep WalletOrAccountPostData x
Generic)
    deriving Int -> WalletOrAccountPostData -> ShowS
[WalletOrAccountPostData] -> ShowS
WalletOrAccountPostData -> String
(Int -> WalletOrAccountPostData -> ShowS)
-> (WalletOrAccountPostData -> String)
-> ([WalletOrAccountPostData] -> ShowS)
-> Show WalletOrAccountPostData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletOrAccountPostData] -> ShowS
$cshowList :: [WalletOrAccountPostData] -> ShowS
show :: WalletOrAccountPostData -> String
$cshow :: WalletOrAccountPostData -> String
showsPrec :: Int -> WalletOrAccountPostData -> ShowS
$cshowsPrec :: Int -> WalletOrAccountPostData -> ShowS
Show via (Quiet WalletOrAccountPostData)

data AccountPostData = AccountPostData
    { AccountPostData -> ApiT WalletName
name :: !(ApiT WalletName)
    , AccountPostData -> ApiAccountPublicKey
accountPublicKey :: !ApiAccountPublicKey
    , AccountPostData -> Maybe (ApiT AddressPoolGap)
addressPoolGap :: !(Maybe (ApiT AddressPoolGap))
    } deriving (AccountPostData -> AccountPostData -> Bool
(AccountPostData -> AccountPostData -> Bool)
-> (AccountPostData -> AccountPostData -> Bool)
-> Eq AccountPostData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountPostData -> AccountPostData -> Bool
$c/= :: AccountPostData -> AccountPostData -> Bool
== :: AccountPostData -> AccountPostData -> Bool
$c== :: AccountPostData -> AccountPostData -> Bool
Eq, (forall x. AccountPostData -> Rep AccountPostData x)
-> (forall x. Rep AccountPostData x -> AccountPostData)
-> Generic AccountPostData
forall x. Rep AccountPostData x -> AccountPostData
forall x. AccountPostData -> Rep AccountPostData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccountPostData x -> AccountPostData
$cfrom :: forall x. AccountPostData -> Rep AccountPostData x
Generic, Int -> AccountPostData -> ShowS
[AccountPostData] -> ShowS
AccountPostData -> String
(Int -> AccountPostData -> ShowS)
-> (AccountPostData -> String)
-> ([AccountPostData] -> ShowS)
-> Show AccountPostData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountPostData] -> ShowS
$cshowList :: [AccountPostData] -> ShowS
show :: AccountPostData -> String
$cshow :: AccountPostData -> String
showsPrec :: Int -> AccountPostData -> ShowS
$cshowsPrec :: Int -> AccountPostData -> ShowS
Show)

newtype WalletPutData = WalletPutData
    { WalletPutData -> Maybe (ApiT WalletName)
name :: (Maybe (ApiT WalletName))
    }
    deriving (WalletPutData -> WalletPutData -> Bool
(WalletPutData -> WalletPutData -> Bool)
-> (WalletPutData -> WalletPutData -> Bool) -> Eq WalletPutData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletPutData -> WalletPutData -> Bool
$c/= :: WalletPutData -> WalletPutData -> Bool
== :: WalletPutData -> WalletPutData -> Bool
$c== :: WalletPutData -> WalletPutData -> Bool
Eq, (forall x. WalletPutData -> Rep WalletPutData x)
-> (forall x. Rep WalletPutData x -> WalletPutData)
-> Generic WalletPutData
forall x. Rep WalletPutData x -> WalletPutData
forall x. WalletPutData -> Rep WalletPutData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalletPutData x -> WalletPutData
$cfrom :: forall x. WalletPutData -> Rep WalletPutData x
Generic)
    deriving Int -> WalletPutData -> ShowS
[WalletPutData] -> ShowS
WalletPutData -> String
(Int -> WalletPutData -> ShowS)
-> (WalletPutData -> String)
-> ([WalletPutData] -> ShowS)
-> Show WalletPutData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletPutData] -> ShowS
$cshowList :: [WalletPutData] -> ShowS
show :: WalletPutData -> String
$cshow :: WalletPutData -> String
showsPrec :: Int -> WalletPutData -> ShowS
$cshowsPrec :: Int -> WalletPutData -> ShowS
Show via (Quiet WalletPutData)

newtype SettingsPutData = SettingsPutData
    { SettingsPutData -> ApiT Settings
settings :: (ApiT W.Settings)
    }
    deriving (SettingsPutData -> SettingsPutData -> Bool
(SettingsPutData -> SettingsPutData -> Bool)
-> (SettingsPutData -> SettingsPutData -> Bool)
-> Eq SettingsPutData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SettingsPutData -> SettingsPutData -> Bool
$c/= :: SettingsPutData -> SettingsPutData -> Bool
== :: SettingsPutData -> SettingsPutData -> Bool
$c== :: SettingsPutData -> SettingsPutData -> Bool
Eq, (forall x. SettingsPutData -> Rep SettingsPutData x)
-> (forall x. Rep SettingsPutData x -> SettingsPutData)
-> Generic SettingsPutData
forall x. Rep SettingsPutData x -> SettingsPutData
forall x. SettingsPutData -> Rep SettingsPutData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SettingsPutData x -> SettingsPutData
$cfrom :: forall x. SettingsPutData -> Rep SettingsPutData x
Generic)
    deriving Int -> SettingsPutData -> ShowS
[SettingsPutData] -> ShowS
SettingsPutData -> String
(Int -> SettingsPutData -> ShowS)
-> (SettingsPutData -> String)
-> ([SettingsPutData] -> ShowS)
-> Show SettingsPutData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SettingsPutData] -> ShowS
$cshowList :: [SettingsPutData] -> ShowS
show :: SettingsPutData -> String
$cshow :: SettingsPutData -> String
showsPrec :: Int -> SettingsPutData -> ShowS
$cshowsPrec :: Int -> SettingsPutData -> ShowS
Show via (Quiet SettingsPutData)

data WalletPutPassphraseMnemonicData = WalletPutPassphraseMnemonicData
    { WalletPutPassphraseMnemonicData
-> ApiMnemonicT (AllowedMnemonics 'Shelley)
mnemonicSentence :: !(ApiMnemonicT (AllowedMnemonics 'Shelley))
    , WalletPutPassphraseMnemonicData
-> Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor))
mnemonicSecondFactor :: !(Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor)))
    , WalletPutPassphraseMnemonicData -> ApiT (Passphrase "user")
newPassphrase :: !(ApiT (Passphrase "user"))
    } deriving (WalletPutPassphraseMnemonicData
-> WalletPutPassphraseMnemonicData -> Bool
(WalletPutPassphraseMnemonicData
 -> WalletPutPassphraseMnemonicData -> Bool)
-> (WalletPutPassphraseMnemonicData
    -> WalletPutPassphraseMnemonicData -> Bool)
-> Eq WalletPutPassphraseMnemonicData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletPutPassphraseMnemonicData
-> WalletPutPassphraseMnemonicData -> Bool
$c/= :: WalletPutPassphraseMnemonicData
-> WalletPutPassphraseMnemonicData -> Bool
== :: WalletPutPassphraseMnemonicData
-> WalletPutPassphraseMnemonicData -> Bool
$c== :: WalletPutPassphraseMnemonicData
-> WalletPutPassphraseMnemonicData -> Bool
Eq, (forall x.
 WalletPutPassphraseMnemonicData
 -> Rep WalletPutPassphraseMnemonicData x)
-> (forall x.
    Rep WalletPutPassphraseMnemonicData x
    -> WalletPutPassphraseMnemonicData)
-> Generic WalletPutPassphraseMnemonicData
forall x.
Rep WalletPutPassphraseMnemonicData x
-> WalletPutPassphraseMnemonicData
forall x.
WalletPutPassphraseMnemonicData
-> Rep WalletPutPassphraseMnemonicData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep WalletPutPassphraseMnemonicData x
-> WalletPutPassphraseMnemonicData
$cfrom :: forall x.
WalletPutPassphraseMnemonicData
-> Rep WalletPutPassphraseMnemonicData x
Generic, Int -> WalletPutPassphraseMnemonicData -> ShowS
[WalletPutPassphraseMnemonicData] -> ShowS
WalletPutPassphraseMnemonicData -> String
(Int -> WalletPutPassphraseMnemonicData -> ShowS)
-> (WalletPutPassphraseMnemonicData -> String)
-> ([WalletPutPassphraseMnemonicData] -> ShowS)
-> Show WalletPutPassphraseMnemonicData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletPutPassphraseMnemonicData] -> ShowS
$cshowList :: [WalletPutPassphraseMnemonicData] -> ShowS
show :: WalletPutPassphraseMnemonicData -> String
$cshow :: WalletPutPassphraseMnemonicData -> String
showsPrec :: Int -> WalletPutPassphraseMnemonicData -> ShowS
$cshowsPrec :: Int -> WalletPutPassphraseMnemonicData -> ShowS
Show)

data WalletPutPassphraseOldPassphraseData = WalletPutPassphraseOldPassphraseData
    { WalletPutPassphraseOldPassphraseData -> ApiT (Passphrase "user")
oldPassphrase :: !(ApiT (Passphrase "user"))
    , WalletPutPassphraseOldPassphraseData -> ApiT (Passphrase "user")
newPassphrase :: !(ApiT (Passphrase "user"))
    } deriving (WalletPutPassphraseOldPassphraseData
-> WalletPutPassphraseOldPassphraseData -> Bool
(WalletPutPassphraseOldPassphraseData
 -> WalletPutPassphraseOldPassphraseData -> Bool)
-> (WalletPutPassphraseOldPassphraseData
    -> WalletPutPassphraseOldPassphraseData -> Bool)
-> Eq WalletPutPassphraseOldPassphraseData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletPutPassphraseOldPassphraseData
-> WalletPutPassphraseOldPassphraseData -> Bool
$c/= :: WalletPutPassphraseOldPassphraseData
-> WalletPutPassphraseOldPassphraseData -> Bool
== :: WalletPutPassphraseOldPassphraseData
-> WalletPutPassphraseOldPassphraseData -> Bool
$c== :: WalletPutPassphraseOldPassphraseData
-> WalletPutPassphraseOldPassphraseData -> Bool
Eq, (forall x.
 WalletPutPassphraseOldPassphraseData
 -> Rep WalletPutPassphraseOldPassphraseData x)
-> (forall x.
    Rep WalletPutPassphraseOldPassphraseData x
    -> WalletPutPassphraseOldPassphraseData)
-> Generic WalletPutPassphraseOldPassphraseData
forall x.
Rep WalletPutPassphraseOldPassphraseData x
-> WalletPutPassphraseOldPassphraseData
forall x.
WalletPutPassphraseOldPassphraseData
-> Rep WalletPutPassphraseOldPassphraseData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep WalletPutPassphraseOldPassphraseData x
-> WalletPutPassphraseOldPassphraseData
$cfrom :: forall x.
WalletPutPassphraseOldPassphraseData
-> Rep WalletPutPassphraseOldPassphraseData x
Generic, Int -> WalletPutPassphraseOldPassphraseData -> ShowS
[WalletPutPassphraseOldPassphraseData] -> ShowS
WalletPutPassphraseOldPassphraseData -> String
(Int -> WalletPutPassphraseOldPassphraseData -> ShowS)
-> (WalletPutPassphraseOldPassphraseData -> String)
-> ([WalletPutPassphraseOldPassphraseData] -> ShowS)
-> Show WalletPutPassphraseOldPassphraseData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletPutPassphraseOldPassphraseData] -> ShowS
$cshowList :: [WalletPutPassphraseOldPassphraseData] -> ShowS
show :: WalletPutPassphraseOldPassphraseData -> String
$cshow :: WalletPutPassphraseOldPassphraseData -> String
showsPrec :: Int -> WalletPutPassphraseOldPassphraseData -> ShowS
$cshowsPrec :: Int -> WalletPutPassphraseOldPassphraseData -> ShowS
Show)

newtype WalletPutPassphraseData = WalletPutPassphraseData
    (  Either
            WalletPutPassphraseOldPassphraseData
            WalletPutPassphraseMnemonicData
    )
    deriving (WalletPutPassphraseData -> WalletPutPassphraseData -> Bool
(WalletPutPassphraseData -> WalletPutPassphraseData -> Bool)
-> (WalletPutPassphraseData -> WalletPutPassphraseData -> Bool)
-> Eq WalletPutPassphraseData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletPutPassphraseData -> WalletPutPassphraseData -> Bool
$c/= :: WalletPutPassphraseData -> WalletPutPassphraseData -> Bool
== :: WalletPutPassphraseData -> WalletPutPassphraseData -> Bool
$c== :: WalletPutPassphraseData -> WalletPutPassphraseData -> Bool
Eq, (forall x.
 WalletPutPassphraseData -> Rep WalletPutPassphraseData x)
-> (forall x.
    Rep WalletPutPassphraseData x -> WalletPutPassphraseData)
-> Generic WalletPutPassphraseData
forall x. Rep WalletPutPassphraseData x -> WalletPutPassphraseData
forall x. WalletPutPassphraseData -> Rep WalletPutPassphraseData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalletPutPassphraseData x -> WalletPutPassphraseData
$cfrom :: forall x. WalletPutPassphraseData -> Rep WalletPutPassphraseData x
Generic, Int -> WalletPutPassphraseData -> ShowS
[WalletPutPassphraseData] -> ShowS
WalletPutPassphraseData -> String
(Int -> WalletPutPassphraseData -> ShowS)
-> (WalletPutPassphraseData -> String)
-> ([WalletPutPassphraseData] -> ShowS)
-> Show WalletPutPassphraseData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletPutPassphraseData] -> ShowS
$cshowList :: [WalletPutPassphraseData] -> ShowS
show :: WalletPutPassphraseData -> String
$cshow :: WalletPutPassphraseData -> String
showsPrec :: Int -> WalletPutPassphraseData -> ShowS
$cshowsPrec :: Int -> WalletPutPassphraseData -> ShowS
Show)

data ByronWalletPutPassphraseData = ByronWalletPutPassphraseData
    { ByronWalletPutPassphraseData -> Maybe (ApiT (Passphrase "lenient"))
oldPassphrase :: !(Maybe (ApiT (Passphrase "lenient")))
    , ByronWalletPutPassphraseData -> ApiT (Passphrase "user")
newPassphrase :: !(ApiT (Passphrase "user"))
    } deriving (ByronWalletPutPassphraseData
-> ByronWalletPutPassphraseData -> Bool
(ByronWalletPutPassphraseData
 -> ByronWalletPutPassphraseData -> Bool)
-> (ByronWalletPutPassphraseData
    -> ByronWalletPutPassphraseData -> Bool)
-> Eq ByronWalletPutPassphraseData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByronWalletPutPassphraseData
-> ByronWalletPutPassphraseData -> Bool
$c/= :: ByronWalletPutPassphraseData
-> ByronWalletPutPassphraseData -> Bool
== :: ByronWalletPutPassphraseData
-> ByronWalletPutPassphraseData -> Bool
$c== :: ByronWalletPutPassphraseData
-> ByronWalletPutPassphraseData -> Bool
Eq, (forall x.
 ByronWalletPutPassphraseData -> Rep ByronWalletPutPassphraseData x)
-> (forall x.
    Rep ByronWalletPutPassphraseData x -> ByronWalletPutPassphraseData)
-> Generic ByronWalletPutPassphraseData
forall x.
Rep ByronWalletPutPassphraseData x -> ByronWalletPutPassphraseData
forall x.
ByronWalletPutPassphraseData -> Rep ByronWalletPutPassphraseData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ByronWalletPutPassphraseData x -> ByronWalletPutPassphraseData
$cfrom :: forall x.
ByronWalletPutPassphraseData -> Rep ByronWalletPutPassphraseData x
Generic, Int -> ByronWalletPutPassphraseData -> ShowS
[ByronWalletPutPassphraseData] -> ShowS
ByronWalletPutPassphraseData -> String
(Int -> ByronWalletPutPassphraseData -> ShowS)
-> (ByronWalletPutPassphraseData -> String)
-> ([ByronWalletPutPassphraseData] -> ShowS)
-> Show ByronWalletPutPassphraseData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByronWalletPutPassphraseData] -> ShowS
$cshowList :: [ByronWalletPutPassphraseData] -> ShowS
show :: ByronWalletPutPassphraseData -> String
$cshow :: ByronWalletPutPassphraseData -> String
showsPrec :: Int -> ByronWalletPutPassphraseData -> ShowS
$cshowsPrec :: Int -> ByronWalletPutPassphraseData -> ShowS
Show)

data ApiConstructTransaction (n :: NetworkDiscriminant) = ApiConstructTransaction
    { ApiConstructTransaction n -> ApiT SealedTx
transaction :: !(ApiT SealedTx)
    , ApiConstructTransaction n -> ApiCoinSelection n
coinSelection :: !(ApiCoinSelection n)
    , ApiConstructTransaction n -> Quantity "lovelace" Natural
fee :: !(Quantity "lovelace" Natural)
    } deriving (ApiConstructTransaction n -> ApiConstructTransaction n -> Bool
(ApiConstructTransaction n -> ApiConstructTransaction n -> Bool)
-> (ApiConstructTransaction n -> ApiConstructTransaction n -> Bool)
-> Eq (ApiConstructTransaction n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiConstructTransaction n -> ApiConstructTransaction n -> Bool
/= :: ApiConstructTransaction n -> ApiConstructTransaction n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiConstructTransaction n -> ApiConstructTransaction n -> Bool
== :: ApiConstructTransaction n -> ApiConstructTransaction n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiConstructTransaction n -> ApiConstructTransaction n -> Bool
Eq, (forall x.
 ApiConstructTransaction n -> Rep (ApiConstructTransaction n) x)
-> (forall x.
    Rep (ApiConstructTransaction n) x -> ApiConstructTransaction n)
-> Generic (ApiConstructTransaction n)
forall x.
Rep (ApiConstructTransaction n) x -> ApiConstructTransaction n
forall x.
ApiConstructTransaction n -> Rep (ApiConstructTransaction n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiConstructTransaction n) x -> ApiConstructTransaction n
forall (n :: NetworkDiscriminant) x.
ApiConstructTransaction n -> Rep (ApiConstructTransaction n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiConstructTransaction n) x -> ApiConstructTransaction n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiConstructTransaction n -> Rep (ApiConstructTransaction n) x
Generic, Int -> ApiConstructTransaction n -> ShowS
[ApiConstructTransaction n] -> ShowS
ApiConstructTransaction n -> String
(Int -> ApiConstructTransaction n -> ShowS)
-> (ApiConstructTransaction n -> String)
-> ([ApiConstructTransaction n] -> ShowS)
-> Show (ApiConstructTransaction n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiConstructTransaction n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiConstructTransaction n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiConstructTransaction n -> String
showList :: [ApiConstructTransaction n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiConstructTransaction n] -> ShowS
show :: ApiConstructTransaction n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiConstructTransaction n -> String
showsPrec :: Int -> ApiConstructTransaction n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiConstructTransaction n -> ShowS
Show, Typeable)
      deriving anyclass ApiConstructTransaction n -> ()
(ApiConstructTransaction n -> ())
-> NFData (ApiConstructTransaction n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiConstructTransaction n -> ()
rnf :: ApiConstructTransaction n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiConstructTransaction n -> ()
NFData

-- | Index of the stake key.
newtype ApiStakeKeyIndex = ApiStakeKeyIndex (ApiT DerivationIndex)
    deriving (ApiStakeKeyIndex -> ApiStakeKeyIndex -> Bool
(ApiStakeKeyIndex -> ApiStakeKeyIndex -> Bool)
-> (ApiStakeKeyIndex -> ApiStakeKeyIndex -> Bool)
-> Eq ApiStakeKeyIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiStakeKeyIndex -> ApiStakeKeyIndex -> Bool
$c/= :: ApiStakeKeyIndex -> ApiStakeKeyIndex -> Bool
== :: ApiStakeKeyIndex -> ApiStakeKeyIndex -> Bool
$c== :: ApiStakeKeyIndex -> ApiStakeKeyIndex -> Bool
Eq, (forall x. ApiStakeKeyIndex -> Rep ApiStakeKeyIndex x)
-> (forall x. Rep ApiStakeKeyIndex x -> ApiStakeKeyIndex)
-> Generic ApiStakeKeyIndex
forall x. Rep ApiStakeKeyIndex x -> ApiStakeKeyIndex
forall x. ApiStakeKeyIndex -> Rep ApiStakeKeyIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiStakeKeyIndex x -> ApiStakeKeyIndex
$cfrom :: forall x. ApiStakeKeyIndex -> Rep ApiStakeKeyIndex x
Generic, Int -> ApiStakeKeyIndex -> ShowS
[ApiStakeKeyIndex] -> ShowS
ApiStakeKeyIndex -> String
(Int -> ApiStakeKeyIndex -> ShowS)
-> (ApiStakeKeyIndex -> String)
-> ([ApiStakeKeyIndex] -> ShowS)
-> Show ApiStakeKeyIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiStakeKeyIndex] -> ShowS
$cshowList :: [ApiStakeKeyIndex] -> ShowS
show :: ApiStakeKeyIndex -> String
$cshow :: ApiStakeKeyIndex -> String
showsPrec :: Int -> ApiStakeKeyIndex -> ShowS
$cshowsPrec :: Int -> ApiStakeKeyIndex -> ShowS
Show)
    deriving anyclass ApiStakeKeyIndex -> ()
(ApiStakeKeyIndex -> ()) -> NFData ApiStakeKeyIndex
forall a. (a -> ()) -> NFData a
rnf :: ApiStakeKeyIndex -> ()
$crnf :: ApiStakeKeyIndex -> ()
NFData

-- | Stake pool delegation certificates.
data ApiMultiDelegationAction
    = Joining !(ApiT PoolId) !ApiStakeKeyIndex
    -- ^ Delegate given staking index to a pool, possibly registering the stake
    -- key at the same time.
    | Leaving !ApiStakeKeyIndex
    -- ^ Undelegate the given staking index from its pool.
    deriving (ApiMultiDelegationAction -> ApiMultiDelegationAction -> Bool
(ApiMultiDelegationAction -> ApiMultiDelegationAction -> Bool)
-> (ApiMultiDelegationAction -> ApiMultiDelegationAction -> Bool)
-> Eq ApiMultiDelegationAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiMultiDelegationAction -> ApiMultiDelegationAction -> Bool
$c/= :: ApiMultiDelegationAction -> ApiMultiDelegationAction -> Bool
== :: ApiMultiDelegationAction -> ApiMultiDelegationAction -> Bool
$c== :: ApiMultiDelegationAction -> ApiMultiDelegationAction -> Bool
Eq, (forall x.
 ApiMultiDelegationAction -> Rep ApiMultiDelegationAction x)
-> (forall x.
    Rep ApiMultiDelegationAction x -> ApiMultiDelegationAction)
-> Generic ApiMultiDelegationAction
forall x.
Rep ApiMultiDelegationAction x -> ApiMultiDelegationAction
forall x.
ApiMultiDelegationAction -> Rep ApiMultiDelegationAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiMultiDelegationAction x -> ApiMultiDelegationAction
$cfrom :: forall x.
ApiMultiDelegationAction -> Rep ApiMultiDelegationAction x
Generic, Int -> ApiMultiDelegationAction -> ShowS
[ApiMultiDelegationAction] -> ShowS
ApiMultiDelegationAction -> String
(Int -> ApiMultiDelegationAction -> ShowS)
-> (ApiMultiDelegationAction -> String)
-> ([ApiMultiDelegationAction] -> ShowS)
-> Show ApiMultiDelegationAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiMultiDelegationAction] -> ShowS
$cshowList :: [ApiMultiDelegationAction] -> ShowS
show :: ApiMultiDelegationAction -> String
$cshow :: ApiMultiDelegationAction -> String
showsPrec :: Int -> ApiMultiDelegationAction -> ShowS
$cshowsPrec :: Int -> ApiMultiDelegationAction -> ShowS
Show)
    deriving anyclass ApiMultiDelegationAction -> ()
(ApiMultiDelegationAction -> ()) -> NFData ApiMultiDelegationAction
forall a. (a -> ()) -> NFData a
rnf :: ApiMultiDelegationAction -> ()
$crnf :: ApiMultiDelegationAction -> ()
NFData

-- | Input parameters for transaction construction.
data ApiConstructTransactionData (n :: NetworkDiscriminant) = ApiConstructTransactionData
    { ApiConstructTransactionData n -> Maybe (ApiPaymentDestination n)
payments :: !(Maybe (ApiPaymentDestination n))
    , ApiConstructTransactionData n -> Maybe ApiWithdrawalPostData
withdrawal :: !(Maybe ApiWithdrawalPostData)
    , ApiConstructTransactionData n -> Maybe TxMetadataWithSchema
metadata :: !(Maybe TxMetadataWithSchema)
    , ApiConstructTransactionData n
-> Maybe (NonEmpty (ApiMintBurnData n))
mintBurn :: !(Maybe (NonEmpty (ApiMintBurnData n)))
    , ApiConstructTransactionData n
-> Maybe (NonEmpty ApiMultiDelegationAction)
delegations :: !(Maybe (NonEmpty ApiMultiDelegationAction))
    , ApiConstructTransactionData n -> Maybe ApiValidityInterval
validityInterval :: !(Maybe ApiValidityInterval)
    } deriving (ApiConstructTransactionData n
-> ApiConstructTransactionData n -> Bool
(ApiConstructTransactionData n
 -> ApiConstructTransactionData n -> Bool)
-> (ApiConstructTransactionData n
    -> ApiConstructTransactionData n -> Bool)
-> Eq (ApiConstructTransactionData n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiConstructTransactionData n
-> ApiConstructTransactionData n -> Bool
/= :: ApiConstructTransactionData n
-> ApiConstructTransactionData n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiConstructTransactionData n
-> ApiConstructTransactionData n -> Bool
== :: ApiConstructTransactionData n
-> ApiConstructTransactionData n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiConstructTransactionData n
-> ApiConstructTransactionData n -> Bool
Eq, (forall x.
 ApiConstructTransactionData n
 -> Rep (ApiConstructTransactionData n) x)
-> (forall x.
    Rep (ApiConstructTransactionData n) x
    -> ApiConstructTransactionData n)
-> Generic (ApiConstructTransactionData n)
forall x.
Rep (ApiConstructTransactionData n) x
-> ApiConstructTransactionData n
forall x.
ApiConstructTransactionData n
-> Rep (ApiConstructTransactionData n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiConstructTransactionData n) x
-> ApiConstructTransactionData n
forall (n :: NetworkDiscriminant) x.
ApiConstructTransactionData n
-> Rep (ApiConstructTransactionData n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiConstructTransactionData n) x
-> ApiConstructTransactionData n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiConstructTransactionData n
-> Rep (ApiConstructTransactionData n) x
Generic, Int -> ApiConstructTransactionData n -> ShowS
[ApiConstructTransactionData n] -> ShowS
ApiConstructTransactionData n -> String
(Int -> ApiConstructTransactionData n -> ShowS)
-> (ApiConstructTransactionData n -> String)
-> ([ApiConstructTransactionData n] -> ShowS)
-> Show (ApiConstructTransactionData n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiConstructTransactionData n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiConstructTransactionData n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiConstructTransactionData n -> String
showList :: [ApiConstructTransactionData n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiConstructTransactionData n] -> ShowS
show :: ApiConstructTransactionData n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiConstructTransactionData n -> String
showsPrec :: Int -> ApiConstructTransactionData n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiConstructTransactionData n -> ShowS
Show, Typeable)
    deriving anyclass ApiConstructTransactionData n -> ()
(ApiConstructTransactionData n -> ())
-> NFData (ApiConstructTransactionData n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant).
ApiConstructTransactionData n -> ()
rnf :: ApiConstructTransactionData n -> ()
$crnf :: forall (n :: NetworkDiscriminant).
ApiConstructTransactionData n -> ()
NFData

data ApiPaymentDestination (n :: NetworkDiscriminant)
    = ApiPaymentAddresses !(NonEmpty (AddressAmount (ApiAddressIdT n)))
    -- ^ Pay amounts to one or more addresses.
    | ApiPaymentAll !(NonEmpty  (ApiT Address, Proxy n))
    -- ^ Migrate all money to one or more addresses.
    deriving (ApiPaymentDestination n -> ApiPaymentDestination n -> Bool
(ApiPaymentDestination n -> ApiPaymentDestination n -> Bool)
-> (ApiPaymentDestination n -> ApiPaymentDestination n -> Bool)
-> Eq (ApiPaymentDestination n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiPaymentDestination n -> ApiPaymentDestination n -> Bool
/= :: ApiPaymentDestination n -> ApiPaymentDestination n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiPaymentDestination n -> ApiPaymentDestination n -> Bool
== :: ApiPaymentDestination n -> ApiPaymentDestination n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiPaymentDestination n -> ApiPaymentDestination n -> Bool
Eq, (forall x.
 ApiPaymentDestination n -> Rep (ApiPaymentDestination n) x)
-> (forall x.
    Rep (ApiPaymentDestination n) x -> ApiPaymentDestination n)
-> Generic (ApiPaymentDestination n)
forall x.
Rep (ApiPaymentDestination n) x -> ApiPaymentDestination n
forall x.
ApiPaymentDestination n -> Rep (ApiPaymentDestination n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiPaymentDestination n) x -> ApiPaymentDestination n
forall (n :: NetworkDiscriminant) x.
ApiPaymentDestination n -> Rep (ApiPaymentDestination n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiPaymentDestination n) x -> ApiPaymentDestination n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiPaymentDestination n -> Rep (ApiPaymentDestination n) x
Generic, Int -> ApiPaymentDestination n -> ShowS
[ApiPaymentDestination n] -> ShowS
ApiPaymentDestination n -> String
(Int -> ApiPaymentDestination n -> ShowS)
-> (ApiPaymentDestination n -> String)
-> ([ApiPaymentDestination n] -> ShowS)
-> Show (ApiPaymentDestination n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiPaymentDestination n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiPaymentDestination n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiPaymentDestination n -> String
showList :: [ApiPaymentDestination n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiPaymentDestination n] -> ShowS
show :: ApiPaymentDestination n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiPaymentDestination n -> String
showsPrec :: Int -> ApiPaymentDestination n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiPaymentDestination n -> ShowS
Show, Typeable)
    deriving anyclass ApiPaymentDestination n -> ()
(ApiPaymentDestination n -> ()) -> NFData (ApiPaymentDestination n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiPaymentDestination n -> ()
rnf :: ApiPaymentDestination n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiPaymentDestination n -> ()
NFData

-- | Times where transactions are valid.
data ApiValidityInterval = ApiValidityInterval
    { ApiValidityInterval -> Maybe ApiValidityBound
invalidBefore :: !(Maybe ApiValidityBound)
    -- ^ Tx is not valid before this time. Defaults to genesis.
    , ApiValidityInterval -> Maybe ApiValidityBound
invalidHereafter :: !(Maybe ApiValidityBound)
    -- ^ Tx is not valid at this time and after. Defaults to now + 2 hours.
    } deriving (ApiValidityInterval -> ApiValidityInterval -> Bool
(ApiValidityInterval -> ApiValidityInterval -> Bool)
-> (ApiValidityInterval -> ApiValidityInterval -> Bool)
-> Eq ApiValidityInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiValidityInterval -> ApiValidityInterval -> Bool
$c/= :: ApiValidityInterval -> ApiValidityInterval -> Bool
== :: ApiValidityInterval -> ApiValidityInterval -> Bool
$c== :: ApiValidityInterval -> ApiValidityInterval -> Bool
Eq, (forall x. ApiValidityInterval -> Rep ApiValidityInterval x)
-> (forall x. Rep ApiValidityInterval x -> ApiValidityInterval)
-> Generic ApiValidityInterval
forall x. Rep ApiValidityInterval x -> ApiValidityInterval
forall x. ApiValidityInterval -> Rep ApiValidityInterval x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiValidityInterval x -> ApiValidityInterval
$cfrom :: forall x. ApiValidityInterval -> Rep ApiValidityInterval x
Generic, Int -> ApiValidityInterval -> ShowS
[ApiValidityInterval] -> ShowS
ApiValidityInterval -> String
(Int -> ApiValidityInterval -> ShowS)
-> (ApiValidityInterval -> String)
-> ([ApiValidityInterval] -> ShowS)
-> Show ApiValidityInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiValidityInterval] -> ShowS
$cshowList :: [ApiValidityInterval] -> ShowS
show :: ApiValidityInterval -> String
$cshow :: ApiValidityInterval -> String
showsPrec :: Int -> ApiValidityInterval -> ShowS
$cshowsPrec :: Int -> ApiValidityInterval -> ShowS
Show)
    deriving anyclass ApiValidityInterval -> ()
(ApiValidityInterval -> ()) -> NFData ApiValidityInterval
forall a. (a -> ()) -> NFData a
rnf :: ApiValidityInterval -> ()
$crnf :: ApiValidityInterval -> ()
NFData

-- | One side of the validity interval.
data ApiValidityBound
    = ApiValidityBoundUnspecified
    -- ^ Use the default.
    | ApiValidityBoundAsTimeFromNow !(Quantity "second" NominalDiffTime)
    -- ^ Time from transaction construction (not submission).
    | ApiValidityBoundAsSlot !(Quantity "slot" Word64)
    -- ^ Absolute slot number.
    deriving (ApiValidityBound -> ApiValidityBound -> Bool
(ApiValidityBound -> ApiValidityBound -> Bool)
-> (ApiValidityBound -> ApiValidityBound -> Bool)
-> Eq ApiValidityBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiValidityBound -> ApiValidityBound -> Bool
$c/= :: ApiValidityBound -> ApiValidityBound -> Bool
== :: ApiValidityBound -> ApiValidityBound -> Bool
$c== :: ApiValidityBound -> ApiValidityBound -> Bool
Eq, (forall x. ApiValidityBound -> Rep ApiValidityBound x)
-> (forall x. Rep ApiValidityBound x -> ApiValidityBound)
-> Generic ApiValidityBound
forall x. Rep ApiValidityBound x -> ApiValidityBound
forall x. ApiValidityBound -> Rep ApiValidityBound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiValidityBound x -> ApiValidityBound
$cfrom :: forall x. ApiValidityBound -> Rep ApiValidityBound x
Generic, Int -> ApiValidityBound -> ShowS
[ApiValidityBound] -> ShowS
ApiValidityBound -> String
(Int -> ApiValidityBound -> ShowS)
-> (ApiValidityBound -> String)
-> ([ApiValidityBound] -> ShowS)
-> Show ApiValidityBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiValidityBound] -> ShowS
$cshowList :: [ApiValidityBound] -> ShowS
show :: ApiValidityBound -> String
$cshow :: ApiValidityBound -> String
showsPrec :: Int -> ApiValidityBound -> ShowS
$cshowsPrec :: Int -> ApiValidityBound -> ShowS
Show)
    deriving anyclass ApiValidityBound -> ()
(ApiValidityBound -> ()) -> NFData ApiValidityBound
forall a. (a -> ()) -> NFData a
rnf :: ApiValidityBound -> ()
$crnf :: ApiValidityBound -> ()
NFData

data ApiSignTransactionPostData = ApiSignTransactionPostData
    { ApiSignTransactionPostData -> ApiT SealedTx
transaction :: !(ApiT SealedTx)
    , ApiSignTransactionPostData -> ApiT (Passphrase "lenient")
passphrase :: !(ApiT (Passphrase "lenient"))
    } deriving (ApiSignTransactionPostData -> ApiSignTransactionPostData -> Bool
(ApiSignTransactionPostData -> ApiSignTransactionPostData -> Bool)
-> (ApiSignTransactionPostData
    -> ApiSignTransactionPostData -> Bool)
-> Eq ApiSignTransactionPostData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiSignTransactionPostData -> ApiSignTransactionPostData -> Bool
$c/= :: ApiSignTransactionPostData -> ApiSignTransactionPostData -> Bool
== :: ApiSignTransactionPostData -> ApiSignTransactionPostData -> Bool
$c== :: ApiSignTransactionPostData -> ApiSignTransactionPostData -> Bool
Eq, (forall x.
 ApiSignTransactionPostData -> Rep ApiSignTransactionPostData x)
-> (forall x.
    Rep ApiSignTransactionPostData x -> ApiSignTransactionPostData)
-> Generic ApiSignTransactionPostData
forall x.
Rep ApiSignTransactionPostData x -> ApiSignTransactionPostData
forall x.
ApiSignTransactionPostData -> Rep ApiSignTransactionPostData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiSignTransactionPostData x -> ApiSignTransactionPostData
$cfrom :: forall x.
ApiSignTransactionPostData -> Rep ApiSignTransactionPostData x
Generic, Int -> ApiSignTransactionPostData -> ShowS
[ApiSignTransactionPostData] -> ShowS
ApiSignTransactionPostData -> String
(Int -> ApiSignTransactionPostData -> ShowS)
-> (ApiSignTransactionPostData -> String)
-> ([ApiSignTransactionPostData] -> ShowS)
-> Show ApiSignTransactionPostData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiSignTransactionPostData] -> ShowS
$cshowList :: [ApiSignTransactionPostData] -> ShowS
show :: ApiSignTransactionPostData -> String
$cshow :: ApiSignTransactionPostData -> String
showsPrec :: Int -> ApiSignTransactionPostData -> ShowS
$cshowsPrec :: Int -> ApiSignTransactionPostData -> ShowS
Show)

-- | Legacy transaction API.
data PostTransactionOldData (n :: NetworkDiscriminant) = PostTransactionOldData
    { PostTransactionOldData n -> NonEmpty (ApiTxOutput n)
payments :: !(NonEmpty (ApiTxOutput n))
    , PostTransactionOldData n -> ApiT (Passphrase "lenient")
passphrase :: !(ApiT (Passphrase "lenient"))
    , PostTransactionOldData n -> Maybe ApiWithdrawalPostData
withdrawal :: !(Maybe ApiWithdrawalPostData)
    , PostTransactionOldData n -> Maybe TxMetadataWithSchema
metadata :: !(Maybe TxMetadataWithSchema)
    , PostTransactionOldData n
-> Maybe (Quantity "second" NominalDiffTime)
timeToLive :: !(Maybe (Quantity "second" NominalDiffTime))
    } deriving (PostTransactionOldData n -> PostTransactionOldData n -> Bool
(PostTransactionOldData n -> PostTransactionOldData n -> Bool)
-> (PostTransactionOldData n -> PostTransactionOldData n -> Bool)
-> Eq (PostTransactionOldData n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
PostTransactionOldData n -> PostTransactionOldData n -> Bool
/= :: PostTransactionOldData n -> PostTransactionOldData n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
PostTransactionOldData n -> PostTransactionOldData n -> Bool
== :: PostTransactionOldData n -> PostTransactionOldData n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
PostTransactionOldData n -> PostTransactionOldData n -> Bool
Eq, (forall x.
 PostTransactionOldData n -> Rep (PostTransactionOldData n) x)
-> (forall x.
    Rep (PostTransactionOldData n) x -> PostTransactionOldData n)
-> Generic (PostTransactionOldData n)
forall x.
Rep (PostTransactionOldData n) x -> PostTransactionOldData n
forall x.
PostTransactionOldData n -> Rep (PostTransactionOldData n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (PostTransactionOldData n) x -> PostTransactionOldData n
forall (n :: NetworkDiscriminant) x.
PostTransactionOldData n -> Rep (PostTransactionOldData n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (PostTransactionOldData n) x -> PostTransactionOldData n
$cfrom :: forall (n :: NetworkDiscriminant) x.
PostTransactionOldData n -> Rep (PostTransactionOldData n) x
Generic, Int -> PostTransactionOldData n -> ShowS
[PostTransactionOldData n] -> ShowS
PostTransactionOldData n -> String
(Int -> PostTransactionOldData n -> ShowS)
-> (PostTransactionOldData n -> String)
-> ([PostTransactionOldData n] -> ShowS)
-> Show (PostTransactionOldData n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> PostTransactionOldData n -> ShowS
forall (n :: NetworkDiscriminant).
[PostTransactionOldData n] -> ShowS
forall (n :: NetworkDiscriminant).
PostTransactionOldData n -> String
showList :: [PostTransactionOldData n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[PostTransactionOldData n] -> ShowS
show :: PostTransactionOldData n -> String
$cshow :: forall (n :: NetworkDiscriminant).
PostTransactionOldData n -> String
showsPrec :: Int -> PostTransactionOldData n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> PostTransactionOldData n -> ShowS
Show, Typeable)

-- | Legacy transaction API.
data PostTransactionFeeOldData (n :: NetworkDiscriminant) = PostTransactionFeeOldData
    { PostTransactionFeeOldData n -> NonEmpty (ApiTxOutput n)
payments :: !(NonEmpty (ApiTxOutput n))
    , PostTransactionFeeOldData n -> Maybe ApiWithdrawalPostData
withdrawal :: !(Maybe ApiWithdrawalPostData)
    , PostTransactionFeeOldData n -> Maybe TxMetadataWithSchema
metadata :: !(Maybe TxMetadataWithSchema )
    , PostTransactionFeeOldData n
-> Maybe (Quantity "second" NominalDiffTime)
timeToLive :: !(Maybe (Quantity "second" NominalDiffTime))
    } deriving (PostTransactionFeeOldData n -> PostTransactionFeeOldData n -> Bool
(PostTransactionFeeOldData n
 -> PostTransactionFeeOldData n -> Bool)
-> (PostTransactionFeeOldData n
    -> PostTransactionFeeOldData n -> Bool)
-> Eq (PostTransactionFeeOldData n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
PostTransactionFeeOldData n -> PostTransactionFeeOldData n -> Bool
/= :: PostTransactionFeeOldData n -> PostTransactionFeeOldData n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
PostTransactionFeeOldData n -> PostTransactionFeeOldData n -> Bool
== :: PostTransactionFeeOldData n -> PostTransactionFeeOldData n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
PostTransactionFeeOldData n -> PostTransactionFeeOldData n -> Bool
Eq, (forall x.
 PostTransactionFeeOldData n -> Rep (PostTransactionFeeOldData n) x)
-> (forall x.
    Rep (PostTransactionFeeOldData n) x -> PostTransactionFeeOldData n)
-> Generic (PostTransactionFeeOldData n)
forall x.
Rep (PostTransactionFeeOldData n) x -> PostTransactionFeeOldData n
forall x.
PostTransactionFeeOldData n -> Rep (PostTransactionFeeOldData n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (PostTransactionFeeOldData n) x -> PostTransactionFeeOldData n
forall (n :: NetworkDiscriminant) x.
PostTransactionFeeOldData n -> Rep (PostTransactionFeeOldData n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (PostTransactionFeeOldData n) x -> PostTransactionFeeOldData n
$cfrom :: forall (n :: NetworkDiscriminant) x.
PostTransactionFeeOldData n -> Rep (PostTransactionFeeOldData n) x
Generic, Int -> PostTransactionFeeOldData n -> ShowS
[PostTransactionFeeOldData n] -> ShowS
PostTransactionFeeOldData n -> String
(Int -> PostTransactionFeeOldData n -> ShowS)
-> (PostTransactionFeeOldData n -> String)
-> ([PostTransactionFeeOldData n] -> ShowS)
-> Show (PostTransactionFeeOldData n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> PostTransactionFeeOldData n -> ShowS
forall (n :: NetworkDiscriminant).
[PostTransactionFeeOldData n] -> ShowS
forall (n :: NetworkDiscriminant).
PostTransactionFeeOldData n -> String
showList :: [PostTransactionFeeOldData n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[PostTransactionFeeOldData n] -> ShowS
show :: PostTransactionFeeOldData n -> String
$cshow :: forall (n :: NetworkDiscriminant).
PostTransactionFeeOldData n -> String
showsPrec :: Int -> PostTransactionFeeOldData n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> PostTransactionFeeOldData n -> ShowS
Show, Typeable)

type ApiBase64 = ApiBytesT 'Base64 ByteString

newtype ApiSerialisedTransaction = ApiSerialisedTransaction
    { ApiSerialisedTransaction -> ApiT SealedTx
transaction :: ApiT SealedTx
    } deriving stock (ApiSerialisedTransaction -> ApiSerialisedTransaction -> Bool
(ApiSerialisedTransaction -> ApiSerialisedTransaction -> Bool)
-> (ApiSerialisedTransaction -> ApiSerialisedTransaction -> Bool)
-> Eq ApiSerialisedTransaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiSerialisedTransaction -> ApiSerialisedTransaction -> Bool
$c/= :: ApiSerialisedTransaction -> ApiSerialisedTransaction -> Bool
== :: ApiSerialisedTransaction -> ApiSerialisedTransaction -> Bool
$c== :: ApiSerialisedTransaction -> ApiSerialisedTransaction -> Bool
Eq, (forall x.
 ApiSerialisedTransaction -> Rep ApiSerialisedTransaction x)
-> (forall x.
    Rep ApiSerialisedTransaction x -> ApiSerialisedTransaction)
-> Generic ApiSerialisedTransaction
forall x.
Rep ApiSerialisedTransaction x -> ApiSerialisedTransaction
forall x.
ApiSerialisedTransaction -> Rep ApiSerialisedTransaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiSerialisedTransaction x -> ApiSerialisedTransaction
$cfrom :: forall x.
ApiSerialisedTransaction -> Rep ApiSerialisedTransaction x
Generic, Int -> ApiSerialisedTransaction -> ShowS
[ApiSerialisedTransaction] -> ShowS
ApiSerialisedTransaction -> String
(Int -> ApiSerialisedTransaction -> ShowS)
-> (ApiSerialisedTransaction -> String)
-> ([ApiSerialisedTransaction] -> ShowS)
-> Show ApiSerialisedTransaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiSerialisedTransaction] -> ShowS
$cshowList :: [ApiSerialisedTransaction] -> ShowS
show :: ApiSerialisedTransaction -> String
$cshow :: ApiSerialisedTransaction -> String
showsPrec :: Int -> ApiSerialisedTransaction -> ShowS
$cshowsPrec :: Int -> ApiSerialisedTransaction -> ShowS
Show)
      deriving anyclass (ApiSerialisedTransaction -> ()
(ApiSerialisedTransaction -> ()) -> NFData ApiSerialisedTransaction
forall a. (a -> ()) -> NFData a
rnf :: ApiSerialisedTransaction -> ()
$crnf :: ApiSerialisedTransaction -> ()
NFData)

data ApiExternalInput (n :: NetworkDiscriminant) = ApiExternalInput
    { ApiExternalInput n -> ApiT (Hash "Tx")
id :: !(ApiT (Hash "Tx"))
    , ApiExternalInput n -> Word32
index :: !Word32
    , ApiExternalInput n -> (ApiT Address, Proxy n)
address :: !(ApiT Address, Proxy n)
    , ApiExternalInput n -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
    , ApiExternalInput n -> ApiT TokenMap
assets :: !(ApiT W.TokenMap)
    , ApiExternalInput n -> Maybe (ApiT (Hash "Datum"))
datum :: !(Maybe (ApiT (Hash "Datum")))
    } deriving (ApiExternalInput n -> ApiExternalInput n -> Bool
(ApiExternalInput n -> ApiExternalInput n -> Bool)
-> (ApiExternalInput n -> ApiExternalInput n -> Bool)
-> Eq (ApiExternalInput n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiExternalInput n -> ApiExternalInput n -> Bool
/= :: ApiExternalInput n -> ApiExternalInput n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiExternalInput n -> ApiExternalInput n -> Bool
== :: ApiExternalInput n -> ApiExternalInput n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiExternalInput n -> ApiExternalInput n -> Bool
Eq, (forall x. ApiExternalInput n -> Rep (ApiExternalInput n) x)
-> (forall x. Rep (ApiExternalInput n) x -> ApiExternalInput n)
-> Generic (ApiExternalInput n)
forall x. Rep (ApiExternalInput n) x -> ApiExternalInput n
forall x. ApiExternalInput n -> Rep (ApiExternalInput n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiExternalInput n) x -> ApiExternalInput n
forall (n :: NetworkDiscriminant) x.
ApiExternalInput n -> Rep (ApiExternalInput n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiExternalInput n) x -> ApiExternalInput n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiExternalInput n -> Rep (ApiExternalInput n) x
Generic, Int -> ApiExternalInput n -> ShowS
[ApiExternalInput n] -> ShowS
ApiExternalInput n -> String
(Int -> ApiExternalInput n -> ShowS)
-> (ApiExternalInput n -> String)
-> ([ApiExternalInput n] -> ShowS)
-> Show (ApiExternalInput n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiExternalInput n -> ShowS
forall (n :: NetworkDiscriminant). [ApiExternalInput n] -> ShowS
forall (n :: NetworkDiscriminant). ApiExternalInput n -> String
showList :: [ApiExternalInput n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiExternalInput n] -> ShowS
show :: ApiExternalInput n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiExternalInput n -> String
showsPrec :: Int -> ApiExternalInput n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiExternalInput n -> ShowS
Show, Typeable)
      deriving anyclass ApiExternalInput n -> ()
(ApiExternalInput n -> ()) -> NFData (ApiExternalInput n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiExternalInput n -> ()
rnf :: ApiExternalInput n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiExternalInput n -> ()
NFData

data ApiBalanceTransactionPostData (n :: NetworkDiscriminant) = ApiBalanceTransactionPostData
    { ApiBalanceTransactionPostData n -> ApiT SealedTx
transaction :: !(ApiT SealedTx)
    , ApiBalanceTransactionPostData n -> [ApiExternalInput n]
inputs :: ![ApiExternalInput n]
    , ApiBalanceTransactionPostData n -> [ApiRedeemer n]
redeemers :: ![ApiRedeemer n]
    } deriving (ApiBalanceTransactionPostData n
-> ApiBalanceTransactionPostData n -> Bool
(ApiBalanceTransactionPostData n
 -> ApiBalanceTransactionPostData n -> Bool)
-> (ApiBalanceTransactionPostData n
    -> ApiBalanceTransactionPostData n -> Bool)
-> Eq (ApiBalanceTransactionPostData n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiBalanceTransactionPostData n
-> ApiBalanceTransactionPostData n -> Bool
/= :: ApiBalanceTransactionPostData n
-> ApiBalanceTransactionPostData n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiBalanceTransactionPostData n
-> ApiBalanceTransactionPostData n -> Bool
== :: ApiBalanceTransactionPostData n
-> ApiBalanceTransactionPostData n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiBalanceTransactionPostData n
-> ApiBalanceTransactionPostData n -> Bool
Eq, (forall x.
 ApiBalanceTransactionPostData n
 -> Rep (ApiBalanceTransactionPostData n) x)
-> (forall x.
    Rep (ApiBalanceTransactionPostData n) x
    -> ApiBalanceTransactionPostData n)
-> Generic (ApiBalanceTransactionPostData n)
forall x.
Rep (ApiBalanceTransactionPostData n) x
-> ApiBalanceTransactionPostData n
forall x.
ApiBalanceTransactionPostData n
-> Rep (ApiBalanceTransactionPostData n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiBalanceTransactionPostData n) x
-> ApiBalanceTransactionPostData n
forall (n :: NetworkDiscriminant) x.
ApiBalanceTransactionPostData n
-> Rep (ApiBalanceTransactionPostData n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiBalanceTransactionPostData n) x
-> ApiBalanceTransactionPostData n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiBalanceTransactionPostData n
-> Rep (ApiBalanceTransactionPostData n) x
Generic, Int -> ApiBalanceTransactionPostData n -> ShowS
[ApiBalanceTransactionPostData n] -> ShowS
ApiBalanceTransactionPostData n -> String
(Int -> ApiBalanceTransactionPostData n -> ShowS)
-> (ApiBalanceTransactionPostData n -> String)
-> ([ApiBalanceTransactionPostData n] -> ShowS)
-> Show (ApiBalanceTransactionPostData n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiBalanceTransactionPostData n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiBalanceTransactionPostData n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiBalanceTransactionPostData n -> String
showList :: [ApiBalanceTransactionPostData n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiBalanceTransactionPostData n] -> ShowS
show :: ApiBalanceTransactionPostData n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiBalanceTransactionPostData n -> String
showsPrec :: Int -> ApiBalanceTransactionPostData n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiBalanceTransactionPostData n -> ShowS
Show)

type ApiRedeemerData = ApiBytesT 'Base16 ByteString

data ApiRedeemer (n :: NetworkDiscriminant)
    = ApiRedeemerSpending ApiRedeemerData (ApiT TxIn)
    | ApiRedeemerMinting ApiRedeemerData (ApiT W.TokenPolicyId)
    | ApiRedeemerRewarding ApiRedeemerData StakeAddress
    deriving (ApiRedeemer n -> ApiRedeemer n -> Bool
(ApiRedeemer n -> ApiRedeemer n -> Bool)
-> (ApiRedeemer n -> ApiRedeemer n -> Bool) -> Eq (ApiRedeemer n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiRedeemer n -> ApiRedeemer n -> Bool
/= :: ApiRedeemer n -> ApiRedeemer n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiRedeemer n -> ApiRedeemer n -> Bool
== :: ApiRedeemer n -> ApiRedeemer n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiRedeemer n -> ApiRedeemer n -> Bool
Eq, (forall x. ApiRedeemer n -> Rep (ApiRedeemer n) x)
-> (forall x. Rep (ApiRedeemer n) x -> ApiRedeemer n)
-> Generic (ApiRedeemer n)
forall x. Rep (ApiRedeemer n) x -> ApiRedeemer n
forall x. ApiRedeemer n -> Rep (ApiRedeemer n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiRedeemer n) x -> ApiRedeemer n
forall (n :: NetworkDiscriminant) x.
ApiRedeemer n -> Rep (ApiRedeemer n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiRedeemer n) x -> ApiRedeemer n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiRedeemer n -> Rep (ApiRedeemer n) x
Generic, Int -> ApiRedeemer n -> ShowS
[ApiRedeemer n] -> ShowS
ApiRedeemer n -> String
(Int -> ApiRedeemer n -> ShowS)
-> (ApiRedeemer n -> String)
-> ([ApiRedeemer n] -> ShowS)
-> Show (ApiRedeemer n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant). Int -> ApiRedeemer n -> ShowS
forall (n :: NetworkDiscriminant). [ApiRedeemer n] -> ShowS
forall (n :: NetworkDiscriminant). ApiRedeemer n -> String
showList :: [ApiRedeemer n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiRedeemer n] -> ShowS
show :: ApiRedeemer n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiRedeemer n -> String
showsPrec :: Int -> ApiRedeemer n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant). Int -> ApiRedeemer n -> ShowS
Show)

data ApiFee = ApiFee
    { ApiFee -> Quantity "lovelace" Natural
estimatedMin :: !(Quantity "lovelace" Natural)
    , ApiFee -> Quantity "lovelace" Natural
estimatedMax :: !(Quantity "lovelace" Natural)
    , ApiFee -> [Quantity "lovelace" Natural]
minimumCoins :: ![Quantity "lovelace" Natural]
    , ApiFee -> Quantity "lovelace" Natural
deposit :: !(Quantity "lovelace" Natural)
    } deriving (ApiFee -> ApiFee -> Bool
(ApiFee -> ApiFee -> Bool)
-> (ApiFee -> ApiFee -> Bool) -> Eq ApiFee
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiFee -> ApiFee -> Bool
$c/= :: ApiFee -> ApiFee -> Bool
== :: ApiFee -> ApiFee -> Bool
$c== :: ApiFee -> ApiFee -> Bool
Eq, (forall x. ApiFee -> Rep ApiFee x)
-> (forall x. Rep ApiFee x -> ApiFee) -> Generic ApiFee
forall x. Rep ApiFee x -> ApiFee
forall x. ApiFee -> Rep ApiFee x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiFee x -> ApiFee
$cfrom :: forall x. ApiFee -> Rep ApiFee x
Generic, Int -> ApiFee -> ShowS
[ApiFee] -> ShowS
ApiFee -> String
(Int -> ApiFee -> ShowS)
-> (ApiFee -> String) -> ([ApiFee] -> ShowS) -> Show ApiFee
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiFee] -> ShowS
$cshowList :: [ApiFee] -> ShowS
show :: ApiFee -> String
$cshow :: ApiFee -> String
showsPrec :: Int -> ApiFee -> ShowS
$cshowsPrec :: Int -> ApiFee -> ShowS
Show)

data ApiNetworkParameters = ApiNetworkParameters
    { ApiNetworkParameters -> ApiT (Hash "Genesis")
genesisBlockHash :: !(ApiT (Hash "Genesis"))
    , ApiNetworkParameters -> ApiT StartTime
blockchainStartTime :: !(ApiT StartTime)
    , ApiNetworkParameters -> Quantity "second" NominalDiffTime
slotLength :: !(Quantity "second" NominalDiffTime)
    , ApiNetworkParameters -> Quantity "slot" Word32
epochLength :: !(Quantity "slot" Word32)
    , ApiNetworkParameters -> Quantity "block" Word32
securityParameter :: !(Quantity "block" Word32)
    , ApiNetworkParameters -> Quantity "percent" Double
activeSlotCoefficient :: !(Quantity "percent" Double)
    , ApiNetworkParameters -> Quantity "percent" Percentage
decentralizationLevel :: !(Quantity "percent" Percentage)
    , ApiNetworkParameters -> Word16
desiredPoolNumber :: !Word16
    , ApiNetworkParameters -> Quantity "lovelace" Natural
minimumUtxoValue :: !(Quantity "lovelace" Natural)
    , ApiNetworkParameters -> Quantity "byte" Natural
maximumTokenBundleSize :: !(Quantity "byte" Natural)
    , ApiNetworkParameters -> ApiEraInfo
eras :: !ApiEraInfo
    , ApiNetworkParameters -> Word16
maximumCollateralInputCount :: !Word16
    , ApiNetworkParameters -> Natural
minimumCollateralPercentage :: !Natural
    , ApiNetworkParameters -> Maybe ExecutionUnitPrices
executionUnitPrices :: !(Maybe ExecutionUnitPrices)
    } deriving (ApiNetworkParameters -> ApiNetworkParameters -> Bool
(ApiNetworkParameters -> ApiNetworkParameters -> Bool)
-> (ApiNetworkParameters -> ApiNetworkParameters -> Bool)
-> Eq ApiNetworkParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiNetworkParameters -> ApiNetworkParameters -> Bool
$c/= :: ApiNetworkParameters -> ApiNetworkParameters -> Bool
== :: ApiNetworkParameters -> ApiNetworkParameters -> Bool
$c== :: ApiNetworkParameters -> ApiNetworkParameters -> Bool
Eq, (forall x. ApiNetworkParameters -> Rep ApiNetworkParameters x)
-> (forall x. Rep ApiNetworkParameters x -> ApiNetworkParameters)
-> Generic ApiNetworkParameters
forall x. Rep ApiNetworkParameters x -> ApiNetworkParameters
forall x. ApiNetworkParameters -> Rep ApiNetworkParameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiNetworkParameters x -> ApiNetworkParameters
$cfrom :: forall x. ApiNetworkParameters -> Rep ApiNetworkParameters x
Generic, Int -> ApiNetworkParameters -> ShowS
[ApiNetworkParameters] -> ShowS
ApiNetworkParameters -> String
(Int -> ApiNetworkParameters -> ShowS)
-> (ApiNetworkParameters -> String)
-> ([ApiNetworkParameters] -> ShowS)
-> Show ApiNetworkParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiNetworkParameters] -> ShowS
$cshowList :: [ApiNetworkParameters] -> ShowS
show :: ApiNetworkParameters -> String
$cshow :: ApiNetworkParameters -> String
showsPrec :: Int -> ApiNetworkParameters -> ShowS
$cshowsPrec :: Int -> ApiNetworkParameters -> ShowS
Show)

data ApiEraInfo = ApiEraInfo
    { ApiEraInfo -> Maybe ApiEpochInfo
byron :: !(Maybe ApiEpochInfo)
    , ApiEraInfo -> Maybe ApiEpochInfo
shelley :: !(Maybe ApiEpochInfo)
    , ApiEraInfo -> Maybe ApiEpochInfo
allegra :: !(Maybe ApiEpochInfo)
    , ApiEraInfo -> Maybe ApiEpochInfo
mary :: !(Maybe ApiEpochInfo)
    , ApiEraInfo -> Maybe ApiEpochInfo
alonzo :: !(Maybe ApiEpochInfo)
    , ApiEraInfo -> Maybe ApiEpochInfo
babbage :: !(Maybe ApiEpochInfo)
    } deriving (ApiEraInfo -> ApiEraInfo -> Bool
(ApiEraInfo -> ApiEraInfo -> Bool)
-> (ApiEraInfo -> ApiEraInfo -> Bool) -> Eq ApiEraInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiEraInfo -> ApiEraInfo -> Bool
$c/= :: ApiEraInfo -> ApiEraInfo -> Bool
== :: ApiEraInfo -> ApiEraInfo -> Bool
$c== :: ApiEraInfo -> ApiEraInfo -> Bool
Eq, (forall x. ApiEraInfo -> Rep ApiEraInfo x)
-> (forall x. Rep ApiEraInfo x -> ApiEraInfo) -> Generic ApiEraInfo
forall x. Rep ApiEraInfo x -> ApiEraInfo
forall x. ApiEraInfo -> Rep ApiEraInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiEraInfo x -> ApiEraInfo
$cfrom :: forall x. ApiEraInfo -> Rep ApiEraInfo x
Generic, Int -> ApiEraInfo -> ShowS
[ApiEraInfo] -> ShowS
ApiEraInfo -> String
(Int -> ApiEraInfo -> ShowS)
-> (ApiEraInfo -> String)
-> ([ApiEraInfo] -> ShowS)
-> Show ApiEraInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiEraInfo] -> ShowS
$cshowList :: [ApiEraInfo] -> ShowS
show :: ApiEraInfo -> String
$cshow :: ApiEraInfo -> String
showsPrec :: Int -> ApiEraInfo -> ShowS
$cshowsPrec :: Int -> ApiEraInfo -> ShowS
Show)

toApiNetworkParameters
    :: Monad m
    => NetworkParameters
    -> TxConstraints
    -> (EpochNo -> m ApiEpochInfo)
    -> m ApiNetworkParameters
toApiNetworkParameters :: NetworkParameters
-> TxConstraints
-> (EpochNo -> m ApiEpochInfo)
-> m ApiNetworkParameters
toApiNetworkParameters (NetworkParameters GenesisParameters
gp SlottingParameters
sp ProtocolParameters
pp) TxConstraints
txConstraints EpochNo -> m ApiEpochInfo
toEpochInfo = do
    Maybe ApiEpochInfo
byron <- (EpochNo -> m ApiEpochInfo)
-> Maybe EpochNo -> m (Maybe ApiEpochInfo)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse EpochNo -> m ApiEpochInfo
toEpochInfo (ProtocolParameters
pp ProtocolParameters
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> Maybe EpochNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "eras"
  ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
   -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
(EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters
#eras ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
 -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> (Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> ProtocolParameters
-> Const (Maybe EpochNo) ProtocolParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "byron"
  ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
   -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
(Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo)
#byron)
    Maybe ApiEpochInfo
shelley <- (EpochNo -> m ApiEpochInfo)
-> Maybe EpochNo -> m (Maybe ApiEpochInfo)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse EpochNo -> m ApiEpochInfo
toEpochInfo (ProtocolParameters
pp ProtocolParameters
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> Maybe EpochNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "eras"
  ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
   -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
(EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters
#eras ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
 -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> (Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> ProtocolParameters
-> Const (Maybe EpochNo) ProtocolParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "shelley"
  ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
   -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
(Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo)
#shelley)
    Maybe ApiEpochInfo
allegra <- (EpochNo -> m ApiEpochInfo)
-> Maybe EpochNo -> m (Maybe ApiEpochInfo)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse EpochNo -> m ApiEpochInfo
toEpochInfo (ProtocolParameters
pp ProtocolParameters
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> Maybe EpochNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "eras"
  ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
   -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
(EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters
#eras ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
 -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> (Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> ProtocolParameters
-> Const (Maybe EpochNo) ProtocolParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "allegra"
  ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
   -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
(Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo)
#allegra)
    Maybe ApiEpochInfo
mary <- (EpochNo -> m ApiEpochInfo)
-> Maybe EpochNo -> m (Maybe ApiEpochInfo)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse EpochNo -> m ApiEpochInfo
toEpochInfo (ProtocolParameters
pp ProtocolParameters
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> Maybe EpochNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "eras"
  ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
   -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
(EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters
#eras ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
 -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> (Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> ProtocolParameters
-> Const (Maybe EpochNo) ProtocolParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "mary"
  ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
   -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
(Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo)
#mary)
    Maybe ApiEpochInfo
alonzo <- (EpochNo -> m ApiEpochInfo)
-> Maybe EpochNo -> m (Maybe ApiEpochInfo)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse EpochNo -> m ApiEpochInfo
toEpochInfo (ProtocolParameters
pp ProtocolParameters
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> Maybe EpochNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "eras"
  ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
   -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
(EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters
#eras ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
 -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> (Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> ProtocolParameters
-> Const (Maybe EpochNo) ProtocolParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "alonzo"
  ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
   -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
(Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo)
#alonzo)
    Maybe ApiEpochInfo
babbage <- (EpochNo -> m ApiEpochInfo)
-> Maybe EpochNo -> m (Maybe ApiEpochInfo)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse EpochNo -> m ApiEpochInfo
toEpochInfo (ProtocolParameters
pp ProtocolParameters
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> Maybe EpochNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "eras"
  ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
   -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
(EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters
#eras ((EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
 -> ProtocolParameters -> Const (Maybe EpochNo) ProtocolParameters)
-> ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
    -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
-> (Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> ProtocolParameters
-> Const (Maybe EpochNo) ProtocolParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "babbage"
  ((Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
   -> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo))
(Maybe EpochNo -> Const (Maybe EpochNo) (Maybe EpochNo))
-> EraInfo EpochNo -> Const (Maybe EpochNo) (EraInfo EpochNo)
#babbage)

    let apiEras :: ApiEraInfo
apiEras = ApiEraInfo :: Maybe ApiEpochInfo
-> Maybe ApiEpochInfo
-> Maybe ApiEpochInfo
-> Maybe ApiEpochInfo
-> Maybe ApiEpochInfo
-> Maybe ApiEpochInfo
-> ApiEraInfo
ApiEraInfo { Maybe ApiEpochInfo
byron :: Maybe ApiEpochInfo
$sel:byron:ApiEraInfo :: Maybe ApiEpochInfo
byron, Maybe ApiEpochInfo
shelley :: Maybe ApiEpochInfo
$sel:shelley:ApiEraInfo :: Maybe ApiEpochInfo
shelley, Maybe ApiEpochInfo
allegra :: Maybe ApiEpochInfo
$sel:allegra:ApiEraInfo :: Maybe ApiEpochInfo
allegra, Maybe ApiEpochInfo
mary :: Maybe ApiEpochInfo
$sel:mary:ApiEraInfo :: Maybe ApiEpochInfo
mary, Maybe ApiEpochInfo
alonzo :: Maybe ApiEpochInfo
$sel:alonzo:ApiEraInfo :: Maybe ApiEpochInfo
alonzo, Maybe ApiEpochInfo
babbage :: Maybe ApiEpochInfo
$sel:babbage:ApiEraInfo :: Maybe ApiEpochInfo
babbage }

    ApiNetworkParameters -> m ApiNetworkParameters
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiNetworkParameters -> m ApiNetworkParameters)
-> ApiNetworkParameters -> m ApiNetworkParameters
forall a b. (a -> b) -> a -> b
$ ApiNetworkParameters :: ApiT (Hash "Genesis")
-> ApiT StartTime
-> Quantity "second" NominalDiffTime
-> Quantity "slot" Word32
-> Quantity "block" Word32
-> Quantity "percent" Double
-> Quantity "percent" Percentage
-> Word16
-> Quantity "lovelace" Natural
-> Quantity "byte" Natural
-> ApiEraInfo
-> Word16
-> Natural
-> Maybe ExecutionUnitPrices
-> ApiNetworkParameters
ApiNetworkParameters
        { $sel:genesisBlockHash:ApiNetworkParameters :: ApiT (Hash "Genesis")
genesisBlockHash = Hash "Genesis" -> ApiT (Hash "Genesis")
forall a. a -> ApiT a
ApiT (Hash "Genesis" -> ApiT (Hash "Genesis"))
-> Hash "Genesis" -> ApiT (Hash "Genesis")
forall a b. (a -> b) -> a -> b
$ GenesisParameters -> Hash "Genesis"
getGenesisBlockHash GenesisParameters
gp
        , $sel:blockchainStartTime:ApiNetworkParameters :: ApiT StartTime
blockchainStartTime = StartTime -> ApiT StartTime
forall a. a -> ApiT a
ApiT (StartTime -> ApiT StartTime) -> StartTime -> ApiT StartTime
forall a b. (a -> b) -> a -> b
$ GenesisParameters -> StartTime
getGenesisBlockDate GenesisParameters
gp
        , $sel:slotLength:ApiNetworkParameters :: Quantity "second" NominalDiffTime
slotLength = NominalDiffTime -> Quantity "second" NominalDiffTime
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (NominalDiffTime -> Quantity "second" NominalDiffTime)
-> NominalDiffTime -> Quantity "second" NominalDiffTime
forall a b. (a -> b) -> a -> b
$ SlotLength -> NominalDiffTime
unSlotLength (SlotLength -> NominalDiffTime) -> SlotLength -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ SlottingParameters -> SlotLength
getSlotLength SlottingParameters
sp
        , $sel:epochLength:ApiNetworkParameters :: Quantity "slot" Word32
epochLength = Word32 -> Quantity "slot" Word32
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Word32 -> Quantity "slot" Word32)
-> Word32 -> Quantity "slot" Word32
forall a b. (a -> b) -> a -> b
$ EpochLength -> Word32
unEpochLength (EpochLength -> Word32) -> EpochLength -> Word32
forall a b. (a -> b) -> a -> b
$ SlottingParameters -> EpochLength
getEpochLength SlottingParameters
sp
        , $sel:securityParameter:ApiNetworkParameters :: Quantity "block" Word32
securityParameter = SlottingParameters -> Quantity "block" Word32
getSecurityParameter SlottingParameters
sp
        , $sel:activeSlotCoefficient:ApiNetworkParameters :: Quantity "percent" Double
activeSlotCoefficient = Double -> Quantity "percent" Double
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity
            (Double -> Quantity "percent" Double)
-> Double -> Quantity "percent" Double
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
100)
            (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ ActiveSlotCoefficient -> Double
unActiveSlotCoefficient
            (ActiveSlotCoefficient -> Double)
-> ActiveSlotCoefficient -> Double
forall a b. (a -> b) -> a -> b
$ SlottingParameters -> ActiveSlotCoefficient
getActiveSlotCoefficient SlottingParameters
sp
        , $sel:decentralizationLevel:ApiNetworkParameters :: Quantity "percent" Percentage
decentralizationLevel = Percentage -> Quantity "percent" Percentage
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity
            (Percentage -> Quantity "percent" Percentage)
-> Percentage -> Quantity "percent" Percentage
forall a b. (a -> b) -> a -> b
$ DecentralizationLevel -> Percentage
getDecentralizationLevel
            (DecentralizationLevel -> Percentage)
-> DecentralizationLevel -> Percentage
forall a b. (a -> b) -> a -> b
$ ((DecentralizationLevel
  -> Const DecentralizationLevel DecentralizationLevel)
 -> ProtocolParameters
 -> Const DecentralizationLevel ProtocolParameters)
-> ProtocolParameters -> DecentralizationLevel
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "decentralizationLevel"
  ((DecentralizationLevel
    -> Const DecentralizationLevel DecentralizationLevel)
   -> ProtocolParameters
   -> Const DecentralizationLevel ProtocolParameters)
(DecentralizationLevel
 -> Const DecentralizationLevel DecentralizationLevel)
-> ProtocolParameters
-> Const DecentralizationLevel ProtocolParameters
#decentralizationLevel ProtocolParameters
pp
        , $sel:desiredPoolNumber:ApiNetworkParameters :: Word16
desiredPoolNumber = ((Word16 -> Const Word16 Word16)
 -> ProtocolParameters -> Const Word16 ProtocolParameters)
-> ProtocolParameters -> Word16
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "desiredNumberOfStakePools"
  ((Word16 -> Const Word16 Word16)
   -> ProtocolParameters -> Const Word16 ProtocolParameters)
(Word16 -> Const Word16 Word16)
-> ProtocolParameters -> Const Word16 ProtocolParameters
#desiredNumberOfStakePools ProtocolParameters
pp
        , $sel:minimumUtxoValue:ApiNetworkParameters :: Quantity "lovelace" Natural
minimumUtxoValue = Coin -> Quantity "lovelace" Natural
forall (unit :: Symbol). Coin -> Quantity unit Natural
toApiCoin (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$
            -- NOTE:
            --
            -- In eras prior to Babbage, the ledger minimum UTxO function was
            -- independent of the length of an address.
            --
            -- However, from the Babbage era onwards, the ledger minimum UTxO
            -- function is *dependent* on the length of an address: longer
            -- addresses give rise to greater minimum UTxO values.
            --
            -- Since address lengths are variable, there is no single ideal
            -- constant that we can return here.
            --
            -- Therefore, we return the absolute minimum UTxO quantity for an
            -- output that sends ada (and no other assets) to an address of the
            -- minimum possible length.
            --
            -- We should consider deprecating this parameter, and replacing it
            -- with era-specific protocol parameters such as:
            --
            -- - lovelacePerUTxOWord (Alonzo)
            -- - lovelacePerUTxOByte (Babbage)
            --
            TxConstraints -> Address -> TokenMap -> Coin
txOutputMinimumAdaQuantity
                TxConstraints
txConstraints Address
minLengthAddress TokenMap
TokenMap.empty
        , $sel:eras:ApiNetworkParameters :: ApiEraInfo
eras = ApiEraInfo
apiEras
        , $sel:maximumCollateralInputCount:ApiNetworkParameters :: Word16
maximumCollateralInputCount =
            ((Word16 -> Const Word16 Word16)
 -> ProtocolParameters -> Const Word16 ProtocolParameters)
-> ProtocolParameters -> Word16
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "maximumCollateralInputCount"
  ((Word16 -> Const Word16 Word16)
   -> ProtocolParameters -> Const Word16 ProtocolParameters)
(Word16 -> Const Word16 Word16)
-> ProtocolParameters -> Const Word16 ProtocolParameters
#maximumCollateralInputCount ProtocolParameters
pp
        , $sel:minimumCollateralPercentage:ApiNetworkParameters :: Natural
minimumCollateralPercentage =
            ((Natural -> Const Natural Natural)
 -> ProtocolParameters -> Const Natural ProtocolParameters)
-> ProtocolParameters -> Natural
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "minimumCollateralPercentage"
  ((Natural -> Const Natural Natural)
   -> ProtocolParameters -> Const Natural ProtocolParameters)
(Natural -> Const Natural Natural)
-> ProtocolParameters -> Const Natural ProtocolParameters
#minimumCollateralPercentage ProtocolParameters
pp
        , $sel:maximumTokenBundleSize:ApiNetworkParameters :: Quantity "byte" Natural
maximumTokenBundleSize = Natural -> Quantity "byte" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "byte" Natural)
-> Natural -> Quantity "byte" Natural
forall a b. (a -> b) -> a -> b
$ ProtocolParameters
pp ProtocolParameters
-> ((Natural -> Const Natural Natural)
    -> ProtocolParameters -> Const Natural ProtocolParameters)
-> Natural
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^.
            (IsLabel
  "txParameters"
  ((TxParameters -> Const Natural TxParameters)
   -> ProtocolParameters -> Const Natural ProtocolParameters)
(TxParameters -> Const Natural TxParameters)
-> ProtocolParameters -> Const Natural ProtocolParameters
#txParameters ((TxParameters -> Const Natural TxParameters)
 -> ProtocolParameters -> Const Natural ProtocolParameters)
-> ((Natural -> Const Natural Natural)
    -> TxParameters -> Const Natural TxParameters)
-> (Natural -> Const Natural Natural)
-> ProtocolParameters
-> Const Natural ProtocolParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getTokenBundleMaxSize"
  ((TokenBundleMaxSize -> Const Natural TokenBundleMaxSize)
   -> TxParameters -> Const Natural TxParameters)
(TokenBundleMaxSize -> Const Natural TokenBundleMaxSize)
-> TxParameters -> Const Natural TxParameters
#getTokenBundleMaxSize ((TokenBundleMaxSize -> Const Natural TokenBundleMaxSize)
 -> TxParameters -> Const Natural TxParameters)
-> ((Natural -> Const Natural Natural)
    -> TokenBundleMaxSize -> Const Natural TokenBundleMaxSize)
-> (Natural -> Const Natural Natural)
-> TxParameters
-> Const Natural TxParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "unTokenBundleMaxSize"
  ((TxSize -> Const Natural TxSize)
   -> TokenBundleMaxSize -> Const Natural TokenBundleMaxSize)
(TxSize -> Const Natural TxSize)
-> TokenBundleMaxSize -> Const Natural TokenBundleMaxSize
#unTokenBundleMaxSize ((TxSize -> Const Natural TxSize)
 -> TokenBundleMaxSize -> Const Natural TokenBundleMaxSize)
-> ((Natural -> Const Natural Natural)
    -> TxSize -> Const Natural TxSize)
-> (Natural -> Const Natural Natural)
-> TokenBundleMaxSize
-> Const Natural TokenBundleMaxSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            #unTxSize)
        , $sel:executionUnitPrices:ApiNetworkParameters :: Maybe ExecutionUnitPrices
executionUnitPrices = ((Maybe ExecutionUnitPrices
  -> Const (Maybe ExecutionUnitPrices) (Maybe ExecutionUnitPrices))
 -> ProtocolParameters
 -> Const (Maybe ExecutionUnitPrices) ProtocolParameters)
-> ProtocolParameters -> Maybe ExecutionUnitPrices
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "executionUnitPrices"
  ((Maybe ExecutionUnitPrices
    -> Const (Maybe ExecutionUnitPrices) (Maybe ExecutionUnitPrices))
   -> ProtocolParameters
   -> Const (Maybe ExecutionUnitPrices) ProtocolParameters)
(Maybe ExecutionUnitPrices
 -> Const (Maybe ExecutionUnitPrices) (Maybe ExecutionUnitPrices))
-> ProtocolParameters
-> Const (Maybe ExecutionUnitPrices) ProtocolParameters
#executionUnitPrices ProtocolParameters
pp
        }
  where
    toApiCoin :: Coin -> Quantity unit Natural
toApiCoin = Natural -> Quantity unit Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity unit Natural)
-> (Coin -> Natural) -> Coin -> Quantity unit Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural) -> (Coin -> Natural) -> Coin -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin

newtype ApiTxId = ApiTxId
    { ApiTxId -> ApiT (Hash "Tx")
id :: ApiT (Hash "Tx")
    }
    deriving (ApiTxId -> ApiTxId -> Bool
(ApiTxId -> ApiTxId -> Bool)
-> (ApiTxId -> ApiTxId -> Bool) -> Eq ApiTxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiTxId -> ApiTxId -> Bool
$c/= :: ApiTxId -> ApiTxId -> Bool
== :: ApiTxId -> ApiTxId -> Bool
$c== :: ApiTxId -> ApiTxId -> Bool
Eq, (forall x. ApiTxId -> Rep ApiTxId x)
-> (forall x. Rep ApiTxId x -> ApiTxId) -> Generic ApiTxId
forall x. Rep ApiTxId x -> ApiTxId
forall x. ApiTxId -> Rep ApiTxId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiTxId x -> ApiTxId
$cfrom :: forall x. ApiTxId -> Rep ApiTxId x
Generic)
    deriving anyclass ApiTxId -> ()
(ApiTxId -> ()) -> NFData ApiTxId
forall a. (a -> ()) -> NFData a
rnf :: ApiTxId -> ()
$crnf :: ApiTxId -> ()
NFData
    deriving Int -> ApiTxId -> ShowS
[ApiTxId] -> ShowS
ApiTxId -> String
(Int -> ApiTxId -> ShowS)
-> (ApiTxId -> String) -> ([ApiTxId] -> ShowS) -> Show ApiTxId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiTxId] -> ShowS
$cshowList :: [ApiTxId] -> ShowS
show :: ApiTxId -> String
$cshow :: ApiTxId -> String
showsPrec :: Int -> ApiTxId -> ShowS
$cshowsPrec :: Int -> ApiTxId -> ShowS
Show via (Quiet ApiTxId)

-- | A helper type to reduce the amount of repetition.
--
type ApiTxOutput n = AddressAmount (ApiT Address, Proxy n)

data ApiTransaction (n :: NetworkDiscriminant) = ApiTransaction
    { ApiTransaction n -> ApiT (Hash "Tx")
id :: !(ApiT (Hash "Tx"))
    , ApiTransaction n -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
    , ApiTransaction n -> Quantity "lovelace" Natural
fee :: !(Quantity "lovelace" Natural)
    , ApiTransaction n -> Quantity "lovelace" Natural
depositTaken :: !(Quantity "lovelace" Natural)
    , ApiTransaction n -> Quantity "lovelace" Natural
depositReturned :: !(Quantity "lovelace" Natural)
    , ApiTransaction n -> Maybe ApiBlockReference
insertedAt :: !(Maybe ApiBlockReference)
    , ApiTransaction n -> Maybe ApiBlockReference
pendingSince :: !(Maybe ApiBlockReference)
    , ApiTransaction n -> Maybe ApiSlotReference
expiresAt :: !(Maybe ApiSlotReference)
    , ApiTransaction n -> Maybe (Quantity "block" Natural)
depth :: !(Maybe (Quantity "block" Natural))
    , ApiTransaction n -> ApiT Direction
direction :: !(ApiT Direction)
    , ApiTransaction n -> [ApiTxInput n]
inputs :: ![ApiTxInput n]
    , ApiTransaction n -> [ApiTxOutput n]
outputs :: ![ApiTxOutput n]
    , ApiTransaction n -> [ApiTxCollateral n]
collateral :: ![ApiTxCollateral n]
    , ApiTransaction n
-> ApiAsArray "collateral_outputs" (Maybe (ApiTxOutput n))
collateralOutputs ::
        !(ApiAsArray "collateral_outputs" (Maybe (ApiTxOutput n)))
    , ApiTransaction n -> [ApiWithdrawal n]
withdrawals :: ![ApiWithdrawal n]
    , ApiTransaction n -> ApiT TxStatus
status :: !(ApiT TxStatus)
    , ApiTransaction n -> Maybe TxMetadataWithSchema
metadata :: !(Maybe TxMetadataWithSchema)
    , ApiTransaction n -> Maybe (ApiT TxScriptValidity)
scriptValidity :: !(Maybe (ApiT TxScriptValidity))
    }
    deriving (ApiTransaction n -> ApiTransaction n -> Bool
(ApiTransaction n -> ApiTransaction n -> Bool)
-> (ApiTransaction n -> ApiTransaction n -> Bool)
-> Eq (ApiTransaction n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiTransaction n -> ApiTransaction n -> Bool
/= :: ApiTransaction n -> ApiTransaction n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiTransaction n -> ApiTransaction n -> Bool
== :: ApiTransaction n -> ApiTransaction n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiTransaction n -> ApiTransaction n -> Bool
Eq, (forall x. ApiTransaction n -> Rep (ApiTransaction n) x)
-> (forall x. Rep (ApiTransaction n) x -> ApiTransaction n)
-> Generic (ApiTransaction n)
forall x. Rep (ApiTransaction n) x -> ApiTransaction n
forall x. ApiTransaction n -> Rep (ApiTransaction n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiTransaction n) x -> ApiTransaction n
forall (n :: NetworkDiscriminant) x.
ApiTransaction n -> Rep (ApiTransaction n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiTransaction n) x -> ApiTransaction n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiTransaction n -> Rep (ApiTransaction n) x
Generic, Int -> ApiTransaction n -> ShowS
[ApiTransaction n] -> ShowS
ApiTransaction n -> String
(Int -> ApiTransaction n -> ShowS)
-> (ApiTransaction n -> String)
-> ([ApiTransaction n] -> ShowS)
-> Show (ApiTransaction n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant). Int -> ApiTransaction n -> ShowS
forall (n :: NetworkDiscriminant). [ApiTransaction n] -> ShowS
forall (n :: NetworkDiscriminant). ApiTransaction n -> String
showList :: [ApiTransaction n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiTransaction n] -> ShowS
show :: ApiTransaction n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiTransaction n -> String
showsPrec :: Int -> ApiTransaction n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant). Int -> ApiTransaction n -> ShowS
Show, Typeable)
    deriving anyclass ApiTransaction n -> ()
(ApiTransaction n -> ()) -> NFData (ApiTransaction n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiTransaction n -> ()
rnf :: ApiTransaction n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiTransaction n -> ()
NFData

data ApiWalletInput (n :: NetworkDiscriminant) = ApiWalletInput
    { ApiWalletInput n -> ApiT (Hash "Tx")
id :: !(ApiT (Hash "Tx"))
    , ApiWalletInput n -> Word32
index :: !Word32
    , ApiWalletInput n -> (ApiT Address, Proxy n)
address :: !(ApiT Address, Proxy n)
    , ApiWalletInput n -> NonEmpty (ApiT DerivationIndex)
derivationPath :: NonEmpty (ApiT DerivationIndex)
    , ApiWalletInput n -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
    , ApiWalletInput n -> ApiT TokenMap
assets :: !(ApiT W.TokenMap)
    } deriving (ApiWalletInput n -> ApiWalletInput n -> Bool
(ApiWalletInput n -> ApiWalletInput n -> Bool)
-> (ApiWalletInput n -> ApiWalletInput n -> Bool)
-> Eq (ApiWalletInput n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiWalletInput n -> ApiWalletInput n -> Bool
/= :: ApiWalletInput n -> ApiWalletInput n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiWalletInput n -> ApiWalletInput n -> Bool
== :: ApiWalletInput n -> ApiWalletInput n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiWalletInput n -> ApiWalletInput n -> Bool
Eq, (forall x. ApiWalletInput n -> Rep (ApiWalletInput n) x)
-> (forall x. Rep (ApiWalletInput n) x -> ApiWalletInput n)
-> Generic (ApiWalletInput n)
forall x. Rep (ApiWalletInput n) x -> ApiWalletInput n
forall x. ApiWalletInput n -> Rep (ApiWalletInput n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiWalletInput n) x -> ApiWalletInput n
forall (n :: NetworkDiscriminant) x.
ApiWalletInput n -> Rep (ApiWalletInput n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiWalletInput n) x -> ApiWalletInput n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiWalletInput n -> Rep (ApiWalletInput n) x
Generic, Int -> ApiWalletInput n -> ShowS
[ApiWalletInput n] -> ShowS
ApiWalletInput n -> String
(Int -> ApiWalletInput n -> ShowS)
-> (ApiWalletInput n -> String)
-> ([ApiWalletInput n] -> ShowS)
-> Show (ApiWalletInput n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant). Int -> ApiWalletInput n -> ShowS
forall (n :: NetworkDiscriminant). [ApiWalletInput n] -> ShowS
forall (n :: NetworkDiscriminant). ApiWalletInput n -> String
showList :: [ApiWalletInput n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiWalletInput n] -> ShowS
show :: ApiWalletInput n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiWalletInput n -> String
showsPrec :: Int -> ApiWalletInput n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant). Int -> ApiWalletInput n -> ShowS
Show, Typeable)
      deriving anyclass ApiWalletInput n -> ()
(ApiWalletInput n -> ()) -> NFData (ApiWalletInput n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiWalletInput n -> ()
rnf :: ApiWalletInput n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiWalletInput n -> ()
NFData

data ApiTxInputGeneral (n :: NetworkDiscriminant) =
      ExternalInput (ApiT TxIn)
    | WalletInput (ApiWalletInput n)
      deriving (ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool
(ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool)
-> (ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool)
-> Eq (ApiTxInputGeneral n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool
/= :: ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool
== :: ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool
Eq, (forall x. ApiTxInputGeneral n -> Rep (ApiTxInputGeneral n) x)
-> (forall x. Rep (ApiTxInputGeneral n) x -> ApiTxInputGeneral n)
-> Generic (ApiTxInputGeneral n)
forall x. Rep (ApiTxInputGeneral n) x -> ApiTxInputGeneral n
forall x. ApiTxInputGeneral n -> Rep (ApiTxInputGeneral n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiTxInputGeneral n) x -> ApiTxInputGeneral n
forall (n :: NetworkDiscriminant) x.
ApiTxInputGeneral n -> Rep (ApiTxInputGeneral n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiTxInputGeneral n) x -> ApiTxInputGeneral n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiTxInputGeneral n -> Rep (ApiTxInputGeneral n) x
Generic, Int -> ApiTxInputGeneral n -> ShowS
[ApiTxInputGeneral n] -> ShowS
ApiTxInputGeneral n -> String
(Int -> ApiTxInputGeneral n -> ShowS)
-> (ApiTxInputGeneral n -> String)
-> ([ApiTxInputGeneral n] -> ShowS)
-> Show (ApiTxInputGeneral n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiTxInputGeneral n -> ShowS
forall (n :: NetworkDiscriminant). [ApiTxInputGeneral n] -> ShowS
forall (n :: NetworkDiscriminant). ApiTxInputGeneral n -> String
showList :: [ApiTxInputGeneral n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiTxInputGeneral n] -> ShowS
show :: ApiTxInputGeneral n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiTxInputGeneral n -> String
showsPrec :: Int -> ApiTxInputGeneral n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiTxInputGeneral n -> ShowS
Show, Typeable)
      deriving anyclass ApiTxInputGeneral n -> ()
(ApiTxInputGeneral n -> ()) -> NFData (ApiTxInputGeneral n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiTxInputGeneral n -> ()
rnf :: ApiTxInputGeneral n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiTxInputGeneral n -> ()
NFData

data ResourceContext = External | Our
      deriving (ResourceContext -> ResourceContext -> Bool
(ResourceContext -> ResourceContext -> Bool)
-> (ResourceContext -> ResourceContext -> Bool)
-> Eq ResourceContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResourceContext -> ResourceContext -> Bool
$c/= :: ResourceContext -> ResourceContext -> Bool
== :: ResourceContext -> ResourceContext -> Bool
$c== :: ResourceContext -> ResourceContext -> Bool
Eq, (forall x. ResourceContext -> Rep ResourceContext x)
-> (forall x. Rep ResourceContext x -> ResourceContext)
-> Generic ResourceContext
forall x. Rep ResourceContext x -> ResourceContext
forall x. ResourceContext -> Rep ResourceContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResourceContext x -> ResourceContext
$cfrom :: forall x. ResourceContext -> Rep ResourceContext x
Generic, Int -> ResourceContext -> ShowS
[ResourceContext] -> ShowS
ResourceContext -> String
(Int -> ResourceContext -> ShowS)
-> (ResourceContext -> String)
-> ([ResourceContext] -> ShowS)
-> Show ResourceContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResourceContext] -> ShowS
$cshowList :: [ResourceContext] -> ShowS
show :: ResourceContext -> String
$cshow :: ResourceContext -> String
showsPrec :: Int -> ResourceContext -> ShowS
$cshowsPrec :: Int -> ResourceContext -> ShowS
Show, Typeable)
      deriving anyclass ResourceContext -> ()
(ResourceContext -> ()) -> NFData ResourceContext
forall a. (a -> ()) -> NFData a
rnf :: ResourceContext -> ()
$crnf :: ResourceContext -> ()
NFData

data ApiWithdrawalGeneral (n :: NetworkDiscriminant) = ApiWithdrawalGeneral
    { ApiWithdrawalGeneral n -> (ApiT RewardAccount, Proxy n)
stakeAddress :: !(ApiT W.RewardAccount, Proxy n)
    , ApiWithdrawalGeneral n -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
    , ApiWithdrawalGeneral n -> ResourceContext
context :: !ResourceContext
    } deriving (ApiWithdrawalGeneral n -> ApiWithdrawalGeneral n -> Bool
(ApiWithdrawalGeneral n -> ApiWithdrawalGeneral n -> Bool)
-> (ApiWithdrawalGeneral n -> ApiWithdrawalGeneral n -> Bool)
-> Eq (ApiWithdrawalGeneral n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiWithdrawalGeneral n -> ApiWithdrawalGeneral n -> Bool
/= :: ApiWithdrawalGeneral n -> ApiWithdrawalGeneral n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiWithdrawalGeneral n -> ApiWithdrawalGeneral n -> Bool
== :: ApiWithdrawalGeneral n -> ApiWithdrawalGeneral n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiWithdrawalGeneral n -> ApiWithdrawalGeneral n -> Bool
Eq, (forall x.
 ApiWithdrawalGeneral n -> Rep (ApiWithdrawalGeneral n) x)
-> (forall x.
    Rep (ApiWithdrawalGeneral n) x -> ApiWithdrawalGeneral n)
-> Generic (ApiWithdrawalGeneral n)
forall x. Rep (ApiWithdrawalGeneral n) x -> ApiWithdrawalGeneral n
forall x. ApiWithdrawalGeneral n -> Rep (ApiWithdrawalGeneral n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiWithdrawalGeneral n) x -> ApiWithdrawalGeneral n
forall (n :: NetworkDiscriminant) x.
ApiWithdrawalGeneral n -> Rep (ApiWithdrawalGeneral n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiWithdrawalGeneral n) x -> ApiWithdrawalGeneral n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiWithdrawalGeneral n -> Rep (ApiWithdrawalGeneral n) x
Generic, Int -> ApiWithdrawalGeneral n -> ShowS
[ApiWithdrawalGeneral n] -> ShowS
ApiWithdrawalGeneral n -> String
(Int -> ApiWithdrawalGeneral n -> ShowS)
-> (ApiWithdrawalGeneral n -> String)
-> ([ApiWithdrawalGeneral n] -> ShowS)
-> Show (ApiWithdrawalGeneral n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiWithdrawalGeneral n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiWithdrawalGeneral n] -> ShowS
forall (n :: NetworkDiscriminant). ApiWithdrawalGeneral n -> String
showList :: [ApiWithdrawalGeneral n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiWithdrawalGeneral n] -> ShowS
show :: ApiWithdrawalGeneral n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiWithdrawalGeneral n -> String
showsPrec :: Int -> ApiWithdrawalGeneral n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiWithdrawalGeneral n -> ShowS
Show)
      deriving anyclass ApiWithdrawalGeneral n -> ()
(ApiWithdrawalGeneral n -> ()) -> NFData (ApiWithdrawalGeneral n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiWithdrawalGeneral n -> ()
rnf :: ApiWithdrawalGeneral n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiWithdrawalGeneral n -> ()
NFData

data ApiWalletOutput (n :: NetworkDiscriminant) = ApiWalletOutput
    { ApiWalletOutput n -> (ApiT Address, Proxy n)
address :: !(ApiT Address, Proxy n)
    , ApiWalletOutput n -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
    , ApiWalletOutput n -> ApiT TokenMap
assets :: !(ApiT W.TokenMap)
    , ApiWalletOutput n -> NonEmpty (ApiT DerivationIndex)
derivationPath :: NonEmpty (ApiT DerivationIndex)
    } deriving (ApiWalletOutput n -> ApiWalletOutput n -> Bool
(ApiWalletOutput n -> ApiWalletOutput n -> Bool)
-> (ApiWalletOutput n -> ApiWalletOutput n -> Bool)
-> Eq (ApiWalletOutput n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiWalletOutput n -> ApiWalletOutput n -> Bool
/= :: ApiWalletOutput n -> ApiWalletOutput n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiWalletOutput n -> ApiWalletOutput n -> Bool
== :: ApiWalletOutput n -> ApiWalletOutput n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiWalletOutput n -> ApiWalletOutput n -> Bool
Eq, (forall x. ApiWalletOutput n -> Rep (ApiWalletOutput n) x)
-> (forall x. Rep (ApiWalletOutput n) x -> ApiWalletOutput n)
-> Generic (ApiWalletOutput n)
forall x. Rep (ApiWalletOutput n) x -> ApiWalletOutput n
forall x. ApiWalletOutput n -> Rep (ApiWalletOutput n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiWalletOutput n) x -> ApiWalletOutput n
forall (n :: NetworkDiscriminant) x.
ApiWalletOutput n -> Rep (ApiWalletOutput n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiWalletOutput n) x -> ApiWalletOutput n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiWalletOutput n -> Rep (ApiWalletOutput n) x
Generic, Int -> ApiWalletOutput n -> ShowS
[ApiWalletOutput n] -> ShowS
ApiWalletOutput n -> String
(Int -> ApiWalletOutput n -> ShowS)
-> (ApiWalletOutput n -> String)
-> ([ApiWalletOutput n] -> ShowS)
-> Show (ApiWalletOutput n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiWalletOutput n -> ShowS
forall (n :: NetworkDiscriminant). [ApiWalletOutput n] -> ShowS
forall (n :: NetworkDiscriminant). ApiWalletOutput n -> String
showList :: [ApiWalletOutput n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiWalletOutput n] -> ShowS
show :: ApiWalletOutput n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiWalletOutput n -> String
showsPrec :: Int -> ApiWalletOutput n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiWalletOutput n -> ShowS
Show, Typeable)
      deriving anyclass ApiWalletOutput n -> ()
(ApiWalletOutput n -> ()) -> NFData (ApiWalletOutput n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiWalletOutput n -> ()
rnf :: ApiWalletOutput n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiWalletOutput n -> ()
NFData

data ApiTxOutputGeneral (n :: NetworkDiscriminant) =
      ExternalOutput (ApiTxOutput n)
    | WalletOutput (ApiWalletOutput n)
      deriving (ApiTxOutputGeneral n -> ApiTxOutputGeneral n -> Bool
(ApiTxOutputGeneral n -> ApiTxOutputGeneral n -> Bool)
-> (ApiTxOutputGeneral n -> ApiTxOutputGeneral n -> Bool)
-> Eq (ApiTxOutputGeneral n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiTxOutputGeneral n -> ApiTxOutputGeneral n -> Bool
/= :: ApiTxOutputGeneral n -> ApiTxOutputGeneral n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiTxOutputGeneral n -> ApiTxOutputGeneral n -> Bool
== :: ApiTxOutputGeneral n -> ApiTxOutputGeneral n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiTxOutputGeneral n -> ApiTxOutputGeneral n -> Bool
Eq, (forall x. ApiTxOutputGeneral n -> Rep (ApiTxOutputGeneral n) x)
-> (forall x. Rep (ApiTxOutputGeneral n) x -> ApiTxOutputGeneral n)
-> Generic (ApiTxOutputGeneral n)
forall x. Rep (ApiTxOutputGeneral n) x -> ApiTxOutputGeneral n
forall x. ApiTxOutputGeneral n -> Rep (ApiTxOutputGeneral n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiTxOutputGeneral n) x -> ApiTxOutputGeneral n
forall (n :: NetworkDiscriminant) x.
ApiTxOutputGeneral n -> Rep (ApiTxOutputGeneral n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiTxOutputGeneral n) x -> ApiTxOutputGeneral n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiTxOutputGeneral n -> Rep (ApiTxOutputGeneral n) x
Generic, Int -> ApiTxOutputGeneral n -> ShowS
[ApiTxOutputGeneral n] -> ShowS
ApiTxOutputGeneral n -> String
(Int -> ApiTxOutputGeneral n -> ShowS)
-> (ApiTxOutputGeneral n -> String)
-> ([ApiTxOutputGeneral n] -> ShowS)
-> Show (ApiTxOutputGeneral n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiTxOutputGeneral n -> ShowS
forall (n :: NetworkDiscriminant). [ApiTxOutputGeneral n] -> ShowS
forall (n :: NetworkDiscriminant). ApiTxOutputGeneral n -> String
showList :: [ApiTxOutputGeneral n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiTxOutputGeneral n] -> ShowS
show :: ApiTxOutputGeneral n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiTxOutputGeneral n -> String
showsPrec :: Int -> ApiTxOutputGeneral n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiTxOutputGeneral n -> ShowS
Show, Typeable)
      deriving anyclass ApiTxOutputGeneral n -> ()
(ApiTxOutputGeneral n -> ()) -> NFData (ApiTxOutputGeneral n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiTxOutputGeneral n -> ()
rnf :: ApiTxOutputGeneral n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiTxOutputGeneral n -> ()
NFData

data ApiExternalCertificate (n :: NetworkDiscriminant)
    = RegisterRewardAccountExternal
        { ApiExternalCertificate n -> (ApiT RewardAccount, Proxy n)
rewardAccount :: !(ApiT W.RewardAccount, Proxy n)
        }
    | JoinPoolExternal
        { rewardAccount :: !(ApiT W.RewardAccount, Proxy n)
        , ApiExternalCertificate n -> ApiT PoolId
pool :: ApiT PoolId
        }
    | QuitPoolExternal
        { rewardAccount :: !(ApiT W.RewardAccount, Proxy n)
        }
    deriving (ApiExternalCertificate n -> ApiExternalCertificate n -> Bool
(ApiExternalCertificate n -> ApiExternalCertificate n -> Bool)
-> (ApiExternalCertificate n -> ApiExternalCertificate n -> Bool)
-> Eq (ApiExternalCertificate n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiExternalCertificate n -> ApiExternalCertificate n -> Bool
/= :: ApiExternalCertificate n -> ApiExternalCertificate n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiExternalCertificate n -> ApiExternalCertificate n -> Bool
== :: ApiExternalCertificate n -> ApiExternalCertificate n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiExternalCertificate n -> ApiExternalCertificate n -> Bool
Eq, (forall x.
 ApiExternalCertificate n -> Rep (ApiExternalCertificate n) x)
-> (forall x.
    Rep (ApiExternalCertificate n) x -> ApiExternalCertificate n)
-> Generic (ApiExternalCertificate n)
forall x.
Rep (ApiExternalCertificate n) x -> ApiExternalCertificate n
forall x.
ApiExternalCertificate n -> Rep (ApiExternalCertificate n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiExternalCertificate n) x -> ApiExternalCertificate n
forall (n :: NetworkDiscriminant) x.
ApiExternalCertificate n -> Rep (ApiExternalCertificate n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiExternalCertificate n) x -> ApiExternalCertificate n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiExternalCertificate n -> Rep (ApiExternalCertificate n) x
Generic, Int -> ApiExternalCertificate n -> ShowS
[ApiExternalCertificate n] -> ShowS
ApiExternalCertificate n -> String
(Int -> ApiExternalCertificate n -> ShowS)
-> (ApiExternalCertificate n -> String)
-> ([ApiExternalCertificate n] -> ShowS)
-> Show (ApiExternalCertificate n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiExternalCertificate n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiExternalCertificate n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiExternalCertificate n -> String
showList :: [ApiExternalCertificate n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiExternalCertificate n] -> ShowS
show :: ApiExternalCertificate n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiExternalCertificate n -> String
showsPrec :: Int -> ApiExternalCertificate n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiExternalCertificate n -> ShowS
Show)
    deriving anyclass ApiExternalCertificate n -> ()
(ApiExternalCertificate n -> ())
-> NFData (ApiExternalCertificate n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiExternalCertificate n -> ()
rnf :: ApiExternalCertificate n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiExternalCertificate n -> ()
NFData

data ApiRegisterPool = ApiRegisterPool
    { ApiRegisterPool -> ApiT PoolId
poolId :: !(ApiT PoolId)
    , ApiRegisterPool -> [ApiT PoolOwner]
poolOwners :: ![ApiT W.PoolOwner]
    , ApiRegisterPool -> Quantity "percent" Percentage
poolMargin :: !(Quantity "percent" Percentage)
    , ApiRegisterPool -> Quantity "lovelace" Natural
poolCost :: !(Quantity "lovelace" Natural)
    , ApiRegisterPool -> Quantity "lovelace" Natural
poolPledge :: !(Quantity "lovelace" Natural)
    , ApiRegisterPool
-> Maybe (ApiT StakePoolMetadataUrl, ApiT StakePoolMetadataHash)
poolMetadata :: Maybe (ApiT W.StakePoolMetadataUrl, ApiT W.StakePoolMetadataHash)
    }
    deriving (ApiRegisterPool -> ApiRegisterPool -> Bool
(ApiRegisterPool -> ApiRegisterPool -> Bool)
-> (ApiRegisterPool -> ApiRegisterPool -> Bool)
-> Eq ApiRegisterPool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiRegisterPool -> ApiRegisterPool -> Bool
$c/= :: ApiRegisterPool -> ApiRegisterPool -> Bool
== :: ApiRegisterPool -> ApiRegisterPool -> Bool
$c== :: ApiRegisterPool -> ApiRegisterPool -> Bool
Eq, (forall x. ApiRegisterPool -> Rep ApiRegisterPool x)
-> (forall x. Rep ApiRegisterPool x -> ApiRegisterPool)
-> Generic ApiRegisterPool
forall x. Rep ApiRegisterPool x -> ApiRegisterPool
forall x. ApiRegisterPool -> Rep ApiRegisterPool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiRegisterPool x -> ApiRegisterPool
$cfrom :: forall x. ApiRegisterPool -> Rep ApiRegisterPool x
Generic, Int -> ApiRegisterPool -> ShowS
[ApiRegisterPool] -> ShowS
ApiRegisterPool -> String
(Int -> ApiRegisterPool -> ShowS)
-> (ApiRegisterPool -> String)
-> ([ApiRegisterPool] -> ShowS)
-> Show ApiRegisterPool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiRegisterPool] -> ShowS
$cshowList :: [ApiRegisterPool] -> ShowS
show :: ApiRegisterPool -> String
$cshow :: ApiRegisterPool -> String
showsPrec :: Int -> ApiRegisterPool -> ShowS
$cshowsPrec :: Int -> ApiRegisterPool -> ShowS
Show)
    deriving anyclass ApiRegisterPool -> ()
(ApiRegisterPool -> ()) -> NFData ApiRegisterPool
forall a. (a -> ()) -> NFData a
rnf :: ApiRegisterPool -> ()
$crnf :: ApiRegisterPool -> ()
NFData

data ApiDeregisterPool = ApiDeregisterPool
    { ApiDeregisterPool -> ApiT PoolId
poolId :: !(ApiT PoolId)
    , ApiDeregisterPool -> ApiT EpochNo
retirementEpoch :: !(ApiT EpochNo)
    }
    deriving (ApiDeregisterPool -> ApiDeregisterPool -> Bool
(ApiDeregisterPool -> ApiDeregisterPool -> Bool)
-> (ApiDeregisterPool -> ApiDeregisterPool -> Bool)
-> Eq ApiDeregisterPool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiDeregisterPool -> ApiDeregisterPool -> Bool
$c/= :: ApiDeregisterPool -> ApiDeregisterPool -> Bool
== :: ApiDeregisterPool -> ApiDeregisterPool -> Bool
$c== :: ApiDeregisterPool -> ApiDeregisterPool -> Bool
Eq, (forall x. ApiDeregisterPool -> Rep ApiDeregisterPool x)
-> (forall x. Rep ApiDeregisterPool x -> ApiDeregisterPool)
-> Generic ApiDeregisterPool
forall x. Rep ApiDeregisterPool x -> ApiDeregisterPool
forall x. ApiDeregisterPool -> Rep ApiDeregisterPool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiDeregisterPool x -> ApiDeregisterPool
$cfrom :: forall x. ApiDeregisterPool -> Rep ApiDeregisterPool x
Generic, Int -> ApiDeregisterPool -> ShowS
[ApiDeregisterPool] -> ShowS
ApiDeregisterPool -> String
(Int -> ApiDeregisterPool -> ShowS)
-> (ApiDeregisterPool -> String)
-> ([ApiDeregisterPool] -> ShowS)
-> Show ApiDeregisterPool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiDeregisterPool] -> ShowS
$cshowList :: [ApiDeregisterPool] -> ShowS
show :: ApiDeregisterPool -> String
$cshow :: ApiDeregisterPool -> String
showsPrec :: Int -> ApiDeregisterPool -> ShowS
$cshowsPrec :: Int -> ApiDeregisterPool -> ShowS
Show)
    deriving anyclass ApiDeregisterPool -> ()
(ApiDeregisterPool -> ()) -> NFData ApiDeregisterPool
forall a. (a -> ()) -> NFData a
rnf :: ApiDeregisterPool -> ()
$crnf :: ApiDeregisterPool -> ()
NFData

data ApiAnyCertificate n =
      WalletDelegationCertificate ApiCertificate
    | DelegationCertificate (ApiExternalCertificate n)
    | StakePoolRegister ApiRegisterPool
    | StakePoolDeregister ApiDeregisterPool
    | OtherCertificate (ApiT NonWalletCertificate)
    deriving (ApiAnyCertificate n -> ApiAnyCertificate n -> Bool
(ApiAnyCertificate n -> ApiAnyCertificate n -> Bool)
-> (ApiAnyCertificate n -> ApiAnyCertificate n -> Bool)
-> Eq (ApiAnyCertificate n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiAnyCertificate n -> ApiAnyCertificate n -> Bool
/= :: ApiAnyCertificate n -> ApiAnyCertificate n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiAnyCertificate n -> ApiAnyCertificate n -> Bool
== :: ApiAnyCertificate n -> ApiAnyCertificate n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiAnyCertificate n -> ApiAnyCertificate n -> Bool
Eq, (forall x. ApiAnyCertificate n -> Rep (ApiAnyCertificate n) x)
-> (forall x. Rep (ApiAnyCertificate n) x -> ApiAnyCertificate n)
-> Generic (ApiAnyCertificate n)
forall x. Rep (ApiAnyCertificate n) x -> ApiAnyCertificate n
forall x. ApiAnyCertificate n -> Rep (ApiAnyCertificate n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiAnyCertificate n) x -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant) x.
ApiAnyCertificate n -> Rep (ApiAnyCertificate n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiAnyCertificate n) x -> ApiAnyCertificate n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiAnyCertificate n -> Rep (ApiAnyCertificate n) x
Generic, Int -> ApiAnyCertificate n -> ShowS
[ApiAnyCertificate n] -> ShowS
ApiAnyCertificate n -> String
(Int -> ApiAnyCertificate n -> ShowS)
-> (ApiAnyCertificate n -> String)
-> ([ApiAnyCertificate n] -> ShowS)
-> Show (ApiAnyCertificate n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiAnyCertificate n -> ShowS
forall (n :: NetworkDiscriminant). [ApiAnyCertificate n] -> ShowS
forall (n :: NetworkDiscriminant). ApiAnyCertificate n -> String
showList :: [ApiAnyCertificate n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiAnyCertificate n] -> ShowS
show :: ApiAnyCertificate n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiAnyCertificate n -> String
showsPrec :: Int -> ApiAnyCertificate n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiAnyCertificate n -> ShowS
Show)
    deriving anyclass ApiAnyCertificate n -> ()
(ApiAnyCertificate n -> ()) -> NFData (ApiAnyCertificate n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiAnyCertificate n -> ()
rnf :: ApiAnyCertificate n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiAnyCertificate n -> ()
NFData

newtype ApiPostPolicyKeyData = ApiPostPolicyKeyData
    { ApiPostPolicyKeyData -> ApiT (Passphrase "user")
passphrase :: ApiT (Passphrase "user")
    }
    deriving (ApiPostPolicyKeyData -> ApiPostPolicyKeyData -> Bool
(ApiPostPolicyKeyData -> ApiPostPolicyKeyData -> Bool)
-> (ApiPostPolicyKeyData -> ApiPostPolicyKeyData -> Bool)
-> Eq ApiPostPolicyKeyData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiPostPolicyKeyData -> ApiPostPolicyKeyData -> Bool
$c/= :: ApiPostPolicyKeyData -> ApiPostPolicyKeyData -> Bool
== :: ApiPostPolicyKeyData -> ApiPostPolicyKeyData -> Bool
$c== :: ApiPostPolicyKeyData -> ApiPostPolicyKeyData -> Bool
Eq, (forall x. ApiPostPolicyKeyData -> Rep ApiPostPolicyKeyData x)
-> (forall x. Rep ApiPostPolicyKeyData x -> ApiPostPolicyKeyData)
-> Generic ApiPostPolicyKeyData
forall x. Rep ApiPostPolicyKeyData x -> ApiPostPolicyKeyData
forall x. ApiPostPolicyKeyData -> Rep ApiPostPolicyKeyData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiPostPolicyKeyData x -> ApiPostPolicyKeyData
$cfrom :: forall x. ApiPostPolicyKeyData -> Rep ApiPostPolicyKeyData x
Generic, Int -> ApiPostPolicyKeyData -> ShowS
[ApiPostPolicyKeyData] -> ShowS
ApiPostPolicyKeyData -> String
(Int -> ApiPostPolicyKeyData -> ShowS)
-> (ApiPostPolicyKeyData -> String)
-> ([ApiPostPolicyKeyData] -> ShowS)
-> Show ApiPostPolicyKeyData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiPostPolicyKeyData] -> ShowS
$cshowList :: [ApiPostPolicyKeyData] -> ShowS
show :: ApiPostPolicyKeyData -> String
$cshow :: ApiPostPolicyKeyData -> String
showsPrec :: Int -> ApiPostPolicyKeyData -> ShowS
$cshowsPrec :: Int -> ApiPostPolicyKeyData -> ShowS
Show)
    deriving anyclass ApiPostPolicyKeyData -> ()
(ApiPostPolicyKeyData -> ()) -> NFData ApiPostPolicyKeyData
forall a. (a -> ()) -> NFData a
rnf :: ApiPostPolicyKeyData -> ()
$crnf :: ApiPostPolicyKeyData -> ()
NFData

data ApiTokenAmountFingerprint = ApiTokenAmountFingerprint
    { ApiTokenAmountFingerprint -> ApiT TokenName
assetName :: !(ApiT W.TokenName)
    , ApiTokenAmountFingerprint -> Natural
quantity :: !Natural
    , ApiTokenAmountFingerprint -> ApiT TokenFingerprint
fingerprint :: !(ApiT W.TokenFingerprint)
    }
    deriving (ApiTokenAmountFingerprint -> ApiTokenAmountFingerprint -> Bool
(ApiTokenAmountFingerprint -> ApiTokenAmountFingerprint -> Bool)
-> (ApiTokenAmountFingerprint -> ApiTokenAmountFingerprint -> Bool)
-> Eq ApiTokenAmountFingerprint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiTokenAmountFingerprint -> ApiTokenAmountFingerprint -> Bool
$c/= :: ApiTokenAmountFingerprint -> ApiTokenAmountFingerprint -> Bool
== :: ApiTokenAmountFingerprint -> ApiTokenAmountFingerprint -> Bool
$c== :: ApiTokenAmountFingerprint -> ApiTokenAmountFingerprint -> Bool
Eq, (forall x.
 ApiTokenAmountFingerprint -> Rep ApiTokenAmountFingerprint x)
-> (forall x.
    Rep ApiTokenAmountFingerprint x -> ApiTokenAmountFingerprint)
-> Generic ApiTokenAmountFingerprint
forall x.
Rep ApiTokenAmountFingerprint x -> ApiTokenAmountFingerprint
forall x.
ApiTokenAmountFingerprint -> Rep ApiTokenAmountFingerprint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiTokenAmountFingerprint x -> ApiTokenAmountFingerprint
$cfrom :: forall x.
ApiTokenAmountFingerprint -> Rep ApiTokenAmountFingerprint x
Generic, Int -> ApiTokenAmountFingerprint -> ShowS
[ApiTokenAmountFingerprint] -> ShowS
ApiTokenAmountFingerprint -> String
(Int -> ApiTokenAmountFingerprint -> ShowS)
-> (ApiTokenAmountFingerprint -> String)
-> ([ApiTokenAmountFingerprint] -> ShowS)
-> Show ApiTokenAmountFingerprint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiTokenAmountFingerprint] -> ShowS
$cshowList :: [ApiTokenAmountFingerprint] -> ShowS
show :: ApiTokenAmountFingerprint -> String
$cshow :: ApiTokenAmountFingerprint -> String
showsPrec :: Int -> ApiTokenAmountFingerprint -> ShowS
$cshowsPrec :: Int -> ApiTokenAmountFingerprint -> ShowS
Show)
    deriving anyclass ApiTokenAmountFingerprint -> ()
(ApiTokenAmountFingerprint -> ())
-> NFData ApiTokenAmountFingerprint
forall a. (a -> ()) -> NFData a
rnf :: ApiTokenAmountFingerprint -> ()
$crnf :: ApiTokenAmountFingerprint -> ()
NFData

data ApiTokens = ApiTokens
    { ApiTokens -> ApiT TokenPolicyId
policyId :: !(ApiT W.TokenPolicyId)
    , ApiTokens -> ApiT AnyScript
policyScript :: !(ApiT AnyScript)
    , ApiTokens -> NonEmpty ApiTokenAmountFingerprint
assets :: !(NonEmpty ApiTokenAmountFingerprint)
    }
    deriving (ApiTokens -> ApiTokens -> Bool
(ApiTokens -> ApiTokens -> Bool)
-> (ApiTokens -> ApiTokens -> Bool) -> Eq ApiTokens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiTokens -> ApiTokens -> Bool
$c/= :: ApiTokens -> ApiTokens -> Bool
== :: ApiTokens -> ApiTokens -> Bool
$c== :: ApiTokens -> ApiTokens -> Bool
Eq, (forall x. ApiTokens -> Rep ApiTokens x)
-> (forall x. Rep ApiTokens x -> ApiTokens) -> Generic ApiTokens
forall x. Rep ApiTokens x -> ApiTokens
forall x. ApiTokens -> Rep ApiTokens x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiTokens x -> ApiTokens
$cfrom :: forall x. ApiTokens -> Rep ApiTokens x
Generic, Int -> ApiTokens -> ShowS
[ApiTokens] -> ShowS
ApiTokens -> String
(Int -> ApiTokens -> ShowS)
-> (ApiTokens -> String)
-> ([ApiTokens] -> ShowS)
-> Show ApiTokens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiTokens] -> ShowS
$cshowList :: [ApiTokens] -> ShowS
show :: ApiTokens -> String
$cshow :: ApiTokens -> String
showsPrec :: Int -> ApiTokens -> ShowS
$cshowsPrec :: Int -> ApiTokens -> ShowS
Show)
    deriving anyclass ApiTokens -> ()
(ApiTokens -> ()) -> NFData ApiTokens
forall a. (a -> ()) -> NFData a
rnf :: ApiTokens -> ()
$crnf :: ApiTokens -> ()
NFData

data ApiAssetMintBurn = ApiAssetMintBurn
    { ApiAssetMintBurn -> [ApiTokens]
tokens :: ![ApiTokens]
    , ApiAssetMintBurn -> Maybe ApiPolicyKey
walletPolicyKeyHash :: !(Maybe ApiPolicyKey)
    , ApiAssetMintBurn -> Maybe (ApiT DerivationIndex)
walletPolicyKeyIndex :: !(Maybe (ApiT DerivationIndex))
    }
    deriving (ApiAssetMintBurn -> ApiAssetMintBurn -> Bool
(ApiAssetMintBurn -> ApiAssetMintBurn -> Bool)
-> (ApiAssetMintBurn -> ApiAssetMintBurn -> Bool)
-> Eq ApiAssetMintBurn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiAssetMintBurn -> ApiAssetMintBurn -> Bool
$c/= :: ApiAssetMintBurn -> ApiAssetMintBurn -> Bool
== :: ApiAssetMintBurn -> ApiAssetMintBurn -> Bool
$c== :: ApiAssetMintBurn -> ApiAssetMintBurn -> Bool
Eq, (forall x. ApiAssetMintBurn -> Rep ApiAssetMintBurn x)
-> (forall x. Rep ApiAssetMintBurn x -> ApiAssetMintBurn)
-> Generic ApiAssetMintBurn
forall x. Rep ApiAssetMintBurn x -> ApiAssetMintBurn
forall x. ApiAssetMintBurn -> Rep ApiAssetMintBurn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiAssetMintBurn x -> ApiAssetMintBurn
$cfrom :: forall x. ApiAssetMintBurn -> Rep ApiAssetMintBurn x
Generic, Int -> ApiAssetMintBurn -> ShowS
[ApiAssetMintBurn] -> ShowS
ApiAssetMintBurn -> String
(Int -> ApiAssetMintBurn -> ShowS)
-> (ApiAssetMintBurn -> String)
-> ([ApiAssetMintBurn] -> ShowS)
-> Show ApiAssetMintBurn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiAssetMintBurn] -> ShowS
$cshowList :: [ApiAssetMintBurn] -> ShowS
show :: ApiAssetMintBurn -> String
$cshow :: ApiAssetMintBurn -> String
showsPrec :: Int -> ApiAssetMintBurn -> ShowS
$cshowsPrec :: Int -> ApiAssetMintBurn -> ShowS
Show)
    deriving anyclass ApiAssetMintBurn -> ()
(ApiAssetMintBurn -> ()) -> NFData ApiAssetMintBurn
forall a. (a -> ()) -> NFData a
rnf :: ApiAssetMintBurn -> ()
$crnf :: ApiAssetMintBurn -> ()
NFData

data ApiDecodedTransaction (n :: NetworkDiscriminant) = ApiDecodedTransaction
    { ApiDecodedTransaction n -> ApiT (Hash "Tx")
id :: !(ApiT (Hash "Tx"))
    , ApiDecodedTransaction n -> Quantity "lovelace" Natural
fee :: !(Quantity "lovelace" Natural)
    , ApiDecodedTransaction n -> [ApiTxInputGeneral n]
inputs :: ![ApiTxInputGeneral n]
    , ApiDecodedTransaction n -> [ApiTxOutputGeneral n]
outputs :: ![ApiTxOutputGeneral n]
    , ApiDecodedTransaction n -> [ApiTxInputGeneral n]
collateral :: ![ApiTxInputGeneral n]
    , ApiDecodedTransaction n
-> ApiAsArray "collateral_outputs" (Maybe (ApiTxOutputGeneral n))
collateralOutputs ::
        !(ApiAsArray "collateral_outputs" (Maybe (ApiTxOutputGeneral n)))
    , ApiDecodedTransaction n -> [ApiWithdrawalGeneral n]
withdrawals :: ![ApiWithdrawalGeneral n]
    , ApiDecodedTransaction n -> ApiAssetMintBurn
mint :: !ApiAssetMintBurn
    , ApiDecodedTransaction n -> ApiAssetMintBurn
burn :: !ApiAssetMintBurn
    , ApiDecodedTransaction n -> [ApiAnyCertificate n]
certificates :: ![ApiAnyCertificate n]
    , ApiDecodedTransaction n -> [Quantity "lovelace" Natural]
depositsTaken :: ![Quantity "lovelace" Natural]
    , ApiDecodedTransaction n -> [Quantity "lovelace" Natural]
depositsReturned :: ![Quantity "lovelace" Natural]
    , ApiDecodedTransaction n -> ApiTxMetadata
metadata :: !ApiTxMetadata
    , ApiDecodedTransaction n -> Maybe (ApiT TxScriptValidity)
scriptValidity :: !(Maybe (ApiT TxScriptValidity))
    , ApiDecodedTransaction n -> Maybe ValidityIntervalExplicit
validityInterval :: !(Maybe ValidityIntervalExplicit)
    }
    deriving (ApiDecodedTransaction n -> ApiDecodedTransaction n -> Bool
(ApiDecodedTransaction n -> ApiDecodedTransaction n -> Bool)
-> (ApiDecodedTransaction n -> ApiDecodedTransaction n -> Bool)
-> Eq (ApiDecodedTransaction n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiDecodedTransaction n -> ApiDecodedTransaction n -> Bool
/= :: ApiDecodedTransaction n -> ApiDecodedTransaction n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiDecodedTransaction n -> ApiDecodedTransaction n -> Bool
== :: ApiDecodedTransaction n -> ApiDecodedTransaction n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiDecodedTransaction n -> ApiDecodedTransaction n -> Bool
Eq, (forall x.
 ApiDecodedTransaction n -> Rep (ApiDecodedTransaction n) x)
-> (forall x.
    Rep (ApiDecodedTransaction n) x -> ApiDecodedTransaction n)
-> Generic (ApiDecodedTransaction n)
forall x.
Rep (ApiDecodedTransaction n) x -> ApiDecodedTransaction n
forall x.
ApiDecodedTransaction n -> Rep (ApiDecodedTransaction n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiDecodedTransaction n) x -> ApiDecodedTransaction n
forall (n :: NetworkDiscriminant) x.
ApiDecodedTransaction n -> Rep (ApiDecodedTransaction n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiDecodedTransaction n) x -> ApiDecodedTransaction n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiDecodedTransaction n -> Rep (ApiDecodedTransaction n) x
Generic, Int -> ApiDecodedTransaction n -> ShowS
[ApiDecodedTransaction n] -> ShowS
ApiDecodedTransaction n -> String
(Int -> ApiDecodedTransaction n -> ShowS)
-> (ApiDecodedTransaction n -> String)
-> ([ApiDecodedTransaction n] -> ShowS)
-> Show (ApiDecodedTransaction n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiDecodedTransaction n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiDecodedTransaction n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiDecodedTransaction n -> String
showList :: [ApiDecodedTransaction n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiDecodedTransaction n] -> ShowS
show :: ApiDecodedTransaction n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiDecodedTransaction n -> String
showsPrec :: Int -> ApiDecodedTransaction n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiDecodedTransaction n -> ShowS
Show, Typeable)
    deriving anyclass ApiDecodedTransaction n -> ()
(ApiDecodedTransaction n -> ()) -> NFData (ApiDecodedTransaction n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiDecodedTransaction n -> ()
rnf :: ApiDecodedTransaction n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiDecodedTransaction n -> ()
NFData

newtype ApiTxMetadata = ApiTxMetadata
    { ApiTxMetadata -> Maybe (ApiT TxMetadata)
getApiTxMetadata :: Maybe (ApiT TxMetadata)
    }
    deriving (ApiTxMetadata -> ApiTxMetadata -> Bool
(ApiTxMetadata -> ApiTxMetadata -> Bool)
-> (ApiTxMetadata -> ApiTxMetadata -> Bool) -> Eq ApiTxMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiTxMetadata -> ApiTxMetadata -> Bool
$c/= :: ApiTxMetadata -> ApiTxMetadata -> Bool
== :: ApiTxMetadata -> ApiTxMetadata -> Bool
$c== :: ApiTxMetadata -> ApiTxMetadata -> Bool
Eq, (forall x. ApiTxMetadata -> Rep ApiTxMetadata x)
-> (forall x. Rep ApiTxMetadata x -> ApiTxMetadata)
-> Generic ApiTxMetadata
forall x. Rep ApiTxMetadata x -> ApiTxMetadata
forall x. ApiTxMetadata -> Rep ApiTxMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiTxMetadata x -> ApiTxMetadata
$cfrom :: forall x. ApiTxMetadata -> Rep ApiTxMetadata x
Generic)
    deriving anyclass ApiTxMetadata -> ()
(ApiTxMetadata -> ()) -> NFData ApiTxMetadata
forall a. (a -> ()) -> NFData a
rnf :: ApiTxMetadata -> ()
$crnf :: ApiTxMetadata -> ()
NFData
    deriving Int -> ApiTxMetadata -> ShowS
[ApiTxMetadata] -> ShowS
ApiTxMetadata -> String
(Int -> ApiTxMetadata -> ShowS)
-> (ApiTxMetadata -> String)
-> ([ApiTxMetadata] -> ShowS)
-> Show ApiTxMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiTxMetadata] -> ShowS
$cshowList :: [ApiTxMetadata] -> ShowS
show :: ApiTxMetadata -> String
$cshow :: ApiTxMetadata -> String
showsPrec :: Int -> ApiTxMetadata -> ShowS
$cshowsPrec :: Int -> ApiTxMetadata -> ShowS
Show via (Quiet ApiTxMetadata)

data ApiWithdrawal n = ApiWithdrawal
    { ApiWithdrawal n -> (ApiT RewardAccount, Proxy n)
stakeAddress :: !(ApiT W.RewardAccount, Proxy n)
    , ApiWithdrawal n -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
    } deriving (ApiWithdrawal n -> ApiWithdrawal n -> Bool
(ApiWithdrawal n -> ApiWithdrawal n -> Bool)
-> (ApiWithdrawal n -> ApiWithdrawal n -> Bool)
-> Eq (ApiWithdrawal n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (n :: k). ApiWithdrawal n -> ApiWithdrawal n -> Bool
/= :: ApiWithdrawal n -> ApiWithdrawal n -> Bool
$c/= :: forall k (n :: k). ApiWithdrawal n -> ApiWithdrawal n -> Bool
== :: ApiWithdrawal n -> ApiWithdrawal n -> Bool
$c== :: forall k (n :: k). ApiWithdrawal n -> ApiWithdrawal n -> Bool
Eq, (forall x. ApiWithdrawal n -> Rep (ApiWithdrawal n) x)
-> (forall x. Rep (ApiWithdrawal n) x -> ApiWithdrawal n)
-> Generic (ApiWithdrawal n)
forall x. Rep (ApiWithdrawal n) x -> ApiWithdrawal n
forall x. ApiWithdrawal n -> Rep (ApiWithdrawal n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (n :: k) x. Rep (ApiWithdrawal n) x -> ApiWithdrawal n
forall k (n :: k) x. ApiWithdrawal n -> Rep (ApiWithdrawal n) x
$cto :: forall k (n :: k) x. Rep (ApiWithdrawal n) x -> ApiWithdrawal n
$cfrom :: forall k (n :: k) x. ApiWithdrawal n -> Rep (ApiWithdrawal n) x
Generic, Int -> ApiWithdrawal n -> ShowS
[ApiWithdrawal n] -> ShowS
ApiWithdrawal n -> String
(Int -> ApiWithdrawal n -> ShowS)
-> (ApiWithdrawal n -> String)
-> ([ApiWithdrawal n] -> ShowS)
-> Show (ApiWithdrawal n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k). Int -> ApiWithdrawal n -> ShowS
forall k (n :: k). [ApiWithdrawal n] -> ShowS
forall k (n :: k). ApiWithdrawal n -> String
showList :: [ApiWithdrawal n] -> ShowS
$cshowList :: forall k (n :: k). [ApiWithdrawal n] -> ShowS
show :: ApiWithdrawal n -> String
$cshow :: forall k (n :: k). ApiWithdrawal n -> String
showsPrec :: Int -> ApiWithdrawal n -> ShowS
$cshowsPrec :: forall k (n :: k). Int -> ApiWithdrawal n -> ShowS
Show)
      deriving anyclass ApiWithdrawal n -> ()
(ApiWithdrawal n -> ()) -> NFData (ApiWithdrawal n)
forall a. (a -> ()) -> NFData a
forall k (n :: k). ApiWithdrawal n -> ()
rnf :: ApiWithdrawal n -> ()
$crnf :: forall k (n :: k). ApiWithdrawal n -> ()
NFData

data ApiCoinSelectionWithdrawal n = ApiCoinSelectionWithdrawal
    { ApiCoinSelectionWithdrawal n -> (ApiT RewardAccount, Proxy n)
stakeAddress :: !(ApiT W.RewardAccount, Proxy n)
    , ApiCoinSelectionWithdrawal n -> NonEmpty (ApiT DerivationIndex)
derivationPath :: !(NonEmpty (ApiT DerivationIndex))
    , ApiCoinSelectionWithdrawal n -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
    } deriving (ApiCoinSelectionWithdrawal n
-> ApiCoinSelectionWithdrawal n -> Bool
(ApiCoinSelectionWithdrawal n
 -> ApiCoinSelectionWithdrawal n -> Bool)
-> (ApiCoinSelectionWithdrawal n
    -> ApiCoinSelectionWithdrawal n -> Bool)
-> Eq (ApiCoinSelectionWithdrawal n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (n :: k).
ApiCoinSelectionWithdrawal n
-> ApiCoinSelectionWithdrawal n -> Bool
/= :: ApiCoinSelectionWithdrawal n
-> ApiCoinSelectionWithdrawal n -> Bool
$c/= :: forall k (n :: k).
ApiCoinSelectionWithdrawal n
-> ApiCoinSelectionWithdrawal n -> Bool
== :: ApiCoinSelectionWithdrawal n
-> ApiCoinSelectionWithdrawal n -> Bool
$c== :: forall k (n :: k).
ApiCoinSelectionWithdrawal n
-> ApiCoinSelectionWithdrawal n -> Bool
Eq, (forall x.
 ApiCoinSelectionWithdrawal n
 -> Rep (ApiCoinSelectionWithdrawal n) x)
-> (forall x.
    Rep (ApiCoinSelectionWithdrawal n) x
    -> ApiCoinSelectionWithdrawal n)
-> Generic (ApiCoinSelectionWithdrawal n)
forall x.
Rep (ApiCoinSelectionWithdrawal n) x
-> ApiCoinSelectionWithdrawal n
forall x.
ApiCoinSelectionWithdrawal n
-> Rep (ApiCoinSelectionWithdrawal n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (n :: k) x.
Rep (ApiCoinSelectionWithdrawal n) x
-> ApiCoinSelectionWithdrawal n
forall k (n :: k) x.
ApiCoinSelectionWithdrawal n
-> Rep (ApiCoinSelectionWithdrawal n) x
$cto :: forall k (n :: k) x.
Rep (ApiCoinSelectionWithdrawal n) x
-> ApiCoinSelectionWithdrawal n
$cfrom :: forall k (n :: k) x.
ApiCoinSelectionWithdrawal n
-> Rep (ApiCoinSelectionWithdrawal n) x
Generic, Int -> ApiCoinSelectionWithdrawal n -> ShowS
[ApiCoinSelectionWithdrawal n] -> ShowS
ApiCoinSelectionWithdrawal n -> String
(Int -> ApiCoinSelectionWithdrawal n -> ShowS)
-> (ApiCoinSelectionWithdrawal n -> String)
-> ([ApiCoinSelectionWithdrawal n] -> ShowS)
-> Show (ApiCoinSelectionWithdrawal n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k). Int -> ApiCoinSelectionWithdrawal n -> ShowS
forall k (n :: k). [ApiCoinSelectionWithdrawal n] -> ShowS
forall k (n :: k). ApiCoinSelectionWithdrawal n -> String
showList :: [ApiCoinSelectionWithdrawal n] -> ShowS
$cshowList :: forall k (n :: k). [ApiCoinSelectionWithdrawal n] -> ShowS
show :: ApiCoinSelectionWithdrawal n -> String
$cshow :: forall k (n :: k). ApiCoinSelectionWithdrawal n -> String
showsPrec :: Int -> ApiCoinSelectionWithdrawal n -> ShowS
$cshowsPrec :: forall k (n :: k). Int -> ApiCoinSelectionWithdrawal n -> ShowS
Show)
      deriving anyclass ApiCoinSelectionWithdrawal n -> ()
(ApiCoinSelectionWithdrawal n -> ())
-> NFData (ApiCoinSelectionWithdrawal n)
forall a. (a -> ()) -> NFData a
forall k (n :: k). ApiCoinSelectionWithdrawal n -> ()
rnf :: ApiCoinSelectionWithdrawal n -> ()
$crnf :: forall k (n :: k). ApiCoinSelectionWithdrawal n -> ()
NFData

data ApiWithdrawalPostData
    = SelfWithdrawal
    | ExternalWithdrawal (ApiMnemonicT '[15,18,21,24])
    deriving (ApiWithdrawalPostData -> ApiWithdrawalPostData -> Bool
(ApiWithdrawalPostData -> ApiWithdrawalPostData -> Bool)
-> (ApiWithdrawalPostData -> ApiWithdrawalPostData -> Bool)
-> Eq ApiWithdrawalPostData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWithdrawalPostData -> ApiWithdrawalPostData -> Bool
$c/= :: ApiWithdrawalPostData -> ApiWithdrawalPostData -> Bool
== :: ApiWithdrawalPostData -> ApiWithdrawalPostData -> Bool
$c== :: ApiWithdrawalPostData -> ApiWithdrawalPostData -> Bool
Eq, (forall x. ApiWithdrawalPostData -> Rep ApiWithdrawalPostData x)
-> (forall x. Rep ApiWithdrawalPostData x -> ApiWithdrawalPostData)
-> Generic ApiWithdrawalPostData
forall x. Rep ApiWithdrawalPostData x -> ApiWithdrawalPostData
forall x. ApiWithdrawalPostData -> Rep ApiWithdrawalPostData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWithdrawalPostData x -> ApiWithdrawalPostData
$cfrom :: forall x. ApiWithdrawalPostData -> Rep ApiWithdrawalPostData x
Generic, Int -> ApiWithdrawalPostData -> ShowS
[ApiWithdrawalPostData] -> ShowS
ApiWithdrawalPostData -> String
(Int -> ApiWithdrawalPostData -> ShowS)
-> (ApiWithdrawalPostData -> String)
-> ([ApiWithdrawalPostData] -> ShowS)
-> Show ApiWithdrawalPostData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWithdrawalPostData] -> ShowS
$cshowList :: [ApiWithdrawalPostData] -> ShowS
show :: ApiWithdrawalPostData -> String
$cshow :: ApiWithdrawalPostData -> String
showsPrec :: Int -> ApiWithdrawalPostData -> ShowS
$cshowsPrec :: Int -> ApiWithdrawalPostData -> ShowS
Show)
    deriving anyclass ApiWithdrawalPostData -> ()
(ApiWithdrawalPostData -> ()) -> NFData ApiWithdrawalPostData
forall a. (a -> ()) -> NFData a
rnf :: ApiWithdrawalPostData -> ()
$crnf :: ApiWithdrawalPostData -> ()
NFData

data ApiTxInput (n :: NetworkDiscriminant) = ApiTxInput
    { ApiTxInput n -> Maybe (ApiTxOutput n)
source :: !(Maybe (ApiTxOutput n))
    , ApiTxInput n -> ApiT TxIn
input :: !(ApiT TxIn)
    } deriving (ApiTxInput n -> ApiTxInput n -> Bool
(ApiTxInput n -> ApiTxInput n -> Bool)
-> (ApiTxInput n -> ApiTxInput n -> Bool) -> Eq (ApiTxInput n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiTxInput n -> ApiTxInput n -> Bool
/= :: ApiTxInput n -> ApiTxInput n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiTxInput n -> ApiTxInput n -> Bool
== :: ApiTxInput n -> ApiTxInput n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiTxInput n -> ApiTxInput n -> Bool
Eq, (forall x. ApiTxInput n -> Rep (ApiTxInput n) x)
-> (forall x. Rep (ApiTxInput n) x -> ApiTxInput n)
-> Generic (ApiTxInput n)
forall x. Rep (ApiTxInput n) x -> ApiTxInput n
forall x. ApiTxInput n -> Rep (ApiTxInput n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiTxInput n) x -> ApiTxInput n
forall (n :: NetworkDiscriminant) x.
ApiTxInput n -> Rep (ApiTxInput n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiTxInput n) x -> ApiTxInput n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiTxInput n -> Rep (ApiTxInput n) x
Generic, Int -> ApiTxInput n -> ShowS
[ApiTxInput n] -> ShowS
ApiTxInput n -> String
(Int -> ApiTxInput n -> ShowS)
-> (ApiTxInput n -> String)
-> ([ApiTxInput n] -> ShowS)
-> Show (ApiTxInput n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant). Int -> ApiTxInput n -> ShowS
forall (n :: NetworkDiscriminant). [ApiTxInput n] -> ShowS
forall (n :: NetworkDiscriminant). ApiTxInput n -> String
showList :: [ApiTxInput n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiTxInput n] -> ShowS
show :: ApiTxInput n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiTxInput n -> String
showsPrec :: Int -> ApiTxInput n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant). Int -> ApiTxInput n -> ShowS
Show, Typeable)
      deriving anyclass ApiTxInput n -> ()
(ApiTxInput n -> ()) -> NFData (ApiTxInput n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiTxInput n -> ()
rnf :: ApiTxInput n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiTxInput n -> ()
NFData

data ApiTxCollateral (n :: NetworkDiscriminant) = ApiTxCollateral
    { ApiTxCollateral n
-> Maybe (AddressAmountNoAssets (ApiT Address, Proxy n))
source :: !(Maybe (AddressAmountNoAssets (ApiT Address, Proxy n)))
    , ApiTxCollateral n -> ApiT TxIn
input :: !(ApiT TxIn)
    } deriving (ApiTxCollateral n -> ApiTxCollateral n -> Bool
(ApiTxCollateral n -> ApiTxCollateral n -> Bool)
-> (ApiTxCollateral n -> ApiTxCollateral n -> Bool)
-> Eq (ApiTxCollateral n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiTxCollateral n -> ApiTxCollateral n -> Bool
/= :: ApiTxCollateral n -> ApiTxCollateral n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiTxCollateral n -> ApiTxCollateral n -> Bool
== :: ApiTxCollateral n -> ApiTxCollateral n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiTxCollateral n -> ApiTxCollateral n -> Bool
Eq, (forall x. ApiTxCollateral n -> Rep (ApiTxCollateral n) x)
-> (forall x. Rep (ApiTxCollateral n) x -> ApiTxCollateral n)
-> Generic (ApiTxCollateral n)
forall x. Rep (ApiTxCollateral n) x -> ApiTxCollateral n
forall x. ApiTxCollateral n -> Rep (ApiTxCollateral n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiTxCollateral n) x -> ApiTxCollateral n
forall (n :: NetworkDiscriminant) x.
ApiTxCollateral n -> Rep (ApiTxCollateral n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiTxCollateral n) x -> ApiTxCollateral n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiTxCollateral n -> Rep (ApiTxCollateral n) x
Generic, Int -> ApiTxCollateral n -> ShowS
[ApiTxCollateral n] -> ShowS
ApiTxCollateral n -> String
(Int -> ApiTxCollateral n -> ShowS)
-> (ApiTxCollateral n -> String)
-> ([ApiTxCollateral n] -> ShowS)
-> Show (ApiTxCollateral n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiTxCollateral n -> ShowS
forall (n :: NetworkDiscriminant). [ApiTxCollateral n] -> ShowS
forall (n :: NetworkDiscriminant). ApiTxCollateral n -> String
showList :: [ApiTxCollateral n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiTxCollateral n] -> ShowS
show :: ApiTxCollateral n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiTxCollateral n -> String
showsPrec :: Int -> ApiTxCollateral n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiTxCollateral n -> ShowS
Show, Typeable)
      deriving anyclass ApiTxCollateral n -> ()
(ApiTxCollateral n -> ()) -> NFData (ApiTxCollateral n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiTxCollateral n -> ()
rnf :: ApiTxCollateral n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiTxCollateral n -> ()
NFData

data AddressAmount addr = AddressAmount
    { AddressAmount addr -> addr
address :: !addr
    , AddressAmount addr -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
    , AddressAmount addr -> ApiT TokenMap
assets :: !(ApiT W.TokenMap)
    } deriving (AddressAmount addr -> AddressAmount addr -> Bool
(AddressAmount addr -> AddressAmount addr -> Bool)
-> (AddressAmount addr -> AddressAmount addr -> Bool)
-> Eq (AddressAmount addr)
forall addr.
Eq addr =>
AddressAmount addr -> AddressAmount addr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressAmount addr -> AddressAmount addr -> Bool
$c/= :: forall addr.
Eq addr =>
AddressAmount addr -> AddressAmount addr -> Bool
== :: AddressAmount addr -> AddressAmount addr -> Bool
$c== :: forall addr.
Eq addr =>
AddressAmount addr -> AddressAmount addr -> Bool
Eq, (forall x. AddressAmount addr -> Rep (AddressAmount addr) x)
-> (forall x. Rep (AddressAmount addr) x -> AddressAmount addr)
-> Generic (AddressAmount addr)
forall x. Rep (AddressAmount addr) x -> AddressAmount addr
forall x. AddressAmount addr -> Rep (AddressAmount addr) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall addr x. Rep (AddressAmount addr) x -> AddressAmount addr
forall addr x. AddressAmount addr -> Rep (AddressAmount addr) x
$cto :: forall addr x. Rep (AddressAmount addr) x -> AddressAmount addr
$cfrom :: forall addr x. AddressAmount addr -> Rep (AddressAmount addr) x
Generic, Int -> AddressAmount addr -> ShowS
[AddressAmount addr] -> ShowS
AddressAmount addr -> String
(Int -> AddressAmount addr -> ShowS)
-> (AddressAmount addr -> String)
-> ([AddressAmount addr] -> ShowS)
-> Show (AddressAmount addr)
forall addr. Show addr => Int -> AddressAmount addr -> ShowS
forall addr. Show addr => [AddressAmount addr] -> ShowS
forall addr. Show addr => AddressAmount addr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressAmount addr] -> ShowS
$cshowList :: forall addr. Show addr => [AddressAmount addr] -> ShowS
show :: AddressAmount addr -> String
$cshow :: forall addr. Show addr => AddressAmount addr -> String
showsPrec :: Int -> AddressAmount addr -> ShowS
$cshowsPrec :: forall addr. Show addr => Int -> AddressAmount addr -> ShowS
Show)
      deriving anyclass AddressAmount addr -> ()
(AddressAmount addr -> ()) -> NFData (AddressAmount addr)
forall addr. NFData addr => AddressAmount addr -> ()
forall a. (a -> ()) -> NFData a
rnf :: AddressAmount addr -> ()
$crnf :: forall addr. NFData addr => AddressAmount addr -> ()
NFData

data AddressAmountNoAssets addr = AddressAmountNoAssets
    { AddressAmountNoAssets addr -> addr
address :: !addr
    , AddressAmountNoAssets addr -> Quantity "lovelace" Natural
amount :: !(Quantity "lovelace" Natural)
    }
    deriving (AddressAmountNoAssets addr -> AddressAmountNoAssets addr -> Bool
(AddressAmountNoAssets addr -> AddressAmountNoAssets addr -> Bool)
-> (AddressAmountNoAssets addr
    -> AddressAmountNoAssets addr -> Bool)
-> Eq (AddressAmountNoAssets addr)
forall addr.
Eq addr =>
AddressAmountNoAssets addr -> AddressAmountNoAssets addr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressAmountNoAssets addr -> AddressAmountNoAssets addr -> Bool
$c/= :: forall addr.
Eq addr =>
AddressAmountNoAssets addr -> AddressAmountNoAssets addr -> Bool
== :: AddressAmountNoAssets addr -> AddressAmountNoAssets addr -> Bool
$c== :: forall addr.
Eq addr =>
AddressAmountNoAssets addr -> AddressAmountNoAssets addr -> Bool
Eq, (forall x.
 AddressAmountNoAssets addr -> Rep (AddressAmountNoAssets addr) x)
-> (forall x.
    Rep (AddressAmountNoAssets addr) x -> AddressAmountNoAssets addr)
-> Generic (AddressAmountNoAssets addr)
forall x.
Rep (AddressAmountNoAssets addr) x -> AddressAmountNoAssets addr
forall x.
AddressAmountNoAssets addr -> Rep (AddressAmountNoAssets addr) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall addr x.
Rep (AddressAmountNoAssets addr) x -> AddressAmountNoAssets addr
forall addr x.
AddressAmountNoAssets addr -> Rep (AddressAmountNoAssets addr) x
$cto :: forall addr x.
Rep (AddressAmountNoAssets addr) x -> AddressAmountNoAssets addr
$cfrom :: forall addr x.
AddressAmountNoAssets addr -> Rep (AddressAmountNoAssets addr) x
Generic, Int -> AddressAmountNoAssets addr -> ShowS
[AddressAmountNoAssets addr] -> ShowS
AddressAmountNoAssets addr -> String
(Int -> AddressAmountNoAssets addr -> ShowS)
-> (AddressAmountNoAssets addr -> String)
-> ([AddressAmountNoAssets addr] -> ShowS)
-> Show (AddressAmountNoAssets addr)
forall addr.
Show addr =>
Int -> AddressAmountNoAssets addr -> ShowS
forall addr. Show addr => [AddressAmountNoAssets addr] -> ShowS
forall addr. Show addr => AddressAmountNoAssets addr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressAmountNoAssets addr] -> ShowS
$cshowList :: forall addr. Show addr => [AddressAmountNoAssets addr] -> ShowS
show :: AddressAmountNoAssets addr -> String
$cshow :: forall addr. Show addr => AddressAmountNoAssets addr -> String
showsPrec :: Int -> AddressAmountNoAssets addr -> ShowS
$cshowsPrec :: forall addr.
Show addr =>
Int -> AddressAmountNoAssets addr -> ShowS
Show)
    deriving anyclass AddressAmountNoAssets addr -> ()
(AddressAmountNoAssets addr -> ())
-> NFData (AddressAmountNoAssets addr)
forall addr. NFData addr => AddressAmountNoAssets addr -> ()
forall a. (a -> ()) -> NFData a
rnf :: AddressAmountNoAssets addr -> ()
$crnf :: forall addr. NFData addr => AddressAmountNoAssets addr -> ()
NFData

coinToQuantity :: Integral n => Coin -> Quantity "lovelace" n
coinToQuantity :: Coin -> Quantity "lovelace" n
coinToQuantity = n -> Quantity "lovelace" n
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (n -> Quantity "lovelace" n)
-> (Coin -> n) -> Coin -> Quantity "lovelace" n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> n) -> (Coin -> Natural) -> Coin -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin

coinFromQuantity :: Integral n => Quantity "lovelace" n -> Coin
coinFromQuantity :: Quantity "lovelace" n -> Coin
coinFromQuantity = Natural -> Coin
Coin (Natural -> Coin)
-> (Quantity "lovelace" n -> Natural)
-> Quantity "lovelace" n
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (n -> Natural)
-> (Quantity "lovelace" n -> n) -> Quantity "lovelace" n -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity "lovelace" n -> n
forall (unit :: Symbol) a. Quantity unit a -> a
getQuantity

newtype ApiAddressInspect = ApiAddressInspect
    { ApiAddressInspect -> Value
unApiAddressInspect :: Aeson.Value }
    deriving (ApiAddressInspect -> ApiAddressInspect -> Bool
(ApiAddressInspect -> ApiAddressInspect -> Bool)
-> (ApiAddressInspect -> ApiAddressInspect -> Bool)
-> Eq ApiAddressInspect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiAddressInspect -> ApiAddressInspect -> Bool
$c/= :: ApiAddressInspect -> ApiAddressInspect -> Bool
== :: ApiAddressInspect -> ApiAddressInspect -> Bool
$c== :: ApiAddressInspect -> ApiAddressInspect -> Bool
Eq, (forall x. ApiAddressInspect -> Rep ApiAddressInspect x)
-> (forall x. Rep ApiAddressInspect x -> ApiAddressInspect)
-> Generic ApiAddressInspect
forall x. Rep ApiAddressInspect x -> ApiAddressInspect
forall x. ApiAddressInspect -> Rep ApiAddressInspect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiAddressInspect x -> ApiAddressInspect
$cfrom :: forall x. ApiAddressInspect -> Rep ApiAddressInspect x
Generic)
    deriving anyclass ApiAddressInspect -> ()
(ApiAddressInspect -> ()) -> NFData ApiAddressInspect
forall a. (a -> ()) -> NFData a
rnf :: ApiAddressInspect -> ()
$crnf :: ApiAddressInspect -> ()
NFData
    deriving Int -> ApiAddressInspect -> ShowS
[ApiAddressInspect] -> ShowS
ApiAddressInspect -> String
(Int -> ApiAddressInspect -> ShowS)
-> (ApiAddressInspect -> String)
-> ([ApiAddressInspect] -> ShowS)
-> Show ApiAddressInspect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiAddressInspect] -> ShowS
$cshowList :: [ApiAddressInspect] -> ShowS
show :: ApiAddressInspect -> String
$cshow :: ApiAddressInspect -> String
showsPrec :: Int -> ApiAddressInspect -> ShowS
$cshowsPrec :: Int -> ApiAddressInspect -> ShowS
Show via (Quiet ApiAddressInspect)

newtype ApiAddressInspectData = ApiAddressInspectData
    { ApiAddressInspectData -> Text
unApiAddressInspectData :: Text }
    deriving (ApiAddressInspectData -> ApiAddressInspectData -> Bool
(ApiAddressInspectData -> ApiAddressInspectData -> Bool)
-> (ApiAddressInspectData -> ApiAddressInspectData -> Bool)
-> Eq ApiAddressInspectData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiAddressInspectData -> ApiAddressInspectData -> Bool
$c/= :: ApiAddressInspectData -> ApiAddressInspectData -> Bool
== :: ApiAddressInspectData -> ApiAddressInspectData -> Bool
$c== :: ApiAddressInspectData -> ApiAddressInspectData -> Bool
Eq, (forall x. ApiAddressInspectData -> Rep ApiAddressInspectData x)
-> (forall x. Rep ApiAddressInspectData x -> ApiAddressInspectData)
-> Generic ApiAddressInspectData
forall x. Rep ApiAddressInspectData x -> ApiAddressInspectData
forall x. ApiAddressInspectData -> Rep ApiAddressInspectData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiAddressInspectData x -> ApiAddressInspectData
$cfrom :: forall x. ApiAddressInspectData -> Rep ApiAddressInspectData x
Generic)
    deriving newtype (String -> ApiAddressInspectData
(String -> ApiAddressInspectData) -> IsString ApiAddressInspectData
forall a. (String -> a) -> IsString a
fromString :: String -> ApiAddressInspectData
$cfromString :: String -> ApiAddressInspectData
IsString)
    deriving anyclass ApiAddressInspectData -> ()
(ApiAddressInspectData -> ()) -> NFData ApiAddressInspectData
forall a. (a -> ()) -> NFData a
rnf :: ApiAddressInspectData -> ()
$crnf :: ApiAddressInspectData -> ()
NFData
    deriving Int -> ApiAddressInspectData -> ShowS
[ApiAddressInspectData] -> ShowS
ApiAddressInspectData -> String
(Int -> ApiAddressInspectData -> ShowS)
-> (ApiAddressInspectData -> String)
-> ([ApiAddressInspectData] -> ShowS)
-> Show ApiAddressInspectData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiAddressInspectData] -> ShowS
$cshowList :: [ApiAddressInspectData] -> ShowS
show :: ApiAddressInspectData -> String
$cshow :: ApiAddressInspectData -> String
showsPrec :: Int -> ApiAddressInspectData -> ShowS
$cshowsPrec :: Int -> ApiAddressInspectData -> ShowS
Show via (Quiet ApiAddressInspectData)

data ApiSlotReference = ApiSlotReference
    { ApiSlotReference -> ApiT SlotNo
absoluteSlotNumber :: !(ApiT SlotNo)
    , ApiSlotReference -> ApiSlotId
slotId :: !ApiSlotId
    , ApiSlotReference -> UTCTime
time :: !UTCTime
    } deriving (ApiSlotReference -> ApiSlotReference -> Bool
(ApiSlotReference -> ApiSlotReference -> Bool)
-> (ApiSlotReference -> ApiSlotReference -> Bool)
-> Eq ApiSlotReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiSlotReference -> ApiSlotReference -> Bool
$c/= :: ApiSlotReference -> ApiSlotReference -> Bool
== :: ApiSlotReference -> ApiSlotReference -> Bool
$c== :: ApiSlotReference -> ApiSlotReference -> Bool
Eq, (forall x. ApiSlotReference -> Rep ApiSlotReference x)
-> (forall x. Rep ApiSlotReference x -> ApiSlotReference)
-> Generic ApiSlotReference
forall x. Rep ApiSlotReference x -> ApiSlotReference
forall x. ApiSlotReference -> Rep ApiSlotReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiSlotReference x -> ApiSlotReference
$cfrom :: forall x. ApiSlotReference -> Rep ApiSlotReference x
Generic, Int -> ApiSlotReference -> ShowS
[ApiSlotReference] -> ShowS
ApiSlotReference -> String
(Int -> ApiSlotReference -> ShowS)
-> (ApiSlotReference -> String)
-> ([ApiSlotReference] -> ShowS)
-> Show ApiSlotReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiSlotReference] -> ShowS
$cshowList :: [ApiSlotReference] -> ShowS
show :: ApiSlotReference -> String
$cshow :: ApiSlotReference -> String
showsPrec :: Int -> ApiSlotReference -> ShowS
$cshowsPrec :: Int -> ApiSlotReference -> ShowS
Show)
      deriving anyclass ApiSlotReference -> ()
(ApiSlotReference -> ()) -> NFData ApiSlotReference
forall a. (a -> ()) -> NFData a
rnf :: ApiSlotReference -> ()
$crnf :: ApiSlotReference -> ()
NFData

data ApiSlotId = ApiSlotId
    { ApiSlotId -> ApiT EpochNo
epochNumber :: !(ApiT EpochNo)
    , ApiSlotId -> ApiT SlotInEpoch
slotNumber :: !(ApiT SlotInEpoch)
    } deriving (ApiSlotId -> ApiSlotId -> Bool
(ApiSlotId -> ApiSlotId -> Bool)
-> (ApiSlotId -> ApiSlotId -> Bool) -> Eq ApiSlotId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiSlotId -> ApiSlotId -> Bool
$c/= :: ApiSlotId -> ApiSlotId -> Bool
== :: ApiSlotId -> ApiSlotId -> Bool
$c== :: ApiSlotId -> ApiSlotId -> Bool
Eq, (forall x. ApiSlotId -> Rep ApiSlotId x)
-> (forall x. Rep ApiSlotId x -> ApiSlotId) -> Generic ApiSlotId
forall x. Rep ApiSlotId x -> ApiSlotId
forall x. ApiSlotId -> Rep ApiSlotId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiSlotId x -> ApiSlotId
$cfrom :: forall x. ApiSlotId -> Rep ApiSlotId x
Generic, Int -> ApiSlotId -> ShowS
[ApiSlotId] -> ShowS
ApiSlotId -> String
(Int -> ApiSlotId -> ShowS)
-> (ApiSlotId -> String)
-> ([ApiSlotId] -> ShowS)
-> Show ApiSlotId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiSlotId] -> ShowS
$cshowList :: [ApiSlotId] -> ShowS
show :: ApiSlotId -> String
$cshow :: ApiSlotId -> String
showsPrec :: Int -> ApiSlotId -> ShowS
$cshowsPrec :: Int -> ApiSlotId -> ShowS
Show)
      deriving anyclass ApiSlotId -> ()
(ApiSlotId -> ()) -> NFData ApiSlotId
forall a. (a -> ()) -> NFData a
rnf :: ApiSlotId -> ()
$crnf :: ApiSlotId -> ()
NFData

data ApiBlockReference = ApiBlockReference
    { ApiBlockReference -> ApiT SlotNo
absoluteSlotNumber :: !(ApiT SlotNo)
    , ApiBlockReference -> ApiSlotId
slotId :: !ApiSlotId
    , ApiBlockReference -> UTCTime
time :: !UTCTime
    , ApiBlockReference -> ApiBlockInfo
block :: !ApiBlockInfo
    } deriving (ApiBlockReference -> ApiBlockReference -> Bool
(ApiBlockReference -> ApiBlockReference -> Bool)
-> (ApiBlockReference -> ApiBlockReference -> Bool)
-> Eq ApiBlockReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiBlockReference -> ApiBlockReference -> Bool
$c/= :: ApiBlockReference -> ApiBlockReference -> Bool
== :: ApiBlockReference -> ApiBlockReference -> Bool
$c== :: ApiBlockReference -> ApiBlockReference -> Bool
Eq, (forall x. ApiBlockReference -> Rep ApiBlockReference x)
-> (forall x. Rep ApiBlockReference x -> ApiBlockReference)
-> Generic ApiBlockReference
forall x. Rep ApiBlockReference x -> ApiBlockReference
forall x. ApiBlockReference -> Rep ApiBlockReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiBlockReference x -> ApiBlockReference
$cfrom :: forall x. ApiBlockReference -> Rep ApiBlockReference x
Generic, Int -> ApiBlockReference -> ShowS
[ApiBlockReference] -> ShowS
ApiBlockReference -> String
(Int -> ApiBlockReference -> ShowS)
-> (ApiBlockReference -> String)
-> ([ApiBlockReference] -> ShowS)
-> Show ApiBlockReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiBlockReference] -> ShowS
$cshowList :: [ApiBlockReference] -> ShowS
show :: ApiBlockReference -> String
$cshow :: ApiBlockReference -> String
showsPrec :: Int -> ApiBlockReference -> ShowS
$cshowsPrec :: Int -> ApiBlockReference -> ShowS
Show)
      deriving anyclass ApiBlockReference -> ()
(ApiBlockReference -> ()) -> NFData ApiBlockReference
forall a. (a -> ()) -> NFData a
rnf :: ApiBlockReference -> ()
$crnf :: ApiBlockReference -> ()
NFData

newtype ApiBlockInfo = ApiBlockInfo
    { ApiBlockInfo -> Quantity "block" Natural
height :: Quantity "block" Natural
    }
    deriving (ApiBlockInfo -> ApiBlockInfo -> Bool
(ApiBlockInfo -> ApiBlockInfo -> Bool)
-> (ApiBlockInfo -> ApiBlockInfo -> Bool) -> Eq ApiBlockInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiBlockInfo -> ApiBlockInfo -> Bool
$c/= :: ApiBlockInfo -> ApiBlockInfo -> Bool
== :: ApiBlockInfo -> ApiBlockInfo -> Bool
$c== :: ApiBlockInfo -> ApiBlockInfo -> Bool
Eq, (forall x. ApiBlockInfo -> Rep ApiBlockInfo x)
-> (forall x. Rep ApiBlockInfo x -> ApiBlockInfo)
-> Generic ApiBlockInfo
forall x. Rep ApiBlockInfo x -> ApiBlockInfo
forall x. ApiBlockInfo -> Rep ApiBlockInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiBlockInfo x -> ApiBlockInfo
$cfrom :: forall x. ApiBlockInfo -> Rep ApiBlockInfo x
Generic)
    deriving anyclass ApiBlockInfo -> ()
(ApiBlockInfo -> ()) -> NFData ApiBlockInfo
forall a. (a -> ()) -> NFData a
rnf :: ApiBlockInfo -> ()
$crnf :: ApiBlockInfo -> ()
NFData
    deriving Int -> ApiBlockInfo -> ShowS
[ApiBlockInfo] -> ShowS
ApiBlockInfo -> String
(Int -> ApiBlockInfo -> ShowS)
-> (ApiBlockInfo -> String)
-> ([ApiBlockInfo] -> ShowS)
-> Show ApiBlockInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiBlockInfo] -> ShowS
$cshowList :: [ApiBlockInfo] -> ShowS
show :: ApiBlockInfo -> String
$cshow :: ApiBlockInfo -> String
showsPrec :: Int -> ApiBlockInfo -> ShowS
$cshowsPrec :: Int -> ApiBlockInfo -> ShowS
Show via (Quiet ApiBlockInfo)

data ApiEra
    = ApiByron
    | ApiShelley
    | ApiAllegra
    | ApiMary
    | ApiAlonzo
    | ApiBabbage
    deriving (Int -> ApiEra -> ShowS
[ApiEra] -> ShowS
ApiEra -> String
(Int -> ApiEra -> ShowS)
-> (ApiEra -> String) -> ([ApiEra] -> ShowS) -> Show ApiEra
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiEra] -> ShowS
$cshowList :: [ApiEra] -> ShowS
show :: ApiEra -> String
$cshow :: ApiEra -> String
showsPrec :: Int -> ApiEra -> ShowS
$cshowsPrec :: Int -> ApiEra -> ShowS
Show, ApiEra -> ApiEra -> Bool
(ApiEra -> ApiEra -> Bool)
-> (ApiEra -> ApiEra -> Bool) -> Eq ApiEra
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiEra -> ApiEra -> Bool
$c/= :: ApiEra -> ApiEra -> Bool
== :: ApiEra -> ApiEra -> Bool
$c== :: ApiEra -> ApiEra -> Bool
Eq, (forall x. ApiEra -> Rep ApiEra x)
-> (forall x. Rep ApiEra x -> ApiEra) -> Generic ApiEra
forall x. Rep ApiEra x -> ApiEra
forall x. ApiEra -> Rep ApiEra x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiEra x -> ApiEra
$cfrom :: forall x. ApiEra -> Rep ApiEra x
Generic, Int -> ApiEra
ApiEra -> Int
ApiEra -> [ApiEra]
ApiEra -> ApiEra
ApiEra -> ApiEra -> [ApiEra]
ApiEra -> ApiEra -> ApiEra -> [ApiEra]
(ApiEra -> ApiEra)
-> (ApiEra -> ApiEra)
-> (Int -> ApiEra)
-> (ApiEra -> Int)
-> (ApiEra -> [ApiEra])
-> (ApiEra -> ApiEra -> [ApiEra])
-> (ApiEra -> ApiEra -> [ApiEra])
-> (ApiEra -> ApiEra -> ApiEra -> [ApiEra])
-> Enum ApiEra
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ApiEra -> ApiEra -> ApiEra -> [ApiEra]
$cenumFromThenTo :: ApiEra -> ApiEra -> ApiEra -> [ApiEra]
enumFromTo :: ApiEra -> ApiEra -> [ApiEra]
$cenumFromTo :: ApiEra -> ApiEra -> [ApiEra]
enumFromThen :: ApiEra -> ApiEra -> [ApiEra]
$cenumFromThen :: ApiEra -> ApiEra -> [ApiEra]
enumFrom :: ApiEra -> [ApiEra]
$cenumFrom :: ApiEra -> [ApiEra]
fromEnum :: ApiEra -> Int
$cfromEnum :: ApiEra -> Int
toEnum :: Int -> ApiEra
$ctoEnum :: Int -> ApiEra
pred :: ApiEra -> ApiEra
$cpred :: ApiEra -> ApiEra
succ :: ApiEra -> ApiEra
$csucc :: ApiEra -> ApiEra
Enum, Eq ApiEra
Eq ApiEra
-> (ApiEra -> ApiEra -> Ordering)
-> (ApiEra -> ApiEra -> Bool)
-> (ApiEra -> ApiEra -> Bool)
-> (ApiEra -> ApiEra -> Bool)
-> (ApiEra -> ApiEra -> Bool)
-> (ApiEra -> ApiEra -> ApiEra)
-> (ApiEra -> ApiEra -> ApiEra)
-> Ord ApiEra
ApiEra -> ApiEra -> Bool
ApiEra -> ApiEra -> Ordering
ApiEra -> ApiEra -> ApiEra
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ApiEra -> ApiEra -> ApiEra
$cmin :: ApiEra -> ApiEra -> ApiEra
max :: ApiEra -> ApiEra -> ApiEra
$cmax :: ApiEra -> ApiEra -> ApiEra
>= :: ApiEra -> ApiEra -> Bool
$c>= :: ApiEra -> ApiEra -> Bool
> :: ApiEra -> ApiEra -> Bool
$c> :: ApiEra -> ApiEra -> Bool
<= :: ApiEra -> ApiEra -> Bool
$c<= :: ApiEra -> ApiEra -> Bool
< :: ApiEra -> ApiEra -> Bool
$c< :: ApiEra -> ApiEra -> Bool
compare :: ApiEra -> ApiEra -> Ordering
$ccompare :: ApiEra -> ApiEra -> Ordering
$cp1Ord :: Eq ApiEra
Ord, ApiEra
ApiEra -> ApiEra -> Bounded ApiEra
forall a. a -> a -> Bounded a
maxBound :: ApiEra
$cmaxBound :: ApiEra
minBound :: ApiEra
$cminBound :: ApiEra
Bounded)
    deriving anyclass ApiEra -> ()
(ApiEra -> ()) -> NFData ApiEra
forall a. (a -> ()) -> NFData a
rnf :: ApiEra -> ()
$crnf :: ApiEra -> ()
NFData

toApiEra :: AnyCardanoEra -> ApiEra
toApiEra :: AnyCardanoEra -> ApiEra
toApiEra (AnyCardanoEra CardanoEra era
ByronEra) = ApiEra
ApiByron
toApiEra (AnyCardanoEra CardanoEra era
ShelleyEra) = ApiEra
ApiShelley
toApiEra (AnyCardanoEra CardanoEra era
AllegraEra) = ApiEra
ApiAllegra
toApiEra (AnyCardanoEra CardanoEra era
MaryEra) = ApiEra
ApiMary
toApiEra (AnyCardanoEra CardanoEra era
AlonzoEra) = ApiEra
ApiAlonzo
toApiEra (AnyCardanoEra CardanoEra era
BabbageEra) = ApiEra
ApiBabbage

fromApiEra :: ApiEra -> AnyCardanoEra
fromApiEra :: ApiEra -> AnyCardanoEra
fromApiEra ApiEra
ApiByron = CardanoEra ByronEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
fromApiEra ApiEra
ApiShelley = CardanoEra ShelleyEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
fromApiEra ApiEra
ApiAllegra = CardanoEra AllegraEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AllegraEra
AllegraEra
fromApiEra ApiEra
ApiMary = CardanoEra MaryEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra MaryEra
MaryEra
fromApiEra ApiEra
ApiAlonzo = CardanoEra AlonzoEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AlonzoEra
AlonzoEra
fromApiEra ApiEra
ApiBabbage = CardanoEra BabbageEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra BabbageEra
BabbageEra


instance FromJSON ApiEra where
    parseJSON :: Value -> Parser ApiEra
parseJSON = Options -> Value -> Parser ApiEra
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ApiEra)
-> Options -> Value -> Parser ApiEra
forall a b. (a -> b) -> a -> b
$ Options
Aeson.defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
camelTo2 Char
'_' }
instance ToJSON ApiEra where
    toJSON :: ApiEra -> Value
toJSON = Options -> ApiEra -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> ApiEra -> Value) -> Options -> ApiEra -> Value
forall a b. (a -> b) -> a -> b
$ Options
Aeson.defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
camelTo2 Char
'_' }

data ApiNetworkInfo = ApiNetworkInfo
    { ApiNetworkInfo -> Text
networkId :: !Text
    , ApiNetworkInfo -> Integer
protocolMagic :: !Integer
    }
    deriving  (ApiNetworkInfo -> ApiNetworkInfo -> Bool
(ApiNetworkInfo -> ApiNetworkInfo -> Bool)
-> (ApiNetworkInfo -> ApiNetworkInfo -> Bool) -> Eq ApiNetworkInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiNetworkInfo -> ApiNetworkInfo -> Bool
$c/= :: ApiNetworkInfo -> ApiNetworkInfo -> Bool
== :: ApiNetworkInfo -> ApiNetworkInfo -> Bool
$c== :: ApiNetworkInfo -> ApiNetworkInfo -> Bool
Eq, Int -> ApiNetworkInfo -> ShowS
[ApiNetworkInfo] -> ShowS
ApiNetworkInfo -> String
(Int -> ApiNetworkInfo -> ShowS)
-> (ApiNetworkInfo -> String)
-> ([ApiNetworkInfo] -> ShowS)
-> Show ApiNetworkInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiNetworkInfo] -> ShowS
$cshowList :: [ApiNetworkInfo] -> ShowS
show :: ApiNetworkInfo -> String
$cshow :: ApiNetworkInfo -> String
showsPrec :: Int -> ApiNetworkInfo -> ShowS
$cshowsPrec :: Int -> ApiNetworkInfo -> ShowS
Show, (forall x. ApiNetworkInfo -> Rep ApiNetworkInfo x)
-> (forall x. Rep ApiNetworkInfo x -> ApiNetworkInfo)
-> Generic ApiNetworkInfo
forall x. Rep ApiNetworkInfo x -> ApiNetworkInfo
forall x. ApiNetworkInfo -> Rep ApiNetworkInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiNetworkInfo x -> ApiNetworkInfo
$cfrom :: forall x. ApiNetworkInfo -> Rep ApiNetworkInfo x
Generic, ApiNetworkInfo -> ()
(ApiNetworkInfo -> ()) -> NFData ApiNetworkInfo
forall a. (a -> ()) -> NFData a
rnf :: ApiNetworkInfo -> ()
$crnf :: ApiNetworkInfo -> ()
NFData)

instance FromJSON ApiNetworkInfo where
    parseJSON :: Value -> Parser ApiNetworkInfo
parseJSON = Options -> Value -> Parser ApiNetworkInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ApiNetworkInfo)
-> Options -> Value -> Parser ApiNetworkInfo
forall a b. (a -> b) -> a -> b
$ Options
Aeson.defaultOptions
        { fieldLabelModifier :: ShowS
fieldLabelModifier =  Char -> ShowS
camelTo2 Char
'_' }

instance ToJSON ApiNetworkInfo where
    toJSON :: ApiNetworkInfo -> Value
toJSON = Options -> ApiNetworkInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> ApiNetworkInfo -> Value)
-> Options -> ApiNetworkInfo -> Value
forall a b. (a -> b) -> a -> b
$ Options
Aeson.defaultOptions
        { fieldLabelModifier :: ShowS
fieldLabelModifier =  Char -> ShowS
camelTo2 Char
'_' }

data ApiWalletMode = Light | Node
    deriving  (ApiWalletMode -> ApiWalletMode -> Bool
(ApiWalletMode -> ApiWalletMode -> Bool)
-> (ApiWalletMode -> ApiWalletMode -> Bool) -> Eq ApiWalletMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletMode -> ApiWalletMode -> Bool
$c/= :: ApiWalletMode -> ApiWalletMode -> Bool
== :: ApiWalletMode -> ApiWalletMode -> Bool
$c== :: ApiWalletMode -> ApiWalletMode -> Bool
Eq, Int -> ApiWalletMode -> ShowS
[ApiWalletMode] -> ShowS
ApiWalletMode -> String
(Int -> ApiWalletMode -> ShowS)
-> (ApiWalletMode -> String)
-> ([ApiWalletMode] -> ShowS)
-> Show ApiWalletMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletMode] -> ShowS
$cshowList :: [ApiWalletMode] -> ShowS
show :: ApiWalletMode -> String
$cshow :: ApiWalletMode -> String
showsPrec :: Int -> ApiWalletMode -> ShowS
$cshowsPrec :: Int -> ApiWalletMode -> ShowS
Show, (forall x. ApiWalletMode -> Rep ApiWalletMode x)
-> (forall x. Rep ApiWalletMode x -> ApiWalletMode)
-> Generic ApiWalletMode
forall x. Rep ApiWalletMode x -> ApiWalletMode
forall x. ApiWalletMode -> Rep ApiWalletMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWalletMode x -> ApiWalletMode
$cfrom :: forall x. ApiWalletMode -> Rep ApiWalletMode x
Generic, ApiWalletMode -> ()
(ApiWalletMode -> ()) -> NFData ApiWalletMode
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletMode -> ()
$crnf :: ApiWalletMode -> ()
NFData)

instance FromJSON ApiWalletMode where
    parseJSON :: Value -> Parser ApiWalletMode
parseJSON = Options -> Value -> Parser ApiWalletMode
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ApiWalletMode)
-> Options -> Value -> Parser ApiWalletMode
forall a b. (a -> b) -> a -> b
$ Options
Aeson.defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower }
instance ToJSON ApiWalletMode where
    toJSON :: ApiWalletMode -> Value
toJSON = Options -> ApiWalletMode -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> ApiWalletMode -> Value)
-> Options -> ApiWalletMode -> Value
forall a b. (a -> b) -> a -> b
$ Options
Aeson.defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower }

data ApiNetworkInformation = ApiNetworkInformation
    { ApiNetworkInformation -> ApiT SyncProgress
syncProgress :: !(ApiT SyncProgress)
    , ApiNetworkInformation -> Maybe ApiEpochInfo
nextEpoch :: !(Maybe ApiEpochInfo)
    , ApiNetworkInformation -> ApiBlockReference
nodeTip :: !ApiBlockReference
    , ApiNetworkInformation -> Maybe ApiSlotReference
networkTip :: !(Maybe ApiSlotReference)
    , ApiNetworkInformation -> ApiEra
nodeEra :: !ApiEra
    , ApiNetworkInformation -> ApiNetworkInfo
networkInfo :: !ApiNetworkInfo
    , ApiNetworkInformation -> ApiWalletMode
walletMode :: !ApiWalletMode
    } deriving (ApiNetworkInformation -> ApiNetworkInformation -> Bool
(ApiNetworkInformation -> ApiNetworkInformation -> Bool)
-> (ApiNetworkInformation -> ApiNetworkInformation -> Bool)
-> Eq ApiNetworkInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiNetworkInformation -> ApiNetworkInformation -> Bool
$c/= :: ApiNetworkInformation -> ApiNetworkInformation -> Bool
== :: ApiNetworkInformation -> ApiNetworkInformation -> Bool
$c== :: ApiNetworkInformation -> ApiNetworkInformation -> Bool
Eq, (forall x. ApiNetworkInformation -> Rep ApiNetworkInformation x)
-> (forall x. Rep ApiNetworkInformation x -> ApiNetworkInformation)
-> Generic ApiNetworkInformation
forall x. Rep ApiNetworkInformation x -> ApiNetworkInformation
forall x. ApiNetworkInformation -> Rep ApiNetworkInformation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiNetworkInformation x -> ApiNetworkInformation
$cfrom :: forall x. ApiNetworkInformation -> Rep ApiNetworkInformation x
Generic, Int -> ApiNetworkInformation -> ShowS
[ApiNetworkInformation] -> ShowS
ApiNetworkInformation -> String
(Int -> ApiNetworkInformation -> ShowS)
-> (ApiNetworkInformation -> String)
-> ([ApiNetworkInformation] -> ShowS)
-> Show ApiNetworkInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiNetworkInformation] -> ShowS
$cshowList :: [ApiNetworkInformation] -> ShowS
show :: ApiNetworkInformation -> String
$cshow :: ApiNetworkInformation -> String
showsPrec :: Int -> ApiNetworkInformation -> ShowS
$cshowsPrec :: Int -> ApiNetworkInformation -> ShowS
Show)
      deriving anyclass ApiNetworkInformation -> ()
(ApiNetworkInformation -> ()) -> NFData ApiNetworkInformation
forall a. (a -> ()) -> NFData a
rnf :: ApiNetworkInformation -> ()
$crnf :: ApiNetworkInformation -> ()
NFData

data NtpSyncingStatus =
      NtpSyncingStatusUnavailable
    | NtpSyncingStatusPending
    | NtpSyncingStatusAvailable
    deriving (NtpSyncingStatus -> NtpSyncingStatus -> Bool
(NtpSyncingStatus -> NtpSyncingStatus -> Bool)
-> (NtpSyncingStatus -> NtpSyncingStatus -> Bool)
-> Eq NtpSyncingStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NtpSyncingStatus -> NtpSyncingStatus -> Bool
$c/= :: NtpSyncingStatus -> NtpSyncingStatus -> Bool
== :: NtpSyncingStatus -> NtpSyncingStatus -> Bool
$c== :: NtpSyncingStatus -> NtpSyncingStatus -> Bool
Eq, (forall x. NtpSyncingStatus -> Rep NtpSyncingStatus x)
-> (forall x. Rep NtpSyncingStatus x -> NtpSyncingStatus)
-> Generic NtpSyncingStatus
forall x. Rep NtpSyncingStatus x -> NtpSyncingStatus
forall x. NtpSyncingStatus -> Rep NtpSyncingStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NtpSyncingStatus x -> NtpSyncingStatus
$cfrom :: forall x. NtpSyncingStatus -> Rep NtpSyncingStatus x
Generic, Int -> NtpSyncingStatus -> ShowS
[NtpSyncingStatus] -> ShowS
NtpSyncingStatus -> String
(Int -> NtpSyncingStatus -> ShowS)
-> (NtpSyncingStatus -> String)
-> ([NtpSyncingStatus] -> ShowS)
-> Show NtpSyncingStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NtpSyncingStatus] -> ShowS
$cshowList :: [NtpSyncingStatus] -> ShowS
show :: NtpSyncingStatus -> String
$cshow :: NtpSyncingStatus -> String
showsPrec :: Int -> NtpSyncingStatus -> ShowS
$cshowsPrec :: Int -> NtpSyncingStatus -> ShowS
Show)
    deriving anyclass NtpSyncingStatus -> ()
(NtpSyncingStatus -> ()) -> NFData NtpSyncingStatus
forall a. (a -> ()) -> NFData a
rnf :: NtpSyncingStatus -> ()
$crnf :: NtpSyncingStatus -> ()
NFData

data ApiNtpStatus = ApiNtpStatus
    { ApiNtpStatus -> NtpSyncingStatus
status :: !NtpSyncingStatus
    , ApiNtpStatus -> Maybe (Quantity "microsecond" Integer)
offset :: !(Maybe (Quantity "microsecond" Integer))
    } deriving (ApiNtpStatus -> ApiNtpStatus -> Bool
(ApiNtpStatus -> ApiNtpStatus -> Bool)
-> (ApiNtpStatus -> ApiNtpStatus -> Bool) -> Eq ApiNtpStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiNtpStatus -> ApiNtpStatus -> Bool
$c/= :: ApiNtpStatus -> ApiNtpStatus -> Bool
== :: ApiNtpStatus -> ApiNtpStatus -> Bool
$c== :: ApiNtpStatus -> ApiNtpStatus -> Bool
Eq, (forall x. ApiNtpStatus -> Rep ApiNtpStatus x)
-> (forall x. Rep ApiNtpStatus x -> ApiNtpStatus)
-> Generic ApiNtpStatus
forall x. Rep ApiNtpStatus x -> ApiNtpStatus
forall x. ApiNtpStatus -> Rep ApiNtpStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiNtpStatus x -> ApiNtpStatus
$cfrom :: forall x. ApiNtpStatus -> Rep ApiNtpStatus x
Generic, Int -> ApiNtpStatus -> ShowS
[ApiNtpStatus] -> ShowS
ApiNtpStatus -> String
(Int -> ApiNtpStatus -> ShowS)
-> (ApiNtpStatus -> String)
-> ([ApiNtpStatus] -> ShowS)
-> Show ApiNtpStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiNtpStatus] -> ShowS
$cshowList :: [ApiNtpStatus] -> ShowS
show :: ApiNtpStatus -> String
$cshow :: ApiNtpStatus -> String
showsPrec :: Int -> ApiNtpStatus -> ShowS
$cshowsPrec :: Int -> ApiNtpStatus -> ShowS
Show)
      deriving anyclass ApiNtpStatus -> ()
(ApiNtpStatus -> ()) -> NFData ApiNtpStatus
forall a. (a -> ()) -> NFData a
rnf :: ApiNtpStatus -> ()
$crnf :: ApiNtpStatus -> ()
NFData

newtype ApiNetworkClock = ApiNetworkClock
    { ApiNetworkClock -> ApiNtpStatus
ntpStatus :: ApiNtpStatus
    }
    deriving (ApiNetworkClock -> ApiNetworkClock -> Bool
(ApiNetworkClock -> ApiNetworkClock -> Bool)
-> (ApiNetworkClock -> ApiNetworkClock -> Bool)
-> Eq ApiNetworkClock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiNetworkClock -> ApiNetworkClock -> Bool
$c/= :: ApiNetworkClock -> ApiNetworkClock -> Bool
== :: ApiNetworkClock -> ApiNetworkClock -> Bool
$c== :: ApiNetworkClock -> ApiNetworkClock -> Bool
Eq, (forall x. ApiNetworkClock -> Rep ApiNetworkClock x)
-> (forall x. Rep ApiNetworkClock x -> ApiNetworkClock)
-> Generic ApiNetworkClock
forall x. Rep ApiNetworkClock x -> ApiNetworkClock
forall x. ApiNetworkClock -> Rep ApiNetworkClock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiNetworkClock x -> ApiNetworkClock
$cfrom :: forall x. ApiNetworkClock -> Rep ApiNetworkClock x
Generic)
    deriving anyclass ApiNetworkClock -> ()
(ApiNetworkClock -> ()) -> NFData ApiNetworkClock
forall a. (a -> ()) -> NFData a
rnf :: ApiNetworkClock -> ()
$crnf :: ApiNetworkClock -> ()
NFData
    deriving Int -> ApiNetworkClock -> ShowS
[ApiNetworkClock] -> ShowS
ApiNetworkClock -> String
(Int -> ApiNetworkClock -> ShowS)
-> (ApiNetworkClock -> String)
-> ([ApiNetworkClock] -> ShowS)
-> Show ApiNetworkClock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiNetworkClock] -> ShowS
$cshowList :: [ApiNetworkClock] -> ShowS
show :: ApiNetworkClock -> String
$cshow :: ApiNetworkClock -> String
showsPrec :: Int -> ApiNetworkClock -> ShowS
$cshowsPrec :: Int -> ApiNetworkClock -> ShowS
Show via (Quiet ApiNetworkClock)

data ApiPostRandomAddressData = ApiPostRandomAddressData
    { ApiPostRandomAddressData -> ApiT (Passphrase "lenient")
passphrase :: !(ApiT (Passphrase "lenient"))
    , ApiPostRandomAddressData
-> Maybe (ApiT (Index 'Hardened 'AddressK))
addressIndex :: !(Maybe (ApiT (Index 'AD.Hardened 'AddressK)))
    } deriving (ApiPostRandomAddressData -> ApiPostRandomAddressData -> Bool
(ApiPostRandomAddressData -> ApiPostRandomAddressData -> Bool)
-> (ApiPostRandomAddressData -> ApiPostRandomAddressData -> Bool)
-> Eq ApiPostRandomAddressData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiPostRandomAddressData -> ApiPostRandomAddressData -> Bool
$c/= :: ApiPostRandomAddressData -> ApiPostRandomAddressData -> Bool
== :: ApiPostRandomAddressData -> ApiPostRandomAddressData -> Bool
$c== :: ApiPostRandomAddressData -> ApiPostRandomAddressData -> Bool
Eq, (forall x.
 ApiPostRandomAddressData -> Rep ApiPostRandomAddressData x)
-> (forall x.
    Rep ApiPostRandomAddressData x -> ApiPostRandomAddressData)
-> Generic ApiPostRandomAddressData
forall x.
Rep ApiPostRandomAddressData x -> ApiPostRandomAddressData
forall x.
ApiPostRandomAddressData -> Rep ApiPostRandomAddressData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiPostRandomAddressData x -> ApiPostRandomAddressData
$cfrom :: forall x.
ApiPostRandomAddressData -> Rep ApiPostRandomAddressData x
Generic, Int -> ApiPostRandomAddressData -> ShowS
[ApiPostRandomAddressData] -> ShowS
ApiPostRandomAddressData -> String
(Int -> ApiPostRandomAddressData -> ShowS)
-> (ApiPostRandomAddressData -> String)
-> ([ApiPostRandomAddressData] -> ShowS)
-> Show ApiPostRandomAddressData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiPostRandomAddressData] -> ShowS
$cshowList :: [ApiPostRandomAddressData] -> ShowS
show :: ApiPostRandomAddressData -> String
$cshow :: ApiPostRandomAddressData -> String
showsPrec :: Int -> ApiPostRandomAddressData -> ShowS
$cshowsPrec :: Int -> ApiPostRandomAddressData -> ShowS
Show)
      deriving anyclass ApiPostRandomAddressData -> ()
(ApiPostRandomAddressData -> ()) -> NFData ApiPostRandomAddressData
forall a. (a -> ()) -> NFData a
rnf :: ApiPostRandomAddressData -> ()
$crnf :: ApiPostRandomAddressData -> ()
NFData

newtype ApiWalletMigrationPlanPostData (n :: NetworkDiscriminant) =
    ApiWalletMigrationPlanPostData
    { ApiWalletMigrationPlanPostData n
-> NonEmpty (ApiT Address, Proxy n)
addresses :: NonEmpty (ApiT Address, Proxy n)
    }
    deriving (ApiWalletMigrationPlanPostData n
-> ApiWalletMigrationPlanPostData n -> Bool
(ApiWalletMigrationPlanPostData n
 -> ApiWalletMigrationPlanPostData n -> Bool)
-> (ApiWalletMigrationPlanPostData n
    -> ApiWalletMigrationPlanPostData n -> Bool)
-> Eq (ApiWalletMigrationPlanPostData n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlanPostData n
-> ApiWalletMigrationPlanPostData n -> Bool
/= :: ApiWalletMigrationPlanPostData n
-> ApiWalletMigrationPlanPostData n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlanPostData n
-> ApiWalletMigrationPlanPostData n -> Bool
== :: ApiWalletMigrationPlanPostData n
-> ApiWalletMigrationPlanPostData n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlanPostData n
-> ApiWalletMigrationPlanPostData n -> Bool
Eq, (forall x.
 ApiWalletMigrationPlanPostData n
 -> Rep (ApiWalletMigrationPlanPostData n) x)
-> (forall x.
    Rep (ApiWalletMigrationPlanPostData n) x
    -> ApiWalletMigrationPlanPostData n)
-> Generic (ApiWalletMigrationPlanPostData n)
forall x.
Rep (ApiWalletMigrationPlanPostData n) x
-> ApiWalletMigrationPlanPostData n
forall x.
ApiWalletMigrationPlanPostData n
-> Rep (ApiWalletMigrationPlanPostData n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiWalletMigrationPlanPostData n) x
-> ApiWalletMigrationPlanPostData n
forall (n :: NetworkDiscriminant) x.
ApiWalletMigrationPlanPostData n
-> Rep (ApiWalletMigrationPlanPostData n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiWalletMigrationPlanPostData n) x
-> ApiWalletMigrationPlanPostData n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiWalletMigrationPlanPostData n
-> Rep (ApiWalletMigrationPlanPostData n) x
Generic, Typeable)
    deriving anyclass ApiWalletMigrationPlanPostData n -> ()
(ApiWalletMigrationPlanPostData n -> ())
-> NFData (ApiWalletMigrationPlanPostData n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlanPostData n -> ()
rnf :: ApiWalletMigrationPlanPostData n -> ()
$crnf :: forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlanPostData n -> ()
NFData
    deriving Int -> ApiWalletMigrationPlanPostData n -> ShowS
[ApiWalletMigrationPlanPostData n] -> ShowS
ApiWalletMigrationPlanPostData n -> String
(Int -> ApiWalletMigrationPlanPostData n -> ShowS)
-> (ApiWalletMigrationPlanPostData n -> String)
-> ([ApiWalletMigrationPlanPostData n] -> ShowS)
-> Show (ApiWalletMigrationPlanPostData n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiWalletMigrationPlanPostData n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiWalletMigrationPlanPostData n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlanPostData n -> String
showList :: [ApiWalletMigrationPlanPostData n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiWalletMigrationPlanPostData n] -> ShowS
show :: ApiWalletMigrationPlanPostData n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlanPostData n -> String
showsPrec :: Int -> ApiWalletMigrationPlanPostData n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiWalletMigrationPlanPostData n -> ShowS
Show via (Quiet (ApiWalletMigrationPlanPostData n))

data ApiWalletMigrationPostData (n :: NetworkDiscriminant) (s :: Symbol) =
    ApiWalletMigrationPostData
    { ApiWalletMigrationPostData n s -> ApiT (Passphrase s)
passphrase :: !(ApiT (Passphrase s))
    , ApiWalletMigrationPostData n s -> NonEmpty (ApiT Address, Proxy n)
addresses :: !(NonEmpty (ApiT Address, Proxy n))
    } deriving (ApiWalletMigrationPostData n s
-> ApiWalletMigrationPostData n s -> Bool
(ApiWalletMigrationPostData n s
 -> ApiWalletMigrationPostData n s -> Bool)
-> (ApiWalletMigrationPostData n s
    -> ApiWalletMigrationPostData n s -> Bool)
-> Eq (ApiWalletMigrationPostData n s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant) (s :: Symbol).
ApiWalletMigrationPostData n s
-> ApiWalletMigrationPostData n s -> Bool
/= :: ApiWalletMigrationPostData n s
-> ApiWalletMigrationPostData n s -> Bool
$c/= :: forall (n :: NetworkDiscriminant) (s :: Symbol).
ApiWalletMigrationPostData n s
-> ApiWalletMigrationPostData n s -> Bool
== :: ApiWalletMigrationPostData n s
-> ApiWalletMigrationPostData n s -> Bool
$c== :: forall (n :: NetworkDiscriminant) (s :: Symbol).
ApiWalletMigrationPostData n s
-> ApiWalletMigrationPostData n s -> Bool
Eq, (forall x.
 ApiWalletMigrationPostData n s
 -> Rep (ApiWalletMigrationPostData n s) x)
-> (forall x.
    Rep (ApiWalletMigrationPostData n s) x
    -> ApiWalletMigrationPostData n s)
-> Generic (ApiWalletMigrationPostData n s)
forall x.
Rep (ApiWalletMigrationPostData n s) x
-> ApiWalletMigrationPostData n s
forall x.
ApiWalletMigrationPostData n s
-> Rep (ApiWalletMigrationPostData n s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) (s :: Symbol) x.
Rep (ApiWalletMigrationPostData n s) x
-> ApiWalletMigrationPostData n s
forall (n :: NetworkDiscriminant) (s :: Symbol) x.
ApiWalletMigrationPostData n s
-> Rep (ApiWalletMigrationPostData n s) x
$cto :: forall (n :: NetworkDiscriminant) (s :: Symbol) x.
Rep (ApiWalletMigrationPostData n s) x
-> ApiWalletMigrationPostData n s
$cfrom :: forall (n :: NetworkDiscriminant) (s :: Symbol) x.
ApiWalletMigrationPostData n s
-> Rep (ApiWalletMigrationPostData n s) x
Generic, Int -> ApiWalletMigrationPostData n s -> ShowS
[ApiWalletMigrationPostData n s] -> ShowS
ApiWalletMigrationPostData n s -> String
(Int -> ApiWalletMigrationPostData n s -> ShowS)
-> (ApiWalletMigrationPostData n s -> String)
-> ([ApiWalletMigrationPostData n s] -> ShowS)
-> Show (ApiWalletMigrationPostData n s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant) (s :: Symbol).
Int -> ApiWalletMigrationPostData n s -> ShowS
forall (n :: NetworkDiscriminant) (s :: Symbol).
[ApiWalletMigrationPostData n s] -> ShowS
forall (n :: NetworkDiscriminant) (s :: Symbol).
ApiWalletMigrationPostData n s -> String
showList :: [ApiWalletMigrationPostData n s] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant) (s :: Symbol).
[ApiWalletMigrationPostData n s] -> ShowS
show :: ApiWalletMigrationPostData n s -> String
$cshow :: forall (n :: NetworkDiscriminant) (s :: Symbol).
ApiWalletMigrationPostData n s -> String
showsPrec :: Int -> ApiWalletMigrationPostData n s -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant) (s :: Symbol).
Int -> ApiWalletMigrationPostData n s -> ShowS
Show, Typeable)
      deriving anyclass ApiWalletMigrationPostData n s -> ()
(ApiWalletMigrationPostData n s -> ())
-> NFData (ApiWalletMigrationPostData n s)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant) (s :: Symbol).
ApiWalletMigrationPostData n s -> ()
rnf :: ApiWalletMigrationPostData n s -> ()
$crnf :: forall (n :: NetworkDiscriminant) (s :: Symbol).
ApiWalletMigrationPostData n s -> ()
NFData

newtype ApiPutAddressesData (n :: NetworkDiscriminant) = ApiPutAddressesData
    { ApiPutAddressesData n -> [(ApiT Address, Proxy n)]
addresses :: [(ApiT Address, Proxy n)]
    }
    deriving (ApiPutAddressesData n -> ApiPutAddressesData n -> Bool
(ApiPutAddressesData n -> ApiPutAddressesData n -> Bool)
-> (ApiPutAddressesData n -> ApiPutAddressesData n -> Bool)
-> Eq (ApiPutAddressesData n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiPutAddressesData n -> ApiPutAddressesData n -> Bool
/= :: ApiPutAddressesData n -> ApiPutAddressesData n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiPutAddressesData n -> ApiPutAddressesData n -> Bool
== :: ApiPutAddressesData n -> ApiPutAddressesData n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiPutAddressesData n -> ApiPutAddressesData n -> Bool
Eq, (forall x. ApiPutAddressesData n -> Rep (ApiPutAddressesData n) x)
-> (forall x.
    Rep (ApiPutAddressesData n) x -> ApiPutAddressesData n)
-> Generic (ApiPutAddressesData n)
forall x. Rep (ApiPutAddressesData n) x -> ApiPutAddressesData n
forall x. ApiPutAddressesData n -> Rep (ApiPutAddressesData n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiPutAddressesData n) x -> ApiPutAddressesData n
forall (n :: NetworkDiscriminant) x.
ApiPutAddressesData n -> Rep (ApiPutAddressesData n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiPutAddressesData n) x -> ApiPutAddressesData n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiPutAddressesData n -> Rep (ApiPutAddressesData n) x
Generic, Typeable)
    deriving anyclass ApiPutAddressesData n -> ()
(ApiPutAddressesData n -> ()) -> NFData (ApiPutAddressesData n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiPutAddressesData n -> ()
rnf :: ApiPutAddressesData n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiPutAddressesData n -> ()
NFData
    deriving Int -> ApiPutAddressesData n -> ShowS
[ApiPutAddressesData n] -> ShowS
ApiPutAddressesData n -> String
(Int -> ApiPutAddressesData n -> ShowS)
-> (ApiPutAddressesData n -> String)
-> ([ApiPutAddressesData n] -> ShowS)
-> Show (ApiPutAddressesData n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiPutAddressesData n -> ShowS
forall (n :: NetworkDiscriminant). [ApiPutAddressesData n] -> ShowS
forall (n :: NetworkDiscriminant). ApiPutAddressesData n -> String
showList :: [ApiPutAddressesData n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiPutAddressesData n] -> ShowS
show :: ApiPutAddressesData n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiPutAddressesData n -> String
showsPrec :: Int -> ApiPutAddressesData n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiPutAddressesData n -> ShowS
Show via (Quiet (ApiPutAddressesData n))

data ApiWalletMigrationBalance = ApiWalletMigrationBalance
    { ApiWalletMigrationBalance -> Quantity "lovelace" Natural
ada :: !(Quantity "lovelace" Natural)
    , ApiWalletMigrationBalance -> ApiT TokenMap
assets :: !(ApiT W.TokenMap)
    } deriving (ApiWalletMigrationBalance -> ApiWalletMigrationBalance -> Bool
(ApiWalletMigrationBalance -> ApiWalletMigrationBalance -> Bool)
-> (ApiWalletMigrationBalance -> ApiWalletMigrationBalance -> Bool)
-> Eq ApiWalletMigrationBalance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletMigrationBalance -> ApiWalletMigrationBalance -> Bool
$c/= :: ApiWalletMigrationBalance -> ApiWalletMigrationBalance -> Bool
== :: ApiWalletMigrationBalance -> ApiWalletMigrationBalance -> Bool
$c== :: ApiWalletMigrationBalance -> ApiWalletMigrationBalance -> Bool
Eq, (forall x.
 ApiWalletMigrationBalance -> Rep ApiWalletMigrationBalance x)
-> (forall x.
    Rep ApiWalletMigrationBalance x -> ApiWalletMigrationBalance)
-> Generic ApiWalletMigrationBalance
forall x.
Rep ApiWalletMigrationBalance x -> ApiWalletMigrationBalance
forall x.
ApiWalletMigrationBalance -> Rep ApiWalletMigrationBalance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiWalletMigrationBalance x -> ApiWalletMigrationBalance
$cfrom :: forall x.
ApiWalletMigrationBalance -> Rep ApiWalletMigrationBalance x
Generic, Int -> ApiWalletMigrationBalance -> ShowS
[ApiWalletMigrationBalance] -> ShowS
ApiWalletMigrationBalance -> String
(Int -> ApiWalletMigrationBalance -> ShowS)
-> (ApiWalletMigrationBalance -> String)
-> ([ApiWalletMigrationBalance] -> ShowS)
-> Show ApiWalletMigrationBalance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletMigrationBalance] -> ShowS
$cshowList :: [ApiWalletMigrationBalance] -> ShowS
show :: ApiWalletMigrationBalance -> String
$cshow :: ApiWalletMigrationBalance -> String
showsPrec :: Int -> ApiWalletMigrationBalance -> ShowS
$cshowsPrec :: Int -> ApiWalletMigrationBalance -> ShowS
Show)
      deriving anyclass ApiWalletMigrationBalance -> ()
(ApiWalletMigrationBalance -> ())
-> NFData ApiWalletMigrationBalance
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletMigrationBalance -> ()
$crnf :: ApiWalletMigrationBalance -> ()
NFData

data ApiWalletMigrationPlan (n :: NetworkDiscriminant) = ApiWalletMigrationPlan
    { ApiWalletMigrationPlan n -> NonEmpty (ApiCoinSelection n)
selections :: !(NonEmpty (ApiCoinSelection n))
    , ApiWalletMigrationPlan n -> Quantity "lovelace" Natural
totalFee :: Quantity "lovelace" Natural
    , ApiWalletMigrationPlan n -> ApiWalletMigrationBalance
balanceLeftover :: ApiWalletMigrationBalance
    , ApiWalletMigrationPlan n -> ApiWalletMigrationBalance
balanceSelected :: ApiWalletMigrationBalance
    } deriving (ApiWalletMigrationPlan n -> ApiWalletMigrationPlan n -> Bool
(ApiWalletMigrationPlan n -> ApiWalletMigrationPlan n -> Bool)
-> (ApiWalletMigrationPlan n -> ApiWalletMigrationPlan n -> Bool)
-> Eq (ApiWalletMigrationPlan n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlan n -> ApiWalletMigrationPlan n -> Bool
/= :: ApiWalletMigrationPlan n -> ApiWalletMigrationPlan n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlan n -> ApiWalletMigrationPlan n -> Bool
== :: ApiWalletMigrationPlan n -> ApiWalletMigrationPlan n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlan n -> ApiWalletMigrationPlan n -> Bool
Eq, (forall x.
 ApiWalletMigrationPlan n -> Rep (ApiWalletMigrationPlan n) x)
-> (forall x.
    Rep (ApiWalletMigrationPlan n) x -> ApiWalletMigrationPlan n)
-> Generic (ApiWalletMigrationPlan n)
forall x.
Rep (ApiWalletMigrationPlan n) x -> ApiWalletMigrationPlan n
forall x.
ApiWalletMigrationPlan n -> Rep (ApiWalletMigrationPlan n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiWalletMigrationPlan n) x -> ApiWalletMigrationPlan n
forall (n :: NetworkDiscriminant) x.
ApiWalletMigrationPlan n -> Rep (ApiWalletMigrationPlan n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiWalletMigrationPlan n) x -> ApiWalletMigrationPlan n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiWalletMigrationPlan n -> Rep (ApiWalletMigrationPlan n) x
Generic, Int -> ApiWalletMigrationPlan n -> ShowS
[ApiWalletMigrationPlan n] -> ShowS
ApiWalletMigrationPlan n -> String
(Int -> ApiWalletMigrationPlan n -> ShowS)
-> (ApiWalletMigrationPlan n -> String)
-> ([ApiWalletMigrationPlan n] -> ShowS)
-> Show (ApiWalletMigrationPlan n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiWalletMigrationPlan n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiWalletMigrationPlan n] -> ShowS
forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlan n -> String
showList :: [ApiWalletMigrationPlan n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiWalletMigrationPlan n] -> ShowS
show :: ApiWalletMigrationPlan n -> String
$cshow :: forall (n :: NetworkDiscriminant).
ApiWalletMigrationPlan n -> String
showsPrec :: Int -> ApiWalletMigrationPlan n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiWalletMigrationPlan n -> ShowS
Show, Typeable)
      deriving anyclass ApiWalletMigrationPlan n -> ()
(ApiWalletMigrationPlan n -> ())
-> NFData (ApiWalletMigrationPlan n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiWalletMigrationPlan n -> ()
rnf :: ApiWalletMigrationPlan n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiWalletMigrationPlan n -> ()
NFData

newtype ApiWithdrawRewards = ApiWithdrawRewards Bool
    deriving (ApiWithdrawRewards -> ApiWithdrawRewards -> Bool
(ApiWithdrawRewards -> ApiWithdrawRewards -> Bool)
-> (ApiWithdrawRewards -> ApiWithdrawRewards -> Bool)
-> Eq ApiWithdrawRewards
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWithdrawRewards -> ApiWithdrawRewards -> Bool
$c/= :: ApiWithdrawRewards -> ApiWithdrawRewards -> Bool
== :: ApiWithdrawRewards -> ApiWithdrawRewards -> Bool
$c== :: ApiWithdrawRewards -> ApiWithdrawRewards -> Bool
Eq, (forall x. ApiWithdrawRewards -> Rep ApiWithdrawRewards x)
-> (forall x. Rep ApiWithdrawRewards x -> ApiWithdrawRewards)
-> Generic ApiWithdrawRewards
forall x. Rep ApiWithdrawRewards x -> ApiWithdrawRewards
forall x. ApiWithdrawRewards -> Rep ApiWithdrawRewards x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWithdrawRewards x -> ApiWithdrawRewards
$cfrom :: forall x. ApiWithdrawRewards -> Rep ApiWithdrawRewards x
Generic, Int -> ApiWithdrawRewards -> ShowS
[ApiWithdrawRewards] -> ShowS
ApiWithdrawRewards -> String
(Int -> ApiWithdrawRewards -> ShowS)
-> (ApiWithdrawRewards -> String)
-> ([ApiWithdrawRewards] -> ShowS)
-> Show ApiWithdrawRewards
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWithdrawRewards] -> ShowS
$cshowList :: [ApiWithdrawRewards] -> ShowS
show :: ApiWithdrawRewards -> String
$cshow :: ApiWithdrawRewards -> String
showsPrec :: Int -> ApiWithdrawRewards -> ShowS
$cshowsPrec :: Int -> ApiWithdrawRewards -> ShowS
Show)
    deriving anyclass ApiWithdrawRewards -> ()
(ApiWithdrawRewards -> ()) -> NFData ApiWithdrawRewards
forall a. (a -> ()) -> NFData a
rnf :: ApiWithdrawRewards -> ()
$crnf :: ApiWithdrawRewards -> ()
NFData

data ApiWalletSignData = ApiWalletSignData
    { ApiWalletSignData -> ApiT TxMetadata
metadata :: ApiT TxMetadata
    , ApiWalletSignData -> ApiT (Passphrase "lenient")
passphrase :: ApiT (Passphrase "lenient")
    } deriving (ApiWalletSignData -> ApiWalletSignData -> Bool
(ApiWalletSignData -> ApiWalletSignData -> Bool)
-> (ApiWalletSignData -> ApiWalletSignData -> Bool)
-> Eq ApiWalletSignData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletSignData -> ApiWalletSignData -> Bool
$c/= :: ApiWalletSignData -> ApiWalletSignData -> Bool
== :: ApiWalletSignData -> ApiWalletSignData -> Bool
$c== :: ApiWalletSignData -> ApiWalletSignData -> Bool
Eq, (forall x. ApiWalletSignData -> Rep ApiWalletSignData x)
-> (forall x. Rep ApiWalletSignData x -> ApiWalletSignData)
-> Generic ApiWalletSignData
forall x. Rep ApiWalletSignData x -> ApiWalletSignData
forall x. ApiWalletSignData -> Rep ApiWalletSignData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWalletSignData x -> ApiWalletSignData
$cfrom :: forall x. ApiWalletSignData -> Rep ApiWalletSignData x
Generic, Int -> ApiWalletSignData -> ShowS
[ApiWalletSignData] -> ShowS
ApiWalletSignData -> String
(Int -> ApiWalletSignData -> ShowS)
-> (ApiWalletSignData -> String)
-> ([ApiWalletSignData] -> ShowS)
-> Show ApiWalletSignData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletSignData] -> ShowS
$cshowList :: [ApiWalletSignData] -> ShowS
show :: ApiWalletSignData -> String
$cshow :: ApiWalletSignData -> String
showsPrec :: Int -> ApiWalletSignData -> ShowS
$cshowsPrec :: Int -> ApiWalletSignData -> ShowS
Show)
      deriving anyclass ApiWalletSignData -> ()
(ApiWalletSignData -> ()) -> NFData ApiWalletSignData
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletSignData -> ()
$crnf :: ApiWalletSignData -> ()
NFData

data VerificationKeyHashing = WithHashing | WithoutHashing
    deriving (VerificationKeyHashing -> VerificationKeyHashing -> Bool
(VerificationKeyHashing -> VerificationKeyHashing -> Bool)
-> (VerificationKeyHashing -> VerificationKeyHashing -> Bool)
-> Eq VerificationKeyHashing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerificationKeyHashing -> VerificationKeyHashing -> Bool
$c/= :: VerificationKeyHashing -> VerificationKeyHashing -> Bool
== :: VerificationKeyHashing -> VerificationKeyHashing -> Bool
$c== :: VerificationKeyHashing -> VerificationKeyHashing -> Bool
Eq, (forall x. VerificationKeyHashing -> Rep VerificationKeyHashing x)
-> (forall x.
    Rep VerificationKeyHashing x -> VerificationKeyHashing)
-> Generic VerificationKeyHashing
forall x. Rep VerificationKeyHashing x -> VerificationKeyHashing
forall x. VerificationKeyHashing -> Rep VerificationKeyHashing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VerificationKeyHashing x -> VerificationKeyHashing
$cfrom :: forall x. VerificationKeyHashing -> Rep VerificationKeyHashing x
Generic, Int -> VerificationKeyHashing -> ShowS
[VerificationKeyHashing] -> ShowS
VerificationKeyHashing -> String
(Int -> VerificationKeyHashing -> ShowS)
-> (VerificationKeyHashing -> String)
-> ([VerificationKeyHashing] -> ShowS)
-> Show VerificationKeyHashing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerificationKeyHashing] -> ShowS
$cshowList :: [VerificationKeyHashing] -> ShowS
show :: VerificationKeyHashing -> String
$cshow :: VerificationKeyHashing -> String
showsPrec :: Int -> VerificationKeyHashing -> ShowS
$cshowsPrec :: Int -> VerificationKeyHashing -> ShowS
Show)
    deriving anyclass VerificationKeyHashing -> ()
(VerificationKeyHashing -> ()) -> NFData VerificationKeyHashing
forall a. (a -> ()) -> NFData a
rnf :: VerificationKeyHashing -> ()
$crnf :: VerificationKeyHashing -> ()
NFData

data ApiVerificationKeyShelley = ApiVerificationKeyShelley
    { ApiVerificationKeyShelley -> (ByteString, Role)
getApiVerificationKey :: (ByteString, Role)
    , ApiVerificationKeyShelley -> VerificationKeyHashing
hashed :: VerificationKeyHashing
    } deriving (ApiVerificationKeyShelley -> ApiVerificationKeyShelley -> Bool
(ApiVerificationKeyShelley -> ApiVerificationKeyShelley -> Bool)
-> (ApiVerificationKeyShelley -> ApiVerificationKeyShelley -> Bool)
-> Eq ApiVerificationKeyShelley
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiVerificationKeyShelley -> ApiVerificationKeyShelley -> Bool
$c/= :: ApiVerificationKeyShelley -> ApiVerificationKeyShelley -> Bool
== :: ApiVerificationKeyShelley -> ApiVerificationKeyShelley -> Bool
$c== :: ApiVerificationKeyShelley -> ApiVerificationKeyShelley -> Bool
Eq, (forall x.
 ApiVerificationKeyShelley -> Rep ApiVerificationKeyShelley x)
-> (forall x.
    Rep ApiVerificationKeyShelley x -> ApiVerificationKeyShelley)
-> Generic ApiVerificationKeyShelley
forall x.
Rep ApiVerificationKeyShelley x -> ApiVerificationKeyShelley
forall x.
ApiVerificationKeyShelley -> Rep ApiVerificationKeyShelley x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiVerificationKeyShelley x -> ApiVerificationKeyShelley
$cfrom :: forall x.
ApiVerificationKeyShelley -> Rep ApiVerificationKeyShelley x
Generic, Int -> ApiVerificationKeyShelley -> ShowS
[ApiVerificationKeyShelley] -> ShowS
ApiVerificationKeyShelley -> String
(Int -> ApiVerificationKeyShelley -> ShowS)
-> (ApiVerificationKeyShelley -> String)
-> ([ApiVerificationKeyShelley] -> ShowS)
-> Show ApiVerificationKeyShelley
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiVerificationKeyShelley] -> ShowS
$cshowList :: [ApiVerificationKeyShelley] -> ShowS
show :: ApiVerificationKeyShelley -> String
$cshow :: ApiVerificationKeyShelley -> String
showsPrec :: Int -> ApiVerificationKeyShelley -> ShowS
$cshowsPrec :: Int -> ApiVerificationKeyShelley -> ShowS
Show)
      deriving anyclass ApiVerificationKeyShelley -> ()
(ApiVerificationKeyShelley -> ())
-> NFData ApiVerificationKeyShelley
forall a. (a -> ()) -> NFData a
rnf :: ApiVerificationKeyShelley -> ()
$crnf :: ApiVerificationKeyShelley -> ()
NFData

data ApiPolicyKey = ApiPolicyKey
    { ApiPolicyKey -> ByteString
getApiPolicyKey :: ByteString
    , ApiPolicyKey -> VerificationKeyHashing
hashed :: VerificationKeyHashing
    }
    deriving (ApiPolicyKey -> ApiPolicyKey -> Bool
(ApiPolicyKey -> ApiPolicyKey -> Bool)
-> (ApiPolicyKey -> ApiPolicyKey -> Bool) -> Eq ApiPolicyKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiPolicyKey -> ApiPolicyKey -> Bool
$c/= :: ApiPolicyKey -> ApiPolicyKey -> Bool
== :: ApiPolicyKey -> ApiPolicyKey -> Bool
$c== :: ApiPolicyKey -> ApiPolicyKey -> Bool
Eq, (forall x. ApiPolicyKey -> Rep ApiPolicyKey x)
-> (forall x. Rep ApiPolicyKey x -> ApiPolicyKey)
-> Generic ApiPolicyKey
forall x. Rep ApiPolicyKey x -> ApiPolicyKey
forall x. ApiPolicyKey -> Rep ApiPolicyKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiPolicyKey x -> ApiPolicyKey
$cfrom :: forall x. ApiPolicyKey -> Rep ApiPolicyKey x
Generic, Int -> ApiPolicyKey -> ShowS
[ApiPolicyKey] -> ShowS
ApiPolicyKey -> String
(Int -> ApiPolicyKey -> ShowS)
-> (ApiPolicyKey -> String)
-> ([ApiPolicyKey] -> ShowS)
-> Show ApiPolicyKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiPolicyKey] -> ShowS
$cshowList :: [ApiPolicyKey] -> ShowS
show :: ApiPolicyKey -> String
$cshow :: ApiPolicyKey -> String
showsPrec :: Int -> ApiPolicyKey -> ShowS
$cshowsPrec :: Int -> ApiPolicyKey -> ShowS
Show)
    deriving anyclass ApiPolicyKey -> ()
(ApiPolicyKey -> ()) -> NFData ApiPolicyKey
forall a. (a -> ()) -> NFData a
rnf :: ApiPolicyKey -> ()
$crnf :: ApiPolicyKey -> ()
NFData

data ApiVerificationKeyShared = ApiVerificationKeyShared
    { ApiVerificationKeyShared -> (ByteString, Role)
getApiVerificationKey :: (ByteString, Role)
    , ApiVerificationKeyShared -> VerificationKeyHashing
hashed :: VerificationKeyHashing
    } deriving (ApiVerificationKeyShared -> ApiVerificationKeyShared -> Bool
(ApiVerificationKeyShared -> ApiVerificationKeyShared -> Bool)
-> (ApiVerificationKeyShared -> ApiVerificationKeyShared -> Bool)
-> Eq ApiVerificationKeyShared
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiVerificationKeyShared -> ApiVerificationKeyShared -> Bool
$c/= :: ApiVerificationKeyShared -> ApiVerificationKeyShared -> Bool
== :: ApiVerificationKeyShared -> ApiVerificationKeyShared -> Bool
$c== :: ApiVerificationKeyShared -> ApiVerificationKeyShared -> Bool
Eq, (forall x.
 ApiVerificationKeyShared -> Rep ApiVerificationKeyShared x)
-> (forall x.
    Rep ApiVerificationKeyShared x -> ApiVerificationKeyShared)
-> Generic ApiVerificationKeyShared
forall x.
Rep ApiVerificationKeyShared x -> ApiVerificationKeyShared
forall x.
ApiVerificationKeyShared -> Rep ApiVerificationKeyShared x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiVerificationKeyShared x -> ApiVerificationKeyShared
$cfrom :: forall x.
ApiVerificationKeyShared -> Rep ApiVerificationKeyShared x
Generic, Int -> ApiVerificationKeyShared -> ShowS
[ApiVerificationKeyShared] -> ShowS
ApiVerificationKeyShared -> String
(Int -> ApiVerificationKeyShared -> ShowS)
-> (ApiVerificationKeyShared -> String)
-> ([ApiVerificationKeyShared] -> ShowS)
-> Show ApiVerificationKeyShared
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiVerificationKeyShared] -> ShowS
$cshowList :: [ApiVerificationKeyShared] -> ShowS
show :: ApiVerificationKeyShared -> String
$cshow :: ApiVerificationKeyShared -> String
showsPrec :: Int -> ApiVerificationKeyShared -> ShowS
$cshowsPrec :: Int -> ApiVerificationKeyShared -> ShowS
Show)
      deriving anyclass ApiVerificationKeyShared -> ()
(ApiVerificationKeyShared -> ()) -> NFData ApiVerificationKeyShared
forall a. (a -> ()) -> NFData a
rnf :: ApiVerificationKeyShared -> ()
$crnf :: ApiVerificationKeyShared -> ()
NFData

data KeyFormat = Extended | NonExtended
    deriving (KeyFormat -> KeyFormat -> Bool
(KeyFormat -> KeyFormat -> Bool)
-> (KeyFormat -> KeyFormat -> Bool) -> Eq KeyFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyFormat -> KeyFormat -> Bool
$c/= :: KeyFormat -> KeyFormat -> Bool
== :: KeyFormat -> KeyFormat -> Bool
$c== :: KeyFormat -> KeyFormat -> Bool
Eq, (forall x. KeyFormat -> Rep KeyFormat x)
-> (forall x. Rep KeyFormat x -> KeyFormat) -> Generic KeyFormat
forall x. Rep KeyFormat x -> KeyFormat
forall x. KeyFormat -> Rep KeyFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeyFormat x -> KeyFormat
$cfrom :: forall x. KeyFormat -> Rep KeyFormat x
Generic, Int -> KeyFormat -> ShowS
[KeyFormat] -> ShowS
KeyFormat -> String
(Int -> KeyFormat -> ShowS)
-> (KeyFormat -> String)
-> ([KeyFormat] -> ShowS)
-> Show KeyFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyFormat] -> ShowS
$cshowList :: [KeyFormat] -> ShowS
show :: KeyFormat -> String
$cshow :: KeyFormat -> String
showsPrec :: Int -> KeyFormat -> ShowS
$cshowsPrec :: Int -> KeyFormat -> ShowS
Show)
    deriving anyclass KeyFormat -> ()
(KeyFormat -> ()) -> NFData KeyFormat
forall a. (a -> ()) -> NFData a
rnf :: KeyFormat -> ()
$crnf :: KeyFormat -> ()
NFData

instance ToText KeyFormat where
    toText :: KeyFormat -> Text
toText KeyFormat
Extended = Text
"extended"
    toText KeyFormat
NonExtended = Text
"non_extended"

instance ToHttpApiData KeyFormat where
    toUrlPiece :: KeyFormat -> Text
toUrlPiece = KeyFormat -> Text
forall a. ToText a => a -> Text
toText

instance FromText KeyFormat where
    fromText :: Text -> Either TextDecodingError KeyFormat
fromText Text
txt = case Text
txt of
        Text
"extended" -> KeyFormat -> Either TextDecodingError KeyFormat
forall a b. b -> Either a b
Right KeyFormat
Extended
        Text
"non_extended" -> KeyFormat -> Either TextDecodingError KeyFormat
forall a b. b -> Either a b
Right KeyFormat
NonExtended
        Text
_ -> TextDecodingError -> Either TextDecodingError KeyFormat
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError KeyFormat)
-> TextDecodingError -> Either TextDecodingError KeyFormat
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"I couldn't parse the given key format."
            , String
"I am expecting one of the words 'extended' or"
            , String
"'non_extended'."]

instance FromHttpApiData KeyFormat where
    parseUrlPiece :: Text -> Either Text KeyFormat
parseUrlPiece = (TextDecodingError -> Text)
-> Either TextDecodingError KeyFormat -> Either Text KeyFormat
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
T.pack (String -> Text)
-> (TextDecodingError -> String) -> TextDecodingError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDecodingError -> String
getTextDecodingError) (Either TextDecodingError KeyFormat -> Either Text KeyFormat)
-> (Text -> Either TextDecodingError KeyFormat)
-> Text
-> Either Text KeyFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError KeyFormat
forall a. FromText a => Text -> Either TextDecodingError a
fromText

data ApiPostAccountKeyData = ApiPostAccountKeyData
    { ApiPostAccountKeyData -> ApiT (Passphrase "user")
passphrase :: ApiT (Passphrase "user")
    , ApiPostAccountKeyData -> KeyFormat
format :: KeyFormat
    } deriving (ApiPostAccountKeyData -> ApiPostAccountKeyData -> Bool
(ApiPostAccountKeyData -> ApiPostAccountKeyData -> Bool)
-> (ApiPostAccountKeyData -> ApiPostAccountKeyData -> Bool)
-> Eq ApiPostAccountKeyData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiPostAccountKeyData -> ApiPostAccountKeyData -> Bool
$c/= :: ApiPostAccountKeyData -> ApiPostAccountKeyData -> Bool
== :: ApiPostAccountKeyData -> ApiPostAccountKeyData -> Bool
$c== :: ApiPostAccountKeyData -> ApiPostAccountKeyData -> Bool
Eq, (forall x. ApiPostAccountKeyData -> Rep ApiPostAccountKeyData x)
-> (forall x. Rep ApiPostAccountKeyData x -> ApiPostAccountKeyData)
-> Generic ApiPostAccountKeyData
forall x. Rep ApiPostAccountKeyData x -> ApiPostAccountKeyData
forall x. ApiPostAccountKeyData -> Rep ApiPostAccountKeyData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiPostAccountKeyData x -> ApiPostAccountKeyData
$cfrom :: forall x. ApiPostAccountKeyData -> Rep ApiPostAccountKeyData x
Generic, Int -> ApiPostAccountKeyData -> ShowS
[ApiPostAccountKeyData] -> ShowS
ApiPostAccountKeyData -> String
(Int -> ApiPostAccountKeyData -> ShowS)
-> (ApiPostAccountKeyData -> String)
-> ([ApiPostAccountKeyData] -> ShowS)
-> Show ApiPostAccountKeyData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiPostAccountKeyData] -> ShowS
$cshowList :: [ApiPostAccountKeyData] -> ShowS
show :: ApiPostAccountKeyData -> String
$cshow :: ApiPostAccountKeyData -> String
showsPrec :: Int -> ApiPostAccountKeyData -> ShowS
$cshowsPrec :: Int -> ApiPostAccountKeyData -> ShowS
Show)
      deriving anyclass ApiPostAccountKeyData -> ()
(ApiPostAccountKeyData -> ()) -> NFData ApiPostAccountKeyData
forall a. (a -> ()) -> NFData a
rnf :: ApiPostAccountKeyData -> ()
$crnf :: ApiPostAccountKeyData -> ()
NFData

data ApiPostAccountKeyDataWithPurpose = ApiPostAccountKeyDataWithPurpose
    { ApiPostAccountKeyDataWithPurpose -> ApiT (Passphrase "user")
passphrase :: ApiT (Passphrase "user")
    , ApiPostAccountKeyDataWithPurpose -> KeyFormat
format :: KeyFormat
    , ApiPostAccountKeyDataWithPurpose -> Maybe (ApiT DerivationIndex)
purpose :: Maybe (ApiT DerivationIndex)
    } deriving (ApiPostAccountKeyDataWithPurpose
-> ApiPostAccountKeyDataWithPurpose -> Bool
(ApiPostAccountKeyDataWithPurpose
 -> ApiPostAccountKeyDataWithPurpose -> Bool)
-> (ApiPostAccountKeyDataWithPurpose
    -> ApiPostAccountKeyDataWithPurpose -> Bool)
-> Eq ApiPostAccountKeyDataWithPurpose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiPostAccountKeyDataWithPurpose
-> ApiPostAccountKeyDataWithPurpose -> Bool
$c/= :: ApiPostAccountKeyDataWithPurpose
-> ApiPostAccountKeyDataWithPurpose -> Bool
== :: ApiPostAccountKeyDataWithPurpose
-> ApiPostAccountKeyDataWithPurpose -> Bool
$c== :: ApiPostAccountKeyDataWithPurpose
-> ApiPostAccountKeyDataWithPurpose -> Bool
Eq, (forall x.
 ApiPostAccountKeyDataWithPurpose
 -> Rep ApiPostAccountKeyDataWithPurpose x)
-> (forall x.
    Rep ApiPostAccountKeyDataWithPurpose x
    -> ApiPostAccountKeyDataWithPurpose)
-> Generic ApiPostAccountKeyDataWithPurpose
forall x.
Rep ApiPostAccountKeyDataWithPurpose x
-> ApiPostAccountKeyDataWithPurpose
forall x.
ApiPostAccountKeyDataWithPurpose
-> Rep ApiPostAccountKeyDataWithPurpose x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiPostAccountKeyDataWithPurpose x
-> ApiPostAccountKeyDataWithPurpose
$cfrom :: forall x.
ApiPostAccountKeyDataWithPurpose
-> Rep ApiPostAccountKeyDataWithPurpose x
Generic, Int -> ApiPostAccountKeyDataWithPurpose -> ShowS
[ApiPostAccountKeyDataWithPurpose] -> ShowS
ApiPostAccountKeyDataWithPurpose -> String
(Int -> ApiPostAccountKeyDataWithPurpose -> ShowS)
-> (ApiPostAccountKeyDataWithPurpose -> String)
-> ([ApiPostAccountKeyDataWithPurpose] -> ShowS)
-> Show ApiPostAccountKeyDataWithPurpose
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiPostAccountKeyDataWithPurpose] -> ShowS
$cshowList :: [ApiPostAccountKeyDataWithPurpose] -> ShowS
show :: ApiPostAccountKeyDataWithPurpose -> String
$cshow :: ApiPostAccountKeyDataWithPurpose -> String
showsPrec :: Int -> ApiPostAccountKeyDataWithPurpose -> ShowS
$cshowsPrec :: Int -> ApiPostAccountKeyDataWithPurpose -> ShowS
Show)
      deriving anyclass ApiPostAccountKeyDataWithPurpose -> ()
(ApiPostAccountKeyDataWithPurpose -> ())
-> NFData ApiPostAccountKeyDataWithPurpose
forall a. (a -> ()) -> NFData a
rnf :: ApiPostAccountKeyDataWithPurpose -> ()
$crnf :: ApiPostAccountKeyDataWithPurpose -> ()
NFData

data ApiAccountKey = ApiAccountKey
    { ApiAccountKey -> ByteString
getApiAccountKey :: ByteString
    , ApiAccountKey -> KeyFormat
format :: KeyFormat
    , ApiAccountKey -> Index 'Hardened 'PurposeK
purpose :: Index 'Hardened 'PurposeK
    } deriving (ApiAccountKey -> ApiAccountKey -> Bool
(ApiAccountKey -> ApiAccountKey -> Bool)
-> (ApiAccountKey -> ApiAccountKey -> Bool) -> Eq ApiAccountKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiAccountKey -> ApiAccountKey -> Bool
$c/= :: ApiAccountKey -> ApiAccountKey -> Bool
== :: ApiAccountKey -> ApiAccountKey -> Bool
$c== :: ApiAccountKey -> ApiAccountKey -> Bool
Eq, (forall x. ApiAccountKey -> Rep ApiAccountKey x)
-> (forall x. Rep ApiAccountKey x -> ApiAccountKey)
-> Generic ApiAccountKey
forall x. Rep ApiAccountKey x -> ApiAccountKey
forall x. ApiAccountKey -> Rep ApiAccountKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiAccountKey x -> ApiAccountKey
$cfrom :: forall x. ApiAccountKey -> Rep ApiAccountKey x
Generic, Int -> ApiAccountKey -> ShowS
[ApiAccountKey] -> ShowS
ApiAccountKey -> String
(Int -> ApiAccountKey -> ShowS)
-> (ApiAccountKey -> String)
-> ([ApiAccountKey] -> ShowS)
-> Show ApiAccountKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiAccountKey] -> ShowS
$cshowList :: [ApiAccountKey] -> ShowS
show :: ApiAccountKey -> String
$cshow :: ApiAccountKey -> String
showsPrec :: Int -> ApiAccountKey -> ShowS
$cshowsPrec :: Int -> ApiAccountKey -> ShowS
Show)
      deriving anyclass ApiAccountKey -> ()
(ApiAccountKey -> ()) -> NFData ApiAccountKey
forall a. (a -> ()) -> NFData a
rnf :: ApiAccountKey -> ()
$crnf :: ApiAccountKey -> ()
NFData

data ApiAccountKeyShared = ApiAccountKeyShared
    { ApiAccountKeyShared -> ByteString
getApiAccountKey :: ByteString
    , ApiAccountKeyShared -> KeyFormat
format :: KeyFormat
    , ApiAccountKeyShared -> Index 'Hardened 'PurposeK
purpose :: Index 'Hardened 'PurposeK
    } deriving (ApiAccountKeyShared -> ApiAccountKeyShared -> Bool
(ApiAccountKeyShared -> ApiAccountKeyShared -> Bool)
-> (ApiAccountKeyShared -> ApiAccountKeyShared -> Bool)
-> Eq ApiAccountKeyShared
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiAccountKeyShared -> ApiAccountKeyShared -> Bool
$c/= :: ApiAccountKeyShared -> ApiAccountKeyShared -> Bool
== :: ApiAccountKeyShared -> ApiAccountKeyShared -> Bool
$c== :: ApiAccountKeyShared -> ApiAccountKeyShared -> Bool
Eq, (forall x. ApiAccountKeyShared -> Rep ApiAccountKeyShared x)
-> (forall x. Rep ApiAccountKeyShared x -> ApiAccountKeyShared)
-> Generic ApiAccountKeyShared
forall x. Rep ApiAccountKeyShared x -> ApiAccountKeyShared
forall x. ApiAccountKeyShared -> Rep ApiAccountKeyShared x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiAccountKeyShared x -> ApiAccountKeyShared
$cfrom :: forall x. ApiAccountKeyShared -> Rep ApiAccountKeyShared x
Generic, Int -> ApiAccountKeyShared -> ShowS
[ApiAccountKeyShared] -> ShowS
ApiAccountKeyShared -> String
(Int -> ApiAccountKeyShared -> ShowS)
-> (ApiAccountKeyShared -> String)
-> ([ApiAccountKeyShared] -> ShowS)
-> Show ApiAccountKeyShared
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiAccountKeyShared] -> ShowS
$cshowList :: [ApiAccountKeyShared] -> ShowS
show :: ApiAccountKeyShared -> String
$cshow :: ApiAccountKeyShared -> String
showsPrec :: Int -> ApiAccountKeyShared -> ShowS
$cshowsPrec :: Int -> ApiAccountKeyShared -> ShowS
Show)
      deriving anyclass ApiAccountKeyShared -> ()
(ApiAccountKeyShared -> ()) -> NFData ApiAccountKeyShared
forall a. (a -> ()) -> NFData a
rnf :: ApiAccountKeyShared -> ()
$crnf :: ApiAccountKeyShared -> ()
NFData

data XPubOrSelf = SomeAccountKey XPub | Self
    deriving (XPubOrSelf -> XPubOrSelf -> Bool
(XPubOrSelf -> XPubOrSelf -> Bool)
-> (XPubOrSelf -> XPubOrSelf -> Bool) -> Eq XPubOrSelf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPubOrSelf -> XPubOrSelf -> Bool
$c/= :: XPubOrSelf -> XPubOrSelf -> Bool
== :: XPubOrSelf -> XPubOrSelf -> Bool
$c== :: XPubOrSelf -> XPubOrSelf -> Bool
Eq, (forall x. XPubOrSelf -> Rep XPubOrSelf x)
-> (forall x. Rep XPubOrSelf x -> XPubOrSelf) -> Generic XPubOrSelf
forall x. Rep XPubOrSelf x -> XPubOrSelf
forall x. XPubOrSelf -> Rep XPubOrSelf x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XPubOrSelf x -> XPubOrSelf
$cfrom :: forall x. XPubOrSelf -> Rep XPubOrSelf x
Generic, Int -> XPubOrSelf -> ShowS
[XPubOrSelf] -> ShowS
XPubOrSelf -> String
(Int -> XPubOrSelf -> ShowS)
-> (XPubOrSelf -> String)
-> ([XPubOrSelf] -> ShowS)
-> Show XPubOrSelf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPubOrSelf] -> ShowS
$cshowList :: [XPubOrSelf] -> ShowS
show :: XPubOrSelf -> String
$cshow :: XPubOrSelf -> String
showsPrec :: Int -> XPubOrSelf -> ShowS
$cshowsPrec :: Int -> XPubOrSelf -> ShowS
Show)
    deriving anyclass XPubOrSelf -> ()
(XPubOrSelf -> ()) -> NFData XPubOrSelf
forall a. (a -> ()) -> NFData a
rnf :: XPubOrSelf -> ()
$crnf :: XPubOrSelf -> ()
NFData

data ApiScriptTemplateEntry = ApiScriptTemplateEntry
    { ApiScriptTemplateEntry -> Map Cosigner XPubOrSelf
cosigners :: Map Cosigner XPubOrSelf
    , ApiScriptTemplateEntry -> Script Cosigner
template :: Script Cosigner
    } deriving (ApiScriptTemplateEntry -> ApiScriptTemplateEntry -> Bool
(ApiScriptTemplateEntry -> ApiScriptTemplateEntry -> Bool)
-> (ApiScriptTemplateEntry -> ApiScriptTemplateEntry -> Bool)
-> Eq ApiScriptTemplateEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiScriptTemplateEntry -> ApiScriptTemplateEntry -> Bool
$c/= :: ApiScriptTemplateEntry -> ApiScriptTemplateEntry -> Bool
== :: ApiScriptTemplateEntry -> ApiScriptTemplateEntry -> Bool
$c== :: ApiScriptTemplateEntry -> ApiScriptTemplateEntry -> Bool
Eq, (forall x. ApiScriptTemplateEntry -> Rep ApiScriptTemplateEntry x)
-> (forall x.
    Rep ApiScriptTemplateEntry x -> ApiScriptTemplateEntry)
-> Generic ApiScriptTemplateEntry
forall x. Rep ApiScriptTemplateEntry x -> ApiScriptTemplateEntry
forall x. ApiScriptTemplateEntry -> Rep ApiScriptTemplateEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiScriptTemplateEntry x -> ApiScriptTemplateEntry
$cfrom :: forall x. ApiScriptTemplateEntry -> Rep ApiScriptTemplateEntry x
Generic, Int -> ApiScriptTemplateEntry -> ShowS
[ApiScriptTemplateEntry] -> ShowS
ApiScriptTemplateEntry -> String
(Int -> ApiScriptTemplateEntry -> ShowS)
-> (ApiScriptTemplateEntry -> String)
-> ([ApiScriptTemplateEntry] -> ShowS)
-> Show ApiScriptTemplateEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiScriptTemplateEntry] -> ShowS
$cshowList :: [ApiScriptTemplateEntry] -> ShowS
show :: ApiScriptTemplateEntry -> String
$cshow :: ApiScriptTemplateEntry -> String
showsPrec :: Int -> ApiScriptTemplateEntry -> ShowS
$cshowsPrec :: Int -> ApiScriptTemplateEntry -> ShowS
Show)
      deriving anyclass ApiScriptTemplateEntry -> ()
(ApiScriptTemplateEntry -> ()) -> NFData ApiScriptTemplateEntry
forall a. (a -> ()) -> NFData a
rnf :: ApiScriptTemplateEntry -> ()
$crnf :: ApiScriptTemplateEntry -> ()
NFData

data ApiSharedWalletPostDataFromMnemonics = ApiSharedWalletPostDataFromMnemonics
    { ApiSharedWalletPostDataFromMnemonics -> ApiT WalletName
name :: !(ApiT WalletName)
    , ApiSharedWalletPostDataFromMnemonics
-> ApiMnemonicT (AllowedMnemonics 'Shelley)
mnemonicSentence :: !(ApiMnemonicT (AllowedMnemonics 'Shelley))
    , ApiSharedWalletPostDataFromMnemonics
-> Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor))
mnemonicSecondFactor :: !(Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor)))
    , ApiSharedWalletPostDataFromMnemonics -> ApiT (Passphrase "user")
passphrase :: !(ApiT (Passphrase "user"))
    , ApiSharedWalletPostDataFromMnemonics -> ApiT DerivationIndex
accountIndex :: !(ApiT DerivationIndex)
    , ApiSharedWalletPostDataFromMnemonics -> ApiScriptTemplateEntry
paymentScriptTemplate :: !ApiScriptTemplateEntry
    , ApiSharedWalletPostDataFromMnemonics
-> Maybe ApiScriptTemplateEntry
delegationScriptTemplate :: !(Maybe ApiScriptTemplateEntry)
    , ApiSharedWalletPostDataFromMnemonics
-> Maybe (ApiT ValidationLevel)
scriptValidation :: !(Maybe (ApiT ValidationLevel))
    } deriving (ApiSharedWalletPostDataFromMnemonics
-> ApiSharedWalletPostDataFromMnemonics -> Bool
(ApiSharedWalletPostDataFromMnemonics
 -> ApiSharedWalletPostDataFromMnemonics -> Bool)
-> (ApiSharedWalletPostDataFromMnemonics
    -> ApiSharedWalletPostDataFromMnemonics -> Bool)
-> Eq ApiSharedWalletPostDataFromMnemonics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiSharedWalletPostDataFromMnemonics
-> ApiSharedWalletPostDataFromMnemonics -> Bool
$c/= :: ApiSharedWalletPostDataFromMnemonics
-> ApiSharedWalletPostDataFromMnemonics -> Bool
== :: ApiSharedWalletPostDataFromMnemonics
-> ApiSharedWalletPostDataFromMnemonics -> Bool
$c== :: ApiSharedWalletPostDataFromMnemonics
-> ApiSharedWalletPostDataFromMnemonics -> Bool
Eq, (forall x.
 ApiSharedWalletPostDataFromMnemonics
 -> Rep ApiSharedWalletPostDataFromMnemonics x)
-> (forall x.
    Rep ApiSharedWalletPostDataFromMnemonics x
    -> ApiSharedWalletPostDataFromMnemonics)
-> Generic ApiSharedWalletPostDataFromMnemonics
forall x.
Rep ApiSharedWalletPostDataFromMnemonics x
-> ApiSharedWalletPostDataFromMnemonics
forall x.
ApiSharedWalletPostDataFromMnemonics
-> Rep ApiSharedWalletPostDataFromMnemonics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiSharedWalletPostDataFromMnemonics x
-> ApiSharedWalletPostDataFromMnemonics
$cfrom :: forall x.
ApiSharedWalletPostDataFromMnemonics
-> Rep ApiSharedWalletPostDataFromMnemonics x
Generic, Int -> ApiSharedWalletPostDataFromMnemonics -> ShowS
[ApiSharedWalletPostDataFromMnemonics] -> ShowS
ApiSharedWalletPostDataFromMnemonics -> String
(Int -> ApiSharedWalletPostDataFromMnemonics -> ShowS)
-> (ApiSharedWalletPostDataFromMnemonics -> String)
-> ([ApiSharedWalletPostDataFromMnemonics] -> ShowS)
-> Show ApiSharedWalletPostDataFromMnemonics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiSharedWalletPostDataFromMnemonics] -> ShowS
$cshowList :: [ApiSharedWalletPostDataFromMnemonics] -> ShowS
show :: ApiSharedWalletPostDataFromMnemonics -> String
$cshow :: ApiSharedWalletPostDataFromMnemonics -> String
showsPrec :: Int -> ApiSharedWalletPostDataFromMnemonics -> ShowS
$cshowsPrec :: Int -> ApiSharedWalletPostDataFromMnemonics -> ShowS
Show)

data ApiSharedWalletPostDataFromAccountPubX = ApiSharedWalletPostDataFromAccountPubX
    { ApiSharedWalletPostDataFromAccountPubX -> ApiT WalletName
name :: !(ApiT WalletName)
    , ApiSharedWalletPostDataFromAccountPubX -> ApiAccountPublicKey
accountPublicKey :: !ApiAccountPublicKey
    , ApiSharedWalletPostDataFromAccountPubX -> ApiT DerivationIndex
accountIndex :: !(ApiT DerivationIndex)
    , ApiSharedWalletPostDataFromAccountPubX -> ApiScriptTemplateEntry
paymentScriptTemplate :: !ApiScriptTemplateEntry
    , ApiSharedWalletPostDataFromAccountPubX
-> Maybe ApiScriptTemplateEntry
delegationScriptTemplate :: !(Maybe ApiScriptTemplateEntry)
    , ApiSharedWalletPostDataFromAccountPubX
-> Maybe (ApiT ValidationLevel)
scriptValidation :: !(Maybe (ApiT ValidationLevel))
    } deriving (ApiSharedWalletPostDataFromAccountPubX
-> ApiSharedWalletPostDataFromAccountPubX -> Bool
(ApiSharedWalletPostDataFromAccountPubX
 -> ApiSharedWalletPostDataFromAccountPubX -> Bool)
-> (ApiSharedWalletPostDataFromAccountPubX
    -> ApiSharedWalletPostDataFromAccountPubX -> Bool)
-> Eq ApiSharedWalletPostDataFromAccountPubX
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiSharedWalletPostDataFromAccountPubX
-> ApiSharedWalletPostDataFromAccountPubX -> Bool
$c/= :: ApiSharedWalletPostDataFromAccountPubX
-> ApiSharedWalletPostDataFromAccountPubX -> Bool
== :: ApiSharedWalletPostDataFromAccountPubX
-> ApiSharedWalletPostDataFromAccountPubX -> Bool
$c== :: ApiSharedWalletPostDataFromAccountPubX
-> ApiSharedWalletPostDataFromAccountPubX -> Bool
Eq, (forall x.
 ApiSharedWalletPostDataFromAccountPubX
 -> Rep ApiSharedWalletPostDataFromAccountPubX x)
-> (forall x.
    Rep ApiSharedWalletPostDataFromAccountPubX x
    -> ApiSharedWalletPostDataFromAccountPubX)
-> Generic ApiSharedWalletPostDataFromAccountPubX
forall x.
Rep ApiSharedWalletPostDataFromAccountPubX x
-> ApiSharedWalletPostDataFromAccountPubX
forall x.
ApiSharedWalletPostDataFromAccountPubX
-> Rep ApiSharedWalletPostDataFromAccountPubX x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiSharedWalletPostDataFromAccountPubX x
-> ApiSharedWalletPostDataFromAccountPubX
$cfrom :: forall x.
ApiSharedWalletPostDataFromAccountPubX
-> Rep ApiSharedWalletPostDataFromAccountPubX x
Generic, Int -> ApiSharedWalletPostDataFromAccountPubX -> ShowS
[ApiSharedWalletPostDataFromAccountPubX] -> ShowS
ApiSharedWalletPostDataFromAccountPubX -> String
(Int -> ApiSharedWalletPostDataFromAccountPubX -> ShowS)
-> (ApiSharedWalletPostDataFromAccountPubX -> String)
-> ([ApiSharedWalletPostDataFromAccountPubX] -> ShowS)
-> Show ApiSharedWalletPostDataFromAccountPubX
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiSharedWalletPostDataFromAccountPubX] -> ShowS
$cshowList :: [ApiSharedWalletPostDataFromAccountPubX] -> ShowS
show :: ApiSharedWalletPostDataFromAccountPubX -> String
$cshow :: ApiSharedWalletPostDataFromAccountPubX -> String
showsPrec :: Int -> ApiSharedWalletPostDataFromAccountPubX -> ShowS
$cshowsPrec :: Int -> ApiSharedWalletPostDataFromAccountPubX -> ShowS
Show)

newtype ApiSharedWalletPostData = ApiSharedWalletPostData
    { ApiSharedWalletPostData
-> Either
     ApiSharedWalletPostDataFromMnemonics
     ApiSharedWalletPostDataFromAccountPubX
wallet :: Either
        ApiSharedWalletPostDataFromMnemonics
        ApiSharedWalletPostDataFromAccountPubX
    }
    deriving (ApiSharedWalletPostData -> ApiSharedWalletPostData -> Bool
(ApiSharedWalletPostData -> ApiSharedWalletPostData -> Bool)
-> (ApiSharedWalletPostData -> ApiSharedWalletPostData -> Bool)
-> Eq ApiSharedWalletPostData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiSharedWalletPostData -> ApiSharedWalletPostData -> Bool
$c/= :: ApiSharedWalletPostData -> ApiSharedWalletPostData -> Bool
== :: ApiSharedWalletPostData -> ApiSharedWalletPostData -> Bool
$c== :: ApiSharedWalletPostData -> ApiSharedWalletPostData -> Bool
Eq, (forall x.
 ApiSharedWalletPostData -> Rep ApiSharedWalletPostData x)
-> (forall x.
    Rep ApiSharedWalletPostData x -> ApiSharedWalletPostData)
-> Generic ApiSharedWalletPostData
forall x. Rep ApiSharedWalletPostData x -> ApiSharedWalletPostData
forall x. ApiSharedWalletPostData -> Rep ApiSharedWalletPostData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiSharedWalletPostData x -> ApiSharedWalletPostData
$cfrom :: forall x. ApiSharedWalletPostData -> Rep ApiSharedWalletPostData x
Generic)
    deriving Int -> ApiSharedWalletPostData -> ShowS
[ApiSharedWalletPostData] -> ShowS
ApiSharedWalletPostData -> String
(Int -> ApiSharedWalletPostData -> ShowS)
-> (ApiSharedWalletPostData -> String)
-> ([ApiSharedWalletPostData] -> ShowS)
-> Show ApiSharedWalletPostData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiSharedWalletPostData] -> ShowS
$cshowList :: [ApiSharedWalletPostData] -> ShowS
show :: ApiSharedWalletPostData -> String
$cshow :: ApiSharedWalletPostData -> String
showsPrec :: Int -> ApiSharedWalletPostData -> ShowS
$cshowsPrec :: Int -> ApiSharedWalletPostData -> ShowS
Show via (Quiet ApiSharedWalletPostData)

data ApiActiveSharedWallet = ApiActiveSharedWallet
    { ApiActiveSharedWallet -> ApiT WalletId
id :: !(ApiT WalletId)
    , ApiActiveSharedWallet -> ApiT WalletName
name :: !(ApiT WalletName)
    , ApiActiveSharedWallet -> ApiT DerivationIndex
accountIndex :: !(ApiT DerivationIndex)
    , ApiActiveSharedWallet -> ApiT AddressPoolGap
addressPoolGap :: !(ApiT AddressPoolGap)
    , ApiActiveSharedWallet -> Maybe ApiWalletPassphraseInfo
passphrase :: !(Maybe ApiWalletPassphraseInfo)
    , ApiActiveSharedWallet -> ScriptTemplate
paymentScriptTemplate :: !ScriptTemplate
    , ApiActiveSharedWallet -> Maybe ScriptTemplate
delegationScriptTemplate :: !(Maybe ScriptTemplate)
    , ApiActiveSharedWallet -> ApiWalletDelegation
delegation :: !ApiWalletDelegation
    , ApiActiveSharedWallet -> ApiWalletBalance
balance :: !ApiWalletBalance
    , ApiActiveSharedWallet -> ApiWalletAssetsBalance
assets :: !ApiWalletAssetsBalance
    , ApiActiveSharedWallet -> ApiT SyncProgress
state :: !(ApiT SyncProgress)
    , ApiActiveSharedWallet -> ApiBlockReference
tip :: !ApiBlockReference
    } deriving (ApiActiveSharedWallet -> ApiActiveSharedWallet -> Bool
(ApiActiveSharedWallet -> ApiActiveSharedWallet -> Bool)
-> (ApiActiveSharedWallet -> ApiActiveSharedWallet -> Bool)
-> Eq ApiActiveSharedWallet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiActiveSharedWallet -> ApiActiveSharedWallet -> Bool
$c/= :: ApiActiveSharedWallet -> ApiActiveSharedWallet -> Bool
== :: ApiActiveSharedWallet -> ApiActiveSharedWallet -> Bool
$c== :: ApiActiveSharedWallet -> ApiActiveSharedWallet -> Bool
Eq, (forall x. ApiActiveSharedWallet -> Rep ApiActiveSharedWallet x)
-> (forall x. Rep ApiActiveSharedWallet x -> ApiActiveSharedWallet)
-> Generic ApiActiveSharedWallet
forall x. Rep ApiActiveSharedWallet x -> ApiActiveSharedWallet
forall x. ApiActiveSharedWallet -> Rep ApiActiveSharedWallet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiActiveSharedWallet x -> ApiActiveSharedWallet
$cfrom :: forall x. ApiActiveSharedWallet -> Rep ApiActiveSharedWallet x
Generic, Int -> ApiActiveSharedWallet -> ShowS
[ApiActiveSharedWallet] -> ShowS
ApiActiveSharedWallet -> String
(Int -> ApiActiveSharedWallet -> ShowS)
-> (ApiActiveSharedWallet -> String)
-> ([ApiActiveSharedWallet] -> ShowS)
-> Show ApiActiveSharedWallet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiActiveSharedWallet] -> ShowS
$cshowList :: [ApiActiveSharedWallet] -> ShowS
show :: ApiActiveSharedWallet -> String
$cshow :: ApiActiveSharedWallet -> String
showsPrec :: Int -> ApiActiveSharedWallet -> ShowS
$cshowsPrec :: Int -> ApiActiveSharedWallet -> ShowS
Show)
      deriving anyclass ApiActiveSharedWallet -> ()
(ApiActiveSharedWallet -> ()) -> NFData ApiActiveSharedWallet
forall a. (a -> ()) -> NFData a
rnf :: ApiActiveSharedWallet -> ()
$crnf :: ApiActiveSharedWallet -> ()
NFData

data ApiPendingSharedWallet = ApiPendingSharedWallet
    { ApiPendingSharedWallet -> ApiT WalletId
id :: !(ApiT WalletId)
    , ApiPendingSharedWallet -> ApiT WalletName
name :: !(ApiT WalletName)
    , ApiPendingSharedWallet -> ApiT DerivationIndex
accountIndex :: !(ApiT DerivationIndex)
    , ApiPendingSharedWallet -> ApiT AddressPoolGap
addressPoolGap :: !(ApiT AddressPoolGap)
    , ApiPendingSharedWallet -> ScriptTemplate
paymentScriptTemplate :: !ScriptTemplate
    , ApiPendingSharedWallet -> Maybe ScriptTemplate
delegationScriptTemplate :: !(Maybe ScriptTemplate)
    } deriving (ApiPendingSharedWallet -> ApiPendingSharedWallet -> Bool
(ApiPendingSharedWallet -> ApiPendingSharedWallet -> Bool)
-> (ApiPendingSharedWallet -> ApiPendingSharedWallet -> Bool)
-> Eq ApiPendingSharedWallet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiPendingSharedWallet -> ApiPendingSharedWallet -> Bool
$c/= :: ApiPendingSharedWallet -> ApiPendingSharedWallet -> Bool
== :: ApiPendingSharedWallet -> ApiPendingSharedWallet -> Bool
$c== :: ApiPendingSharedWallet -> ApiPendingSharedWallet -> Bool
Eq, (forall x. ApiPendingSharedWallet -> Rep ApiPendingSharedWallet x)
-> (forall x.
    Rep ApiPendingSharedWallet x -> ApiPendingSharedWallet)
-> Generic ApiPendingSharedWallet
forall x. Rep ApiPendingSharedWallet x -> ApiPendingSharedWallet
forall x. ApiPendingSharedWallet -> Rep ApiPendingSharedWallet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiPendingSharedWallet x -> ApiPendingSharedWallet
$cfrom :: forall x. ApiPendingSharedWallet -> Rep ApiPendingSharedWallet x
Generic, Int -> ApiPendingSharedWallet -> ShowS
[ApiPendingSharedWallet] -> ShowS
ApiPendingSharedWallet -> String
(Int -> ApiPendingSharedWallet -> ShowS)
-> (ApiPendingSharedWallet -> String)
-> ([ApiPendingSharedWallet] -> ShowS)
-> Show ApiPendingSharedWallet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiPendingSharedWallet] -> ShowS
$cshowList :: [ApiPendingSharedWallet] -> ShowS
show :: ApiPendingSharedWallet -> String
$cshow :: ApiPendingSharedWallet -> String
showsPrec :: Int -> ApiPendingSharedWallet -> ShowS
$cshowsPrec :: Int -> ApiPendingSharedWallet -> ShowS
Show)
      deriving anyclass ApiPendingSharedWallet -> ()
(ApiPendingSharedWallet -> ()) -> NFData ApiPendingSharedWallet
forall a. (a -> ()) -> NFData a
rnf :: ApiPendingSharedWallet -> ()
$crnf :: ApiPendingSharedWallet -> ()
NFData

newtype ApiSharedWallet = ApiSharedWallet
    { ApiSharedWallet
-> Either ApiPendingSharedWallet ApiActiveSharedWallet
wallet :: Either ApiPendingSharedWallet ApiActiveSharedWallet
    }
    deriving (ApiSharedWallet -> ApiSharedWallet -> Bool
(ApiSharedWallet -> ApiSharedWallet -> Bool)
-> (ApiSharedWallet -> ApiSharedWallet -> Bool)
-> Eq ApiSharedWallet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiSharedWallet -> ApiSharedWallet -> Bool
$c/= :: ApiSharedWallet -> ApiSharedWallet -> Bool
== :: ApiSharedWallet -> ApiSharedWallet -> Bool
$c== :: ApiSharedWallet -> ApiSharedWallet -> Bool
Eq, (forall x. ApiSharedWallet -> Rep ApiSharedWallet x)
-> (forall x. Rep ApiSharedWallet x -> ApiSharedWallet)
-> Generic ApiSharedWallet
forall x. Rep ApiSharedWallet x -> ApiSharedWallet
forall x. ApiSharedWallet -> Rep ApiSharedWallet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiSharedWallet x -> ApiSharedWallet
$cfrom :: forall x. ApiSharedWallet -> Rep ApiSharedWallet x
Generic)
    deriving anyclass ApiSharedWallet -> ()
(ApiSharedWallet -> ()) -> NFData ApiSharedWallet
forall a. (a -> ()) -> NFData a
rnf :: ApiSharedWallet -> ()
$crnf :: ApiSharedWallet -> ()
NFData
    deriving Int -> ApiSharedWallet -> ShowS
[ApiSharedWallet] -> ShowS
ApiSharedWallet -> String
(Int -> ApiSharedWallet -> ShowS)
-> (ApiSharedWallet -> String)
-> ([ApiSharedWallet] -> ShowS)
-> Show ApiSharedWallet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiSharedWallet] -> ShowS
$cshowList :: [ApiSharedWallet] -> ShowS
show :: ApiSharedWallet -> String
$cshow :: ApiSharedWallet -> String
showsPrec :: Int -> ApiSharedWallet -> ShowS
$cshowsPrec :: Int -> ApiSharedWallet -> ShowS
Show via (Quiet ApiSharedWallet)

data ApiSharedWalletPatchData = ApiSharedWalletPatchData
    { ApiSharedWalletPatchData -> ApiT Cosigner
cosigner :: !(ApiT Cosigner)
    , ApiSharedWalletPatchData -> ApiAccountPublicKey
accountPublicKey :: !ApiAccountPublicKey
    } deriving (ApiSharedWalletPatchData -> ApiSharedWalletPatchData -> Bool
(ApiSharedWalletPatchData -> ApiSharedWalletPatchData -> Bool)
-> (ApiSharedWalletPatchData -> ApiSharedWalletPatchData -> Bool)
-> Eq ApiSharedWalletPatchData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiSharedWalletPatchData -> ApiSharedWalletPatchData -> Bool
$c/= :: ApiSharedWalletPatchData -> ApiSharedWalletPatchData -> Bool
== :: ApiSharedWalletPatchData -> ApiSharedWalletPatchData -> Bool
$c== :: ApiSharedWalletPatchData -> ApiSharedWalletPatchData -> Bool
Eq, (forall x.
 ApiSharedWalletPatchData -> Rep ApiSharedWalletPatchData x)
-> (forall x.
    Rep ApiSharedWalletPatchData x -> ApiSharedWalletPatchData)
-> Generic ApiSharedWalletPatchData
forall x.
Rep ApiSharedWalletPatchData x -> ApiSharedWalletPatchData
forall x.
ApiSharedWalletPatchData -> Rep ApiSharedWalletPatchData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApiSharedWalletPatchData x -> ApiSharedWalletPatchData
$cfrom :: forall x.
ApiSharedWalletPatchData -> Rep ApiSharedWalletPatchData x
Generic, Int -> ApiSharedWalletPatchData -> ShowS
[ApiSharedWalletPatchData] -> ShowS
ApiSharedWalletPatchData -> String
(Int -> ApiSharedWalletPatchData -> ShowS)
-> (ApiSharedWalletPatchData -> String)
-> ([ApiSharedWalletPatchData] -> ShowS)
-> Show ApiSharedWalletPatchData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiSharedWalletPatchData] -> ShowS
$cshowList :: [ApiSharedWalletPatchData] -> ShowS
show :: ApiSharedWalletPatchData -> String
$cshow :: ApiSharedWalletPatchData -> String
showsPrec :: Int -> ApiSharedWalletPatchData -> ShowS
$cshowsPrec :: Int -> ApiSharedWalletPatchData -> ShowS
Show)
      deriving anyclass ApiSharedWalletPatchData -> ()
(ApiSharedWalletPatchData -> ()) -> NFData ApiSharedWalletPatchData
forall a. (a -> ()) -> NFData a
rnf :: ApiSharedWalletPatchData -> ()
$crnf :: ApiSharedWalletPatchData -> ()
NFData

-- | Error codes returned by the API, in the form of snake_cased strings
data ApiErrorCode
    = AddressAlreadyExists
    | AlreadyWithdrawing
    | AssetNameTooLong
    | AssetNotPresent
    | BadRequest
    | BalanceTxByronNotSupported
    | BalanceTxConflictingNetworks
    | BalanceTxExistingCollateral
    | BalanceTxExistingKeyWitnesses
    | BalanceTxExistingReturnCollateral
    | BalanceTxExistingTotalCollateral
    | BalanceTxInternalError
    | BalanceTxMaxSizeLimitExceeded
    | BalanceTxUnderestimatedFee
    | BalanceTxZeroAdaOutput
    | CannotCoverFee
    | CreatedInvalidTransaction
    | CreatedMultiaccountTransaction
    | CreatedMultidelegationTransaction
    | CreatedWrongPolicyScriptTemplate
    | ExistingKeyWitnesses
    | ForeignTransaction
    | HardenedDerivationRequired
    | InputsDepleted
    | InsufficientCollateral
    | InvalidCoinSelection
    | InvalidWalletType
    | InvalidValidityBounds
    | KeyNotFoundForAddress
    | MalformedTxPayload
    | MethodNotAllowed
    | MinWithdrawalWrong
    | MintOrBurnAssetQuantityOutOfBounds
    | MissingPolicyPublicKey
    | MissingWitnessesInTransaction
    | NetworkMisconfigured
    | NetworkQueryFailed
    | NetworkUnreachable
    | NoRootKey
    | NoSuchPool
    | NoSuchTransaction
    | NoSuchWallet
    | NonNullRewards
    | NotAcceptable
    | NotDelegatingTo
    | NotEnoughMoney
    | NotFound
    | NotImplemented
    | NotSynced
    | NothingToMigrate
    | OutputTokenBundleSizeExceedsLimit
    | OutputTokenQuantityExceedsLimit
    | PastHorizon
    | PoolAlreadyJoined
    | QueryParamMissing
    | RedeemerInvalidData
    | RedeemerScriptFailure
    | RedeemerTargetNotFound
    | RejectedByCoreNode
    | SharedWalletCannotUpdateKey
    | SharedWalletKeyAlreadyExists
    | SharedWalletNoDelegationTemplate
    | SharedWalletNoSuchCosigner
    | SharedWalletNotPending
    | SharedWalletPending
    | SharedWalletScriptTemplateInvalid
    | SoftDerivationRequired
    | StartTimeLaterThanEndTime
    | TokensMintedButNotSpentOrBurned
    | TransactionAlreadyBalanced
    | TransactionAlreadyInLedger
    | TransactionIsTooBig
    | TranslationError
    | UnableToAssignInputOutput
    | UnableToDetermineCurrentEpoch
    | UnexpectedError
    | UnresolvedInputs
    | UnsupportedMediaType
    | UtxoTooSmall
    | WalletAlreadyExists
    | WalletNotResponding
    | WithdrawalNotWorth
    | WrongEncryptionPassphrase
    | WrongMnemonic
    | ValidityIntervalNotInsideScriptTimelock
    deriving (ApiErrorCode -> ApiErrorCode -> Bool
(ApiErrorCode -> ApiErrorCode -> Bool)
-> (ApiErrorCode -> ApiErrorCode -> Bool) -> Eq ApiErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiErrorCode -> ApiErrorCode -> Bool
$c/= :: ApiErrorCode -> ApiErrorCode -> Bool
== :: ApiErrorCode -> ApiErrorCode -> Bool
$c== :: ApiErrorCode -> ApiErrorCode -> Bool
Eq, (forall x. ApiErrorCode -> Rep ApiErrorCode x)
-> (forall x. Rep ApiErrorCode x -> ApiErrorCode)
-> Generic ApiErrorCode
forall x. Rep ApiErrorCode x -> ApiErrorCode
forall x. ApiErrorCode -> Rep ApiErrorCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiErrorCode x -> ApiErrorCode
$cfrom :: forall x. ApiErrorCode -> Rep ApiErrorCode x
Generic, Int -> ApiErrorCode -> ShowS
[ApiErrorCode] -> ShowS
ApiErrorCode -> String
(Int -> ApiErrorCode -> ShowS)
-> (ApiErrorCode -> String)
-> ([ApiErrorCode] -> ShowS)
-> Show ApiErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiErrorCode] -> ShowS
$cshowList :: [ApiErrorCode] -> ShowS
show :: ApiErrorCode -> String
$cshow :: ApiErrorCode -> String
showsPrec :: Int -> ApiErrorCode -> ShowS
$cshowsPrec :: Int -> ApiErrorCode -> ShowS
Show, Typeable ApiErrorCode
DataType
Constr
Typeable ApiErrorCode
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ApiErrorCode -> c ApiErrorCode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ApiErrorCode)
-> (ApiErrorCode -> Constr)
-> (ApiErrorCode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ApiErrorCode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ApiErrorCode))
-> ((forall b. Data b => b -> b) -> ApiErrorCode -> ApiErrorCode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ApiErrorCode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ApiErrorCode -> r)
-> (forall u. (forall d. Data d => d -> u) -> ApiErrorCode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ApiErrorCode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ApiErrorCode -> m ApiErrorCode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ApiErrorCode -> m ApiErrorCode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ApiErrorCode -> m ApiErrorCode)
-> Data ApiErrorCode
ApiErrorCode -> DataType
ApiErrorCode -> Constr
(forall b. Data b => b -> b) -> ApiErrorCode -> ApiErrorCode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApiErrorCode -> c ApiErrorCode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApiErrorCode
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ApiErrorCode -> u
forall u. (forall d. Data d => d -> u) -> ApiErrorCode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ApiErrorCode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ApiErrorCode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApiErrorCode -> m ApiErrorCode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApiErrorCode -> m ApiErrorCode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApiErrorCode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApiErrorCode -> c ApiErrorCode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApiErrorCode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApiErrorCode)
$cValidityIntervalNotInsideScriptTimelock :: Constr
$cWrongMnemonic :: Constr
$cWrongEncryptionPassphrase :: Constr
$cWithdrawalNotWorth :: Constr
$cWalletNotResponding :: Constr
$cWalletAlreadyExists :: Constr
$cUtxoTooSmall :: Constr
$cUnsupportedMediaType :: Constr
$cUnresolvedInputs :: Constr
$cUnexpectedError :: Constr
$cUnableToDetermineCurrentEpoch :: Constr
$cUnableToAssignInputOutput :: Constr
$cTranslationError :: Constr
$cTransactionIsTooBig :: Constr
$cTransactionAlreadyInLedger :: Constr
$cTransactionAlreadyBalanced :: Constr
$cTokensMintedButNotSpentOrBurned :: Constr
$cStartTimeLaterThanEndTime :: Constr
$cSoftDerivationRequired :: Constr
$cSharedWalletScriptTemplateInvalid :: Constr
$cSharedWalletPending :: Constr
$cSharedWalletNotPending :: Constr
$cSharedWalletNoSuchCosigner :: Constr
$cSharedWalletNoDelegationTemplate :: Constr
$cSharedWalletKeyAlreadyExists :: Constr
$cSharedWalletCannotUpdateKey :: Constr
$cRejectedByCoreNode :: Constr
$cRedeemerTargetNotFound :: Constr
$cRedeemerScriptFailure :: Constr
$cRedeemerInvalidData :: Constr
$cQueryParamMissing :: Constr
$cPoolAlreadyJoined :: Constr
$cPastHorizon :: Constr
$cOutputTokenQuantityExceedsLimit :: Constr
$cOutputTokenBundleSizeExceedsLimit :: Constr
$cNothingToMigrate :: Constr
$cNotSynced :: Constr
$cNotImplemented :: Constr
$cNotFound :: Constr
$cNotEnoughMoney :: Constr
$cNotDelegatingTo :: Constr
$cNotAcceptable :: Constr
$cNonNullRewards :: Constr
$cNoSuchWallet :: Constr
$cNoSuchTransaction :: Constr
$cNoSuchPool :: Constr
$cNoRootKey :: Constr
$cNetworkUnreachable :: Constr
$cNetworkQueryFailed :: Constr
$cNetworkMisconfigured :: Constr
$cMissingWitnessesInTransaction :: Constr
$cMissingPolicyPublicKey :: Constr
$cMintOrBurnAssetQuantityOutOfBounds :: Constr
$cMinWithdrawalWrong :: Constr
$cMethodNotAllowed :: Constr
$cMalformedTxPayload :: Constr
$cKeyNotFoundForAddress :: Constr
$cInvalidValidityBounds :: Constr
$cInvalidWalletType :: Constr
$cInvalidCoinSelection :: Constr
$cInsufficientCollateral :: Constr
$cInputsDepleted :: Constr
$cHardenedDerivationRequired :: Constr
$cForeignTransaction :: Constr
$cExistingKeyWitnesses :: Constr
$cCreatedWrongPolicyScriptTemplate :: Constr
$cCreatedMultidelegationTransaction :: Constr
$cCreatedMultiaccountTransaction :: Constr
$cCreatedInvalidTransaction :: Constr
$cCannotCoverFee :: Constr
$cBalanceTxZeroAdaOutput :: Constr
$cBalanceTxUnderestimatedFee :: Constr
$cBalanceTxMaxSizeLimitExceeded :: Constr
$cBalanceTxInternalError :: Constr
$cBalanceTxExistingTotalCollateral :: Constr
$cBalanceTxExistingReturnCollateral :: Constr
$cBalanceTxExistingKeyWitnesses :: Constr
$cBalanceTxExistingCollateral :: Constr
$cBalanceTxConflictingNetworks :: Constr
$cBalanceTxByronNotSupported :: Constr
$cBadRequest :: Constr
$cAssetNotPresent :: Constr
$cAssetNameTooLong :: Constr
$cAlreadyWithdrawing :: Constr
$cAddressAlreadyExists :: Constr
$tApiErrorCode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ApiErrorCode -> m ApiErrorCode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApiErrorCode -> m ApiErrorCode
gmapMp :: (forall d. Data d => d -> m d) -> ApiErrorCode -> m ApiErrorCode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApiErrorCode -> m ApiErrorCode
gmapM :: (forall d. Data d => d -> m d) -> ApiErrorCode -> m ApiErrorCode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApiErrorCode -> m ApiErrorCode
gmapQi :: Int -> (forall d. Data d => d -> u) -> ApiErrorCode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ApiErrorCode -> u
gmapQ :: (forall d. Data d => d -> u) -> ApiErrorCode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ApiErrorCode -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ApiErrorCode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ApiErrorCode -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ApiErrorCode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ApiErrorCode -> r
gmapT :: (forall b. Data b => b -> b) -> ApiErrorCode -> ApiErrorCode
$cgmapT :: (forall b. Data b => b -> b) -> ApiErrorCode -> ApiErrorCode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApiErrorCode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApiErrorCode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ApiErrorCode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApiErrorCode)
dataTypeOf :: ApiErrorCode -> DataType
$cdataTypeOf :: ApiErrorCode -> DataType
toConstr :: ApiErrorCode -> Constr
$ctoConstr :: ApiErrorCode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApiErrorCode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApiErrorCode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApiErrorCode -> c ApiErrorCode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApiErrorCode -> c ApiErrorCode
$cp1Data :: Typeable ApiErrorCode
Data, Typeable)
    deriving anyclass ApiErrorCode -> ()
(ApiErrorCode -> ()) -> NFData ApiErrorCode
forall a. (a -> ()) -> NFData a
rnf :: ApiErrorCode -> ()
$crnf :: ApiErrorCode -> ()
NFData

-- | Defines a point in time that can be formatted as and parsed from an
--   ISO 8601-compliant string.
--
newtype Iso8601Time = Iso8601Time
    { Iso8601Time -> UTCTime
getIso8601Time :: UTCTime
    }
    deriving (Iso8601Time -> Iso8601Time -> Bool
(Iso8601Time -> Iso8601Time -> Bool)
-> (Iso8601Time -> Iso8601Time -> Bool) -> Eq Iso8601Time
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Iso8601Time -> Iso8601Time -> Bool
$c/= :: Iso8601Time -> Iso8601Time -> Bool
== :: Iso8601Time -> Iso8601Time -> Bool
$c== :: Iso8601Time -> Iso8601Time -> Bool
Eq, Eq Iso8601Time
Eq Iso8601Time
-> (Iso8601Time -> Iso8601Time -> Ordering)
-> (Iso8601Time -> Iso8601Time -> Bool)
-> (Iso8601Time -> Iso8601Time -> Bool)
-> (Iso8601Time -> Iso8601Time -> Bool)
-> (Iso8601Time -> Iso8601Time -> Bool)
-> (Iso8601Time -> Iso8601Time -> Iso8601Time)
-> (Iso8601Time -> Iso8601Time -> Iso8601Time)
-> Ord Iso8601Time
Iso8601Time -> Iso8601Time -> Bool
Iso8601Time -> Iso8601Time -> Ordering
Iso8601Time -> Iso8601Time -> Iso8601Time
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Iso8601Time -> Iso8601Time -> Iso8601Time
$cmin :: Iso8601Time -> Iso8601Time -> Iso8601Time
max :: Iso8601Time -> Iso8601Time -> Iso8601Time
$cmax :: Iso8601Time -> Iso8601Time -> Iso8601Time
>= :: Iso8601Time -> Iso8601Time -> Bool
$c>= :: Iso8601Time -> Iso8601Time -> Bool
> :: Iso8601Time -> Iso8601Time -> Bool
$c> :: Iso8601Time -> Iso8601Time -> Bool
<= :: Iso8601Time -> Iso8601Time -> Bool
$c<= :: Iso8601Time -> Iso8601Time -> Bool
< :: Iso8601Time -> Iso8601Time -> Bool
$c< :: Iso8601Time -> Iso8601Time -> Bool
compare :: Iso8601Time -> Iso8601Time -> Ordering
$ccompare :: Iso8601Time -> Iso8601Time -> Ordering
$cp1Ord :: Eq Iso8601Time
Ord, (forall x. Iso8601Time -> Rep Iso8601Time x)
-> (forall x. Rep Iso8601Time x -> Iso8601Time)
-> Generic Iso8601Time
forall x. Rep Iso8601Time x -> Iso8601Time
forall x. Iso8601Time -> Rep Iso8601Time x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Iso8601Time x -> Iso8601Time
$cfrom :: forall x. Iso8601Time -> Rep Iso8601Time x
Generic)
    deriving Int -> Iso8601Time -> ShowS
[Iso8601Time] -> ShowS
Iso8601Time -> String
(Int -> Iso8601Time -> ShowS)
-> (Iso8601Time -> String)
-> ([Iso8601Time] -> ShowS)
-> Show Iso8601Time
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Iso8601Time] -> ShowS
$cshowList :: [Iso8601Time] -> ShowS
show :: Iso8601Time -> String
$cshow :: Iso8601Time -> String
showsPrec :: Int -> Iso8601Time -> ShowS
$cshowsPrec :: Int -> Iso8601Time -> ShowS
Show via (Quiet Iso8601Time)

instance ToText Iso8601Time where
    toText :: Iso8601Time -> Text
toText = TimeFormat -> UTCTime -> Text
utcTimeToText TimeFormat
iso8601ExtendedUtc (UTCTime -> Text)
-> (Iso8601Time -> UTCTime) -> Iso8601Time -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso8601Time -> UTCTime
getIso8601Time

instance FromText Iso8601Time where
    fromText :: Text -> Either TextDecodingError Iso8601Time
fromText Text
t =
        UTCTime -> Iso8601Time
Iso8601Time (UTCTime -> Iso8601Time)
-> Either TextDecodingError UTCTime
-> Either TextDecodingError Iso8601Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextDecodingError
-> Maybe UTCTime -> Either TextDecodingError UTCTime
forall a b. a -> Maybe b -> Either a b
maybeToEither TextDecodingError
err ([TimeFormat] -> Text -> Maybe UTCTime
utcTimeFromText [TimeFormat]
iso8601 Text
t)
      where
        err :: TextDecodingError
err = String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ String
forall a. Monoid a => a
mempty
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Unable to parse time argument: '"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'. Expecting ISO 8601 date-and-time format (basic or extended)"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", e.g. 2012-09-25T10:15:00Z."

instance FromJSON (ApiT Iso8601Time) where
    parseJSON :: Value -> Parser (ApiT Iso8601Time)
parseJSON = String -> Value -> Parser (ApiT Iso8601Time)
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"ISO-8601 Time"
instance ToJSON (ApiT Iso8601Time) where
    toJSON :: ApiT Iso8601Time -> Value
toJSON = ApiT Iso8601Time -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromHttpApiData Iso8601Time where
    parseUrlPiece :: Text -> Either Text Iso8601Time
parseUrlPiece = (TextDecodingError -> Text)
-> Either TextDecodingError Iso8601Time -> Either Text Iso8601Time
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
T.pack (String -> Text)
-> (TextDecodingError -> String) -> TextDecodingError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDecodingError -> String
getTextDecodingError) (Either TextDecodingError Iso8601Time -> Either Text Iso8601Time)
-> (Text -> Either TextDecodingError Iso8601Time)
-> Text
-> Either Text Iso8601Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError Iso8601Time
forall a. FromText a => Text -> Either TextDecodingError a
fromText

instance ToHttpApiData Iso8601Time where
    toUrlPiece :: Iso8601Time -> Text
toUrlPiece = Iso8601Time -> Text
forall a. ToText a => a -> Text
toText

newtype MinWithdrawal = MinWithdrawal
    { MinWithdrawal -> Natural
getMinWithdrawal :: Natural
    }
    deriving (forall x. MinWithdrawal -> Rep MinWithdrawal x)
-> (forall x. Rep MinWithdrawal x -> MinWithdrawal)
-> Generic MinWithdrawal
forall x. Rep MinWithdrawal x -> MinWithdrawal
forall x. MinWithdrawal -> Rep MinWithdrawal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MinWithdrawal x -> MinWithdrawal
$cfrom :: forall x. MinWithdrawal -> Rep MinWithdrawal x
Generic
    deriving Int -> MinWithdrawal -> ShowS
[MinWithdrawal] -> ShowS
MinWithdrawal -> String
(Int -> MinWithdrawal -> ShowS)
-> (MinWithdrawal -> String)
-> ([MinWithdrawal] -> ShowS)
-> Show MinWithdrawal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MinWithdrawal] -> ShowS
$cshowList :: [MinWithdrawal] -> ShowS
show :: MinWithdrawal -> String
$cshow :: MinWithdrawal -> String
showsPrec :: Int -> MinWithdrawal -> ShowS
$cshowsPrec :: Int -> MinWithdrawal -> ShowS
Show via (Quiet MinWithdrawal)

instance FromHttpApiData MinWithdrawal where
    parseUrlPiece :: Text -> Either Text MinWithdrawal
parseUrlPiece = (TextDecodingError -> Text)
-> (Natural -> MinWithdrawal)
-> Either TextDecodingError Natural
-> Either Text MinWithdrawal
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> Text
T.pack (String -> Text)
-> (TextDecodingError -> String) -> TextDecodingError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDecodingError -> String
getTextDecodingError) Natural -> MinWithdrawal
MinWithdrawal (Either TextDecodingError Natural -> Either Text MinWithdrawal)
-> (Text -> Either TextDecodingError Natural)
-> Text
-> Either Text MinWithdrawal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError Natural
forall a. FromText a => Text -> Either TextDecodingError a
fromText

instance ToHttpApiData MinWithdrawal where
    toUrlPiece :: MinWithdrawal -> Text
toUrlPiece = Natural -> Text
forall a. ToText a => a -> Text
toText (Natural -> Text)
-> (MinWithdrawal -> Natural) -> MinWithdrawal -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinWithdrawal -> Natural
getMinWithdrawal

instance ToText NtpSyncingStatus where
    toText :: NtpSyncingStatus -> Text
toText NtpSyncingStatus
NtpSyncingStatusUnavailable = Text
"unavailable"
    toText NtpSyncingStatus
NtpSyncingStatusPending = Text
"pending"
    toText NtpSyncingStatus
NtpSyncingStatusAvailable = Text
"available"

instance FromText NtpSyncingStatus where
    fromText :: Text -> Either TextDecodingError NtpSyncingStatus
fromText Text
txt = case Text
txt of
        Text
"unavailable" -> NtpSyncingStatus -> Either TextDecodingError NtpSyncingStatus
forall a b. b -> Either a b
Right NtpSyncingStatus
NtpSyncingStatusUnavailable
        Text
"pending" -> NtpSyncingStatus -> Either TextDecodingError NtpSyncingStatus
forall a b. b -> Either a b
Right NtpSyncingStatus
NtpSyncingStatusPending
        Text
"available" -> NtpSyncingStatus -> Either TextDecodingError NtpSyncingStatus
forall a b. b -> Either a b
Right NtpSyncingStatus
NtpSyncingStatusAvailable
        Text
_ -> TextDecodingError -> Either TextDecodingError NtpSyncingStatus
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError NtpSyncingStatus)
-> TextDecodingError -> Either TextDecodingError NtpSyncingStatus
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"I couldn't parse the given ntp syncing status."
            , String
"I am expecting one of the words 'unavailable', 'pending' or"
            , String
"'available'."]

instance ToText (ApiT ValidationLevel) where
    toText :: ApiT ValidationLevel -> Text
toText (ApiT ValidationLevel
RequiredValidation) = Text
"required"
    toText (ApiT ValidationLevel
RecommendedValidation) = Text
"recommended"

instance FromText (ApiT ValidationLevel) where
    fromText :: Text -> Either TextDecodingError (ApiT ValidationLevel)
fromText Text
txt = case Text
txt of
        Text
"required" -> ApiT ValidationLevel
-> Either TextDecodingError (ApiT ValidationLevel)
forall a b. b -> Either a b
Right (ApiT ValidationLevel
 -> Either TextDecodingError (ApiT ValidationLevel))
-> ApiT ValidationLevel
-> Either TextDecodingError (ApiT ValidationLevel)
forall a b. (a -> b) -> a -> b
$ ValidationLevel -> ApiT ValidationLevel
forall a. a -> ApiT a
ApiT ValidationLevel
RequiredValidation
        Text
"recommended" -> ApiT ValidationLevel
-> Either TextDecodingError (ApiT ValidationLevel)
forall a b. b -> Either a b
Right (ApiT ValidationLevel
 -> Either TextDecodingError (ApiT ValidationLevel))
-> ApiT ValidationLevel
-> Either TextDecodingError (ApiT ValidationLevel)
forall a b. (a -> b) -> a -> b
$ ValidationLevel -> ApiT ValidationLevel
forall a. a -> ApiT a
ApiT ValidationLevel
RecommendedValidation
        Text
_ -> TextDecodingError
-> Either TextDecodingError (ApiT ValidationLevel)
forall a b. a -> Either a b
Left (TextDecodingError
 -> Either TextDecodingError (ApiT ValidationLevel))
-> TextDecodingError
-> Either TextDecodingError (ApiT ValidationLevel)
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"I couldn't parse the given validation level."
            , String
"I am expecting one of the words 'required' or"
            , String
"'recommended'."]

data ApiPoolId
    = ApiPoolIdPlaceholder
    | ApiPoolId PoolId
    deriving (ApiPoolId -> ApiPoolId -> Bool
(ApiPoolId -> ApiPoolId -> Bool)
-> (ApiPoolId -> ApiPoolId -> Bool) -> Eq ApiPoolId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiPoolId -> ApiPoolId -> Bool
$c/= :: ApiPoolId -> ApiPoolId -> Bool
== :: ApiPoolId -> ApiPoolId -> Bool
$c== :: ApiPoolId -> ApiPoolId -> Bool
Eq, (forall x. ApiPoolId -> Rep ApiPoolId x)
-> (forall x. Rep ApiPoolId x -> ApiPoolId) -> Generic ApiPoolId
forall x. Rep ApiPoolId x -> ApiPoolId
forall x. ApiPoolId -> Rep ApiPoolId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiPoolId x -> ApiPoolId
$cfrom :: forall x. ApiPoolId -> Rep ApiPoolId x
Generic, Int -> ApiPoolId -> ShowS
[ApiPoolId] -> ShowS
ApiPoolId -> String
(Int -> ApiPoolId -> ShowS)
-> (ApiPoolId -> String)
-> ([ApiPoolId] -> ShowS)
-> Show ApiPoolId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiPoolId] -> ShowS
$cshowList :: [ApiPoolId] -> ShowS
show :: ApiPoolId -> String
$cshow :: ApiPoolId -> String
showsPrec :: Int -> ApiPoolId -> ShowS
$cshowsPrec :: Int -> ApiPoolId -> ShowS
Show)

instance FromText ApiAccountPublicKey where
    fromText :: Text -> Either TextDecodingError ApiAccountPublicKey
fromText Text
txt = case Text -> Maybe XPub
xpubFromText Text
txt of
        Maybe XPub
Nothing ->
            TextDecodingError -> Either TextDecodingError ApiAccountPublicKey
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError ApiAccountPublicKey)
-> TextDecodingError
-> Either TextDecodingError ApiAccountPublicKey
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"Invalid account public key: expecting a hex-encoded value"
            , String
"that is 64 bytes in length."]
        Just XPub
pubkey ->
            ApiAccountPublicKey -> Either TextDecodingError ApiAccountPublicKey
forall a b. b -> Either a b
Right (ApiAccountPublicKey
 -> Either TextDecodingError ApiAccountPublicKey)
-> ApiAccountPublicKey
-> Either TextDecodingError ApiAccountPublicKey
forall a b. (a -> b) -> a -> b
$ ApiT XPub -> ApiAccountPublicKey
ApiAccountPublicKey (ApiT XPub -> ApiAccountPublicKey)
-> ApiT XPub -> ApiAccountPublicKey
forall a b. (a -> b) -> a -> b
$ XPub -> ApiT XPub
forall a. a -> ApiT a
ApiT XPub
pubkey
      where
        xpubFromText :: Text -> Maybe XPub
        xpubFromText :: Text -> Maybe XPub
xpubFromText = (Either String ByteString -> Maybe ByteString)
-> (Text -> Either String ByteString) -> Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
eitherToMaybe Text -> Either String ByteString
fromHexText (Text -> Maybe ByteString)
-> (ByteString -> Maybe XPub) -> Text -> Maybe XPub
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Maybe XPub
xpubFromBytes

instance FromText (ApiT XPrv) where
    fromText :: Text -> Either TextDecodingError (ApiT XPrv)
fromText Text
t = case Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
t of
        Left String
_ ->
            Either TextDecodingError (ApiT XPrv)
forall b. Either TextDecodingError b
textDecodingError
        Right (ByteString
bytes :: ByteString) -> case ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
CC.xprv ByteString
bytes of
            Left String
_ -> Either TextDecodingError (ApiT XPrv)
forall b. Either TextDecodingError b
textDecodingError
            Right XPrv
val -> ApiT XPrv -> Either TextDecodingError (ApiT XPrv)
forall a b. b -> Either a b
Right (ApiT XPrv -> Either TextDecodingError (ApiT XPrv))
-> ApiT XPrv -> Either TextDecodingError (ApiT XPrv)
forall a b. (a -> b) -> a -> b
$ XPrv -> ApiT XPrv
forall a. a -> ApiT a
ApiT XPrv
val
      where
        textDecodingError :: Either TextDecodingError b
textDecodingError = TextDecodingError -> Either TextDecodingError b
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError b)
-> TextDecodingError -> Either TextDecodingError b
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"Invalid encrypted root private key:"
            , String
"expecting a hex-encoded value that is 128 "
            , String
"bytes in length."
            ]

instance {-# OVERLAPPING #-} Show (ApiT XPrv) where
    show :: ApiT XPrv -> String
show ApiT XPrv
_ = String
"<xprv>"

instance {-# OVERLAPPING #-} Eq (ApiT XPrv) where
    (ApiT XPrv
val1) == :: ApiT XPrv -> ApiT XPrv -> Bool
== (ApiT XPrv
val2) = XPrv -> ByteString
CC.unXPrv XPrv
val1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== XPrv -> ByteString
CC.unXPrv XPrv
val2

instance ToText (ApiT XPrv) where
    toText :: ApiT XPrv -> Text
toText = ByteString -> Text
T.decodeUtf8
        (ByteString -> Text)
-> (ApiT XPrv -> ByteString) -> ApiT XPrv -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16
        (ByteString -> ByteString)
-> (ApiT XPrv -> ByteString) -> ApiT XPrv -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> ByteString
CC.unXPrv
        (XPrv -> ByteString)
-> (ApiT XPrv -> XPrv) -> ApiT XPrv -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT XPrv -> XPrv
forall a. ApiT a -> a
getApiT

instance FromText (ApiT PassphraseHash)  where
    fromText :: Text -> Either TextDecodingError (ApiT PassphraseHash)
fromText Text
txt = case Base -> ByteString -> Either String ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 (ByteString -> Either String ScrubbedBytes)
-> ByteString -> Either String ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
txt of
        Right ScrubbedBytes
bytes -> ApiT PassphraseHash
-> Either TextDecodingError (ApiT PassphraseHash)
forall a b. b -> Either a b
Right (ApiT PassphraseHash
 -> Either TextDecodingError (ApiT PassphraseHash))
-> ApiT PassphraseHash
-> Either TextDecodingError (ApiT PassphraseHash)
forall a b. (a -> b) -> a -> b
$ PassphraseHash -> ApiT PassphraseHash
forall a. a -> ApiT a
ApiT (PassphraseHash -> ApiT PassphraseHash)
-> PassphraseHash -> ApiT PassphraseHash
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> PassphraseHash
PassphraseHash ScrubbedBytes
bytes
        Left String
_ -> Either TextDecodingError (ApiT PassphraseHash)
forall b. Either TextDecodingError b
textDecodingError
      where
        textDecodingError :: Either TextDecodingError b
textDecodingError = TextDecodingError -> Either TextDecodingError b
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError b)
-> TextDecodingError -> Either TextDecodingError b
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"Invalid encrypted passphrase:"
            , String
"expecting a hex-encoded value."
            ]

instance DecodeAddress n => FromHttpApiData (ApiT Address, Proxy n) where
    parseUrlPiece :: Text -> Either Text (ApiT Address, Proxy n)
parseUrlPiece Text
txt = do
        let proxy :: Proxy n
proxy = Proxy n
forall k (t :: k). Proxy t
Proxy @n
        ApiT Address
addr <- (TextDecodingError -> Text)
-> (Address -> ApiT Address)
-> Either TextDecodingError Address
-> Either Text (ApiT Address)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> Text
T.pack (String -> Text)
-> (TextDecodingError -> String) -> TextDecodingError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDecodingError -> String
getTextDecodingError) Address -> ApiT Address
forall a. a -> ApiT a
ApiT (Text -> Either TextDecodingError Address
forall (n :: NetworkDiscriminant).
DecodeAddress n =>
Text -> Either TextDecodingError Address
decodeAddress @n Text
txt)
        (ApiT Address, Proxy n) -> Either Text (ApiT Address, Proxy n)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiT Address
addr, Proxy n
proxy)

instance EncodeAddress n => ToHttpApiData (ApiT Address, Proxy n) where
    toUrlPiece :: (ApiT Address, Proxy n) -> Text
toUrlPiece = EncodeAddress n => Address -> Text
forall (n :: NetworkDiscriminant).
EncodeAddress n =>
Address -> Text
encodeAddress @n (Address -> Text)
-> ((ApiT Address, Proxy n) -> Address)
-> (ApiT Address, Proxy n)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT Address -> Address
forall a. ApiT a -> a
getApiT (ApiT Address -> Address)
-> ((ApiT Address, Proxy n) -> ApiT Address)
-> (ApiT Address, Proxy n)
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApiT Address, Proxy n) -> ApiT Address
forall a b. (a, b) -> a
fst

{-------------------------------------------------------------------------------
                              API Types: Byron
-------------------------------------------------------------------------------}

data ApiByronWallet = ApiByronWallet
    { ApiByronWallet -> ApiT WalletId
id :: !(ApiT WalletId)
    , ApiByronWallet -> ApiByronWalletBalance
balance :: !(ApiByronWalletBalance)
    , ApiByronWallet -> ApiWalletAssetsBalance
assets :: !ApiWalletAssetsBalance
    , ApiByronWallet -> ApiWalletDiscovery
discovery :: !ApiWalletDiscovery
    , ApiByronWallet -> ApiT WalletName
name :: !(ApiT WalletName)
    , ApiByronWallet -> Maybe ApiWalletPassphraseInfo
passphrase :: !(Maybe ApiWalletPassphraseInfo)
    , ApiByronWallet -> ApiT SyncProgress
state :: !(ApiT SyncProgress)
    , ApiByronWallet -> ApiBlockReference
tip :: !ApiBlockReference
    } deriving (ApiByronWallet -> ApiByronWallet -> Bool
(ApiByronWallet -> ApiByronWallet -> Bool)
-> (ApiByronWallet -> ApiByronWallet -> Bool) -> Eq ApiByronWallet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiByronWallet -> ApiByronWallet -> Bool
$c/= :: ApiByronWallet -> ApiByronWallet -> Bool
== :: ApiByronWallet -> ApiByronWallet -> Bool
$c== :: ApiByronWallet -> ApiByronWallet -> Bool
Eq, (forall x. ApiByronWallet -> Rep ApiByronWallet x)
-> (forall x. Rep ApiByronWallet x -> ApiByronWallet)
-> Generic ApiByronWallet
forall x. Rep ApiByronWallet x -> ApiByronWallet
forall x. ApiByronWallet -> Rep ApiByronWallet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiByronWallet x -> ApiByronWallet
$cfrom :: forall x. ApiByronWallet -> Rep ApiByronWallet x
Generic, Int -> ApiByronWallet -> ShowS
[ApiByronWallet] -> ShowS
ApiByronWallet -> String
(Int -> ApiByronWallet -> ShowS)
-> (ApiByronWallet -> String)
-> ([ApiByronWallet] -> ShowS)
-> Show ApiByronWallet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiByronWallet] -> ShowS
$cshowList :: [ApiByronWallet] -> ShowS
show :: ApiByronWallet -> String
$cshow :: ApiByronWallet -> String
showsPrec :: Int -> ApiByronWallet -> ShowS
$cshowsPrec :: Int -> ApiByronWallet -> ShowS
Show)
      deriving anyclass ApiByronWallet -> ()
(ApiByronWallet -> ()) -> NFData ApiByronWallet
forall a. (a -> ()) -> NFData a
rnf :: ApiByronWallet -> ()
$crnf :: ApiByronWallet -> ()
NFData

data ApiWalletDiscovery
    = DiscoveryRandom
    | DiscoverySequential
    deriving (ApiWalletDiscovery -> ApiWalletDiscovery -> Bool
(ApiWalletDiscovery -> ApiWalletDiscovery -> Bool)
-> (ApiWalletDiscovery -> ApiWalletDiscovery -> Bool)
-> Eq ApiWalletDiscovery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiWalletDiscovery -> ApiWalletDiscovery -> Bool
$c/= :: ApiWalletDiscovery -> ApiWalletDiscovery -> Bool
== :: ApiWalletDiscovery -> ApiWalletDiscovery -> Bool
$c== :: ApiWalletDiscovery -> ApiWalletDiscovery -> Bool
Eq, (forall x. ApiWalletDiscovery -> Rep ApiWalletDiscovery x)
-> (forall x. Rep ApiWalletDiscovery x -> ApiWalletDiscovery)
-> Generic ApiWalletDiscovery
forall x. Rep ApiWalletDiscovery x -> ApiWalletDiscovery
forall x. ApiWalletDiscovery -> Rep ApiWalletDiscovery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiWalletDiscovery x -> ApiWalletDiscovery
$cfrom :: forall x. ApiWalletDiscovery -> Rep ApiWalletDiscovery x
Generic, Int -> ApiWalletDiscovery -> ShowS
[ApiWalletDiscovery] -> ShowS
ApiWalletDiscovery -> String
(Int -> ApiWalletDiscovery -> ShowS)
-> (ApiWalletDiscovery -> String)
-> ([ApiWalletDiscovery] -> ShowS)
-> Show ApiWalletDiscovery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiWalletDiscovery] -> ShowS
$cshowList :: [ApiWalletDiscovery] -> ShowS
show :: ApiWalletDiscovery -> String
$cshow :: ApiWalletDiscovery -> String
showsPrec :: Int -> ApiWalletDiscovery -> ShowS
$cshowsPrec :: Int -> ApiWalletDiscovery -> ShowS
Show)
    deriving anyclass ApiWalletDiscovery -> ()
(ApiWalletDiscovery -> ()) -> NFData ApiWalletDiscovery
forall a. (a -> ()) -> NFData a
rnf :: ApiWalletDiscovery -> ()
$crnf :: ApiWalletDiscovery -> ()
NFData

class KnownDiscovery s where
    knownDiscovery :: ApiWalletDiscovery

instance KnownDiscovery (RndState network) where
    knownDiscovery :: ApiWalletDiscovery
knownDiscovery = ApiWalletDiscovery
DiscoveryRandom

instance KnownDiscovery (SeqState network key) where
    knownDiscovery :: ApiWalletDiscovery
knownDiscovery = ApiWalletDiscovery
DiscoverySequential

{-------------------------------------------------------------------------------
                              Polymorphic Types
-------------------------------------------------------------------------------}

-- | Polymorphic wrapper type to put around primitive types and, 3rd party lib
-- types to avoid defining orphan instances and/or, undesirable instances on
-- primitive types. It helps to keep a nice separation of concerns between the
-- API layer and other modules.
newtype ApiT a =
    ApiT { ApiT a -> a
getApiT :: a }
    deriving ((forall x. ApiT a -> Rep (ApiT a) x)
-> (forall x. Rep (ApiT a) x -> ApiT a) -> Generic (ApiT a)
forall x. Rep (ApiT a) x -> ApiT a
forall x. ApiT a -> Rep (ApiT a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ApiT a) x -> ApiT a
forall a x. ApiT a -> Rep (ApiT a) x
$cto :: forall a x. Rep (ApiT a) x -> ApiT a
$cfrom :: forall a x. ApiT a -> Rep (ApiT a) x
Generic, ApiT a -> ApiT a -> Bool
(ApiT a -> ApiT a -> Bool)
-> (ApiT a -> ApiT a -> Bool) -> Eq (ApiT a)
forall a. Eq a => ApiT a -> ApiT a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiT a -> ApiT a -> Bool
$c/= :: forall a. Eq a => ApiT a -> ApiT a -> Bool
== :: ApiT a -> ApiT a -> Bool
$c== :: forall a. Eq a => ApiT a -> ApiT a -> Bool
Eq, a -> ApiT b -> ApiT a
(a -> b) -> ApiT a -> ApiT b
(forall a b. (a -> b) -> ApiT a -> ApiT b)
-> (forall a b. a -> ApiT b -> ApiT a) -> Functor ApiT
forall a b. a -> ApiT b -> ApiT a
forall a b. (a -> b) -> ApiT a -> ApiT b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ApiT b -> ApiT a
$c<$ :: forall a b. a -> ApiT b -> ApiT a
fmap :: (a -> b) -> ApiT a -> ApiT b
$cfmap :: forall a b. (a -> b) -> ApiT a -> ApiT b
Functor)
    deriving newtype (b -> ApiT a -> ApiT a
NonEmpty (ApiT a) -> ApiT a
ApiT a -> ApiT a -> ApiT a
(ApiT a -> ApiT a -> ApiT a)
-> (NonEmpty (ApiT a) -> ApiT a)
-> (forall b. Integral b => b -> ApiT a -> ApiT a)
-> Semigroup (ApiT a)
forall b. Integral b => b -> ApiT a -> ApiT a
forall a. Semigroup a => NonEmpty (ApiT a) -> ApiT a
forall a. Semigroup a => ApiT a -> ApiT a -> ApiT a
forall a b. (Semigroup a, Integral b) => b -> ApiT a -> ApiT a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> ApiT a -> ApiT a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> ApiT a -> ApiT a
sconcat :: NonEmpty (ApiT a) -> ApiT a
$csconcat :: forall a. Semigroup a => NonEmpty (ApiT a) -> ApiT a
<> :: ApiT a -> ApiT a -> ApiT a
$c<> :: forall a. Semigroup a => ApiT a -> ApiT a -> ApiT a
Semigroup, Semigroup (ApiT a)
ApiT a
Semigroup (ApiT a)
-> ApiT a
-> (ApiT a -> ApiT a -> ApiT a)
-> ([ApiT a] -> ApiT a)
-> Monoid (ApiT a)
[ApiT a] -> ApiT a
ApiT a -> ApiT a -> ApiT a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (ApiT a)
forall a. Monoid a => ApiT a
forall a. Monoid a => [ApiT a] -> ApiT a
forall a. Monoid a => ApiT a -> ApiT a -> ApiT a
mconcat :: [ApiT a] -> ApiT a
$cmconcat :: forall a. Monoid a => [ApiT a] -> ApiT a
mappend :: ApiT a -> ApiT a -> ApiT a
$cmappend :: forall a. Monoid a => ApiT a -> ApiT a -> ApiT a
mempty :: ApiT a
$cmempty :: forall a. Monoid a => ApiT a
$cp1Monoid :: forall a. Monoid a => Semigroup (ApiT a)
Monoid, Int -> ApiT a -> Int
ApiT a -> Int
(Int -> ApiT a -> Int) -> (ApiT a -> Int) -> Hashable (ApiT a)
forall a. Hashable a => Int -> ApiT a -> Int
forall a. Hashable a => ApiT a -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ApiT a -> Int
$chash :: forall a. Hashable a => ApiT a -> Int
hashWithSalt :: Int -> ApiT a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> ApiT a -> Int
Hashable)
    deriving anyclass ApiT a -> ()
(ApiT a -> ()) -> NFData (ApiT a)
forall a. NFData a => ApiT a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ApiT a -> ()
$crnf :: forall a. NFData a => ApiT a -> ()
NFData
    deriving Int -> ApiT a -> ShowS
[ApiT a] -> ShowS
ApiT a -> String
(Int -> ApiT a -> ShowS)
-> (ApiT a -> String) -> ([ApiT a] -> ShowS) -> Show (ApiT a)
forall a. Show a => Int -> ApiT a -> ShowS
forall a. Show a => [ApiT a] -> ShowS
forall a. Show a => ApiT a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiT a] -> ShowS
$cshowList :: forall a. Show a => [ApiT a] -> ShowS
show :: ApiT a -> String
$cshow :: forall a. Show a => ApiT a -> String
showsPrec :: Int -> ApiT a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ApiT a -> ShowS
Show via (Quiet (ApiT a))
deriving instance Ord a => Ord (ApiT a)

-- | Polymorphic wrapper for byte arrays, parameterised by the desired string
-- encoding.
newtype ApiBytesT (base :: Base) bs = ApiBytesT { ApiBytesT base bs -> bs
getApiBytesT :: bs }
    deriving ((forall x. ApiBytesT base bs -> Rep (ApiBytesT base bs) x)
-> (forall x. Rep (ApiBytesT base bs) x -> ApiBytesT base bs)
-> Generic (ApiBytesT base bs)
forall x. Rep (ApiBytesT base bs) x -> ApiBytesT base bs
forall x. ApiBytesT base bs -> Rep (ApiBytesT base bs) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (base :: Base) bs x.
Rep (ApiBytesT base bs) x -> ApiBytesT base bs
forall (base :: Base) bs x.
ApiBytesT base bs -> Rep (ApiBytesT base bs) x
$cto :: forall (base :: Base) bs x.
Rep (ApiBytesT base bs) x -> ApiBytesT base bs
$cfrom :: forall (base :: Base) bs x.
ApiBytesT base bs -> Rep (ApiBytesT base bs) x
Generic, ApiBytesT base bs -> ApiBytesT base bs -> Bool
(ApiBytesT base bs -> ApiBytesT base bs -> Bool)
-> (ApiBytesT base bs -> ApiBytesT base bs -> Bool)
-> Eq (ApiBytesT base bs)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (base :: Base) bs.
Eq bs =>
ApiBytesT base bs -> ApiBytesT base bs -> Bool
/= :: ApiBytesT base bs -> ApiBytesT base bs -> Bool
$c/= :: forall (base :: Base) bs.
Eq bs =>
ApiBytesT base bs -> ApiBytesT base bs -> Bool
== :: ApiBytesT base bs -> ApiBytesT base bs -> Bool
$c== :: forall (base :: Base) bs.
Eq bs =>
ApiBytesT base bs -> ApiBytesT base bs -> Bool
Eq, a -> ApiBytesT base b -> ApiBytesT base a
(a -> b) -> ApiBytesT base a -> ApiBytesT base b
(forall a b. (a -> b) -> ApiBytesT base a -> ApiBytesT base b)
-> (forall a b. a -> ApiBytesT base b -> ApiBytesT base a)
-> Functor (ApiBytesT base)
forall a b. a -> ApiBytesT base b -> ApiBytesT base a
forall a b. (a -> b) -> ApiBytesT base a -> ApiBytesT base b
forall (base :: Base) a b.
a -> ApiBytesT base b -> ApiBytesT base a
forall (base :: Base) a b.
(a -> b) -> ApiBytesT base a -> ApiBytesT base b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ApiBytesT base b -> ApiBytesT base a
$c<$ :: forall (base :: Base) a b.
a -> ApiBytesT base b -> ApiBytesT base a
fmap :: (a -> b) -> ApiBytesT base a -> ApiBytesT base b
$cfmap :: forall (base :: Base) a b.
(a -> b) -> ApiBytesT base a -> ApiBytesT base b
Functor)
    deriving newtype (b -> ApiBytesT base bs -> ApiBytesT base bs
NonEmpty (ApiBytesT base bs) -> ApiBytesT base bs
ApiBytesT base bs -> ApiBytesT base bs -> ApiBytesT base bs
(ApiBytesT base bs -> ApiBytesT base bs -> ApiBytesT base bs)
-> (NonEmpty (ApiBytesT base bs) -> ApiBytesT base bs)
-> (forall b.
    Integral b =>
    b -> ApiBytesT base bs -> ApiBytesT base bs)
-> Semigroup (ApiBytesT base bs)
forall b. Integral b => b -> ApiBytesT base bs -> ApiBytesT base bs
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (base :: Base) bs.
Semigroup bs =>
NonEmpty (ApiBytesT base bs) -> ApiBytesT base bs
forall (base :: Base) bs.
Semigroup bs =>
ApiBytesT base bs -> ApiBytesT base bs -> ApiBytesT base bs
forall (base :: Base) bs b.
(Semigroup bs, Integral b) =>
b -> ApiBytesT base bs -> ApiBytesT base bs
stimes :: b -> ApiBytesT base bs -> ApiBytesT base bs
$cstimes :: forall (base :: Base) bs b.
(Semigroup bs, Integral b) =>
b -> ApiBytesT base bs -> ApiBytesT base bs
sconcat :: NonEmpty (ApiBytesT base bs) -> ApiBytesT base bs
$csconcat :: forall (base :: Base) bs.
Semigroup bs =>
NonEmpty (ApiBytesT base bs) -> ApiBytesT base bs
<> :: ApiBytesT base bs -> ApiBytesT base bs -> ApiBytesT base bs
$c<> :: forall (base :: Base) bs.
Semigroup bs =>
ApiBytesT base bs -> ApiBytesT base bs -> ApiBytesT base bs
Semigroup, Semigroup (ApiBytesT base bs)
ApiBytesT base bs
Semigroup (ApiBytesT base bs)
-> ApiBytesT base bs
-> (ApiBytesT base bs -> ApiBytesT base bs -> ApiBytesT base bs)
-> ([ApiBytesT base bs] -> ApiBytesT base bs)
-> Monoid (ApiBytesT base bs)
[ApiBytesT base bs] -> ApiBytesT base bs
ApiBytesT base bs -> ApiBytesT base bs -> ApiBytesT base bs
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (base :: Base) bs.
Monoid bs =>
Semigroup (ApiBytesT base bs)
forall (base :: Base) bs. Monoid bs => ApiBytesT base bs
forall (base :: Base) bs.
Monoid bs =>
[ApiBytesT base bs] -> ApiBytesT base bs
forall (base :: Base) bs.
Monoid bs =>
ApiBytesT base bs -> ApiBytesT base bs -> ApiBytesT base bs
mconcat :: [ApiBytesT base bs] -> ApiBytesT base bs
$cmconcat :: forall (base :: Base) bs.
Monoid bs =>
[ApiBytesT base bs] -> ApiBytesT base bs
mappend :: ApiBytesT base bs -> ApiBytesT base bs -> ApiBytesT base bs
$cmappend :: forall (base :: Base) bs.
Monoid bs =>
ApiBytesT base bs -> ApiBytesT base bs -> ApiBytesT base bs
mempty :: ApiBytesT base bs
$cmempty :: forall (base :: Base) bs. Monoid bs => ApiBytesT base bs
$cp1Monoid :: forall (base :: Base) bs.
Monoid bs =>
Semigroup (ApiBytesT base bs)
Monoid, Int -> ApiBytesT base bs -> Int
ApiBytesT base bs -> Int
(Int -> ApiBytesT base bs -> Int)
-> (ApiBytesT base bs -> Int) -> Hashable (ApiBytesT base bs)
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (base :: Base) bs.
Hashable bs =>
Int -> ApiBytesT base bs -> Int
forall (base :: Base) bs. Hashable bs => ApiBytesT base bs -> Int
hash :: ApiBytesT base bs -> Int
$chash :: forall (base :: Base) bs. Hashable bs => ApiBytesT base bs -> Int
hashWithSalt :: Int -> ApiBytesT base bs -> Int
$chashWithSalt :: forall (base :: Base) bs.
Hashable bs =>
Int -> ApiBytesT base bs -> Int
Hashable)
    deriving anyclass ApiBytesT base bs -> ()
(ApiBytesT base bs -> ()) -> NFData (ApiBytesT base bs)
forall a. (a -> ()) -> NFData a
forall (base :: Base) bs. NFData bs => ApiBytesT base bs -> ()
rnf :: ApiBytesT base bs -> ()
$crnf :: forall (base :: Base) bs. NFData bs => ApiBytesT base bs -> ()
NFData
    deriving Int -> ApiBytesT base bs -> ShowS
[ApiBytesT base bs] -> ShowS
ApiBytesT base bs -> String
(Int -> ApiBytesT base bs -> ShowS)
-> (ApiBytesT base bs -> String)
-> ([ApiBytesT base bs] -> ShowS)
-> Show (ApiBytesT base bs)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (base :: Base) bs.
Show bs =>
Int -> ApiBytesT base bs -> ShowS
forall (base :: Base) bs. Show bs => [ApiBytesT base bs] -> ShowS
forall (base :: Base) bs. Show bs => ApiBytesT base bs -> String
showList :: [ApiBytesT base bs] -> ShowS
$cshowList :: forall (base :: Base) bs. Show bs => [ApiBytesT base bs] -> ShowS
show :: ApiBytesT base bs -> String
$cshow :: forall (base :: Base) bs. Show bs => ApiBytesT base bs -> String
showsPrec :: Int -> ApiBytesT base bs -> ShowS
$cshowsPrec :: forall (base :: Base) bs.
Show bs =>
Int -> ApiBytesT base bs -> ShowS
Show via (Quiet (ApiBytesT base bs))

-- | Representation of mnemonics at the API-level, using a polymorphic type in
-- the lengths of mnemonics that are supported (and an underlying purpose). In
-- practice, mnemonics correspond to passphrases or seeds, and although they're
-- nice to manipulate as mnemonics from a user-perspective, carrying around a
-- list of words doesn't really make sense for the business logic, which prefers
-- manipulating scrubbed bytes directly.
--
-- @
-- data MyWallet
--     { mnemonic :: ApiMnemonicT '[15,18,21,24]
--     }
-- @
--
-- Note that the given 'Nat's **have** to be valid mnemonic sizes, otherwise the
-- underlying code won't even compile, with not-so-friendly error messages.
--
-- Also, the internal representation holds a @[Text]@ which contains the list of
-- mnemonic words that was parsed. This is only to be able to implement the
-- 'ToJSON' instances and roundtrip, which is a very dubious argument. In
-- practice, we'll NEVER peek at the mnemonic, output them and whatnot.
newtype ApiMnemonicT (sizes :: [Nat]) =
    ApiMnemonicT { ApiMnemonicT sizes -> SomeMnemonic
getApiMnemonicT :: SomeMnemonic }
    deriving ((forall x. ApiMnemonicT sizes -> Rep (ApiMnemonicT sizes) x)
-> (forall x. Rep (ApiMnemonicT sizes) x -> ApiMnemonicT sizes)
-> Generic (ApiMnemonicT sizes)
forall (sizes :: [Nat]) x.
Rep (ApiMnemonicT sizes) x -> ApiMnemonicT sizes
forall (sizes :: [Nat]) x.
ApiMnemonicT sizes -> Rep (ApiMnemonicT sizes) x
forall x. Rep (ApiMnemonicT sizes) x -> ApiMnemonicT sizes
forall x. ApiMnemonicT sizes -> Rep (ApiMnemonicT sizes) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (sizes :: [Nat]) x.
Rep (ApiMnemonicT sizes) x -> ApiMnemonicT sizes
$cfrom :: forall (sizes :: [Nat]) x.
ApiMnemonicT sizes -> Rep (ApiMnemonicT sizes) x
Generic, ApiMnemonicT sizes -> ApiMnemonicT sizes -> Bool
(ApiMnemonicT sizes -> ApiMnemonicT sizes -> Bool)
-> (ApiMnemonicT sizes -> ApiMnemonicT sizes -> Bool)
-> Eq (ApiMnemonicT sizes)
forall (sizes :: [Nat]).
ApiMnemonicT sizes -> ApiMnemonicT sizes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiMnemonicT sizes -> ApiMnemonicT sizes -> Bool
$c/= :: forall (sizes :: [Nat]).
ApiMnemonicT sizes -> ApiMnemonicT sizes -> Bool
== :: ApiMnemonicT sizes -> ApiMnemonicT sizes -> Bool
$c== :: forall (sizes :: [Nat]).
ApiMnemonicT sizes -> ApiMnemonicT sizes -> Bool
Eq)
    deriving newtype ApiMnemonicT sizes -> ()
(ApiMnemonicT sizes -> ()) -> NFData (ApiMnemonicT sizes)
forall (sizes :: [Nat]). ApiMnemonicT sizes -> ()
forall a. (a -> ()) -> NFData a
rnf :: ApiMnemonicT sizes -> ()
$crnf :: forall (sizes :: [Nat]). ApiMnemonicT sizes -> ()
NFData
    deriving Int -> ApiMnemonicT sizes -> ShowS
[ApiMnemonicT sizes] -> ShowS
ApiMnemonicT sizes -> String
(Int -> ApiMnemonicT sizes -> ShowS)
-> (ApiMnemonicT sizes -> String)
-> ([ApiMnemonicT sizes] -> ShowS)
-> Show (ApiMnemonicT sizes)
forall (sizes :: [Nat]). Int -> ApiMnemonicT sizes -> ShowS
forall (sizes :: [Nat]). [ApiMnemonicT sizes] -> ShowS
forall (sizes :: [Nat]). ApiMnemonicT sizes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiMnemonicT sizes] -> ShowS
$cshowList :: forall (sizes :: [Nat]). [ApiMnemonicT sizes] -> ShowS
show :: ApiMnemonicT sizes -> String
$cshow :: forall (sizes :: [Nat]). ApiMnemonicT sizes -> String
showsPrec :: Int -> ApiMnemonicT sizes -> ShowS
$cshowsPrec :: forall (sizes :: [Nat]). Int -> ApiMnemonicT sizes -> ShowS
Show via (Quiet (ApiMnemonicT sizes))

-- | A stake key belonging to the current wallet.
data ApiOurStakeKey (n :: NetworkDiscriminant) = ApiOurStakeKey
     { ApiOurStakeKey n -> Natural
_index :: !Natural
    , ApiOurStakeKey n -> (ApiT RewardAccount, Proxy n)
_key :: !(ApiT W.RewardAccount, Proxy n)
    , ApiOurStakeKey n -> Quantity "lovelace" Natural
_stake :: !(Quantity "lovelace" Natural)
      -- ^ The total ada this stake key controls / is associated with. This
      -- also includes the reward balance.
    , ApiOurStakeKey n -> Quantity "lovelace" Natural
_rewardBalance :: !(Quantity "lovelace" Natural)
      -- ^ The current reward balance (not lifetime).
    , ApiOurStakeKey n -> ApiWalletDelegation
_delegation :: !ApiWalletDelegation
      -- ^ The delegation of this stake key
    } deriving ((forall x. ApiOurStakeKey n -> Rep (ApiOurStakeKey n) x)
-> (forall x. Rep (ApiOurStakeKey n) x -> ApiOurStakeKey n)
-> Generic (ApiOurStakeKey n)
forall x. Rep (ApiOurStakeKey n) x -> ApiOurStakeKey n
forall x. ApiOurStakeKey n -> Rep (ApiOurStakeKey n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiOurStakeKey n) x -> ApiOurStakeKey n
forall (n :: NetworkDiscriminant) x.
ApiOurStakeKey n -> Rep (ApiOurStakeKey n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiOurStakeKey n) x -> ApiOurStakeKey n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiOurStakeKey n -> Rep (ApiOurStakeKey n) x
Generic, ApiOurStakeKey n -> ApiOurStakeKey n -> Bool
(ApiOurStakeKey n -> ApiOurStakeKey n -> Bool)
-> (ApiOurStakeKey n -> ApiOurStakeKey n -> Bool)
-> Eq (ApiOurStakeKey n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiOurStakeKey n -> ApiOurStakeKey n -> Bool
/= :: ApiOurStakeKey n -> ApiOurStakeKey n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiOurStakeKey n -> ApiOurStakeKey n -> Bool
== :: ApiOurStakeKey n -> ApiOurStakeKey n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiOurStakeKey n -> ApiOurStakeKey n -> Bool
Eq, Int -> ApiOurStakeKey n -> ShowS
[ApiOurStakeKey n] -> ShowS
ApiOurStakeKey n -> String
(Int -> ApiOurStakeKey n -> ShowS)
-> (ApiOurStakeKey n -> String)
-> ([ApiOurStakeKey n] -> ShowS)
-> Show (ApiOurStakeKey n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant). Int -> ApiOurStakeKey n -> ShowS
forall (n :: NetworkDiscriminant). [ApiOurStakeKey n] -> ShowS
forall (n :: NetworkDiscriminant). ApiOurStakeKey n -> String
showList :: [ApiOurStakeKey n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiOurStakeKey n] -> ShowS
show :: ApiOurStakeKey n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiOurStakeKey n -> String
showsPrec :: Int -> ApiOurStakeKey n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant). Int -> ApiOurStakeKey n -> ShowS
Show)

-- | A stake key found in the wallet UTxO, but which isn't ours.
--
-- We /could/ provide the current delegation status for foreign stake
-- keys.
data ApiForeignStakeKey (n :: NetworkDiscriminant) = ApiForeignStakeKey
    { ApiForeignStakeKey n -> (ApiT RewardAccount, Proxy n)
_key :: !(ApiT W.RewardAccount, Proxy n)
    , ApiForeignStakeKey n -> Quantity "lovelace" Natural
_stake :: !(Quantity "lovelace" Natural)
      -- ^ The total ada this stake key controls / is associated with. This
      -- also includes the reward balance.
    , ApiForeignStakeKey n -> Quantity "lovelace" Natural
_rewardBalance :: !(Quantity "lovelace" Natural)
      -- ^ The current reward balance (not lifetime).
    } deriving ((forall x. ApiForeignStakeKey n -> Rep (ApiForeignStakeKey n) x)
-> (forall x. Rep (ApiForeignStakeKey n) x -> ApiForeignStakeKey n)
-> Generic (ApiForeignStakeKey n)
forall x. Rep (ApiForeignStakeKey n) x -> ApiForeignStakeKey n
forall x. ApiForeignStakeKey n -> Rep (ApiForeignStakeKey n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiForeignStakeKey n) x -> ApiForeignStakeKey n
forall (n :: NetworkDiscriminant) x.
ApiForeignStakeKey n -> Rep (ApiForeignStakeKey n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiForeignStakeKey n) x -> ApiForeignStakeKey n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiForeignStakeKey n -> Rep (ApiForeignStakeKey n) x
Generic, ApiForeignStakeKey n -> ApiForeignStakeKey n -> Bool
(ApiForeignStakeKey n -> ApiForeignStakeKey n -> Bool)
-> (ApiForeignStakeKey n -> ApiForeignStakeKey n -> Bool)
-> Eq (ApiForeignStakeKey n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiForeignStakeKey n -> ApiForeignStakeKey n -> Bool
/= :: ApiForeignStakeKey n -> ApiForeignStakeKey n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiForeignStakeKey n -> ApiForeignStakeKey n -> Bool
== :: ApiForeignStakeKey n -> ApiForeignStakeKey n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiForeignStakeKey n -> ApiForeignStakeKey n -> Bool
Eq, Int -> ApiForeignStakeKey n -> ShowS
[ApiForeignStakeKey n] -> ShowS
ApiForeignStakeKey n -> String
(Int -> ApiForeignStakeKey n -> ShowS)
-> (ApiForeignStakeKey n -> String)
-> ([ApiForeignStakeKey n] -> ShowS)
-> Show (ApiForeignStakeKey n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiForeignStakeKey n -> ShowS
forall (n :: NetworkDiscriminant). [ApiForeignStakeKey n] -> ShowS
forall (n :: NetworkDiscriminant). ApiForeignStakeKey n -> String
showList :: [ApiForeignStakeKey n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiForeignStakeKey n] -> ShowS
show :: ApiForeignStakeKey n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiForeignStakeKey n -> String
showsPrec :: Int -> ApiForeignStakeKey n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiForeignStakeKey n -> ShowS
Show)

-- | For describing how much stake is associated with no stake key.
newtype ApiNullStakeKey = ApiNullStakeKey
    { ApiNullStakeKey -> Quantity "lovelace" Natural
_stake :: Quantity "lovelace" Natural
      -- ^ The total stake of the wallet UTxO that is not associated with a
      -- stake key, because it's part of an enterprise address.
    }
    deriving ((forall x. ApiNullStakeKey -> Rep ApiNullStakeKey x)
-> (forall x. Rep ApiNullStakeKey x -> ApiNullStakeKey)
-> Generic ApiNullStakeKey
forall x. Rep ApiNullStakeKey x -> ApiNullStakeKey
forall x. ApiNullStakeKey -> Rep ApiNullStakeKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiNullStakeKey x -> ApiNullStakeKey
$cfrom :: forall x. ApiNullStakeKey -> Rep ApiNullStakeKey x
Generic, ApiNullStakeKey -> ApiNullStakeKey -> Bool
(ApiNullStakeKey -> ApiNullStakeKey -> Bool)
-> (ApiNullStakeKey -> ApiNullStakeKey -> Bool)
-> Eq ApiNullStakeKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiNullStakeKey -> ApiNullStakeKey -> Bool
$c/= :: ApiNullStakeKey -> ApiNullStakeKey -> Bool
== :: ApiNullStakeKey -> ApiNullStakeKey -> Bool
$c== :: ApiNullStakeKey -> ApiNullStakeKey -> Bool
Eq)
    deriving Int -> ApiNullStakeKey -> ShowS
[ApiNullStakeKey] -> ShowS
ApiNullStakeKey -> String
(Int -> ApiNullStakeKey -> ShowS)
-> (ApiNullStakeKey -> String)
-> ([ApiNullStakeKey] -> ShowS)
-> Show ApiNullStakeKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiNullStakeKey] -> ShowS
$cshowList :: [ApiNullStakeKey] -> ShowS
show :: ApiNullStakeKey -> String
$cshow :: ApiNullStakeKey -> String
showsPrec :: Int -> ApiNullStakeKey -> ShowS
$cshowsPrec :: Int -> ApiNullStakeKey -> ShowS
Show via (Quiet ApiNullStakeKey)

-- | Collection of stake keys associated with a wallet.
data ApiStakeKeys (n :: NetworkDiscriminant) = ApiStakeKeys
    { ApiStakeKeys n -> [ApiOurStakeKey n]
_ours :: ![ApiOurStakeKey n]
    , ApiStakeKeys n -> [ApiForeignStakeKey n]
_foreign :: ![ApiForeignStakeKey n]
    , ApiStakeKeys n -> ApiNullStakeKey
_none :: !ApiNullStakeKey
    } deriving ((forall x. ApiStakeKeys n -> Rep (ApiStakeKeys n) x)
-> (forall x. Rep (ApiStakeKeys n) x -> ApiStakeKeys n)
-> Generic (ApiStakeKeys n)
forall x. Rep (ApiStakeKeys n) x -> ApiStakeKeys n
forall x. ApiStakeKeys n -> Rep (ApiStakeKeys n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiStakeKeys n) x -> ApiStakeKeys n
forall (n :: NetworkDiscriminant) x.
ApiStakeKeys n -> Rep (ApiStakeKeys n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiStakeKeys n) x -> ApiStakeKeys n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiStakeKeys n -> Rep (ApiStakeKeys n) x
Generic, ApiStakeKeys n -> ApiStakeKeys n -> Bool
(ApiStakeKeys n -> ApiStakeKeys n -> Bool)
-> (ApiStakeKeys n -> ApiStakeKeys n -> Bool)
-> Eq (ApiStakeKeys n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiStakeKeys n -> ApiStakeKeys n -> Bool
/= :: ApiStakeKeys n -> ApiStakeKeys n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiStakeKeys n -> ApiStakeKeys n -> Bool
== :: ApiStakeKeys n -> ApiStakeKeys n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiStakeKeys n -> ApiStakeKeys n -> Bool
Eq, Int -> ApiStakeKeys n -> ShowS
[ApiStakeKeys n] -> ShowS
ApiStakeKeys n -> String
(Int -> ApiStakeKeys n -> ShowS)
-> (ApiStakeKeys n -> String)
-> ([ApiStakeKeys n] -> ShowS)
-> Show (ApiStakeKeys n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant). Int -> ApiStakeKeys n -> ShowS
forall (n :: NetworkDiscriminant). [ApiStakeKeys n] -> ShowS
forall (n :: NetworkDiscriminant). ApiStakeKeys n -> String
showList :: [ApiStakeKeys n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiStakeKeys n] -> ShowS
show :: ApiStakeKeys n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiStakeKeys n -> String
showsPrec :: Int -> ApiStakeKeys n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant). Int -> ApiStakeKeys n -> ShowS
Show)

{-------------------------------------------------------------------------------
                               JSON Instances
-------------------------------------------------------------------------------}

instance DecodeAddress n => FromJSON (ApiAddress n) where
    parseJSON :: Value -> Parser (ApiAddress n)
parseJSON = Options -> Value -> Parser (ApiAddress n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress n => ToJSON (ApiAddress n) where
    toJSON :: ApiAddress n -> Value
toJSON = Options -> ApiAddress n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiMetadataError where
    parseJSON :: Value -> Parser ApiMetadataError
parseJSON = Options -> Value -> Parser ApiMetadataError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultSumTypeOptions
instance ToJSON ApiMetadataError where
    toJSON :: ApiMetadataError -> Value
toJSON = Options -> ApiMetadataError -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultSumTypeOptions

instance FromJSON ApiAsset where
    parseJSON :: Value -> Parser ApiAsset
parseJSON = Options -> Value -> Parser ApiAsset
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiAsset where
    toJSON :: ApiAsset -> Value
toJSON = Options -> ApiAsset -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeStakeAddress n => FromJSON (ApiOurStakeKey n) where
    parseJSON :: Value -> Parser (ApiOurStakeKey n)
parseJSON = Options -> Value -> Parser (ApiOurStakeKey n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeStakeAddress n => ToJSON (ApiOurStakeKey n) where
    toJSON :: ApiOurStakeKey n -> Value
toJSON = Options -> ApiOurStakeKey n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeStakeAddress n => FromJSON (ApiForeignStakeKey n) where
    parseJSON :: Value -> Parser (ApiForeignStakeKey n)
parseJSON = Options -> Value -> Parser (ApiForeignStakeKey n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeStakeAddress n => ToJSON (ApiForeignStakeKey n) where
    toJSON :: ApiForeignStakeKey n -> Value
toJSON = Options -> ApiForeignStakeKey n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiNullStakeKey where
    parseJSON :: Value -> Parser ApiNullStakeKey
parseJSON = Options -> Value -> Parser ApiNullStakeKey
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiNullStakeKey where
    toJSON :: ApiNullStakeKey -> Value
toJSON = Options -> ApiNullStakeKey -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeStakeAddress n => FromJSON (ApiStakeKeys n) where
    parseJSON :: Value -> Parser (ApiStakeKeys n)
parseJSON = Options -> Value -> Parser (ApiStakeKeys n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeStakeAddress n => ToJSON (ApiStakeKeys n) where
    toJSON :: ApiStakeKeys n -> Value
toJSON = Options -> ApiStakeKeys n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiPostPolicyIdData where
    parseJSON :: Value -> Parser ApiPostPolicyIdData
parseJSON = Options -> Value -> Parser ApiPostPolicyIdData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiPostPolicyIdData where
    toJSON :: ApiPostPolicyIdData -> Value
toJSON = Options -> ApiPostPolicyIdData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiPolicyId where
    parseJSON :: Value -> Parser ApiPolicyId
parseJSON = Options -> Value -> Parser ApiPolicyId
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiPolicyId where
    toJSON :: ApiPolicyId -> Value
toJSON = Options -> ApiPolicyId -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON (ApiT W.TokenPolicyId) where
    parseJSON :: Value -> Parser (ApiT TokenPolicyId)
parseJSON = String -> Value -> Parser (ApiT TokenPolicyId)
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"PolicyId"
instance ToJSON (ApiT W.TokenPolicyId) where
    toJSON :: ApiT TokenPolicyId -> Value
toJSON = ApiT TokenPolicyId -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON (ApiT W.TokenName) where
    parseJSON :: Value -> Parser (ApiT TokenName)
parseJSON = String
-> (Text -> Parser (ApiT TokenName))
-> Value
-> Parser (ApiT TokenName)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"AssetName"
        ((ByteString -> ApiT TokenName)
-> Parser ByteString -> Parser (ApiT TokenName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TokenName -> ApiT TokenName
forall a. a -> ApiT a
ApiT (TokenName -> ApiT TokenName)
-> (ByteString -> TokenName) -> ByteString -> ApiT TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> TokenName
W.UnsafeTokenName) (Parser ByteString -> Parser (ApiT TokenName))
-> (Text -> Parser ByteString) -> Text -> Parser (ApiT TokenName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String ByteString -> Parser ByteString
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either String ByteString -> Parser ByteString)
-> (Text -> Either String ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String ByteString
fromHexText)
instance ToJSON (ApiT W.TokenName) where
    toJSON :: ApiT TokenName -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (ApiT TokenName -> Text) -> ApiT TokenName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
hexText (ByteString -> Text)
-> (ApiT TokenName -> ByteString) -> ApiT TokenName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenName -> ByteString
W.unTokenName (TokenName -> ByteString)
-> (ApiT TokenName -> TokenName) -> ApiT TokenName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT TokenName -> TokenName
forall a. ApiT a -> a
getApiT

instance FromJSON (ApiT W.TokenFingerprint) where
    parseJSON :: Value -> Parser (ApiT TokenFingerprint)
parseJSON = String -> Value -> Parser (ApiT TokenFingerprint)
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"TokenFingerprint"
instance ToJSON (ApiT W.TokenFingerprint) where
    toJSON :: ApiT TokenFingerprint -> Value
toJSON = ApiT TokenFingerprint -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON ApiAssetMetadata where
    parseJSON :: Value -> Parser ApiAssetMetadata
parseJSON = Options -> Value -> Parser ApiAssetMetadata
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiAssetMetadata where
    toJSON :: ApiAssetMetadata -> Value
toJSON = Options -> ApiAssetMetadata -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON (ApiT W.AssetURL) where
    parseJSON :: Value -> Parser (ApiT AssetURL)
parseJSON Value
value = Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value Parser Text
-> (Text -> Parser (ApiT AssetURL)) -> Parser (ApiT AssetURL)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Parser (ApiT AssetURL))
-> (AssetURL -> Parser (ApiT AssetURL))
-> Either String AssetURL
-> Parser (ApiT AssetURL)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (ApiT AssetURL)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ApiT AssetURL -> Parser (ApiT AssetURL)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiT AssetURL -> Parser (ApiT AssetURL))
-> (AssetURL -> ApiT AssetURL)
-> AssetURL
-> Parser (ApiT AssetURL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetURL -> ApiT AssetURL
forall a. a -> ApiT a
ApiT) (Either String AssetURL -> Parser (ApiT AssetURL))
-> (Text -> Either String AssetURL)
-> Text
-> Parser (ApiT AssetURL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String AssetURL
W.validateMetadataURL
instance ToJSON (ApiT W.AssetURL) where
    toJSON :: ApiT AssetURL -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value)
-> (ApiT AssetURL -> String) -> ApiT AssetURL -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show (URI -> String)
-> (ApiT AssetURL -> URI) -> ApiT AssetURL -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetURL -> URI
W.unAssetURL (AssetURL -> URI)
-> (ApiT AssetURL -> AssetURL) -> ApiT AssetURL -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT AssetURL -> AssetURL
forall a. ApiT a -> a
getApiT

-- TODO: clean up duplication with TokenMetadata
instance FromJSON (ApiT W.AssetLogo) where
    parseJSON :: Value -> Parser (ApiT AssetLogo)
parseJSON = String
-> (Text -> Parser (ApiT AssetLogo))
-> Value
-> Parser (ApiT AssetLogo)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"base64 bytestring" ((Text -> Parser (ApiT AssetLogo))
 -> Value -> Parser (ApiT AssetLogo))
-> (Text -> Parser (ApiT AssetLogo))
-> Value
-> Parser (ApiT AssetLogo)
forall a b. (a -> b) -> a -> b
$
        (String -> Parser (ApiT AssetLogo))
-> (ByteString -> Parser (ApiT AssetLogo))
-> Either String ByteString
-> Parser (ApiT AssetLogo)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (ApiT AssetLogo)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ApiT AssetLogo -> Parser (ApiT AssetLogo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiT AssetLogo -> Parser (ApiT AssetLogo))
-> (ByteString -> ApiT AssetLogo)
-> ByteString
-> Parser (ApiT AssetLogo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetLogo -> ApiT AssetLogo
forall a. a -> ApiT a
ApiT (AssetLogo -> ApiT AssetLogo)
-> (ByteString -> AssetLogo) -> ByteString -> ApiT AssetLogo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AssetLogo
W.AssetLogo) (Either String ByteString -> Parser (ApiT AssetLogo))
-> (Text -> Either String ByteString)
-> Text
-> Parser (ApiT AssetLogo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base64 (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
instance ToJSON (ApiT W.AssetLogo) where
    toJSON :: ApiT AssetLogo -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value)
-> (ApiT AssetLogo -> String) -> ApiT AssetLogo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B8.unpack (ByteString -> String)
-> (ApiT AssetLogo -> ByteString) -> ApiT AssetLogo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base64 (ByteString -> ByteString)
-> (ApiT AssetLogo -> ByteString) -> ApiT AssetLogo -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetLogo -> ByteString
W.unAssetLogo (AssetLogo -> ByteString)
-> (ApiT AssetLogo -> AssetLogo) -> ApiT AssetLogo -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT AssetLogo -> AssetLogo
forall a. ApiT a -> a
getApiT

instance FromJSON (ApiT W.AssetDecimals) where
    parseJSON :: Value -> Parser (ApiT AssetDecimals)
parseJSON = Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Int)
-> (Int -> Parser (ApiT AssetDecimals))
-> Value
-> Parser (ApiT AssetDecimals)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ApiT AssetDecimals -> Parser (ApiT AssetDecimals)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiT AssetDecimals -> Parser (ApiT AssetDecimals))
-> (Int -> ApiT AssetDecimals)
-> Int
-> Parser (ApiT AssetDecimals)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetDecimals -> ApiT AssetDecimals
forall a. a -> ApiT a
ApiT (AssetDecimals -> ApiT AssetDecimals)
-> (Int -> AssetDecimals) -> Int -> ApiT AssetDecimals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AssetDecimals
W.AssetDecimals)
instance ToJSON (ApiT W.AssetDecimals) where
    toJSON :: ApiT AssetDecimals -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value)
-> (ApiT AssetDecimals -> Int) -> ApiT AssetDecimals -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetDecimals -> Int
W.unAssetDecimals (AssetDecimals -> Int)
-> (ApiT AssetDecimals -> AssetDecimals)
-> ApiT AssetDecimals
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT AssetDecimals -> AssetDecimals
forall a. ApiT a -> a
getApiT

instance ToJSON (ApiT DerivationIndex) where
    toJSON :: ApiT DerivationIndex -> Value
toJSON = ApiT DerivationIndex -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON
instance FromJSON (ApiT DerivationIndex) where
    parseJSON :: Value -> Parser (ApiT DerivationIndex)
parseJSON = String -> Value -> Parser (ApiT DerivationIndex)
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"DerivationIndex"

instance ToJSON ApiVerificationKeyShelley where
    toJSON :: ApiVerificationKeyShelley -> Value
toJSON (ApiVerificationKeyShelley (ByteString
pub, Role
role_) VerificationKeyHashing
hashed) =
        Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ HumanReadablePart -> DataPart -> Text
Bech32.encodeLenient HumanReadablePart
hrp (DataPart -> Text) -> DataPart -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> DataPart
dataPartFromBytes ByteString
pub
      where
        hrp :: HumanReadablePart
hrp = case Role
role_ of
            Role
UtxoExternal -> case VerificationKeyHashing
hashed of
                VerificationKeyHashing
WithHashing -> [humanReadablePart|addr_vkh|]
                VerificationKeyHashing
WithoutHashing -> [humanReadablePart|addr_vk|]
            Role
UtxoInternal -> case VerificationKeyHashing
hashed of
                VerificationKeyHashing
WithHashing -> [humanReadablePart|addr_vkh|]
                VerificationKeyHashing
WithoutHashing -> [humanReadablePart|addr_vk|]
            Role
MutableAccount -> case VerificationKeyHashing
hashed of
                VerificationKeyHashing
WithHashing -> [humanReadablePart|stake_vkh|]
                VerificationKeyHashing
WithoutHashing -> [humanReadablePart|stake_vk|]

instance FromJSON ApiVerificationKeyShelley where
    parseJSON :: Value -> Parser ApiVerificationKeyShelley
parseJSON Value
value = do
        (HumanReadablePart
hrp, ByteString
bytes) <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value Parser Text
-> (Text -> Parser (HumanReadablePart, ByteString))
-> Parser (HumanReadablePart, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> Parser (HumanReadablePart, ByteString)
parseBech32 Text
"Malformed verification key")
        (Role
role, VerificationKeyHashing
hashing) <- HumanReadablePart -> Parser (Role, VerificationKeyHashing)
parseRoleHashing HumanReadablePart
hrp
        ByteString
payload <- case VerificationKeyHashing
hashing of
            VerificationKeyHashing
WithoutHashing -> ByteString -> Parser ByteString
forall (f :: * -> *). MonadFail f => ByteString -> f ByteString
parsePubVer ByteString
bytes
            VerificationKeyHashing
WithHashing -> ByteString -> Parser ByteString
forall (f :: * -> *). MonadFail f => ByteString -> f ByteString
parsePubVerHash ByteString
bytes
        ApiVerificationKeyShelley -> Parser ApiVerificationKeyShelley
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiVerificationKeyShelley -> Parser ApiVerificationKeyShelley)
-> ApiVerificationKeyShelley -> Parser ApiVerificationKeyShelley
forall a b. (a -> b) -> a -> b
$ (ByteString, Role)
-> VerificationKeyHashing -> ApiVerificationKeyShelley
ApiVerificationKeyShelley (ByteString
payload,Role
role) VerificationKeyHashing
hashing
      where
        parseRoleHashing :: HumanReadablePart -> Parser (Role, VerificationKeyHashing)
parseRoleHashing = \case
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|addr_vk|] -> (Role, VerificationKeyHashing)
-> Parser (Role, VerificationKeyHashing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Role
UtxoExternal, VerificationKeyHashing
WithoutHashing)
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|stake_vk|] -> (Role, VerificationKeyHashing)
-> Parser (Role, VerificationKeyHashing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Role
MutableAccount, VerificationKeyHashing
WithoutHashing)
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|addr_vkh|] -> (Role, VerificationKeyHashing)
-> Parser (Role, VerificationKeyHashing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Role
UtxoExternal, VerificationKeyHashing
WithHashing)
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|stake_vkh|] -> (Role, VerificationKeyHashing)
-> Parser (Role, VerificationKeyHashing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Role
MutableAccount, VerificationKeyHashing
WithHashing)
            HumanReadablePart
_ -> String -> Parser (Role, VerificationKeyHashing)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errRole
          where
            errRole :: String
errRole =
                String
"Unrecognized human-readable part. Expected one of:\
                \ \"addr_vkh\", \"stake_vkh\",\"addr_vk\" or \"stake_vk\"."

instance ToJSON ApiPolicyKey where
    toJSON :: ApiPolicyKey -> Value
toJSON (ApiPolicyKey ByteString
pub VerificationKeyHashing
hashed) =
        Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ HumanReadablePart -> DataPart -> Text
Bech32.encodeLenient HumanReadablePart
hrp (DataPart -> Text) -> DataPart -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> DataPart
dataPartFromBytes ByteString
pub
      where
        hrp :: HumanReadablePart
hrp = case VerificationKeyHashing
hashed of
            VerificationKeyHashing
WithHashing -> [humanReadablePart|policy_vkh|]
            VerificationKeyHashing
WithoutHashing -> [humanReadablePart|policy_vk|]

instance FromJSON ApiPolicyKey where
    parseJSON :: Value -> Parser ApiPolicyKey
parseJSON Value
value = do
        (HumanReadablePart
hrp, ByteString
bytes) <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value Parser Text
-> (Text -> Parser (HumanReadablePart, ByteString))
-> Parser (HumanReadablePart, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> Parser (HumanReadablePart, ByteString)
parseBech32 Text
"Malformed policy key")
        VerificationKeyHashing
hashing <- HumanReadablePart -> Parser VerificationKeyHashing
parseHashing HumanReadablePart
hrp
        ByteString
payload <- case VerificationKeyHashing
hashing of
            VerificationKeyHashing
WithoutHashing -> ByteString -> Parser ByteString
forall (f :: * -> *). MonadFail f => ByteString -> f ByteString
parsePubVer ByteString
bytes
            VerificationKeyHashing
WithHashing -> ByteString -> Parser ByteString
forall (f :: * -> *). MonadFail f => ByteString -> f ByteString
parsePubVerHash ByteString
bytes
        ApiPolicyKey -> Parser ApiPolicyKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiPolicyKey -> Parser ApiPolicyKey)
-> ApiPolicyKey -> Parser ApiPolicyKey
forall a b. (a -> b) -> a -> b
$ ByteString -> VerificationKeyHashing -> ApiPolicyKey
ApiPolicyKey ByteString
payload VerificationKeyHashing
hashing
      where
        parseHashing :: HumanReadablePart -> Parser VerificationKeyHashing
parseHashing = \case
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|policy_vk|] -> VerificationKeyHashing -> Parser VerificationKeyHashing
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationKeyHashing
WithoutHashing
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|policy_vkh|] -> VerificationKeyHashing -> Parser VerificationKeyHashing
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationKeyHashing
WithHashing
            HumanReadablePart
_ -> String -> Parser VerificationKeyHashing
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errRole
          where
            errRole :: String
errRole =
                String
"Unrecognized human-readable part. Expected either\
                \ \"policy_vkh\" or \"policy_vk\"."

instance FromJSON ApiAssetMintBurn where
    parseJSON :: Value -> Parser ApiAssetMintBurn
parseJSON = Options -> Value -> Parser ApiAssetMintBurn
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiAssetMintBurn where
    toJSON :: ApiAssetMintBurn -> Value
toJSON = Options -> ApiAssetMintBurn -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiTokenAmountFingerprint where
    parseJSON :: Value -> Parser ApiTokenAmountFingerprint
parseJSON = Options -> Value -> Parser ApiTokenAmountFingerprint
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiTokenAmountFingerprint where
    toJSON :: ApiTokenAmountFingerprint -> Value
toJSON = Options -> ApiTokenAmountFingerprint -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiTokens where
    parseJSON :: Value -> Parser ApiTokens
parseJSON = Options -> Value -> Parser ApiTokens
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiTokens where
    toJSON :: ApiTokens -> Value
toJSON = Options -> ApiTokens -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiPostPolicyKeyData where
    parseJSON :: Value -> Parser ApiPostPolicyKeyData
parseJSON = Options -> Value -> Parser ApiPostPolicyKeyData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiPostPolicyKeyData where
    toJSON :: ApiPostPolicyKeyData -> Value
toJSON = Options -> ApiPostPolicyKeyData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

parseBech32
    :: Text
    -> Text
    -> Aeson.Parser (Bech32.HumanReadablePart, ByteString)
parseBech32 :: Text -> Text -> Parser (HumanReadablePart, ByteString)
parseBech32 Text
err =
    (DecodingError -> Parser (HumanReadablePart, ByteString))
-> ((HumanReadablePart, DataPart)
    -> Parser (HumanReadablePart, ByteString))
-> Either DecodingError (HumanReadablePart, DataPart)
-> Parser (HumanReadablePart, ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Parser (HumanReadablePart, ByteString)
-> DecodingError -> Parser (HumanReadablePart, ByteString)
forall a b. a -> b -> a
const (Parser (HumanReadablePart, ByteString)
 -> DecodingError -> Parser (HumanReadablePart, ByteString))
-> Parser (HumanReadablePart, ByteString)
-> DecodingError
-> Parser (HumanReadablePart, ByteString)
forall a b. (a -> b) -> a -> b
$ String -> Parser (HumanReadablePart, ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errBech32) (HumanReadablePart, DataPart)
-> Parser (HumanReadablePart, ByteString)
parseDataPart (Either DecodingError (HumanReadablePart, DataPart)
 -> Parser (HumanReadablePart, ByteString))
-> (Text -> Either DecodingError (HumanReadablePart, DataPart))
-> Text
-> Parser (HumanReadablePart, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either DecodingError (HumanReadablePart, DataPart)
Bech32.decodeLenient
  where
      errBech32 :: String
errBech32 =
          Text -> String
T.unpack Text
err String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
". Expected a bech32-encoded key."

parseDataPart
    :: (Bech32.HumanReadablePart, Bech32.DataPart)
    -> Aeson.Parser (Bech32.HumanReadablePart, ByteString)
parseDataPart :: (HumanReadablePart, DataPart)
-> Parser (HumanReadablePart, ByteString)
parseDataPart =
    Parser (HumanReadablePart, ByteString)
-> ((HumanReadablePart, ByteString)
    -> Parser (HumanReadablePart, ByteString))
-> Maybe (HumanReadablePart, ByteString)
-> Parser (HumanReadablePart, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser (HumanReadablePart, ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errDataPart) (HumanReadablePart, ByteString)
-> Parser (HumanReadablePart, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HumanReadablePart, ByteString)
 -> Parser (HumanReadablePart, ByteString))
-> ((HumanReadablePart, DataPart)
    -> Maybe (HumanReadablePart, ByteString))
-> (HumanReadablePart, DataPart)
-> Parser (HumanReadablePart, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataPart -> Maybe ByteString)
-> (HumanReadablePart, DataPart)
-> Maybe (HumanReadablePart, ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse DataPart -> Maybe ByteString
dataPartToBytes
  where
      errDataPart :: String
errDataPart =
          String
"Couldn't decode data-part to valid UTF-8 bytes."

parsePubVer :: MonadFail f => ByteString -> f ByteString
parsePubVer :: ByteString -> f ByteString
parsePubVer ByteString
bytes
    | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 =
          ByteString -> f ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bytes
    | Bool
otherwise =
          String -> f ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a valid Ed25519 public key. Must be 32 bytes, without chain code"

parsePubVerHash :: MonadFail f => ByteString -> f ByteString
parsePubVerHash :: ByteString -> f ByteString
parsePubVerHash ByteString
bytes
    | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
28 =
          ByteString -> f ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bytes
    | Bool
otherwise =
          String -> f ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a valid hash of Ed25519 public key. Must be 28 bytes."

instance ToJSON ApiVerificationKeyShared where
    toJSON :: ApiVerificationKeyShared -> Value
toJSON (ApiVerificationKeyShared (ByteString
pub, Role
role_) VerificationKeyHashing
hashed) =
        Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ HumanReadablePart -> DataPart -> Text
Bech32.encodeLenient HumanReadablePart
hrp (DataPart -> Text) -> DataPart -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> DataPart
dataPartFromBytes ByteString
pub
      where
        hrp :: HumanReadablePart
hrp = case Role
role_ of
            Role
UtxoExternal -> case VerificationKeyHashing
hashed of
                VerificationKeyHashing
WithHashing -> [humanReadablePart|addr_shared_vkh|]
                VerificationKeyHashing
WithoutHashing -> [humanReadablePart|addr_shared_vk|]
            Role
UtxoInternal -> case VerificationKeyHashing
hashed of
                VerificationKeyHashing
WithHashing -> [humanReadablePart|addr_shared_vkh|]
                VerificationKeyHashing
WithoutHashing -> [humanReadablePart|addr_shared_vk|]
            Role
MutableAccount -> case VerificationKeyHashing
hashed of
                VerificationKeyHashing
WithHashing -> [humanReadablePart|stake_shared_vkh|]
                VerificationKeyHashing
WithoutHashing -> [humanReadablePart|stake_shared_vk|]

instance FromJSON ApiVerificationKeyShared where
    parseJSON :: Value -> Parser ApiVerificationKeyShared
parseJSON Value
value = do
        (HumanReadablePart
hrp, ByteString
bytes) <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value Parser Text
-> (Text -> Parser (HumanReadablePart, ByteString))
-> Parser (HumanReadablePart, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> Parser (HumanReadablePart, ByteString)
parseBech32 Text
"Malformed verification key")
        (Role
role, VerificationKeyHashing
hashing) <- HumanReadablePart -> Parser (Role, VerificationKeyHashing)
parseRoleHashing HumanReadablePart
hrp
        ByteString
payload <- case VerificationKeyHashing
hashing of
            VerificationKeyHashing
WithoutHashing -> ByteString -> Parser ByteString
forall (f :: * -> *). MonadFail f => ByteString -> f ByteString
parsePubVer ByteString
bytes
            VerificationKeyHashing
WithHashing -> ByteString -> Parser ByteString
forall (f :: * -> *). MonadFail f => ByteString -> f ByteString
parsePubVerHash ByteString
bytes
        ApiVerificationKeyShared -> Parser ApiVerificationKeyShared
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiVerificationKeyShared -> Parser ApiVerificationKeyShared)
-> ApiVerificationKeyShared -> Parser ApiVerificationKeyShared
forall a b. (a -> b) -> a -> b
$ (ByteString, Role)
-> VerificationKeyHashing -> ApiVerificationKeyShared
ApiVerificationKeyShared (ByteString
payload,Role
role) VerificationKeyHashing
hashing
      where
        parseRoleHashing :: HumanReadablePart -> Parser (Role, VerificationKeyHashing)
parseRoleHashing = \case
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|addr_shared_vk|] -> (Role, VerificationKeyHashing)
-> Parser (Role, VerificationKeyHashing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Role
UtxoExternal, VerificationKeyHashing
WithoutHashing)
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|stake_shared_vk|] -> (Role, VerificationKeyHashing)
-> Parser (Role, VerificationKeyHashing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Role
MutableAccount, VerificationKeyHashing
WithoutHashing)
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|addr_shared_vkh|] -> (Role, VerificationKeyHashing)
-> Parser (Role, VerificationKeyHashing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Role
UtxoExternal, VerificationKeyHashing
WithHashing)
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|stake_shared_vkh|] -> (Role, VerificationKeyHashing)
-> Parser (Role, VerificationKeyHashing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Role
MutableAccount, VerificationKeyHashing
WithHashing)
            HumanReadablePart
_ -> String -> Parser (Role, VerificationKeyHashing)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errRole
          where
            errRole :: String
errRole =
                String
"Unrecognized human-readable part. Expected one of:\
                \ \"addr_shared_vkh\", \"stake_shared_vkh\",\"addr_shared_vk\" or \"stake_shared_vk\"."

instance ToJSON ApiAccountKey where
    toJSON :: ApiAccountKey -> Value
toJSON (ApiAccountKey ByteString
pub KeyFormat
extd Index 'Hardened 'PurposeK
purpose') =
        Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ HumanReadablePart -> DataPart -> Text
Bech32.encodeLenient (Index 'Hardened 'PurposeK -> HumanReadablePart
hrp Index 'Hardened 'PurposeK
purpose') (DataPart -> Text) -> DataPart -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> DataPart
dataPartFromBytes ByteString
pub
      where
        hrp :: Index 'Hardened 'PurposeK -> HumanReadablePart
hrp Index 'Hardened 'PurposeK
p
            | Index 'Hardened 'PurposeK
p Index 'Hardened 'PurposeK -> Index 'Hardened 'PurposeK -> Bool
forall a. Eq a => a -> a -> Bool
== Index 'Hardened 'PurposeK
purposeCIP1854 = case KeyFormat
extd of
                  KeyFormat
Extended -> [humanReadablePart|acct_shared_xvk|]
                  KeyFormat
NonExtended -> [humanReadablePart|acct_shared_vk|]
            | Bool
otherwise = case KeyFormat
extd of
                  KeyFormat
Extended -> [humanReadablePart|acct_xvk|]
                  KeyFormat
NonExtended -> [humanReadablePart|acct_vk|]

instance FromJSON ApiAccountKey where
    parseJSON :: Value -> Parser ApiAccountKey
parseJSON Value
value = do
        (HumanReadablePart
hrp, ByteString
bytes) <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value Parser Text
-> (Text -> Parser (HumanReadablePart, ByteString))
-> Parser (HumanReadablePart, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> Parser (HumanReadablePart, ByteString)
parseBech32 Text
"Malformed extended/normal account public key")
        (KeyFormat
extended', Index 'Hardened 'PurposeK
purpose') <- HumanReadablePart -> Parser (KeyFormat, Index 'Hardened 'PurposeK)
parseHrp HumanReadablePart
hrp
        ByteString
pub <- ByteString -> KeyFormat -> Parser ByteString
forall (f :: * -> *).
MonadFail f =>
ByteString -> KeyFormat -> f ByteString
parsePub ByteString
bytes KeyFormat
extended'
        ApiAccountKey -> Parser ApiAccountKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiAccountKey -> Parser ApiAccountKey)
-> ApiAccountKey -> Parser ApiAccountKey
forall a b. (a -> b) -> a -> b
$ ByteString
-> KeyFormat -> Index 'Hardened 'PurposeK -> ApiAccountKey
ApiAccountKey ByteString
pub KeyFormat
extended' Index 'Hardened 'PurposeK
purpose'
      where
        parseHrp :: HumanReadablePart -> Parser (KeyFormat, Index 'Hardened 'PurposeK)
parseHrp = \case
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|acct_xvk|] -> (KeyFormat, Index 'Hardened 'PurposeK)
-> Parser (KeyFormat, Index 'Hardened 'PurposeK)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyFormat
Extended, Index 'Hardened 'PurposeK
purposeCIP1852)
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|acct_vk|] -> (KeyFormat, Index 'Hardened 'PurposeK)
-> Parser (KeyFormat, Index 'Hardened 'PurposeK)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyFormat
NonExtended, Index 'Hardened 'PurposeK
purposeCIP1852)
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|acct_shared_xvk|] -> (KeyFormat, Index 'Hardened 'PurposeK)
-> Parser (KeyFormat, Index 'Hardened 'PurposeK)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyFormat
Extended, Index 'Hardened 'PurposeK
purposeCIP1854)
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|acct_shared_vk|] -> (KeyFormat, Index 'Hardened 'PurposeK)
-> Parser (KeyFormat, Index 'Hardened 'PurposeK)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyFormat
NonExtended, Index 'Hardened 'PurposeK
purposeCIP1854)
            HumanReadablePart
_ -> String -> Parser (KeyFormat, Index 'Hardened 'PurposeK)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errHrp
          where
              errHrp :: String
errHrp =
                  String
"Unrecognized human-readable part. Expected one of:\
                  \ \"acct_xvk\", \"acct_vk\", \"acct_shared_xvk\" or \"acct_shared_vk\"."

parsePubErr :: IsString p => KeyFormat -> p
parsePubErr :: KeyFormat -> p
parsePubErr = \case
    KeyFormat
Extended ->
        p
"Not a valid Ed25519 extended public key. Must be 64 bytes, with chain code"
    KeyFormat
NonExtended ->
        p
"Not a valid Ed25519 normal public key. Must be 32 bytes, without chain code"

parsePub :: MonadFail f => ByteString -> KeyFormat -> f ByteString
parsePub :: ByteString -> KeyFormat -> f ByteString
parsePub ByteString
bytes KeyFormat
extd
    | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bytesExpectedLength =
          ByteString -> f ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bytes
    | Bool
otherwise =
          String -> f ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f ByteString) -> String -> f ByteString
forall a b. (a -> b) -> a -> b
$ KeyFormat -> String
forall p. IsString p => KeyFormat -> p
parsePubErr KeyFormat
extd
  where
    bytesExpectedLength :: Int
bytesExpectedLength = case KeyFormat
extd of
        KeyFormat
Extended -> Int
64
        KeyFormat
NonExtended -> Int
32

instance ToJSON ApiAccountKeyShared where
    toJSON :: ApiAccountKeyShared -> Value
toJSON (ApiAccountKeyShared ByteString
pub KeyFormat
extd Index 'Hardened 'PurposeK
_) =
        Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ HumanReadablePart -> DataPart -> Text
Bech32.encodeLenient HumanReadablePart
hrp (DataPart -> Text) -> DataPart -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> DataPart
dataPartFromBytes ByteString
pub
      where
        hrp :: HumanReadablePart
hrp = case KeyFormat
extd of
            KeyFormat
Extended -> [humanReadablePart|acct_shared_xvk|]
            KeyFormat
NonExtended -> [humanReadablePart|acct_shared_vk|]

instance FromJSON ApiAccountKeyShared where
    parseJSON :: Value -> Parser ApiAccountKeyShared
parseJSON Value
value = do
        (HumanReadablePart
hrp, ByteString
bytes) <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value Parser Text
-> (Text -> Parser (HumanReadablePart, ByteString))
-> Parser (HumanReadablePart, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Text -> Parser (HumanReadablePart, ByteString)
parseBech32 Text
"Malformed extended/normal account public key")
        KeyFormat
extended' <- HumanReadablePart -> Parser KeyFormat
parseHrp HumanReadablePart
hrp
        ByteString
pub <- ByteString -> KeyFormat -> Parser ByteString
forall (f :: * -> *).
MonadFail f =>
ByteString -> KeyFormat -> f ByteString
parsePub ByteString
bytes KeyFormat
extended'
        ApiAccountKeyShared -> Parser ApiAccountKeyShared
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiAccountKeyShared -> Parser ApiAccountKeyShared)
-> ApiAccountKeyShared -> Parser ApiAccountKeyShared
forall a b. (a -> b) -> a -> b
$ ByteString
-> KeyFormat -> Index 'Hardened 'PurposeK -> ApiAccountKeyShared
ApiAccountKeyShared ByteString
pub KeyFormat
extended' Index 'Hardened 'PurposeK
purposeCIP1854
      where
        parseHrp :: HumanReadablePart -> Parser KeyFormat
parseHrp = \case
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|acct_shared_xvk|] -> KeyFormat -> Parser KeyFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyFormat
Extended
            HumanReadablePart
hrp | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== [humanReadablePart|acct_shared_vk|] -> KeyFormat -> Parser KeyFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyFormat
NonExtended
            HumanReadablePart
_ -> String -> Parser KeyFormat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errHrp
          where
              errHrp :: String
errHrp =
                  String
"Unrecognized human-readable part. Expected one of:\
                  \ \"acct_shared_xvk\" or \"acct_shared_vk\"."


instance FromJSON KeyFormat where
    parseJSON :: Value -> Parser KeyFormat
parseJSON = Options -> Value -> Parser KeyFormat
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultSumTypeOptions
instance ToJSON KeyFormat where
    toJSON :: KeyFormat -> Value
toJSON = Options -> KeyFormat -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultSumTypeOptions

instance FromJSON ApiPostAccountKeyData where
    parseJSON :: Value -> Parser ApiPostAccountKeyData
parseJSON = Options -> Value -> Parser ApiPostAccountKeyData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiPostAccountKeyData where
    toJSON :: ApiPostAccountKeyData -> Value
toJSON = Options -> ApiPostAccountKeyData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiPostAccountKeyDataWithPurpose where
    parseJSON :: Value -> Parser ApiPostAccountKeyDataWithPurpose
parseJSON = Options -> Value -> Parser ApiPostAccountKeyDataWithPurpose
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiPostAccountKeyDataWithPurpose where
    toJSON :: ApiPostAccountKeyDataWithPurpose -> Value
toJSON = Options -> ApiPostAccountKeyDataWithPurpose -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiEpochInfo where
    parseJSON :: Value -> Parser ApiEpochInfo
parseJSON = Options -> Value -> Parser ApiEpochInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiEpochInfo where
    toJSON :: ApiEpochInfo -> Value
toJSON = Options -> ApiEpochInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiSelectCoinsAction where
    parseJSON :: Value -> Parser ApiSelectCoinsAction
parseJSON = Options -> Value -> Parser ApiSelectCoinsAction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiSelectCoinsAction where
    toJSON :: ApiSelectCoinsAction -> Value
toJSON = Options -> ApiSelectCoinsAction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeAddress n => FromJSON (ApiSelectCoinsPayments n) where
    parseJSON :: Value -> Parser (ApiSelectCoinsPayments n)
parseJSON = Options -> Value -> Parser (ApiSelectCoinsPayments n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress n => ToJSON (ApiSelectCoinsPayments n) where
    toJSON :: ApiSelectCoinsPayments n -> Value
toJSON = Options -> ApiSelectCoinsPayments n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeAddress n => FromJSON (ApiSelectCoinsData n) where
    parseJSON :: Value -> Parser (ApiSelectCoinsData n)
parseJSON = String
-> (Object -> Parser (ApiSelectCoinsData n))
-> Value
-> Parser (ApiSelectCoinsData n)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DelegationAction" ((Object -> Parser (ApiSelectCoinsData n))
 -> Value -> Parser (ApiSelectCoinsData n))
-> (Object -> Parser (ApiSelectCoinsData n))
-> Value
-> Parser (ApiSelectCoinsData n)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Maybe Value
p <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"payments"
        Maybe Value
a <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"delegation_action"
        case (Maybe Value
p :: Maybe Value, Maybe Value
a :: Maybe Value) of
            (Just Value
_, Just Value
_) ->
                String -> Parser (ApiSelectCoinsData n)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Specified both payments and action, pick one"
            (Maybe Value
Nothing, Just{}) ->
                ApiSelectCoinsAction -> ApiSelectCoinsData n
forall (n :: NetworkDiscriminant).
ApiSelectCoinsAction -> ApiSelectCoinsData n
ApiSelectForDelegation (ApiSelectCoinsAction -> ApiSelectCoinsData n)
-> Parser ApiSelectCoinsAction -> Parser (ApiSelectCoinsData n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ApiSelectCoinsAction
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            (Just{}, Maybe Value
Nothing) ->
                ApiSelectCoinsPayments n -> ApiSelectCoinsData n
forall (n :: NetworkDiscriminant).
ApiSelectCoinsPayments n -> ApiSelectCoinsData n
ApiSelectForPayment (ApiSelectCoinsPayments n -> ApiSelectCoinsData n)
-> Parser (ApiSelectCoinsPayments n)
-> Parser (ApiSelectCoinsData n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ApiSelectCoinsPayments n)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            (Maybe Value, Maybe Value)
_ ->
                String -> Parser (ApiSelectCoinsData n)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No valid parse for ApiSelectCoinsPayments or ApiSelectCoinsAction"

instance EncodeAddress n => ToJSON (ApiSelectCoinsData n) where
    toJSON :: ApiSelectCoinsData n -> Value
toJSON (ApiSelectForPayment ApiSelectCoinsPayments n
v) = ApiSelectCoinsPayments n -> Value
forall a. ToJSON a => a -> Value
toJSON ApiSelectCoinsPayments n
v
    toJSON (ApiSelectForDelegation ApiSelectCoinsAction
v) = ApiSelectCoinsAction -> Value
forall a. ToJSON a => a -> Value
toJSON ApiSelectCoinsAction
v

instance (DecodeStakeAddress n, DecodeAddress n) =>
    FromJSON (ApiCoinSelection n)
  where
    parseJSON :: Value -> Parser (ApiCoinSelection n)
parseJSON = Options -> Value -> Parser (ApiCoinSelection n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance (EncodeStakeAddress n, EncodeAddress n) =>
    ToJSON (ApiCoinSelection n)
  where
    toJSON :: ApiCoinSelection n -> Value
toJSON = Options -> ApiCoinSelection n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

apiCertificateOptions :: Aeson.Options
apiCertificateOptions :: Options
apiCertificateOptions = Options
Aeson.defaultOptions
      { constructorTagModifier :: ShowS
constructorTagModifier = Char -> ShowS
camelTo2 Char
'_'
      , tagSingleConstructors :: Bool
tagSingleConstructors = Bool
True
      , fieldLabelModifier :: ShowS
fieldLabelModifier = Char -> ShowS
camelTo2 Char
'_' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
      , omitNothingFields :: Bool
omitNothingFields = Bool
True
      , sumEncoding :: SumEncoding
sumEncoding = TaggedObject :: String -> String -> SumEncoding
TaggedObject
          {
            tagFieldName :: String
tagFieldName = String
"certificate_type"
          , contentsFieldName :: String
contentsFieldName = String
"details" -- this isn't actually used
          }
      }

instance FromJSON ApiCertificate where
    parseJSON :: Value -> Parser ApiCertificate
parseJSON = Options -> Value -> Parser ApiCertificate
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
apiCertificateOptions

instance ToJSON ApiCertificate where
    toJSON :: ApiCertificate -> Value
toJSON = Options -> ApiCertificate -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
apiCertificateOptions

apiDelegationActionOptions :: Aeson.Options
apiDelegationActionOptions :: Options
apiDelegationActionOptions = Options
Aeson.defaultOptions
      { tagSingleConstructors :: Bool
tagSingleConstructors = Bool
True
      , omitNothingFields :: Bool
omitNothingFields = Bool
True
      , constructorTagModifier :: ShowS
constructorTagModifier = Char -> ShowS
camelTo2 Char
'_'
      , fieldLabelModifier :: ShowS
fieldLabelModifier = Char -> ShowS
camelTo2 Char
'_' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
      , sumEncoding :: SumEncoding
sumEncoding = TaggedObject :: String -> String -> SumEncoding
TaggedObject
          { tagFieldName :: String
tagFieldName = String
"action"
          , contentsFieldName :: String
contentsFieldName = String
"pool"
          }
      }

instance FromJSON ApiDelegationAction where
    parseJSON :: Value -> Parser ApiDelegationAction
parseJSON = Options -> Value -> Parser ApiDelegationAction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
apiDelegationActionOptions
instance ToJSON ApiDelegationAction where
    toJSON :: ApiDelegationAction -> Value
toJSON = Options -> ApiDelegationAction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
apiDelegationActionOptions

instance ToJSON ApiStakeKeyIndex where
    toJSON :: ApiStakeKeyIndex -> Value
toJSON (ApiStakeKeyIndex ApiT DerivationIndex
ix) = ApiT DerivationIndex -> Value
forall a. ToJSON a => a -> Value
toJSON ApiT DerivationIndex
ix
instance FromJSON ApiStakeKeyIndex where
    parseJSON :: Value -> Parser ApiStakeKeyIndex
parseJSON Value
val = ApiT DerivationIndex -> ApiStakeKeyIndex
ApiStakeKeyIndex (ApiT DerivationIndex -> ApiStakeKeyIndex)
-> Parser (ApiT DerivationIndex) -> Parser ApiStakeKeyIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ApiT DerivationIndex)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val

instance ToJSON ApiMultiDelegationAction where
    toJSON :: ApiMultiDelegationAction -> Value
toJSON (Joining ApiT PoolId
poolId ApiStakeKeyIndex
stakeKey) =
        [Pair] -> Value
object [ Key
"join" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                   [Pair] -> Value
object [
                         Key
"pool" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiT PoolId -> Value
forall a. ToJSON a => a -> Value
toJSON ApiT PoolId
poolId
                       , Key
"stake_key_index" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiStakeKeyIndex -> Value
forall a. ToJSON a => a -> Value
toJSON ApiStakeKeyIndex
stakeKey
                       ]
               ]
    toJSON (Leaving ApiStakeKeyIndex
stakeKey) =
        [Pair] -> Value
object [ Key
"quit" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [ Key
"stake_key_index" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiStakeKeyIndex -> Value
forall a. ToJSON a => a -> Value
toJSON ApiStakeKeyIndex
stakeKey ] ]
instance FromJSON ApiMultiDelegationAction where
    parseJSON :: Value -> Parser ApiMultiDelegationAction
parseJSON = String
-> (Object -> Parser ApiMultiDelegationAction)
-> Value
-> Parser ApiMultiDelegationAction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiMultiDelegationAction" ((Object -> Parser ApiMultiDelegationAction)
 -> Value -> Parser ApiMultiDelegationAction)
-> (Object -> Parser ApiMultiDelegationAction)
-> Value
-> Parser ApiMultiDelegationAction
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        Maybe Object
actionJoin <- Object
obj Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"join"
        Maybe Object
actionQuit <- Object
obj Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"quit"
        case (Maybe Object
actionJoin, Maybe Object
actionQuit) of
            (Just Object
o, Maybe Object
Nothing) ->
                ApiT PoolId -> ApiStakeKeyIndex -> ApiMultiDelegationAction
Joining (ApiT PoolId -> ApiStakeKeyIndex -> ApiMultiDelegationAction)
-> Parser (ApiT PoolId)
-> Parser (ApiStakeKeyIndex -> ApiMultiDelegationAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (ApiT PoolId)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pool" Parser (ApiStakeKeyIndex -> ApiMultiDelegationAction)
-> Parser ApiStakeKeyIndex -> Parser ApiMultiDelegationAction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApiStakeKeyIndex
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stake_key_index"
            (Maybe Object
Nothing, Just Object
o) ->
                ApiStakeKeyIndex -> ApiMultiDelegationAction
Leaving (ApiStakeKeyIndex -> ApiMultiDelegationAction)
-> Parser ApiStakeKeyIndex -> Parser ApiMultiDelegationAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApiStakeKeyIndex
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stake_key_index"
            (Maybe Object, Maybe Object)
_ -> String -> Parser ApiMultiDelegationAction
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ApiMultiDelegationAction needs either 'join' or 'quit', but not both"

instance FromJSON (ApiT AnyScript) where
    parseJSON :: Value -> Parser (ApiT AnyScript)
parseJSON = String
-> (Object -> Parser (ApiT AnyScript))
-> Value
-> Parser (ApiT AnyScript)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiT AnyScript" ((Object -> Parser (ApiT AnyScript))
 -> Value -> Parser (ApiT AnyScript))
-> (Object -> Parser (ApiT AnyScript))
-> Value
-> Parser (ApiT AnyScript)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        Maybe String
scriptType <- Object
obj Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"script_type"
        case (Maybe String
scriptType :: Maybe String) of
            Just String
t | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"plutus"  ->
                AnyScript -> ApiT AnyScript
forall a. a -> ApiT a
ApiT (AnyScript -> ApiT AnyScript)
-> (PlutusScriptInfo -> AnyScript)
-> PlutusScriptInfo
-> ApiT AnyScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptInfo -> AnyScript
PlutusScript (PlutusScriptInfo -> ApiT AnyScript)
-> Parser PlutusScriptInfo -> Parser (ApiT AnyScript)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser PlutusScriptInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"language_version"
            Just String
t | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"native" ->
                AnyScript -> ApiT AnyScript
forall a. a -> ApiT a
ApiT (AnyScript -> ApiT AnyScript)
-> (Script KeyHash -> AnyScript)
-> Script KeyHash
-> ApiT AnyScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script KeyHash -> AnyScript
NativeScript (Script KeyHash -> ApiT AnyScript)
-> Parser (Script KeyHash) -> Parser (ApiT AnyScript)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Script KeyHash)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"script"
            Maybe String
_ -> String -> Parser (ApiT AnyScript)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"AnyScript needs either 'native' or 'plutus' in 'script_type'"

instance ToJSON (ApiT AnyScript) where
    toJSON :: ApiT AnyScript -> Value
toJSON (ApiT (NativeScript Script KeyHash
s)) =
        [Pair] -> Value
object [ Key
"script_type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"native"
               , Key
"script" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Script KeyHash -> Value
forall a. ToJSON a => a -> Value
toJSON Script KeyHash
s]
    toJSON (ApiT (PlutusScript PlutusScriptInfo
v)) =
        [Pair] -> Value
object [ Key
"script_type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"plutus"
               , Key
"language_version" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PlutusScriptInfo -> Value
forall a. ToJSON a => a -> Value
toJSON PlutusScriptInfo
v]

instance DecodeAddress n => FromJSON (ApiCoinSelectionChange n) where
    parseJSON :: Value -> Parser (ApiCoinSelectionChange n)
parseJSON = Options -> Value -> Parser (ApiCoinSelectionChange n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress n => ToJSON (ApiCoinSelectionChange n) where
    toJSON :: ApiCoinSelectionChange n -> Value
toJSON = Options -> ApiCoinSelectionChange n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeAddress n => FromJSON (ApiCoinSelectionCollateral n) where
    parseJSON :: Value -> Parser (ApiCoinSelectionCollateral n)
parseJSON = Options -> Value -> Parser (ApiCoinSelectionCollateral n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress n => ToJSON (ApiCoinSelectionCollateral n) where
    toJSON :: ApiCoinSelectionCollateral n -> Value
toJSON = Options -> ApiCoinSelectionCollateral n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeAddress n => FromJSON (ApiCoinSelectionOutput n) where
    parseJSON :: Value -> Parser (ApiCoinSelectionOutput n)
parseJSON = Options -> Value -> Parser (ApiCoinSelectionOutput n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress n => ToJSON (ApiCoinSelectionOutput n) where
    toJSON :: ApiCoinSelectionOutput n -> Value
toJSON = Options -> ApiCoinSelectionOutput n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeStakeAddress n => FromJSON (ApiCoinSelectionWithdrawal n) where
    parseJSON :: Value -> Parser (ApiCoinSelectionWithdrawal n)
parseJSON = Options -> Value -> Parser (ApiCoinSelectionWithdrawal n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeStakeAddress n => ToJSON (ApiCoinSelectionWithdrawal n) where
    toJSON :: ApiCoinSelectionWithdrawal n -> Value
toJSON = Options -> ApiCoinSelectionWithdrawal n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance {-# OVERLAPS #-} DecodeAddress n => FromJSON (ApiT Address, Proxy n)
  where
    parseJSON :: Value -> Parser (ApiT Address, Proxy n)
parseJSON Value
x = do
        let proxy :: Proxy n
proxy = Proxy n
forall k (t :: k). Proxy t
Proxy @n
        ApiT Address
addr <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x Parser Text
-> (Text -> Parser (ApiT Address)) -> Parser (ApiT Address)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (ShowFmt TextDecodingError) (ApiT Address)
-> Parser (ApiT Address)
forall s a. Show s => Either s a -> Parser a
eitherToParser
            (Either (ShowFmt TextDecodingError) (ApiT Address)
 -> Parser (ApiT Address))
-> (Text -> Either (ShowFmt TextDecodingError) (ApiT Address))
-> Text
-> Parser (ApiT Address)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> (Address -> ApiT Address)
-> Either TextDecodingError Address
-> Either (ShowFmt TextDecodingError) (ApiT Address)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt Address -> ApiT Address
forall a. a -> ApiT a
ApiT
            (Either TextDecodingError Address
 -> Either (ShowFmt TextDecodingError) (ApiT Address))
-> (Text -> Either TextDecodingError Address)
-> Text
-> Either (ShowFmt TextDecodingError) (ApiT Address)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeAddress n => Text -> Either TextDecodingError Address
forall (n :: NetworkDiscriminant).
DecodeAddress n =>
Text -> Either TextDecodingError Address
decodeAddress @n
        (ApiT Address, Proxy n) -> Parser (ApiT Address, Proxy n)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiT Address
addr, Proxy n
proxy)
instance {-# OVERLAPS #-} EncodeAddress n => ToJSON (ApiT Address, Proxy n)
  where
    toJSON :: (ApiT Address, Proxy n) -> Value
toJSON (ApiT Address
addr, Proxy n
_) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (ApiT Address -> Text) -> ApiT Address -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAddress n => Address -> Text
forall (n :: NetworkDiscriminant).
EncodeAddress n =>
Address -> Text
encodeAddress @n (Address -> Text)
-> (ApiT Address -> Address) -> ApiT Address -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT Address -> Address
forall a. ApiT a -> a
getApiT (ApiT Address -> Value) -> ApiT Address -> Value
forall a b. (a -> b) -> a -> b
$ ApiT Address
addr

instance FromJSON (ApiT AddressState) where
    parseJSON :: Value -> Parser (ApiT AddressState)
parseJSON = (AddressState -> ApiT AddressState)
-> Parser AddressState -> Parser (ApiT AddressState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddressState -> ApiT AddressState
forall a. a -> ApiT a
ApiT (Parser AddressState -> Parser (ApiT AddressState))
-> (Value -> Parser AddressState)
-> Value
-> Parser (ApiT AddressState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Value -> Parser AddressState
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultSumTypeOptions
instance ToJSON (ApiT AddressState) where
    toJSON :: ApiT AddressState -> Value
toJSON = Options -> AddressState -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultSumTypeOptions (AddressState -> Value)
-> (ApiT AddressState -> AddressState)
-> ApiT AddressState
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT AddressState -> AddressState
forall a. ApiT a -> a
getApiT

instance FromJSON ApiWallet where
    parseJSON :: Value -> Parser ApiWallet
parseJSON = Options -> Value -> Parser ApiWallet
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiWallet where
    toJSON :: ApiWallet -> Value
toJSON = Options -> ApiWallet -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiWalletPassphrase where
    parseJSON :: Value -> Parser ApiWalletPassphrase
parseJSON = Options -> Value -> Parser ApiWalletPassphrase
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiWalletPassphrase where
    toJSON :: ApiWalletPassphrase -> Value
toJSON = Options -> ApiWalletPassphrase -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiWalletUtxoSnapshot where
    parseJSON :: Value -> Parser ApiWalletUtxoSnapshot
parseJSON = Options -> Value -> Parser ApiWalletUtxoSnapshot
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiWalletUtxoSnapshot where
    toJSON :: ApiWalletUtxoSnapshot -> Value
toJSON = Options -> ApiWalletUtxoSnapshot -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiWalletUtxoSnapshotEntry where
    parseJSON :: Value -> Parser ApiWalletUtxoSnapshotEntry
parseJSON = Options -> Value -> Parser ApiWalletUtxoSnapshotEntry
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiWalletUtxoSnapshotEntry where
    toJSON :: ApiWalletUtxoSnapshotEntry -> Value
toJSON = Options -> ApiWalletUtxoSnapshotEntry -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON WalletPostData where
    parseJSON :: Value -> Parser WalletPostData
parseJSON = Options -> Value -> Parser WalletPostData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON WalletPostData where
    toJSON :: WalletPostData -> Value
toJSON = Options -> WalletPostData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiAccountPublicKey where
    parseJSON :: Value -> Parser ApiAccountPublicKey
parseJSON =
        Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Text)
-> (Text -> Parser ApiAccountPublicKey)
-> Value
-> Parser ApiAccountPublicKey
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either (ShowFmt TextDecodingError) ApiAccountPublicKey
-> Parser ApiAccountPublicKey
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt TextDecodingError) ApiAccountPublicKey
 -> Parser ApiAccountPublicKey)
-> (Text -> Either (ShowFmt TextDecodingError) ApiAccountPublicKey)
-> Text
-> Parser ApiAccountPublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> Either TextDecodingError ApiAccountPublicKey
-> Either (ShowFmt TextDecodingError) ApiAccountPublicKey
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt (Either TextDecodingError ApiAccountPublicKey
 -> Either (ShowFmt TextDecodingError) ApiAccountPublicKey)
-> (Text -> Either TextDecodingError ApiAccountPublicKey)
-> Text
-> Either (ShowFmt TextDecodingError) ApiAccountPublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError ApiAccountPublicKey
forall a. FromText a => Text -> Either TextDecodingError a
fromText
instance ToJSON ApiAccountPublicKey where
    toJSON :: ApiAccountPublicKey -> Value
toJSON =
        Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (ApiAccountPublicKey -> Text) -> ApiAccountPublicKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
hexText (ByteString -> Text)
-> (ApiAccountPublicKey -> ByteString)
-> ApiAccountPublicKey
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubToBytes (XPub -> ByteString)
-> (ApiAccountPublicKey -> XPub)
-> ApiAccountPublicKey
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT XPub -> XPub
forall a. ApiT a -> a
getApiT (ApiT XPub -> XPub)
-> (ApiAccountPublicKey -> ApiT XPub)
-> ApiAccountPublicKey
-> XPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiAccountPublicKey -> ApiT XPub
key

instance FromJSON WalletOrAccountPostData where
    parseJSON :: Value -> Parser WalletOrAccountPostData
parseJSON Value
obj = do
        Maybe Text
passwd <-
            (String
-> (Object -> Parser (Maybe Text)) -> Value -> Parser (Maybe Text)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"postData" ((Object -> Parser (Maybe Text)) -> Value -> Parser (Maybe Text))
-> (Object -> Parser (Maybe Text)) -> Value -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$
             \Object
o -> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"passphrase" :: Aeson.Parser (Maybe Text)) Value
obj
        Maybe [Text]
mnemonic <-
            (String
-> (Object -> Parser (Maybe [Text]))
-> Value
-> Parser (Maybe [Text])
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"postData" ((Object -> Parser (Maybe [Text]))
 -> Value -> Parser (Maybe [Text]))
-> (Object -> Parser (Maybe [Text]))
-> Value
-> Parser (Maybe [Text])
forall a b. (a -> b) -> a -> b
$
             \Object
o -> Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mnemonic_sentence" :: Aeson.Parser (Maybe [Text])) Value
obj
        case (Maybe Text
passwd, Maybe [Text]
mnemonic) of
            (Maybe Text
Nothing, Maybe [Text]
Nothing) -> do
                AccountPostData
xs <- Value -> Parser AccountPostData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj :: Aeson.Parser AccountPostData
                WalletOrAccountPostData -> Parser WalletOrAccountPostData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalletOrAccountPostData -> Parser WalletOrAccountPostData)
-> WalletOrAccountPostData -> Parser WalletOrAccountPostData
forall a b. (a -> b) -> a -> b
$ Either WalletPostData AccountPostData -> WalletOrAccountPostData
WalletOrAccountPostData (Either WalletPostData AccountPostData -> WalletOrAccountPostData)
-> Either WalletPostData AccountPostData -> WalletOrAccountPostData
forall a b. (a -> b) -> a -> b
$ AccountPostData -> Either WalletPostData AccountPostData
forall a b. b -> Either a b
Right AccountPostData
xs
            (Maybe Text, Maybe [Text])
_ -> do
                WalletPostData
xs <- Value -> Parser WalletPostData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj :: Aeson.Parser WalletPostData
                WalletOrAccountPostData -> Parser WalletOrAccountPostData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalletOrAccountPostData -> Parser WalletOrAccountPostData)
-> WalletOrAccountPostData -> Parser WalletOrAccountPostData
forall a b. (a -> b) -> a -> b
$ Either WalletPostData AccountPostData -> WalletOrAccountPostData
WalletOrAccountPostData (Either WalletPostData AccountPostData -> WalletOrAccountPostData)
-> Either WalletPostData AccountPostData -> WalletOrAccountPostData
forall a b. (a -> b) -> a -> b
$ WalletPostData -> Either WalletPostData AccountPostData
forall a b. a -> Either a b
Left WalletPostData
xs

instance ToJSON WalletOrAccountPostData where
    toJSON :: WalletOrAccountPostData -> Value
toJSON (WalletOrAccountPostData (Left WalletPostData
c))= WalletPostData -> Value
forall a. ToJSON a => a -> Value
toJSON WalletPostData
c
    toJSON (WalletOrAccountPostData (Right AccountPostData
c))= AccountPostData -> Value
forall a. ToJSON a => a -> Value
toJSON AccountPostData
c

instance FromJSON AccountPostData where
    parseJSON :: Value -> Parser AccountPostData
parseJSON = Options -> Value -> Parser AccountPostData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON AccountPostData where
    toJSON :: AccountPostData -> Value
toJSON = Options -> AccountPostData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance ToJSON SomeByronWalletPostData where
    toJSON :: SomeByronWalletPostData -> Value
toJSON = \case
        RandomWalletFromMnemonic ByronWalletPostData (AllowedMnemonics 'Random)
w -> ByronWalletPostData '[12, 15, 18, 21, 24] -> Value
forall a. ToJSON a => a -> Value
toJSON ByronWalletPostData '[12, 15, 18, 21, 24]
ByronWalletPostData (AllowedMnemonics 'Random)
w
            Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& (Text, Value) -> Value -> Value
withExtraField (Text
fieldName, Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByronWalletStyle -> Text
forall a. ToText a => a -> Text
toText ByronWalletStyle
Random)
        RandomWalletFromXPrv ByronWalletFromXPrvPostData
w -> ByronWalletFromXPrvPostData -> Value
forall a. ToJSON a => a -> Value
toJSON ByronWalletFromXPrvPostData
w
            Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& (Text, Value) -> Value -> Value
withExtraField (Text
fieldName, Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByronWalletStyle -> Text
forall a. ToText a => a -> Text
toText ByronWalletStyle
Random)
        SomeIcarusWallet ByronWalletPostData (AllowedMnemonics 'Icarus)
w -> ByronWalletPostData '[12, 15, 18, 21, 24] -> Value
forall a. ToJSON a => a -> Value
toJSON ByronWalletPostData '[12, 15, 18, 21, 24]
ByronWalletPostData (AllowedMnemonics 'Icarus)
w
            Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& (Text, Value) -> Value -> Value
withExtraField (Text
fieldName, Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByronWalletStyle -> Text
forall a. ToText a => a -> Text
toText ByronWalletStyle
Icarus)
        SomeTrezorWallet ByronWalletPostData (AllowedMnemonics 'Trezor)
w -> ByronWalletPostData '[12, 15, 18, 21, 24] -> Value
forall a. ToJSON a => a -> Value
toJSON ByronWalletPostData '[12, 15, 18, 21, 24]
ByronWalletPostData (AllowedMnemonics 'Trezor)
w
            Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& (Text, Value) -> Value -> Value
withExtraField (Text
fieldName, Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByronWalletStyle -> Text
forall a. ToText a => a -> Text
toText ByronWalletStyle
Trezor)
        SomeLedgerWallet ByronWalletPostData (AllowedMnemonics 'Ledger)
w -> ByronWalletPostData '[12, 15, 18, 21, 24] -> Value
forall a. ToJSON a => a -> Value
toJSON ByronWalletPostData '[12, 15, 18, 21, 24]
ByronWalletPostData (AllowedMnemonics 'Ledger)
w
            Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& (Text, Value) -> Value -> Value
withExtraField (Text
fieldName, Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByronWalletStyle -> Text
forall a. ToText a => a -> Text
toText ByronWalletStyle
Ledger)
        SomeAccount AccountPostData
w -> AccountPostData -> Value
forall a. ToJSON a => a -> Value
toJSON AccountPostData
w
      where
        fieldName :: Text
        fieldName :: Text
fieldName = Text
"style"

instance FromJSON SomeByronWalletPostData where
    parseJSON :: Value -> Parser SomeByronWalletPostData
parseJSON = String
-> (Object -> Parser SomeByronWalletPostData)
-> Value
-> Parser SomeByronWalletPostData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SomeByronWallet" ((Object -> Parser SomeByronWalletPostData)
 -> Value -> Parser SomeByronWalletPostData)
-> (Object -> Parser SomeByronWalletPostData)
-> Value
-> Parser SomeByronWalletPostData
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        (Maybe ApiAccountPublicKey, Maybe Text)
choice <- (,) (Maybe ApiAccountPublicKey
 -> Maybe Text -> (Maybe ApiAccountPublicKey, Maybe Text))
-> Parser (Maybe ApiAccountPublicKey)
-> Parser (Maybe Text -> (Maybe ApiAccountPublicKey, Maybe Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe ApiAccountPublicKey)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"account_public_key" Parser (Maybe Text -> (Maybe ApiAccountPublicKey, Maybe Text))
-> Parser (Maybe Text)
-> Parser (Maybe ApiAccountPublicKey, Maybe Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"style"
        case (Maybe ApiAccountPublicKey, Maybe Text)
choice of
            (Maybe ApiAccountPublicKey
Nothing, Just Text
t) | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ByronWalletStyle -> Text
forall a. ToText a => a -> Text
toText ByronWalletStyle
Random ->
                (Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"passphrase_hash" :: Aeson.Parser (Maybe Text)) Parser (Maybe Text)
-> (Maybe Text -> Parser SomeByronWalletPostData)
-> Parser SomeByronWalletPostData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe Text
Nothing ->
                        ByronWalletPostData '[12, 15, 18, 21, 24]
-> SomeByronWalletPostData
ByronWalletPostData (AllowedMnemonics 'Random)
-> SomeByronWalletPostData
RandomWalletFromMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]
 -> SomeByronWalletPostData)
-> Parser (ByronWalletPostData '[12, 15, 18, 21, 24])
-> Parser SomeByronWalletPostData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ByronWalletPostData '[12, 15, 18, 21, 24])
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Aeson.Object Object
obj)
                    Just Text
_ ->
                        ByronWalletFromXPrvPostData -> SomeByronWalletPostData
RandomWalletFromXPrv (ByronWalletFromXPrvPostData -> SomeByronWalletPostData)
-> Parser ByronWalletFromXPrvPostData
-> Parser SomeByronWalletPostData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ByronWalletFromXPrvPostData
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Aeson.Object Object
obj)

            (Maybe ApiAccountPublicKey
Nothing, Just Text
t) | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ByronWalletStyle -> Text
forall a. ToText a => a -> Text
toText ByronWalletStyle
Icarus ->
                ByronWalletPostData '[12, 15, 18, 21, 24]
-> SomeByronWalletPostData
ByronWalletPostData (AllowedMnemonics 'Icarus)
-> SomeByronWalletPostData
SomeIcarusWallet (ByronWalletPostData '[12, 15, 18, 21, 24]
 -> SomeByronWalletPostData)
-> Parser (ByronWalletPostData '[12, 15, 18, 21, 24])
-> Parser SomeByronWalletPostData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ByronWalletPostData '[12, 15, 18, 21, 24])
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Aeson.Object Object
obj)

            (Maybe ApiAccountPublicKey
Nothing, Just Text
t) | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ByronWalletStyle -> Text
forall a. ToText a => a -> Text
toText ByronWalletStyle
Trezor ->
                    ByronWalletPostData '[12, 15, 18, 21, 24]
-> SomeByronWalletPostData
ByronWalletPostData (AllowedMnemonics 'Trezor)
-> SomeByronWalletPostData
SomeTrezorWallet (ByronWalletPostData '[12, 15, 18, 21, 24]
 -> SomeByronWalletPostData)
-> Parser (ByronWalletPostData '[12, 15, 18, 21, 24])
-> Parser SomeByronWalletPostData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ByronWalletPostData '[12, 15, 18, 21, 24])
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Aeson.Object Object
obj)

            (Maybe ApiAccountPublicKey
Nothing, Just Text
t) | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ByronWalletStyle -> Text
forall a. ToText a => a -> Text
toText ByronWalletStyle
Ledger ->
                    ByronWalletPostData '[12, 15, 18, 21, 24]
-> SomeByronWalletPostData
ByronWalletPostData (AllowedMnemonics 'Ledger)
-> SomeByronWalletPostData
SomeLedgerWallet (ByronWalletPostData '[12, 15, 18, 21, 24]
 -> SomeByronWalletPostData)
-> Parser (ByronWalletPostData '[12, 15, 18, 21, 24])
-> Parser SomeByronWalletPostData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ByronWalletPostData '[12, 15, 18, 21, 24])
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Aeson.Object Object
obj)

            (Just (ApiAccountPublicKey
_ :: ApiAccountPublicKey), Maybe Text
_) ->
                AccountPostData -> SomeByronWalletPostData
SomeAccount (AccountPostData -> SomeByronWalletPostData)
-> Parser AccountPostData -> Parser SomeByronWalletPostData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser AccountPostData
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Aeson.Object Object
obj)

            (Maybe ApiAccountPublicKey, Maybe Text)
_ ->
                String -> Parser SomeByronWalletPostData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unrecognized wallet's style."

withExtraField
    :: (Text, Value)
    -> Value
    -> Value
withExtraField :: (Text, Value) -> Value -> Value
withExtraField (Text
k,Value
v) = \case
    Aeson.Object Object
m -> Object -> Value
Aeson.Object (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
Aeson.insert (Text -> Key
Aeson.fromText Text
k) Value
v Object
m)
    Value
json -> Value
json

instance MkSomeMnemonic mw => FromJSON (ByronWalletPostData mw) where
    parseJSON :: Value -> Parser (ByronWalletPostData mw)
parseJSON = Options -> Value -> Parser (ByronWalletPostData mw)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON (ByronWalletPostData mw) where
    toJSON :: ByronWalletPostData mw -> Value
toJSON = Options -> ByronWalletPostData mw -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON (ApiT PassphraseHash) where
    parseJSON :: Value -> Parser (ApiT PassphraseHash)
parseJSON = Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Text)
-> (Text -> Parser (ApiT PassphraseHash))
-> Value
-> Parser (ApiT PassphraseHash)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either (ShowFmt TextDecodingError) (ApiT PassphraseHash)
-> Parser (ApiT PassphraseHash)
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt TextDecodingError) (ApiT PassphraseHash)
 -> Parser (ApiT PassphraseHash))
-> (Text
    -> Either (ShowFmt TextDecodingError) (ApiT PassphraseHash))
-> Text
-> Parser (ApiT PassphraseHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> Either TextDecodingError (ApiT PassphraseHash)
-> Either (ShowFmt TextDecodingError) (ApiT PassphraseHash)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt (Either TextDecodingError (ApiT PassphraseHash)
 -> Either (ShowFmt TextDecodingError) (ApiT PassphraseHash))
-> (Text -> Either TextDecodingError (ApiT PassphraseHash))
-> Text
-> Either (ShowFmt TextDecodingError) (ApiT PassphraseHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError (ApiT PassphraseHash)
forall a. FromText a => Text -> Either TextDecodingError a
fromText
instance ToJSON (ApiT PassphraseHash) where
    toJSON :: ApiT PassphraseHash -> Value
toJSON = ApiT PassphraseHash -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON (ApiT XPrv) where
    parseJSON :: Value -> Parser (ApiT XPrv)
parseJSON = Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Text)
-> (Text -> Parser (ApiT XPrv)) -> Value -> Parser (ApiT XPrv)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either (ShowFmt TextDecodingError) (ApiT XPrv)
-> Parser (ApiT XPrv)
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt TextDecodingError) (ApiT XPrv)
 -> Parser (ApiT XPrv))
-> (Text -> Either (ShowFmt TextDecodingError) (ApiT XPrv))
-> Text
-> Parser (ApiT XPrv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> Either TextDecodingError (ApiT XPrv)
-> Either (ShowFmt TextDecodingError) (ApiT XPrv)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt (Either TextDecodingError (ApiT XPrv)
 -> Either (ShowFmt TextDecodingError) (ApiT XPrv))
-> (Text -> Either TextDecodingError (ApiT XPrv))
-> Text
-> Either (ShowFmt TextDecodingError) (ApiT XPrv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError (ApiT XPrv)
forall a. FromText a => Text -> Either TextDecodingError a
fromText
instance ToJSON (ApiT XPrv) where
    toJSON :: ApiT XPrv -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (ApiT XPrv -> Text) -> ApiT XPrv -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT XPrv -> Text
forall a. ToText a => a -> Text
toText

instance FromJSON (ApiT (Hash "VerificationKey")) where
    parseJSON :: Value -> Parser (ApiT (Hash "VerificationKey"))
parseJSON = String -> Value -> Parser (ApiT (Hash "VerificationKey"))
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"VerificationKey Hash"
instance ToJSON (ApiT (Hash "VerificationKey")) where
    toJSON :: ApiT (Hash "VerificationKey") -> Value
toJSON = ApiT (Hash "VerificationKey") -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON (ApiT (Hash "TokenPolicy")) where
    parseJSON :: Value -> Parser (ApiT (Hash "TokenPolicy"))
parseJSON = String -> Value -> Parser (ApiT (Hash "TokenPolicy"))
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"TokenPolicy Hash"
instance ToJSON (ApiT (Hash "TokenPolicy")) where
    toJSON :: ApiT (Hash "TokenPolicy") -> Value
toJSON = ApiT (Hash "TokenPolicy") -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON ByronWalletFromXPrvPostData where
    parseJSON :: Value -> Parser ByronWalletFromXPrvPostData
parseJSON = Options -> Value -> Parser ByronWalletFromXPrvPostData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ByronWalletFromXPrvPostData where
    toJSON :: ByronWalletFromXPrvPostData -> Value
toJSON = Options -> ByronWalletFromXPrvPostData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON WalletPutData where
    parseJSON :: Value -> Parser WalletPutData
parseJSON = Options -> Value -> Parser WalletPutData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON  WalletPutData where
    toJSON :: WalletPutData -> Value
toJSON = Options -> WalletPutData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON SettingsPutData where
    parseJSON :: Value -> Parser SettingsPutData
parseJSON = Options -> Value -> Parser SettingsPutData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON  SettingsPutData where
    toJSON :: SettingsPutData -> Value
toJSON = Options -> SettingsPutData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON WalletPutPassphraseMnemonicData where
    parseJSON :: Value -> Parser WalletPutPassphraseMnemonicData
parseJSON = Options -> Value -> Parser WalletPutPassphraseMnemonicData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON WalletPutPassphraseMnemonicData where
    toJSON :: WalletPutPassphraseMnemonicData -> Value
toJSON = Options -> WalletPutPassphraseMnemonicData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON WalletPutPassphraseOldPassphraseData where
    parseJSON :: Value -> Parser WalletPutPassphraseOldPassphraseData
parseJSON = Options -> Value -> Parser WalletPutPassphraseOldPassphraseData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON  WalletPutPassphraseOldPassphraseData where
    toJSON :: WalletPutPassphraseOldPassphraseData -> Value
toJSON = Options -> WalletPutPassphraseOldPassphraseData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON WalletPutPassphraseData where
    parseJSON :: Value -> Parser WalletPutPassphraseData
parseJSON  =
        (Either
   WalletPutPassphraseOldPassphraseData
   WalletPutPassphraseMnemonicData
 -> WalletPutPassphraseData)
-> Parser
     (Either
        WalletPutPassphraseOldPassphraseData
        WalletPutPassphraseMnemonicData)
-> Parser WalletPutPassphraseData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either
  WalletPutPassphraseOldPassphraseData
  WalletPutPassphraseMnemonicData
-> WalletPutPassphraseData
WalletPutPassphraseData (Parser
   (Either
      WalletPutPassphraseOldPassphraseData
      WalletPutPassphraseMnemonicData)
 -> Parser WalletPutPassphraseData)
-> (Value
    -> Parser
         (Either
            WalletPutPassphraseOldPassphraseData
            WalletPutPassphraseMnemonicData))
-> Value
-> Parser WalletPutPassphraseData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> [Variant
      (Either
         WalletPutPassphraseOldPassphraseData
         WalletPutPassphraseMnemonicData)]
-> Value
-> Parser
     (Either
        WalletPutPassphraseOldPassphraseData
        WalletPutPassphraseMnemonicData)
forall a. String -> [Variant a] -> Value -> Parser a
variants String
"PutPassphrase data"
            [ String
-> (Object -> Bool)
-> (Value
    -> Parser
         (Either
            WalletPutPassphraseOldPassphraseData
            WalletPutPassphraseMnemonicData))
-> Variant
     (Either
        WalletPutPassphraseOldPassphraseData
        WalletPutPassphraseMnemonicData)
forall a.
String -> (Object -> Bool) -> (Value -> Parser a) -> Variant a
variant String
"old passphrase"
                    (Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
Aeson.member Key
"old_passphrase")
                    ((Value
  -> Parser
       (Either
          WalletPutPassphraseOldPassphraseData
          WalletPutPassphraseMnemonicData))
 -> Variant
      (Either
         WalletPutPassphraseOldPassphraseData
         WalletPutPassphraseMnemonicData))
-> (Value
    -> Parser
         (Either
            WalletPutPassphraseOldPassphraseData
            WalletPutPassphraseMnemonicData))
-> Variant
     (Either
        WalletPutPassphraseOldPassphraseData
        WalletPutPassphraseMnemonicData)
forall a b. (a -> b) -> a -> b
$ (WalletPutPassphraseOldPassphraseData
 -> Either
      WalletPutPassphraseOldPassphraseData
      WalletPutPassphraseMnemonicData)
-> Parser WalletPutPassphraseOldPassphraseData
-> Parser
     (Either
        WalletPutPassphraseOldPassphraseData
        WalletPutPassphraseMnemonicData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletPutPassphraseOldPassphraseData
-> Either
     WalletPutPassphraseOldPassphraseData
     WalletPutPassphraseMnemonicData
forall a b. a -> Either a b
Left (Parser WalletPutPassphraseOldPassphraseData
 -> Parser
      (Either
         WalletPutPassphraseOldPassphraseData
         WalletPutPassphraseMnemonicData))
-> (Value -> Parser WalletPutPassphraseOldPassphraseData)
-> Value
-> Parser
     (Either
        WalletPutPassphraseOldPassphraseData
        WalletPutPassphraseMnemonicData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser WalletPutPassphraseOldPassphraseData
forall a. FromJSON a => Value -> Parser a
parseJSON
            , String
-> (Object -> Bool)
-> (Value
    -> Parser
         (Either
            WalletPutPassphraseOldPassphraseData
            WalletPutPassphraseMnemonicData))
-> Variant
     (Either
        WalletPutPassphraseOldPassphraseData
        WalletPutPassphraseMnemonicData)
forall a.
String -> (Object -> Bool) -> (Value -> Parser a) -> Variant a
variant String
"mnemonic"
                    (Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
Aeson.member Key
"mnemonic_sentence")
                    ((Value
  -> Parser
       (Either
          WalletPutPassphraseOldPassphraseData
          WalletPutPassphraseMnemonicData))
 -> Variant
      (Either
         WalletPutPassphraseOldPassphraseData
         WalletPutPassphraseMnemonicData))
-> (Value
    -> Parser
         (Either
            WalletPutPassphraseOldPassphraseData
            WalletPutPassphraseMnemonicData))
-> Variant
     (Either
        WalletPutPassphraseOldPassphraseData
        WalletPutPassphraseMnemonicData)
forall a b. (a -> b) -> a -> b
$ (WalletPutPassphraseMnemonicData
 -> Either
      WalletPutPassphraseOldPassphraseData
      WalletPutPassphraseMnemonicData)
-> Parser WalletPutPassphraseMnemonicData
-> Parser
     (Either
        WalletPutPassphraseOldPassphraseData
        WalletPutPassphraseMnemonicData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletPutPassphraseMnemonicData
-> Either
     WalletPutPassphraseOldPassphraseData
     WalletPutPassphraseMnemonicData
forall a b. b -> Either a b
Right (Parser WalletPutPassphraseMnemonicData
 -> Parser
      (Either
         WalletPutPassphraseOldPassphraseData
         WalletPutPassphraseMnemonicData))
-> (Value -> Parser WalletPutPassphraseMnemonicData)
-> Value
-> Parser
     (Either
        WalletPutPassphraseOldPassphraseData
        WalletPutPassphraseMnemonicData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser WalletPutPassphraseMnemonicData
forall a. FromJSON a => Value -> Parser a
parseJSON
            ]

instance ToJSON  WalletPutPassphraseData where
    toJSON :: WalletPutPassphraseData -> Value
toJSON (WalletPutPassphraseData Either
  WalletPutPassphraseOldPassphraseData
  WalletPutPassphraseMnemonicData
x) = (WalletPutPassphraseOldPassphraseData -> Value)
-> (WalletPutPassphraseMnemonicData -> Value)
-> Either
     WalletPutPassphraseOldPassphraseData
     WalletPutPassphraseMnemonicData
-> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (Options -> WalletPutPassphraseOldPassphraseData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions)
        (Options -> WalletPutPassphraseMnemonicData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions)
        Either
  WalletPutPassphraseOldPassphraseData
  WalletPutPassphraseMnemonicData
x

instance FromJSON (ApiT PoolMetadataGCStatus) where
    parseJSON :: Value -> Parser (ApiT PoolMetadataGCStatus)
parseJSON = String
-> (Object -> Parser (ApiT PoolMetadataGCStatus))
-> Value
-> Parser (ApiT PoolMetadataGCStatus)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PoolMetadataGCStatus" ((Object -> Parser (ApiT PoolMetadataGCStatus))
 -> Value -> Parser (ApiT PoolMetadataGCStatus))
-> (Object -> Parser (ApiT PoolMetadataGCStatus))
-> Value
-> Parser (ApiT PoolMetadataGCStatus)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        (String
status' :: String) <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
        Maybe (ApiT Iso8601Time)
last_run <- Object
o Object -> Key -> Parser (Maybe (ApiT Iso8601Time))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_run"
        case (String
status', Maybe (ApiT Iso8601Time)
last_run) of
            (String
"restarting", Just (ApiT (Iso8601Time UTCTime
gctime)))
                -> ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus))
-> ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus)
forall a b. (a -> b) -> a -> b
$ PoolMetadataGCStatus -> ApiT PoolMetadataGCStatus
forall a. a -> ApiT a
ApiT (NominalDiffTime -> PoolMetadataGCStatus
Restarting (NominalDiffTime -> PoolMetadataGCStatus)
-> NominalDiffTime -> PoolMetadataGCStatus
forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds UTCTime
gctime)
            (String
"has_run", Just (ApiT (Iso8601Time UTCTime
gctime)))
                -> ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus))
-> ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus)
forall a b. (a -> b) -> a -> b
$ PoolMetadataGCStatus -> ApiT PoolMetadataGCStatus
forall a. a -> ApiT a
ApiT (NominalDiffTime -> PoolMetadataGCStatus
HasRun (NominalDiffTime -> PoolMetadataGCStatus)
-> NominalDiffTime -> PoolMetadataGCStatus
forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds UTCTime
gctime)
            (String
"restarting", Maybe (ApiT Iso8601Time)
Nothing)
                -> String -> Parser (ApiT PoolMetadataGCStatus)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing field last_run"
            (String
"has_run", Maybe (ApiT Iso8601Time)
Nothing)
                -> String -> Parser (ApiT PoolMetadataGCStatus)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing field last_run"
            (String
"not_applicable", Maybe (ApiT Iso8601Time)
_)
                -> ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus))
-> ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus)
forall a b. (a -> b) -> a -> b
$ PoolMetadataGCStatus -> ApiT PoolMetadataGCStatus
forall a. a -> ApiT a
ApiT PoolMetadataGCStatus
NotApplicable
            (String
"not_started", Maybe (ApiT Iso8601Time)
_)
                -> ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus))
-> ApiT PoolMetadataGCStatus -> Parser (ApiT PoolMetadataGCStatus)
forall a b. (a -> b) -> a -> b
$ PoolMetadataGCStatus -> ApiT PoolMetadataGCStatus
forall a. a -> ApiT a
ApiT PoolMetadataGCStatus
NotStarted
            (String, Maybe (ApiT Iso8601Time))
_ -> String -> Parser (ApiT PoolMetadataGCStatus)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown status: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
status')

instance ToJSON (ApiT PoolMetadataGCStatus) where
    toJSON :: ApiT PoolMetadataGCStatus -> Value
toJSON (ApiT (PoolMetadataGCStatus
NotApplicable)) =
        [Pair] -> Value
object [ Key
"status" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"not_applicable" ]
    toJSON (ApiT (PoolMetadataGCStatus
NotStarted)) =
        [Pair] -> Value
object [ Key
"status" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"not_started" ]
    toJSON (ApiT (Restarting NominalDiffTime
gctime)) =
        [Pair] -> Value
object [ Key
"status" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"restarting"
            , Key
"last_run" Key -> ApiT Iso8601Time -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Iso8601Time -> ApiT Iso8601Time
forall a. a -> ApiT a
ApiT (UTCTime -> Iso8601Time
Iso8601Time (NominalDiffTime -> UTCTime
posixSecondsToUTCTime NominalDiffTime
gctime)) ]
    toJSON (ApiT (HasRun NominalDiffTime
gctime)) =
        [Pair] -> Value
object [ Key
"status" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"has_run"
            , Key
"last_run" Key -> ApiT Iso8601Time -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Iso8601Time -> ApiT Iso8601Time
forall a. a -> ApiT a
ApiT (UTCTime -> Iso8601Time
Iso8601Time (NominalDiffTime -> UTCTime
posixSecondsToUTCTime NominalDiffTime
gctime)) ]

instance FromJSON ByronWalletPutPassphraseData where
    parseJSON :: Value -> Parser ByronWalletPutPassphraseData
parseJSON = Options -> Value -> Parser ByronWalletPutPassphraseData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ByronWalletPutPassphraseData where
    toJSON :: ByronWalletPutPassphraseData -> Value
toJSON = Options -> ByronWalletPutPassphraseData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiMaintenanceActionPostData where
    parseJSON :: Value -> Parser ApiMaintenanceActionPostData
parseJSON = Options -> Value -> Parser ApiMaintenanceActionPostData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiMaintenanceActionPostData where
    toJSON :: ApiMaintenanceActionPostData -> Value
toJSON = Options -> ApiMaintenanceActionPostData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiMaintenanceAction where
    parseJSON :: Value -> Parser ApiMaintenanceAction
parseJSON = Options -> Value -> Parser ApiMaintenanceAction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiMaintenanceAction where
    toJSON :: ApiMaintenanceAction -> Value
toJSON = Options -> ApiMaintenanceAction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON MaintenanceAction where
    parseJSON :: Value -> Parser MaintenanceAction
parseJSON = Options -> Value -> Parser MaintenanceAction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultSumTypeOptions
instance ToJSON MaintenanceAction where
    toJSON :: MaintenanceAction -> Value
toJSON = Options -> MaintenanceAction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultSumTypeOptions

instance FromJSON ApiTxId where
    parseJSON :: Value -> Parser ApiTxId
parseJSON = Options -> Value -> Parser ApiTxId
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiTxId where
    toJSON :: ApiTxId -> Value
toJSON = Options -> ApiTxId -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiFee where
    parseJSON :: Value -> Parser ApiFee
parseJSON = Options -> Value -> Parser ApiFee
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiFee where
    toJSON :: ApiFee -> Value
toJSON = Options -> ApiFee -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance (PassphraseMaxLength purpose, PassphraseMinLength purpose)
    => FromJSON (ApiT (Passphrase purpose)) where
    parseJSON :: Value -> Parser (ApiT (Passphrase purpose))
parseJSON = String -> Value -> Parser (ApiT (Passphrase purpose))
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"Passphrase"
instance ToJSON (ApiT (Passphrase purpose)) where
    toJSON :: ApiT (Passphrase purpose) -> Value
toJSON = ApiT (Passphrase purpose) -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON ApiCredential where
    parseJSON :: Value -> Parser ApiCredential
parseJSON Value
v =
        (ByteString -> ApiCredential
CredentialKeyHash (ByteString -> ApiCredential)
-> Parser ByteString -> Parser ApiCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Text] -> Value -> Parser ByteString
parseCredential Int
28 [Text
"stake_vkh",Text
"addr_vkh"] Value
v) Parser ApiCredential
-> Parser ApiCredential -> Parser ApiCredential
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (ByteString -> ApiCredential
CredentialPubKey (ByteString -> ApiCredential)
-> Parser ByteString -> Parser ApiCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Text] -> Value -> Parser ByteString
parseCredential Int
32 [Text
"stake_vk",Text
"addr_vk"] Value
v) Parser ApiCredential
-> Parser ApiCredential -> Parser ApiCredential
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (ByteString -> ApiCredential
CredentialExtendedPubKey (ByteString -> ApiCredential)
-> Parser ByteString -> Parser ApiCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Text] -> Value -> Parser ByteString
parseCredential Int
64 [Text
"stake_xvk",Text
"addr_xvk"] Value
v) Parser ApiCredential
-> Parser ApiCredential -> Parser ApiCredential
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (Script KeyHash -> ApiCredential
CredentialScript (Script KeyHash -> ApiCredential)
-> Parser (Script KeyHash) -> Parser ApiCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Script KeyHash)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

parseCredential
    :: Int
    -> [Text]
    -> Aeson.Value
    -> Aeson.Parser ByteString
parseCredential :: Int -> [Text] -> Value -> Parser ByteString
parseCredential Int
payloadLength [Text]
prefixes = String -> (Text -> Parser ByteString) -> Value -> Parser ByteString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Credential" ((Text -> Parser ByteString) -> Value -> Parser ByteString)
-> (Text -> Parser ByteString) -> Value -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \Text
txt ->
    case String -> Maybe (AbstractEncoding ())
detectEncoding (Text -> String
T.unpack Text
txt) of
        Just EBech32{} -> do
            (HumanReadablePart
hrp, DataPart
dp) <- case Text -> Either DecodingError (HumanReadablePart, DataPart)
Bech32.decodeLenient Text
txt of
                Left DecodingError
_ -> String -> Parser (HumanReadablePart, DataPart)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Credential's Bech32 has invalid text."
                Right (HumanReadablePart, DataPart)
res -> (HumanReadablePart, DataPart)
-> Parser (HumanReadablePart, DataPart)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HumanReadablePart, DataPart)
res
            let checkPayload :: ByteString -> Parser ByteString
checkPayload ByteString
bytes
                    | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
payloadLength =
                          String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString) -> String -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ String
"Credential must be "
                          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
payloadLength String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes."
                    | Bool
otherwise = ByteString -> Parser ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bytes
            let proceedWhenHrpCorrect :: Parser ByteString
proceedWhenHrpCorrect = case  DataPart -> Maybe ByteString
Bech32.dataPartToBytes DataPart
dp of
                    Maybe ByteString
Nothing ->
                          String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Credential has invalid Bech32 datapart."
                    Just ByteString
bytes -> ByteString -> Parser ByteString
checkPayload ByteString
bytes
            if HumanReadablePart -> Text
Bech32.humanReadablePartToText HumanReadablePart
hrp Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [Text]
prefixes then
                Parser ByteString
proceedWhenHrpCorrect
            else
                String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString) -> String -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ String
"Credential must have following prefixes: "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show [Text]
prefixes
        Maybe (AbstractEncoding ())
_ -> String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Credential must be must be encoded as Bech32."

instance ToJSON ApiCredential where
    toJSON :: ApiCredential -> Value
toJSON (CredentialPubKey ByteString
key') = do
        let hrp :: HumanReadablePart
hrp = [Bech32.humanReadablePart|addr_vk|]
        Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
hrp) ByteString
key'
    toJSON (CredentialExtendedPubKey ByteString
key') = do
        let hrp :: HumanReadablePart
hrp = [Bech32.humanReadablePart|addr_xvk|]
        Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
hrp) ByteString
key'
    toJSON (CredentialKeyHash ByteString
key') = do
        let hrp :: HumanReadablePart
hrp = [Bech32.humanReadablePart|addr_vkh|]
        Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
hrp) ByteString
key'
    toJSON (CredentialScript Script KeyHash
s) = Script KeyHash -> Value
forall a. ToJSON a => a -> Value
toJSON Script KeyHash
s

instance FromJSON ApiAddressData where
    parseJSON :: Value -> Parser ApiAddressData
parseJSON Value
v =
        Value -> Parser ApiAddressData
parseBaseAddr Value
v Parser ApiAddressData
-> Parser ApiAddressData -> Parser ApiAddressData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        Value -> Parser ApiAddressData
parseEnterprise Value
v Parser ApiAddressData
-> Parser ApiAddressData -> Parser ApiAddressData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        Value -> Parser ApiAddressData
parseRewardAccount Value
v Parser ApiAddressData
-> Parser ApiAddressData -> Parser ApiAddressData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        String -> Parser ApiAddressData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msgError
      where
         msgError :: String
msgError =
             String
"Address must have at least one valid credential. When script is\
             \ used as a credential it must have only bech32 encoded verification keys\
             \ with possible prefixes: 'stake_shared_vkh', 'stake_shared_vk', 'stake_shared_xvk', \
             \'addr_shared_vkh', 'addr_shared_vk' or 'addr_shared_xvk' and proper \
             \payload size. 'at_least' cannot exceed 255. When public key is used as a credential \
             \then bech32 encoded public keys are expected to be used with possible prefixes: \
             \'stake_xvk', 'addr_xvk', 'stake_vk' or 'addr_vk', always with proper payload size \
             \(32-byte and 64-byte payload for non-extended and extended credential, respectively). \
             \When key hash is used as a credential then bech32 encoded public keys are expected \
             \to be used with possible prefixes: 'stake_vkh' or 'addr_vkh', always with 28-byte \
             \payload size."
         parseBaseAddr :: Value -> Parser ApiAddressData
parseBaseAddr = String
-> (Object -> Parser ApiAddressData)
-> Value
-> Parser ApiAddressData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AddrBase" ((Object -> Parser ApiAddressData)
 -> Value -> Parser ApiAddressData)
-> (Object -> Parser ApiAddressData)
-> Value
-> Parser ApiAddressData
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
             ApiAddressDataPayload
addr <- ApiCredential -> ApiCredential -> ApiAddressDataPayload
AddrBase (ApiCredential -> ApiCredential -> ApiAddressDataPayload)
-> Parser ApiCredential
-> Parser (ApiCredential -> ApiAddressDataPayload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApiCredential
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"payment" Parser (ApiCredential -> ApiAddressDataPayload)
-> Parser ApiCredential -> Parser ApiAddressDataPayload
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApiCredential
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stake"
             ApiAddressDataPayload
-> Maybe (ApiT ValidationLevel) -> ApiAddressData
ApiAddressData ApiAddressDataPayload
addr (Maybe (ApiT ValidationLevel) -> ApiAddressData)
-> Parser (Maybe (ApiT ValidationLevel)) -> Parser ApiAddressData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (ApiT ValidationLevel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"validation"
         parseEnterprise :: Value -> Parser ApiAddressData
parseEnterprise = String
-> (Object -> Parser ApiAddressData)
-> Value
-> Parser ApiAddressData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AddrEnterprise" ((Object -> Parser ApiAddressData)
 -> Value -> Parser ApiAddressData)
-> (Object -> Parser ApiAddressData)
-> Value
-> Parser ApiAddressData
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
             ApiAddressDataPayload
addr <- ApiCredential -> ApiAddressDataPayload
AddrEnterprise (ApiCredential -> ApiAddressDataPayload)
-> Parser ApiCredential -> Parser ApiAddressDataPayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApiCredential
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"payment"
             ApiAddressDataPayload
-> Maybe (ApiT ValidationLevel) -> ApiAddressData
ApiAddressData ApiAddressDataPayload
addr (Maybe (ApiT ValidationLevel) -> ApiAddressData)
-> Parser (Maybe (ApiT ValidationLevel)) -> Parser ApiAddressData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (ApiT ValidationLevel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"validation"
         parseRewardAccount :: Value -> Parser ApiAddressData
parseRewardAccount = String
-> (Object -> Parser ApiAddressData)
-> Value
-> Parser ApiAddressData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AddrRewardAccount" ((Object -> Parser ApiAddressData)
 -> Value -> Parser ApiAddressData)
-> (Object -> Parser ApiAddressData)
-> Value
-> Parser ApiAddressData
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
             ApiAddressDataPayload
addr <- ApiCredential -> ApiAddressDataPayload
AddrRewardAccount (ApiCredential -> ApiAddressDataPayload)
-> Parser ApiCredential -> Parser ApiAddressDataPayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApiCredential
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stake"
             ApiAddressDataPayload
-> Maybe (ApiT ValidationLevel) -> ApiAddressData
ApiAddressData ApiAddressDataPayload
addr (Maybe (ApiT ValidationLevel) -> ApiAddressData)
-> Parser (Maybe (ApiT ValidationLevel)) -> Parser ApiAddressData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (ApiT ValidationLevel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"validation"

instance ToJSON ApiAddressData where
    toJSON :: ApiAddressData -> Value
toJSON (ApiAddressData (AddrEnterprise ApiCredential
payment') Maybe (ApiT ValidationLevel)
validation') =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Key
"payment" Key -> ApiCredential -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiCredential
payment') Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Maybe (ApiT ValidationLevel) -> [Pair]
forall a v. (KeyValue a, ToJSON v) => Maybe v -> [a]
addOptionally Maybe (ApiT ValidationLevel)
validation'
    toJSON (ApiAddressData (AddrRewardAccount ApiCredential
stake') Maybe (ApiT ValidationLevel)
validation') =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Key
"stake" Key -> ApiCredential -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiCredential
stake') Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Maybe (ApiT ValidationLevel) -> [Pair]
forall a v. (KeyValue a, ToJSON v) => Maybe v -> [a]
addOptionally Maybe (ApiT ValidationLevel)
validation'
    toJSON (ApiAddressData (AddrBase ApiCredential
payment' ApiCredential
stake') Maybe (ApiT ValidationLevel)
validation') =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Key
"payment" Key -> ApiCredential -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiCredential
payment', Key
"stake" Key -> ApiCredential -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiCredential
stake'] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Maybe (ApiT ValidationLevel) -> [Pair]
forall a v. (KeyValue a, ToJSON v) => Maybe v -> [a]
addOptionally Maybe (ApiT ValidationLevel)
validation'

addOptionally :: (Aeson.KeyValue a, ToJSON v) => Maybe v -> [a]
addOptionally :: Maybe v -> [a]
addOptionally Maybe v
v = case Maybe v
v of
    Just v
v' -> [Key
"validation" Key -> v -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
v']
    Maybe v
Nothing -> []

instance FromJSON (ApiT ValidationLevel) where
    parseJSON :: Value -> Parser (ApiT ValidationLevel)
parseJSON =
        Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Text)
-> (Text -> Parser (ApiT ValidationLevel))
-> Value
-> Parser (ApiT ValidationLevel)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either (ShowFmt TextDecodingError) (ApiT ValidationLevel)
-> Parser (ApiT ValidationLevel)
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt TextDecodingError) (ApiT ValidationLevel)
 -> Parser (ApiT ValidationLevel))
-> (Text
    -> Either (ShowFmt TextDecodingError) (ApiT ValidationLevel))
-> Text
-> Parser (ApiT ValidationLevel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> Either TextDecodingError (ApiT ValidationLevel)
-> Either (ShowFmt TextDecodingError) (ApiT ValidationLevel)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt (Either TextDecodingError (ApiT ValidationLevel)
 -> Either (ShowFmt TextDecodingError) (ApiT ValidationLevel))
-> (Text -> Either TextDecodingError (ApiT ValidationLevel))
-> Text
-> Either (ShowFmt TextDecodingError) (ApiT ValidationLevel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError (ApiT ValidationLevel)
forall a. FromText a => Text -> Either TextDecodingError a
fromText
instance ToJSON (ApiT ValidationLevel) where
    toJSON :: ApiT ValidationLevel -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (ApiT ValidationLevel -> Text) -> ApiT ValidationLevel -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT ValidationLevel -> Text
forall a. ToText a => a -> Text
toText

instance FromJSON AnyAddress where
    parseJSON :: Value -> Parser AnyAddress
parseJSON = String -> Text -> Value -> Parser AnyAddress
forall a. FromText a => String -> Text -> Value -> Parser a
parseFromText String
"AnyAddress" Text
"address"

parseFromText :: FromText a => String -> Text -> Aeson.Value -> Aeson.Parser a
parseFromText :: String -> Text -> Value -> Parser a
parseFromText String
typeName Text
k = String -> (Object -> Parser a) -> Value -> Parser a
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
typeName ((Object -> Parser a) -> Value -> Parser a)
-> (Object -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
v <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: (Text -> Key
Aeson.fromText Text
k)
    case Text -> Either TextDecodingError a
forall a. FromText a => Text -> Either TextDecodingError a
fromText Text
v of
        Right a
bytes -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
bytes
        Left (TextDecodingError String
err) -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err

instance ToJSON AnyAddress where
    toJSON :: AnyAddress -> Value
toJSON (AnyAddress ByteString
p AnyAddressType
addrType Int
net) =
        [Pair] -> Value
object [ Key
"address" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
T.decodeUtf8 (Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
hrp) ByteString
p) ]
      where
        Right HumanReadablePart
hrp = Text -> Either HumanReadablePartError HumanReadablePart
Bech32.humanReadablePartFromText (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix)
        prefix :: Text
prefix = case AnyAddressType
addrType of
                AnyAddressType
EnterpriseDelegating -> Text
"addr"
                AnyAddressType
RewardAccount -> Text
"stake"
        suffix :: Text
suffix = if Int
net Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
mainnetId then Text
"" else Text
"_test"
        mainnetId :: Int
mainnetId = Int
1 :: Int

instance MkSomeMnemonic sizes => FromJSON (ApiMnemonicT sizes)
  where
    parseJSON :: Value -> Parser (ApiMnemonicT sizes)
parseJSON Value
bytes = do
        [Text]
xs <- Value -> Parser [Text]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
bytes
        SomeMnemonic
m <- Either (ShowFmt String) SomeMnemonic -> Parser SomeMnemonic
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt String) SomeMnemonic -> Parser SomeMnemonic)
-> Either (ShowFmt String) SomeMnemonic -> Parser SomeMnemonic
forall a b. (a -> b) -> a -> b
$ (MkSomeMnemonicError sizes -> ShowFmt String)
-> Either (MkSomeMnemonicError sizes) SomeMnemonic
-> Either (ShowFmt String) SomeMnemonic
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (String -> ShowFmt String
forall a. a -> ShowFmt a
ShowFmt (String -> ShowFmt String)
-> (MkSomeMnemonicError sizes -> String)
-> MkSomeMnemonicError sizes
-> ShowFmt String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MkSomeMnemonicError sizes -> String
forall (sz :: [Nat]). MkSomeMnemonicError sz -> String
getMkSomeMnemonicError) (Either (MkSomeMnemonicError sizes) SomeMnemonic
 -> Either (ShowFmt String) SomeMnemonic)
-> Either (MkSomeMnemonicError sizes) SomeMnemonic
-> Either (ShowFmt String) SomeMnemonic
forall a b. (a -> b) -> a -> b
$ [Text] -> Either (MkSomeMnemonicError sizes) SomeMnemonic
forall (sz :: [Nat]).
MkSomeMnemonic sz =>
[Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic
mkSomeMnemonic @sizes [Text]
xs
        ApiMnemonicT sizes -> Parser (ApiMnemonicT sizes)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiMnemonicT sizes -> Parser (ApiMnemonicT sizes))
-> ApiMnemonicT sizes -> Parser (ApiMnemonicT sizes)
forall a b. (a -> b) -> a -> b
$ SomeMnemonic -> ApiMnemonicT sizes
forall (sizes :: [Nat]). SomeMnemonic -> ApiMnemonicT sizes
ApiMnemonicT SomeMnemonic
m

instance ToJSON (ApiMnemonicT sizes) where
    toJSON :: ApiMnemonicT sizes -> Value
toJSON (ApiMnemonicT (SomeMnemonic Mnemonic mw
mw)) = [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON (Mnemonic mw -> [Text]
forall (mw :: Nat). Mnemonic mw -> [Text]
mnemonicToText Mnemonic mw
mw)

instance FromJSON (ApiT WalletId) where
    parseJSON :: Value -> Parser (ApiT WalletId)
parseJSON = String -> Value -> Parser (ApiT WalletId)
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"WalletId"
instance ToJSON (ApiT WalletId) where
    toJSON :: ApiT WalletId -> Value
toJSON = ApiT WalletId -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON (ApiT AddressPoolGap) where
    parseJSON :: Value -> Parser (ApiT AddressPoolGap)
parseJSON = Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Integer)
-> (Integer -> Parser (ApiT AddressPoolGap))
-> Value
-> Parser (ApiT AddressPoolGap)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        Either (ShowFmt TextDecodingError) (ApiT AddressPoolGap)
-> Parser (ApiT AddressPoolGap)
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt TextDecodingError) (ApiT AddressPoolGap)
 -> Parser (ApiT AddressPoolGap))
-> (Integer
    -> Either (ShowFmt TextDecodingError) (ApiT AddressPoolGap))
-> Integer
-> Parser (ApiT AddressPoolGap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> (AddressPoolGap -> ApiT AddressPoolGap)
-> Either TextDecodingError AddressPoolGap
-> Either (ShowFmt TextDecodingError) (ApiT AddressPoolGap)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt AddressPoolGap -> ApiT AddressPoolGap
forall a. a -> ApiT a
ApiT (Either TextDecodingError AddressPoolGap
 -> Either (ShowFmt TextDecodingError) (ApiT AddressPoolGap))
-> (Integer -> Either TextDecodingError AddressPoolGap)
-> Integer
-> Either (ShowFmt TextDecodingError) (ApiT AddressPoolGap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError AddressPoolGap
forall a. FromText a => Text -> Either TextDecodingError a
fromText (Text -> Either TextDecodingError AddressPoolGap)
-> (Integer -> Text)
-> Integer
-> Either TextDecodingError AddressPoolGap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Show Integer => Integer -> String
forall a. Show a => a -> String
show @Integer
instance ToJSON (ApiT AddressPoolGap) where
    toJSON :: ApiT AddressPoolGap -> Value
toJSON = Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON (Word32 -> Value)
-> (ApiT AddressPoolGap -> Word32) -> ApiT AddressPoolGap -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressPoolGap -> Word32
getAddressPoolGap (AddressPoolGap -> Word32)
-> (ApiT AddressPoolGap -> AddressPoolGap)
-> ApiT AddressPoolGap
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT AddressPoolGap -> AddressPoolGap
forall a. ApiT a -> a
getApiT

instance FromJSON ApiWalletBalance where
    parseJSON :: Value -> Parser ApiWalletBalance
parseJSON = Options -> Value -> Parser ApiWalletBalance
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiWalletBalance where
    toJSON :: ApiWalletBalance -> Value
toJSON = Options -> ApiWalletBalance -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

data ApiByronWalletBalance = ApiByronWalletBalance
    { ApiByronWalletBalance -> Quantity "lovelace" Natural
available :: !(Quantity "lovelace" Natural)
    , ApiByronWalletBalance -> Quantity "lovelace" Natural
total :: !(Quantity "lovelace" Natural)
    } deriving (ApiByronWalletBalance -> ApiByronWalletBalance -> Bool
(ApiByronWalletBalance -> ApiByronWalletBalance -> Bool)
-> (ApiByronWalletBalance -> ApiByronWalletBalance -> Bool)
-> Eq ApiByronWalletBalance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiByronWalletBalance -> ApiByronWalletBalance -> Bool
$c/= :: ApiByronWalletBalance -> ApiByronWalletBalance -> Bool
== :: ApiByronWalletBalance -> ApiByronWalletBalance -> Bool
$c== :: ApiByronWalletBalance -> ApiByronWalletBalance -> Bool
Eq, (forall x. ApiByronWalletBalance -> Rep ApiByronWalletBalance x)
-> (forall x. Rep ApiByronWalletBalance x -> ApiByronWalletBalance)
-> Generic ApiByronWalletBalance
forall x. Rep ApiByronWalletBalance x -> ApiByronWalletBalance
forall x. ApiByronWalletBalance -> Rep ApiByronWalletBalance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiByronWalletBalance x -> ApiByronWalletBalance
$cfrom :: forall x. ApiByronWalletBalance -> Rep ApiByronWalletBalance x
Generic, Int -> ApiByronWalletBalance -> ShowS
[ApiByronWalletBalance] -> ShowS
ApiByronWalletBalance -> String
(Int -> ApiByronWalletBalance -> ShowS)
-> (ApiByronWalletBalance -> String)
-> ([ApiByronWalletBalance] -> ShowS)
-> Show ApiByronWalletBalance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiByronWalletBalance] -> ShowS
$cshowList :: [ApiByronWalletBalance] -> ShowS
show :: ApiByronWalletBalance -> String
$cshow :: ApiByronWalletBalance -> String
showsPrec :: Int -> ApiByronWalletBalance -> ShowS
$cshowsPrec :: Int -> ApiByronWalletBalance -> ShowS
Show)
      deriving anyclass ApiByronWalletBalance -> ()
(ApiByronWalletBalance -> ()) -> NFData ApiByronWalletBalance
forall a. (a -> ()) -> NFData a
rnf :: ApiByronWalletBalance -> ()
$crnf :: ApiByronWalletBalance -> ()
NFData

instance FromJSON ApiByronWalletBalance where
    parseJSON :: Value -> Parser ApiByronWalletBalance
parseJSON = Options -> Value -> Parser ApiByronWalletBalance
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiByronWalletBalance where
    toJSON :: ApiByronWalletBalance -> Value
toJSON = Options -> ApiByronWalletBalance -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiWalletAssetsBalance where
    parseJSON :: Value -> Parser ApiWalletAssetsBalance
parseJSON = Options -> Value -> Parser ApiWalletAssetsBalance
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiWalletAssetsBalance where
    toJSON :: ApiWalletAssetsBalance -> Value
toJSON = Options -> ApiWalletAssetsBalance -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON (ApiT W.TokenMap) where
    parseJSON :: Value -> Parser (ApiT TokenMap)
parseJSON = (Flat TokenMap -> ApiT TokenMap)
-> Parser (Flat TokenMap) -> Parser (ApiT TokenMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT (TokenMap -> ApiT TokenMap)
-> (Flat TokenMap -> TokenMap) -> Flat TokenMap -> ApiT TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flat TokenMap -> TokenMap
forall a. Flat a -> a
W.getFlat) (Parser (Flat TokenMap) -> Parser (ApiT TokenMap))
-> (Value -> Parser (Flat TokenMap))
-> Value
-> Parser (ApiT TokenMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (Flat TokenMap)
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON (ApiT W.TokenMap) where
    toJSON :: ApiT TokenMap -> Value
toJSON = Flat TokenMap -> Value
forall a. ToJSON a => a -> Value
toJSON (Flat TokenMap -> Value)
-> (ApiT TokenMap -> Flat TokenMap) -> ApiT TokenMap -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> Flat TokenMap
forall a. a -> Flat a
W.Flat (TokenMap -> Flat TokenMap)
-> (ApiT TokenMap -> TokenMap) -> ApiT TokenMap -> Flat TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT TokenMap -> TokenMap
forall a. ApiT a -> a
getApiT

instance FromJSON (ApiT PoolId) where
    parseJSON :: Value -> Parser (ApiT PoolId)
parseJSON = Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Text)
-> (Text -> Parser (ApiT PoolId)) -> Value -> Parser (ApiT PoolId)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either (ShowFmt TextDecodingError) (ApiT PoolId)
-> Parser (ApiT PoolId)
forall s a. Show s => Either s a -> Parser a
eitherToParser
           (Either (ShowFmt TextDecodingError) (ApiT PoolId)
 -> Parser (ApiT PoolId))
-> (Text -> Either (ShowFmt TextDecodingError) (ApiT PoolId))
-> Text
-> Parser (ApiT PoolId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> (PoolId -> ApiT PoolId)
-> Either TextDecodingError PoolId
-> Either (ShowFmt TextDecodingError) (ApiT PoolId)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt PoolId -> ApiT PoolId
forall a. a -> ApiT a
ApiT
           (Either TextDecodingError PoolId
 -> Either (ShowFmt TextDecodingError) (ApiT PoolId))
-> (Text -> Either TextDecodingError PoolId)
-> Text
-> Either (ShowFmt TextDecodingError) (ApiT PoolId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError PoolId
decodePoolIdBech32
instance ToJSON (ApiT PoolId) where
    toJSON :: ApiT PoolId -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (ApiT PoolId -> Text) -> ApiT PoolId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolId -> Text
encodePoolIdBech32 (PoolId -> Text) -> (ApiT PoolId -> PoolId) -> ApiT PoolId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT PoolId -> PoolId
forall a. ApiT a -> a
getApiT

instance FromJSON ApiWalletDelegationStatus where
    parseJSON :: Value -> Parser ApiWalletDelegationStatus
parseJSON = Options -> Value -> Parser ApiWalletDelegationStatus
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultSumTypeOptions
instance ToJSON ApiWalletDelegationStatus where
    toJSON :: ApiWalletDelegationStatus -> Value
toJSON = Options -> ApiWalletDelegationStatus -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultSumTypeOptions

instance FromJSON ApiWalletDelegation where
    parseJSON :: Value -> Parser ApiWalletDelegation
parseJSON = Options -> Value -> Parser ApiWalletDelegation
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiWalletDelegation where
    toJSON :: ApiWalletDelegation -> Value
toJSON = Options -> ApiWalletDelegation -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiWalletDelegationNext where
    parseJSON :: Value -> Parser ApiWalletDelegationNext
parseJSON = Options -> Value -> Parser ApiWalletDelegationNext
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiWalletDelegationNext where
    toJSON :: ApiWalletDelegationNext -> Value
toJSON = Options -> ApiWalletDelegationNext -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiStakePool where
    parseJSON :: Value -> Parser ApiStakePool
parseJSON = Options -> Value -> Parser ApiStakePool
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiStakePool where
    toJSON :: ApiStakePool -> Value
toJSON = Options -> ApiStakePool -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiStakePoolMetrics where
    parseJSON :: Value -> Parser ApiStakePoolMetrics
parseJSON = Options -> Value -> Parser ApiStakePoolMetrics
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiStakePoolMetrics where
    toJSON :: ApiStakePoolMetrics -> Value
toJSON = Options -> ApiStakePoolMetrics -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiStakePoolFlag where
    parseJSON :: Value -> Parser ApiStakePoolFlag
parseJSON = Options -> Value -> Parser ApiStakePoolFlag
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultSumTypeOptions
instance ToJSON ApiStakePoolFlag where
    toJSON :: ApiStakePoolFlag -> Value
toJSON = Options -> ApiStakePoolFlag -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultSumTypeOptions

instance FromJSON (ApiT WalletName) where
    parseJSON :: Value -> Parser (ApiT WalletName)
parseJSON = String -> Value -> Parser (ApiT WalletName)
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"WalletName"
instance ToJSON (ApiT WalletName) where
    toJSON :: ApiT WalletName -> Value
toJSON = ApiT WalletName -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON (ApiT W.Settings) where
    parseJSON :: Value -> Parser (ApiT Settings)
parseJSON = (Settings -> ApiT Settings)
-> Parser Settings -> Parser (ApiT Settings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Settings -> ApiT Settings
forall a. a -> ApiT a
ApiT (Parser Settings -> Parser (ApiT Settings))
-> (Value -> Parser Settings) -> Value -> Parser (ApiT Settings)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Value -> Parser Settings
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON (ApiT W.Settings) where
    toJSON :: ApiT Settings -> Value
toJSON = Options -> Settings -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions (Settings -> Value)
-> (ApiT Settings -> Settings) -> ApiT Settings -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT Settings -> Settings
forall a. ApiT a -> a
getApiT

instance FromJSON ApiWalletPassphraseInfo where
    parseJSON :: Value -> Parser ApiWalletPassphraseInfo
parseJSON = Options -> Value -> Parser ApiWalletPassphraseInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiWalletPassphraseInfo where
    toJSON :: ApiWalletPassphraseInfo -> Value
toJSON = Options -> ApiWalletPassphraseInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON (ApiT SyncProgress) where
    parseJSON :: Value -> Parser (ApiT SyncProgress)
parseJSON = (SyncProgress -> ApiT SyncProgress)
-> Parser SyncProgress -> Parser (ApiT SyncProgress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SyncProgress -> ApiT SyncProgress
forall a. a -> ApiT a
ApiT (Parser SyncProgress -> Parser (ApiT SyncProgress))
-> (Value -> Parser SyncProgress)
-> Value
-> Parser (ApiT SyncProgress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Value -> Parser SyncProgress
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
syncProgressOptions
instance ToJSON (ApiT SyncProgress) where
    toJSON :: ApiT SyncProgress -> Value
toJSON = Options -> SyncProgress -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
syncProgressOptions (SyncProgress -> Value)
-> (ApiT SyncProgress -> SyncProgress)
-> ApiT SyncProgress
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT SyncProgress -> SyncProgress
forall a. ApiT a -> a
getApiT

instance FromJSON ApiUtxoStatistics where
    parseJSON :: Value -> Parser ApiUtxoStatistics
parseJSON = Options -> Value -> Parser ApiUtxoStatistics
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiUtxoStatistics where
    toJSON :: ApiUtxoStatistics -> Value
toJSON = Options -> ApiUtxoStatistics -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance ToJSON (ApiT BoundType) where
    toJSON :: ApiT BoundType -> Value
toJSON = Options -> BoundType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultSumTypeOptions (BoundType -> Value)
-> (ApiT BoundType -> BoundType) -> ApiT BoundType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT BoundType -> BoundType
forall a. ApiT a -> a
getApiT
instance FromJSON (ApiT BoundType) where
    parseJSON :: Value -> Parser (ApiT BoundType)
parseJSON = (BoundType -> ApiT BoundType)
-> Parser BoundType -> Parser (ApiT BoundType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BoundType -> ApiT BoundType
forall a. a -> ApiT a
ApiT (Parser BoundType -> Parser (ApiT BoundType))
-> (Value -> Parser BoundType) -> Value -> Parser (ApiT BoundType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Value -> Parser BoundType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultSumTypeOptions

instance (HasBase base, ByteArray bs) => FromJSON (ApiBytesT base bs) where
    parseJSON :: Value -> Parser (ApiBytesT base bs)
parseJSON = String
-> (Text -> Parser (ApiBytesT base bs))
-> Value
-> Parser (ApiBytesT base bs)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText (TypeRep -> String
forall a. Show a => a -> String
show (Proxy base -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy base
forall k (t :: k). Proxy t
Proxy @base)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ByteString") ((Text -> Parser (ApiBytesT base bs))
 -> Value -> Parser (ApiBytesT base bs))
-> (Text -> Parser (ApiBytesT base bs))
-> Value
-> Parser (ApiBytesT base bs)
forall a b. (a -> b) -> a -> b
$
        Either (ShowFmt TextDecodingError) (ApiBytesT base bs)
-> Parser (ApiBytesT base bs)
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt TextDecodingError) (ApiBytesT base bs)
 -> Parser (ApiBytesT base bs))
-> (Text -> Either (ShowFmt TextDecodingError) (ApiBytesT base bs))
-> Text
-> Parser (ApiBytesT base bs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> Either TextDecodingError (ApiBytesT base bs)
-> Either (ShowFmt TextDecodingError) (ApiBytesT base bs)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt (Either TextDecodingError (ApiBytesT base bs)
 -> Either (ShowFmt TextDecodingError) (ApiBytesT base bs))
-> (Text -> Either TextDecodingError (ApiBytesT base bs))
-> Text
-> Either (ShowFmt TextDecodingError) (ApiBytesT base bs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromText (ApiBytesT base bs) =>
Text -> Either TextDecodingError (ApiBytesT base bs)
forall a. FromText a => Text -> Either TextDecodingError a
fromText @(ApiBytesT base bs)

instance (HasBase base, ByteArrayAccess bs) => ToJSON (ApiBytesT base bs) where
    toJSON :: ApiBytesT base bs -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (ApiBytesT base bs -> Text) -> ApiBytesT base bs -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToText (ApiBytesT base bs) => ApiBytesT base bs -> Text
forall a. ToText a => a -> Text
toText @(ApiBytesT base bs)

instance FromJSON (ApiT SealedTx) where
    parseJSON :: Value -> Parser (ApiT SealedTx)
parseJSON Value
v = do
        SealedTx
tx <- Value -> Parser SealedTx
forall (base :: Base). HasBase base => Value -> Parser SealedTx
parseSealedTxBytes @'Base16 Value
v Parser SealedTx -> Parser SealedTx -> Parser SealedTx
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser SealedTx
forall (base :: Base). HasBase base => Value -> Parser SealedTx
parseSealedTxBytes @'Base64 Value
v
        ApiT SealedTx -> Parser (ApiT SealedTx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiT SealedTx -> Parser (ApiT SealedTx))
-> ApiT SealedTx -> Parser (ApiT SealedTx)
forall a b. (a -> b) -> a -> b
$ SealedTx -> ApiT SealedTx
forall a. a -> ApiT a
ApiT SealedTx
tx

instance ToJSON (ApiT SealedTx) where
    toJSON :: ApiT SealedTx -> Value
toJSON = HasBase 'Base64 => SealedTx -> Value
forall (base :: Base). HasBase base => SealedTx -> Value
sealedTxBytesValue @'Base64 (SealedTx -> Value)
-> (ApiT SealedTx -> SealedTx) -> ApiT SealedTx -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT SealedTx -> SealedTx
forall a. ApiT a -> a
getApiT

parseSealedTxBytes
    :: forall (base :: Base). HasBase base => Value -> Parser SealedTx
parseSealedTxBytes :: Value -> Parser SealedTx
parseSealedTxBytes =
    (Either (ShowFmt DecoderError) SealedTx -> Parser SealedTx
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt DecoderError) SealedTx -> Parser SealedTx)
-> (ByteString -> Either (ShowFmt DecoderError) SealedTx)
-> ByteString
-> Parser SealedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DecoderError -> ShowFmt DecoderError)
-> Either DecoderError SealedTx
-> Either (ShowFmt DecoderError) SealedTx
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> ShowFmt DecoderError
forall a. a -> ShowFmt a
ShowFmt (Either DecoderError SealedTx
 -> Either (ShowFmt DecoderError) SealedTx)
-> (ByteString -> Either DecoderError SealedTx)
-> ByteString
-> Either (ShowFmt DecoderError) SealedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DecoderError SealedTx
sealedTxFromBytes)
    (ByteString -> Parser SealedTx)
-> (Value -> Parser ByteString) -> Value -> Parser SealedTx
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ((ApiBytesT base ByteString -> ByteString)
-> Parser (ApiBytesT base ByteString) -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ApiBytesT base ByteString -> ByteString
forall (base :: Base) bs. ApiBytesT base bs -> bs
getApiBytesT (Parser (ApiBytesT base ByteString) -> Parser ByteString)
-> (Value -> Parser (ApiBytesT base ByteString))
-> Value
-> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromJSON (ApiBytesT base ByteString) =>
Value -> Parser (ApiBytesT base ByteString)
forall a. FromJSON a => Value -> Parser a
parseJSON @(ApiBytesT base ByteString))

sealedTxBytesValue :: forall (base :: Base). HasBase base => SealedTx -> Value
sealedTxBytesValue :: SealedTx -> Value
sealedTxBytesValue = ApiBytesT base ByteString -> Value
forall a. ToJSON a => a -> Value
toJSON (ApiBytesT base ByteString -> Value)
-> (SealedTx -> ApiBytesT base ByteString) -> SealedTx -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bs. bs -> ApiBytesT base bs
forall (base :: Base) bs. bs -> ApiBytesT base bs
ApiBytesT @base (ByteString -> ApiBytesT base ByteString)
-> (SealedTx -> ByteString)
-> SealedTx
-> ApiBytesT base ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> Const ByteString ByteString)
 -> SealedTx -> Const ByteString SealedTx)
-> SealedTx -> ByteString
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "serialisedTx"
  ((ByteString -> Const ByteString ByteString)
   -> SealedTx -> Const ByteString SealedTx)
(ByteString -> Const ByteString ByteString)
-> SealedTx -> Const ByteString SealedTx
#serialisedTx

instance FromJSON ApiSerialisedTransaction where
    parseJSON :: Value -> Parser ApiSerialisedTransaction
parseJSON = Options -> Value -> Parser ApiSerialisedTransaction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiSerialisedTransaction where
    toJSON :: ApiSerialisedTransaction -> Value
toJSON = Options -> ApiSerialisedTransaction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiSignTransactionPostData where
    parseJSON :: Value -> Parser ApiSignTransactionPostData
parseJSON = Options -> Value -> Parser ApiSignTransactionPostData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
strictRecordTypeOptions
instance ToJSON ApiSignTransactionPostData where
    toJSON :: ApiSignTransactionPostData -> Value
toJSON = Options -> ApiSignTransactionPostData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
strictRecordTypeOptions

instance DecodeAddress t => FromJSON (PostTransactionOldData t) where
    parseJSON :: Value -> Parser (PostTransactionOldData t)
parseJSON = Options -> Value -> Parser (PostTransactionOldData t)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress t => ToJSON (PostTransactionOldData t) where
    toJSON :: PostTransactionOldData t -> Value
toJSON = Options -> PostTransactionOldData t -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeAddress t => FromJSON (ApiPaymentDestination t) where
    parseJSON :: Value -> Parser (ApiPaymentDestination t)
parseJSON Value
obj = Parser (ApiPaymentDestination t)
parseAll Parser (ApiPaymentDestination t)
-> Parser (ApiPaymentDestination t)
-> Parser (ApiPaymentDestination t)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (ApiPaymentDestination t)
parseAddrs
      where
        parseAll :: Parser (ApiPaymentDestination t)
parseAll = NonEmpty (ApiT Address, Proxy t) -> ApiPaymentDestination t
forall (n :: NetworkDiscriminant).
NonEmpty (ApiT Address, Proxy n) -> ApiPaymentDestination n
ApiPaymentAll (NonEmpty (ApiT Address, Proxy t) -> ApiPaymentDestination t)
-> Parser (NonEmpty (ApiT Address, Proxy t))
-> Parser (ApiPaymentDestination t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (NonEmpty (ApiT Address, Proxy t))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
        parseAddrs :: Parser (ApiPaymentDestination t)
parseAddrs = NonEmpty (AddressAmount (ApiT Address, Proxy t))
-> ApiPaymentDestination t
forall (n :: NetworkDiscriminant).
NonEmpty (AddressAmount (ApiAddressIdT n))
-> ApiPaymentDestination n
ApiPaymentAddresses (NonEmpty (AddressAmount (ApiT Address, Proxy t))
 -> ApiPaymentDestination t)
-> Parser (NonEmpty (AddressAmount (ApiT Address, Proxy t)))
-> Parser (ApiPaymentDestination t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (NonEmpty (AddressAmount (ApiT Address, Proxy t)))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj

instance EncodeAddress t => ToJSON (ApiPaymentDestination t) where
    toJSON :: ApiPaymentDestination t -> Value
toJSON (ApiPaymentAddresses NonEmpty (AddressAmount (ApiAddressIdT t))
addrs) = NonEmpty (AddressAmount (ApiT Address, Proxy t)) -> Value
forall a. ToJSON a => a -> Value
toJSON NonEmpty (AddressAmount (ApiT Address, Proxy t))
NonEmpty (AddressAmount (ApiAddressIdT t))
addrs
    toJSON (ApiPaymentAll NonEmpty (ApiT Address, Proxy t)
addrs) = NonEmpty (ApiT Address, Proxy t) -> Value
forall a. ToJSON a => a -> Value
toJSON NonEmpty (ApiT Address, Proxy t)
addrs

instance DecodeAddress t => FromJSON (ApiConstructTransactionData t) where
    parseJSON :: Value -> Parser (ApiConstructTransactionData t)
parseJSON = Options -> Value -> Parser (ApiConstructTransactionData t)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress t => ToJSON (ApiConstructTransactionData t) where
    toJSON :: ApiConstructTransactionData t -> Value
toJSON = Options -> ApiConstructTransactionData t -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeAddress n => FromJSON (ApiExternalInput n) where
    parseJSON :: Value -> Parser (ApiExternalInput n)
parseJSON = Options -> Value -> Parser (ApiExternalInput n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress n => ToJSON (ApiExternalInput n) where
    toJSON :: ApiExternalInput n -> Value
toJSON = Options -> ApiExternalInput n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeStakeAddress n => FromJSON (ApiRedeemer n) where
    parseJSON :: Value -> Parser (ApiRedeemer n)
parseJSON = String
-> (Object -> Parser (ApiRedeemer n))
-> Value
-> Parser (ApiRedeemer n)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiRedeemer" ((Object -> Parser (ApiRedeemer n))
 -> Value -> Parser (ApiRedeemer n))
-> (Object -> Parser (ApiRedeemer n))
-> Value
-> Parser (ApiRedeemer n)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
purpose <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"purpose"
        ApiRedeemerData
bytes <- Object
o Object -> Key -> Parser ApiRedeemerData
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
        case (Text
purpose :: Text) of
            Text
"spending" ->
                ApiRedeemerData -> ApiT TxIn -> ApiRedeemer n
forall (n :: NetworkDiscriminant).
ApiRedeemerData -> ApiT TxIn -> ApiRedeemer n
ApiRedeemerSpending ApiRedeemerData
bytes (ApiT TxIn -> ApiRedeemer n)
-> Parser (ApiT TxIn) -> Parser (ApiRedeemer n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (ApiT TxIn)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"input")
            Text
"minting" ->
                ApiRedeemerData -> ApiT TokenPolicyId -> ApiRedeemer n
forall (n :: NetworkDiscriminant).
ApiRedeemerData -> ApiT TokenPolicyId -> ApiRedeemer n
ApiRedeemerMinting ApiRedeemerData
bytes (ApiT TokenPolicyId -> ApiRedeemer n)
-> Parser (ApiT TokenPolicyId) -> Parser (ApiRedeemer n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (ApiT TokenPolicyId)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"policy_id")
            Text
"rewarding" -> do
                Text
text <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stake_address"
                case AsType StakeAddress
-> Text -> Either Bech32DecodeError StakeAddress
forall a.
SerialiseAsBech32 a =>
AsType a -> Text -> Either Bech32DecodeError a
deserialiseFromBech32 (Proxy StakeAddress -> AsType StakeAddress
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType Proxy StakeAddress
forall k (t :: k). Proxy t
Proxy) Text
text of
                    Left Bech32DecodeError
e -> String -> Parser (ApiRedeemer n)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Bech32DecodeError -> String
forall a. Show a => a -> String
show Bech32DecodeError
e)
                    Right StakeAddress
addr -> ApiRedeemer n -> Parser (ApiRedeemer n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiRedeemer n -> Parser (ApiRedeemer n))
-> ApiRedeemer n -> Parser (ApiRedeemer n)
forall a b. (a -> b) -> a -> b
$ ApiRedeemerData -> StakeAddress -> ApiRedeemer n
forall (n :: NetworkDiscriminant).
ApiRedeemerData -> StakeAddress -> ApiRedeemer n
ApiRedeemerRewarding ApiRedeemerData
bytes StakeAddress
addr
            Text
_ ->
                String -> Parser (ApiRedeemer n)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown purpose for redeemer."
instance EncodeStakeAddress n => ToJSON (ApiRedeemer n) where
    toJSON :: ApiRedeemer n -> Value
toJSON = \case
        ApiRedeemerSpending ApiRedeemerData
bytes ApiT TxIn
input -> [Pair] -> Value
object
            [ Key
"purpose" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"spending" :: Text)
            , Key
"data" Key -> ApiRedeemerData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiRedeemerData
bytes
            , Key
"input" Key -> ApiT TxIn -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiT TxIn
input
            ]
        ApiRedeemerMinting ApiRedeemerData
bytes ApiT TokenPolicyId
policy -> [Pair] -> Value
object
            [ Key
"purpose" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"minting" :: Text)
            , Key
"data" Key -> ApiRedeemerData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiRedeemerData
bytes
            , Key
"policy_id" Key -> ApiT TokenPolicyId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiT TokenPolicyId
policy
            ]
        ApiRedeemerRewarding ApiRedeemerData
bytes StakeAddress
addr -> [Pair] -> Value
object
            [ Key
"purpose" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"rewarding" :: Text)
            , Key
"data" Key -> ApiRedeemerData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiRedeemerData
bytes
            , Key
"stake_address" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StakeAddress -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 StakeAddress
addr
            ]

instance (DecodeStakeAddress n, DecodeAddress n)
    => FromJSON (ApiBalanceTransactionPostData n)
  where
    parseJSON :: Value -> Parser (ApiBalanceTransactionPostData n)
parseJSON = Options -> Value -> Parser (ApiBalanceTransactionPostData n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance (EncodeStakeAddress n, EncodeAddress n)
    => ToJSON (ApiBalanceTransactionPostData n)
  where
    toJSON :: ApiBalanceTransactionPostData n -> Value
toJSON = Options -> ApiBalanceTransactionPostData n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance ToJSON ApiValidityBound where
    toJSON :: ApiValidityBound -> Value
toJSON ApiValidityBound
ApiValidityBoundUnspecified = Value
Aeson.Null
    toJSON (ApiValidityBoundAsTimeFromNow Quantity "second" NominalDiffTime
from) = Quantity "second" NominalDiffTime -> Value
forall a. ToJSON a => a -> Value
toJSON Quantity "second" NominalDiffTime
from
    toJSON (ApiValidityBoundAsSlot Quantity "slot" Word64
sl) = Quantity "slot" Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Quantity "slot" Word64
sl
instance FromJSON ApiValidityBound where
    parseJSON :: Value -> Parser ApiValidityBound
parseJSON Value
obj = Parser ApiValidityBound
processNull Parser ApiValidityBound
-> Parser ApiValidityBound -> Parser ApiValidityBound
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser ApiValidityBound
processObject Value
obj
      where
        processNull :: Parser ApiValidityBound
processNull =
            if Value
obj Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
Aeson.Null then
                ApiValidityBound -> Parser ApiValidityBound
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApiValidityBound
ApiValidityBoundUnspecified
            else
                String -> Parser ApiValidityBound
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid string of ApiValidityBound"
        processObject :: Value -> Parser ApiValidityBound
processObject = String
-> (Object -> Parser ApiValidityBound)
-> Value
-> Parser ApiValidityBound
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiValidityBound object" ((Object -> Parser ApiValidityBound)
 -> Value -> Parser ApiValidityBound)
-> (Object -> Parser ApiValidityBound)
-> Value
-> Parser ApiValidityBound
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
            Maybe Value
unit <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unit"
            case Maybe Value
unit of
                Just (String Text
unitType) -> case Text
unitType of
                    Text
"second" -> Quantity "second" NominalDiffTime -> ApiValidityBound
ApiValidityBoundAsTimeFromNow (Quantity "second" NominalDiffTime -> ApiValidityBound)
-> Parser (Quantity "second" NominalDiffTime)
-> Parser ApiValidityBound
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Quantity "second" NominalDiffTime)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
                    Text
"slot" -> Quantity "slot" Word64 -> ApiValidityBound
ApiValidityBoundAsSlot (Quantity "slot" Word64 -> ApiValidityBound)
-> Parser (Quantity "slot" Word64) -> Parser ApiValidityBound
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Quantity "slot" Word64)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
                    Text
_ -> String -> Parser ApiValidityBound
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ApiValidityBound string must have either 'second' or 'slot' unit."
                Maybe Value
_ -> String -> Parser ApiValidityBound
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ApiValidityBound string must have 'unit' field."

instance ToJSON ApiValidityInterval where
    toJSON :: ApiValidityInterval -> Value
toJSON = Options -> ApiValidityInterval -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions
instance FromJSON ApiValidityInterval where
    parseJSON :: Value -> Parser ApiValidityInterval
parseJSON = Options -> Value -> Parser ApiValidityInterval
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions

instance (DecodeAddress t, DecodeStakeAddress t) => FromJSON (ApiConstructTransaction t) where
    parseJSON :: Value -> Parser (ApiConstructTransaction t)
parseJSON = Options -> Value -> Parser (ApiConstructTransaction t)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance (EncodeAddress t, EncodeStakeAddress t) => ToJSON (ApiConstructTransaction t) where
    toJSON :: ApiConstructTransaction t -> Value
toJSON = Options -> ApiConstructTransaction t -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiWithdrawalPostData where
    parseJSON :: Value -> Parser ApiWithdrawalPostData
parseJSON Value
obj =
        Parser ApiWithdrawalPostData
parseSelfWithdrawal Parser ApiWithdrawalPostData
-> Parser ApiWithdrawalPostData -> Parser ApiWithdrawalPostData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ApiMnemonicT '[15, 18, 21, 24] -> ApiWithdrawalPostData)
-> Parser (ApiMnemonicT '[15, 18, 21, 24])
-> Parser ApiWithdrawalPostData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ApiMnemonicT '[15, 18, 21, 24] -> ApiWithdrawalPostData
ExternalWithdrawal (Value -> Parser (ApiMnemonicT '[15, 18, 21, 24])
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj)
      where
        parseSelfWithdrawal :: Parser ApiWithdrawalPostData
parseSelfWithdrawal = do
            String
str <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
            ApiWithdrawalPostData
SelfWithdrawal ApiWithdrawalPostData -> Parser () -> Parser ApiWithdrawalPostData
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"self" :: String))
instance ToJSON ApiWithdrawalPostData where
    toJSON :: ApiWithdrawalPostData -> Value
toJSON = \case
        ApiWithdrawalPostData
SelfWithdrawal -> String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"self" :: String)
        ExternalWithdrawal ApiMnemonicT '[15, 18, 21, 24]
mw -> ApiMnemonicT '[15, 18, 21, 24] -> Value
forall a. ToJSON a => a -> Value
toJSON ApiMnemonicT '[15, 18, 21, 24]
mw

instance DecodeAddress t => FromJSON (PostTransactionFeeOldData t) where
    parseJSON :: Value -> Parser (PostTransactionFeeOldData t)
parseJSON = Options -> Value -> Parser (PostTransactionFeeOldData t)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress t => ToJSON (PostTransactionFeeOldData t) where
    toJSON :: PostTransactionFeeOldData t -> Value
toJSON = Options -> PostTransactionFeeOldData t -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

-- Note: These custom JSON instances are for compatibility with the existing API
-- schema. At some point, we can switch to the generic instances.
instance FromJSON ApiSlotReference where
    parseJSON :: Value -> Parser ApiSlotReference
parseJSON = String
-> (Object -> Parser ApiSlotReference)
-> Value
-> Parser ApiSlotReference
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SlotReference" ((Object -> Parser ApiSlotReference)
 -> Value -> Parser ApiSlotReference)
-> (Object -> Parser ApiSlotReference)
-> Value
-> Parser ApiSlotReference
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        ApiT SlotNo -> ApiSlotId -> UTCTime -> ApiSlotReference
ApiSlotReference
        (ApiT SlotNo -> ApiSlotId -> UTCTime -> ApiSlotReference)
-> Parser (ApiT SlotNo)
-> Parser (ApiSlotId -> UTCTime -> ApiSlotReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (ApiT SlotNo)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"absolute_slot_number"
        Parser (ApiSlotId -> UTCTime -> ApiSlotReference)
-> Parser ApiSlotId -> Parser (UTCTime -> ApiSlotReference)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser ApiSlotId
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Aeson.Object Object
o)
        Parser (UTCTime -> ApiSlotReference)
-> Parser UTCTime -> Parser ApiSlotReference
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
instance ToJSON ApiSlotReference where
    toJSON :: ApiSlotReference -> Value
toJSON (ApiSlotReference ApiT SlotNo
sln ApiSlotId
sli UTCTime
t) =
        let Aeson.Object Object
rest = ApiSlotId -> Value
forall a. ToJSON a => a -> Value
toJSON ApiSlotId
sli
        in Object -> Value
Aeson.Object (Key
"absolute_slot_number" Key -> ApiT SlotNo -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiT SlotNo
sln Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key
"time" Key -> UTCTime -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime
t Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
rest)

instance FromJSON ApiSlotId where
    parseJSON :: Value -> Parser ApiSlotId
parseJSON = Options -> Value -> Parser ApiSlotId
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiSlotId where
    toJSON :: ApiSlotId -> Value
toJSON = Options -> ApiSlotId -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

-- Note: These custom JSON instances are for compatibility with the existing API
-- schema. At some point, we can switch to the generic instances.
-- A BlockReference is just a SlotReference with the block height included.
instance FromJSON ApiBlockReference where
    parseJSON :: Value -> Parser ApiBlockReference
parseJSON Value
v = do
        ApiSlotReference ApiT SlotNo
sln ApiSlotId
sli UTCTime
t <- Value -> Parser ApiSlotReference
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        ApiT SlotNo
-> ApiSlotId -> UTCTime -> ApiBlockInfo -> ApiBlockReference
ApiBlockReference ApiT SlotNo
sln ApiSlotId
sli UTCTime
t (ApiBlockInfo -> ApiBlockReference)
-> Parser ApiBlockInfo -> Parser ApiBlockReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ApiBlockInfo
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance ToJSON ApiBlockReference where
    toJSON :: ApiBlockReference -> Value
toJSON (ApiBlockReference ApiT SlotNo
sln ApiSlotId
sli UTCTime
t (ApiBlockInfo Quantity "block" Natural
bh)) =
        let Aeson.Object Object
rest = ApiSlotReference -> Value
forall a. ToJSON a => a -> Value
toJSON (ApiT SlotNo -> ApiSlotId -> UTCTime -> ApiSlotReference
ApiSlotReference ApiT SlotNo
sln ApiSlotId
sli UTCTime
t)
        in Object -> Value
Aeson.Object (Key
"height" Key -> Quantity "block" Natural -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Quantity "block" Natural
bh Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
rest)

instance FromJSON ApiBlockInfo where
    parseJSON :: Value -> Parser ApiBlockInfo
parseJSON = Options -> Value -> Parser ApiBlockInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiBlockInfo where
    toJSON :: ApiBlockInfo -> Value
toJSON = Options -> ApiBlockInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON (ApiT EpochNo) where
    parseJSON :: Value -> Parser (ApiT EpochNo)
parseJSON = (Word32 -> ApiT EpochNo) -> Parser Word32 -> Parser (ApiT EpochNo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EpochNo -> ApiT EpochNo
forall a. a -> ApiT a
ApiT (EpochNo -> ApiT EpochNo)
-> (Word32 -> EpochNo) -> Word32 -> ApiT EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Word32 -> EpochNo
Word32 -> EpochNo
unsafeEpochNo) (Parser Word32 -> Parser (ApiT EpochNo))
-> (Value -> Parser Word32) -> Value -> Parser (ApiT EpochNo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Word32
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON (ApiT EpochNo) where
    toJSON :: ApiT EpochNo -> Value
toJSON (ApiT (EpochNo Word31
en)) = Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON (Word32 -> Value) -> Word32 -> Value
forall a b. (a -> b) -> a -> b
$ Word31 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word31 @Word32 Word31
en

instance FromJSON (ApiT SlotInEpoch) where
    parseJSON :: Value -> Parser (ApiT SlotInEpoch)
parseJSON = (Word32 -> ApiT SlotInEpoch)
-> Parser Word32 -> Parser (ApiT SlotInEpoch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SlotInEpoch -> ApiT SlotInEpoch
forall a. a -> ApiT a
ApiT (SlotInEpoch -> ApiT SlotInEpoch)
-> (Word32 -> SlotInEpoch) -> Word32 -> ApiT SlotInEpoch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> SlotInEpoch
SlotInEpoch) (Parser Word32 -> Parser (ApiT SlotInEpoch))
-> (Value -> Parser Word32) -> Value -> Parser (ApiT SlotInEpoch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Word32
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON (ApiT SlotInEpoch) where
    toJSON :: ApiT SlotInEpoch -> Value
toJSON (ApiT (SlotInEpoch Word32
sn)) = Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON Word32
sn

instance FromJSON (ApiT SlotNo) where
    parseJSON :: Value -> Parser (ApiT SlotNo)
parseJSON = (Word64 -> ApiT SlotNo) -> Parser Word64 -> Parser (ApiT SlotNo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SlotNo -> ApiT SlotNo
forall a. a -> ApiT a
ApiT (SlotNo -> ApiT SlotNo)
-> (Word64 -> SlotNo) -> Word64 -> ApiT SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo) (Parser Word64 -> Parser (ApiT SlotNo))
-> (Value -> Parser Word64) -> Value -> Parser (ApiT SlotNo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Word64
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON (ApiT SlotNo) where
    toJSON :: ApiT SlotNo -> Value
toJSON (ApiT (SlotNo Word64
sn)) = Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Word64
sn

instance FromJSON a => FromJSON (AddressAmount a) where
    parseJSON :: Value -> Parser (AddressAmount a)
parseJSON = String
-> (Object -> Parser (AddressAmount a))
-> Value
-> Parser (AddressAmount a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AddressAmount " ((Object -> Parser (AddressAmount a))
 -> Value -> Parser (AddressAmount a))
-> (Object -> Parser (AddressAmount a))
-> Value
-> Parser (AddressAmount a)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        String -> Parser (AddressAmount a) -> Parser (AddressAmount a)
forall a. String -> Parser a -> Parser a
prependFailure String
"parsing AddressAmount failed, " (Parser (AddressAmount a) -> Parser (AddressAmount a))
-> Parser (AddressAmount a) -> Parser (AddressAmount a)
forall a b. (a -> b) -> a -> b
$
        a
-> Quantity "lovelace" Natural -> ApiT TokenMap -> AddressAmount a
forall addr.
addr
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> AddressAmount addr
AddressAmount
            (a
 -> Quantity "lovelace" Natural -> ApiT TokenMap -> AddressAmount a)
-> Parser a
-> Parser
     (Quantity "lovelace" Natural -> ApiT TokenMap -> AddressAmount a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
            Parser
  (Quantity "lovelace" Natural -> ApiT TokenMap -> AddressAmount a)
-> Parser (Quantity "lovelace" Natural)
-> Parser (ApiT TokenMap -> AddressAmount a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Key -> Parser (Quantity "lovelace" Natural)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount" Parser (Quantity "lovelace" Natural)
-> (Quantity "lovelace" Natural
    -> Parser (Quantity "lovelace" Natural))
-> Parser (Quantity "lovelace" Natural)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Quantity "lovelace" Natural -> Parser (Quantity "lovelace" Natural)
forall n (f :: * -> *).
(Integral n, MonadFail f) =>
Quantity "lovelace" n -> f (Quantity "lovelace" n)
validateCoin)
            Parser (ApiT TokenMap -> AddressAmount a)
-> Parser (ApiT TokenMap) -> Parser (AddressAmount a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (ApiT TokenMap))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assets" Parser (Maybe (ApiT TokenMap))
-> ApiT TokenMap -> Parser (ApiT TokenMap)
forall a. Parser (Maybe a) -> a -> Parser a
.!= ApiT TokenMap
forall a. Monoid a => a
mempty
      where
        validateCoin :: Quantity "lovelace" n -> f (Quantity "lovelace" n)
validateCoin Quantity "lovelace" n
q
            | Coin -> Bool
coinIsValidForTxOut (Quantity "lovelace" n -> Coin
forall n. Integral n => Quantity "lovelace" n -> Coin
coinFromQuantity Quantity "lovelace" n
q) = Quantity "lovelace" n -> f (Quantity "lovelace" n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Quantity "lovelace" n
q
            | Bool
otherwise = String -> f (Quantity "lovelace" n)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f (Quantity "lovelace" n))
-> String -> f (Quantity "lovelace" n)
forall a b. (a -> b) -> a -> b
$
                String
"invalid coin value: value has to be lower than or equal to "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Natural -> String
forall a. Show a => a -> String
show (Coin -> Natural
unCoin Coin
txOutMaxCoin) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" lovelace."

instance ToJSON (ApiT W.TokenBundle) where
    -- TODO: consider other structures
    toJSON :: ApiT TokenBundle -> Value
toJSON (ApiT (W.TokenBundle Coin
c TokenMap
ts)) = [Pair] -> Value
object
        [ Key
"amount" Key -> Quantity "lovelace" Word -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Coin -> Quantity "lovelace" Word
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity @Word Coin
c
        , Key
"assets" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiT TokenMap -> Value
forall a. ToJSON a => a -> Value
toJSON (TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT TokenMap
ts)
        ]

instance FromJSON (ApiT W.TokenBundle) where
    -- TODO: reject unknown fields
    parseJSON :: Value -> Parser (ApiT TokenBundle)
parseJSON = String
-> (Object -> Parser (ApiT TokenBundle))
-> Value
-> Parser (ApiT TokenBundle)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Value " ((Object -> Parser (ApiT TokenBundle))
 -> Value -> Parser (ApiT TokenBundle))
-> (Object -> Parser (ApiT TokenBundle))
-> Value
-> Parser (ApiT TokenBundle)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        String -> Parser (ApiT TokenBundle) -> Parser (ApiT TokenBundle)
forall a. String -> Parser a -> Parser a
prependFailure String
"parsing Value failed, " (Parser (ApiT TokenBundle) -> Parser (ApiT TokenBundle))
-> Parser (ApiT TokenBundle) -> Parser (ApiT TokenBundle)
forall a b. (a -> b) -> a -> b
$
        (TokenBundle -> ApiT TokenBundle)
-> Parser TokenBundle -> Parser (ApiT TokenBundle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TokenBundle -> ApiT TokenBundle
forall a. a -> ApiT a
ApiT (Parser TokenBundle -> Parser (ApiT TokenBundle))
-> Parser TokenBundle -> Parser (ApiT TokenBundle)
forall a b. (a -> b) -> a -> b
$ Coin -> TokenMap -> TokenBundle
W.TokenBundle
            (Coin -> TokenMap -> TokenBundle)
-> Parser Coin -> Parser (TokenMap -> TokenBundle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Key -> Parser (Quantity "lovelace" Word64)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount" Parser (Quantity "lovelace" Word64)
-> (Quantity "lovelace" Word64 -> Parser Coin) -> Parser Coin
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Quantity "lovelace" Word64 -> Parser Coin
validateCoin)
            Parser (TokenMap -> TokenBundle)
-> Parser TokenMap -> Parser TokenBundle
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ApiT TokenMap -> TokenMap)
-> Parser (ApiT TokenMap) -> Parser TokenMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ApiT TokenMap -> TokenMap
forall a. ApiT a -> a
getApiT (Object
v Object -> Key -> Parser (Maybe (ApiT TokenMap))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"assets" Parser (Maybe (ApiT TokenMap))
-> ApiT TokenMap -> Parser (ApiT TokenMap)
forall a. Parser (Maybe a) -> a -> Parser a
.!= ApiT TokenMap
forall a. Monoid a => a
mempty)
      where
        validateCoin :: Quantity "lovelace" Word64 -> Aeson.Parser Coin
        validateCoin :: Quantity "lovelace" Word64 -> Parser Coin
validateCoin (Quantity "lovelace" Word64 -> Coin
forall n. Integral n => Quantity "lovelace" n -> Coin
coinFromQuantity -> Coin
c)
            | Coin -> Bool
coinIsValidForTxOut Coin
c = Coin -> Parser Coin
forall (f :: * -> *) a. Applicative f => a -> f a
pure Coin
c
            | Bool
otherwise = String -> Parser Coin
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Coin) -> String -> Parser Coin
forall a b. (a -> b) -> a -> b
$
                String
"invalid coin value: value has to be lower than or equal to "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Natural -> String
forall a. Show a => a -> String
show (Coin -> Natural
unCoin Coin
txOutMaxCoin) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" lovelace."

instance ToJSON a => ToJSON (AddressAmount a) where
    toJSON :: AddressAmount a -> Value
toJSON = Options -> AddressAmount a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON a => FromJSON (AddressAmountNoAssets a) where
    parseJSON :: Value -> Parser (AddressAmountNoAssets a)
parseJSON = Options -> Value -> Parser (AddressAmountNoAssets a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON a => ToJSON (AddressAmountNoAssets a) where
    toJSON :: AddressAmountNoAssets a -> Value
toJSON = Options -> AddressAmountNoAssets a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance
    ( DecodeAddress n
    , DecodeStakeAddress n
    ) => FromJSON (ApiTransaction n)
  where
    parseJSON :: Value -> Parser (ApiTransaction n)
parseJSON = Options -> Value -> Parser (ApiTransaction n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance
    ( EncodeAddress n
    , EncodeStakeAddress n
    ) => ToJSON (ApiTransaction n)
  where
    toJSON :: ApiTransaction n -> Value
toJSON = Options -> ApiTransaction n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeAddress n => FromJSON (ApiWalletInput n) where
    parseJSON :: Value -> Parser (ApiWalletInput n)
parseJSON = Options -> Value -> Parser (ApiWalletInput n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress n => ToJSON (ApiWalletInput n) where
    toJSON :: ApiWalletInput n -> Value
toJSON = Options -> ApiWalletInput n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeAddress n => FromJSON (ApiWalletOutput n) where
    parseJSON :: Value -> Parser (ApiWalletOutput n)
parseJSON = Options -> Value -> Parser (ApiWalletOutput n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress n => ToJSON (ApiWalletOutput n) where
    toJSON :: ApiWalletOutput n -> Value
toJSON = Options -> ApiWalletOutput n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeStakeAddress n => FromJSON (ApiExternalCertificate n) where
    parseJSON :: Value -> Parser (ApiExternalCertificate n)
parseJSON = Options -> Value -> Parser (ApiExternalCertificate n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
apiCertificateOptions
instance EncodeStakeAddress n => ToJSON (ApiExternalCertificate n) where
    toJSON :: ApiExternalCertificate n -> Value
toJSON = Options -> ApiExternalCertificate n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
apiCertificateOptions

instance FromJSON (ApiT W.PoolOwner) where
    parseJSON :: Value -> Parser (ApiT PoolOwner)
parseJSON = String -> Value -> Parser (ApiT PoolOwner)
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"ApiT PoolOwner"
instance ToJSON (ApiT W.PoolOwner) where
    toJSON :: ApiT PoolOwner -> Value
toJSON = ApiT PoolOwner -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON (ApiT W.StakePoolMetadataUrl) where
    parseJSON :: Value -> Parser (ApiT StakePoolMetadataUrl)
parseJSON = String -> Value -> Parser (ApiT StakePoolMetadataUrl)
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"ApiT StakePoolMetadataUrl"
instance ToJSON (ApiT W.StakePoolMetadataUrl) where
    toJSON :: ApiT StakePoolMetadataUrl -> Value
toJSON = ApiT StakePoolMetadataUrl -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON (ApiT W.StakePoolMetadataHash) where
    parseJSON :: Value -> Parser (ApiT StakePoolMetadataHash)
parseJSON = String -> Value -> Parser (ApiT StakePoolMetadataHash)
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"ApiT StakePoolMetadataHash"
instance ToJSON (ApiT W.StakePoolMetadataHash) where
    toJSON :: ApiT StakePoolMetadataHash -> Value
toJSON = ApiT StakePoolMetadataHash -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON (ApiT W.NonWalletCertificate) where
  parseJSON :: Value -> Parser (ApiT NonWalletCertificate)
parseJSON Value
val
    | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== [Pair] -> Value
object [Key
"certificate_type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"mir"]
    = ApiT NonWalletCertificate -> Parser (ApiT NonWalletCertificate)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiT NonWalletCertificate -> Parser (ApiT NonWalletCertificate))
-> ApiT NonWalletCertificate -> Parser (ApiT NonWalletCertificate)
forall a b. (a -> b) -> a -> b
$ NonWalletCertificate -> ApiT NonWalletCertificate
forall a. a -> ApiT a
ApiT NonWalletCertificate
MIRCertificate
    | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== [Pair] -> Value
object [Key
"certificate_type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"genesis"]
    = ApiT NonWalletCertificate -> Parser (ApiT NonWalletCertificate)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiT NonWalletCertificate -> Parser (ApiT NonWalletCertificate))
-> ApiT NonWalletCertificate -> Parser (ApiT NonWalletCertificate)
forall a b. (a -> b) -> a -> b
$ NonWalletCertificate -> ApiT NonWalletCertificate
forall a. a -> ApiT a
ApiT NonWalletCertificate
GenesisCertificate
    | Bool
otherwise
    = String -> Parser (ApiT NonWalletCertificate)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
        String
"expected object with key 'certificate_type' and value either 'mir' or 'genesis'"
instance ToJSON (ApiT W.NonWalletCertificate) where
    toJSON :: ApiT NonWalletCertificate -> Value
toJSON (ApiT NonWalletCertificate
cert) = [Pair] -> Value
object [Key
"certificate_type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (NonWalletCertificate -> Text
forall a. ToText a => a -> Text
toText NonWalletCertificate
cert)]

parseExtendedAesonObject
    :: ( Generic a
       , Aeson.GFromJSON Aeson.Zero (Rep a) )
    => String
    -> Text
    -> Value
    -> Parser a
parseExtendedAesonObject :: String -> Text -> Value -> Parser a
parseExtendedAesonObject String
txt Text
fieldtoremove = String -> (Object -> Parser a) -> Value -> Parser a
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
txt ((Object -> Parser a) -> Value -> Parser a)
-> (Object -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    let removeCertType :: Key -> Value -> Bool
removeCertType Key
numKey Value
_ = Key -> Text
Aeson.toText Key
numKey Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
fieldtoremove
    let o' :: Object
o' = (Key -> Value -> Bool) -> Object -> Object
forall v. (Key -> v -> Bool) -> KeyMap v -> KeyMap v
Aeson.filterWithKey Key -> Value -> Bool
removeCertType Object
o
    Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions (Object -> Value
Object Object
o')

extendAesonObject
    :: ( Generic a
       , Aeson.GToJSON' Value Aeson.Zero (Rep a))
    => [Aeson.Pair]
    -> a
    -> Value
extendAesonObject :: [Pair] -> a -> Value
extendAesonObject [Pair]
tobeadded a
apipool =
    let Object Object
obj = Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions a
apipool
        Object Object
obj' = [Pair] -> Value
object [Pair]
tobeadded
    in Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object
obj Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
obj'

instance FromJSON ApiRegisterPool where
    parseJSON :: Value -> Parser ApiRegisterPool
parseJSON = String -> Text -> Value -> Parser ApiRegisterPool
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
String -> Text -> Value -> Parser a
parseExtendedAesonObject String
"ApiRegisterPool" Text
"certificate_type"
instance ToJSON ApiRegisterPool where
    toJSON :: ApiRegisterPool -> Value
toJSON = [Pair] -> ApiRegisterPool -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
[Pair] -> a -> Value
extendAesonObject [Key
"certificate_type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"register_pool"]

instance FromJSON ApiDeregisterPool where
    parseJSON :: Value -> Parser ApiDeregisterPool
parseJSON = String -> Text -> Value -> Parser ApiDeregisterPool
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
String -> Text -> Value -> Parser a
parseExtendedAesonObject String
"ApiDeregisterPool" Text
"certificate_type"
instance ToJSON ApiDeregisterPool where
    toJSON :: ApiDeregisterPool -> Value
toJSON = [Pair] -> ApiDeregisterPool -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
[Pair] -> a -> Value
extendAesonObject [Key
"certificate_type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"deregister_pool"]

instance DecodeStakeAddress n => FromJSON (ApiAnyCertificate n) where
    parseJSON :: Value -> Parser (ApiAnyCertificate n)
parseJSON = String
-> (Object -> Parser (ApiAnyCertificate n))
-> Value
-> Parser (ApiAnyCertificate n)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiAnyCertificate" ((Object -> Parser (ApiAnyCertificate n))
 -> Value -> Parser (ApiAnyCertificate n))
-> (Object -> Parser (ApiAnyCertificate n))
-> Value
-> Parser (ApiAnyCertificate n)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        (String
certType :: String) <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"certificate_type"
        case String
certType of
            String
"register_pool" -> ApiRegisterPool -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiRegisterPool -> ApiAnyCertificate n
StakePoolRegister (ApiRegisterPool -> ApiAnyCertificate n)
-> Parser ApiRegisterPool -> Parser (ApiAnyCertificate n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ApiRegisterPool
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            String
"deregister_pool" -> ApiDeregisterPool -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiDeregisterPool -> ApiAnyCertificate n
StakePoolDeregister (ApiDeregisterPool -> ApiAnyCertificate n)
-> Parser ApiDeregisterPool -> Parser (ApiAnyCertificate n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ApiDeregisterPool
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            String
"join_pool" -> ApiCertificate -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiCertificate -> ApiAnyCertificate n
WalletDelegationCertificate (ApiCertificate -> ApiAnyCertificate n)
-> Parser ApiCertificate -> Parser (ApiAnyCertificate n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ApiCertificate
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            String
"quit_pool" -> ApiCertificate -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiCertificate -> ApiAnyCertificate n
WalletDelegationCertificate (ApiCertificate -> ApiAnyCertificate n)
-> Parser ApiCertificate -> Parser (ApiAnyCertificate n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ApiCertificate
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            String
"register_reward_account" -> ApiCertificate -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiCertificate -> ApiAnyCertificate n
WalletDelegationCertificate (ApiCertificate -> ApiAnyCertificate n)
-> Parser ApiCertificate -> Parser (ApiAnyCertificate n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ApiCertificate
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            String
"join_pool_external" -> ApiExternalCertificate n -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiExternalCertificate n -> ApiAnyCertificate n
DelegationCertificate (ApiExternalCertificate n -> ApiAnyCertificate n)
-> Parser (ApiExternalCertificate n)
-> Parser (ApiAnyCertificate n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ApiExternalCertificate n)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            String
"quit_pool_external" -> ApiExternalCertificate n -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiExternalCertificate n -> ApiAnyCertificate n
DelegationCertificate (ApiExternalCertificate n -> ApiAnyCertificate n)
-> Parser (ApiExternalCertificate n)
-> Parser (ApiAnyCertificate n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ApiExternalCertificate n)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            String
"register_reward_account_external" -> ApiExternalCertificate n -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiExternalCertificate n -> ApiAnyCertificate n
DelegationCertificate (ApiExternalCertificate n -> ApiAnyCertificate n)
-> Parser (ApiExternalCertificate n)
-> Parser (ApiAnyCertificate n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ApiExternalCertificate n)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            String
"mir" -> ApiT NonWalletCertificate -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiT NonWalletCertificate -> ApiAnyCertificate n
OtherCertificate (ApiT NonWalletCertificate -> ApiAnyCertificate n)
-> Parser (ApiT NonWalletCertificate)
-> Parser (ApiAnyCertificate n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ApiT NonWalletCertificate)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            String
"genesis" -> ApiT NonWalletCertificate -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiT NonWalletCertificate -> ApiAnyCertificate n
OtherCertificate (ApiT NonWalletCertificate -> ApiAnyCertificate n)
-> Parser (ApiT NonWalletCertificate)
-> Parser (ApiAnyCertificate n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ApiT NonWalletCertificate)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
            String
_ -> String -> Parser (ApiAnyCertificate n)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (ApiAnyCertificate n))
-> String -> Parser (ApiAnyCertificate n)
forall a b. (a -> b) -> a -> b
$ String
"unknown certificate_type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
certType
instance EncodeStakeAddress n => ToJSON (ApiAnyCertificate n) where
    toJSON :: ApiAnyCertificate n -> Value
toJSON (WalletDelegationCertificate ApiCertificate
cert) = ApiCertificate -> Value
forall a. ToJSON a => a -> Value
toJSON ApiCertificate
cert
    toJSON (DelegationCertificate ApiExternalCertificate n
cert) = ApiExternalCertificate n -> Value
forall a. ToJSON a => a -> Value
toJSON ApiExternalCertificate n
cert
    toJSON (StakePoolRegister ApiRegisterPool
reg) = ApiRegisterPool -> Value
forall a. ToJSON a => a -> Value
toJSON ApiRegisterPool
reg
    toJSON (StakePoolDeregister ApiDeregisterPool
dereg) = ApiDeregisterPool -> Value
forall a. ToJSON a => a -> Value
toJSON ApiDeregisterPool
dereg
    toJSON (OtherCertificate ApiT NonWalletCertificate
cert) = ApiT NonWalletCertificate -> Value
forall a. ToJSON a => a -> Value
toJSON ApiT NonWalletCertificate
cert

instance
    ( DecodeAddress n
    , DecodeStakeAddress n
    ) => FromJSON (ApiDecodedTransaction n)
  where
    parseJSON :: Value -> Parser (ApiDecodedTransaction n)
parseJSON = Options -> Value -> Parser (ApiDecodedTransaction n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance
    ( EncodeAddress n
    , EncodeStakeAddress n
    ) => ToJSON (ApiDecodedTransaction n)
  where
    toJSON :: ApiDecodedTransaction n -> Value
toJSON = Options -> ApiDecodedTransaction n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance
    ( DecodeAddress n
    , DecodeStakeAddress n
    ) => FromJSON (ApiTxOutputGeneral n)
  where
    parseJSON :: Value -> Parser (ApiTxOutputGeneral n)
parseJSON Value
obj = do
        Maybe (NonEmpty (ApiT DerivationIndex))
derPathM <-
            (String
-> (Object -> Parser (Maybe (NonEmpty (ApiT DerivationIndex))))
-> Value
-> Parser (Maybe (NonEmpty (ApiT DerivationIndex)))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiTxOutputGeneral" ((Object -> Parser (Maybe (NonEmpty (ApiT DerivationIndex))))
 -> Value -> Parser (Maybe (NonEmpty (ApiT DerivationIndex))))
-> (Object -> Parser (Maybe (NonEmpty (ApiT DerivationIndex))))
-> Value
-> Parser (Maybe (NonEmpty (ApiT DerivationIndex)))
forall a b. (a -> b) -> a -> b
$
             \Object
o -> Object
o Object -> Key -> Parser (Maybe (NonEmpty (ApiT DerivationIndex)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"derivation_path"
                :: Aeson.Parser (Maybe (NonEmpty (ApiT DerivationIndex)))) Value
obj
        case Maybe (NonEmpty (ApiT DerivationIndex))
derPathM of
            Maybe (NonEmpty (ApiT DerivationIndex))
Nothing -> do
                ApiTxOutput n
xs <- Value -> Parser (ApiTxOutput n)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
                    :: Aeson.Parser (ApiTxOutput n)
                ApiTxOutputGeneral n -> Parser (ApiTxOutputGeneral n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiTxOutputGeneral n -> Parser (ApiTxOutputGeneral n))
-> ApiTxOutputGeneral n -> Parser (ApiTxOutputGeneral n)
forall a b. (a -> b) -> a -> b
$ ApiTxOutput n -> ApiTxOutputGeneral n
forall (n :: NetworkDiscriminant).
ApiTxOutput n -> ApiTxOutputGeneral n
ExternalOutput ApiTxOutput n
xs
            Just NonEmpty (ApiT DerivationIndex)
_ -> do
                ApiWalletOutput n
xs <- Value -> Parser (ApiWalletOutput n)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
                    :: Aeson.Parser (ApiWalletOutput n)
                ApiTxOutputGeneral n -> Parser (ApiTxOutputGeneral n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiTxOutputGeneral n -> Parser (ApiTxOutputGeneral n))
-> ApiTxOutputGeneral n -> Parser (ApiTxOutputGeneral n)
forall a b. (a -> b) -> a -> b
$ ApiWalletOutput n -> ApiTxOutputGeneral n
forall (n :: NetworkDiscriminant).
ApiWalletOutput n -> ApiTxOutputGeneral n
WalletOutput ApiWalletOutput n
xs
instance
    ( EncodeAddress n
    , EncodeStakeAddress n
    ) => ToJSON (ApiTxOutputGeneral n)
  where
    toJSON :: ApiTxOutputGeneral n -> Value
toJSON (ExternalOutput ApiTxOutput n
content) = ApiTxOutput n -> Value
forall a. ToJSON a => a -> Value
toJSON ApiTxOutput n
content
    toJSON (WalletOutput ApiWalletOutput n
content) = ApiWalletOutput n -> Value
forall a. ToJSON a => a -> Value
toJSON ApiWalletOutput n
content

instance
    ( DecodeAddress n
    , DecodeStakeAddress n
    ) => FromJSON (ApiTxInputGeneral n)
  where
    parseJSON :: Value -> Parser (ApiTxInputGeneral n)
parseJSON Value
obj = do
        Maybe (NonEmpty (ApiT DerivationIndex))
derPathM <-
            (String
-> (Object -> Parser (Maybe (NonEmpty (ApiT DerivationIndex))))
-> Value
-> Parser (Maybe (NonEmpty (ApiT DerivationIndex)))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiTxInputGeneral" ((Object -> Parser (Maybe (NonEmpty (ApiT DerivationIndex))))
 -> Value -> Parser (Maybe (NonEmpty (ApiT DerivationIndex))))
-> (Object -> Parser (Maybe (NonEmpty (ApiT DerivationIndex))))
-> Value
-> Parser (Maybe (NonEmpty (ApiT DerivationIndex)))
forall a b. (a -> b) -> a -> b
$
             \Object
o -> Object
o Object -> Key -> Parser (Maybe (NonEmpty (ApiT DerivationIndex)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"derivation_path"
                :: Aeson.Parser (Maybe (NonEmpty (ApiT DerivationIndex)))) Value
obj
        case Maybe (NonEmpty (ApiT DerivationIndex))
derPathM of
            Maybe (NonEmpty (ApiT DerivationIndex))
Nothing -> do
                ApiT TxIn
xs <- Value -> Parser (ApiT TxIn)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj :: Aeson.Parser (ApiT TxIn)
                ApiTxInputGeneral n -> Parser (ApiTxInputGeneral n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiTxInputGeneral n -> Parser (ApiTxInputGeneral n))
-> ApiTxInputGeneral n -> Parser (ApiTxInputGeneral n)
forall a b. (a -> b) -> a -> b
$ ApiT TxIn -> ApiTxInputGeneral n
forall (n :: NetworkDiscriminant). ApiT TxIn -> ApiTxInputGeneral n
ExternalInput ApiT TxIn
xs
            Just NonEmpty (ApiT DerivationIndex)
_ -> do
                ApiWalletInput n
xs <- Value -> Parser (ApiWalletInput n)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj :: Aeson.Parser (ApiWalletInput n)
                ApiTxInputGeneral n -> Parser (ApiTxInputGeneral n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiTxInputGeneral n -> Parser (ApiTxInputGeneral n))
-> ApiTxInputGeneral n -> Parser (ApiTxInputGeneral n)
forall a b. (a -> b) -> a -> b
$ ApiWalletInput n -> ApiTxInputGeneral n
forall (n :: NetworkDiscriminant).
ApiWalletInput n -> ApiTxInputGeneral n
WalletInput ApiWalletInput n
xs
instance
    ( EncodeAddress n
    , EncodeStakeAddress n
    ) => ToJSON (ApiTxInputGeneral n)
  where
    toJSON :: ApiTxInputGeneral n -> Value
toJSON (ExternalInput ApiT TxIn
content) = ApiT TxIn -> Value
forall a. ToJSON a => a -> Value
toJSON ApiT TxIn
content
    toJSON (WalletInput ApiWalletInput n
content) = ApiWalletInput n -> Value
forall a. ToJSON a => a -> Value
toJSON ApiWalletInput n
content

instance FromJSON (ApiT TxMetadata) where
    parseJSON :: Value -> Parser (ApiT TxMetadata)
parseJSON = (TxMetadata -> ApiT TxMetadata)
-> Parser TxMetadata -> Parser (ApiT TxMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxMetadata -> ApiT TxMetadata
forall a. a -> ApiT a
ApiT
        (Parser TxMetadata -> Parser (ApiT TxMetadata))
-> (Value -> Parser TxMetadata)
-> Value
-> Parser (ApiT TxMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxMetadataJsonError -> Parser TxMetadata)
-> (TxMetadata -> Parser TxMetadata)
-> Either TxMetadataJsonError TxMetadata
-> Parser TxMetadata
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser TxMetadata
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TxMetadata)
-> (TxMetadataJsonError -> String)
-> TxMetadataJsonError
-> Parser TxMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMetadataJsonError -> String
forall e. Error e => e -> String
displayError) TxMetadata -> Parser TxMetadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either TxMetadataJsonError TxMetadata -> Parser TxMetadata)
-> (Value -> Either TxMetadataJsonError TxMetadata)
-> Value
-> Parser TxMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMetadataJsonSchema
-> Value -> Either TxMetadataJsonError TxMetadata
metadataFromJson TxMetadataJsonSchema
TxMetadataJsonDetailedSchema

instance ToJSON (ApiT TxMetadata) where
    toJSON :: ApiT TxMetadata -> Value
toJSON = TxMetadataJsonSchema -> TxMetadata -> Value
metadataToJson TxMetadataJsonSchema
TxMetadataJsonDetailedSchema (TxMetadata -> Value)
-> (ApiT TxMetadata -> TxMetadata) -> ApiT TxMetadata -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT TxMetadata -> TxMetadata
forall a. ApiT a -> a
getApiT

instance FromJSON ApiTxMetadata where
    parseJSON :: Value -> Parser ApiTxMetadata
parseJSON Value
Aeson.Null = ApiTxMetadata -> Parser ApiTxMetadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiTxMetadata -> Parser ApiTxMetadata)
-> ApiTxMetadata -> Parser ApiTxMetadata
forall a b. (a -> b) -> a -> b
$ Maybe (ApiT TxMetadata) -> ApiTxMetadata
ApiTxMetadata Maybe (ApiT TxMetadata)
forall a. Maybe a
Nothing
    parseJSON Value
v = Maybe (ApiT TxMetadata) -> ApiTxMetadata
ApiTxMetadata (Maybe (ApiT TxMetadata) -> ApiTxMetadata)
-> (ApiT TxMetadata -> Maybe (ApiT TxMetadata))
-> ApiT TxMetadata
-> ApiTxMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT TxMetadata -> Maybe (ApiT TxMetadata)
forall a. a -> Maybe a
Just (ApiT TxMetadata -> ApiTxMetadata)
-> Parser (ApiT TxMetadata) -> Parser ApiTxMetadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ApiT TxMetadata)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance ToJSON ApiTxMetadata where
    toJSON :: ApiTxMetadata -> Value
toJSON (ApiTxMetadata Maybe (ApiT TxMetadata)
x) = case Maybe (ApiT TxMetadata)
x of
        Maybe (ApiT TxMetadata)
Nothing -> Value
Aeson.Null
        Just (ApiT TxMetadata
md) | TxMetadata -> Bool
txMetadataIsNull TxMetadata
md -> Value
Aeson.Null
        Just ApiT TxMetadata
md -> ApiT TxMetadata -> Value
forall a. ToJSON a => a -> Value
toJSON ApiT TxMetadata
md

instance DecodeAddress n => FromJSON (ApiWalletMigrationPlanPostData n) where
    parseJSON :: Value -> Parser (ApiWalletMigrationPlanPostData n)
parseJSON = Options -> Value -> Parser (ApiWalletMigrationPlanPostData n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress n => ToJSON (ApiWalletMigrationPlanPostData n) where
    toJSON :: ApiWalletMigrationPlanPostData n -> Value
toJSON = Options -> ApiWalletMigrationPlanPostData n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance (DecodeAddress n, PassphraseMaxLength s, PassphraseMinLength s) =>
    FromJSON (ApiWalletMigrationPostData n s)
  where
    parseJSON :: Value -> Parser (ApiWalletMigrationPostData n s)
parseJSON = Options -> Value -> Parser (ApiWalletMigrationPostData n s)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress n =>
    ToJSON (ApiWalletMigrationPostData n s)
  where
    toJSON :: ApiWalletMigrationPostData n s -> Value
toJSON = Options -> ApiWalletMigrationPostData n s -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance (DecodeAddress n) => FromJSON (ApiPutAddressesData n)
  where
    parseJSON :: Value -> Parser (ApiPutAddressesData n)
parseJSON = Options -> Value -> Parser (ApiPutAddressesData n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeAddress n => ToJSON (ApiPutAddressesData n) where
    toJSON :: ApiPutAddressesData n -> Value
toJSON = Options -> ApiPutAddressesData n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeAddress n => FromJSON (ApiTxInput n) where
    parseJSON :: Value -> Parser (ApiTxInput n)
parseJSON Value
v = Maybe (ApiTxOutput n) -> ApiT TxIn -> ApiTxInput n
forall (n :: NetworkDiscriminant).
Maybe (ApiTxOutput n) -> ApiT TxIn -> ApiTxInput n
ApiTxInput (Maybe (ApiTxOutput n) -> ApiT TxIn -> ApiTxInput n)
-> Parser (Maybe (ApiTxOutput n))
-> Parser (ApiT TxIn -> ApiTxInput n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ApiTxOutput n) -> Parser (Maybe (ApiTxOutput n))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Value -> Parser (ApiTxOutput n)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v) Parser (ApiT TxIn -> ApiTxInput n)
-> Parser (ApiT TxIn) -> Parser (ApiTxInput n)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser (ApiT TxIn)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance EncodeAddress n => ToJSON (ApiTxInput n) where
    toJSON :: ApiTxInput n -> Value
toJSON (ApiTxInput Maybe (ApiTxOutput n)
s ApiT TxIn
i) =
        Object -> Value
Object (Object
-> (ApiTxOutput n -> Object) -> Maybe (ApiTxOutput n) -> Object
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Object
forall a. Monoid a => a
mempty (Value -> Object
fromValue (Value -> Object)
-> (ApiTxOutput n -> Value) -> ApiTxOutput n -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiTxOutput n -> Value
forall a. ToJSON a => a -> Value
toJSON) Maybe (ApiTxOutput n)
s Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Value -> Object
fromValue (ApiT TxIn -> Value
forall a. ToJSON a => a -> Value
toJSON ApiT TxIn
i))
      where
        fromValue :: Value -> Object
fromValue (Object Object
o) = Object
o
        fromValue Value
_ = Object
forall a. Monoid a => a
mempty

instance DecodeAddress n => FromJSON (ApiTxCollateral n) where
    parseJSON :: Value -> Parser (ApiTxCollateral n)
parseJSON Value
v = Maybe (AddressAmountNoAssets (ApiT Address, Proxy n))
-> ApiT TxIn -> ApiTxCollateral n
forall (n :: NetworkDiscriminant).
Maybe (AddressAmountNoAssets (ApiT Address, Proxy n))
-> ApiT TxIn -> ApiTxCollateral n
ApiTxCollateral (Maybe (AddressAmountNoAssets (ApiT Address, Proxy n))
 -> ApiT TxIn -> ApiTxCollateral n)
-> Parser (Maybe (AddressAmountNoAssets (ApiT Address, Proxy n)))
-> Parser (ApiT TxIn -> ApiTxCollateral n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (AddressAmountNoAssets (ApiT Address, Proxy n))
-> Parser (Maybe (AddressAmountNoAssets (ApiT Address, Proxy n)))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Value -> Parser (AddressAmountNoAssets (ApiT Address, Proxy n))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v) Parser (ApiT TxIn -> ApiTxCollateral n)
-> Parser (ApiT TxIn) -> Parser (ApiTxCollateral n)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser (ApiT TxIn)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance EncodeAddress n => ToJSON (ApiTxCollateral n) where
    toJSON :: ApiTxCollateral n -> Value
toJSON (ApiTxCollateral Maybe (AddressAmountNoAssets (ApiT Address, Proxy n))
s ApiT TxIn
i) =
        Object -> Value
Object (Object
-> (AddressAmountNoAssets (ApiT Address, Proxy n) -> Object)
-> Maybe (AddressAmountNoAssets (ApiT Address, Proxy n))
-> Object
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Object
forall a. Monoid a => a
mempty (Value -> Object
fromValue (Value -> Object)
-> (AddressAmountNoAssets (ApiT Address, Proxy n) -> Value)
-> AddressAmountNoAssets (ApiT Address, Proxy n)
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressAmountNoAssets (ApiT Address, Proxy n) -> Value
forall a. ToJSON a => a -> Value
toJSON) Maybe (AddressAmountNoAssets (ApiT Address, Proxy n))
s Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Value -> Object
fromValue (ApiT TxIn -> Value
forall a. ToJSON a => a -> Value
toJSON ApiT TxIn
i))
      where
        fromValue :: Value -> Object
fromValue (Object Object
o) = Object
o
        fromValue Value
_ = Object
forall a. Monoid a => a
mempty

instance FromJSON (ApiT TxIn) where
    parseJSON :: Value -> Parser (ApiT TxIn)
parseJSON = String
-> (Object -> Parser (ApiT TxIn)) -> Value -> Parser (ApiT TxIn)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TxIn" ((Object -> Parser (ApiT TxIn)) -> Value -> Parser (ApiT TxIn))
-> (Object -> Parser (ApiT TxIn)) -> Value -> Parser (ApiT TxIn)
forall a b. (a -> b) -> a -> b
$ \Object
v -> TxIn -> ApiT TxIn
forall a. a -> ApiT a
ApiT (TxIn -> ApiT TxIn) -> Parser TxIn -> Parser (ApiT TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Hash "Tx" -> Word32 -> TxIn
TxIn (Hash "Tx" -> Word32 -> TxIn)
-> Parser (Hash "Tx") -> Parser (Word32 -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ApiT (Hash "Tx") -> Hash "Tx")
-> Parser (ApiT (Hash "Tx")) -> Parser (Hash "Tx")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ApiT (Hash "Tx") -> Hash "Tx"
forall a. ApiT a -> a
getApiT (Object
v Object -> Key -> Parser (ApiT (Hash "Tx"))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id") Parser (Word32 -> TxIn) -> Parser Word32 -> Parser TxIn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index")

instance ToJSON (ApiT TxIn) where
    toJSON :: ApiT TxIn -> Value
toJSON (ApiT (TxIn Hash "Tx"
txid Word32
ix)) = [Pair] -> Value
object
        [ Key
"id" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiT (Hash "Tx") -> Value
forall a. ToJSON a => a -> Value
toJSON (Hash "Tx" -> ApiT (Hash "Tx")
forall a. a -> ApiT a
ApiT Hash "Tx"
txid)
        , Key
"index" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON Word32
ix ]

instance FromJSON (ApiT (Hash "Tx")) where
    parseJSON :: Value -> Parser (ApiT (Hash "Tx"))
parseJSON = String -> Value -> Parser (ApiT (Hash "Tx"))
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"Tx Hash"
instance ToJSON (ApiT (Hash "Tx")) where
    toJSON :: ApiT (Hash "Tx") -> Value
toJSON = ApiT (Hash "Tx") -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON (ApiT (Hash "Datum")) where
    parseJSON :: Value -> Parser (ApiT (Hash "Datum"))
parseJSON = String -> Value -> Parser (ApiT (Hash "Datum"))
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"Datum Hash"
instance ToJSON (ApiT (Hash "Datum")) where
    toJSON :: ApiT (Hash "Datum") -> Value
toJSON = ApiT (Hash "Datum") -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON (ApiT Direction) where
    parseJSON :: Value -> Parser (ApiT Direction)
parseJSON = (Direction -> ApiT Direction)
-> Parser Direction -> Parser (ApiT Direction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Direction -> ApiT Direction
forall a. a -> ApiT a
ApiT (Parser Direction -> Parser (ApiT Direction))
-> (Value -> Parser Direction) -> Value -> Parser (ApiT Direction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Value -> Parser Direction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultSumTypeOptions
instance ToJSON (ApiT Direction) where
    toJSON :: ApiT Direction -> Value
toJSON = Options -> Direction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultSumTypeOptions (Direction -> Value)
-> (ApiT Direction -> Direction) -> ApiT Direction -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT Direction -> Direction
forall a. ApiT a -> a
getApiT

instance FromJSON (ApiT TxStatus) where
    parseJSON :: Value -> Parser (ApiT TxStatus)
parseJSON = (TxStatus -> ApiT TxStatus)
-> Parser TxStatus -> Parser (ApiT TxStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxStatus -> ApiT TxStatus
forall a. a -> ApiT a
ApiT (Parser TxStatus -> Parser (ApiT TxStatus))
-> (Value -> Parser TxStatus) -> Value -> Parser (ApiT TxStatus)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Value -> Parser TxStatus
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultSumTypeOptions
instance ToJSON (ApiT TxStatus) where
    toJSON :: ApiT TxStatus -> Value
toJSON = Options -> TxStatus -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultSumTypeOptions (TxStatus -> Value)
-> (ApiT TxStatus -> TxStatus) -> ApiT TxStatus -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT TxStatus -> TxStatus
forall a. ApiT a -> a
getApiT

instance FromJSON ApiNetworkInformation where
    parseJSON :: Value -> Parser ApiNetworkInformation
parseJSON = Options -> Value -> Parser ApiNetworkInformation
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiNetworkInformation where
    toJSON :: ApiNetworkInformation -> Value
toJSON = Options -> ApiNetworkInformation -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON NtpSyncingStatus where
    parseJSON :: Value -> Parser NtpSyncingStatus
parseJSON =
        Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Text)
-> (Text -> Parser NtpSyncingStatus)
-> Value
-> Parser NtpSyncingStatus
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either (ShowFmt TextDecodingError) NtpSyncingStatus
-> Parser NtpSyncingStatus
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt TextDecodingError) NtpSyncingStatus
 -> Parser NtpSyncingStatus)
-> (Text -> Either (ShowFmt TextDecodingError) NtpSyncingStatus)
-> Text
-> Parser NtpSyncingStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> Either TextDecodingError NtpSyncingStatus
-> Either (ShowFmt TextDecodingError) NtpSyncingStatus
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt (Either TextDecodingError NtpSyncingStatus
 -> Either (ShowFmt TextDecodingError) NtpSyncingStatus)
-> (Text -> Either TextDecodingError NtpSyncingStatus)
-> Text
-> Either (ShowFmt TextDecodingError) NtpSyncingStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError NtpSyncingStatus
forall a. FromText a => Text -> Either TextDecodingError a
fromText
instance ToJSON NtpSyncingStatus where
    toJSON :: NtpSyncingStatus -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (NtpSyncingStatus -> Text) -> NtpSyncingStatus -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NtpSyncingStatus -> Text
forall a. ToText a => a -> Text
toText

instance FromJSON ApiNtpStatus where
    parseJSON :: Value -> Parser ApiNtpStatus
parseJSON = Options -> Value -> Parser ApiNtpStatus
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiNtpStatus where
    toJSON :: ApiNtpStatus -> Value
toJSON = Options -> ApiNtpStatus -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiNetworkClock where
    parseJSON :: Value -> Parser ApiNetworkClock
parseJSON = Value -> Parser ApiNtpStatus
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser ApiNtpStatus)
-> (ApiNtpStatus -> Parser ApiNetworkClock)
-> Value
-> Parser ApiNetworkClock
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ApiNetworkClock -> Parser ApiNetworkClock
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiNetworkClock -> Parser ApiNetworkClock)
-> (ApiNtpStatus -> ApiNetworkClock)
-> ApiNtpStatus
-> Parser ApiNetworkClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiNtpStatus -> ApiNetworkClock
ApiNetworkClock
instance ToJSON ApiNetworkClock where
    toJSON :: ApiNetworkClock -> Value
toJSON (ApiNetworkClock ApiNtpStatus
st) = ApiNtpStatus -> Value
forall a. ToJSON a => a -> Value
toJSON ApiNtpStatus
st

instance FromJSON (ApiT StakePoolMetadata) where
    parseJSON :: Value -> Parser (ApiT StakePoolMetadata)
parseJSON = (StakePoolMetadata -> ApiT StakePoolMetadata)
-> Parser StakePoolMetadata -> Parser (ApiT StakePoolMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StakePoolMetadata -> ApiT StakePoolMetadata
forall a. a -> ApiT a
ApiT (Parser StakePoolMetadata -> Parser (ApiT StakePoolMetadata))
-> (Value -> Parser StakePoolMetadata)
-> Value
-> Parser (ApiT StakePoolMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Value -> Parser StakePoolMetadata
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON (ApiT StakePoolMetadata) where
    toJSON :: ApiT StakePoolMetadata -> Value
toJSON = Options -> StakePoolMetadata -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions (StakePoolMetadata -> Value)
-> (ApiT StakePoolMetadata -> StakePoolMetadata)
-> ApiT StakePoolMetadata
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT StakePoolMetadata -> StakePoolMetadata
forall a. ApiT a -> a
getApiT

instance FromJSON (ApiT StartTime) where
    parseJSON :: Value -> Parser (ApiT StartTime)
parseJSON = (UTCTime -> ApiT StartTime)
-> Parser UTCTime -> Parser (ApiT StartTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StartTime -> ApiT StartTime
forall a. a -> ApiT a
ApiT (StartTime -> ApiT StartTime)
-> (UTCTime -> StartTime) -> UTCTime -> ApiT StartTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> StartTime
StartTime) (Parser UTCTime -> Parser (ApiT StartTime))
-> (Value -> Parser UTCTime) -> Value -> Parser (ApiT StartTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser UTCTime
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON (ApiT StartTime) where
    toJSON :: ApiT StartTime -> Value
toJSON (ApiT (StartTime UTCTime
sn)) = UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON UTCTime
sn

instance FromJSON (ApiT SlotLength) where
    parseJSON :: Value -> Parser (ApiT SlotLength)
parseJSON = (NominalDiffTime -> ApiT SlotLength)
-> Parser NominalDiffTime -> Parser (ApiT SlotLength)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SlotLength -> ApiT SlotLength
forall a. a -> ApiT a
ApiT (SlotLength -> ApiT SlotLength)
-> (NominalDiffTime -> SlotLength)
-> NominalDiffTime
-> ApiT SlotLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> SlotLength
SlotLength) (Parser NominalDiffTime -> Parser (ApiT SlotLength))
-> (Value -> Parser NominalDiffTime)
-> Value
-> Parser (ApiT SlotLength)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser NominalDiffTime
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON (ApiT SlotLength) where
    toJSON :: ApiT SlotLength -> Value
toJSON (ApiT (SlotLength NominalDiffTime
sn)) = NominalDiffTime -> Value
forall a. ToJSON a => a -> Value
toJSON NominalDiffTime
sn

instance FromJSON (ApiT EpochLength) where
    parseJSON :: Value -> Parser (ApiT EpochLength)
parseJSON = (Word32 -> ApiT EpochLength)
-> Parser Word32 -> Parser (ApiT EpochLength)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EpochLength -> ApiT EpochLength
forall a. a -> ApiT a
ApiT (EpochLength -> ApiT EpochLength)
-> (Word32 -> EpochLength) -> Word32 -> ApiT EpochLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> EpochLength
EpochLength) (Parser Word32 -> Parser (ApiT EpochLength))
-> (Value -> Parser Word32) -> Value -> Parser (ApiT EpochLength)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Word32
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON (ApiT EpochLength) where
    toJSON :: ApiT EpochLength -> Value
toJSON (ApiT (EpochLength Word32
sn)) = Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON Word32
sn

instance FromJSON (ApiT ActiveSlotCoefficient) where
    parseJSON :: Value -> Parser (ApiT ActiveSlotCoefficient)
parseJSON = (Double -> ApiT ActiveSlotCoefficient)
-> Parser Double -> Parser (ApiT ActiveSlotCoefficient)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ActiveSlotCoefficient -> ApiT ActiveSlotCoefficient
forall a. a -> ApiT a
ApiT (ActiveSlotCoefficient -> ApiT ActiveSlotCoefficient)
-> (Double -> ActiveSlotCoefficient)
-> Double
-> ApiT ActiveSlotCoefficient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ActiveSlotCoefficient
ActiveSlotCoefficient) (Parser Double -> Parser (ApiT ActiveSlotCoefficient))
-> (Value -> Parser Double)
-> Value
-> Parser (ApiT ActiveSlotCoefficient)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Double
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON (ApiT ActiveSlotCoefficient) where
    toJSON :: ApiT ActiveSlotCoefficient -> Value
toJSON (ApiT (ActiveSlotCoefficient Double
sn)) = Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
sn

instance FromJSON (ApiT (Hash "Genesis")) where
    parseJSON :: Value -> Parser (ApiT (Hash "Genesis"))
parseJSON = String -> Value -> Parser (ApiT (Hash "Genesis"))
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"Genesis Hash"
instance ToJSON (ApiT (Hash "Genesis")) where
    toJSON :: ApiT (Hash "Genesis") -> Value
toJSON = ApiT (Hash "Genesis") -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

instance FromJSON ApiEraInfo where
    parseJSON :: Value -> Parser ApiEraInfo
parseJSON = Options -> Value -> Parser ApiEraInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
explicitNothingRecordTypeOptions
instance ToJSON ApiEraInfo where
    toJSON :: ApiEraInfo -> Value
toJSON = Options -> ApiEraInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
explicitNothingRecordTypeOptions

instance FromJSON ApiNetworkParameters where
    parseJSON :: Value -> Parser ApiNetworkParameters
parseJSON = Options -> Value -> Parser ApiNetworkParameters
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiNetworkParameters where
    toJSON :: ApiNetworkParameters -> Value
toJSON = Options -> ApiNetworkParameters -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiWalletSignData where
    parseJSON :: Value -> Parser ApiWalletSignData
parseJSON = Options -> Value -> Parser ApiWalletSignData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiWalletSignData where
    toJSON :: ApiWalletSignData -> Value
toJSON = Options -> ApiWalletSignData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeStakeAddress n => FromJSON (ApiWithdrawal n) where
    parseJSON :: Value -> Parser (ApiWithdrawal n)
parseJSON = Options -> Value -> Parser (ApiWithdrawal n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance EncodeStakeAddress n => ToJSON (ApiWithdrawal n) where
    toJSON :: ApiWithdrawal n -> Value
toJSON = Options -> ApiWithdrawal n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance DecodeStakeAddress n => FromJSON (ApiWithdrawalGeneral n) where
    parseJSON :: Value -> Parser (ApiWithdrawalGeneral n)
parseJSON Value
obj = do
        Maybe Text
myResource <-
            (String
-> (Object -> Parser (Maybe Text)) -> Value -> Parser (Maybe Text)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiWithdrawalGeneral" ((Object -> Parser (Maybe Text)) -> Value -> Parser (Maybe Text))
-> (Object -> Parser (Maybe Text)) -> Value -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$
             \Object
o -> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"context" :: Aeson.Parser (Maybe Text)) Value
obj
        case Maybe Text
myResource of
            Maybe Text
Nothing -> do
                (ApiWithdrawal (ApiT RewardAccount, Proxy n)
addr Quantity "lovelace" Natural
amt)  <- Value -> Parser (ApiWithdrawal n)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj :: Aeson.Parser (ApiWithdrawal n)
                ApiWithdrawalGeneral n -> Parser (ApiWithdrawalGeneral n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiWithdrawalGeneral n -> Parser (ApiWithdrawalGeneral n))
-> ApiWithdrawalGeneral n -> Parser (ApiWithdrawalGeneral n)
forall a b. (a -> b) -> a -> b
$ (ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural
-> ResourceContext
-> ApiWithdrawalGeneral n
forall (n :: NetworkDiscriminant).
(ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural
-> ResourceContext
-> ApiWithdrawalGeneral n
ApiWithdrawalGeneral (ApiT RewardAccount, Proxy n)
addr Quantity "lovelace" Natural
amt ResourceContext
External
            Maybe Text
_ -> do
                (ApiWithdrawal (ApiT RewardAccount, Proxy n)
addr Quantity "lovelace" Natural
amt)  <- Value -> Parser (ApiWithdrawal n)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj :: Aeson.Parser (ApiWithdrawal n)
                ApiWithdrawalGeneral n -> Parser (ApiWithdrawalGeneral n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiWithdrawalGeneral n -> Parser (ApiWithdrawalGeneral n))
-> ApiWithdrawalGeneral n -> Parser (ApiWithdrawalGeneral n)
forall a b. (a -> b) -> a -> b
$ (ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural
-> ResourceContext
-> ApiWithdrawalGeneral n
forall (n :: NetworkDiscriminant).
(ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural
-> ResourceContext
-> ApiWithdrawalGeneral n
ApiWithdrawalGeneral (ApiT RewardAccount, Proxy n)
addr Quantity "lovelace" Natural
amt ResourceContext
Our
instance EncodeStakeAddress n => ToJSON (ApiWithdrawalGeneral n) where
    toJSON :: ApiWithdrawalGeneral n -> Value
toJSON (ApiWithdrawalGeneral (ApiT RewardAccount, Proxy n)
addr Quantity "lovelace" Natural
amt ResourceContext
ctx) = do
        let obj :: [Pair]
obj = [ Key
"stake_address" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (ApiT RewardAccount, Proxy n) -> Value
forall a. ToJSON a => a -> Value
toJSON (ApiT RewardAccount, Proxy n)
addr
                  , Key
"amount" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Quantity "lovelace" Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Quantity "lovelace" Natural
amt]
        case ResourceContext
ctx of
            ResourceContext
External -> [Pair] -> Value
object [Pair]
obj
            ResourceContext
Our -> [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair]
obj [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"context" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ours"]

instance {-# OVERLAPS #-} (DecodeStakeAddress n)
    => FromJSON (ApiT W.RewardAccount, Proxy n)
  where
    parseJSON :: Value -> Parser (ApiT RewardAccount, Proxy n)
parseJSON Value
x = do
        let proxy :: Proxy n
proxy = Proxy n
forall k (t :: k). Proxy t
Proxy @n
        ApiT RewardAccount
acct <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x Parser Text
-> (Text -> Parser (ApiT RewardAccount))
-> Parser (ApiT RewardAccount)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (ShowFmt TextDecodingError) (ApiT RewardAccount)
-> Parser (ApiT RewardAccount)
forall s a. Show s => Either s a -> Parser a
eitherToParser
            (Either (ShowFmt TextDecodingError) (ApiT RewardAccount)
 -> Parser (ApiT RewardAccount))
-> (Text
    -> Either (ShowFmt TextDecodingError) (ApiT RewardAccount))
-> Text
-> Parser (ApiT RewardAccount)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> (RewardAccount -> ApiT RewardAccount)
-> Either TextDecodingError RewardAccount
-> Either (ShowFmt TextDecodingError) (ApiT RewardAccount)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt RewardAccount -> ApiT RewardAccount
forall a. a -> ApiT a
ApiT
            (Either TextDecodingError RewardAccount
 -> Either (ShowFmt TextDecodingError) (ApiT RewardAccount))
-> (Text -> Either TextDecodingError RewardAccount)
-> Text
-> Either (ShowFmt TextDecodingError) (ApiT RewardAccount)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeStakeAddress n =>
Text -> Either TextDecodingError RewardAccount
forall (n :: NetworkDiscriminant).
DecodeStakeAddress n =>
Text -> Either TextDecodingError RewardAccount
decodeStakeAddress @n
        (ApiT RewardAccount, Proxy n)
-> Parser (ApiT RewardAccount, Proxy n)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiT RewardAccount
acct, Proxy n
proxy)

instance {-# OVERLAPS #-} EncodeStakeAddress n
    => ToJSON (ApiT W.RewardAccount, Proxy n)
  where
    toJSON :: (ApiT RewardAccount, Proxy n) -> Value
toJSON (ApiT RewardAccount
acct, Proxy n
_) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (ApiT RewardAccount -> Text) -> ApiT RewardAccount -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeStakeAddress n => RewardAccount -> Text
forall (n :: NetworkDiscriminant).
EncodeStakeAddress n =>
RewardAccount -> Text
encodeStakeAddress @n (RewardAccount -> Text)
-> (ApiT RewardAccount -> RewardAccount)
-> ApiT RewardAccount
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT RewardAccount -> RewardAccount
forall a. ApiT a -> a
getApiT (ApiT RewardAccount -> Value) -> ApiT RewardAccount -> Value
forall a b. (a -> b) -> a -> b
$ ApiT RewardAccount
acct

instance ToJSON XPubOrSelf where
    toJSON :: XPubOrSelf -> Value
toJSON (SomeAccountKey XPub
xpub) =
        Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode Encoding
forall a. AbstractEncoding a
EBase16 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ XPub -> ByteString
xpubToBytes XPub
xpub
    toJSON XPubOrSelf
Self = Value
"self"

instance FromJSON XPubOrSelf where
    parseJSON :: Value -> Parser XPubOrSelf
parseJSON Value
t = Value -> Parser XPubOrSelf
parseXPub Value
t Parser XPubOrSelf -> Parser XPubOrSelf -> Parser XPubOrSelf
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser XPubOrSelf
parseSelf Value
t
      where
        parseXPub :: Value -> Parser XPubOrSelf
parseXPub = String -> (Text -> Parser XPubOrSelf) -> Value -> Parser XPubOrSelf
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"XPub" ((Text -> Parser XPubOrSelf) -> Value -> Parser XPubOrSelf)
-> (Text -> Parser XPubOrSelf) -> Value -> Parser XPubOrSelf
forall a b. (a -> b) -> a -> b
$ \Text
txt ->
            case ByteString -> Either String ByteString
fromBase16 (Text -> ByteString
T.encodeUtf8 Text
txt) of
                Left String
err -> String -> Parser XPubOrSelf
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
                Right ByteString
hex' -> case ByteString -> Maybe XPub
xpubFromBytes ByteString
hex' of
                    Maybe XPub
Nothing -> String -> Parser XPubOrSelf
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Extended public key cannot be retrieved from a given hex bytestring"
                    Just XPub
validXPub -> XPubOrSelf -> Parser XPubOrSelf
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPubOrSelf -> Parser XPubOrSelf)
-> XPubOrSelf -> Parser XPubOrSelf
forall a b. (a -> b) -> a -> b
$ XPub -> XPubOrSelf
SomeAccountKey XPub
validXPub
        parseSelf :: Value -> Parser XPubOrSelf
parseSelf = String -> (Text -> Parser XPubOrSelf) -> Value -> Parser XPubOrSelf
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Self" ((Text -> Parser XPubOrSelf) -> Value -> Parser XPubOrSelf)
-> (Text -> Parser XPubOrSelf) -> Value -> Parser XPubOrSelf
forall a b. (a -> b) -> a -> b
$ \Text
txt ->
            if Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"self" then
                XPubOrSelf -> Parser XPubOrSelf
forall (f :: * -> *) a. Applicative f => a -> f a
pure XPubOrSelf
Self
            else
                String -> Parser XPubOrSelf
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"'self' is expected."

instance FromJSON ApiScriptTemplateEntry where
    parseJSON :: Value -> Parser ApiScriptTemplateEntry
parseJSON = String
-> (Object -> Parser ApiScriptTemplateEntry)
-> Value
-> Parser ApiScriptTemplateEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiScriptTemplateEntry" ((Object -> Parser ApiScriptTemplateEntry)
 -> Value -> Parser ApiScriptTemplateEntry)
-> (Object -> Parser ApiScriptTemplateEntry)
-> Value
-> Parser ApiScriptTemplateEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Parser (Script Cosigner)
template' <- Value -> Parser (Script Cosigner)
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser (Script Cosigner))
-> Parser Value -> Parser (Parser (Script Cosigner))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"template"
        Parser [(Cosigner, XPubOrSelf)]
cosigners' <- Value -> Parser [(Cosigner, XPubOrSelf)]
parseCosignerPairs (Value -> Parser [(Cosigner, XPubOrSelf)])
-> Parser Value -> Parser (Parser [(Cosigner, XPubOrSelf)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cosigners"
        Map Cosigner XPubOrSelf
-> Script Cosigner -> ApiScriptTemplateEntry
ApiScriptTemplateEntry (Map Cosigner XPubOrSelf
 -> Script Cosigner -> ApiScriptTemplateEntry)
-> Parser (Map Cosigner XPubOrSelf)
-> Parser (Script Cosigner -> ApiScriptTemplateEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Cosigner, XPubOrSelf)] -> Map Cosigner XPubOrSelf
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Cosigner, XPubOrSelf)] -> Map Cosigner XPubOrSelf)
-> Parser [(Cosigner, XPubOrSelf)]
-> Parser (Map Cosigner XPubOrSelf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(Cosigner, XPubOrSelf)]
cosigners') Parser (Script Cosigner -> ApiScriptTemplateEntry)
-> Parser (Script Cosigner) -> Parser ApiScriptTemplateEntry
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Script Cosigner)
template'
      where
        parseCosignerPairs :: Value -> Parser [(Cosigner, XPubOrSelf)]
parseCosignerPairs = String
-> (Object -> Parser [(Cosigner, XPubOrSelf)])
-> Value
-> Parser [(Cosigner, XPubOrSelf)]
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Cosigner pairs" ((Object -> Parser [(Cosigner, XPubOrSelf)])
 -> Value -> Parser [(Cosigner, XPubOrSelf)])
-> (Object -> Parser [(Cosigner, XPubOrSelf)])
-> Value
-> Parser [(Cosigner, XPubOrSelf)]
forall a b. (a -> b) -> a -> b
$ \Object
o ->
            case Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
Aeson.toList Object
o of
                [] -> String -> Parser [(Cosigner, XPubOrSelf)]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cosigners object array should not be empty"
                [Pair]
cs -> [Pair]
-> (Pair -> Parser (Cosigner, XPubOrSelf))
-> Parser [(Cosigner, XPubOrSelf)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([Pair] -> [Pair]
forall a. [a] -> [a]
reverse [Pair]
cs) ((Pair -> Parser (Cosigner, XPubOrSelf))
 -> Parser [(Cosigner, XPubOrSelf)])
-> (Pair -> Parser (Cosigner, XPubOrSelf))
-> Parser [(Cosigner, XPubOrSelf)]
forall a b. (a -> b) -> a -> b
$ \(Key
numTxt, Value
str) -> do
                    Cosigner
cosigner' <- FromJSON Cosigner => Value -> Parser Cosigner
forall a. FromJSON a => Value -> Parser a
parseJSON @Cosigner (Value -> Parser Cosigner) -> Value -> Parser Cosigner
forall a b. (a -> b) -> a -> b
$
                        Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Text
Aeson.toText Key
numTxt
                    XPubOrSelf
xpubOrSelf <- Value -> Parser XPubOrSelf
forall a. FromJSON a => Value -> Parser a
parseJSON Value
str
                    (Cosigner, XPubOrSelf) -> Parser (Cosigner, XPubOrSelf)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cosigner
cosigner', XPubOrSelf
xpubOrSelf)

instance ToJSON ApiScriptTemplateEntry where
    toJSON :: ApiScriptTemplateEntry -> Value
toJSON (ApiScriptTemplateEntry Map Cosigner XPubOrSelf
cosigners' Script Cosigner
template') =
        [Pair] -> Value
object [ Key
"cosigners" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object (((Cosigner, XPubOrSelf) -> Pair)
-> [(Cosigner, XPubOrSelf)] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Cosigner, XPubOrSelf) -> Pair
forall a. ToJSON a => (Cosigner, a) -> Pair
toPair (Map Cosigner XPubOrSelf -> [(Cosigner, XPubOrSelf)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Cosigner XPubOrSelf
cosigners'))
               , Key
"template" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Script Cosigner -> Value
forall a. ToJSON a => a -> Value
toJSON Script Cosigner
template']
      where
        cosignerToKey :: Cosigner -> Key
cosignerToKey (Cosigner Word8
ix) =
            Text -> Key
Aeson.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ Text
"cosigner#"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Word8 -> String
forall a. Show a => a -> String
show Word8
ix)
        toPair :: (Cosigner, a) -> Pair
toPair (Cosigner
cosigner', a
xpubOrSelf) =
            ( Cosigner -> Key
cosignerToKey Cosigner
cosigner'
            , a -> Value
forall a. ToJSON a => a -> Value
toJSON a
xpubOrSelf
            )

instance FromJSON ApiSharedWalletPostDataFromAccountPubX where
    parseJSON :: Value -> Parser ApiSharedWalletPostDataFromAccountPubX
parseJSON = Options -> Value -> Parser ApiSharedWalletPostDataFromAccountPubX
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiSharedWalletPostDataFromAccountPubX where
    toJSON :: ApiSharedWalletPostDataFromAccountPubX -> Value
toJSON = Options -> ApiSharedWalletPostDataFromAccountPubX -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiSharedWalletPostDataFromMnemonics where
    parseJSON :: Value -> Parser ApiSharedWalletPostDataFromMnemonics
parseJSON = Options -> Value -> Parser ApiSharedWalletPostDataFromMnemonics
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiSharedWalletPostDataFromMnemonics where
    toJSON :: ApiSharedWalletPostDataFromMnemonics -> Value
toJSON = Options -> ApiSharedWalletPostDataFromMnemonics -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiSharedWalletPostData where
    parseJSON :: Value -> Parser ApiSharedWalletPostData
parseJSON Value
obj = do
        Maybe [Text]
mnemonic <-
            (String
-> (Object -> Parser (Maybe [Text]))
-> Value
-> Parser (Maybe [Text])
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"postData" ((Object -> Parser (Maybe [Text]))
 -> Value -> Parser (Maybe [Text]))
-> (Object -> Parser (Maybe [Text]))
-> Value
-> Parser (Maybe [Text])
forall a b. (a -> b) -> a -> b
$
             \Object
o -> Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mnemonic_sentence" :: Aeson.Parser (Maybe [Text])) Value
obj
        case Maybe [Text]
mnemonic of
            Maybe [Text]
Nothing -> do
                ApiSharedWalletPostDataFromAccountPubX
xs <- Value -> Parser ApiSharedWalletPostDataFromAccountPubX
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj :: Aeson.Parser ApiSharedWalletPostDataFromAccountPubX
                ApiSharedWalletPostData -> Parser ApiSharedWalletPostData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiSharedWalletPostData -> Parser ApiSharedWalletPostData)
-> ApiSharedWalletPostData -> Parser ApiSharedWalletPostData
forall a b. (a -> b) -> a -> b
$ Either
  ApiSharedWalletPostDataFromMnemonics
  ApiSharedWalletPostDataFromAccountPubX
-> ApiSharedWalletPostData
ApiSharedWalletPostData (Either
   ApiSharedWalletPostDataFromMnemonics
   ApiSharedWalletPostDataFromAccountPubX
 -> ApiSharedWalletPostData)
-> Either
     ApiSharedWalletPostDataFromMnemonics
     ApiSharedWalletPostDataFromAccountPubX
-> ApiSharedWalletPostData
forall a b. (a -> b) -> a -> b
$ ApiSharedWalletPostDataFromAccountPubX
-> Either
     ApiSharedWalletPostDataFromMnemonics
     ApiSharedWalletPostDataFromAccountPubX
forall a b. b -> Either a b
Right ApiSharedWalletPostDataFromAccountPubX
xs
            Maybe [Text]
_ -> do
                ApiSharedWalletPostDataFromMnemonics
xs <- Value -> Parser ApiSharedWalletPostDataFromMnemonics
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj :: Aeson.Parser ApiSharedWalletPostDataFromMnemonics
                ApiSharedWalletPostData -> Parser ApiSharedWalletPostData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiSharedWalletPostData -> Parser ApiSharedWalletPostData)
-> ApiSharedWalletPostData -> Parser ApiSharedWalletPostData
forall a b. (a -> b) -> a -> b
$ Either
  ApiSharedWalletPostDataFromMnemonics
  ApiSharedWalletPostDataFromAccountPubX
-> ApiSharedWalletPostData
ApiSharedWalletPostData (Either
   ApiSharedWalletPostDataFromMnemonics
   ApiSharedWalletPostDataFromAccountPubX
 -> ApiSharedWalletPostData)
-> Either
     ApiSharedWalletPostDataFromMnemonics
     ApiSharedWalletPostDataFromAccountPubX
-> ApiSharedWalletPostData
forall a b. (a -> b) -> a -> b
$ ApiSharedWalletPostDataFromMnemonics
-> Either
     ApiSharedWalletPostDataFromMnemonics
     ApiSharedWalletPostDataFromAccountPubX
forall a b. a -> Either a b
Left ApiSharedWalletPostDataFromMnemonics
xs

instance ToJSON ApiSharedWalletPostData where
    toJSON :: ApiSharedWalletPostData -> Value
toJSON (ApiSharedWalletPostData (Left ApiSharedWalletPostDataFromMnemonics
c))= ApiSharedWalletPostDataFromMnemonics -> Value
forall a. ToJSON a => a -> Value
toJSON ApiSharedWalletPostDataFromMnemonics
c
    toJSON (ApiSharedWalletPostData (Right ApiSharedWalletPostDataFromAccountPubX
c))= ApiSharedWalletPostDataFromAccountPubX -> Value
forall a. ToJSON a => a -> Value
toJSON ApiSharedWalletPostDataFromAccountPubX
c

instance FromJSON (ApiT Cosigner) where
    parseJSON :: Value -> Parser (ApiT Cosigner)
parseJSON =
        Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Text)
-> (Text -> Parser (ApiT Cosigner))
-> Value
-> Parser (ApiT Cosigner)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either (ShowFmt TextDecodingError) (ApiT Cosigner)
-> Parser (ApiT Cosigner)
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt TextDecodingError) (ApiT Cosigner)
 -> Parser (ApiT Cosigner))
-> (Text -> Either (ShowFmt TextDecodingError) (ApiT Cosigner))
-> Text
-> Parser (ApiT Cosigner)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> Either TextDecodingError (ApiT Cosigner)
-> Either (ShowFmt TextDecodingError) (ApiT Cosigner)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt (Either TextDecodingError (ApiT Cosigner)
 -> Either (ShowFmt TextDecodingError) (ApiT Cosigner))
-> (Text -> Either TextDecodingError (ApiT Cosigner))
-> Text
-> Either (ShowFmt TextDecodingError) (ApiT Cosigner)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError (ApiT Cosigner)
forall a. FromText a => Text -> Either TextDecodingError a
fromText
instance ToJSON (ApiT Cosigner) where
    toJSON :: ApiT Cosigner -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (ApiT Cosigner -> Text) -> ApiT Cosigner -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT Cosigner -> Text
forall a. ToText a => a -> Text
toText

instance FromJSON ApiSharedWalletPatchData where
    parseJSON :: Value -> Parser ApiSharedWalletPatchData
parseJSON = String
-> (Object -> Parser ApiSharedWalletPatchData)
-> Value
-> Parser ApiSharedWalletPatchData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiSharedWalletPatchData" ((Object -> Parser ApiSharedWalletPatchData)
 -> Value -> Parser ApiSharedWalletPatchData)
-> (Object -> Parser ApiSharedWalletPatchData)
-> Value
-> Parser ApiSharedWalletPatchData
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        case Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
Aeson.toList Object
o of
            [] -> String -> Parser ApiSharedWalletPatchData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ApiSharedWalletPatchData should not be empty"
            [(Key
numTxt, Value
str)] -> do
                ApiT Cosigner
cosigner' <- Value -> Parser (ApiT Cosigner)
forall a. FromJSON a => Value -> Parser a
parseJSON @(ApiT Cosigner)
                    (Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Text
Aeson.toText Key
numTxt)
                ApiAccountPublicKey
xpub <- Value -> Parser ApiAccountPublicKey
forall a. FromJSON a => Value -> Parser a
parseJSON @ApiAccountPublicKey Value
str
                ApiSharedWalletPatchData -> Parser ApiSharedWalletPatchData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiSharedWalletPatchData -> Parser ApiSharedWalletPatchData)
-> ApiSharedWalletPatchData -> Parser ApiSharedWalletPatchData
forall a b. (a -> b) -> a -> b
$ ApiT Cosigner -> ApiAccountPublicKey -> ApiSharedWalletPatchData
ApiSharedWalletPatchData ApiT Cosigner
cosigner' ApiAccountPublicKey
xpub
            [Pair]
_ -> String -> Parser ApiSharedWalletPatchData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ApiSharedWalletPatchData should have one pair"

instance ToJSON ApiSharedWalletPatchData where
    toJSON :: ApiSharedWalletPatchData -> Value
toJSON (ApiSharedWalletPatchData ApiT Cosigner
cosigner ApiAccountPublicKey
accXPub) =
        [Pair] -> Value
object [ Text -> Key
Aeson.fromText (ApiT Cosigner -> Text
forall a. ToText a => a -> Text
toText ApiT Cosigner
cosigner) Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiAccountPublicKey -> Value
forall a. ToJSON a => a -> Value
toJSON ApiAccountPublicKey
accXPub ]

instance FromJSON ApiActiveSharedWallet where
    parseJSON :: Value -> Parser ApiActiveSharedWallet
parseJSON = Options -> Value -> Parser ApiActiveSharedWallet
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiActiveSharedWallet where
    toJSON :: ApiActiveSharedWallet -> Value
toJSON = Options -> ApiActiveSharedWallet -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiPendingSharedWallet where
    parseJSON :: Value -> Parser ApiPendingSharedWallet
parseJSON Value
val = case Value
val of
        Aeson.Object Object
obj -> do
            let obj' :: Object
obj' = Key -> Object -> Object
forall v. Key -> KeyMap v -> KeyMap v
Aeson.delete (Text -> Key
Aeson.fromText Text
"state") Object
obj
            Options -> Value -> Parser ApiPendingSharedWallet
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions (Object -> Value
Aeson.Object Object
obj')
        Value
_ -> String -> Parser ApiPendingSharedWallet
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ApiPendingSharedWallet should be object"

instance ToJSON ApiPendingSharedWallet where
    toJSON :: ApiPendingSharedWallet -> Value
toJSON ApiPendingSharedWallet
wal = Object -> Value
Aeson.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
Aeson.insert
        (Text -> Key
Aeson.fromText Text
"state")
        ([Pair] -> Value
object [Key
"status" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"incomplete"]) Object
obj
      where
        Aeson.Object Object
obj = Options -> ApiPendingSharedWallet -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions ApiPendingSharedWallet
wal

instance FromJSON ApiSharedWallet where
    parseJSON :: Value -> Parser ApiSharedWallet
parseJSON Value
obj = do
        Maybe ApiWalletBalance
balance <-
            (String
-> (Object -> Parser (Maybe ApiWalletBalance))
-> Value
-> Parser (Maybe ApiWalletBalance)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActiveSharedWallet" ((Object -> Parser (Maybe ApiWalletBalance))
 -> Value -> Parser (Maybe ApiWalletBalance))
-> (Object -> Parser (Maybe ApiWalletBalance))
-> Value
-> Parser (Maybe ApiWalletBalance)
forall a b. (a -> b) -> a -> b
$
             \Object
o -> Object
o Object -> Key -> Parser (Maybe ApiWalletBalance)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"balance" :: Aeson.Parser (Maybe ApiWalletBalance)) Value
obj
        case Maybe ApiWalletBalance
balance of
            Maybe ApiWalletBalance
Nothing -> do
                ApiPendingSharedWallet
xs <- Value -> Parser ApiPendingSharedWallet
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj :: Aeson.Parser ApiPendingSharedWallet
                ApiSharedWallet -> Parser ApiSharedWallet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiSharedWallet -> Parser ApiSharedWallet)
-> ApiSharedWallet -> Parser ApiSharedWallet
forall a b. (a -> b) -> a -> b
$ Either ApiPendingSharedWallet ApiActiveSharedWallet
-> ApiSharedWallet
ApiSharedWallet (Either ApiPendingSharedWallet ApiActiveSharedWallet
 -> ApiSharedWallet)
-> Either ApiPendingSharedWallet ApiActiveSharedWallet
-> ApiSharedWallet
forall a b. (a -> b) -> a -> b
$ ApiPendingSharedWallet
-> Either ApiPendingSharedWallet ApiActiveSharedWallet
forall a b. a -> Either a b
Left ApiPendingSharedWallet
xs
            Maybe ApiWalletBalance
_ -> do
                ApiActiveSharedWallet
xs <- Value -> Parser ApiActiveSharedWallet
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj :: Aeson.Parser ApiActiveSharedWallet
                ApiSharedWallet -> Parser ApiSharedWallet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiSharedWallet -> Parser ApiSharedWallet)
-> ApiSharedWallet -> Parser ApiSharedWallet
forall a b. (a -> b) -> a -> b
$ Either ApiPendingSharedWallet ApiActiveSharedWallet
-> ApiSharedWallet
ApiSharedWallet (Either ApiPendingSharedWallet ApiActiveSharedWallet
 -> ApiSharedWallet)
-> Either ApiPendingSharedWallet ApiActiveSharedWallet
-> ApiSharedWallet
forall a b. (a -> b) -> a -> b
$ ApiActiveSharedWallet
-> Either ApiPendingSharedWallet ApiActiveSharedWallet
forall a b. b -> Either a b
Right ApiActiveSharedWallet
xs

instance ToJSON ApiSharedWallet where
    toJSON :: ApiSharedWallet -> Value
toJSON (ApiSharedWallet (Left ApiPendingSharedWallet
c))= ApiPendingSharedWallet -> Value
forall a. ToJSON a => a -> Value
toJSON ApiPendingSharedWallet
c
    toJSON (ApiSharedWallet (Right ApiActiveSharedWallet
c))= ApiActiveSharedWallet -> Value
forall a. ToJSON a => a -> Value
toJSON ApiActiveSharedWallet
c

instance ToJSON ApiErrorCode where
    toJSON :: ApiErrorCode -> Value
toJSON = Options -> ApiErrorCode -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultSumTypeOptions

-- | Options for encoding synchronization progress. It can be serialized to
-- and from JSON as follows:
--
-- >>> Aeson.encode Ready
-- {"status":"ready"}
--
-- >>> Aeson.encode $ Restoring (Quantity 14)
-- {"status":"restoring","progress":{"quantity":14,"unit":"percent"}}
syncProgressOptions :: Aeson.Options
syncProgressOptions :: Options
syncProgressOptions = Options -> TaggedObjectOptions -> Options
taggedSumTypeOptions Options
defaultSumTypeOptions (TaggedObjectOptions -> Options) -> TaggedObjectOptions -> Options
forall a b. (a -> b) -> a -> b
$
    TaggedObjectOptions :: String -> String -> TaggedObjectOptions
TaggedObjectOptions
        { $sel:_tagFieldName:TaggedObjectOptions :: String
_tagFieldName = String
"status"
        , $sel:_contentsFieldName:TaggedObjectOptions :: String
_contentsFieldName = String
"progress"
        }

{-------------------------------------------------------------------------------
                             JSON Instances: Byron
-------------------------------------------------------------------------------}

instance FromJSON ApiByronWallet where
    parseJSON :: Value -> Parser ApiByronWallet
parseJSON = Options -> Value -> Parser ApiByronWallet
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiByronWallet where
    toJSON :: ApiByronWallet -> Value
toJSON = Options -> ApiByronWallet -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiWalletMigrationBalance where
    parseJSON :: Value -> Parser ApiWalletMigrationBalance
parseJSON = Options -> Value -> Parser ApiWalletMigrationBalance
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiWalletMigrationBalance where
    toJSON :: ApiWalletMigrationBalance -> Value
toJSON = Options -> ApiWalletMigrationBalance -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance (DecodeStakeAddress n, DecodeAddress n) =>
    FromJSON (ApiWalletMigrationPlan n)
  where
    parseJSON :: Value -> Parser (ApiWalletMigrationPlan n)
parseJSON = Options -> Value -> Parser (ApiWalletMigrationPlan n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance (EncodeStakeAddress n, EncodeAddress n) =>
    ToJSON (ApiWalletMigrationPlan n)
  where
    toJSON :: ApiWalletMigrationPlan n -> Value
toJSON = Options -> ApiWalletMigrationPlan n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON ApiPostRandomAddressData where
    parseJSON :: Value -> Parser ApiPostRandomAddressData
parseJSON = Options -> Value -> Parser ApiPostRandomAddressData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiPostRandomAddressData where
    toJSON :: ApiPostRandomAddressData -> Value
toJSON = Options -> ApiPostRandomAddressData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance
  ( Enum (Index derivation level)
  , Bounded (Index derivation level)
  ) => FromJSON (ApiT (Index derivation level)) where
    parseJSON :: Value -> Parser (ApiT (Index derivation level))
parseJSON Value
bytes = do
        Int
n <- Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON @Int Value
bytes
        Either (ShowFmt TextDecodingError) (ApiT (Index derivation level))
-> Parser (ApiT (Index derivation level))
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt TextDecodingError) (ApiT (Index derivation level))
 -> Parser (ApiT (Index derivation level)))
-> (String
    -> Either
         (ShowFmt TextDecodingError) (ApiT (Index derivation level)))
-> String
-> Parser (ApiT (Index derivation level))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> (Index derivation level -> ApiT (Index derivation level))
-> Either TextDecodingError (Index derivation level)
-> Either
     (ShowFmt TextDecodingError) (ApiT (Index derivation level))
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt Index derivation level -> ApiT (Index derivation level)
forall a. a -> ApiT a
ApiT (Either TextDecodingError (Index derivation level)
 -> Either
      (ShowFmt TextDecodingError) (ApiT (Index derivation level)))
-> (String -> Either TextDecodingError (Index derivation level))
-> String
-> Either
     (ShowFmt TextDecodingError) (ApiT (Index derivation level))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError (Index derivation level)
forall a. FromText a => Text -> Either TextDecodingError a
fromText (Text -> Either TextDecodingError (Index derivation level))
-> (String -> Text)
-> String
-> Either TextDecodingError (Index derivation level)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Parser (ApiT (Index derivation level)))
-> String -> Parser (ApiT (Index derivation level))
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n

instance
  ( Enum (Index derivation level)
  ) => ToJSON (ApiT (Index derivation level)) where
    toJSON :: ApiT (Index derivation level) -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value)
-> (ApiT (Index derivation level) -> Int)
-> ApiT (Index derivation level)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index derivation level -> Int
forall a. Enum a => a -> Int
fromEnum (Index derivation level -> Int)
-> (ApiT (Index derivation level) -> Index derivation level)
-> ApiT (Index derivation level)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT (Index derivation level) -> Index derivation level
forall a. ApiT a -> a
getApiT

instance FromJSON ApiWalletDiscovery where
    parseJSON :: Value -> Parser ApiWalletDiscovery
parseJSON = Options -> Value -> Parser ApiWalletDiscovery
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ApiWalletDiscovery)
-> Options -> Value -> Parser ApiWalletDiscovery
forall a b. (a -> b) -> a -> b
$ Options
Aeson.defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
camelTo2 Char
'_' }

instance ToJSON ApiWalletDiscovery where
    toJSON :: ApiWalletDiscovery -> Value
toJSON = Options -> ApiWalletDiscovery -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> ApiWalletDiscovery -> Value)
-> Options -> ApiWalletDiscovery -> Value
forall a b. (a -> b) -> a -> b
$ Options
Aeson.defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
camelTo2 Char
'_' }

instance ToJSON ApiAddressInspect where
    toJSON :: ApiAddressInspect -> Value
toJSON = ApiAddressInspect -> Value
unApiAddressInspect

instance FromJSON ApiAddressInspect where
    parseJSON :: Value -> Parser ApiAddressInspect
parseJSON = ApiAddressInspect -> Parser ApiAddressInspect
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiAddressInspect -> Parser ApiAddressInspect)
-> (Value -> ApiAddressInspect)
-> Value
-> Parser ApiAddressInspect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ApiAddressInspect
ApiAddressInspect

{-------------------------------------------------------------------------------
                             FromText/ToText instances
-------------------------------------------------------------------------------}

instance (HasBase b, ByteArray bs) => FromText (ApiBytesT b bs) where
    fromText :: Text -> Either TextDecodingError (ApiBytesT b bs)
fromText = (bs -> ApiBytesT b bs)
-> Either TextDecodingError bs
-> Either TextDecodingError (ApiBytesT b bs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap bs -> ApiBytesT b bs
forall (base :: Base) bs. bs -> ApiBytesT base bs
ApiBytesT (Either TextDecodingError bs
 -> Either TextDecodingError (ApiBytesT b bs))
-> (Text -> Either TextDecodingError bs)
-> Text
-> Either TextDecodingError (ApiBytesT b bs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> Text -> Either TextDecodingError bs
forall bs.
ByteArray bs =>
Base -> Text -> Either TextDecodingError bs
fromTextBytes (HasBase b => Base
forall k (a :: k). HasBase a => Base
baseFor @b)

instance (HasBase b, ByteArrayAccess bs) => ToText (ApiBytesT b bs) where
    toText :: ApiBytesT b bs -> Text
toText = Base -> bs -> Text
forall bs. ByteArrayAccess bs => Base -> bs -> Text
toTextBytes (HasBase b => Base
forall k (a :: k). HasBase a => Base
baseFor @b) (bs -> Text) -> (ApiBytesT b bs -> bs) -> ApiBytesT b bs -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiBytesT b bs -> bs
forall (base :: Base) bs. ApiBytesT base bs -> bs
getApiBytesT

class Typeable a => HasBase a where
    baseFor :: Base
instance HasBase 'Base16 where
    baseFor :: Base
baseFor = Base
Base16
instance HasBase 'Base64 where
    baseFor :: Base
baseFor = Base
Base64

fromTextBytes :: ByteArray bs => Base -> Text -> Either TextDecodingError bs
fromTextBytes :: Base -> Text -> Either TextDecodingError bs
fromTextBytes Base
base = (String -> TextDecodingError)
-> Either String bs -> Either TextDecodingError bs
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (TextDecodingError -> String -> TextDecodingError
forall a b. a -> b -> a
const TextDecodingError
errMsg) (Either String bs -> Either TextDecodingError bs)
-> (Text -> Either String bs)
-> Text
-> Either TextDecodingError bs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> Either String bs
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
base (ByteString -> Either String bs)
-> (Text -> ByteString) -> Text -> Either String bs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
  where
    errMsg :: TextDecodingError
errMsg = String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"Parse error. Expecting ", Base -> String
forall a. Show a => a -> String
show Base
base, String
"-encoded format." ]

toTextBytes :: ByteArrayAccess bs => Base -> bs -> Text
toTextBytes :: Base -> bs -> Text
toTextBytes Base
base = ByteString -> Text
T.decodeLatin1 (ByteString -> Text) -> (bs -> ByteString) -> bs -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> bs -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
base

instance FromText (AddressAmount Text) where
    fromText :: Text -> Either TextDecodingError (AddressAmount Text)
fromText Text
text = do
        let err :: Either TextDecodingError (AddressAmount Text)
err = TextDecodingError -> Either TextDecodingError (AddressAmount Text)
forall a b. a -> Either a b
Left (TextDecodingError
 -> Either TextDecodingError (AddressAmount Text))
-> (String -> TextDecodingError)
-> String
-> Either TextDecodingError (AddressAmount Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TextDecodingError
TextDecodingError (String -> Either TextDecodingError (AddressAmount Text))
-> String -> Either TextDecodingError (AddressAmount Text)
forall a b. (a -> b) -> a -> b
$ String
"Parse error. Expecting format \
            \\"<amount>@<address>\" but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
text
        case (Char -> Bool) -> Text -> [Text]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'@') Text
text of
            [] -> Either TextDecodingError (AddressAmount Text)
err
            [Text
_] -> Either TextDecodingError (AddressAmount Text)
err
            [Text
l, Text
r] -> Text
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> AddressAmount Text
forall addr.
addr
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> AddressAmount addr
AddressAmount Text
r (Quantity "lovelace" Natural
 -> ApiT TokenMap -> AddressAmount Text)
-> Either TextDecodingError (Quantity "lovelace" Natural)
-> Either TextDecodingError (ApiT TokenMap -> AddressAmount Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either TextDecodingError (Quantity "lovelace" Natural)
forall a. FromText a => Text -> Either TextDecodingError a
fromText Text
l Either TextDecodingError (ApiT TokenMap -> AddressAmount Text)
-> Either TextDecodingError (ApiT TokenMap)
-> Either TextDecodingError (AddressAmount Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ApiT TokenMap -> Either TextDecodingError (ApiT TokenMap)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApiT TokenMap
forall a. Monoid a => a
mempty
            [Text]
_ -> Either TextDecodingError (AddressAmount Text)
err

instance FromText AnyAddress where
    fromText :: Text -> Either TextDecodingError AnyAddress
fromText Text
txt = case String -> Maybe (AbstractEncoding ())
detectEncoding (Text -> String
T.unpack Text
txt) of
        Just EBech32{} -> do
            (HumanReadablePart
hrp, DataPart
dp) <- (DecodingError
 -> Either TextDecodingError (HumanReadablePart, DataPart))
-> ((HumanReadablePart, DataPart)
    -> Either TextDecodingError (HumanReadablePart, DataPart))
-> Either DecodingError (HumanReadablePart, DataPart)
-> Either TextDecodingError (HumanReadablePart, DataPart)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (Either TextDecodingError (HumanReadablePart, DataPart)
-> DecodingError
-> Either TextDecodingError (HumanReadablePart, DataPart)
forall a b. a -> b -> a
const (Either TextDecodingError (HumanReadablePart, DataPart)
 -> DecodingError
 -> Either TextDecodingError (HumanReadablePart, DataPart))
-> Either TextDecodingError (HumanReadablePart, DataPart)
-> DecodingError
-> Either TextDecodingError (HumanReadablePart, DataPart)
forall a b. (a -> b) -> a -> b
$ TextDecodingError
-> Either TextDecodingError (HumanReadablePart, DataPart)
forall a b. a -> Either a b
Left (TextDecodingError
 -> Either TextDecodingError (HumanReadablePart, DataPart))
-> TextDecodingError
-> Either TextDecodingError (HumanReadablePart, DataPart)
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError String
"AnyAddress's Bech32 has invalid text.")
                (HumanReadablePart, DataPart)
-> Either TextDecodingError (HumanReadablePart, DataPart)
forall a b. b -> Either a b
Right (Text -> Either DecodingError (HumanReadablePart, DataPart)
Bech32.decodeLenient Text
txt)
            let err1 :: TextDecodingError
err1 = String -> TextDecodingError
TextDecodingError String
"AnyAddress has invalid Bech32 datapart."
            let proceedWhenHrpCorrect :: AnyAddressType -> Int -> Either TextDecodingError AnyAddress
proceedWhenHrpCorrect AnyAddressType
ctr Int
net = do
                    ByteString
bytes <- TextDecodingError
-> Maybe ByteString -> Either TextDecodingError ByteString
forall a b. a -> Maybe b -> Either a b
maybeToRight TextDecodingError
err1 (DataPart -> Maybe ByteString
Bech32.dataPartToBytes DataPart
dp)
                    AnyAddress -> Either TextDecodingError AnyAddress
forall a b. b -> Either a b
Right (AnyAddress -> Either TextDecodingError AnyAddress)
-> AnyAddress -> Either TextDecodingError AnyAddress
forall a b. (a -> b) -> a -> b
$ ByteString -> AnyAddressType -> Int -> AnyAddress
AnyAddress ByteString
bytes AnyAddressType
ctr Int
net
            case HumanReadablePart -> Text
Bech32.humanReadablePartToText HumanReadablePart
hrp of
                Text
"addr" -> AnyAddressType -> Int -> Either TextDecodingError AnyAddress
proceedWhenHrpCorrect AnyAddressType
EnterpriseDelegating Int
1
                Text
"addr_test" -> AnyAddressType -> Int -> Either TextDecodingError AnyAddress
proceedWhenHrpCorrect AnyAddressType
EnterpriseDelegating Int
0
                Text
"stake" -> AnyAddressType -> Int -> Either TextDecodingError AnyAddress
proceedWhenHrpCorrect AnyAddressType
RewardAccount Int
1
                Text
"stake_test" -> AnyAddressType -> Int -> Either TextDecodingError AnyAddress
proceedWhenHrpCorrect AnyAddressType
RewardAccount Int
0
                Text
_ -> TextDecodingError -> Either TextDecodingError AnyAddress
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError AnyAddress)
-> TextDecodingError -> Either TextDecodingError AnyAddress
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError String
"AnyAddress is not correctly prefixed."
        Maybe (AbstractEncoding ())
_ -> TextDecodingError -> Either TextDecodingError AnyAddress
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError AnyAddress)
-> TextDecodingError -> Either TextDecodingError AnyAddress
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError String
"AnyAddress must be must be encoded as Bech32."

instance ToText (ApiT Cosigner) where
    toText :: ApiT Cosigner -> Text
toText (ApiT (Cosigner Word8
ix)) = Text
"cosigner#"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Word8 -> String
forall a. Show a => a -> String
show Word8
ix)

instance FromText (ApiT Cosigner) where
    fromText :: Text -> Either TextDecodingError (ApiT Cosigner)
fromText Text
txt = case Text -> Text -> [Text]
T.splitOn Text
"cosigner#" Text
txt of
        [Text
"",Text
numTxt] ->  case Reader Integer
forall a. Integral a => Reader a
T.decimal @Integer Text
numTxt of
            Right (Integer
num,Text
"") -> do
                Bool -> Either TextDecodingError () -> Either TextDecodingError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
num Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
num Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
255) (Either TextDecodingError () -> Either TextDecodingError ())
-> Either TextDecodingError () -> Either TextDecodingError ()
forall a b. (a -> b) -> a -> b
$
                        TextDecodingError -> Either TextDecodingError ()
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError ())
-> TextDecodingError -> Either TextDecodingError ()
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError String
"Cosigner number should be between '0' and '255'"
                ApiT Cosigner -> Either TextDecodingError (ApiT Cosigner)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiT Cosigner -> Either TextDecodingError (ApiT Cosigner))
-> ApiT Cosigner -> Either TextDecodingError (ApiT Cosigner)
forall a b. (a -> b) -> a -> b
$ Cosigner -> ApiT Cosigner
forall a. a -> ApiT a
ApiT (Cosigner -> ApiT Cosigner) -> Cosigner -> ApiT Cosigner
forall a b. (a -> b) -> a -> b
$ Word8 -> Cosigner
Cosigner (Word8 -> Cosigner) -> Word8 -> Cosigner
forall a b. (a -> b) -> a -> b
$ Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
num
            Either String (Integer, Text)
_ -> TextDecodingError -> Either TextDecodingError (ApiT Cosigner)
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError (ApiT Cosigner))
-> TextDecodingError -> Either TextDecodingError (ApiT Cosigner)
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError String
"Cosigner should be enumerated with number"
        [Text]
_ -> TextDecodingError -> Either TextDecodingError (ApiT Cosigner)
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError (ApiT Cosigner))
-> TextDecodingError -> Either TextDecodingError (ApiT Cosigner)
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError String
"Cosigner should be of form: cosigner#num"

{-------------------------------------------------------------------------------
                             HTTPApiData instances
-------------------------------------------------------------------------------}

instance MimeUnrender OctetStream (ApiBytesT base ByteString) where
    mimeUnrender :: Proxy OctetStream
-> ByteString -> Either String (ApiBytesT base ByteString)
mimeUnrender Proxy OctetStream
_ = ApiBytesT base ByteString
-> Either String (ApiBytesT base ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiBytesT base ByteString
 -> Either String (ApiBytesT base ByteString))
-> (ByteString -> ApiBytesT base ByteString)
-> ByteString
-> Either String (ApiBytesT base ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ApiBytesT base ByteString
forall (base :: Base) bs. bs -> ApiBytesT base bs
ApiBytesT (ByteString -> ApiBytesT base ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> ApiBytesT base ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

instance MimeRender OctetStream (ApiBytesT base ByteString) where
   mimeRender :: Proxy OctetStream -> ApiBytesT base ByteString -> ByteString
mimeRender Proxy OctetStream
_ = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (ApiBytesT base ByteString -> ByteString)
-> ApiBytesT base ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiBytesT base ByteString -> ByteString
forall (base :: Base) bs. ApiBytesT base bs -> bs
getApiBytesT

instance MimeUnrender OctetStream (ApiBytesT base SerialisedTx) where
    mimeUnrender :: Proxy OctetStream
-> ByteString -> Either String (ApiBytesT base SerialisedTx)
mimeUnrender Proxy OctetStream
_ = ApiBytesT base SerialisedTx
-> Either String (ApiBytesT base SerialisedTx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiBytesT base SerialisedTx
 -> Either String (ApiBytesT base SerialisedTx))
-> (ByteString -> ApiBytesT base SerialisedTx)
-> ByteString
-> Either String (ApiBytesT base SerialisedTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedTx -> ApiBytesT base SerialisedTx
forall (base :: Base) bs. bs -> ApiBytesT base bs
ApiBytesT (SerialisedTx -> ApiBytesT base SerialisedTx)
-> (ByteString -> SerialisedTx)
-> ByteString
-> ApiBytesT base SerialisedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SerialisedTx
SerialisedTx (ByteString -> SerialisedTx)
-> (ByteString -> ByteString) -> ByteString -> SerialisedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

instance MimeRender OctetStream (ApiBytesT base SerialisedTx) where
   mimeRender :: Proxy OctetStream -> ApiBytesT base SerialisedTx -> ByteString
mimeRender Proxy OctetStream
_ = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (ApiBytesT base SerialisedTx -> ByteString)
-> ApiBytesT base SerialisedTx
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> Const ByteString ByteString)
 -> SerialisedTx -> Const ByteString SerialisedTx)
-> SerialisedTx -> ByteString
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "payload"
  ((ByteString -> Const ByteString ByteString)
   -> SerialisedTx -> Const ByteString SerialisedTx)
(ByteString -> Const ByteString ByteString)
-> SerialisedTx -> Const ByteString SerialisedTx
#payload (SerialisedTx -> ByteString)
-> (ApiBytesT base SerialisedTx -> SerialisedTx)
-> ApiBytesT base SerialisedTx
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiBytesT base SerialisedTx -> SerialisedTx
forall (base :: Base) bs. ApiBytesT base bs -> bs
getApiBytesT

instance MimeUnrender OctetStream (ApiT SealedTx) where
    mimeUnrender :: Proxy OctetStream -> ByteString -> Either String (ApiT SealedTx)
mimeUnrender Proxy OctetStream
_ = (DecoderError -> String)
-> (SealedTx -> ApiT SealedTx)
-> Either DecoderError SealedTx
-> Either String (ApiT SealedTx)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap DecoderError -> String
forall a. Show a => a -> String
show SealedTx -> ApiT SealedTx
forall a. a -> ApiT a
ApiT (Either DecoderError SealedTx -> Either String (ApiT SealedTx))
-> (ByteString -> Either DecoderError SealedTx)
-> ByteString
-> Either String (ApiT SealedTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DecoderError SealedTx
sealedTxFromBytes (ByteString -> Either DecoderError SealedTx)
-> (ByteString -> ByteString)
-> ByteString
-> Either DecoderError SealedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

instance MimeRender OctetStream (ApiT SealedTx) where
   mimeRender :: Proxy OctetStream -> ApiT SealedTx -> ByteString
mimeRender Proxy OctetStream
_ = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (ApiT SealedTx -> ByteString) -> ApiT SealedTx -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> Const ByteString ByteString)
 -> SealedTx -> Const ByteString SealedTx)
-> SealedTx -> ByteString
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "serialisedTx"
  ((ByteString -> Const ByteString ByteString)
   -> SealedTx -> Const ByteString SealedTx)
(ByteString -> Const ByteString ByteString)
-> SealedTx -> Const ByteString SealedTx
#serialisedTx (SealedTx -> ByteString)
-> (ApiT SealedTx -> SealedTx) -> ApiT SealedTx -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT SealedTx -> SealedTx
forall a. ApiT a -> a
getApiT

instance FromText a => FromHttpApiData (ApiT a) where
    parseUrlPiece :: Text -> Either Text (ApiT a)
parseUrlPiece = (TextDecodingError -> Text)
-> (a -> ApiT a)
-> Either TextDecodingError a
-> Either Text (ApiT a)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextDecodingError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty a -> ApiT a
forall a. a -> ApiT a
ApiT (Either TextDecodingError a -> Either Text (ApiT a))
-> (Text -> Either TextDecodingError a)
-> Text
-> Either Text (ApiT a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError a
forall a. FromText a => Text -> Either TextDecodingError a
fromText
instance ToText a => ToHttpApiData (ApiT a) where
    toUrlPiece :: ApiT a -> Text
toUrlPiece = a -> Text
forall a. ToText a => a -> Text
toText (a -> Text) -> (ApiT a -> a) -> ApiT a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT a -> a
forall a. ApiT a -> a
getApiT

instance MimeRender OctetStream ApiSerialisedTransaction where
   mimeRender :: Proxy OctetStream -> ApiSerialisedTransaction -> ByteString
mimeRender Proxy OctetStream
ct = Proxy OctetStream -> ApiT SealedTx -> ByteString
forall k (ctype :: k) a.
MimeRender ctype a =>
Proxy ctype -> a -> ByteString
mimeRender Proxy OctetStream
ct (ApiT SealedTx -> ByteString)
-> (ApiSerialisedTransaction -> ApiT SealedTx)
-> ApiSerialisedTransaction
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ApiT SealedTx -> Const (ApiT SealedTx) (ApiT SealedTx))
 -> ApiSerialisedTransaction
 -> Const (ApiT SealedTx) ApiSerialisedTransaction)
-> ApiSerialisedTransaction -> ApiT SealedTx
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "transaction"
  ((ApiT SealedTx -> Const (ApiT SealedTx) (ApiT SealedTx))
   -> ApiSerialisedTransaction
   -> Const (ApiT SealedTx) ApiSerialisedTransaction)
(ApiT SealedTx -> Const (ApiT SealedTx) (ApiT SealedTx))
-> ApiSerialisedTransaction
-> Const (ApiT SealedTx) ApiSerialisedTransaction
#transaction

instance FromHttpApiData ApiTxId where
    parseUrlPiece :: Text -> Either Text ApiTxId
parseUrlPiece Text
txt = case Text -> Either TextDecodingError (Hash "Tx")
forall a. FromText a => Text -> Either TextDecodingError a
fromText Text
txt of
        Left (TextDecodingError String
err) -> Text -> Either Text ApiTxId
forall a b. a -> Either a b
Left (Text -> Either Text ApiTxId) -> Text -> Either Text ApiTxId
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err
        Right Hash "Tx"
tid -> ApiTxId -> Either Text ApiTxId
forall a b. b -> Either a b
Right (ApiTxId -> Either Text ApiTxId) -> ApiTxId -> Either Text ApiTxId
forall a b. (a -> b) -> a -> b
$ ApiT (Hash "Tx") -> ApiTxId
ApiTxId (ApiT (Hash "Tx") -> ApiTxId) -> ApiT (Hash "Tx") -> ApiTxId
forall a b. (a -> b) -> a -> b
$ Hash "Tx" -> ApiT (Hash "Tx")
forall a. a -> ApiT a
ApiT Hash "Tx"
tid

instance ToHttpApiData ApiTxId where
    toUrlPiece :: ApiTxId -> Text
toUrlPiece (ApiTxId (ApiT Hash "Tx"
tid)) = Hash "Tx" -> Text
forall a. ToText a => a -> Text
toText Hash "Tx"
tid

instance FromHttpApiData ApiPoolId where
    parseUrlPiece :: Text -> Either Text ApiPoolId
parseUrlPiece Text
t
        | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*" =
            ApiPoolId -> Either Text ApiPoolId
forall a b. b -> Either a b
Right ApiPoolId
ApiPoolIdPlaceholder
        | Bool
otherwise =
            PoolId -> ApiPoolId
ApiPoolId (PoolId -> ApiPoolId)
-> Either Text PoolId -> Either Text ApiPoolId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Text -> Either TextDecodingError PoolId
forall a. FromText a => Text -> Either TextDecodingError a
fromText Text
t of
                Left TextDecodingError
_ ->
                    (TextDecodingError -> Text)
-> Either TextDecodingError PoolId -> Either Text PoolId
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (String -> Text
T.pack (String -> Text)
-> (TextDecodingError -> String) -> TextDecodingError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowFmt TextDecodingError -> String
forall a. Show a => a -> String
show (ShowFmt TextDecodingError -> String)
-> (TextDecodingError -> ShowFmt TextDecodingError)
-> TextDecodingError
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt) (Either TextDecodingError PoolId -> Either Text PoolId)
-> Either TextDecodingError PoolId -> Either Text PoolId
forall a b. (a -> b) -> a -> b
$ Text -> Either TextDecodingError PoolId
decodePoolIdBech32 Text
t
                Right PoolId
r ->
                    PoolId -> Either Text PoolId
forall a b. b -> Either a b
Right PoolId
r

instance ToHttpApiData ApiPoolId where
    toUrlPiece :: ApiPoolId -> Text
toUrlPiece = \case
        ApiPoolId
ApiPoolIdPlaceholder -> Text
"*"
        ApiPoolId PoolId
pid -> PoolId -> Text
encodePoolIdBech32 PoolId
pid

instance FromHttpApiData ApiAddressInspectData where
    parseUrlPiece :: Text -> Either Text ApiAddressInspectData
parseUrlPiece = ApiAddressInspectData -> Either Text ApiAddressInspectData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiAddressInspectData -> Either Text ApiAddressInspectData)
-> (Text -> ApiAddressInspectData)
-> Text
-> Either Text ApiAddressInspectData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ApiAddressInspectData
ApiAddressInspectData

instance ToHttpApiData ApiAddressInspectData where
    toUrlPiece :: ApiAddressInspectData -> Text
toUrlPiece = ApiAddressInspectData -> Text
unApiAddressInspectData

{-------------------------------------------------------------------------------
                                Aeson Options
-------------------------------------------------------------------------------}

data TaggedObjectOptions = TaggedObjectOptions
    { TaggedObjectOptions -> String
_tagFieldName :: String
    , TaggedObjectOptions -> String
_contentsFieldName :: String
    }

defaultSumTypeOptions :: Aeson.Options
defaultSumTypeOptions :: Options
defaultSumTypeOptions = Options
Aeson.defaultOptions
    { constructorTagModifier :: ShowS
constructorTagModifier = Char -> ShowS
camelTo2 Char
'_'
    , tagSingleConstructors :: Bool
tagSingleConstructors = Bool
True
    }

defaultRecordTypeOptions :: Aeson.Options
defaultRecordTypeOptions :: Options
defaultRecordTypeOptions = Options
Aeson.defaultOptions
    { fieldLabelModifier :: ShowS
fieldLabelModifier = Char -> ShowS
camelTo2 Char
'_' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
    , omitNothingFields :: Bool
omitNothingFields = Bool
True
    }

strictRecordTypeOptions :: Aeson.Options
strictRecordTypeOptions :: Options
strictRecordTypeOptions = Options
defaultRecordTypeOptions
    { rejectUnknownFields :: Bool
rejectUnknownFields = Bool
True
    }

taggedSumTypeOptions :: Aeson.Options -> TaggedObjectOptions -> Aeson.Options
taggedSumTypeOptions :: Options -> TaggedObjectOptions -> Options
taggedSumTypeOptions Options
base TaggedObjectOptions
opts = Options
base
    { sumEncoding :: SumEncoding
sumEncoding = String -> String -> SumEncoding
TaggedObject (TaggedObjectOptions -> String
_tagFieldName TaggedObjectOptions
opts) (TaggedObjectOptions -> String
_contentsFieldName TaggedObjectOptions
opts)
    }

explicitNothingRecordTypeOptions :: Aeson.Options
explicitNothingRecordTypeOptions :: Options
explicitNothingRecordTypeOptions = Options
defaultRecordTypeOptions
    { omitNothingFields :: Bool
omitNothingFields = Bool
False
    }

{-------------------------------------------------------------------------------
                                   Helpers
-------------------------------------------------------------------------------}

eitherToParser :: Show s => Either s a -> Aeson.Parser a
eitherToParser :: Either s a -> Parser a
eitherToParser = (s -> Parser a) -> (a -> Parser a) -> Either s a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> (s -> String) -> s -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Show a => a -> String
show) a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

hexText :: ByteString -> Text
hexText :: ByteString -> Text
hexText = ByteString -> Text
T.decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
hex

fromHexText :: Text -> Either String ByteString
fromHexText :: Text -> Either String ByteString
fromHexText = ByteString -> Either String ByteString
forall bout. ByteArray bout => ByteString -> Either String bout
fromHex (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

toTextJSON :: ToText a => ApiT a -> Value
toTextJSON :: ApiT a -> Value
toTextJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (ApiT a -> Text) -> ApiT a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToText a => a -> Text
toText (a -> Text) -> (ApiT a -> a) -> ApiT a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT a -> a
forall a. ApiT a -> a
getApiT

fromTextJSON :: FromText a => String -> Value -> Aeson.Parser (ApiT a)
fromTextJSON :: String -> Value -> Parser (ApiT a)
fromTextJSON String
n = String -> (Text -> Parser (ApiT a)) -> Value -> Parser (ApiT a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
n (Either (ShowFmt TextDecodingError) (ApiT a) -> Parser (ApiT a)
forall s a. Show s => Either s a -> Parser a
eitherToParser (Either (ShowFmt TextDecodingError) (ApiT a) -> Parser (ApiT a))
-> (Text -> Either (ShowFmt TextDecodingError) (ApiT a))
-> Text
-> Parser (ApiT a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDecodingError -> ShowFmt TextDecodingError)
-> (a -> ApiT a)
-> Either TextDecodingError a
-> Either (ShowFmt TextDecodingError) (ApiT a)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextDecodingError -> ShowFmt TextDecodingError
forall a. a -> ShowFmt a
ShowFmt a -> ApiT a
forall a. a -> ApiT a
ApiT (Either TextDecodingError a
 -> Either (ShowFmt TextDecodingError) (ApiT a))
-> (Text -> Either TextDecodingError a)
-> Text
-> Either (ShowFmt TextDecodingError) (ApiT a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError a
forall a. FromText a => Text -> Either TextDecodingError a
fromText)

{-------------------------------------------------------------------------------
                          User-Facing Address Encoding
-------------------------------------------------------------------------------}

-- | An abstract class to allow encoding of addresses depending on the target
-- backend used.
class EncodeAddress (n :: NetworkDiscriminant) where
    encodeAddress :: Address -> Text

instance EncodeAddress 'Mainnet => EncodeAddress ('Staging pm) where
    encodeAddress :: Address -> Text
encodeAddress = EncodeAddress 'Mainnet => Address -> Text
forall (n :: NetworkDiscriminant).
EncodeAddress n =>
Address -> Text
encodeAddress @'Mainnet

-- | An abstract class to allow decoding of addresses depending on the target
-- backend used.
class DecodeAddress (n :: NetworkDiscriminant) where
    decodeAddress :: Text -> Either TextDecodingError Address

instance DecodeAddress 'Mainnet => DecodeAddress ('Staging pm) where
    decodeAddress :: Text -> Either TextDecodingError Address
decodeAddress = DecodeAddress 'Mainnet => Text -> Either TextDecodingError Address
forall (n :: NetworkDiscriminant).
DecodeAddress n =>
Text -> Either TextDecodingError Address
decodeAddress @'Mainnet

class EncodeStakeAddress (n :: NetworkDiscriminant) where
    encodeStakeAddress :: W.RewardAccount -> Text

instance EncodeStakeAddress 'Mainnet => EncodeStakeAddress ('Staging pm) where
    encodeStakeAddress :: RewardAccount -> Text
encodeStakeAddress = EncodeStakeAddress 'Mainnet => RewardAccount -> Text
forall (n :: NetworkDiscriminant).
EncodeStakeAddress n =>
RewardAccount -> Text
encodeStakeAddress @'Mainnet

class DecodeStakeAddress (n :: NetworkDiscriminant) where
    decodeStakeAddress :: Text -> Either TextDecodingError W.RewardAccount

instance DecodeStakeAddress 'Mainnet => DecodeStakeAddress ('Staging pm) where
    decodeStakeAddress :: Text -> Either TextDecodingError RewardAccount
decodeStakeAddress = DecodeStakeAddress 'Mainnet =>
Text -> Either TextDecodingError RewardAccount
forall (n :: NetworkDiscriminant).
DecodeStakeAddress n =>
Text -> Either TextDecodingError RewardAccount
decodeStakeAddress @'Mainnet

-- NOTE:
-- The type families below are useful to allow building more flexible API
-- implementation from the definition above. In particular, the API client we
-- use for the command-line doesn't really _care much_ about how addresses are
-- serialized / deserialized. So, we use a poly-kinded type family here to allow
-- defining custom types in the API client with a minimal overhead and, without
-- having to actually rewrite any of the API definition.
--
-- We use an open type family so it can be extended by other module in places.
type family ApiAddressT (n :: k) :: Type
type family ApiStakeKeysT (n :: k) :: Type
type family ApiAddressIdT (n :: k) :: Type
type family ApiCoinSelectionT (n :: k) :: Type
type family ApiSelectCoinsDataT (n :: k) :: Type
type family ApiTransactionT (n :: k) :: Type
type family ApiConstructTransactionT (n :: k) :: Type
type family ApiConstructTransactionDataT (n :: k) :: Type
type family PostTransactionOldDataT (n :: k) :: Type
type family PostTransactionFeeOldDataT (n :: k) :: Type
type family ApiWalletMigrationPlanPostDataT (n :: k) :: Type
type family ApiWalletMigrationPostDataT (n :: k1) (s :: k2) :: Type
type family ApiPutAddressesDataT (n :: k) :: Type
type family ApiBalanceTransactionPostDataT (n :: k) :: Type
type family ApiDecodedTransactionT (n :: k) :: Type

type instance ApiAddressT (n :: NetworkDiscriminant) =
    ApiAddress n

type instance ApiStakeKeysT (n :: NetworkDiscriminant) =
    ApiStakeKeys n

type instance ApiPutAddressesDataT (n :: NetworkDiscriminant) =
    ApiPutAddressesData n

type instance ApiAddressIdT (n :: NetworkDiscriminant) =
    (ApiT Address, Proxy n)

type instance ApiCoinSelectionT (n :: NetworkDiscriminant) =
    ApiCoinSelection n

type instance ApiSelectCoinsDataT (n :: NetworkDiscriminant) =
    ApiSelectCoinsData n

type instance ApiTransactionT (n :: NetworkDiscriminant) =
    ApiTransaction n

type instance ApiConstructTransactionT (n :: NetworkDiscriminant) =
    ApiConstructTransaction n

type instance ApiConstructTransactionDataT (n :: NetworkDiscriminant) =
    ApiConstructTransactionData n

type instance PostTransactionOldDataT (n :: NetworkDiscriminant) =
    PostTransactionOldData n
type instance PostTransactionFeeOldDataT (n :: NetworkDiscriminant) =
    PostTransactionFeeOldData n

type instance ApiWalletMigrationPlanPostDataT (n :: NetworkDiscriminant) =
    ApiWalletMigrationPlanPostData n

type instance ApiWalletMigrationPostDataT (n :: NetworkDiscriminant) (s :: Symbol) =
    ApiWalletMigrationPostData n s

type instance ApiBalanceTransactionPostDataT (n :: NetworkDiscriminant) =
    ApiBalanceTransactionPostData n

type instance ApiDecodedTransactionT (n :: NetworkDiscriminant) =
    ApiDecodedTransaction n

{-------------------------------------------------------------------------------
                         SMASH interfacing types
-------------------------------------------------------------------------------}

-- | Parses the SMASH HealthCheck type from the SMASH API.
data HealthStatusSMASH = HealthStatusSMASH
    { HealthStatusSMASH -> Text
status :: Text
    , HealthStatusSMASH -> Text
version :: Text
    } deriving ((forall x. HealthStatusSMASH -> Rep HealthStatusSMASH x)
-> (forall x. Rep HealthStatusSMASH x -> HealthStatusSMASH)
-> Generic HealthStatusSMASH
forall x. Rep HealthStatusSMASH x -> HealthStatusSMASH
forall x. HealthStatusSMASH -> Rep HealthStatusSMASH x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HealthStatusSMASH x -> HealthStatusSMASH
$cfrom :: forall x. HealthStatusSMASH -> Rep HealthStatusSMASH x
Generic, Int -> HealthStatusSMASH -> ShowS
[HealthStatusSMASH] -> ShowS
HealthStatusSMASH -> String
(Int -> HealthStatusSMASH -> ShowS)
-> (HealthStatusSMASH -> String)
-> ([HealthStatusSMASH] -> ShowS)
-> Show HealthStatusSMASH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HealthStatusSMASH] -> ShowS
$cshowList :: [HealthStatusSMASH] -> ShowS
show :: HealthStatusSMASH -> String
$cshow :: HealthStatusSMASH -> String
showsPrec :: Int -> HealthStatusSMASH -> ShowS
$cshowsPrec :: Int -> HealthStatusSMASH -> ShowS
Show, HealthStatusSMASH -> HealthStatusSMASH -> Bool
(HealthStatusSMASH -> HealthStatusSMASH -> Bool)
-> (HealthStatusSMASH -> HealthStatusSMASH -> Bool)
-> Eq HealthStatusSMASH
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
$c/= :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
== :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
$c== :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
Eq, Eq HealthStatusSMASH
Eq HealthStatusSMASH
-> (HealthStatusSMASH -> HealthStatusSMASH -> Ordering)
-> (HealthStatusSMASH -> HealthStatusSMASH -> Bool)
-> (HealthStatusSMASH -> HealthStatusSMASH -> Bool)
-> (HealthStatusSMASH -> HealthStatusSMASH -> Bool)
-> (HealthStatusSMASH -> HealthStatusSMASH -> Bool)
-> (HealthStatusSMASH -> HealthStatusSMASH -> HealthStatusSMASH)
-> (HealthStatusSMASH -> HealthStatusSMASH -> HealthStatusSMASH)
-> Ord HealthStatusSMASH
HealthStatusSMASH -> HealthStatusSMASH -> Bool
HealthStatusSMASH -> HealthStatusSMASH -> Ordering
HealthStatusSMASH -> HealthStatusSMASH -> HealthStatusSMASH
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HealthStatusSMASH -> HealthStatusSMASH -> HealthStatusSMASH
$cmin :: HealthStatusSMASH -> HealthStatusSMASH -> HealthStatusSMASH
max :: HealthStatusSMASH -> HealthStatusSMASH -> HealthStatusSMASH
$cmax :: HealthStatusSMASH -> HealthStatusSMASH -> HealthStatusSMASH
>= :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
$c>= :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
> :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
$c> :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
<= :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
$c<= :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
< :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
$c< :: HealthStatusSMASH -> HealthStatusSMASH -> Bool
compare :: HealthStatusSMASH -> HealthStatusSMASH -> Ordering
$ccompare :: HealthStatusSMASH -> HealthStatusSMASH -> Ordering
$cp1Ord :: Eq HealthStatusSMASH
Ord)

instance FromJSON HealthStatusSMASH where
    parseJSON :: Value -> Parser HealthStatusSMASH
parseJSON = Options -> Value -> Parser HealthStatusSMASH
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON HealthStatusSMASH where
    toJSON :: HealthStatusSMASH -> Value
toJSON = Options -> HealthStatusSMASH -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

-- | Dscribes the health status of the SMASH server.
data HealthCheckSMASH =
      Available          -- server available
    | Unavailable        -- server reachable, but unavailable
    | Unreachable        -- could not get a response from the SMASH server
    | NoSmashConfigured  -- no SMASH server has been configured
    deriving ((forall x. HealthCheckSMASH -> Rep HealthCheckSMASH x)
-> (forall x. Rep HealthCheckSMASH x -> HealthCheckSMASH)
-> Generic HealthCheckSMASH
forall x. Rep HealthCheckSMASH x -> HealthCheckSMASH
forall x. HealthCheckSMASH -> Rep HealthCheckSMASH x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HealthCheckSMASH x -> HealthCheckSMASH
$cfrom :: forall x. HealthCheckSMASH -> Rep HealthCheckSMASH x
Generic, Int -> HealthCheckSMASH -> ShowS
[HealthCheckSMASH] -> ShowS
HealthCheckSMASH -> String
(Int -> HealthCheckSMASH -> ShowS)
-> (HealthCheckSMASH -> String)
-> ([HealthCheckSMASH] -> ShowS)
-> Show HealthCheckSMASH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HealthCheckSMASH] -> ShowS
$cshowList :: [HealthCheckSMASH] -> ShowS
show :: HealthCheckSMASH -> String
$cshow :: HealthCheckSMASH -> String
showsPrec :: Int -> HealthCheckSMASH -> ShowS
$cshowsPrec :: Int -> HealthCheckSMASH -> ShowS
Show, HealthCheckSMASH -> HealthCheckSMASH -> Bool
(HealthCheckSMASH -> HealthCheckSMASH -> Bool)
-> (HealthCheckSMASH -> HealthCheckSMASH -> Bool)
-> Eq HealthCheckSMASH
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
$c/= :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
== :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
$c== :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
Eq, Eq HealthCheckSMASH
Eq HealthCheckSMASH
-> (HealthCheckSMASH -> HealthCheckSMASH -> Ordering)
-> (HealthCheckSMASH -> HealthCheckSMASH -> Bool)
-> (HealthCheckSMASH -> HealthCheckSMASH -> Bool)
-> (HealthCheckSMASH -> HealthCheckSMASH -> Bool)
-> (HealthCheckSMASH -> HealthCheckSMASH -> Bool)
-> (HealthCheckSMASH -> HealthCheckSMASH -> HealthCheckSMASH)
-> (HealthCheckSMASH -> HealthCheckSMASH -> HealthCheckSMASH)
-> Ord HealthCheckSMASH
HealthCheckSMASH -> HealthCheckSMASH -> Bool
HealthCheckSMASH -> HealthCheckSMASH -> Ordering
HealthCheckSMASH -> HealthCheckSMASH -> HealthCheckSMASH
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HealthCheckSMASH -> HealthCheckSMASH -> HealthCheckSMASH
$cmin :: HealthCheckSMASH -> HealthCheckSMASH -> HealthCheckSMASH
max :: HealthCheckSMASH -> HealthCheckSMASH -> HealthCheckSMASH
$cmax :: HealthCheckSMASH -> HealthCheckSMASH -> HealthCheckSMASH
>= :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
$c>= :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
> :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
$c> :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
<= :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
$c<= :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
< :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
$c< :: HealthCheckSMASH -> HealthCheckSMASH -> Bool
compare :: HealthCheckSMASH -> HealthCheckSMASH -> Ordering
$ccompare :: HealthCheckSMASH -> HealthCheckSMASH -> Ordering
$cp1Ord :: Eq HealthCheckSMASH
Ord)

newtype ApiHealthCheck = ApiHealthCheck
    { ApiHealthCheck -> HealthCheckSMASH
health :: HealthCheckSMASH }
    deriving ((forall x. ApiHealthCheck -> Rep ApiHealthCheck x)
-> (forall x. Rep ApiHealthCheck x -> ApiHealthCheck)
-> Generic ApiHealthCheck
forall x. Rep ApiHealthCheck x -> ApiHealthCheck
forall x. ApiHealthCheck -> Rep ApiHealthCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiHealthCheck x -> ApiHealthCheck
$cfrom :: forall x. ApiHealthCheck -> Rep ApiHealthCheck x
Generic, ApiHealthCheck -> ApiHealthCheck -> Bool
(ApiHealthCheck -> ApiHealthCheck -> Bool)
-> (ApiHealthCheck -> ApiHealthCheck -> Bool) -> Eq ApiHealthCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiHealthCheck -> ApiHealthCheck -> Bool
$c/= :: ApiHealthCheck -> ApiHealthCheck -> Bool
== :: ApiHealthCheck -> ApiHealthCheck -> Bool
$c== :: ApiHealthCheck -> ApiHealthCheck -> Bool
Eq, Eq ApiHealthCheck
Eq ApiHealthCheck
-> (ApiHealthCheck -> ApiHealthCheck -> Ordering)
-> (ApiHealthCheck -> ApiHealthCheck -> Bool)
-> (ApiHealthCheck -> ApiHealthCheck -> Bool)
-> (ApiHealthCheck -> ApiHealthCheck -> Bool)
-> (ApiHealthCheck -> ApiHealthCheck -> Bool)
-> (ApiHealthCheck -> ApiHealthCheck -> ApiHealthCheck)
-> (ApiHealthCheck -> ApiHealthCheck -> ApiHealthCheck)
-> Ord ApiHealthCheck
ApiHealthCheck -> ApiHealthCheck -> Bool
ApiHealthCheck -> ApiHealthCheck -> Ordering
ApiHealthCheck -> ApiHealthCheck -> ApiHealthCheck
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ApiHealthCheck -> ApiHealthCheck -> ApiHealthCheck
$cmin :: ApiHealthCheck -> ApiHealthCheck -> ApiHealthCheck
max :: ApiHealthCheck -> ApiHealthCheck -> ApiHealthCheck
$cmax :: ApiHealthCheck -> ApiHealthCheck -> ApiHealthCheck
>= :: ApiHealthCheck -> ApiHealthCheck -> Bool
$c>= :: ApiHealthCheck -> ApiHealthCheck -> Bool
> :: ApiHealthCheck -> ApiHealthCheck -> Bool
$c> :: ApiHealthCheck -> ApiHealthCheck -> Bool
<= :: ApiHealthCheck -> ApiHealthCheck -> Bool
$c<= :: ApiHealthCheck -> ApiHealthCheck -> Bool
< :: ApiHealthCheck -> ApiHealthCheck -> Bool
$c< :: ApiHealthCheck -> ApiHealthCheck -> Bool
compare :: ApiHealthCheck -> ApiHealthCheck -> Ordering
$ccompare :: ApiHealthCheck -> ApiHealthCheck -> Ordering
$cp1Ord :: Eq ApiHealthCheck
Ord)
    deriving Int -> ApiHealthCheck -> ShowS
[ApiHealthCheck] -> ShowS
ApiHealthCheck -> String
(Int -> ApiHealthCheck -> ShowS)
-> (ApiHealthCheck -> String)
-> ([ApiHealthCheck] -> ShowS)
-> Show ApiHealthCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiHealthCheck] -> ShowS
$cshowList :: [ApiHealthCheck] -> ShowS
show :: ApiHealthCheck -> String
$cshow :: ApiHealthCheck -> String
showsPrec :: Int -> ApiHealthCheck -> ShowS
$cshowsPrec :: Int -> ApiHealthCheck -> ShowS
Show via (Quiet ApiHealthCheck)

instance FromJSON HealthCheckSMASH where
    parseJSON :: Value -> Parser HealthCheckSMASH
parseJSON = Options -> Value -> Parser HealthCheckSMASH
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultSumTypeOptions
        { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue }
instance ToJSON HealthCheckSMASH where
    toJSON :: HealthCheckSMASH -> Value
toJSON = Options -> HealthCheckSMASH -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultSumTypeOptions

instance FromJSON ApiHealthCheck where
    parseJSON :: Value -> Parser ApiHealthCheck
parseJSON = Options -> Value -> Parser ApiHealthCheck
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions
instance ToJSON ApiHealthCheck where
    toJSON :: ApiHealthCheck -> Value
toJSON = Options -> ApiHealthCheck -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

instance FromJSON (ApiT SmashServer) where
    parseJSON :: Value -> Parser (ApiT SmashServer)
parseJSON = String -> Value -> Parser (ApiT SmashServer)
forall a. FromText a => String -> Value -> Parser (ApiT a)
fromTextJSON String
"SmashServer"
instance ToJSON (ApiT SmashServer) where
    toJSON :: ApiT SmashServer -> Value
toJSON = ApiT SmashServer -> Value
forall a. ToText a => ApiT a -> Value
toTextJSON

{-------------------------------------------------------------------------------
                         Token minting types
-------------------------------------------------------------------------------}

-- | Core minting and burning request information.
--
-- Assets are minted and burned under a "policy". The policy defines under what
-- circumstances a token may be minted and burned. The policy is the hash of a
-- serialized script that contains verification keys and timelocks combined in
-- conditions, possibly nested, to accommodate non-trivial time conditions.
-- In the non-multisig case the script regulating minting/burning will
-- contain a verification key via cosigner#0 of the wallet with optional
-- time predicates.
-- In the multisig case the script regulating minting/burning will contain
-- verification keys of signers (via cosigner#N) with optional time predicates.
-- The used key derivation index is the same for all engaged derivation keys and
-- ix=0 is assumed to be used. The verification key derivation is performed
-- according to CIP 1855.
data ApiMintBurnData (n :: NetworkDiscriminant) = ApiMintBurnData
    { ApiMintBurnData n -> ApiT (Script Cosigner)
policyScriptTemplate
        :: !(ApiT (Script Cosigner))
        -- ^ A script regulating minting/burning policy. 'self' is expected
        -- in place of verification key.
    , ApiMintBurnData n -> Maybe (ApiT TokenName)
assetName
        :: !(Maybe (ApiT W.TokenName))
        -- ^ The name of the asset to mint/burn.
    , ApiMintBurnData n -> ApiMintBurnOperation n
operation
        :: !(ApiMintBurnOperation n)
        -- ^ The minting or burning operation to perform.
    }
    deriving (ApiMintBurnData n -> ApiMintBurnData n -> Bool
(ApiMintBurnData n -> ApiMintBurnData n -> Bool)
-> (ApiMintBurnData n -> ApiMintBurnData n -> Bool)
-> Eq (ApiMintBurnData n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiMintBurnData n -> ApiMintBurnData n -> Bool
/= :: ApiMintBurnData n -> ApiMintBurnData n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiMintBurnData n -> ApiMintBurnData n -> Bool
== :: ApiMintBurnData n -> ApiMintBurnData n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiMintBurnData n -> ApiMintBurnData n -> Bool
Eq, (forall x. ApiMintBurnData n -> Rep (ApiMintBurnData n) x)
-> (forall x. Rep (ApiMintBurnData n) x -> ApiMintBurnData n)
-> Generic (ApiMintBurnData n)
forall x. Rep (ApiMintBurnData n) x -> ApiMintBurnData n
forall x. ApiMintBurnData n -> Rep (ApiMintBurnData n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiMintBurnData n) x -> ApiMintBurnData n
forall (n :: NetworkDiscriminant) x.
ApiMintBurnData n -> Rep (ApiMintBurnData n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiMintBurnData n) x -> ApiMintBurnData n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiMintBurnData n -> Rep (ApiMintBurnData n) x
Generic, Int -> ApiMintBurnData n -> ShowS
[ApiMintBurnData n] -> ShowS
ApiMintBurnData n -> String
(Int -> ApiMintBurnData n -> ShowS)
-> (ApiMintBurnData n -> String)
-> ([ApiMintBurnData n] -> ShowS)
-> Show (ApiMintBurnData n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiMintBurnData n -> ShowS
forall (n :: NetworkDiscriminant). [ApiMintBurnData n] -> ShowS
forall (n :: NetworkDiscriminant). ApiMintBurnData n -> String
showList :: [ApiMintBurnData n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiMintBurnData n] -> ShowS
show :: ApiMintBurnData n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiMintBurnData n -> String
showsPrec :: Int -> ApiMintBurnData n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiMintBurnData n -> ShowS
Show)
    deriving anyclass ApiMintBurnData n -> ()
(ApiMintBurnData n -> ()) -> NFData (ApiMintBurnData n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiMintBurnData n -> ()
rnf :: ApiMintBurnData n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiMintBurnData n -> ()
NFData

instance DecodeAddress n => FromJSON (ApiMintBurnData n) where
    parseJSON :: Value -> Parser (ApiMintBurnData n)
parseJSON = Options -> Value -> Parser (ApiMintBurnData n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions

instance EncodeAddress n => ToJSON (ApiMintBurnData n) where
    toJSON :: ApiMintBurnData n -> Value
toJSON = Options -> ApiMintBurnData n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

-- | A user may choose to either mint tokens or burn tokens with each operation.
data ApiMintBurnOperation (n :: NetworkDiscriminant)
    = ApiMint (ApiMintData n)
    -- ^ Mint tokens.
    | ApiBurn ApiBurnData
    -- ^ Burn tokens.
    deriving (ApiMintBurnOperation n -> ApiMintBurnOperation n -> Bool
(ApiMintBurnOperation n -> ApiMintBurnOperation n -> Bool)
-> (ApiMintBurnOperation n -> ApiMintBurnOperation n -> Bool)
-> Eq (ApiMintBurnOperation n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiMintBurnOperation n -> ApiMintBurnOperation n -> Bool
/= :: ApiMintBurnOperation n -> ApiMintBurnOperation n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiMintBurnOperation n -> ApiMintBurnOperation n -> Bool
== :: ApiMintBurnOperation n -> ApiMintBurnOperation n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiMintBurnOperation n -> ApiMintBurnOperation n -> Bool
Eq, (forall x.
 ApiMintBurnOperation n -> Rep (ApiMintBurnOperation n) x)
-> (forall x.
    Rep (ApiMintBurnOperation n) x -> ApiMintBurnOperation n)
-> Generic (ApiMintBurnOperation n)
forall x. Rep (ApiMintBurnOperation n) x -> ApiMintBurnOperation n
forall x. ApiMintBurnOperation n -> Rep (ApiMintBurnOperation n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiMintBurnOperation n) x -> ApiMintBurnOperation n
forall (n :: NetworkDiscriminant) x.
ApiMintBurnOperation n -> Rep (ApiMintBurnOperation n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiMintBurnOperation n) x -> ApiMintBurnOperation n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiMintBurnOperation n -> Rep (ApiMintBurnOperation n) x
Generic, Int -> ApiMintBurnOperation n -> ShowS
[ApiMintBurnOperation n] -> ShowS
ApiMintBurnOperation n -> String
(Int -> ApiMintBurnOperation n -> ShowS)
-> (ApiMintBurnOperation n -> String)
-> ([ApiMintBurnOperation n] -> ShowS)
-> Show (ApiMintBurnOperation n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant).
Int -> ApiMintBurnOperation n -> ShowS
forall (n :: NetworkDiscriminant).
[ApiMintBurnOperation n] -> ShowS
forall (n :: NetworkDiscriminant). ApiMintBurnOperation n -> String
showList :: [ApiMintBurnOperation n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant).
[ApiMintBurnOperation n] -> ShowS
show :: ApiMintBurnOperation n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiMintBurnOperation n -> String
showsPrec :: Int -> ApiMintBurnOperation n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant).
Int -> ApiMintBurnOperation n -> ShowS
Show)
    deriving anyclass ApiMintBurnOperation n -> ()
(ApiMintBurnOperation n -> ()) -> NFData (ApiMintBurnOperation n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiMintBurnOperation n -> ()
rnf :: ApiMintBurnOperation n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiMintBurnOperation n -> ()
NFData

-- | The format of a minting request: mint "amount" and send it to the
-- "address".
data ApiMintData (n :: NetworkDiscriminant) = ApiMintData
    { ApiMintData n -> Maybe (ApiT Address, Proxy n)
receivingAddress
        :: Maybe (ApiT Address, Proxy n)
        -- ^ An optional address to which minted assets should be paid.
        --
        -- If no address is specified, then minted assets will be returned to
        -- the wallet as change, and change output addresses will be assigned
        -- automatically.
    , ApiMintData n -> Natural
quantity
        :: Natural
        -- ^ Amount of assets to mint.
    }
    deriving (ApiMintData n -> ApiMintData n -> Bool
(ApiMintData n -> ApiMintData n -> Bool)
-> (ApiMintData n -> ApiMintData n -> Bool) -> Eq (ApiMintData n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: NetworkDiscriminant).
ApiMintData n -> ApiMintData n -> Bool
/= :: ApiMintData n -> ApiMintData n -> Bool
$c/= :: forall (n :: NetworkDiscriminant).
ApiMintData n -> ApiMintData n -> Bool
== :: ApiMintData n -> ApiMintData n -> Bool
$c== :: forall (n :: NetworkDiscriminant).
ApiMintData n -> ApiMintData n -> Bool
Eq, (forall x. ApiMintData n -> Rep (ApiMintData n) x)
-> (forall x. Rep (ApiMintData n) x -> ApiMintData n)
-> Generic (ApiMintData n)
forall x. Rep (ApiMintData n) x -> ApiMintData n
forall x. ApiMintData n -> Rep (ApiMintData n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) x.
Rep (ApiMintData n) x -> ApiMintData n
forall (n :: NetworkDiscriminant) x.
ApiMintData n -> Rep (ApiMintData n) x
$cto :: forall (n :: NetworkDiscriminant) x.
Rep (ApiMintData n) x -> ApiMintData n
$cfrom :: forall (n :: NetworkDiscriminant) x.
ApiMintData n -> Rep (ApiMintData n) x
Generic, Int -> ApiMintData n -> ShowS
[ApiMintData n] -> ShowS
ApiMintData n -> String
(Int -> ApiMintData n -> ShowS)
-> (ApiMintData n -> String)
-> ([ApiMintData n] -> ShowS)
-> Show (ApiMintData n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: NetworkDiscriminant). Int -> ApiMintData n -> ShowS
forall (n :: NetworkDiscriminant). [ApiMintData n] -> ShowS
forall (n :: NetworkDiscriminant). ApiMintData n -> String
showList :: [ApiMintData n] -> ShowS
$cshowList :: forall (n :: NetworkDiscriminant). [ApiMintData n] -> ShowS
show :: ApiMintData n -> String
$cshow :: forall (n :: NetworkDiscriminant). ApiMintData n -> String
showsPrec :: Int -> ApiMintData n -> ShowS
$cshowsPrec :: forall (n :: NetworkDiscriminant). Int -> ApiMintData n -> ShowS
Show)
    deriving anyclass ApiMintData n -> ()
(ApiMintData n -> ()) -> NFData (ApiMintData n)
forall a. (a -> ()) -> NFData a
forall (n :: NetworkDiscriminant). ApiMintData n -> ()
rnf :: ApiMintData n -> ()
$crnf :: forall (n :: NetworkDiscriminant). ApiMintData n -> ()
NFData

instance DecodeAddress n => FromJSON (ApiMintData n) where
    parseJSON :: Value -> Parser (ApiMintData n)
parseJSON = Options -> Value -> Parser (ApiMintData n)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions

instance EncodeAddress n => ToJSON (ApiMintData n) where
    toJSON :: ApiMintData n -> Value
toJSON = Options -> ApiMintData n -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions

-- | The format of a burn request: burn "amount". The user can only specify the
-- type of tokens to burn (policyId, assetName), and the amount, the exact
-- tokens selected are up to the implementation.
newtype ApiBurnData = ApiBurnData
    { ApiBurnData -> Natural
quantity :: Natural
    }
    deriving (ApiBurnData -> ApiBurnData -> Bool
(ApiBurnData -> ApiBurnData -> Bool)
-> (ApiBurnData -> ApiBurnData -> Bool) -> Eq ApiBurnData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiBurnData -> ApiBurnData -> Bool
$c/= :: ApiBurnData -> ApiBurnData -> Bool
== :: ApiBurnData -> ApiBurnData -> Bool
$c== :: ApiBurnData -> ApiBurnData -> Bool
Eq, (forall x. ApiBurnData -> Rep ApiBurnData x)
-> (forall x. Rep ApiBurnData x -> ApiBurnData)
-> Generic ApiBurnData
forall x. Rep ApiBurnData x -> ApiBurnData
forall x. ApiBurnData -> Rep ApiBurnData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiBurnData x -> ApiBurnData
$cfrom :: forall x. ApiBurnData -> Rep ApiBurnData x
Generic, Int -> ApiBurnData -> ShowS
[ApiBurnData] -> ShowS
ApiBurnData -> String
(Int -> ApiBurnData -> ShowS)
-> (ApiBurnData -> String)
-> ([ApiBurnData] -> ShowS)
-> Show ApiBurnData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiBurnData] -> ShowS
$cshowList :: [ApiBurnData] -> ShowS
show :: ApiBurnData -> String
$cshow :: ApiBurnData -> String
showsPrec :: Int -> ApiBurnData -> ShowS
$cshowsPrec :: Int -> ApiBurnData -> ShowS
Show)
    deriving anyclass ApiBurnData -> ()
(ApiBurnData -> ()) -> NFData ApiBurnData
forall a. (a -> ()) -> NFData a
rnf :: ApiBurnData -> ()
$crnf :: ApiBurnData -> ()
NFData

instance FromJSON ApiBurnData where
    parseJSON :: Value -> Parser ApiBurnData
parseJSON = Options -> Value -> Parser ApiBurnData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultRecordTypeOptions

instance ToJSON ApiBurnData where
    toJSON :: ApiBurnData -> Value
toJSON (ApiBurnData
burn) = Options -> ApiBurnData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultRecordTypeOptions ApiBurnData
burn

instance EncodeAddress n => ToJSON (ApiMintBurnOperation n) where
    toJSON :: ApiMintBurnOperation n -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (ApiMintBurnOperation n -> [Pair])
-> ApiMintBurnOperation n
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> [Pair]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair])
-> (ApiMintBurnOperation n -> Pair)
-> ApiMintBurnOperation n
-> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        ApiMint ApiMintData n
mint -> Key
"mint" Key -> ApiMintData n -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiMintData n
mint
        ApiBurn ApiBurnData
burn -> Key
"burn" Key -> ApiBurnData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiBurnData
burn

instance DecodeAddress n => FromJSON (ApiMintBurnOperation n) where
    parseJSON :: Value -> Parser (ApiMintBurnOperation n)
parseJSON = String
-> (Object -> Parser (ApiMintBurnOperation n))
-> Value
-> Parser (ApiMintBurnOperation n)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ApiMintBurnOperation" ((Object -> Parser (ApiMintBurnOperation n))
 -> Value -> Parser (ApiMintBurnOperation n))
-> (Object -> Parser (ApiMintBurnOperation n))
-> Value
-> Parser (ApiMintBurnOperation n)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        case Object -> [Key]
forall v. KeyMap v -> [Key]
Aeson.keys Object
o of
            [Key
"mint"] -> ApiMintData n -> ApiMintBurnOperation n
forall (n :: NetworkDiscriminant).
ApiMintData n -> ApiMintBurnOperation n
ApiMint (ApiMintData n -> ApiMintBurnOperation n)
-> Parser (ApiMintData n) -> Parser (ApiMintBurnOperation n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (ApiMintData n)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mint"
            [Key
"burn"] -> ApiBurnData -> ApiMintBurnOperation n
forall (n :: NetworkDiscriminant).
ApiBurnData -> ApiMintBurnOperation n
ApiBurn (ApiBurnData -> ApiMintBurnOperation n)
-> Parser ApiBurnData -> Parser (ApiMintBurnOperation n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApiBurnData
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"burn"
            [] -> String -> Parser (ApiMintBurnOperation n)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Must include a \"mint\" or \"burn\" property."
            [Key]
_ -> String -> Parser (ApiMintBurnOperation n)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"May be either a \"mint\" or a \"burn\"."

instance FromJSON (ApiT (Script KeyHash)) where
    parseJSON :: Value -> Parser (ApiT (Script KeyHash))
parseJSON = (Script KeyHash -> ApiT (Script KeyHash))
-> Parser (Script KeyHash) -> Parser (ApiT (Script KeyHash))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script KeyHash -> ApiT (Script KeyHash)
forall a. a -> ApiT a
ApiT (Parser (Script KeyHash) -> Parser (ApiT (Script KeyHash)))
-> (Value -> Parser (Script KeyHash))
-> Value
-> Parser (ApiT (Script KeyHash))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (Script KeyHash)
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON (ApiT (Script KeyHash)) where
    toJSON :: ApiT (Script KeyHash) -> Value
toJSON = Script KeyHash -> Value
forall a. ToJSON a => a -> Value
toJSON (Script KeyHash -> Value)
-> (ApiT (Script KeyHash) -> Script KeyHash)
-> ApiT (Script KeyHash)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT (Script KeyHash) -> Script KeyHash
forall a. ApiT a -> a
getApiT

instance FromJSON (ApiT (Script Cosigner)) where
    parseJSON :: Value -> Parser (ApiT (Script Cosigner))
parseJSON = (Script Cosigner -> ApiT (Script Cosigner))
-> Parser (Script Cosigner) -> Parser (ApiT (Script Cosigner))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script Cosigner -> ApiT (Script Cosigner)
forall a. a -> ApiT a
ApiT (Parser (Script Cosigner) -> Parser (ApiT (Script Cosigner)))
-> (Value -> Parser (Script Cosigner))
-> Value
-> Parser (ApiT (Script Cosigner))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (Script Cosigner)
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON (ApiT (Script Cosigner)) where
    toJSON :: ApiT (Script Cosigner) -> Value
toJSON = Script Cosigner -> Value
forall a. ToJSON a => a -> Value
toJSON (Script Cosigner -> Value)
-> (ApiT (Script Cosigner) -> Script Cosigner)
-> ApiT (Script Cosigner)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT (Script Cosigner) -> Script Cosigner
forall a. ApiT a -> a
getApiT

instance FromJSON (ApiT TxScriptValidity) where
    parseJSON :: Value -> Parser (ApiT TxScriptValidity)
parseJSON = (TxScriptValidity -> ApiT TxScriptValidity)
-> Parser TxScriptValidity -> Parser (ApiT TxScriptValidity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxScriptValidity -> ApiT TxScriptValidity
forall a. a -> ApiT a
ApiT (Parser TxScriptValidity -> Parser (ApiT TxScriptValidity))
-> (Value -> Parser TxScriptValidity)
-> Value
-> Parser (ApiT TxScriptValidity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Value -> Parser TxScriptValidity
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
Aeson.defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = Char -> ShowS
camelTo2 Char
'_' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
8 }

instance ToJSON (ApiT TxScriptValidity) where
    toJSON :: ApiT TxScriptValidity -> Value
toJSON = Options -> TxScriptValidity -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
Aeson.defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = Char -> ShowS
camelTo2 Char
'_' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
8 } (TxScriptValidity -> Value)
-> (ApiT TxScriptValidity -> TxScriptValidity)
-> ApiT TxScriptValidity
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT TxScriptValidity -> TxScriptValidity
forall a. ApiT a -> a
getApiT

--------------------------------------------------------------------------------
-- Utility types
--------------------------------------------------------------------------------

-- | A wrapper that allows any type to be serialized as a JSON array.
--
-- The number of items permitted in the array is dependent on the wrapped type.
--
newtype ApiAsArray (s :: Symbol) a = ApiAsArray a
    deriving (ApiAsArray s a -> ApiAsArray s a -> Bool
(ApiAsArray s a -> ApiAsArray s a -> Bool)
-> (ApiAsArray s a -> ApiAsArray s a -> Bool)
-> Eq (ApiAsArray s a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Symbol) a.
Eq a =>
ApiAsArray s a -> ApiAsArray s a -> Bool
/= :: ApiAsArray s a -> ApiAsArray s a -> Bool
$c/= :: forall (s :: Symbol) a.
Eq a =>
ApiAsArray s a -> ApiAsArray s a -> Bool
== :: ApiAsArray s a -> ApiAsArray s a -> Bool
$c== :: forall (s :: Symbol) a.
Eq a =>
ApiAsArray s a -> ApiAsArray s a -> Bool
Eq, (forall x. ApiAsArray s a -> Rep (ApiAsArray s a) x)
-> (forall x. Rep (ApiAsArray s a) x -> ApiAsArray s a)
-> Generic (ApiAsArray s a)
forall x. Rep (ApiAsArray s a) x -> ApiAsArray s a
forall x. ApiAsArray s a -> Rep (ApiAsArray s a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Symbol) a x. Rep (ApiAsArray s a) x -> ApiAsArray s a
forall (s :: Symbol) a x. ApiAsArray s a -> Rep (ApiAsArray s a) x
$cto :: forall (s :: Symbol) a x. Rep (ApiAsArray s a) x -> ApiAsArray s a
$cfrom :: forall (s :: Symbol) a x. ApiAsArray s a -> Rep (ApiAsArray s a) x
Generic, Int -> ApiAsArray s a -> ShowS
[ApiAsArray s a] -> ShowS
ApiAsArray s a -> String
(Int -> ApiAsArray s a -> ShowS)
-> (ApiAsArray s a -> String)
-> ([ApiAsArray s a] -> ShowS)
-> Show (ApiAsArray s a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) a. Show a => Int -> ApiAsArray s a -> ShowS
forall (s :: Symbol) a. Show a => [ApiAsArray s a] -> ShowS
forall (s :: Symbol) a. Show a => ApiAsArray s a -> String
showList :: [ApiAsArray s a] -> ShowS
$cshowList :: forall (s :: Symbol) a. Show a => [ApiAsArray s a] -> ShowS
show :: ApiAsArray s a -> String
$cshow :: forall (s :: Symbol) a. Show a => ApiAsArray s a -> String
showsPrec :: Int -> ApiAsArray s a -> ShowS
$cshowsPrec :: forall (s :: Symbol) a. Show a => Int -> ApiAsArray s a -> ShowS
Show, Typeable)
    deriving newtype (Semigroup (ApiAsArray s a)
ApiAsArray s a
Semigroup (ApiAsArray s a)
-> ApiAsArray s a
-> (ApiAsArray s a -> ApiAsArray s a -> ApiAsArray s a)
-> ([ApiAsArray s a] -> ApiAsArray s a)
-> Monoid (ApiAsArray s a)
[ApiAsArray s a] -> ApiAsArray s a
ApiAsArray s a -> ApiAsArray s a -> ApiAsArray s a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (s :: Symbol) a. Monoid a => Semigroup (ApiAsArray s a)
forall (s :: Symbol) a. Monoid a => ApiAsArray s a
forall (s :: Symbol) a.
Monoid a =>
[ApiAsArray s a] -> ApiAsArray s a
forall (s :: Symbol) a.
Monoid a =>
ApiAsArray s a -> ApiAsArray s a -> ApiAsArray s a
mconcat :: [ApiAsArray s a] -> ApiAsArray s a
$cmconcat :: forall (s :: Symbol) a.
Monoid a =>
[ApiAsArray s a] -> ApiAsArray s a
mappend :: ApiAsArray s a -> ApiAsArray s a -> ApiAsArray s a
$cmappend :: forall (s :: Symbol) a.
Monoid a =>
ApiAsArray s a -> ApiAsArray s a -> ApiAsArray s a
mempty :: ApiAsArray s a
$cmempty :: forall (s :: Symbol) a. Monoid a => ApiAsArray s a
$cp1Monoid :: forall (s :: Symbol) a. Monoid a => Semigroup (ApiAsArray s a)
Monoid, b -> ApiAsArray s a -> ApiAsArray s a
NonEmpty (ApiAsArray s a) -> ApiAsArray s a
ApiAsArray s a -> ApiAsArray s a -> ApiAsArray s a
(ApiAsArray s a -> ApiAsArray s a -> ApiAsArray s a)
-> (NonEmpty (ApiAsArray s a) -> ApiAsArray s a)
-> (forall b. Integral b => b -> ApiAsArray s a -> ApiAsArray s a)
-> Semigroup (ApiAsArray s a)
forall b. Integral b => b -> ApiAsArray s a -> ApiAsArray s a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (s :: Symbol) a.
Semigroup a =>
NonEmpty (ApiAsArray s a) -> ApiAsArray s a
forall (s :: Symbol) a.
Semigroup a =>
ApiAsArray s a -> ApiAsArray s a -> ApiAsArray s a
forall (s :: Symbol) a b.
(Semigroup a, Integral b) =>
b -> ApiAsArray s a -> ApiAsArray s a
stimes :: b -> ApiAsArray s a -> ApiAsArray s a
$cstimes :: forall (s :: Symbol) a b.
(Semigroup a, Integral b) =>
b -> ApiAsArray s a -> ApiAsArray s a
sconcat :: NonEmpty (ApiAsArray s a) -> ApiAsArray s a
$csconcat :: forall (s :: Symbol) a.
Semigroup a =>
NonEmpty (ApiAsArray s a) -> ApiAsArray s a
<> :: ApiAsArray s a -> ApiAsArray s a -> ApiAsArray s a
$c<> :: forall (s :: Symbol) a.
Semigroup a =>
ApiAsArray s a -> ApiAsArray s a -> ApiAsArray s a
Semigroup)
    deriving anyclass ApiAsArray s a -> ()
(ApiAsArray s a -> ()) -> NFData (ApiAsArray s a)
forall a. (a -> ()) -> NFData a
forall (s :: Symbol) a. NFData a => ApiAsArray s a -> ()
rnf :: ApiAsArray s a -> ()
$crnf :: forall (s :: Symbol) a. NFData a => ApiAsArray s a -> ()
NFData

instance (KnownSymbol s, FromJSON a) => FromJSON (ApiAsArray s (Maybe a)) where
    parseJSON :: Value -> Parser (ApiAsArray s (Maybe a))
parseJSON Value
json = Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON @[a] Value
json Parser [a]
-> ([a] -> Parser (ApiAsArray s (Maybe a)))
-> Parser (ApiAsArray s (Maybe a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [a
a] ->
            ApiAsArray s (Maybe a) -> Parser (ApiAsArray s (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiAsArray s (Maybe a) -> Parser (ApiAsArray s (Maybe a)))
-> ApiAsArray s (Maybe a) -> Parser (ApiAsArray s (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> ApiAsArray s (Maybe a)
forall (s :: Symbol) a. a -> ApiAsArray s a
ApiAsArray (Maybe a -> ApiAsArray s (Maybe a))
-> Maybe a -> ApiAsArray s (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a
        [] ->
            ApiAsArray s (Maybe a) -> Parser (ApiAsArray s (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiAsArray s (Maybe a) -> Parser (ApiAsArray s (Maybe a)))
-> ApiAsArray s (Maybe a) -> Parser (ApiAsArray s (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> ApiAsArray s (Maybe a)
forall (s :: Symbol) a. a -> ApiAsArray s a
ApiAsArray Maybe a
forall a. Maybe a
Nothing
        [a]
_  ->
            String -> Parser (ApiAsArray s (Maybe a))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (ApiAsArray s (Maybe a)))
-> String -> Parser (ApiAsArray s (Maybe a))
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"Expected at most one item for "
                , ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s -> String) -> Proxy s -> String
forall a b. (a -> b) -> a -> b
$ Proxy s
forall k (t :: k). Proxy t
Proxy @s
                , String
"."
                ]

instance ToJSON a => ToJSON (ApiAsArray s (Maybe a)) where
    toJSON :: ApiAsArray s (Maybe a) -> Value
toJSON (ApiAsArray Maybe a
m) = [a] -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList Maybe a
m)