{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia        #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Ledger.Builtins.Orphans where

import PlutusTx.Prelude qualified as PlutusTx

import Data.Aeson.Extras qualified as JSON

import Codec.Serialise (Serialise (decode, encode))
import Control.Lens
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON))
import Data.Aeson qualified as JSON
import Data.OpenApi qualified as OpenApi
import Data.Proxy (Proxy (Proxy))
import GHC.Exts (IsList (fromList))
import GHC.Generics (Generic)
import PlutusCore.Data
import PlutusTx qualified as PlutusTx
import PlutusTx.Builtins.Internal (BuiltinData (..))

instance OpenApi.ToSchema PlutusTx.BuiltinByteString where
    declareNamedSchema :: Proxy BuiltinByteString -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy BuiltinByteString
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
OpenApi.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Bytes") Schema
forall a. Monoid a => a
mempty

instance ToJSON PlutusTx.BuiltinByteString where
    toJSON :: BuiltinByteString -> Value
toJSON = Text -> Value
JSON.String (Text -> Value)
-> (BuiltinByteString -> Text) -> BuiltinByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
JSON.encodeByteString (ByteString -> Text)
-> (BuiltinByteString -> ByteString) -> BuiltinByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin

instance FromJSON PlutusTx.BuiltinByteString where
    parseJSON :: Value -> Parser BuiltinByteString
parseJSON Value
v = ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (ByteString -> BuiltinByteString)
-> Parser ByteString -> Parser BuiltinByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ByteString
JSON.decodeByteString Value
v

instance ToJSON PlutusTx.BuiltinData where
  toJSON :: BuiltinData -> Value
toJSON = Data -> Value
forall a. ToJSON a => a -> Value
toJSON (Data -> Value) -> (BuiltinData -> Data) -> BuiltinData -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Data
PlutusTx.builtinDataToData

instance FromJSON PlutusTx.BuiltinData where
  parseJSON :: Value -> Parser BuiltinData
parseJSON Value
v = Value -> Parser Data
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser Data -> (Data -> Parser BuiltinData) -> Parser BuiltinData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BuiltinData -> Parser BuiltinData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BuiltinData -> Parser BuiltinData)
-> (Data -> BuiltinData) -> Data -> Parser BuiltinData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> BuiltinData
PlutusTx.dataToBuiltinData

instance Serialise PlutusTx.BuiltinData where
  encode :: BuiltinData -> Encoding
encode = Data -> Encoding
forall a. Serialise a => a -> Encoding
encode (Data -> Encoding)
-> (BuiltinData -> Data) -> BuiltinData -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Data
PlutusTx.builtinDataToData
  decode :: Decoder s BuiltinData
decode = Data -> BuiltinData
PlutusTx.dataToBuiltinData (Data -> BuiltinData) -> Decoder s Data -> Decoder s BuiltinData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Data
forall a s. Serialise a => Decoder s a
decode

deriving stock instance Generic BuiltinData
deriving instance OpenApi.ToSchema BuiltinData

deriving via (JSON.JSONViaSerialise Data) instance ToJSON Data
deriving via (JSON.JSONViaSerialise Data) instance FromJSON Data

instance OpenApi.ToSchema Data where
  declareNamedSchema :: Proxy Data -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Data
_ = do
    Referenced Schema
integerSchema <- Proxy Integer -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
OpenApi.declareSchemaRef (Proxy Integer
forall k (t :: k). Proxy t
Proxy :: Proxy Integer)
    Referenced Schema
constrArgsSchema <- Proxy (Integer, [Data])
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
OpenApi.declareSchemaRef (Proxy (Integer, [Data])
forall k (t :: k). Proxy t
Proxy :: Proxy (Integer, [Data]))
    Referenced Schema
mapArgsSchema <- Proxy [(Data, Data)]
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
OpenApi.declareSchemaRef (Proxy [(Data, Data)]
forall k (t :: k). Proxy t
Proxy :: Proxy [(Data, Data)])
    Referenced Schema
listArgsSchema <- Proxy [Data] -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
OpenApi.declareSchemaRef (Proxy [Data]
forall k (t :: k). Proxy t
Proxy :: Proxy [Data])
    Referenced Schema
bytestringSchema <- Proxy String -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
OpenApi.declareSchemaRef (Proxy String
forall k (t :: k). Proxy t
Proxy :: Proxy String)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
OpenApi.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Data") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
OpenApi.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApi.OpenApiObject
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
OpenApi.properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~
          [Item (InsOrdHashMap Text (Referenced Schema))]
-> InsOrdHashMap Text (Referenced Schema)
forall l. IsList l => [Item l] -> l
fromList
          [ (Text
"Constr", Referenced Schema
constrArgsSchema)
          , (Text
"Map", Referenced Schema
mapArgsSchema)
          , (Text
"List", Referenced Schema
listArgsSchema)
          , (Text
"I", Referenced Schema
integerSchema)
          , (Text
"B", Referenced Schema
bytestringSchema)
          ]