{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}

-- | This module exists to take concrete types and convert them into
-- something we can easily create generic UI forms for, based on their
-- structure. As a secondary requirement, it also aims to be easy to
-- serialize to a sensible JSON representation.
--
-- 'ToSchema' turns a function signature into a 'FormSchema' - a
-- description that can serialised as JSON and analysed in PureScript
-- land. In essence it's a simplified, specialised version of a
-- 'Generic' representation.
--
-- The frontend then takes a 'FormSchema', generates a UI form, and
-- allows the user create a concrete value that follows that
-- schema. This is the 'FormArgument'.
--
-- It's useful for the backend to make this instantiation too (because
-- we want to give the user example filled-in forms), so we provide
-- ToArgument.
module Schema
    ( ToSchema
    , toSchema
    , ToArgument
    , toArgument
    , FormSchema(..)
    , FormArgument
    , FormArgumentF(..)
    , formArgumentToJson
    ) where

import Crypto.Hash (Digest, SHA256)
import Data.Aeson (FromJSON, ToJSON, toJSON)
import Data.Aeson qualified as JSON
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Bifunctor (first)
import Data.Eq.Deriving (deriveEq1)
import Data.Functor.Foldable (Fix (Fix), cata)
import Data.Map qualified
import Data.Proxy (Proxy)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.UUID (UUID)
import GHC.Generics (C1, Constructor, D1, Generic, K1 (K1), M1 (M1), Rec0, Rep, S1, Selector, U1, conIsRecord, conName,
                     from, selName, (:*:) ((:*:)), (:+:) (L1, R1))
import Ledger (Ada, Address, AssetClass, CurrencySymbol, Interval, Language, POSIXTime, POSIXTimeRange, PaymentPubKey,
               PaymentPubKeyHash, PubKey, PubKeyHash, Signature, Slot, StakePubKey, StakePubKeyHash, TokenName, TxId,
               TxOutRef, Value)
import Ledger.Bytes (LedgerBytes)
import Ledger.CardanoWallet (WalletNumber)
import Plutus.Contract.Secrets (SecretArgument (EndpointSide, UserSide))
import Plutus.Contract.StateMachine.ThreadToken (ThreadToken)
import Plutus.V1.Ledger.Api (DatumHash, RedeemerHash, ValidatorHash)
import PlutusTx.AssocMap qualified
import PlutusTx.Prelude qualified as P
import PlutusTx.Ratio qualified as P
import Wallet.Emulator.Wallet (Wallet, WalletId, getWalletId)
import Wallet.Types (ContractInstanceId)

import Data.OpenApi.Schema qualified as OpenApi
import Text.Show.Deriving (deriveShow1)

{- HLINT ignore "Avoid restricted function" -}

data FormSchema
    = FormSchemaUnit
    | FormSchemaBool
    | FormSchemaInt
    | FormSchemaInteger
    | FormSchemaString
    | FormSchemaHex
      -- ^ A string that may only contain @0-9a-fA-F@
    | FormSchemaArray FormSchema
    | FormSchemaMaybe FormSchema
    | FormSchemaRadio [String]
      -- ^ A radio button with a list of labels.
    | FormSchemaTuple FormSchema FormSchema
    | FormSchemaObject [(String, FormSchema)]
    -- Blessed types that get their own special UI widget.
    | FormSchemaValue
    | FormSchemaPOSIXTimeRange
    -- Exceptions.
    | FormSchemaUnsupported String
    deriving (Int -> FormSchema -> ShowS
[FormSchema] -> ShowS
FormSchema -> String
(Int -> FormSchema -> ShowS)
-> (FormSchema -> String)
-> ([FormSchema] -> ShowS)
-> Show FormSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormSchema] -> ShowS
$cshowList :: [FormSchema] -> ShowS
show :: FormSchema -> String
$cshow :: FormSchema -> String
showsPrec :: Int -> FormSchema -> ShowS
$cshowsPrec :: Int -> FormSchema -> ShowS
Show, FormSchema -> FormSchema -> Bool
(FormSchema -> FormSchema -> Bool)
-> (FormSchema -> FormSchema -> Bool) -> Eq FormSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormSchema -> FormSchema -> Bool
$c/= :: FormSchema -> FormSchema -> Bool
== :: FormSchema -> FormSchema -> Bool
$c== :: FormSchema -> FormSchema -> Bool
Eq, (forall x. FormSchema -> Rep FormSchema x)
-> (forall x. Rep FormSchema x -> FormSchema) -> Generic FormSchema
forall x. Rep FormSchema x -> FormSchema
forall x. FormSchema -> Rep FormSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormSchema x -> FormSchema
$cfrom :: forall x. FormSchema -> Rep FormSchema x
Generic)
    deriving anyclass (Value -> Parser [FormSchema]
Value -> Parser FormSchema
(Value -> Parser FormSchema)
-> (Value -> Parser [FormSchema]) -> FromJSON FormSchema
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FormSchema]
$cparseJSONList :: Value -> Parser [FormSchema]
parseJSON :: Value -> Parser FormSchema
$cparseJSON :: Value -> Parser FormSchema
FromJSON, [FormSchema] -> Encoding
[FormSchema] -> Value
FormSchema -> Encoding
FormSchema -> Value
(FormSchema -> Value)
-> (FormSchema -> Encoding)
-> ([FormSchema] -> Value)
-> ([FormSchema] -> Encoding)
-> ToJSON FormSchema
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FormSchema] -> Encoding
$ctoEncodingList :: [FormSchema] -> Encoding
toJSONList :: [FormSchema] -> Value
$ctoJSONList :: [FormSchema] -> Value
toEncoding :: FormSchema -> Encoding
$ctoEncoding :: FormSchema -> Encoding
toJSON :: FormSchema -> Value
$ctoJSON :: FormSchema -> Value
ToJSON, Typeable FormSchema
Typeable FormSchema
-> (Proxy FormSchema -> Declare (Definitions Schema) NamedSchema)
-> ToSchema FormSchema
Proxy FormSchema -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy FormSchema -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy FormSchema -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable FormSchema
OpenApi.ToSchema)

