{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE StrictData #-}

-- |
-- Copyright: © 2018-2022 IOHK
-- License: Apache-2.0
--
-- A wrapper around TxMetadata to allow different JSON codecs. (ADP-1596)
-- see https://github.com/input-output-hk/cardano-node/blob/master/cardano-api/src/Cardano/Api/TxMetadata.hs
module Cardano.Wallet.Api.Types.SchemaMetadata where

import Cardano.Api
    ( Error (displayError)
    , TxMetadataJsonSchema (..)
    , metadataFromJson
    , metadataToJson
    )
import Cardano.Wallet.Primitive.Types.Tx
    ( TxMetadata )
import Control.Applicative
    ( liftA2, (<|>) )
import Control.DeepSeq
    ( NFData )
import Data.Aeson
    ( FromJSON (parseJSON), ToJSON (toJSON) )
import GHC.Generics
    ( Generic )
import Prelude

-- | A tag to select the json codec
data TxMetadataSchema = TxMetadataNoSchema | TxMetadataDetailedSchema
    deriving (Int -> TxMetadataSchema -> ShowS
[TxMetadataSchema] -> ShowS
TxMetadataSchema -> String
(Int -> TxMetadataSchema -> ShowS)
-> (TxMetadataSchema -> String)
-> ([TxMetadataSchema] -> ShowS)
-> Show TxMetadataSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxMetadataSchema] -> ShowS
$cshowList :: [TxMetadataSchema] -> ShowS
show :: TxMetadataSchema -> String
$cshow :: TxMetadataSchema -> String
showsPrec :: Int -> TxMetadataSchema -> ShowS
$cshowsPrec :: Int -> TxMetadataSchema -> ShowS
Show, TxMetadataSchema -> TxMetadataSchema -> Bool
(TxMetadataSchema -> TxMetadataSchema -> Bool)
-> (TxMetadataSchema -> TxMetadataSchema -> Bool)
-> Eq TxMetadataSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxMetadataSchema -> TxMetadataSchema -> Bool
$c/= :: TxMetadataSchema -> TxMetadataSchema -> Bool
== :: TxMetadataSchema -> TxMetadataSchema -> Bool
$c== :: TxMetadataSchema -> TxMetadataSchema -> Bool
Eq, (forall x. TxMetadataSchema -> Rep TxMetadataSchema x)
-> (forall x. Rep TxMetadataSchema x -> TxMetadataSchema)
-> Generic TxMetadataSchema
forall x. Rep TxMetadataSchema x -> TxMetadataSchema
forall x. TxMetadataSchema -> Rep TxMetadataSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxMetadataSchema x -> TxMetadataSchema
$cfrom :: forall x. TxMetadataSchema -> Rep TxMetadataSchema x
Generic, TxMetadataSchema -> ()
(TxMetadataSchema -> ()) -> NFData TxMetadataSchema
forall a. (a -> ()) -> NFData a
rnf :: TxMetadataSchema -> ()
$crnf :: TxMetadataSchema -> ()
NFData)

-- | A wrapper to drive the json codec of metadata
data TxMetadataWithSchema = TxMetadataWithSchema
    { -- | How to codec the metadata into json
        TxMetadataWithSchema -> TxMetadataSchema
txMetadataWithSchema_schema :: TxMetadataSchema
    , -- | The metadata
        TxMetadataWithSchema -> TxMetadata
txMetadataWithSchema_metadata :: TxMetadata
    }
    deriving (Int -> TxMetadataWithSchema -> ShowS
[TxMetadataWithSchema] -> ShowS
TxMetadataWithSchema -> String
(Int -> TxMetadataWithSchema -> ShowS)
-> (TxMetadataWithSchema -> String)
-> ([TxMetadataWithSchema] -> ShowS)
-> Show TxMetadataWithSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxMetadataWithSchema] -> ShowS
$cshowList :: [TxMetadataWithSchema] -> ShowS
show :: TxMetadataWithSchema -> String
$cshow :: TxMetadataWithSchema -> String
showsPrec :: Int -> TxMetadataWithSchema -> ShowS
$cshowsPrec :: Int -> TxMetadataWithSchema -> ShowS
Show, TxMetadataWithSchema -> TxMetadataWithSchema -> Bool
(TxMetadataWithSchema -> TxMetadataWithSchema -> Bool)
-> (TxMetadataWithSchema -> TxMetadataWithSchema -> Bool)
-> Eq TxMetadataWithSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxMetadataWithSchema -> TxMetadataWithSchema -> Bool
$c/= :: TxMetadataWithSchema -> TxMetadataWithSchema -> Bool
== :: TxMetadataWithSchema -> TxMetadataWithSchema -> Bool
$c== :: TxMetadataWithSchema -> TxMetadataWithSchema -> Bool
Eq, (forall x. TxMetadataWithSchema -> Rep TxMetadataWithSchema x)
-> (forall x. Rep TxMetadataWithSchema x -> TxMetadataWithSchema)
-> Generic TxMetadataWithSchema
forall x. Rep TxMetadataWithSchema x -> TxMetadataWithSchema
forall x. TxMetadataWithSchema -> Rep TxMetadataWithSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxMetadataWithSchema x -> TxMetadataWithSchema
$cfrom :: forall x. TxMetadataWithSchema -> Rep TxMetadataWithSchema x
Generic, TxMetadataWithSchema -> ()
(TxMetadataWithSchema -> ()) -> NFData TxMetadataWithSchema
forall a. (a -> ()) -> NFData a
rnf :: TxMetadataWithSchema -> ()
$crnf :: TxMetadataWithSchema -> ()
NFData)

