{-# OPTIONS_GHC -Wno-orphans #-}

module Agora.Aeson.Orphans (AsBase16Bytes (..)) where

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

import Data.Coerce (Coercible, coerce)
import Prelude

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

import Codec.Serialise qualified as Codec
import Data.Aeson qualified as Aeson
import Data.Aeson.Types qualified as Aeson
import Data.ByteString.Lazy qualified as Lazy
import Data.Text qualified as T
import Data.Text.Encoding qualified as T

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

import PlutusLedgerApi.V1 qualified as Plutus
import PlutusLedgerApi.V1.Bytes qualified as Plutus
import PlutusLedgerApi.V1.Value qualified as Plutus

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

newtype AsBase16Bytes a = AsBase16Bytes {forall a. AsBase16Bytes a -> a
unAsBase16Bytes :: a}
newtype AsBase16Codec a = AsBase16Codec {forall a. AsBase16Codec a -> a
unAsBase16Codec :: a}

deriving via
  (Plutus.CurrencySymbol, Plutus.TokenName)
  instance
    Aeson.ToJSON Plutus.AssetClass

deriving via
  (Plutus.CurrencySymbol, Plutus.TokenName)
  instance
    Aeson.FromJSON Plutus.AssetClass

deriving via
  AsBase16Bytes Plutus.TxId
  instance
    Aeson.FromJSON Plutus.TxId

deriving via
  AsBase16Bytes Plutus.TxId
  instance
    Aeson.ToJSON Plutus.TxId

deriving anyclass instance Aeson.FromJSON Plutus.TxOutRef
deriving anyclass instance Aeson.ToJSON Plutus.TxOutRef

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

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

instance (Codec.Serialise a) => Aeson.ToJSON (AsBase16Codec a) where
  toJSON :: AsBase16Codec a -> Value
toJSON =
    Text -> Value
Aeson.String
      (Text -> Value)
-> (AsBase16Codec a -> Text) -> AsBase16Codec a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Plutus.encodeByteString
      (ByteString -> Text)
-> (AsBase16Codec a -> ByteString) -> AsBase16Codec a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.toStrict
      (ByteString -> ByteString)
-> (AsBase16Codec a -> ByteString) -> AsBase16Codec a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => a -> ByteString
Codec.serialise @a
      (a -> ByteString)
-> (AsBase16Codec a -> a) -> AsBase16Codec a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.unAsBase16Codec)

instance (Codec.Serialise a) => Aeson.FromJSON (AsBase16Codec a) where
  parseJSON :: Value -> Parser (AsBase16Codec a)
parseJSON Value
v =
    forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON @T.Text Value
v
      Parser Text
-> (Text -> Parser (AsBase16Codec a)) -> Parser (AsBase16Codec a)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (DeserialiseFailure -> Parser (AsBase16Codec a))
-> (a -> Parser (AsBase16Codec a))
-> Either DeserialiseFailure a
-> Parser (AsBase16Codec a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (JSONPath -> String -> Parser (AsBase16Codec a)
forall a. JSONPath -> String -> Parser a
Aeson.parserThrowError [] (String -> Parser (AsBase16Codec a))
-> (DeserialiseFailure -> String)
-> DeserialiseFailure
-> Parser (AsBase16Codec a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeserialiseFailure -> String
forall a. Show a => a -> String
show) (AsBase16Codec a -> Parser (AsBase16Codec a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (AsBase16Codec a -> Parser (AsBase16Codec a))
-> (a -> AsBase16Codec a) -> a -> Parser (AsBase16Codec a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> AsBase16Codec a
forall a. a -> AsBase16Codec a
AsBase16Codec)
        (Either DeserialiseFailure a -> Parser (AsBase16Codec a))
-> (Text -> Either DeserialiseFailure a)
-> Text
-> Parser (AsBase16Codec a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DeserialiseFailure a
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
Codec.deserialiseOrFail
        (ByteString -> Either DeserialiseFailure a)
-> (Text -> ByteString) -> Text -> Either DeserialiseFailure a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.fromStrict
        (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

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

deriving via
  (AsBase16Bytes Plutus.CurrencySymbol)
  instance
    (Aeson.ToJSON Plutus.CurrencySymbol)
deriving via
  (AsBase16Bytes Plutus.CurrencySymbol)
  instance
    (Aeson.FromJSON Plutus.CurrencySymbol)

deriving via
  (AsBase16Bytes Plutus.TokenName)
  instance
    (Aeson.ToJSON Plutus.TokenName)
deriving via
  (AsBase16Bytes Plutus.TokenName)
  instance
    (Aeson.FromJSON Plutus.TokenName)

deriving via
  (AsBase16Bytes Plutus.ValidatorHash)
  instance
    (Aeson.ToJSON Plutus.ValidatorHash)
deriving via
  (AsBase16Bytes Plutus.ValidatorHash)
  instance
    (Aeson.FromJSON Plutus.ValidatorHash)

deriving via
  (AsBase16Codec Plutus.Validator)
  instance
    (Aeson.ToJSON Plutus.Validator)
deriving via
  (AsBase16Codec Plutus.Validator)
  instance
    (Aeson.FromJSON Plutus.Validator)

deriving via
  (AsBase16Codec Plutus.MintingPolicy)
  instance
    (Aeson.ToJSON Plutus.MintingPolicy)
deriving via
  (AsBase16Codec Plutus.MintingPolicy)
  instance
    (Aeson.FromJSON Plutus.MintingPolicy)

deriving via
  (AsBase16Codec Plutus.Script)
  instance
    (Aeson.ToJSON Plutus.Script)
deriving via
  (AsBase16Codec Plutus.Script)
  instance
    (Aeson.FromJSON Plutus.Script)

deriving via
  Integer
  instance
    (Aeson.ToJSON Plutus.POSIXTime)
deriving via
  Integer
  instance
    (Aeson.FromJSON Plutus.POSIXTime)