{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Api.ScriptData
  ( -- * Script data
    HashableScriptData
  , hashScriptDataBytes
  , getOriginalScriptDataBytes
  , getScriptData
  , unsafeHashableScriptData
  , ScriptData (..)

    -- * Validating metadata
  , validateScriptData
  , ScriptDataRangeError (..)

    -- * Conversion to\/from JSON
  , ScriptDataJsonSchema (..)
  , scriptDataFromJson
  , scriptDataToJson
  , ScriptDataJsonError (..)
  , ScriptDataJsonSchemaError (..)
  , scriptDataFromJsonDetailedSchema
  , scriptDataToJsonDetailedSchema
  , ScriptBytesError (..)
  , ScriptDataJsonBytesError (..)
  , scriptDataJsonToHashable

    -- * Internal conversion functions
  , toPlutusData
  , fromPlutusData
  , toAlonzoData
  , fromAlonzoData

    -- * Data family instances
  , AsType (..)
  , Hash (..)
  )
where

import           Cardano.Api.Eras
import           Cardano.Api.Error
import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Keys.Shelley
import           Cardano.Api.Pretty
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseJSON
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseUsing
import           Cardano.Api.TxMetadata (pBytes, pSigned, parseAll)

import qualified Cardano.Binary as CBOR
import qualified Cardano.Crypto.Hash.Class as Crypto
import           Cardano.Ledger.Core (Era)
import qualified Cardano.Ledger.Plutus.Data as Plutus
import qualified Cardano.Ledger.SafeHash as Ledger
import           Ouroboros.Consensus.Shelley.Eras (StandardAlonzo, StandardCrypto)
import qualified PlutusLedgerApi.V1 as PlutusAPI

import           Codec.Serialise.Class (Serialise (..))
import           Control.Applicative (Alternative (..))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Aeson
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Aeson.Text as Aeson.Text
import qualified Data.Attoparsec.ByteString.Char8 as Atto
import           Data.Bifunctor (first)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Short as SB
import qualified Data.Char as Char
import           Data.Data (Data)
import           Data.Either.Combinators
import qualified Data.List as List
import           Data.Maybe (fromMaybe)
import qualified Data.Scientific as Scientific
import           Data.String (IsString)
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as Text.Lazy
import           Data.Word
import           GHC.Exts (IsList (..))

-- Original script data bytes
data HashableScriptData
  = HashableScriptData
      !BS.ByteString
      -- ^ Original 'ScriptData' bytes
      !ScriptData
  deriving (HashableScriptData -> HashableScriptData -> Bool
(HashableScriptData -> HashableScriptData -> Bool)
-> (HashableScriptData -> HashableScriptData -> Bool)
-> Eq HashableScriptData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HashableScriptData -> HashableScriptData -> Bool
== :: HashableScriptData -> HashableScriptData -> Bool
$c/= :: HashableScriptData -> HashableScriptData -> Bool
/= :: HashableScriptData -> HashableScriptData -> Bool
Eq, Int -> HashableScriptData -> ShowS
[HashableScriptData] -> ShowS
HashableScriptData -> String
(Int -> HashableScriptData -> ShowS)
-> (HashableScriptData -> String)
-> ([HashableScriptData] -> ShowS)
-> Show HashableScriptData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashableScriptData -> ShowS
showsPrec :: Int -> HashableScriptData -> ShowS
$cshow :: HashableScriptData -> String
show :: HashableScriptData -> String
$cshowList :: [HashableScriptData] -> ShowS
showList :: [HashableScriptData] -> ShowS
Show)

instance HasTypeProxy HashableScriptData where
  data AsType HashableScriptData = AsHashableScriptData
  proxyToAsType :: Proxy HashableScriptData -> AsType HashableScriptData
proxyToAsType Proxy HashableScriptData
_ = AsType HashableScriptData
AsHashableScriptData

instance SerialiseAsCBOR HashableScriptData where
  serialiseToCBOR :: HashableScriptData -> ByteString
serialiseToCBOR (HashableScriptData ByteString
origBytes ScriptData
_) = ByteString
origBytes
  deserialiseFromCBOR :: AsType HashableScriptData
-> ByteString -> Either DecoderError HashableScriptData
deserialiseFromCBOR AsType HashableScriptData
R:AsTypeHashableScriptData
AsHashableScriptData ByteString
bs =
    ByteString -> ScriptData -> HashableScriptData
HashableScriptData ByteString
bs
      (ScriptData -> HashableScriptData)
-> Either DecoderError ScriptData
-> Either DecoderError HashableScriptData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (forall s. Decoder s ScriptData)
-> ByteString
-> Either DecoderError ScriptData
forall a.
Text
-> (forall s. Decoder s a) -> ByteString -> Either DecoderError a
CBOR.decodeFullDecoder Text
"ScriptData" Decoder s ScriptData
forall s. Decoder s ScriptData
forall a s. FromCBOR a => Decoder s a
fromCBOR (ByteString -> ByteString
LBS.fromStrict ByteString
bs)

getOriginalScriptDataBytes :: HashableScriptData -> BS.ByteString
getOriginalScriptDataBytes :: HashableScriptData -> ByteString
getOriginalScriptDataBytes (HashableScriptData ByteString
bs ScriptData
_) = ByteString
bs

getScriptData :: HashableScriptData -> ScriptData
getScriptData :: HashableScriptData -> ScriptData
getScriptData (HashableScriptData ByteString
_ ScriptData
sd) = ScriptData
sd

-- | Warning: Creating 'HashableScriptData' from a 'ScriptData' value pretty
-- much guarantees the original bytes used to create the 'ScriptData'
-- value will be different if we serialize `HashableScriptData` again.
-- Do not use this.
unsafeHashableScriptData :: ScriptData -> HashableScriptData
unsafeHashableScriptData :: ScriptData -> HashableScriptData
unsafeHashableScriptData ScriptData
sd = ByteString -> ScriptData -> HashableScriptData
HashableScriptData (ScriptData -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR ScriptData
sd) ScriptData
sd

-- ----------------------------------------------------------------------------
-- Script data - Allows us to represent script data as JSON
--

data ScriptData
  = ScriptDataConstructor
      Integer
      -- ^ Tag for the constructor
      [ScriptData]
      -- ^ Constructor arguments
  | -- | Key value pairs
    ScriptDataMap [(ScriptData, ScriptData)]
  | -- | Elements
    ScriptDataList [ScriptData]
  | ScriptDataNumber Integer
  | ScriptDataBytes BS.ByteString
  deriving (ScriptData -> ScriptData -> Bool
(ScriptData -> ScriptData -> Bool)
-> (ScriptData -> ScriptData -> Bool) -> Eq ScriptData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptData -> ScriptData -> Bool
== :: ScriptData -> ScriptData -> Bool
$c/= :: ScriptData -> ScriptData -> Bool
/= :: ScriptData -> ScriptData -> Bool
Eq, Eq ScriptData
Eq ScriptData =>
(ScriptData -> ScriptData -> Ordering)
-> (ScriptData -> ScriptData -> Bool)
-> (ScriptData -> ScriptData -> Bool)
-> (ScriptData -> ScriptData -> Bool)
-> (ScriptData -> ScriptData -> Bool)
-> (ScriptData -> ScriptData -> ScriptData)
-> (ScriptData -> ScriptData -> ScriptData)
-> Ord ScriptData
ScriptData -> ScriptData -> Bool
ScriptData -> ScriptData -> Ordering
ScriptData -> ScriptData -> ScriptData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScriptData -> ScriptData -> Ordering
compare :: ScriptData -> ScriptData -> Ordering
$c< :: ScriptData -> ScriptData -> Bool
< :: ScriptData -> ScriptData -> Bool
$c<= :: ScriptData -> ScriptData -> Bool
<= :: ScriptData -> ScriptData -> Bool
$c> :: ScriptData -> ScriptData -> Bool
> :: ScriptData -> ScriptData -> Bool
$c>= :: ScriptData -> ScriptData -> Bool
>= :: ScriptData -> ScriptData -> Bool
$cmax :: ScriptData -> ScriptData -> ScriptData
max :: ScriptData -> ScriptData -> ScriptData
$cmin :: ScriptData -> ScriptData -> ScriptData
min :: ScriptData -> ScriptData -> ScriptData
Ord, Int -> ScriptData -> ShowS
[ScriptData] -> ShowS
ScriptData -> String
(Int -> ScriptData -> ShowS)
-> (ScriptData -> String)
-> ([ScriptData] -> ShowS)
-> Show ScriptData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptData -> ShowS
showsPrec :: Int -> ScriptData -> ShowS
$cshow :: ScriptData -> String
show :: ScriptData -> String
$cshowList :: [ScriptData] -> ShowS
showList :: [ScriptData] -> ShowS
Show)

-- Note the order of constructors is the same as the Plutus definitions
-- so that the Ord instance is consistent with the Plutus one.
-- This is checked by prop_ord_distributive_ScriptData

instance HasTypeProxy ScriptData where
  data AsType ScriptData = AsScriptData
  proxyToAsType :: Proxy ScriptData -> AsType ScriptData
proxyToAsType Proxy ScriptData
_ = AsType ScriptData
AsScriptData

-- ----------------------------------------------------------------------------
-- Script data hash
--

newtype instance Hash ScriptData
  = ScriptDataHash (Plutus.DataHash StandardCrypto)
  deriving stock (Hash ScriptData -> Hash ScriptData -> Bool
(Hash ScriptData -> Hash ScriptData -> Bool)
-> (Hash ScriptData -> Hash ScriptData -> Bool)
-> Eq (Hash ScriptData)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash ScriptData -> Hash ScriptData -> Bool
== :: Hash ScriptData -> Hash ScriptData -> Bool
$c/= :: Hash ScriptData -> Hash ScriptData -> Bool
/= :: Hash ScriptData -> Hash ScriptData -> Bool
Eq, Eq (Hash ScriptData)
Eq (Hash ScriptData) =>
(Hash ScriptData -> Hash ScriptData -> Ordering)
-> (Hash ScriptData -> Hash ScriptData -> Bool)
-> (Hash ScriptData -> Hash ScriptData -> Bool)
-> (Hash ScriptData -> Hash ScriptData -> Bool)
-> (Hash ScriptData -> Hash ScriptData -> Bool)
-> (Hash ScriptData -> Hash ScriptData -> Hash ScriptData)
-> (Hash ScriptData -> Hash ScriptData -> Hash ScriptData)
-> Ord (Hash ScriptData)
Hash ScriptData -> Hash ScriptData -> Bool
Hash ScriptData -> Hash ScriptData -> Ordering
Hash ScriptData -> Hash ScriptData -> Hash ScriptData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash ScriptData -> Hash ScriptData -> Ordering
compare :: Hash ScriptData -> Hash ScriptData -> Ordering
$c< :: Hash ScriptData -> Hash ScriptData -> Bool
< :: Hash ScriptData -> Hash ScriptData -> Bool
$c<= :: Hash ScriptData -> Hash ScriptData -> Bool
<= :: Hash ScriptData -> Hash ScriptData -> Bool
$c> :: Hash ScriptData -> Hash ScriptData -> Bool
> :: Hash ScriptData -> Hash ScriptData -> Bool
$c>= :: Hash ScriptData -> Hash ScriptData -> Bool
>= :: Hash ScriptData -> Hash ScriptData -> Bool
$cmax :: Hash ScriptData -> Hash ScriptData -> Hash ScriptData
max :: Hash ScriptData -> Hash ScriptData -> Hash ScriptData
$cmin :: Hash ScriptData -> Hash ScriptData -> Hash ScriptData
min :: Hash ScriptData -> Hash ScriptData -> Hash ScriptData
Ord)
  deriving (Int -> Hash ScriptData -> ShowS
[Hash ScriptData] -> ShowS
Hash ScriptData -> String
(Int -> Hash ScriptData -> ShowS)
-> (Hash ScriptData -> String)
-> ([Hash ScriptData] -> ShowS)
-> Show (Hash ScriptData)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash ScriptData -> ShowS
showsPrec :: Int -> Hash ScriptData -> ShowS
$cshow :: Hash ScriptData -> String
show :: Hash ScriptData -> String
$cshowList :: [Hash ScriptData] -> ShowS
showList :: [Hash ScriptData] -> ShowS
Show, String -> Hash ScriptData
(String -> Hash ScriptData) -> IsString (Hash ScriptData)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash ScriptData
fromString :: String -> Hash ScriptData
IsString) via UsingRawBytesHex (Hash ScriptData)
  deriving ([Hash ScriptData] -> Value
[Hash ScriptData] -> Encoding
Hash ScriptData -> Bool
Hash ScriptData -> Value
Hash ScriptData -> Encoding
(Hash ScriptData -> Value)
-> (Hash ScriptData -> Encoding)
-> ([Hash ScriptData] -> Value)
-> ([Hash ScriptData] -> Encoding)
-> (Hash ScriptData -> Bool)
-> ToJSON (Hash ScriptData)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Hash ScriptData -> Value
toJSON :: Hash ScriptData -> Value
$ctoEncoding :: Hash ScriptData -> Encoding
toEncoding :: Hash ScriptData -> Encoding
$ctoJSONList :: [Hash ScriptData] -> Value
toJSONList :: [Hash ScriptData] -> Value
$ctoEncodingList :: [Hash ScriptData] -> Encoding
toEncodingList :: [Hash ScriptData] -> Encoding
$comitField :: Hash ScriptData -> Bool
omitField :: Hash ScriptData -> Bool
ToJSON, Maybe (Hash ScriptData)
Value -> Parser [Hash ScriptData]
Value -> Parser (Hash ScriptData)
(Value -> Parser (Hash ScriptData))
-> (Value -> Parser [Hash ScriptData])
-> Maybe (Hash ScriptData)
-> FromJSON (Hash ScriptData)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser (Hash ScriptData)
parseJSON :: Value -> Parser (Hash ScriptData)
$cparseJSONList :: Value -> Parser [Hash ScriptData]
parseJSONList :: Value -> Parser [Hash ScriptData]
$comittedField :: Maybe (Hash ScriptData)
omittedField :: Maybe (Hash ScriptData)
FromJSON) via UsingRawBytesHex (Hash ScriptData)
  deriving (ToJSONKeyFunction [Hash ScriptData]
ToJSONKeyFunction (Hash ScriptData)
ToJSONKeyFunction (Hash ScriptData)
-> ToJSONKeyFunction [Hash ScriptData]
-> ToJSONKey (Hash ScriptData)
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction (Hash ScriptData)
toJSONKey :: ToJSONKeyFunction (Hash ScriptData)
$ctoJSONKeyList :: ToJSONKeyFunction [Hash ScriptData]
toJSONKeyList :: ToJSONKeyFunction [Hash ScriptData]
ToJSONKey, FromJSONKeyFunction [Hash ScriptData]
FromJSONKeyFunction (Hash ScriptData)
FromJSONKeyFunction (Hash ScriptData)
-> FromJSONKeyFunction [Hash ScriptData]
-> FromJSONKey (Hash ScriptData)
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction (Hash ScriptData)
fromJSONKey :: FromJSONKeyFunction (Hash ScriptData)
$cfromJSONKeyList :: FromJSONKeyFunction [Hash ScriptData]
fromJSONKeyList :: FromJSONKeyFunction [Hash ScriptData]
FromJSONKey) via UsingRawBytesHex (Hash ScriptData)

instance SerialiseAsRawBytes (Hash ScriptData) where
  serialiseToRawBytes :: Hash ScriptData -> ByteString
serialiseToRawBytes (ScriptDataHash DataHash StandardCrypto
dh) =
    Hash Blake2b_256 EraIndependentData -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes (DataHash StandardCrypto
-> Hash (HASH StandardCrypto) EraIndependentData
forall c i. SafeHash c i -> Hash (HASH c) i
Ledger.extractHash DataHash StandardCrypto
dh)

  deserialiseFromRawBytes :: AsType (Hash ScriptData)
-> ByteString -> Either SerialiseAsRawBytesError (Hash ScriptData)
deserialiseFromRawBytes (AsHash AsType ScriptData
R:AsTypeScriptData
AsScriptData) ByteString
bs =
    SerialiseAsRawBytesError
-> Maybe (Hash ScriptData)
-> Either SerialiseAsRawBytesError (Hash ScriptData)
forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError String
"Unable to deserialise Hash ScriptData") (Maybe (Hash ScriptData)
 -> Either SerialiseAsRawBytesError (Hash ScriptData))
