{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

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

    -- * Script data hashes
    hashScriptData,

    -- * 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 qualified Cardano.Binary as CBOR
import           Codec.Serialise.Class (Serialise (..))
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.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 qualified Data.Vector as Vector
import           Data.Word

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           Control.Applicative (Alternative (..))

import qualified Cardano.Crypto.Hash.Class as Crypto
import qualified Cardano.Ledger.Alonzo.Data as Alonzo
import qualified Cardano.Ledger.SafeHash as Ledger
import           Ouroboros.Consensus.Shelley.Eras (StandardAlonzo, StandardCrypto)
import qualified PlutusLedgerApi.V1 as Plutus

import           Cardano.Api.Eras
import           Cardano.Api.Error
import           Cardano.Api.Hash

import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Keys.Shelley

import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseJSON
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseUsing
import           Cardano.Api.TxMetadata (pBytes, pSigned, parseAll)

-- Original script data bytes
data HashableScriptData
  = HashableScriptData
      !BS.ByteString -- ^ Original 'ScriptData' bytes
      !ScriptData
      deriving (HashableScriptData -> HashableScriptData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashableScriptData -> HashableScriptData -> Bool
$c/= :: HashableScriptData -> HashableScriptData -> Bool
== :: HashableScriptData -> HashableScriptData -> Bool
$c== :: HashableScriptData -> HashableScriptData -> Bool
Eq, Int -> HashableScriptData -> ShowS
[HashableScriptData] -> ShowS
HashableScriptData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashableScriptData] -> ShowS
$cshowList :: [HashableScriptData] -> ShowS
show :: HashableScriptData -> String
$cshow :: HashableScriptData -> String
showsPrec :: Int -> HashableScriptData -> ShowS
$cshowsPrec :: Int -> 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
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Text
-> (forall s. Decoder s a) -> ByteString -> Either DecoderError a
CBOR.decodeFullDecoder Text
"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 (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
                | ScriptDataMap         [(ScriptData, ScriptData)]  -- ^ Key value pairs
                | ScriptDataList        [ScriptData]                -- ^ Elements
                | ScriptDataNumber      Integer
                | ScriptDataBytes       BS.ByteString
  deriving (ScriptData -> ScriptData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptData -> ScriptData -> Bool
$c/= :: ScriptData -> ScriptData -> Bool
== :: ScriptData -> ScriptData -> Bool
$c== :: ScriptData -> ScriptData -> Bool
Eq, Eq 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
min :: ScriptData -> ScriptData -> ScriptData
$cmin :: ScriptData -> ScriptData -> ScriptData
max :: ScriptData -> ScriptData -> ScriptData
$cmax :: ScriptData -> ScriptData -> ScriptData
>= :: ScriptData -> ScriptData -> Bool
$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
compare :: ScriptData -> ScriptData -> Ordering
$ccompare :: ScriptData -> ScriptData -> Ordering
Ord, Int -> ScriptData -> ShowS
[ScriptData] -> ShowS
ScriptData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptData] -> ShowS
$cshowList :: [ScriptData] -> ShowS
show :: ScriptData -> String
$cshow :: ScriptData -> String
showsPrec :: Int -> ScriptData -> ShowS
$cshowsPrec :: Int -> 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 (Alonzo.DataHash StandardCrypto)
  deriving stock (Hash ScriptData -> Hash ScriptData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hash ScriptData -> Hash ScriptData -> Bool
$c/= :: Hash ScriptData -> Hash ScriptData -> Bool
== :: Hash ScriptData -> Hash ScriptData -> Bool
$c== :: Hash ScriptData -> Hash ScriptData -> Bool
Eq, Eq (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
min :: Hash ScriptData -> Hash ScriptData -> Hash ScriptData
$cmin :: Hash ScriptData -> Hash ScriptData -> Hash ScriptData
max :: Hash ScriptData -> Hash ScriptData -> Hash ScriptData
$cmax :: Hash ScriptData -> Hash ScriptData -> Hash ScriptData
>= :: 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
$c< :: Hash ScriptData -> Hash ScriptData -> Bool
compare :: Hash ScriptData -> Hash ScriptData -> Ordering
$ccompare :: Hash ScriptData -> Hash ScriptData -> Ordering
Ord)
  deriving (Int -> Hash ScriptData -> ShowS
[Hash ScriptData] -> ShowS
Hash ScriptData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hash ScriptData] -> ShowS
$cshowList :: [Hash ScriptData] -> ShowS
show :: Hash ScriptData -> String
$cshow :: Hash ScriptData -> String
showsPrec :: Int -> Hash ScriptData -> ShowS
$cshowsPrec :: Int -> Hash ScriptData -> ShowS
Show, String -> Hash ScriptData
forall a. (String -> a) -> IsString a
fromString :: String -> Hash ScriptData
$cfromString :: String -> Hash ScriptData
IsString)         via UsingRawBytesHex (Hash ScriptData)
  deriving ([Hash ScriptData] -> Value
[Hash ScriptData] -> Encoding
Hash ScriptData -> Value
Hash ScriptData -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Hash ScriptData] -> Encoding
$ctoEncodingList :: [Hash ScriptData] -> Encoding
toJSONList :: [Hash ScriptData] -> Value
$ctoJSONList :: [Hash ScriptData] -> Value
toEncoding :: Hash ScriptData -> Encoding
$ctoEncoding :: Hash ScriptData -> Encoding
toJSON :: Hash ScriptData -> Value
$ctoJSON :: Hash ScriptData -> Value
ToJSON, Value -> Parser [Hash ScriptData]
Value -> Parser (Hash ScriptData)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Hash ScriptData]
$cparseJSONList :: Value -> Parser [Hash ScriptData]
parseJSON :: Value -> Parser (Hash ScriptData)
$cparseJSON :: Value -> Parser (Hash ScriptData)
FromJSON)       via UsingRawBytesHex (Hash ScriptData)
  deriving (ToJSONKeyFunction [Hash ScriptData]
ToJSONKeyFunction (Hash ScriptData)
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [Hash ScriptData]
$ctoJSONKeyList :: ToJSONKeyFunction [Hash ScriptData]
toJSONKey :: ToJSONKeyFunction (Hash ScriptData)
$ctoJSONKey :: ToJSONKeyFunction (Hash ScriptData)
ToJSONKey, FromJSONKeyFunction [Hash ScriptData]
FromJSONKeyFunction (Hash ScriptData)
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [Hash ScriptData]
$cfromJSONKeyList :: FromJSONKeyFunction [Hash ScriptData]
fromJSONKey :: FromJSONKeyFunction (Hash ScriptData)
$cfromJSONKey :: FromJSONKeyFunction (Hash ScriptData)
FromJSONKey) via UsingRawBytesHex (Hash ScriptData)

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

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

