{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
-- The whole point of this module
{-# OPTIONS_GHC -Wno-orphans #-}

{- | Module: Plutarch.Orphans
 Description: Orphan instances for Plutarch and Plutus types, including
  JSON serialization.
-}
module Plutarch.Orphans () where

import Codec.Serialise (Serialise, deserialiseOrFail, serialise)
import Data.Aeson ((.:), (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Types (Parser, parserThrowError)
import Data.ByteString qualified as ByteStringStrict
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Lazy (fromStrict, toStrict)
import Data.ByteString.Short (fromShort, toShort)
import Data.Coerce (Coercible, coerce)
import Data.Functor ((<&>))
import Data.Ratio (Ratio, denominator, numerator, (%))
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Vector qualified as Vector
import Plutarch.Api.V2 (PDatumHash (PDatumHash))
import Plutarch.Builtin (PIsData (pdataImpl, pfromDataImpl))
import Plutarch.Extra.TermCont (ptryFromC)
import Plutarch.TryFrom (PTryFrom (ptryFrom'), PTryFromExcess)
import Plutarch.Unsafe (punsafeCoerce)

--------------------------------------------------------------------------------

import Plutarch.Script (Script, deserialiseScript, serialiseScript)
import PlutusLedgerApi.V1.Bytes (bytes, encodeByteString, fromHex)
import PlutusLedgerApi.V2 (
  BuiltinByteString,
  BuiltinData (BuiltinData),
  Credential (PubKeyCredential, ScriptCredential),
  CurrencySymbol (CurrencySymbol, unCurrencySymbol),
  Data (I, List),
  Datum,
  LedgerBytes (LedgerBytes),
  POSIXTime (POSIXTime),
  PubKeyHash (PubKeyHash),
  ScriptHash (ScriptHash),
  StakingCredential (StakingHash, StakingPtr),
  TokenName (TokenName),
  TxId (TxId),
  TxOutRef,
  fromBuiltin,
  toBuiltin,
 )

import PlutusTx (FromData (fromBuiltinData), ToData (toBuiltinData))
import PlutusLedgerApi.V1 (TokenName(unTokenName))

--------------------------------------------------------------------------------

tryDecode :: Text -> Either String ByteStringStrict.ByteString
tryDecode :: Text -> Either String ByteString
tryDecode = ByteString -> Either String ByteString
Base16.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

decodeByteString :: Aeson.Value -> Parser ByteStringStrict.ByteString
decodeByteString :: Value -> Parser ByteString
decodeByteString = forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"ByteString" (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String ByteString
tryDecode)

--------------------------------------------------------------------------------

newtype Flip f a b = Flip (f b a) deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Rep (Flip f a b) x -> Flip f a b
forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Flip f a b -> Rep (Flip f a b) x
$cto :: forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Rep (Flip f a b) x -> Flip f a b
$cfrom :: forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Flip f a b -> Rep (Flip f a b) x
Generic)

-- | @since 3.0.3
instance (PIsData a) => PIsData (PAsData a) where
  pfromDataImpl :: forall (s :: S). Term s (PAsData (PAsData a)) -> Term s (PAsData a)
pfromDataImpl = forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce
  pdataImpl :: forall (s :: S). Term s (PAsData a) -> Term s PData
pdataImpl = forall (a :: PType) (s :: S). PIsData a => Term s a -> Term s PData
pdataImpl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData

-- | @since 3.0.3
instance PTryFrom PData (PAsData PDatumHash) where
  type PTryFromExcess PData (PAsData PDatumHash) = Flip Term PDatumHash
  ptryFrom' :: forall (s :: S) (r :: PType).
Term s PData
-> ((Term s (PAsData PDatumHash),
     Reduce (PTryFromExcess PData (PAsData PDatumHash) s))
    -> Term s r)
-> Term s r
ptryFrom' Term s PData
opq = forall (r :: PType) (s :: S) a.
TermCont s a -> (a -> Term s r) -> Term s r
runTermCont forall a b. (a -> b) -> a -> b
$ do
    Term s PByteString
unwrapped <- forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (b :: PType) (r :: PType) (a :: PType) (s :: S).
PTryFrom a b =>
Term s a -> TermCont s (Term s b, Reduce (PTryFromExcess a b s))
ptryFromC @(PAsData PByteString) Term s PData
opq
    forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont s a
tcont forall a b. (a -> b) -> a -> b
$ \() -> Term s r
f ->
      forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
        -- Blake2b_256 hash: 256 bits/32 bytes.
        (forall (s :: S). Term s (PByteString :--> PInteger)
plengthBS forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
unwrapped forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
32)
        (() -> Term s r
f ())
        (forall (s :: S) (a :: PType). Term s PString -> Term s a
ptraceError Term s PString
"ptryFrom(PDatumHash): must be 32 bytes long")
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s PData
opq, forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PByteString -> PDatumHash s
PDatumHash Term s PByteString
unwrapped)

-- | @since 3.0.3
instance PTryFrom PData (PAsData PUnit)

----------------------------------------
-- Instances for Ratios

instance ToData (Ratio Integer) where
  toBuiltinData :: Ratio Integer -> BuiltinData
toBuiltinData Ratio Integer
rat =
    Data -> BuiltinData
BuiltinData forall a b. (a -> b) -> a -> b
$
      [Data] -> Data
List
        [ Integer -> Data
I forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
numerator Ratio Integer
rat
        , Integer -> Data
I forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
denominator Ratio Integer
rat
        ]

instance FromData (Ratio Integer) where
  fromBuiltinData :: BuiltinData -> Maybe (Ratio Integer)
fromBuiltinData (BuiltinData (List [I Integer
num, I Integer
denom])) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer
num forall a. Integral a => a -> a -> Ratio a
% if Integer
num forall a. Eq a => a -> a -> Bool
== Integer
0 then Integer
1 else Integer
denom
  fromBuiltinData BuiltinData
_ = forall a. Maybe a
Nothing

----------------------------------------
-- Aeson (JSON) instances

-- | Represent a ByteString as a hex-encoded JSON String
newtype AsBase16Bytes (a :: Type) = AsBase16Bytes a

{- | Represent any serializable value as a hex-encoded JSON String of its
 serialization
-}
newtype AsBase16Codec (a :: Type) = AsBase16Codec a

--------------------
-- Instances for `deriving via`

-- @ since 3.6.1
instance
  (Coercible a LedgerBytes) =>
  Aeson.ToJSON (AsBase16Bytes a)
  where
  toJSON :: AsBase16Bytes a -> Value
toJSON =
    Text -> Value
Aeson.String
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeByteString
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerBytes -> ByteString
bytes
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce @(AsBase16Bytes a) @LedgerBytes

  toEncoding :: AsBase16Bytes a -> Encoding
toEncoding =
    forall a. ToJSON a => a -> Encoding
Aeson.toEncoding @Text
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeByteString
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerBytes -> ByteString
bytes
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce @(AsBase16Bytes a) @LedgerBytes

-- @ since 3.6.1
instance
  (Coercible LedgerBytes a) =>
  Aeson.FromJSON (AsBase16Bytes a)
  where
  parseJSON :: Value -> Parser (AsBase16Bytes a)
parseJSON Value
v =
    forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON @Text Value
v
      forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (forall a. JSONPath -> String -> Parser a
parserThrowError [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
        ( forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce @_
              @(AsBase16Bytes a)
        )
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either LedgerBytesError LedgerBytes
fromHex
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- @ since 3.6.1
instance (Serialise a) => Aeson.ToJSON (AsBase16Codec a) where
  toJSON :: AsBase16Codec a -> Value
toJSON (AsBase16Codec a
x) =
    Text -> Value
Aeson.String
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeByteString
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => a -> ByteString
serialise @a
      forall a b. (a -> b) -> a -> b
$ a
x

  toEncoding :: AsBase16Codec a -> Encoding
toEncoding (AsBase16Codec a
x) =
    forall a. ToJSON a => a -> Encoding
Aeson.toEncoding @Text
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeByteString
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => a -> ByteString
serialise @a
      forall a b. (a -> b) -> a -> b
$ a
x

-- @ since 3.6.1
instance (Serialise a) => Aeson.FromJSON (AsBase16Codec a) where
  parseJSON :: Value -> Parser (AsBase16Codec a)
parseJSON Value
v = do
    Either LedgerBytesError LedgerBytes
eitherLedgerBytes <-
      ByteString -> Either LedgerBytesError LedgerBytes
fromHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
        forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON @Text Value
v

    ByteString
b <- case Either LedgerBytesError LedgerBytes
eitherLedgerBytes of
      (Left LedgerBytesError
err) -> forall a. JSONPath -> String -> Parser a
parserThrowError [] forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show LedgerBytesError
err
      (Right LedgerBytes
lb) -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LedgerBytes -> ByteString
bytes LedgerBytes
lb
    case forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail (ByteString -> ByteString
fromStrict ByteString
b) of
      (Left DeserialiseFailure
err) -> forall a. JSONPath -> String -> Parser a
parserThrowError [] forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show DeserialiseFailure
err
      (Right a
r) -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> AsBase16Codec a
AsBase16Codec a
r

-- @since X.Y.Z
deriving via (AsBase16Codec Datum) instance Aeson.ToJSON Datum

-- @since X.Y.Z
deriving via (AsBase16Codec Datum) instance Aeson.FromJSON Datum

-- @ since 3.6.1
deriving via (AsBase16Bytes TxId) instance Aeson.ToJSON TxId

-- @ since 3.6.1
deriving via (AsBase16Bytes TxId) instance Aeson.FromJSON TxId

-- @ since 3.6.1
deriving anyclass instance Aeson.ToJSON TxOutRef

-- @ since 3.6.1
deriving anyclass instance Aeson.FromJSON TxOutRef

-- @ since 3.20.2
instance Aeson.ToJSON CurrencySymbol where
  toJSON :: CurrencySymbol -> Value
toJSON CurrencySymbol
c =
    [Pair] -> Value
Aeson.object
      [
        ( Key
"unCurrencySymbol"
        , Text -> Value
Aeson.String
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeByteString
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall arep a. FromBuiltin arep a => arep -> a
fromBuiltin
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrencySymbol -> BuiltinByteString
unCurrencySymbol
            forall a b. (a -> b) -> a -> b
$ CurrencySymbol
c
        )
      ]

-- @ since 3.20.2
instance Aeson.FromJSON CurrencySymbol where
  parseJSON :: Value -> Parser CurrencySymbol
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"CurrencySymbol" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
      Value
raw <- Object
object forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unCurrencySymbol"
      ByteString
bytes' <- Value -> Parser ByteString
decodeByteString Value
raw
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> CurrencySymbol
CurrencySymbol forall a b. (a -> b) -> a -> b
$ forall a arep. ToBuiltin a arep => a -> arep
toBuiltin ByteString
bytes'

{- Copied from an old version of Plutarch:
https://github.com/input-output-hk/plutus/blob/4fd86930f1dc628a816adf5f5d854b3fec578312/plutus-ledger-api/src/Plutus/V1/Ledger/Value.hs#L155

note [Roundtripping token names]

How to properly roundtrip a token name that is not valid UTF-8 through PureScript
without a big rewrite of the API?
We prefix it with a zero byte so we can recognize it when we get a bytestring value back,
and we serialize it base16 encoded, with 0x in front so it will look as a hex string.
(Browsers don't render the zero byte.)
-}

-- @ since 3.20.2
-- NOTE(Kylix, 23 Aug 2024): Changed this to work with base-16 directly instead of encoding to UTF-8, which was unconventional for non-UTF-8 strings.
instance Aeson.ToJSON TokenName where
  toJSON :: TokenName -> Value
toJSON TokenName
c =
    [Pair] -> Value
Aeson.object
      [
        ( Key
"unTokenName"
        , Text -> Value
Aeson.String
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeByteString
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall arep a. FromBuiltin arep a => arep -> a
fromBuiltin
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenName -> BuiltinByteString
unTokenName
            forall a b. (a -> b) -> a -> b
$ TokenName
c
        )
      ]

-- @ since 3.20.2
-- NOTE(Kylix, 23 Aug 2024): Changed this to work with base-16 directly instead of decoding from UTF-8, which was unconventional for non-UTF-8 strings.
instance Aeson.FromJSON TokenName where
  parseJSON :: Value -> Parser TokenName
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"TokenName" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
      Value
raw <- Object
object forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unTokenName"
      ByteString
bytes' <- Value -> Parser ByteString
decodeByteString Value
raw
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> TokenName
TokenName forall a b. (a -> b) -> a -> b
$ forall a arep. ToBuiltin a arep => a -> arep
toBuiltin ByteString
bytes'

-- @ since 3.6.1
deriving via
  (AsBase16Bytes ScriptHash)
  instance
    (Aeson.ToJSON ScriptHash)

-- @ since 3.6.1
deriving via
  (AsBase16Bytes ScriptHash)
  instance
    (Aeson.FromJSON ScriptHash)

-- @ since 3.6.1
deriving via
  Integer
  instance
    (Aeson.ToJSON POSIXTime)

-- @ since 3.6.1
deriving via
  Integer
  instance
    (Aeson.FromJSON POSIXTime)

-- @ since 3.6.1
deriving via
  (AsBase16Bytes BuiltinByteString)
  instance
    (Aeson.ToJSON BuiltinByteString)

-- @ since 3.6.1
deriving via
  (AsBase16Bytes BuiltinByteString)
  instance
    (Aeson.FromJSON BuiltinByteString)

-- @ since 3.6.1
instance Aeson.ToJSON Script where
  toJSON :: Script -> Value
toJSON =
    Text -> Value
Aeson.String
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeByteString
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> ShortByteString
serialiseScript

-- @ since 3.6.1
instance Aeson.FromJSON Script where
  parseJSON :: Value -> Parser Script
parseJSON Value
v =
    forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON @Text Value
v
      forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> ShortByteString -> Script
deserialiseScript
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- @ since 3.16.0
deriving via
  BuiltinByteString
  instance
    (Aeson.ToJSON PubKeyHash)

-- @ since 3.16.0
deriving via
  BuiltinByteString
  instance
    (Aeson.FromJSON PubKeyHash)

--------------------------------------------------------------------------------
-- manual instances

-- @ since 3.16.0
instance Aeson.ToJSON StakingCredential where
  toJSON :: StakingCredential -> Value
toJSON (StakingHash Credential
cred) =
    [Pair] -> Value
Aeson.object
      [ Key
"contents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
Aeson.toJSON Credential
cred
      , Key
"tag" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"StakingHash"
      ]
  toJSON (StakingPtr Integer
x Integer
y Integer
z) =
    [Pair] -> Value
Aeson.object
      [ Key
"contents"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Array -> Value
Aeson.Array
            ( forall a. [a] -> Vector a
Vector.fromList
                (forall a. ToJSON a => a -> Value
Aeson.toJSON forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer
x, Integer
y, Integer
z])
            )
      , Key
"tag" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"StakingPtr"
      ]

  toEncoding :: StakingCredential -> Encoding
toEncoding (StakingHash Credential
cred) =
    Series -> Encoding
Aeson.pairs
      ( Key
"contents"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Credential
cred
          forall a. Semigroup a => a -> a -> a
<> Key
"tag"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"StakingHash"
      )
  toEncoding (StakingPtr Integer
x Integer
y Integer
z) =
    Series -> Encoding
Aeson.pairs
      ( Key
"contents"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Integer
x, Integer
y, Integer
z]
          forall a. Semigroup a => a -> a -> a
<> Key
"tag"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"StakingPtr"
      )

-- @since 3.16.0
instance Aeson.FromJSON StakingCredential where
  parseJSON :: Value -> Parser StakingCredential
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"StakingCredential" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Value
contents <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contents"
    String
tag <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag"
    case String
tag of
      String
"StakingHash" -> Credential -> StakingCredential
StakingHash forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
contents
      String
"StakingPtr" -> Value -> Parser StakingCredential
parseStakingPtr Value
contents
      String
_ -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected StakingHash or StakingPtr, got " forall a. Semigroup a => a -> a -> a
<> String
tag
    where
      parseStakingPtr :: Aeson.Value -> Parser StakingCredential
      parseStakingPtr :: Value -> Parser StakingCredential
parseStakingPtr Value
v =
        forall a. FromJSON a => Value -> Parser [a]
Aeson.parseJSONList Value
v forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          [Integer
x, Integer
y, Integer
z] -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> StakingCredential
StakingPtr Integer
x Integer
y Integer
z
          [Integer]
xs ->
            forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
              String
"expected an array of length 3, but got length "
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Integer]
xs)

-- @since 3.16.0
instance Aeson.ToJSON Credential where
  toJSON :: Credential -> Value
toJSON (PubKeyCredential PubKeyHash
cred) =
    [Pair] -> Value
Aeson.object
      [ Key
"contents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
Aeson.toJSON PubKeyHash
cred
      , Key
"tag" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"PubKeyCredential"
      ]
  toJSON (ScriptCredential ScriptHash
cred) =
    [Pair] -> Value
Aeson.object
      [ Key
"contents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
Aeson.toJSON ScriptHash
cred
      , Key
"tag" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"ScriptCredential"
      ]

  toEncoding :: Credential -> Encoding
toEncoding (PubKeyCredential PubKeyHash
cred) =
    Series -> Encoding
Aeson.pairs
      ( Key
"contents"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PubKeyHash
cred
          forall a. Semigroup a => a -> a -> a
<> Key
"tag"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"PubKeyCredential"
      )
  toEncoding (ScriptCredential ScriptHash
cred) =
    Series -> Encoding
Aeson.pairs
      ( Key
"contents"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScriptHash
cred
          forall a. Semigroup a => a -> a -> a
<> Key
"tag"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"ScriptCredential"
      )

-- @since 3.16.0
instance Aeson.FromJSON Credential where
  parseJSON :: Value -> Parser Credential
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Credential" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Value
contents <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contents"
    String
tag <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag"
    case String
tag of
      String
"PubKeyCredential" -> PubKeyHash -> Credential
PubKeyCredential forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
contents
      String
"ScriptCredential" -> ScriptHash -> Credential
ScriptCredential forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
contents
      String
_ -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected PubKeyCredential or ScriptCredential, got " forall a. Semigroup a => a -> a -> a
<> String
tag