-> Maybe (Hash ScriptData)
-> Either SerialiseAsRawBytesError (Hash ScriptData)
forall a b. (a -> b) -> a -> b
$
      DataHash StandardCrypto -> Hash ScriptData
ScriptDataHash (DataHash StandardCrypto -> Hash ScriptData)
-> (Hash Blake2b_256 EraIndependentData -> DataHash StandardCrypto)
-> Hash Blake2b_256 EraIndependentData
-> Hash ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 EraIndependentData -> DataHash StandardCrypto
Hash (HASH StandardCrypto) EraIndependentData
-> DataHash StandardCrypto
forall c index. Hash (HASH c) index -> SafeHash c index
Ledger.unsafeMakeSafeHash (Hash Blake2b_256 EraIndependentData -> Hash ScriptData)
-> Maybe (Hash Blake2b_256 EraIndependentData)
-> Maybe (Hash ScriptData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_256 EraIndependentData)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance SerialiseAsCBOR ScriptData where
  serialiseToCBOR :: ScriptData -> ByteString
serialiseToCBOR = ScriptData -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize'
  deserialiseFromCBOR :: AsType ScriptData -> ByteString -> Either DecoderError ScriptData
deserialiseFromCBOR AsType ScriptData
R:AsTypeScriptData
AsScriptData ByteString
bs =
    Text
-> (forall s. Decoder s ScriptData)
-> ByteString
-> Either DecoderError ScriptData
forall a.
Text
-> (forall s. Decoder s a) -> ByteString -> Either DecoderError a
CBOR.decodeFullDecoder Text
"ScriptData" Decoder s ScriptData
forall s. Decoder s ScriptData
forall a s. FromCBOR a => Decoder s a
fromCBOR (ByteString -> ByteString
LBS.fromStrict ByteString
bs)
      :: Either CBOR.DecoderError ScriptData

instance ToCBOR ScriptData where
  toCBOR :: ScriptData -> Encoding
toCBOR = forall a. Serialise a => a -> Encoding
encode @PlutusAPI.Data (Data -> Encoding)
-> (ScriptData -> Data) -> ScriptData -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptData -> Data
toPlutusData

instance FromCBOR ScriptData where
  fromCBOR :: CBOR.Decoder s ScriptData
  fromCBOR :: forall s. Decoder s ScriptData
fromCBOR = Data -> ScriptData
fromPlutusData (Data -> ScriptData) -> Decoder s Data -> Decoder s ScriptData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. Serialise a => Decoder s a
decode @PlutusAPI.Data

hashScriptDataBytes :: HashableScriptData -> Hash ScriptData
hashScriptDataBytes :: HashableScriptData -> Hash ScriptData
hashScriptDataBytes =
  DataHash StandardCrypto -> Hash ScriptData
ScriptDataHash
    (DataHash StandardCrypto -> Hash ScriptData)
-> (HashableScriptData -> DataHash StandardCrypto)
-> HashableScriptData
-> Hash ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data StandardAlonzo -> DataHash (EraCrypto StandardAlonzo)
Data StandardAlonzo -> DataHash StandardCrypto
forall era. Era era => Data era -> DataHash (EraCrypto era)
Plutus.hashData
    (Data StandardAlonzo -> DataHash StandardCrypto)
-> (HashableScriptData -> Data StandardAlonzo)
-> HashableScriptData
-> DataHash StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashableScriptData -> Data StandardAlonzo
forall ledgerera.
Era ledgerera =>
HashableScriptData -> Data ledgerera
toAlonzoData :: HashableScriptData -> Plutus.Data StandardAlonzo)

-- ----------------------------------------------------------------------------
-- Conversion functions
--

newtype ScriptBytesError = ScriptBytesError String deriving Int -> ScriptBytesError -> ShowS
[ScriptBytesError] -> ShowS
ScriptBytesError -> String
(Int -> ScriptBytesError -> ShowS)
-> (ScriptBytesError -> String)
-> ([ScriptBytesError] -> ShowS)
-> Show ScriptBytesError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptBytesError -> ShowS
showsPrec :: Int -> ScriptBytesError -> ShowS
$cshow :: ScriptBytesError -> String
show :: ScriptBytesError -> String
$cshowList :: [ScriptBytesError] -> ShowS
showList :: [ScriptBytesError] -> ShowS
Show