instance SerialiseAsCBOR ScriptData where
    serialiseToCBOR :: ScriptData -> ByteString
serialiseToCBOR = forall a. ToCBOR a => a -> ByteString
CBOR.serialize'
    deserialiseFromCBOR :: AsType ScriptData -> ByteString -> Either DecoderError ScriptData
deserialiseFromCBOR AsType ScriptData
R:AsTypeScriptData
AsScriptData ByteString
bs = forall a.
Text
-> (forall s. Decoder s a) -> ByteString -> Either DecoderError a
CBOR.decodeFullDecoder Text
"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 @Plutus.Data 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. Serialise a => Decoder s a
decode @Plutus.Data

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

{-# DEPRECATED hashScriptData "Use hashScriptDataBytes" #-}
hashScriptData :: HashableScriptData -> Hash ScriptData
hashScriptData :: HashableScriptData -> Hash ScriptData
hashScriptData = HashableScriptData -> Hash ScriptData
hashScriptDataBytes

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

newtype ScriptBytesError = ScriptBytesError String deriving Int -> ScriptBytesError -> ShowS
[ScriptBytesError] -> ShowS
ScriptBytesError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptBytesError] -> ShowS
$cshowList :: [ScriptBytesError] -> ShowS
show :: ScriptBytesError -> String
$cshow :: ScriptBytesError -> String
showsPrec :: Int -> ScriptBytesError -> ShowS
$cshowsPrec :: Int -> 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 :: HashableScriptData -> Alonzo.Data ledgerera
toAlonzoData :: forall ledgerera. HashableScriptData -> Data ledgerera
toAlonzoData =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
  (\ ScriptBytesError
e -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"toAlonzoData: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ScriptBytesError
e)
  forall era. BinaryData era -> Data era
Alonzo.binaryDataToData
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> ScriptBytesError
ScriptBytesError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ShortByteString -> Either String (BinaryData era)
Alonzo.makeBinaryData forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SB.toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashableScriptData -> ByteString
getOriginalScriptDataBytes

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

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


fromPlutusData :: Plutus.Data -> ScriptData
fromPlutusData :: Data -> ScriptData
fromPlutusData (Plutus.Constr Integer
int [Data]
xs)
                                = Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