------------------------------------------------------------
type FormArgument = Fix FormArgumentF

data FormArgumentF a
    = FormUnitF
    | FormBoolF Bool
    | FormIntF (Maybe Int)
    | FormIntegerF (Maybe Integer)
    | FormStringF (Maybe String)
    | FormHexF (Maybe String)
    | FormRadioF [String] (Maybe String)
    | FormArrayF FormSchema [a]
    | FormMaybeF FormSchema (Maybe a)
    | FormTupleF a a
    | FormObjectF [(String, a)]
    | FormValueF Value
    | FormPOSIXTimeRangeF (Interval POSIXTime)
    | FormUnsupportedF String
    deriving (Int -> FormArgumentF a -> ShowS
[FormArgumentF a] -> ShowS
FormArgumentF a -> String
(Int -> FormArgumentF a -> ShowS)
-> (FormArgumentF a -> String)
-> ([FormArgumentF a] -> ShowS)
-> Show (FormArgumentF a)
forall a. Show a => Int -> FormArgumentF a -> ShowS
forall a. Show a => [FormArgumentF a] -> ShowS
forall a. Show a => FormArgumentF a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormArgumentF a] -> ShowS
$cshowList :: forall a. Show a => [FormArgumentF a] -> ShowS
show :: FormArgumentF a -> String
$cshow :: forall a. Show a => FormArgumentF a -> String
showsPrec :: Int -> FormArgumentF a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FormArgumentF a -> ShowS
Show, (forall x. FormArgumentF a -> Rep (FormArgumentF a) x)
-> (forall x. Rep (FormArgumentF a) x -> FormArgumentF a)
-> Generic (FormArgumentF a)
forall x. Rep (FormArgumentF a) x -> FormArgumentF a
forall x. FormArgumentF a -> Rep (FormArgumentF a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FormArgumentF a) x -> FormArgumentF a
forall a x. FormArgumentF a -> Rep (FormArgumentF a) x
$cto :: forall a x. Rep (FormArgumentF a) x -> FormArgumentF a
$cfrom :: forall a x. FormArgumentF a -> Rep (FormArgumentF a) x
Generic, FormArgumentF a -> FormArgumentF a -> Bool
(FormArgumentF a -> FormArgumentF a -> Bool)
-> (FormArgumentF a -> FormArgumentF a -> Bool)
-> Eq (FormArgumentF a)
forall a. Eq a => FormArgumentF a -> FormArgumentF a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormArgumentF a -> FormArgumentF a -> Bool
$c/= :: forall a. Eq a => FormArgumentF a -> FormArgumentF a -> Bool
== :: FormArgumentF a -> FormArgumentF a -> Bool
$c== :: forall a. Eq a => FormArgumentF a -> FormArgumentF a -> Bool
Eq, a -> FormArgumentF b -> FormArgumentF a
(a -> b) -> FormArgumentF a -> FormArgumentF b
(forall a b. (a -> b) -> FormArgumentF a -> FormArgumentF b)
-> (forall a b. a -> FormArgumentF b -> FormArgumentF a)
-> Functor FormArgumentF
forall a b. a -> FormArgumentF b -> FormArgumentF a
forall a b. (a -> b) -> FormArgumentF a -> FormArgumentF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FormArgumentF b -> FormArgumentF a
$c<$ :: forall a b. a -> FormArgumentF b -> FormArgumentF a
fmap :: (a -> b) -> FormArgumentF a -> FormArgumentF b
$cfmap :: forall a b. (a -> b) -> FormArgumentF a -> FormArgumentF b
Functor)
    deriving anyclass ([FormArgumentF a] -> Encoding
[FormArgumentF a] -> Value
FormArgumentF a -> Encoding
FormArgumentF a -> Value
(FormArgumentF a -> Value)
-> (FormArgumentF a -> Encoding)
-> ([FormArgumentF a] -> Value)
-> ([FormArgumentF a] -> Encoding)
-> ToJSON (FormArgumentF a)
forall a. ToJSON a => [FormArgumentF a] -> Encoding
forall a. ToJSON a => [FormArgumentF a] -> Value
forall a. ToJSON a => FormArgumentF a -> Encoding
forall a. ToJSON a => FormArgumentF a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FormArgumentF a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [FormArgumentF a] -> Encoding
toJSONList :: [FormArgumentF a] -> Value
$ctoJSONList :: forall a. ToJSON a => [FormArgumentF a] -> Value
toEncoding :: FormArgumentF a -> Encoding
$ctoEncoding :: forall a. ToJSON a => FormArgumentF a -> Encoding
toJSON :: FormArgumentF a -> Value
$ctoJSON :: forall a. ToJSON a => FormArgumentF a -> Value
ToJSON, Value -> Parser [FormArgumentF a]
Value -> Parser (FormArgumentF a)
(Value -> Parser (FormArgumentF a))
-> (Value -> Parser [FormArgumentF a])
-> FromJSON (FormArgumentF a)
forall a. FromJSON a => Value -> Parser [FormArgumentF a]
forall a. FromJSON a => Value -> Parser (FormArgumentF a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FormArgumentF a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [FormArgumentF a]
parseJSON :: Value -> Parser (FormArgumentF a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (FormArgumentF a)
FromJSON)

deriving newtype instance ToJSON (Fix FormArgumentF)

deriving newtype instance FromJSON (Fix FormArgumentF)

formArgumentToJson :: Fix FormArgumentF -> Maybe JSON.Value
formArgumentToJson :: Fix FormArgumentF -> Maybe Value
formArgumentToJson = (Base (Fix FormArgumentF) (Maybe Value) -> Maybe Value)
-> Fix FormArgumentF -> Maybe Value
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Fix FormArgumentF) (Maybe Value) -> Maybe Value
FormArgumentF (Maybe Value) -> Maybe Value
algebra
  where
    algebra :: FormArgumentF (Maybe JSON.Value) -> Maybe JSON.Value
    algebra :: FormArgumentF (Maybe Value) -> Maybe Value
algebra FormArgumentF (Maybe Value)
FormUnitF = () -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON ()
    algebra (FormBoolF Bool
v) = Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON Bool
v
    algebra (FormIntF Maybe Int
v) = Maybe Int -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON Maybe Int
v
    algebra (FormIntegerF Maybe Integer
v) = Maybe Integer -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON Maybe Integer
v
    algebra (FormStringF Maybe String
v) = String -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON (Maybe String -> String
forall a. Show a => a -> String
show Maybe String
v)
    algebra (FormHexF Maybe String
v) = Maybe String -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON Maybe String
v
    algebra (FormRadioF [String]
_ Maybe String
v) = Maybe String -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON Maybe String
v
    algebra (FormArrayF FormSchema
_ [Maybe Value]
v) = [Maybe Value] -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON [Maybe Value]
v
    algebra (FormMaybeF FormSchema
_ Maybe (Maybe Value)
v) = Maybe (Maybe Value) -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON Maybe (Maybe Value)
v
    algebra (FormTupleF (Just Value
a) (Just Value
b)) = [Value] -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON [Value
a, Value
b]
    algebra (FormTupleF Maybe Value
_ Maybe Value
_) = Maybe Value
forall a. Maybe a
Nothing
    algebra (FormObjectF [(String, Maybe Value)]
vs) =
        Object -> Value
JSON.Object (Object -> Value)
-> ([(String, Value)] -> Object) -> [(String, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, Value)] -> Object)
-> ([(String, Value)] -> [(Key, Value)])
-> [(String, Value)]
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Value) -> (Key, Value))
-> [(String, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Key) -> (String, Value) -> (Key, Value)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Key
Key.fromText (Text -> Key) -> (String -> Text) -> String -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack)) ([(String, Value)] -> Value)
-> Maybe [(String, Value)] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ((String, Maybe Value) -> Maybe (String, Value))
-> [(String, Maybe Value)] -> Maybe [(String, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String, Maybe Value) -> Maybe (String, Value)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [(String, Maybe Value)]
vs
    algebra (FormValueF Value
v) = Value -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON Value
v
    algebra (FormPOSIXTimeRangeF Interval POSIXTime
v) = Interval POSIXTime -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
justJSON Interval POSIXTime
v
    algebra (FormUnsupportedF String
_) = Maybe Value
forall a. Maybe a
Nothing
    justJSON ::
           forall a. ToJSON a
        => a
        -> Maybe JSON.Value
    justJSON :: a -> Maybe Value
justJSON = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (a -> Value) -> a -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON

------------------------------------------------------------
-- | A description of a type, suitable for consumption by the Playground's website.
--
-- By calling 'toSchema' on a type you get a description of its
-- structure. Semantically:
--
-- >>> toSchema @Int
-- >>> -- returns, "this is an Int."
-- >>>
-- >>> toSchema @SomeRecord
-- >>>   -- returns, "this is a record, and it has
-- >>>   -- these named fields with these types".
--
-- The description you get back is the 'FormSchema' type, which
-- describes all the obvious primitives, plus some Plutus types
-- deemed worthy of special treatment (eg. 'Value').
--
-- Internally it relies on 'GHC.Generics' to extract the type
-- information, but the implementation jumps through some hoops
-- because generics is geared towards getting the type-description of
-- a specific value (eg. @Left "Foo"@ or @Right 5@) rather than on the
-- type itself (eg. @Either String Int@).
class ToSchema a where
    toSchema :: FormSchema
    default toSchema :: (Generic a, GenericToSchema (Rep a)) =>
        FormSchema
    toSchema = Rep a Any -> FormSchema
forall (f :: * -> *) a. GenericToSchema f => f a -> FormSchema
genericToSchema (Rep a Any -> FormSchema) -> Rep a Any -> FormSchema
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from (a
forall a. HasCallStack => a
undefined :: a)

-- | The value-level equivalent of 'ToSchema'. Where 'ToSchema' takes
-- your type and returns a generic description of its structure,
-- 'ToArgument' takes your value and returns an equivalent value with
-- a more generic structure. So semantially:
--
-- The description you get back is the 'FormArgument' type, which
-- describes all the obvious primitives, plus some Plutus types
-- deemed worthy of special treatment (eg. 'Value').
--
-- >>> toSchema @User
-- >>> -- returns, "this is a record with a 'name' field, which is a String."
-- >>>
-- >>> toArgument (User "Dave")
-- >>> -- returns, "this is a record with a 'name' field, which is a the String 'Dave'."
class ToSchema a =>
      ToArgument a
    where
    toArgument :: a -> Fix FormArgumentF
    default toArgument :: (Generic a, GenericToArgument (Rep a)) =>
        a -> Fix FormArgumentF
    toArgument = Rep a Any -> Fix FormArgumentF
forall (f :: * -> *) a.
GenericToArgument f =>
f a -> Fix FormArgumentF
genericToArgument (Rep a Any -> Fix FormArgumentF)
-> (a -> Rep a Any) -> a -> Fix FormArgumentF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

instance ToSchema () where
    toSchema :: FormSchema
toSchema = FormSchema
FormSchemaUnit

instance ToArgument () where
    toArgument :: () -> Fix FormArgumentF
toArgument ()
_ = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix FormArgumentF (Fix FormArgumentF)
forall a. FormArgumentF a
FormUnitF

instance ToSchema Bool where
    toSchema :: FormSchema
toSchema = FormSchema
FormSchemaBool

instance ToArgument Bool where
    toArgument :: Bool -> Fix FormArgumentF
toArgument = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> (Bool -> FormArgumentF (Fix FormArgumentF))
-> Bool
-> Fix FormArgumentF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FormArgumentF (Fix FormArgumentF)
forall a. Bool -> FormArgumentF a
FormBoolF

instance ToSchema Int where
    toSchema :: FormSchema
toSchema = FormSchema
FormSchemaInt

instance ToArgument Int where
    toArgument :: Int -> Fix FormArgumentF
toArgument = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> (Int -> FormArgumentF (Fix FormArgumentF))
-> Int
-> Fix FormArgumentF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> FormArgumentF (Fix FormArgumentF)
forall a. Maybe Int -> FormArgumentF a
FormIntF (Maybe Int -> FormArgumentF (Fix FormArgumentF))
-> (Int -> Maybe Int) -> Int -> FormArgumentF (Fix FormArgumentF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just

instance ToSchema Integer where
    toSchema :: FormSchema
toSchema = FormSchema
FormSchemaInteger

instance ToArgument Integer where
    toArgument :: Integer -> Fix FormArgumentF
toArgument = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> (Integer -> FormArgumentF (Fix FormArgumentF))
-> Integer
-> Fix FormArgumentF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Integer -> FormArgumentF (Fix FormArgumentF)
forall a. Maybe Integer -> FormArgumentF a
FormIntegerF (Maybe Integer -> FormArgumentF (Fix FormArgumentF))
-> (Integer -> Maybe Integer)
-> Integer
-> FormArgumentF (Fix FormArgumentF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Integer
forall a. a -> Maybe a
Just

instance ToSchema P.Rational where
    toSchema :: FormSchema
toSchema = FormSchema -> FormSchema -> FormSchema
FormSchemaTuple FormSchema
FormSchemaInteger FormSchema
FormSchemaInteger

instance ToArgument P.Rational where
    toArgument :: Rational -> Fix FormArgumentF
toArgument Rational
r = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall a b. (a -> b) -> a -> b
$ Fix FormArgumentF
-> Fix FormArgumentF -> FormArgumentF (Fix FormArgumentF)
forall a. a -> a -> FormArgumentF a
FormTupleF (Integer -> Fix FormArgumentF
forall a. ToArgument a => a -> Fix FormArgumentF
toArgument (Integer -> Fix FormArgumentF) -> Integer -> Fix FormArgumentF
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
P.numerator Rational
r) (Integer -> Fix FormArgumentF
forall a. ToArgument a => a -> Fix FormArgumentF
toArgument (Integer -> Fix FormArgumentF) -> Integer -> Fix FormArgumentF
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
P.denominator Rational
r)

instance ToSchema Text where
    toSchema :: FormSchema
toSchema = FormSchema
FormSchemaString

instance ToArgument Text where
    toArgument :: Text -> Fix FormArgumentF
toArgument = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> (Text -> FormArgumentF (Fix FormArgumentF))
-> Text
-> Fix FormArgumentF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> FormArgumentF (Fix FormArgumentF)
forall a. Maybe String -> FormArgumentF a
FormStringF (Maybe String -> FormArgumentF (Fix FormArgumentF))
-> (Text -> Maybe String)
-> Text
-> FormArgumentF (Fix FormArgumentF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Text -> String) -> Text -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

instance ToSchema a => ToSchema (Proxy a) where
    toSchema :: FormSchema
toSchema = ToSchema a => FormSchema
forall a. ToSchema a => FormSchema
toSchema @a

instance (ToSchema k, ToSchema v) => ToSchema (Data.Map.Map k v) where
    toSchema :: FormSchema
toSchema = FormSchema -> FormSchema
FormSchemaArray (FormSchema -> FormSchema) -> FormSchema -> FormSchema
forall a b. (a -> b) -> a -> b
$ ToSchema (k, v) => FormSchema
forall a. ToSchema a => FormSchema
toSchema @(k, v)

instance (ToSchema a, ToSchema b) => ToSchema (a, b) where
    toSchema :: FormSchema
toSchema = FormSchema -> FormSchema -> FormSchema
FormSchemaTuple (ToSchema a => FormSchema
forall a. ToSchema a => FormSchema
toSchema @a) (ToSchema b => FormSchema
forall a. ToSchema a => FormSchema
toSchema @b)

instance (ToArgument a, ToArgument b) => ToArgument (a, b) where
    toArgument :: (a, b) -> Fix FormArgumentF
toArgument (a
a, b
b) = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall a b. (a -> b) -> a -> b
$ Fix FormArgumentF
-> Fix FormArgumentF -> FormArgumentF (Fix FormArgumentF)
forall a. a -> a -> FormArgumentF a
FormTupleF (a -> Fix FormArgumentF
forall a. ToArgument a => a -> Fix FormArgumentF
toArgument a
a) (b -> Fix FormArgumentF
forall a. ToArgument a => a -> Fix FormArgumentF
toArgument b
b)

instance ToSchema String where
    toSchema :: FormSchema
toSchema = FormSchema
FormSchemaString

instance {-# OVERLAPPABLE #-} (ToSchema a) => ToSchema [a] where
    toSchema :: FormSchema
toSchema = FormSchema -> FormSchema
FormSchemaArray (ToSchema a => FormSchema
forall a. ToSchema a => FormSchema
toSchema @a)

instance ToArgument String where
    toArgument :: String -> Fix FormArgumentF
toArgument = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> (String -> FormArgumentF (Fix FormArgumentF))
-> String
-> Fix FormArgumentF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> FormArgumentF (Fix FormArgumentF)
forall a. Maybe String -> FormArgumentF a
FormStringF (Maybe String -> FormArgumentF (Fix FormArgumentF))
-> (String -> Maybe String)
-> String
-> FormArgumentF (Fix FormArgumentF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just

instance {-# OVERLAPPABLE #-} (ToSchema a, ToArgument a) => ToArgument [a] where
    toArgument :: [a] -> Fix FormArgumentF
toArgument [a]
xs = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall a b. (a -> b) -> a -> b
$ FormSchema
-> [Fix FormArgumentF] -> FormArgumentF (Fix FormArgumentF)
forall a. FormSchema -> [a] -> FormArgumentF a
FormArrayF (ToSchema a => FormSchema
forall a. ToSchema a => FormSchema
toSchema @a) (a -> Fix FormArgumentF
forall a. ToArgument a => a -> Fix FormArgumentF
toArgument (a -> Fix FormArgumentF) -> [a] -> [Fix FormArgumentF]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs)

instance ToSchema AssetClass

------------------------------------------------------------
class GenericToSchema f where
    genericToSchema :: f a -> FormSchema

instance (GenericToSchema f) => GenericToSchema (D1 d f) where
    genericToSchema :: D1 d f a -> FormSchema
genericToSchema (M1 f a
constructors) = f a -> FormSchema
forall (f :: * -> *) a. GenericToSchema f => f a -> FormSchema
genericToSchema f a
constructors

instance (Constructor c, GenericToFields f) => GenericToSchema (C1 c f) where
    genericToSchema :: C1 c f a -> FormSchema
genericToSchema c :: C1 c f a
c@(M1 f a
selectors) =
        if C1 c f a -> Bool
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord C1 c f a
c
            then [(String, FormSchema)] -> FormSchema
FormSchemaObject ([(String, FormSchema)] -> FormSchema)
-> [(String, FormSchema)] -> FormSchema
forall a b. (a -> b) -> a -> b
$ f a -> [(String, FormSchema)]
forall (f :: * -> *) a.
GenericToFields f =>
f a -> [(String, FormSchema)]
genericToFields f a
selectors
            else String -> FormSchema
FormSchemaUnsupported String
"Unsupported, non-record constructor."

instance (GenericToConstructorName c1, GenericToConstructorName c2) =>
         GenericToSchema (c1 :+: c2) where
    genericToSchema :: (:+:) c1 c2 a -> FormSchema
genericToSchema (:+:) c1 c2 a
_ =
        [String] -> FormSchema
FormSchemaRadio ([String] -> FormSchema) -> [String] -> FormSchema
forall a b. (a -> b) -> a -> b
$
        c1 Any -> [String]
forall (f :: * -> *) a.
GenericToConstructorName f =>
f a -> [String]
genericToConstructorName (forall a. c1 a
forall a. HasCallStack => a
undefined :: c1 a) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>
        c2 Any -> [String]
forall (f :: * -> *) a.
GenericToConstructorName f =>
f a -> [String]
genericToConstructorName (forall a. c2 a
forall a. HasCallStack => a
undefined :: c2 a)

instance ToSchema a => ToSchema (Maybe a) where
    toSchema :: FormSchema
toSchema = FormSchema -> FormSchema
FormSchemaMaybe (FormSchema -> FormSchema) -> FormSchema -> FormSchema
forall a b. (a -> b) -> a -> b
$ ToSchema a => FormSchema
forall a. ToSchema a => FormSchema
toSchema @a

class GenericToArgument f where
    genericToArgument :: f a -> Fix FormArgumentF

instance (GenericToArgument f) => GenericToArgument (D1 d f) where
    genericToArgument :: D1 d f a -> Fix FormArgumentF
genericToArgument (M1 f a
x) = f a -> Fix FormArgumentF
forall (f :: * -> *) a.
GenericToArgument f =>
f a -> Fix FormArgumentF
genericToArgument f a
x

instance (GenericToPairs f, Constructor c) => GenericToArgument (C1 c f) where
    genericToArgument :: C1 c f a -> Fix FormArgumentF
genericToArgument c :: C1 c f a
c@(M1 f a
selectors) =
        if C1 c f a -> Bool
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord C1 c f a
c
            then FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall a b. (a -> b) -> a -> b
$ [(String, Fix FormArgumentF)] -> FormArgumentF (Fix FormArgumentF)
forall a. [(String, a)] -> FormArgumentF a
FormObjectF ([(String, Fix FormArgumentF)]
 -> FormArgumentF (Fix FormArgumentF))
-> [(String, Fix FormArgumentF)]
-> FormArgumentF (Fix FormArgumentF)
forall a b. (a -> b) -> a -> b
$ f a -> [(String, Fix FormArgumentF)]
forall (f :: * -> *) a.
GenericToPairs f =>
f a -> [(String, Fix FormArgumentF)]
genericToPairs f a
selectors
            else FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall a b. (a -> b) -> a -> b
$ String -> FormArgumentF (Fix FormArgumentF)
forall a. String -> FormArgumentF a
FormUnsupportedF String
"Unsupported, non-record constructor."

instance (GenericToConstructorName c1, GenericToConstructorName c2) =>
         GenericToArgument (c1 :+: c2) where
    genericToArgument :: (:+:) c1 c2 a -> Fix FormArgumentF
genericToArgument (L1 c1 a
_) = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String -> FormArgumentF (Fix FormArgumentF)
forall a. [String] -> Maybe String -> FormArgumentF a
FormRadioF [String]
names ([String] -> Maybe String
forall a. [a] -> Maybe a
safeHead [String]
name)
      where
        name :: [String]
name = c1 Any -> [String]
forall (f :: * -> *) a.
GenericToConstructorName f =>
f a -> [String]
genericToConstructorName (forall a. c1 a
forall a. HasCallStack => a
undefined :: c1 a)
        names :: [String]
names =
            c1 Any -> [String]
forall (f :: * -> *) a.
GenericToConstructorName f =>
f a -> [String]
genericToConstructorName (forall a. c1 a
forall a. HasCallStack => a
undefined :: c1 a) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>
            c2 Any -> [String]
forall (f :: * -> *) a.
GenericToConstructorName f =>
f a -> [String]
genericToConstructorName (forall a. c2 a
forall a. HasCallStack => a
undefined :: c2 a)
    genericToArgument (R1 c2 a
_) = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String -> FormArgumentF (Fix FormArgumentF)
forall a. [String] -> Maybe String -> FormArgumentF a
FormRadioF [String]
names ([String] -> Maybe String
forall a. [a] -> Maybe a
safeHead [String]
name)
      where
        name :: [String]
name = c2 Any -> [String]
forall (f :: * -> *) a.
GenericToConstructorName f =>
f a -> [String]
genericToConstructorName (forall a. c2 a
forall a. HasCallStack => a
undefined :: c2 a)
        names :: [String]
names =
            c1 Any -> [String]
forall (f :: * -> *) a.
GenericToConstructorName f =>
f a -> [String]
genericToConstructorName (forall a. c1 a
forall a. HasCallStack => a
undefined :: c1 a) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>
            c2 Any -> [String]
forall (f :: * -> *) a.
GenericToConstructorName f =>
f a -> [String]
genericToConstructorName (forall a. c2 a
forall a. HasCallStack => a
undefined :: c2 a)

class GenericToPairs f where
    genericToPairs :: f a -> [(String, Fix FormArgumentF)]

instance (GenericToPairs f, GenericToPairs g) => GenericToPairs (f :*: g) where
    genericToPairs :: (:*:) f g a -> [(String, Fix FormArgumentF)]
genericToPairs (f a
x :*: g a
y) = f a -> [(String, Fix FormArgumentF)]
forall (f :: * -> *) a.
GenericToPairs f =>
f a -> [(String, Fix FormArgumentF)]
genericToPairs f a
x [(String, Fix FormArgumentF)]
-> [(String, Fix FormArgumentF)] -> [(String, Fix FormArgumentF)]
forall a. Semigroup a => a -> a -> a
<> g a -> [(String, Fix FormArgumentF)]
forall (f :: * -> *) a.
GenericToPairs f =>
f a -> [(String, Fix FormArgumentF)]
genericToPairs g a
y

instance (Selector s, ToArgument f) => GenericToPairs (S1 s (Rec0 f)) where
    genericToPairs :: S1 s (Rec0 f) a -> [(String, Fix FormArgumentF)]
genericToPairs selector :: S1 s (Rec0 f) a
selector@(M1 (K1 f
a)) = [(S1 s (Rec0 f) a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName S1 s (Rec0 f) a
selector, f -> Fix FormArgumentF
forall a. ToArgument a => a -> Fix FormArgumentF
toArgument f
a)]

------------------------------------------------------------
class GenericToConstructorName f where
    genericToConstructorName :: f a -> [String]

instance (Constructor c) => GenericToConstructorName (C1 c U1) where
    genericToConstructorName :: C1 c U1 a -> [String]
genericToConstructorName C1 c U1 a
c = [C1 c U1 a -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName C1 c U1 a
c]

instance (GenericToConstructorName c1, GenericToConstructorName c2) =>
         GenericToConstructorName (c1 :+: c2) where
    genericToConstructorName :: (:+:) c1 c2 a -> [String]
genericToConstructorName (:+:) c1 c2 a
_ =
        c1 Any -> [String]
forall (f :: * -> *) a.
GenericToConstructorName f =>
f a -> [String]
genericToConstructorName (forall a. c1 a
forall a. HasCallStack => a
undefined :: c1 a) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>
        c2 Any -> [String]
forall (f :: * -> *) a.
GenericToConstructorName f =>
f a -> [String]
genericToConstructorName (forall a. c2 a
forall a. HasCallStack => a
undefined :: c2 a)

------------------------------------------------------------
class GenericToFields f where
    genericToFields :: f a -> [(String, FormSchema)]

instance (GenericToFields f, GenericToFields g) =>
         GenericToFields (f :*: g) where
    genericToFields :: (:*:) f g a -> [(String, FormSchema)]
genericToFields ~(f a
f :*: g a
g) = f a -> [(String, FormSchema)]
forall (f :: * -> *) a.
GenericToFields f =>
f a -> [(String, FormSchema)]
genericToFields f a
f [(String, FormSchema)]
-> [(String, FormSchema)] -> [(String, FormSchema)]
forall a. Semigroup a => a -> a -> a
<> g a -> [(String, FormSchema)]
forall (f :: * -> *) a.
GenericToFields f =>
f a -> [(String, FormSchema)]
genericToFields g a
g

instance (ToSchema f, Selector s) => GenericToFields (S1 s (Rec0 f)) where
    genericToFields :: S1 s (Rec0 f) a -> [(String, FormSchema)]
genericToFields S1 s (Rec0 f) a
selector = [(S1 s (Rec0 f) a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName S1 s (Rec0 f) a
selector, ToSchema f => FormSchema
forall a. ToSchema a => FormSchema
toSchema @f)]

------------------------------------------------------------
-- We could take this from the `safe` package, but I don't think it's worth the extra dependency.
safeHead :: [a] -> Maybe a
safeHead :: [a] -> Maybe a
safeHead []    = Maybe a
forall a. Maybe a
Nothing
safeHead (a
x:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

------------------------------------------------------------
deriveEq1 ''FormArgumentF

deriveShow1 ''FormArgumentF

------------------------------------------------------------
instance ToSchema (Digest SHA256) where
    toSchema :: FormSchema
toSchema = FormSchema
FormSchemaHex

instance ToSchema P.BuiltinByteString where
    toSchema :: FormSchema
toSchema = ToSchema String => FormSchema
forall a. ToSchema a => FormSchema
toSchema @String

instance (ToSchema k, ToSchema v) =>
         ToSchema (PlutusTx.AssocMap.Map k v)

instance ToSchema Value where
    toSchema :: FormSchema
toSchema = FormSchema
FormSchemaValue

instance ToArgument Value where
    toArgument :: Value -> Fix FormArgumentF
toArgument = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> (Value -> FormArgumentF (Fix FormArgumentF))
-> Value
-> Fix FormArgumentF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> FormArgumentF (Fix FormArgumentF)
forall a. Value -> FormArgumentF a
FormValueF

instance ToSchema LedgerBytes where
    toSchema :: FormSchema
toSchema = ToSchema String => FormSchema
forall a. ToSchema a => FormSchema
toSchema @String

instance ToSchema UUID where
    toSchema :: FormSchema
toSchema = ToSchema String => FormSchema
forall a. ToSchema a => FormSchema
toSchema @String

instance ToSchema WalletId where
    toSchema :: FormSchema
toSchema = ToSchema String => FormSchema
forall a. ToSchema a => FormSchema
toSchema @String

instance ToSchema POSIXTime where
    toSchema :: FormSchema
toSchema = FormSchema
FormSchemaInteger

instance ToSchema POSIXTimeRange where
    toSchema :: FormSchema
toSchema = FormSchema
FormSchemaPOSIXTimeRange

deriving anyclass instance ToSchema Ada

deriving anyclass instance ToSchema ContractInstanceId

deriving anyclass instance ToSchema CurrencySymbol

deriving anyclass instance ToSchema DatumHash

deriving anyclass instance ToSchema PubKey

deriving anyclass instance ToSchema PubKeyHash

deriving anyclass instance ToSchema PaymentPubKey

deriving anyclass instance ToSchema PaymentPubKeyHash

deriving anyclass instance ToSchema Language

deriving anyclass instance ToSchema StakePubKey

deriving anyclass instance ToSchema StakePubKeyHash

deriving anyclass instance ToSchema RedeemerHash

deriving anyclass instance ToSchema Slot

deriving anyclass instance ToSchema Signature

deriving anyclass instance ToSchema ThreadToken

deriving anyclass instance ToSchema TokenName

deriving anyclass instance ToSchema TxId

deriving anyclass instance ToSchema TxOutRef

deriving anyclass instance ToSchema ValidatorHash

deriving anyclass instance ToSchema WalletNumber

deriving anyclass instance ToArgument Ada

deriving anyclass instance ToArgument WalletNumber

deriving anyclass instance ToArgument Slot

instance ToSchema Address where
  toSchema :: FormSchema
toSchema = FormSchema
FormSchemaString

instance ToSchema Wallet where
  toSchema :: FormSchema
toSchema = ToSchema WalletId => FormSchema
forall a. ToSchema a => FormSchema
toSchema @WalletId

instance ToArgument Wallet where
  toArgument :: Wallet -> Fix FormArgumentF
toArgument = WalletId -> Fix FormArgumentF
forall a. ToArgument a => a -> Fix FormArgumentF
toArgument (WalletId -> Fix FormArgumentF)
-> (Wallet -> WalletId) -> Wallet -> Fix FormArgumentF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> WalletId
getWalletId

instance ToArgument WalletId where
  toArgument :: WalletId -> Fix FormArgumentF
toArgument = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> (WalletId -> FormArgumentF (Fix FormArgumentF))
-> WalletId
-> Fix FormArgumentF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> FormArgumentF (Fix FormArgumentF)
forall a. Maybe String -> FormArgumentF a
FormStringF (Maybe String -> FormArgumentF (Fix FormArgumentF))
-> (WalletId -> Maybe String)
-> WalletId
-> FormArgumentF (Fix FormArgumentF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (WalletId -> String) -> WalletId -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletId -> String
forall a. Show a => a -> String
show

instance forall a. ToSchema a => ToSchema (SecretArgument a) where
  toSchema :: FormSchema
toSchema = ToSchema a => FormSchema
forall a. ToSchema a => FormSchema
toSchema @a

instance forall a. ToArgument a => ToArgument (SecretArgument a) where
  toArgument :: SecretArgument a -> Fix FormArgumentF
toArgument (UserSide a
a)     = a -> Fix FormArgumentF
forall a. ToArgument a => a -> Fix FormArgumentF
toArgument a
a
  toArgument (EndpointSide Secret a
_) = FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF)
-> FormArgumentF (Fix FormArgumentF) -> Fix FormArgumentF
forall a b. (a -> b) -> a -> b
$ String -> FormArgumentF (Fix FormArgumentF)
forall a. String -> FormArgumentF a
FormUnsupportedF String
"endpoint side secrets are not supported in toArgument"