-- There is a subtlety here. We must use the original bytes
-- when converting to and from `HashableScriptData`/`Data`. This
-- avoids problems that arise due to reserialization of the script
-- data i.e differing script data hashes due to the re-encoding being slightly
-- different to the original encoding. See: https://github.com/input-output-hk/cardano-ledger/issues/2943

toAlonzoData :: Era ledgerera => HashableScriptData -> Plutus.Data ledgerera
toAlonzoData :: forall ledgerera.
Era ledgerera =>
HashableScriptData -> Data ledgerera
toAlonzoData =
  (ScriptBytesError -> Data ledgerera)
-> (BinaryData ledgerera -> Data ledgerera)
-> Either ScriptBytesError (BinaryData ledgerera)
-> Data ledgerera
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\ScriptBytesError
e -> String -> Data ledgerera
forall a. HasCallStack => String -> a
error (String -> Data ledgerera) -> String -> Data ledgerera
forall a b. (a -> b) -> a -> b
$ String
"toAlonzoData: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ScriptBytesError -> String
forall a. Show a => a -> String
show ScriptBytesError
e)
    BinaryData ledgerera -> Data ledgerera
forall era. Era era => BinaryData era -> Data era
Plutus.binaryDataToData
    (Either ScriptBytesError (BinaryData ledgerera) -> Data ledgerera)
-> (HashableScriptData
    -> Either ScriptBytesError (BinaryData ledgerera))
-> HashableScriptData
-> Data ledgerera
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ScriptBytesError)
-> Either String (BinaryData ledgerera)
-> Either ScriptBytesError (BinaryData ledgerera)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> ScriptBytesError
ScriptBytesError
    (Either String (BinaryData ledgerera)
 -> Either ScriptBytesError (BinaryData ledgerera))
-> (HashableScriptData -> Either String (BinaryData ledgerera))
-> HashableScriptData
-> Either ScriptBytesError (BinaryData ledgerera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Either String (BinaryData ledgerera)
forall era.
Era era =>
ShortByteString -> Either String (BinaryData era)
Plutus.makeBinaryData
    (ShortByteString -> Either String (BinaryData ledgerera))
-> (HashableScriptData -> ShortByteString)
-> HashableScriptData
-> Either String (BinaryData ledgerera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SB.toShort
    (ByteString -> ShortByteString)
-> (HashableScriptData -> ByteString)
-> HashableScriptData
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashableScriptData -> ByteString
getOriginalScriptDataBytes

fromAlonzoData :: Plutus.Data ledgerera -> HashableScriptData
fromAlonzoData :: forall ledgerera. Data ledgerera -> HashableScriptData
fromAlonzoData Data ledgerera
d =
  ByteString -> ScriptData -> HashableScriptData
HashableScriptData
    (Data ledgerera -> ByteString
forall t. SafeToHash t => t -> ByteString
Ledger.originalBytes Data ledgerera
d)
    (Data -> ScriptData
fromPlutusData (Data -> ScriptData) -> Data -> ScriptData
forall a b. (a -> b) -> a -> b
$ Data ledgerera -> Data
forall era. Data era -> Data
Plutus.getPlutusData Data ledgerera
d)

toPlutusData :: ScriptData -> PlutusAPI.Data
toPlutusData :: ScriptData -> Data
toPlutusData (ScriptDataConstructor Integer
int [ScriptData]
xs) =
  Integer -> [Data] -> Data
PlutusAPI.Constr
    Integer
int
    [ScriptData -> Data
toPlutusData ScriptData
x | ScriptData
x <- [ScriptData]
xs]
toPlutusData (ScriptDataMap [(ScriptData, ScriptData)]
kvs) =
  [(Data, Data)] -> Data
PlutusAPI.Map
    [ (ScriptData -> Data
toPlutusData ScriptData
k, ScriptData -> Data
toPlutusData ScriptData
v)
    | (ScriptData
k, ScriptData
v) <- [(ScriptData, ScriptData)]
kvs
    ]
toPlutusData (ScriptDataList [ScriptData]
xs) =
  [Data] -> Data
PlutusAPI.List
    [ScriptData -> Data
toPlutusData ScriptData
x | ScriptData
x <- [ScriptData]
xs]
toPlutusData (ScriptDataNumber Integer
n) = Integer -> Data
PlutusAPI.I Integer
n
toPlutusData (ScriptDataBytes ByteString
bs) = ByteString -> Data
PlutusAPI.B ByteString
bs

fromPlutusData :: PlutusAPI.Data -> ScriptData
fromPlutusData :: Data -> ScriptData
fromPlutusData (PlutusAPI.Constr Integer
int [Data]
xs) =
  Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor
    Integer
int
    [Data -> ScriptData
fromPlutusData Data
x | Data
x <- [Data]
xs]
fromPlutusData (PlutusAPI.Map [(Data, Data)]
kvs) =
  [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap
    [ (Data -> ScriptData
fromPlutusData Data
k, Data -> ScriptData
fromPlutusData Data
v)
    | (Data
k, Data
v) <- [(Data, Data)]
kvs
    ]
fromPlutusData (PlutusAPI.List [Data]
xs) =
  [ScriptData] -> ScriptData
ScriptDataList
    [Data -> ScriptData
fromPlutusData Data
x | Data
x <- [Data]
xs]
fromPlutusData (PlutusAPI.I Integer
n) = Integer -> ScriptData
ScriptDataNumber Integer
n
fromPlutusData (PlutusAPI.B ByteString
bs) = ByteString -> ScriptData
ScriptDataBytes ByteString
bs

-- ----------------------------------------------------------------------------
-- Validate script data
--

-- | Validate script data. This is for use with existing constructed script
-- data values, e.g. constructed manually or decoded from CBOR directly.
validateScriptData :: ScriptData -> Either ScriptDataRangeError ()
validateScriptData :: ScriptData -> Either ScriptDataRangeError ()
validateScriptData ScriptData
d =
  case ScriptData -> [ScriptDataRangeError]
collect ScriptData
d of
    [] -> () -> Either ScriptDataRangeError ()
forall a b. b -> Either a b
Right ()
    ScriptDataRangeError
err : [ScriptDataRangeError]
_ -> ScriptDataRangeError -> Either ScriptDataRangeError ()
forall a b. a -> Either a b
Left ScriptDataRangeError
err
 where
  -- Arbitrary size numbers are fine
  collect :: ScriptData -> [ScriptDataRangeError]
collect (ScriptDataNumber Integer
_) = []
  -- Arbitrary sized bytes are fine
  collect (ScriptDataBytes ByteString
_) = []
  collect (ScriptDataList [ScriptData]
xs) =
    (ScriptData -> [ScriptDataRangeError])
-> [ScriptData] -> [ScriptDataRangeError]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ScriptData -> [ScriptDataRangeError]
collect [ScriptData]
xs
  collect (ScriptDataMap [(ScriptData, ScriptData)]
kvs) =
    ((ScriptData, ScriptData) -> [ScriptDataRangeError])
-> [(ScriptData, ScriptData)] -> [ScriptDataRangeError]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
      ( \(ScriptData
k, ScriptData
v) ->
          ScriptData -> [ScriptDataRangeError]
collect ScriptData
k
            [ScriptDataRangeError]
-> [ScriptDataRangeError] -> [ScriptDataRangeError]
forall a. Semigroup a => a -> a -> a
<> ScriptData -> [ScriptDataRangeError]
collect ScriptData
v
      )
      [(ScriptData, ScriptData)]
kvs
  -- Constr tags do need to be less than a Word64
  collect (ScriptDataConstructor Integer
n [ScriptData]
xs) =
    [ Integer -> ScriptDataRangeError
ScriptDataConstructorOutOfRange Integer
n
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) Bool -> Bool -> Bool
|| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
    ]
      [ScriptDataRangeError]
-> [ScriptDataRangeError] -> [ScriptDataRangeError]
forall a. Semigroup a => a -> a -> a
<> (ScriptData -> [ScriptDataRangeError])
-> [ScriptData] -> [ScriptDataRangeError]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ScriptData -> [ScriptDataRangeError]
collect [ScriptData]
xs

-- | An error in script data due to an out-of-range value.
newtype ScriptDataRangeError
  = -- | The constructor number is outside the maximum range of @-2^64-1 .. 2^64-1@.
    ScriptDataConstructorOutOfRange Integer
  deriving (ScriptDataRangeError -> ScriptDataRangeError -> Bool
(ScriptDataRangeError -> ScriptDataRangeError -> Bool)
-> (ScriptDataRangeError -> ScriptDataRangeError -> Bool)
-> Eq ScriptDataRangeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptDataRangeError -> ScriptDataRangeError -> Bool
== :: ScriptDataRangeError -> ScriptDataRangeError -> Bool
$c/= :: ScriptDataRangeError -> ScriptDataRangeError -> Bool
/= :: ScriptDataRangeError -> ScriptDataRangeError -> Bool
Eq, Int -> ScriptDataRangeError -> ShowS
[ScriptDataRangeError] -> ShowS
ScriptDataRangeError -> String
(Int -> ScriptDataRangeError -> ShowS)
-> (ScriptDataRangeError -> String)
-> ([ScriptDataRangeError] -> ShowS)
-> Show ScriptDataRangeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptDataRangeError -> ShowS
showsPrec :: Int -> ScriptDataRangeError -> ShowS
$cshow :: ScriptDataRangeError -> String
show :: ScriptDataRangeError -> String
$cshowList :: [ScriptDataRangeError] -> ShowS
showList :: [ScriptDataRangeError] -> ShowS
Show, Typeable ScriptDataRangeError
Typeable ScriptDataRangeError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ScriptDataRangeError
 -> c ScriptDataRangeError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ScriptDataRangeError)
-> (ScriptDataRangeError -> Constr)
-> (ScriptDataRangeError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ScriptDataRangeError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ScriptDataRangeError))
-> ((forall b. Data b => b -> b)
    -> ScriptDataRangeError -> ScriptDataRangeError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ScriptDataRangeError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ScriptDataRangeError -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ScriptDataRangeError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ScriptDataRangeError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataRangeError -> m ScriptDataRangeError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataRangeError -> m ScriptDataRangeError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataRangeError -> m ScriptDataRangeError)
-> Data ScriptDataRangeError
ScriptDataRangeError -> Constr
ScriptDataRangeError -> DataType
(forall b. Data b => b -> b)
-> ScriptDataRangeError -> ScriptDataRangeError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ScriptDataRangeError -> u
forall u.
(forall d. Data d => d -> u) -> ScriptDataRangeError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataRangeError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataRangeError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataRangeError -> m ScriptDataRangeError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataRangeError -> m ScriptDataRangeError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataRangeError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataRangeError
-> c ScriptDataRangeError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScriptDataRangeError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataRangeError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataRangeError
-> c ScriptDataRangeError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataRangeError
-> c ScriptDataRangeError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataRangeError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataRangeError
$ctoConstr :: ScriptDataRangeError -> Constr
toConstr :: ScriptDataRangeError -> Constr
$cdataTypeOf :: ScriptDataRangeError -> DataType
dataTypeOf :: ScriptDataRangeError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScriptDataRangeError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScriptDataRangeError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataRangeError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataRangeError)
$cgmapT :: (forall b. Data b => b -> b)
-> ScriptDataRangeError -> ScriptDataRangeError
gmapT :: (forall b. Data b => b -> b)
-> ScriptDataRangeError -> ScriptDataRangeError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataRangeError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataRangeError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataRangeError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataRangeError -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ScriptDataRangeError -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ScriptDataRangeError -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ScriptDataRangeError -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ScriptDataRangeError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataRangeError -> m ScriptDataRangeError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataRangeError -> m ScriptDataRangeError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataRangeError -> m ScriptDataRangeError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataRangeError -> m ScriptDataRangeError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataRangeError -> m ScriptDataRangeError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataRangeError -> m ScriptDataRangeError
Data)