int
                                    [ Data -> ScriptData
fromPlutusData Data
x | Data
x <- [Data]
xs ]
fromPlutusData (Plutus.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 (Plutus.List [Data]
xs) = [ScriptData] -> ScriptData
ScriptDataList
                                    [ Data -> ScriptData
fromPlutusData Data
x | Data
x <- [Data]
xs ]
fromPlutusData (Plutus.I     Integer
n) = Integer -> ScriptData
ScriptDataNumber Integer
n
fromPlutusData (Plutus.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
      []    -> forall a b. b -> Either a b
Right ()
      ScriptDataRangeError
err:[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) =
        forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ScriptData -> [ScriptDataRangeError]
collect [ScriptData]
xs

    collect (ScriptDataMap [(ScriptData, ScriptData)]
kvs) =
        forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(ScriptData
k, ScriptData
v) -> ScriptData -> [ScriptDataRangeError]
collect ScriptData
k
                         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 forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word64) Bool -> Bool -> Bool
|| Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0 ]
     forall a. Semigroup a => a -> a -> a
<> 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 number is outside the maximum range of @-2^64-1 .. 2^64-1@.
    --
  ScriptDataConstructorOutOfRange Integer
  deriving (ScriptDataRangeError -> ScriptDataRangeError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptDataRangeError -> ScriptDataRangeError -> Bool
$c/= :: ScriptDataRangeError -> ScriptDataRangeError -> Bool
== :: ScriptDataRangeError -> ScriptDataRangeError -> Bool
$c== :: ScriptDataRangeError -> ScriptDataRangeError -> Bool
Eq, Int -> ScriptDataRangeError -> ShowS
[ScriptDataRangeError] -> ShowS
ScriptDataRangeError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptDataRangeError] -> ShowS
$cshowList :: [ScriptDataRangeError] -> ShowS
show :: ScriptDataRangeError -> String
$cshow :: ScriptDataRangeError -> String
showsPrec :: Int -> ScriptDataRangeError -> ShowS
$cshowsPrec :: Int -> ScriptDataRangeError -> ShowS
Show)

instance Error ScriptDataRangeError where
  displayError :: ScriptDataRangeError -> String
displayError (ScriptDataConstructorOutOfRange Integer
n) =
      String
"Constructor numbers in script data value "
        forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Integer
n
        forall a. Semigroup a => a -> a -> a
<> String
" 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptDataJsonSchema -> ScriptDataJsonSchema -> Bool
$c/= :: ScriptDataJsonSchema -> ScriptDataJsonSchema -> Bool
== :: ScriptDataJsonSchema -> ScriptDataJsonSchema -> Bool
$c== :: ScriptDataJsonSchema -> ScriptDataJsonSchema -> Bool
Eq, Int -> ScriptDataJsonSchema -> ShowS
[ScriptDataJsonSchema] -> ShowS
ScriptDataJsonSchema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptDataJsonSchema] -> ShowS
$cshowList :: [ScriptDataJsonSchema] -> ShowS
show :: ScriptDataJsonSchema -> String
$cshow :: ScriptDataJsonSchema -> String
showsPrec :: Int -> ScriptDataJsonSchema -> ShowS
$cshowsPrec :: Int -> 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 <- 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)
    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 forall a b. (a -> b) -> a -> b
$ HashableScriptData -> ScriptData
getScriptData HashableScriptData
d)
    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 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 (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 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 (forall a. [a] -> Vector a
Vector.fromList (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 forall a b. (a -> b) -> a -> b
$
          forall a. [a] -> Vector a
Vector.fromList
           [ Scientific -> Value
Aeson.Number (forall a. Num a => Integer -> a
fromInteger Integer
n)
           , Array -> Value
Aeson.Array (forall a. [a] -> Vector a
Vector.fromList (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 forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (forall a. Show a => a -> String
show Integer
n)
    convKey (ScriptDataBytes ByteString
bs) = Text -> Key
Aeson.fromText forall a b. (a -> b) -> a -> b
$ Text
bytesPrefix
                                forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeLatin1 (ByteString -> ByteString
Base16.encode ByteString
bs)
    convKey ScriptData
v                    = Text -> Key
Aeson.fromText
                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.Lazy.toStrict
                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Text
Aeson.Text.encodeToLazyText
                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptData -> Value
conv
                                 forall a b. (a -> b) -> a -> b
$ ScriptData
v

scriptDataFromJsonNoSchema :: Aeson.Value
                           -> Either ScriptDataJsonSchemaError
                                     HashableScriptData
scriptDataFromJsonNoSchema :: Value -> Either ScriptDataJsonSchemaError HashableScriptData
scriptDataFromJsonNoSchema = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ScriptData
sd -> ByteString -> ScriptData -> HashableScriptData
HashableScriptData (forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR ScriptData
sd) ScriptData
sd) 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   = forall a b. a -> Either a b
Left ScriptDataJsonSchemaError
ScriptDataJsonNullNotAllowed
    conv Aeson.Bool{} = forall a b. a -> Either a b
Left ScriptDataJsonSchemaError
ScriptDataJsonBoolNotAllowed

    conv (Aeson.Number Scientific
d) =
      case forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
d :: Either Double Integer of
        Left  Double
n -> forall a b. a -> Either a b
Left (Double -> ScriptDataJsonSchemaError
ScriptDataJsonNumberNotInteger Double
n)
        Right Integer
n -> 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 forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'F') ByteString
bs')
      = forall a b. b -> Either a b
Right (ByteString -> ScriptData
ScriptDataBytes ByteString
bs)

      | Bool
otherwise
      = forall a b. b -> Either a b
Right (ByteString -> ScriptData
ScriptDataBytes (Text -> ByteString
Text.encodeUtf8 Text
s))

    conv (Aeson.Array Array
vs) =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ScriptData] -> ScriptData
ScriptDataList
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either ScriptDataJsonSchemaError ScriptData
conv
      forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
Vector.toList Array
vs

    conv (Aeson.Object Object
kvs) =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Text
k,Value
v) -> (,) (Text -> ScriptData
convKey Text
k) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either ScriptDataJsonSchemaError ScriptData
conv Value
v)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a, b) -> a
fst
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
Aeson.toText)
      forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Object