-- | Parses a Boolean "simple-metadata" API flag.
--
-- prop> toSimpleMetadataFlag . parseSimpleMetadataFlag == id
-- prop> parseSimpleMetadataFlag . toSimpleMetadataFlag == id
--
parseSimpleMetadataFlag :: Bool -> TxMetadataSchema
parseSimpleMetadataFlag :: Bool -> TxMetadataSchema
parseSimpleMetadataFlag Bool
flag =
    if Bool
flag
    then TxMetadataSchema
TxMetadataNoSchema
    else TxMetadataSchema
TxMetadataDetailedSchema

-- | Produces a Boolean "simple-metadata" API flag.
--
-- prop> toSimpleMetadataFlag . parseSimpleMetadataFlag == id
-- prop> parseSimpleMetadataFlag . toSimpleMetadataFlag == id
--
toSimpleMetadataFlag :: TxMetadataSchema -> Bool
toSimpleMetadataFlag :: TxMetadataSchema -> Bool
toSimpleMetadataFlag = \case
    TxMetadataSchema
TxMetadataNoSchema -> Bool
True
    TxMetadataSchema
TxMetadataDetailedSchema -> Bool
False

instance ToJSON TxMetadataWithSchema where
    toJSON :: TxMetadataWithSchema -> Value
toJSON (TxMetadataWithSchema TxMetadataSchema
TxMetadataDetailedSchema TxMetadata
x) =
        TxMetadataJsonSchema -> TxMetadata -> Value
metadataToJson TxMetadataJsonSchema
TxMetadataJsonDetailedSchema TxMetadata
x
    toJSON (TxMetadataWithSchema TxMetadataSchema
TxMetadataNoSchema TxMetadata
x) =
        TxMetadataJsonSchema -> TxMetadata -> Value
metadataToJson TxMetadataJsonSchema
TxMetadataJsonNoSchema TxMetadata
x

detailedMetadata :: TxMetadata -> TxMetadataWithSchema
detailedMetadata :: TxMetadata -> TxMetadataWithSchema
detailedMetadata = TxMetadataSchema -> TxMetadata -> TxMetadataWithSchema
TxMetadataWithSchema TxMetadataSchema
TxMetadataDetailedSchema

noSchemaMetadata :: TxMetadata -> TxMetadataWithSchema
noSchemaMetadata :: TxMetadata -> TxMetadataWithSchema
noSchemaMetadata = TxMetadataSchema -> TxMetadata -> TxMetadataWithSchema
TxMetadataWithSchema TxMetadataSchema
TxMetadataNoSchema

instance FromJSON TxMetadataWithSchema where
    parseJSON :: Value -> Parser TxMetadataWithSchema
parseJSON = (Parser TxMetadataWithSchema
 -> Parser TxMetadataWithSchema -> Parser TxMetadataWithSchema)
-> (Value -> Parser TxMetadataWithSchema)
-> (Value -> Parser TxMetadataWithSchema)
-> Value
-> Parser TxMetadataWithSchema
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
        Parser TxMetadataWithSchema
-> Parser TxMetadataWithSchema -> Parser TxMetadataWithSchema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
        ((TxMetadata -> TxMetadataWithSchema)
-> Parser TxMetadata -> Parser TxMetadataWithSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxMetadata -> TxMetadataWithSchema
detailedMetadata
            (Parser TxMetadata -> Parser TxMetadataWithSchema)
-> (Value -> Parser TxMetadata)
-> Value
-> Parser TxMetadataWithSchema
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
        )
        ((TxMetadata -> TxMetadataWithSchema)
-> Parser TxMetadata -> Parser TxMetadataWithSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxMetadata -> TxMetadataWithSchema
noSchemaMetadata
            (Parser TxMetadata -> Parser TxMetadataWithSchema)
-> (Value -> Parser TxMetadata)
-> Value
-> Parser TxMetadataWithSchema
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
TxMetadataJsonNoSchema
        )