instance Error ScriptDataRangeError where
  prettyError :: forall ann. ScriptDataRangeError -> Doc ann
prettyError (ScriptDataConstructorOutOfRange Integer
n) =
    [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
      [ Doc ann
"Constructor numbers in script data value "
      , Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
n
      , Doc ann
" is outside the range 0 .. 2^64-1."
      ]

-- ----------------------------------------------------------------------------
-- JSON conversion
--

-- | Script data is similar to JSON but not exactly the same. It has some
-- deliberate limitations such as no support for floating point numbers or
-- special forms for null or boolean values. It also has limitations on the
-- length of strings. On the other hand, unlike JSON, it distinguishes between
-- byte strings and text strings. It also supports any value as map keys rather
-- than just string. It also supports alternatives \/ tagged unions, used for
-- representing constructors for Plutus data values.
--
-- We provide two different mappings between script data and JSON, useful
-- for different purposes:
--
-- 1. A mapping that allows almost any JSON value to be converted into script
--    data. This does not require a specific JSON schema for the input. It does
--    not expose the full representation capability of script data.
--
-- 2. A mapping that exposes the full representation capability of script data,
--    but relies on a specific JSON schema for the input JSON.
--
-- In the \"no schema"\ mapping, the idea is that (almost) any JSON can be
-- turned into script data and then converted back, without loss. That is, we
-- can round-trip the JSON.
--
-- The subset of JSON supported is all JSON except:
-- * No null or bool values
-- * No floating point, only integers in the range of a 64bit signed integer
-- * A limitation on string lengths
--
-- The approach for this mapping is to use whichever representation as script
-- data is most compact. In particular:
--
-- * JSON lists and maps represented as CBOR lists and maps
-- * JSON strings represented as CBOR strings
-- * JSON hex strings with \"0x\" prefix represented as CBOR byte strings
-- * JSON integer numbers represented as CBOR signed or unsigned numbers
-- * JSON maps with string keys that parse as numbers or hex byte strings,
--   represented as CBOR map keys that are actually numbers or byte strings.
--
-- The string length limit depends on whether the hex string representation
-- is used or not. For text strings the limit is 64 bytes for the UTF8
-- representation of the text string. For byte strings the limit is 64 bytes
-- for the raw byte form (ie not the input hex, but after hex decoding).
--
-- In the \"detailed schema\" mapping, the idea is that we expose the full
-- representation capability of the script data in the form of a JSON schema.
-- This means the full representation is available and can be controlled
-- precisely. It also means any script data can be converted into the JSON and
-- back without loss. That is we can round-trip the script data via the JSON and
-- also round-trip schema-compliant JSON via script data.
data ScriptDataJsonSchema
  = -- | Use the \"no schema\" mapping between JSON and script data as
    -- described above.
    ScriptDataJsonNoSchema
  | -- | Use the \"detailed schema\" mapping between JSON and script data as
    -- described above.
    ScriptDataJsonDetailedSchema
  deriving (ScriptDataJsonSchema -> ScriptDataJsonSchema -> Bool
(ScriptDataJsonSchema -> ScriptDataJsonSchema -> Bool)
-> (ScriptDataJsonSchema -> ScriptDataJsonSchema -> Bool)
-> Eq ScriptDataJsonSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptDataJsonSchema -> ScriptDataJsonSchema -> Bool
== :: ScriptDataJsonSchema -> ScriptDataJsonSchema -> Bool
$c/= :: ScriptDataJsonSchema -> ScriptDataJsonSchema -> Bool
/= :: ScriptDataJsonSchema -> ScriptDataJsonSchema -> Bool
Eq, Int -> ScriptDataJsonSchema -> ShowS
[ScriptDataJsonSchema] -> ShowS
ScriptDataJsonSchema -> String
(Int -> ScriptDataJsonSchema -> ShowS)
-> (ScriptDataJsonSchema -> String)
-> ([ScriptDataJsonSchema] -> ShowS)
-> Show ScriptDataJsonSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptDataJsonSchema -> ShowS
showsPrec :: Int -> ScriptDataJsonSchema -> ShowS
$cshow :: ScriptDataJsonSchema -> String
show :: ScriptDataJsonSchema -> String
$cshowList :: [ScriptDataJsonSchema] -> ShowS
showList :: [ScriptDataJsonSchema] -> ShowS
Show)

-- | Convert a value from JSON into script data, using the given choice of
-- mapping between JSON and script data.
--
-- This may fail with a conversion error if the JSON is outside the supported
-- subset for the chosen mapping. See 'ScriptDataJsonSchema' for the details.
scriptDataFromJson
  :: ScriptDataJsonSchema
  -> Aeson.Value
  -> Either ScriptDataJsonError HashableScriptData
scriptDataFromJson :: ScriptDataJsonSchema
-> Value -> Either ScriptDataJsonError HashableScriptData
scriptDataFromJson ScriptDataJsonSchema
schema Value
v = do
  HashableScriptData
d <- (ScriptDataJsonSchemaError -> ScriptDataJsonError)
-> Either ScriptDataJsonSchemaError HashableScriptData
-> Either ScriptDataJsonError HashableScriptData
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Value -> ScriptDataJsonSchemaError -> ScriptDataJsonError
ScriptDataJsonSchemaError Value
v) (Value -> Either ScriptDataJsonSchemaError HashableScriptData
scriptDataFromJson' Value
v)
  (ScriptDataRangeError -> ScriptDataJsonError)
-> Either ScriptDataRangeError () -> Either ScriptDataJsonError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Value -> ScriptDataRangeError -> ScriptDataJsonError
ScriptDataRangeError Value
v) (ScriptData -> Either ScriptDataRangeError ()
validateScriptData (ScriptData -> Either ScriptDataRangeError ())
-> ScriptData -> Either ScriptDataRangeError ()
forall a b. (a -> b) -> a -> b
$ HashableScriptData -> ScriptData
getScriptData HashableScriptData
d)
  HashableScriptData -> Either ScriptDataJsonError HashableScriptData
forall a. a -> Either ScriptDataJsonError a
forall (m :: * -> *) a. Monad m => a -> m a
return HashableScriptData
d
 where
  scriptDataFromJson' :: Value -> Either ScriptDataJsonSchemaError HashableScriptData
scriptDataFromJson' =
    case ScriptDataJsonSchema
schema of
      ScriptDataJsonSchema
ScriptDataJsonNoSchema -> Value -> Either ScriptDataJsonSchemaError HashableScriptData
scriptDataFromJsonNoSchema
      ScriptDataJsonSchema
ScriptDataJsonDetailedSchema -> Value -> Either ScriptDataJsonSchemaError HashableScriptData
scriptDataFromJsonDetailedSchema

-- | Convert a script data value into JSON , using the given choice of mapping
-- between JSON and script data.
--
-- This conversion is total but is not necessarily invertible.
-- See 'ScriptDataJsonSchema' for the details.
scriptDataToJson
  :: ScriptDataJsonSchema
  -> HashableScriptData
  -> Aeson.Value
scriptDataToJson :: ScriptDataJsonSchema -> HashableScriptData -> Value
scriptDataToJson ScriptDataJsonSchema
schema =
  case ScriptDataJsonSchema
schema of
    ScriptDataJsonSchema
ScriptDataJsonNoSchema -> HashableScriptData -> Value
scriptDataToJsonNoSchema
    ScriptDataJsonSchema
ScriptDataJsonDetailedSchema -> HashableScriptData -> Value
scriptDataToJsonDetailedSchema

-- ----------------------------------------------------------------------------
-- JSON conversion using the the "no schema" style
--

scriptDataToJsonNoSchema :: HashableScriptData -> Aeson.Value
scriptDataToJsonNoSchema :: HashableScriptData -> Value
scriptDataToJsonNoSchema = ScriptData -> Value
conv (ScriptData -> Value)
-> (HashableScriptData -> ScriptData)
-> HashableScriptData
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashableScriptData -> ScriptData
getScriptData
 where
  conv :: ScriptData -> Aeson.Value
  conv :: ScriptData -> Value
conv (ScriptDataNumber Integer
n) = Scientific -> Value
Aeson.Number (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger Integer
n)
  conv (ScriptDataBytes ByteString
bs)
    | Right Text