kvs

    convKey :: Text -> ScriptData
    convKey :: Text -> ScriptData
convKey Text
s =
      forall a. a -> Maybe a -> a
fromMaybe (ByteString -> ScriptData
ScriptDataBytes (Text -> ByteString
Text.encodeUtf8 Text
s)) forall a b. (a -> b) -> a -> b
$
      forall a. Parser a -> Text -> Maybe a
parseAll ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> ScriptData
ScriptDataNumber Parser Integer
pSigned forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
Atto.endOfInput)
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ScriptData
ScriptDataBytes  Parser ByteString
pBytes  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptDataJsonBytesError] -> ShowS
$cshowList :: [ScriptDataJsonBytesError] -> ShowS
show :: ScriptDataJsonBytesError -> String
$cshow :: ScriptDataJsonBytesError -> String
showsPrec :: Int -> ScriptDataJsonBytesError -> ShowS
$cshowsPrec :: Int -> ScriptDataJsonBytesError -> ShowS
Show

instance Error ScriptDataJsonBytesError where
  displayError :: ScriptDataJsonBytesError -> String
displayError (ScriptDataJsonBytesErrorValue ScriptDataJsonError
e) =
    String
"Error decoding ScriptData JSON value: " forall a. Semigroup a => a -> a -> a
<> forall e. Error e => e -> String
displayError ScriptDataJsonError
e
  displayError (ScriptDataJsonBytesErrorInvalid ScriptDataRangeError
e) =
    String
"ScriptData is invalid: " forall a. Semigroup a => a -> a -> a
<> forall e. Error e => e -> String
displayError 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 <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ScriptDataJsonError -> ScriptDataJsonBytesError
ScriptDataJsonBytesErrorValue forall a b. (a -> b) -> a -> b
$ ScriptDataJsonSchema
-> Value -> Either ScriptDataJsonError HashableScriptData
scriptDataFromJson ScriptDataJsonSchema
schema Value
scriptDataVal
  forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ScriptDataRangeError -> ScriptDataJsonBytesError
ScriptDataJsonBytesErrorInvalid forall a b. (a -> b) -> a -> b
$ ScriptData -> Either ScriptDataRangeError ()
validateScriptData forall a b. (a -> b) -> a -> b
$ HashableScriptData -> ScriptData
getScriptData HashableScriptData
sData
  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 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"
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Value
Aeson.Number
                              forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
n
    conv (ScriptDataBytes ByteString
bs) = Key -> Value -> Value
singleFieldObject Key
"bytes"
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
Aeson.String
                              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"
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Value
Aeson.Array
                              forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
Vector.fromList (forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> Value
conv [ScriptData]
vs)
    conv (ScriptDataMap  [(ScriptData, ScriptData)]
kvs) = Key -> Value -> Value
singleFieldObject Key
"map"
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Value
Aeson.Array
                              forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