s <- ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
bs
    , (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
Char.isPrint Text
s =
        Text -> Value
Aeson.String Text
s
    | Bool
otherwise =
        Text -> Value
Aeson.String (Text
bytesPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeLatin1 (ByteString -> ByteString
Base16.encode ByteString
bs))
  conv (ScriptDataList [ScriptData]
vs) = Array -> Value
Aeson.Array ([Item Array] -> Array
forall l. IsList l => [Item l] -> l
fromList ((ScriptData -> Value) -> [ScriptData] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> Value
conv [ScriptData]
vs))
  conv (ScriptDataMap [(ScriptData, ScriptData)]
kvs) =
    [(Key, Value)] -> Value
Aeson.object
      [ (ScriptData -> Key
convKey ScriptData
k, ScriptData -> Value
conv ScriptData
v)
      | (ScriptData
k, ScriptData
v) <- [(ScriptData, ScriptData)]
kvs
      ]
  conv (ScriptDataConstructor Integer
n [ScriptData]
vs) =
    Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$
      [Item Array] -> Array
forall l. IsList l => [Item l] -> l
fromList
        [ Scientific -> Value
Aeson.Number (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger Integer
n)
        , Array -> Value
Aeson.Array ([Item Array] -> Array
forall l. IsList l => [Item l] -> l
fromList ((ScriptData -> Value) -> [ScriptData] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> Value
conv [ScriptData]
vs))
        ]

  -- Script data allows any value as a key, not just string as JSON does.
  -- For simple types we just convert them to string directly.
  -- For structured keys we render them as JSON and use that as the string.
  convKey :: ScriptData -> Aeson.Key
  convKey :: ScriptData -> Key
convKey (ScriptDataNumber Integer
n) = Text -> Key
Aeson.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (Integer -> String
forall a. Show a => a -> String
show Integer
n)
  convKey (ScriptDataBytes ByteString
bs) =
    Text -> Key
Aeson.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$
      Text
bytesPrefix
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeLatin1 (ByteString -> ByteString
Base16.encode ByteString
bs)
  convKey ScriptData
v =
    Text -> Key
Aeson.fromText
      (Text -> Key) -> (ScriptData -> Text) -> ScriptData -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyText -> Text
Text.Lazy.toStrict
      (LazyText -> Text)
-> (ScriptData -> LazyText) -> ScriptData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> LazyText
forall a. ToJSON a => a -> LazyText
Aeson.Text.encodeToLazyText
      (Value -> LazyText)
-> (ScriptData -> Value) -> ScriptData -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptData -> Value
conv
      (ScriptData -> Key) -> ScriptData -> Key
forall a b. (a -> b) -> a -> b
$ ScriptData
v

scriptDataFromJsonNoSchema
  :: Aeson.Value
  -> Either
      ScriptDataJsonSchemaError
      HashableScriptData
scriptDataFromJsonNoSchema :: Value -> Either ScriptDataJsonSchemaError HashableScriptData
scriptDataFromJsonNoSchema = (ScriptData -> HashableScriptData)
-> Either ScriptDataJsonSchemaError ScriptData
-> Either ScriptDataJsonSchemaError HashableScriptData
forall a b.
(a -> b)
-> Either ScriptDataJsonSchemaError a
-> Either ScriptDataJsonSchemaError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ScriptData
sd -> ByteString -> ScriptData -> HashableScriptData
HashableScriptData (ScriptData -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR ScriptData
sd) ScriptData
sd) (Either ScriptDataJsonSchemaError ScriptData
 -> Either ScriptDataJsonSchemaError HashableScriptData)
-> (Value -> Either ScriptDataJsonSchemaError ScriptData)
-> Value
-> Either ScriptDataJsonSchemaError HashableScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either ScriptDataJsonSchemaError ScriptData
conv
 where
  conv
    :: Aeson.Value
    -> Either ScriptDataJsonSchemaError ScriptData
  conv :: Value -> Either ScriptDataJsonSchemaError ScriptData
conv Value
Aeson.Null = ScriptDataJsonSchemaError
-> Either ScriptDataJsonSchemaError ScriptData
forall a b. a -> Either a b
Left ScriptDataJsonSchemaError
ScriptDataJsonNullNotAllowed
  conv Aeson.Bool{} = ScriptDataJsonSchemaError
-> Either ScriptDataJsonSchemaError ScriptData
forall a b. a -> Either a b
Left ScriptDataJsonSchemaError
ScriptDataJsonBoolNotAllowed
  conv (Aeson.Number Scientific
d) =
    case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
d :: Either Double Integer of
      Left Double
n -> ScriptDataJsonSchemaError
-> Either ScriptDataJsonSchemaError ScriptData
forall a b. a -> Either a b
Left (Double -> ScriptDataJsonSchemaError
ScriptDataJsonNumberNotInteger Double
n)
      Right Integer
n -> ScriptData -> Either ScriptDataJsonSchemaError ScriptData
forall a b. b -> Either a b
Right (Integer -> ScriptData
ScriptDataNumber Integer
n)
  conv (Aeson.String Text
s)
    | Just Text
s' <- Text -> Text -> Maybe Text
Text.stripPrefix Text
bytesPrefix Text
s
    , let bs' :: ByteString
bs' = Text -> ByteString
Text.encodeUtf8 Text
s'
    , Right ByteString
bs <- ByteString -> Either String ByteString
Base16.decode ByteString
bs'
    , Bool -> Bool
not ((Char -> Bool) -> ByteString -> Bool
BSC.any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F') ByteString
bs') =
        ScriptData -> Either ScriptDataJsonSchemaError ScriptData
forall a b. b -> Either a b
Right (ByteString -> ScriptData
ScriptDataBytes ByteString
bs)
    | Bool
otherwise =
        ScriptData -> Either ScriptDataJsonSchemaError ScriptData
forall a b. b -> Either a b
Right (ByteString -> ScriptData
ScriptDataBytes (Text -> ByteString
Text.encodeUtf8 Text
s))
  conv (Aeson.Array Array
vs) =
    ([ScriptData] -> ScriptData)
-> Either ScriptDataJsonSchemaError [ScriptData]
-> Either ScriptDataJsonSchemaError ScriptData
forall a b.
(a -> b)
-> Either ScriptDataJsonSchemaError a
-> Either ScriptDataJsonSchemaError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ScriptData] -> ScriptData
ScriptDataList
      (Either ScriptDataJsonSchemaError [ScriptData]
 -> Either ScriptDataJsonSchemaError ScriptData)
-> ([Value] -> Either ScriptDataJsonSchemaError [ScriptData])
-> [Value]
-> Either ScriptDataJsonSchemaError ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Either ScriptDataJsonSchemaError ScriptData)
-> [Value] -> Either ScriptDataJsonSchemaError [ScriptData]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> Either ScriptDataJsonSchemaError ScriptData
conv
      ([Value] -> Either ScriptDataJsonSchemaError ScriptData)
-> [Value] -> Either ScriptDataJsonSchemaError ScriptData
forall a b. (a -> b) -> a -> b
$ Array -> [Item Array]
forall l. IsList l => l -> [Item l]
toList Array
vs
  conv (Aeson.Object Object
kvs) =
    ([(ScriptData, ScriptData)] -> ScriptData)
-> Either ScriptDataJsonSchemaError [(ScriptData, ScriptData)]
-> Either ScriptDataJsonSchemaError ScriptData
forall a b.
(a -> b)
-> Either ScriptDataJsonSchemaError a
-> Either ScriptDataJsonSchemaError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap
      (Either ScriptDataJsonSchemaError [(ScriptData, ScriptData)]
 -> Either ScriptDataJsonSchemaError ScriptData)
-> ([(Key, Value)]
    -> Either ScriptDataJsonSchemaError [(ScriptData, ScriptData)])
-> [(Key, Value)]
-> Either ScriptDataJsonSchemaError ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value)
 -> Either ScriptDataJsonSchemaError (ScriptData, ScriptData))
-> [(Text, Value)]
-> Either ScriptDataJsonSchemaError [(ScriptData, ScriptData)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(Text
k, Value
v) -> (,) (Text -> ScriptData
convKey Text
k) (ScriptData -> (ScriptData, ScriptData))
-> Either ScriptDataJsonSchemaError ScriptData
-> Either ScriptDataJsonSchemaError (ScriptData, ScriptData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either ScriptDataJsonSchemaError ScriptData
conv Value
v)
      ([(Text, Value)]
 -> Either ScriptDataJsonSchemaError [(ScriptData, ScriptData)])
-> ([(Key, Value)] -> [(Text, Value)])
-> [(Key, Value)]
-> Either ScriptDataJsonSchemaError [(ScriptData, ScriptData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value) -> Text) -> [(Text, Value)] -> [(Text, Value)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Text, Value) -> Text
forall a b. (a, b) -> a
fst
      ([(Text, Value)] -> [(Text, Value)])
-> ([(Key, Value)] -> [(Text, Value)])
-> [(Key, Value)]
-> [(Text, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, Value) -> (Text, Value))
-> [(Key, Value)] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key -> Text) -> (Key, Value) -> (Text, Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
Aeson.toText)
      ([(Key, Value)] -> Either ScriptDataJsonSchemaError ScriptData)
-> [(Key, Value)] -> Either ScriptDataJsonSchemaError ScriptData
forall a b. (a -> b) -> a -> b
$ Object -> [Item Object]
forall l. IsList l => l -> [Item l]
toList Object
kvs

  convKey :: Text -> ScriptData
  convKey :: Text -> ScriptData
convKey Text
s =
    ScriptData -> Maybe ScriptData -> ScriptData
forall a. a -> Maybe a -> a
fromMaybe (ByteString -> ScriptData
ScriptDataBytes (Text -> ByteString
Text.encodeUtf8 Text
s)) (Maybe ScriptData -> ScriptData) -> Maybe ScriptData -> ScriptData
forall a b. (a -> b) -> a -> b
$
      Parser ScriptData -> Text -> Maybe ScriptData
forall a. Parser a -> Text -> Maybe a
parseAll
        ( ((Integer -> ScriptData)
-> Parser ByteString Integer -> Parser ScriptData
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> ScriptData
ScriptDataNumber Parser ByteString Integer
pSigned Parser ScriptData -> Parser ByteString () -> Parser ScriptData
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
Atto.endOfInput)
            Parser ScriptData -> Parser ScriptData -> Parser ScriptData
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((ByteString -> ScriptData)
-> Parser ByteString ByteString -> Parser ScriptData
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ScriptData
ScriptDataBytes Parser ByteString ByteString
pBytes Parser ScriptData -> Parser ByteString () -> Parser ScriptData
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
Atto.endOfInput)
        )
        Text
s

-- | JSON strings that are base16 encoded and prefixed with 'bytesPrefix' will
-- be encoded as CBOR bytestrings.
bytesPrefix :: Text
bytesPrefix :: Text
bytesPrefix = Text
"0x"

data ScriptDataJsonBytesError
  = ScriptDataJsonBytesErrorValue ScriptDataJsonError
  | ScriptDataJsonBytesErrorInvalid ScriptDataRangeError
  deriving (Int -> ScriptDataJsonBytesError -> ShowS
[ScriptDataJsonBytesError] -> ShowS
ScriptDataJsonBytesError -> String
(Int -> ScriptDataJsonBytesError -> ShowS)
-> (ScriptDataJsonBytesError -> String)
-> ([ScriptDataJsonBytesError] -> ShowS)
-> Show ScriptDataJsonBytesError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptDataJsonBytesError -> ShowS
showsPrec :: Int -> ScriptDataJsonBytesError -> ShowS
$cshow :: ScriptDataJsonBytesError -> String
show :: ScriptDataJsonBytesError -> String
$cshowList :: [ScriptDataJsonBytesError] -> ShowS
showList :: [ScriptDataJsonBytesError] -> ShowS
Show, Typeable ScriptDataJsonBytesError
Typeable ScriptDataJsonBytesError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ScriptDataJsonBytesError
 -> c ScriptDataJsonBytesError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ScriptDataJsonBytesError)
-> (ScriptDataJsonBytesError -> Constr)
-> (ScriptDataJsonBytesError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ScriptDataJsonBytesError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ScriptDataJsonBytesError))
-> ((forall b. Data b => b -> b)
    -> ScriptDataJsonBytesError -> ScriptDataJsonBytesError)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ScriptDataJsonBytesError
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ScriptDataJsonBytesError
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ScriptDataJsonBytesError -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> ScriptDataJsonBytesError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataJsonBytesError -> m ScriptDataJsonBytesError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataJsonBytesError -> m ScriptDataJsonBytesError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataJsonBytesError -> m ScriptDataJsonBytesError)
-> Data ScriptDataJsonBytesError
ScriptDataJsonBytesError -> Constr
ScriptDataJsonBytesError -> DataType
(forall b. Data b => b -> b)
-> ScriptDataJsonBytesError -> ScriptDataJsonBytesError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> ScriptDataJsonBytesError -> u
forall u.
(forall d. Data d => d -> u) -> ScriptDataJsonBytesError -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonBytesError
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonBytesError
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonBytesError -> m ScriptDataJsonBytesError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonBytesError -> m ScriptDataJsonBytesError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataJsonBytesError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataJsonBytesError
-> c ScriptDataJsonBytesError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScriptDataJsonBytesError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataJsonBytesError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataJsonBytesError
-> c ScriptDataJsonBytesError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataJsonBytesError
-> c ScriptDataJsonBytesError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataJsonBytesError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataJsonBytesError
$ctoConstr :: ScriptDataJsonBytesError -> Constr
toConstr :: ScriptDataJsonBytesError -> Constr
$cdataTypeOf :: ScriptDataJsonBytesError -> DataType
dataTypeOf :: ScriptDataJsonBytesError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScriptDataJsonBytesError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScriptDataJsonBytesError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataJsonBytesError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataJsonBytesError)
$cgmapT :: (forall b. Data b => b -> b)
-> ScriptDataJsonBytesError -> ScriptDataJsonBytesError
gmapT :: (forall b. Data b => b -> b)
-> ScriptDataJsonBytesError -> ScriptDataJsonBytesError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonBytesError
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonBytesError
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonBytesError
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonBytesError
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ScriptDataJsonBytesError -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ScriptDataJsonBytesError -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ScriptDataJsonBytesError -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ScriptDataJsonBytesError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonBytesError -> m ScriptDataJsonBytesError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonBytesError -> m ScriptDataJsonBytesError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonBytesError -> m ScriptDataJsonBytesError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonBytesError -> m ScriptDataJsonBytesError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonBytesError -> m ScriptDataJsonBytesError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonBytesError -> m ScriptDataJsonBytesError
Data)

instance Error ScriptDataJsonBytesError where
  prettyError :: forall ann. ScriptDataJsonBytesError -> Doc ann
prettyError (ScriptDataJsonBytesErrorValue ScriptDataJsonError
e) =
    Doc ann
"Error decoding ScriptData JSON value: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptDataJsonError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. ScriptDataJsonError -> Doc ann
prettyError ScriptDataJsonError
e
  prettyError (ScriptDataJsonBytesErrorInvalid ScriptDataRangeError
e) =
    Doc ann
"ScriptData is invalid: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptDataRangeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. ScriptDataRangeError -> Doc ann
prettyError ScriptDataRangeError
e

-- | This allows us to take JSON formatted ScriptData and encode it in the CDDL format
-- whilst preserving the original bytes.
scriptDataJsonToHashable
  :: ScriptDataJsonSchema
  -> Aeson.Value
  -- ^ ScriptData Value
  -> Either ScriptDataJsonBytesError HashableScriptData
scriptDataJsonToHashable :: ScriptDataJsonSchema
-> Value -> Either ScriptDataJsonBytesError HashableScriptData
scriptDataJsonToHashable ScriptDataJsonSchema
schema Value
scriptDataVal = do
  HashableScriptData
sData <- (ScriptDataJsonError -> ScriptDataJsonBytesError)
-> Either ScriptDataJsonError HashableScriptData
-> Either ScriptDataJsonBytesError HashableScriptData
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ScriptDataJsonError -> ScriptDataJsonBytesError
ScriptDataJsonBytesErrorValue (Either ScriptDataJsonError HashableScriptData
 -> Either ScriptDataJsonBytesError HashableScriptData)
-> Either ScriptDataJsonError HashableScriptData
-> Either ScriptDataJsonBytesError HashableScriptData
forall a b. (a -> b) -> a -> b
$ ScriptDataJsonSchema
-> Value -> Either ScriptDataJsonError HashableScriptData
scriptDataFromJson ScriptDataJsonSchema
schema Value
scriptDataVal
  (ScriptDataRangeError -> ScriptDataJsonBytesError)
-> Either ScriptDataRangeError ()
-> Either ScriptDataJsonBytesError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ScriptDataRangeError -> ScriptDataJsonBytesError
ScriptDataJsonBytesErrorInvalid (Either ScriptDataRangeError ()
 -> Either ScriptDataJsonBytesError ())
-> Either ScriptDataRangeError ()
-> Either ScriptDataJsonBytesError ()
forall a b. (a -> b) -> a -> b
$ ScriptData -> Either ScriptDataRangeError ()
validateScriptData (ScriptData -> Either ScriptDataRangeError ())
-> ScriptData -> Either ScriptDataRangeError ()
forall a b. (a -> b) -> a -> b
$ HashableScriptData -> ScriptData
getScriptData HashableScriptData
sData
  HashableScriptData
-> Either ScriptDataJsonBytesError HashableScriptData
forall a. a -> Either ScriptDataJsonBytesError a
forall (m :: * -> *) a. Monad m => a -> m a
return HashableScriptData
sData

-- ----------------------------------------------------------------------------
-- JSON conversion using the "detailed schema" style
--

scriptDataToJsonDetailedSchema :: HashableScriptData -> Aeson.Value
scriptDataToJsonDetailedSchema :: HashableScriptData -> Value
scriptDataToJsonDetailedSchema = ScriptData -> Value
conv (ScriptData -> Value)
-> (HashableScriptData -> ScriptData)
-> HashableScriptData
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashableScriptData -> ScriptData
getScriptData
 where
  conv :: ScriptData -> Aeson.Value
  conv :: ScriptData -> Value
conv (ScriptDataNumber Integer
n) =
    Key -> Value -> Value
singleFieldObject Key
"int"
      (Value -> Value) -> (Scientific -> Value) -> Scientific -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Value