Vector.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 (forall a. Num a => Integer -> a
fromInteger Integer
n))
        , (Key
"fields",      Array -> Value
Aeson.Array (forall a. [a] -> Vector a
Vector.fromList (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ScriptData
sd -> ByteString -> ScriptData -> HashableScriptData
HashableScriptData (forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR ScriptData
sd) ScriptData
sd) 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 forall a. Ord a => [a] -> [a]
List.sort forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Object
m of
        [(Key
"int", Aeson.Number Scientific
d)] ->
          case forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
d :: Either Double Integer of
            Left  Double
n -> forall a b. a -> Either a b
Left (Double -> ScriptDataJsonSchemaError
ScriptDataJsonNumberNotInteger Double
n)
            Right Integer
n -> 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)
          -> forall a b. b -> Either a b
Right (ByteString -> ScriptData
ScriptDataBytes ByteString
bs)

        [(Key
"list", Aeson.Array Array
vs)] ->
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ScriptData] -> ScriptData
ScriptDataList
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either ScriptDataJsonSchemaError ScriptData
conv
          forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
Vector.toList Array
vs

        [(Key
"map", Aeson.Array Array
kvs)] ->
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either ScriptDataJsonSchemaError (ScriptData, ScriptData)
convKeyValuePair
          forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
Vector.toList Array
kvs

        [(Key
"constructor", Aeson.Number Scientific
d),
         (Key
"fields",      Aeson.Array Array
vs)] ->
          case forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
d :: Either Double Integer of
            Left  Double
n -> forall a b. a -> Either a b
Left (Double -> ScriptDataJsonSchemaError
ScriptDataJsonNumberNotInteger Double
n)
            Right Integer
n -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
n)
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either ScriptDataJsonSchemaError ScriptData
conv
                     forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
Vector.toList Array
vs

        (Key
key, Value
v):[(Key, Value)]
_ | Key
key forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
"int", Key
"bytes", Key
"list", Key
"map", Key
"constructor"] ->
            forall a b. a -> Either a b
Left (Text -> Value -> ScriptDataJsonSchemaError
ScriptDataJsonTypeMismatch (Key -> Text
Aeson.toText Key
key) Value
v)

        [(Key, Value)]
kvs -> forall a b. a -> Either a b
Left ([(Text, Value)] -> ScriptDataJsonSchemaError
ScriptDataJsonBadObject forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
Aeson.toText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Key, Value)]
kvs)

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

    convKeyValuePair Value
v = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptDataJsonError -> ScriptDataJsonError -> Bool
$c/= :: ScriptDataJsonError -> ScriptDataJsonError -> Bool
== :: ScriptDataJsonError -> ScriptDataJsonError -> Bool
$c== :: ScriptDataJsonError -> ScriptDataJsonError -> Bool
Eq, Int -> ScriptDataJsonError -> ShowS
[ScriptDataJsonError] -> ShowS
ScriptDataJsonError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptDataJsonError] -> ShowS
$cshowList :: [ScriptDataJsonError] -> ShowS
show :: ScriptDataJsonError -> String
$cshow :: ScriptDataJsonError -> String
showsPrec :: Int -> ScriptDataJsonError -> ShowS
$cshowsPrec :: Int -> ScriptDataJsonError -> ShowS
Show)

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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError -> Bool
$c/= :: ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError -> Bool
== :: ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError -> Bool
$c== :: ScriptDataJsonSchemaError -> ScriptDataJsonSchemaError -> Bool
Eq, Int -> ScriptDataJsonSchemaError -> ShowS
[ScriptDataJsonSchemaError] -> ShowS
ScriptDataJsonSchemaError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptDataJsonSchemaError] -> ShowS
$cshowList :: [ScriptDataJsonSchemaError] -> ShowS
show :: ScriptDataJsonSchemaError -> String
$cshow :: ScriptDataJsonSchemaError -> String
showsPrec :: Int -> ScriptDataJsonSchemaError -> ShowS
$cshowsPrec :: Int -> ScriptDataJsonSchemaError -> ShowS
Show)

instance Error ScriptDataJsonError where
    displayError :: ScriptDataJsonError -> String
displayError (ScriptDataJsonSchemaError Value
v ScriptDataJsonSchemaError
detail) =
        String
"JSON schema error within the script data: "
     forall a. [a] -> [a] -> [a]
++ ByteString -> String
LBS.unpack (forall a. ToJSON a => a -> ByteString
Aeson.encode Value
v) forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall e. Error e => e -> String
displayError ScriptDataJsonSchemaError
detail
    displayError (ScriptDataRangeError Value
v ScriptDataRangeError
detail) =
        String
"Value out of range within the script data: "
     forall a. [a] -> [a] -> [a]
++ ByteString -> String
LBS.unpack (forall a. ToJSON a => a -> ByteString
Aeson.encode Value
v) forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall e. Error e => e -> String
displayError ScriptDataRangeError
detail

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