Aeson.Number
      (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger Integer
n
  conv (ScriptDataBytes ByteString
bs) =
    Key -> Value -> Value
singleFieldObject Key
"bytes"
      (Value -> Value) -> (Text -> Value) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
Aeson.String
      (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeLatin1 (ByteString -> ByteString
Base16.encode ByteString
bs)
  conv (ScriptDataList [ScriptData]
vs) =
    Key -> Value -> Value
singleFieldObject Key
"list"
      (Value -> Value) -> (Array -> Value) -> Array -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Value
Aeson.Array
      (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Item Array] -> Array
forall l. IsList l => [Item l] -> l
fromList ((ScriptData -> Value) -> [ScriptData] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> Value
conv [ScriptData]
vs)
  conv (ScriptDataMap [(ScriptData, ScriptData)]
kvs) =
    Key -> Value -> Value
singleFieldObject Key
"map"
      (Value -> Value) -> (Array -> Value) -> Array -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Value
Aeson.Array
      (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Item Array] -> Array
forall l. IsList l => [Item l] -> l
fromList
        [ [(Key, Value)] -> Value
Aeson.object [(Key
"k", ScriptData -> Value
conv ScriptData
k), (Key
"v", ScriptData -> Value
conv ScriptData
v)]
        | (ScriptData
k, ScriptData
v) <- [(ScriptData, ScriptData)]
kvs
        ]
  conv (ScriptDataConstructor Integer
n [ScriptData]
vs) =
    [(Key, Value)] -> Value
Aeson.object
      [ (Key
"constructor", Scientific -> Value
Aeson.Number (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger Integer
n))
      , (Key
"fields", Array -> Value
Aeson.Array ([Item Array] -> Array
forall l. IsList l => [Item l] -> l
fromList ((ScriptData -> Value) -> [ScriptData] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> Value
conv [ScriptData]
vs)))
      ]

  singleFieldObject :: Key -> Value -> Value
singleFieldObject Key
name Value
v = [(Key, Value)] -> Value
Aeson.object [(Key
name, Value
v)]

scriptDataFromJsonDetailedSchema
  :: Aeson.Value
  -> Either
      ScriptDataJsonSchemaError
      HashableScriptData
scriptDataFromJsonDetailedSchema :: Value -> Either ScriptDataJsonSchemaError HashableScriptData
scriptDataFromJsonDetailedSchema = (ScriptData -> HashableScriptData)
-> Either ScriptDataJsonSchemaError ScriptData
-> Either ScriptDataJsonSchemaError HashableScriptData
forall a b.
(a -> b)
-> Either ScriptDataJsonSchemaError a
-> Either ScriptDataJsonSchemaError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ScriptData
sd -> ByteString -> ScriptData -> HashableScriptData
HashableScriptData (ScriptData -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR ScriptData
sd) ScriptData
sd) (Either ScriptDataJsonSchemaError ScriptData
 -> Either ScriptDataJsonSchemaError HashableScriptData)
-> (Value -> Either ScriptDataJsonSchemaError ScriptData)
-> Value
-> Either ScriptDataJsonSchemaError HashableScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either ScriptDataJsonSchemaError ScriptData
conv
 where
  conv
    :: Aeson.Value
    -> Either ScriptDataJsonSchemaError ScriptData
  conv :: Value -> Either ScriptDataJsonSchemaError ScriptData
conv (Aeson.Object Object
m) =
    case [(Key, Value)] -> [(Key, Value)]
forall a. Ord a => [a] -> [a]
List.sort ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ Object -> [Item Object]
forall l. IsList l => l -> [Item l]
toList Object
m of
      [(Key
"int", Aeson.Number Scientific
d)] ->
        case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
d :: Either Double Integer of
          Left Double
n -> ScriptDataJsonSchemaError
-> Either ScriptDataJsonSchemaError ScriptData
forall a b. a -> Either a b
Left (Double -> ScriptDataJsonSchemaError
ScriptDataJsonNumberNotInteger Double
n)
          Right Integer
n -> ScriptData -> Either ScriptDataJsonSchemaError ScriptData
forall a b. b -> Either a b
Right (Integer -> ScriptData
ScriptDataNumber Integer
n)
      [(Key
"bytes", Aeson.String Text
s)]
        | Right ByteString
bs <- ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
Text.encodeUtf8 Text
s) ->
            ScriptData -> Either ScriptDataJsonSchemaError ScriptData
forall a b. b -> Either a b
Right (ByteString -> ScriptData
ScriptDataBytes ByteString
bs)
      [(Key
"list", Aeson.Array Array
vs)] ->
        ([ScriptData] -> ScriptData)
-> Either ScriptDataJsonSchemaError [ScriptData]
-> Either ScriptDataJsonSchemaError ScriptData
forall a b.
(a -> b)
-> Either ScriptDataJsonSchemaError a
-> Either ScriptDataJsonSchemaError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ScriptData] -> ScriptData
ScriptDataList
          (Either ScriptDataJsonSchemaError [ScriptData]
 -> Either ScriptDataJsonSchemaError ScriptData)
-> ([Value] -> Either ScriptDataJsonSchemaError [ScriptData])
-> [Value]
-> Either ScriptDataJsonSchemaError ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Either ScriptDataJsonSchemaError ScriptData)
-> [Value] -> Either ScriptDataJsonSchemaError [ScriptData]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> Either ScriptDataJsonSchemaError ScriptData
conv
          ([Value] -> Either ScriptDataJsonSchemaError ScriptData)
-> [Value] -> Either ScriptDataJsonSchemaError ScriptData
forall a b. (a -> b) -> a -> b
$ Array -> [Item Array]
forall l. IsList l => l -> [Item l]
toList Array
vs
      [(Key
"map", Aeson.Array Array
kvs)] ->
        ([(ScriptData, ScriptData)] -> ScriptData)
-> Either ScriptDataJsonSchemaError [(ScriptData, ScriptData)]
-> Either ScriptDataJsonSchemaError ScriptData
forall a b.
(a -> b)
-> Either ScriptDataJsonSchemaError a
-> Either ScriptDataJsonSchemaError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap
          (Either ScriptDataJsonSchemaError [(ScriptData, ScriptData)]
 -> Either ScriptDataJsonSchemaError ScriptData)
-> ([Value]
    -> Either ScriptDataJsonSchemaError [(ScriptData, ScriptData)])
-> [Value]
-> Either ScriptDataJsonSchemaError ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value
 -> Either ScriptDataJsonSchemaError (ScriptData, ScriptData))
-> [Value]
-> Either ScriptDataJsonSchemaError [(ScriptData, ScriptData)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> Either ScriptDataJsonSchemaError (ScriptData, ScriptData)
convKeyValuePair
          ([Value] -> Either ScriptDataJsonSchemaError ScriptData)
-> [Value] -> Either ScriptDataJsonSchemaError ScriptData
forall a b. (a -> b) -> a -> b
$ Array -> [Item Array]
forall l. IsList l => l -> [Item l]
toList Array
kvs
      [ (Key
"constructor", Aeson.Number Scientific
d)
        , (Key
"fields", Aeson.Array Array
vs)
        ] ->
          case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
d :: Either Double Integer of
            Left Double
n -> ScriptDataJsonSchemaError
-> Either ScriptDataJsonSchemaError ScriptData
forall a b. a -> Either a b
Left (Double -> ScriptDataJsonSchemaError
ScriptDataJsonNumberNotInteger Double
n)
            Right Integer
n ->
              ([ScriptData] -> ScriptData)
-> Either ScriptDataJsonSchemaError [ScriptData]
-> Either ScriptDataJsonSchemaError ScriptData
forall a b.
(a -> b)
-> Either ScriptDataJsonSchemaError a
-> Either ScriptDataJsonSchemaError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
n)
                (Either ScriptDataJsonSchemaError [ScriptData]
 -> Either ScriptDataJsonSchemaError ScriptData)
-> ([Value] -> Either ScriptDataJsonSchemaError [ScriptData])
-> [Value]
-> Either ScriptDataJsonSchemaError ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Either ScriptDataJsonSchemaError ScriptData)
-> [Value] -> Either ScriptDataJsonSchemaError [ScriptData]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> Either ScriptDataJsonSchemaError ScriptData
conv
                ([Value] -> Either ScriptDataJsonSchemaError ScriptData)
-> [Value] -> Either ScriptDataJsonSchemaError ScriptData
forall a b. (a -> b) -> a -> b
$ Array -> [Item Array]
forall l. IsList l => l -> [Item l]
toList Array
vs
      (Key
key, Value
v) : [(Key, Value)]
_
        | Key
key Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
"int", Key
"bytes", Key
"list", Key
"map", Key
"constructor"] ->
            ScriptDataJsonSchemaError
-> Either ScriptDataJsonSchemaError ScriptData
forall a b. a -> Either a b
Left (Text -> Value -> ScriptDataJsonSchemaError
ScriptDataJsonTypeMismatch (Key -> Text
Aeson.toText Key
key) Value
v)
      [(Key, Value)]
kvs -> ScriptDataJsonSchemaError
-> Either ScriptDataJsonSchemaError ScriptData
forall a b. a -> Either a b
Left ([(Text, Value)] -> ScriptDataJsonSchemaError
ScriptDataJsonBadObject ([(Text, Value)] -> ScriptDataJsonSchemaError)
-> [(Text, Value)] -> ScriptDataJsonSchemaError
forall a b. (a -> b) -> a -> b
$ (Key -> Text) -> (Key, Value) -> (Text, Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
Aeson.toText ((Key, Value) -> (Text, Value))
-> [(Key, Value)] -> [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Key, Value)]
kvs)
  conv Value
v = ScriptDataJsonSchemaError
-> Either ScriptDataJsonSchemaError ScriptData
forall a b. a -> Either a b
Left (Value -> ScriptDataJsonSchemaError
ScriptDataJsonNotObject Value
v)

  convKeyValuePair
    :: Aeson.Value
    -> Either
        ScriptDataJsonSchemaError
        (ScriptData, ScriptData)
  convKeyValuePair :: Value -> Either ScriptDataJsonSchemaError (ScriptData, ScriptData)
convKeyValuePair (Aeson.Object Object
m)
    | Object -> Int
forall v. KeyMap v -> Int
KeyMap.size Object
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
    , Just Value
k <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"k" Object
m
    , Just Value
v <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"v" Object
m =
        (,) (ScriptData -> ScriptData -> (ScriptData, ScriptData))
-> Either ScriptDataJsonSchemaError ScriptData
-> Either
     ScriptDataJsonSchemaError (ScriptData -> (ScriptData, ScriptData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either ScriptDataJsonSchemaError ScriptData
conv Value
k Either
  ScriptDataJsonSchemaError (ScriptData -> (ScriptData, ScriptData))
-> Either ScriptDataJsonSchemaError ScriptData
-> Either ScriptDataJsonSchemaError (ScriptData, ScriptData)
forall a b.
Either ScriptDataJsonSchemaError (a -> b)
-> Either ScriptDataJsonSchemaError a
-> Either ScriptDataJsonSchemaError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Either ScriptDataJsonSchemaError ScriptData
conv Value
v
  convKeyValuePair Value
v = ScriptDataJsonSchemaError
-> Either ScriptDataJsonSchemaError (ScriptData, ScriptData)
forall a b. a -> Either a b
Left (Value -> ScriptDataJsonSchemaError
ScriptDataJsonBadMapPair Value
v)

-- ----------------------------------------------------------------------------
-- Shared JSON conversion error types
--

data ScriptDataJsonError
  = ScriptDataJsonSchemaError !Aeson.Value !ScriptDataJsonSchemaError
  | ScriptDataRangeError !Aeson.Value !ScriptDataRangeError
  deriving (ScriptDataJsonError -> ScriptDataJsonError -> Bool
(ScriptDataJsonError -> ScriptDataJsonError -> Bool)
-> (ScriptDataJsonError -> ScriptDataJsonError -> Bool)
-> Eq ScriptDataJsonError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptDataJsonError -> ScriptDataJsonError -> Bool
== :: ScriptDataJsonError -> ScriptDataJsonError -> Bool
$c/= :: ScriptDataJsonError -> ScriptDataJsonError -> Bool
/= :: ScriptDataJsonError -> ScriptDataJsonError -> Bool
Eq, Int -> ScriptDataJsonError -> ShowS
[ScriptDataJsonError] -> ShowS
ScriptDataJsonError -> String
(Int -> ScriptDataJsonError -> ShowS)
-> (ScriptDataJsonError -> String)
-> ([ScriptDataJsonError] -> ShowS)
-> Show ScriptDataJsonError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptDataJsonError -> ShowS
showsPrec :: Int -> ScriptDataJsonError -> ShowS
$cshow :: ScriptDataJsonError -> String
show :: ScriptDataJsonError -> String
$cshowList :: [ScriptDataJsonError] -> ShowS
showList :: [ScriptDataJsonError] -> ShowS
Show, Typeable ScriptDataJsonError
Typeable ScriptDataJsonError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ScriptDataJsonError
 -> c ScriptDataJsonError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ScriptDataJsonError)
-> (ScriptDataJsonError -> Constr)
-> (ScriptDataJsonError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ScriptDataJsonError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ScriptDataJsonError))
-> ((forall b. Data b => b -> b)
    -> ScriptDataJsonError -> ScriptDataJsonError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ScriptDataJsonError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ScriptDataJsonError -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ScriptDataJsonError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ScriptDataJsonError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataJsonError -> m ScriptDataJsonError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataJsonError -> m ScriptDataJsonError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataJsonError -> m ScriptDataJsonError)
-> Data ScriptDataJsonError
ScriptDataJsonError -> Constr
ScriptDataJsonError -> DataType
(forall b. Data b => b -> b)
-> ScriptDataJsonError -> ScriptDataJsonError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ScriptDataJsonError -> u
forall u.
(forall d. Data d => d -> u) -> ScriptDataJsonError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataJsonError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataJsonError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonError -> m ScriptDataJsonError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonError -> m ScriptDataJsonError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataJsonError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataJsonError
-> c ScriptDataJsonError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScriptDataJsonError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataJsonError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataJsonError
-> c ScriptDataJsonError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataJsonError
-> c ScriptDataJsonError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataJsonError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataJsonError
$ctoConstr :: ScriptDataJsonError -> Constr
toConstr :: ScriptDataJsonError -> Constr
$cdataTypeOf :: ScriptDataJsonError -> DataType
dataTypeOf :: ScriptDataJsonError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScriptDataJsonError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ScriptDataJsonError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataJsonError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataJsonError)
$cgmapT :: (forall b. Data b => b -> b)
-> ScriptDataJsonError -> ScriptDataJsonError
gmapT :: (forall b. Data b => b -> b)
-> ScriptDataJsonError -> ScriptDataJsonError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataJsonError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataJsonError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataJsonError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ScriptDataJsonError -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ScriptDataJsonError -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ScriptDataJsonError -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ScriptDataJsonError -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ScriptDataJsonError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonError -> m ScriptDataJsonError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonError -> m ScriptDataJsonError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonError -> m ScriptDataJsonError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonError -> m ScriptDataJsonError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonError -> m ScriptDataJsonError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonError -> m ScriptDataJsonError
Data)

data ScriptDataJsonSchemaError
  = -- Only used for 'ScriptDataJsonNoSchema'
    ScriptDataJsonNullNotAllowed
  | ScriptDataJsonBoolNotAllowed
  | -- Used by both mappings
    ScriptDataJsonNumberNotInteger !Double
  | -- Only used for 'ScriptDataJsonDetailedSchema'
    ScriptDataJsonNotObject !Aeson.Value
  | ScriptDataJsonBadObject ![(Text, Aeson.Value)]
  | ScriptDataJsonBadMapPair !Aeson.Value
  | ScriptDataJsonTypeMismatch !Text !Aeson.Value
  deriving (ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError -> Bool
(ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError -> Bool)
-> (ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError -> Bool)
-> Eq ScriptDataJsonSchemaError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError -> Bool
== :: ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError -> Bool
$c/= :: ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError -> Bool
/= :: ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError -> Bool
Eq, Int -> ScriptDataJsonSchemaError -> ShowS
[ScriptDataJsonSchemaError] -> ShowS
ScriptDataJsonSchemaError -> String
(Int -> ScriptDataJsonSchemaError -> ShowS)
-> (ScriptDataJsonSchemaError -> String)
-> ([ScriptDataJsonSchemaError] -> ShowS)
-> Show ScriptDataJsonSchemaError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptDataJsonSchemaError -> ShowS
showsPrec :: Int -> ScriptDataJsonSchemaError -> ShowS
$cshow :: ScriptDataJsonSchemaError -> String
show :: ScriptDataJsonSchemaError -> String
$cshowList :: [ScriptDataJsonSchemaError] -> ShowS
showList :: [ScriptDataJsonSchemaError] -> ShowS
Show, Typeable ScriptDataJsonSchemaError
Typeable ScriptDataJsonSchemaError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ScriptDataJsonSchemaError
 -> c ScriptDataJsonSchemaError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ScriptDataJsonSchemaError)
-> (ScriptDataJsonSchemaError -> Constr)
-> (ScriptDataJsonSchemaError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ScriptDataJsonSchemaError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ScriptDataJsonSchemaError))
-> ((forall b. Data b => b -> b)
    -> ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ScriptDataJsonSchemaError
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ScriptDataJsonSchemaError
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ScriptDataJsonSchemaError -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> ScriptDataJsonSchemaError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataJsonSchemaError -> m ScriptDataJsonSchemaError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataJsonSchemaError -> m ScriptDataJsonSchemaError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ScriptDataJsonSchemaError -> m ScriptDataJsonSchemaError)
-> Data ScriptDataJsonSchemaError
ScriptDataJsonSchemaError -> Constr
ScriptDataJsonSchemaError -> DataType
(forall b. Data b => b -> b)
-> ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> ScriptDataJsonSchemaError -> u
forall u.
(forall d. Data d => d -> u) -> ScriptDataJsonSchemaError -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonSchemaError
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonSchemaError
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonSchemaError -> m ScriptDataJsonSchemaError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonSchemaError -> m ScriptDataJsonSchemaError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataJsonSchemaError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataJsonSchemaError
-> c ScriptDataJsonSchemaError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ScriptDataJsonSchemaError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataJsonSchemaError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataJsonSchemaError
-> c ScriptDataJsonSchemaError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ScriptDataJsonSchemaError
-> c ScriptDataJsonSchemaError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataJsonSchemaError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ScriptDataJsonSchemaError
$ctoConstr :: ScriptDataJsonSchemaError -> Constr
toConstr :: ScriptDataJsonSchemaError -> Constr
$cdataTypeOf :: ScriptDataJsonSchemaError -> DataType
dataTypeOf :: ScriptDataJsonSchemaError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ScriptDataJsonSchemaError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ScriptDataJsonSchemaError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataJsonSchemaError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ScriptDataJsonSchemaError)
$cgmapT :: (forall b. Data b => b -> b)
-> ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError
gmapT :: (forall b. Data b => b -> b)
-> ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonSchemaError
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonSchemaError
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonSchemaError
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ScriptDataJsonSchemaError
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ScriptDataJsonSchemaError -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ScriptDataJsonSchemaError -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ScriptDataJsonSchemaError -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ScriptDataJsonSchemaError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonSchemaError -> m ScriptDataJsonSchemaError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonSchemaError -> m ScriptDataJsonSchemaError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonSchemaError -> m ScriptDataJsonSchemaError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonSchemaError -> m ScriptDataJsonSchemaError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonSchemaError -> m ScriptDataJsonSchemaError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ScriptDataJsonSchemaError -> m ScriptDataJsonSchemaError
Data)

instance Error ScriptDataJsonError where
  prettyError :: forall ann. ScriptDataJsonError -> Doc ann
prettyError = \case
    ScriptDataJsonSchemaError Value
v ScriptDataJsonSchemaError
detail ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"JSON schema error within the script data: "
        , String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
LBS.unpack (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
v)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptDataJsonSchemaError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. ScriptDataJsonSchemaError -> Doc ann
prettyError ScriptDataJsonSchemaError
detail
        ]
    ScriptDataRangeError Value
v ScriptDataRangeError
detail ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"Value out of range within the script data: "
        , String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
LBS.unpack (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
v)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptDataRangeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. ScriptDataRangeError -> Doc ann
prettyError ScriptDataRangeError
detail
        ]

instance Error ScriptDataJsonSchemaError where
  prettyError :: forall ann. ScriptDataJsonSchemaError -> Doc ann
prettyError = \case
    ScriptDataJsonSchemaError
ScriptDataJsonNullNotAllowed ->
      Doc ann
"JSON null values are not supported."
    ScriptDataJsonSchemaError
ScriptDataJsonBoolNotAllowed ->
      Doc ann
"JSON bool values are not supported."
    ScriptDataJsonNumberNotInteger Double
d ->
      Doc ann
"JSON numbers must be integers. Unexpected value: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Double -> Doc ann
forall ann. Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Double
d
    ScriptDataJsonNotObject Value
v ->
      Doc ann
"JSON object expected. Unexpected value: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
LBS.unpack (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
v))
    ScriptDataJsonBadObject [(Text, Value)]
v ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"JSON object does not match the schema.\nExpected a single field named "
        , Doc ann
"\"int\", \"bytes\", \"list\" or \"map\".\n"
        , Doc ann
"Unexpected object field(s): "
        , String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
LBS.unpack (Object -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (forall l. IsList l => [Item l] -> l
fromList @Aeson.Object ([Item Object] -> Object) -> [Item Object] -> Object
forall a b. (a -> b) -> a -> b
$ (Text -> Key) -> (Text, Value) -> (Key, Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Key
Aeson.fromText ((Text, Value) -> (Key, Value))
-> [(Text, Value)] -> [(Key, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Value)]
v)))
        ]
    ScriptDataJsonBadMapPair Value
v ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"Expected a list of key/value pair { \"k\": ..., \"v\": ... } objects."
        , Doc ann
"\nUnexpected value: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
LBS.unpack (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
v))
        ]
    ScriptDataJsonTypeMismatch Text
k Value
v ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The value in the field " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Text
k Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" does not have the type "
        , Doc ann
"required by the schema.\nUnexpected value: "
        , String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
LBS.unpack (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
v))
        ]