{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- | Currency values
--
module Bcc.Api.Value
  ( Entropic(..)

    -- * Multi-asset values
  , Quantity(..)
  , PolicyId(..)
  , scriptPolicyId
  , AssetName(..)
  , AssetId(..)
  , Value
  , selectAsset
  , valueFromList
  , valueToList
  , filterValue
  , negateValue
  , calcMinimumDeposit

    -- ** Bcc \/ Entropic specifically
  , quantityToEntropic
  , entropicToQuantity
  , selectEntropic
  , entropicToValue
  , valueToEntropic

    -- ** Alternative nested representation
  , ValueNestedRep(..)
  , ValueNestedBundle(..)
  , valueToNestedRep
  , valueFromNestedRep

    -- ** Rendering
  , renderValue
  , renderValuePretty

    -- * Internal conversion functions
  , toColeEntropic
  , fromColeEntropic
  , toSophieEntropic
  , fromSophieEntropic
  , fromSophieDeltaEntropic
  , toJenValue
  , fromJenValue

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

import           Prelude

import           Data.Aeson hiding (Value)
import qualified Data.Aeson as Aeson
import           Data.Aeson.Types (Parser, toJSONKeyText)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map.Merge.Strict as Map
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.String (IsString (..))
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

import qualified Bcc.Chain.Common as Cole

import qualified Bcc.Ledger.Coin as Sophie
import qualified Bcc.Ledger.Jen.Value as Jen
import qualified Bcc.Ledger.SophieMA.Rules.Utxo as Sophie
import           Bcc.Ledger.Crypto (StandardCrypto)

import           Bcc.Api.HasTypeProxy
import           Bcc.Api.Script
import           Bcc.Api.SerialiseCBOR
import           Bcc.Api.SerialiseRaw
import           Bcc.Api.SerialiseUsing


-- ----------------------------------------------------------------------------
-- Entropic
--

newtype Entropic = Entropic Integer
  deriving stock (Entropic -> Entropic -> Bool
(Entropic -> Entropic -> Bool)
-> (Entropic -> Entropic -> Bool) -> Eq Entropic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entropic -> Entropic -> Bool
$c/= :: Entropic -> Entropic -> Bool
== :: Entropic -> Entropic -> Bool
$c== :: Entropic -> Entropic -> Bool
Eq, Eq Entropic
Eq Entropic
-> (Entropic -> Entropic -> Ordering)
-> (Entropic -> Entropic -> Bool)
-> (Entropic -> Entropic -> Bool)
-> (Entropic -> Entropic -> Bool)
-> (Entropic -> Entropic -> Bool)
-> (Entropic -> Entropic -> Entropic)
-> (Entropic -> Entropic -> Entropic)
-> Ord Entropic
Entropic -> Entropic -> Bool
Entropic -> Entropic -> Ordering
Entropic -> Entropic -> Entropic
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 :: Entropic -> Entropic -> Entropic
$cmin :: Entropic -> Entropic -> Entropic
max :: Entropic -> Entropic -> Entropic
$cmax :: Entropic -> Entropic -> Entropic
>= :: Entropic -> Entropic -> Bool
$c>= :: Entropic -> Entropic -> Bool
> :: Entropic -> Entropic -> Bool
$c> :: Entropic -> Entropic -> Bool
<= :: Entropic -> Entropic -> Bool
$c<= :: Entropic -> Entropic -> Bool
< :: Entropic -> Entropic -> Bool
$c< :: Entropic -> Entropic -> Bool
compare :: Entropic -> Entropic -> Ordering
$ccompare :: Entropic -> Entropic -> Ordering
$cp1Ord :: Eq Entropic
Ord, Int -> Entropic -> ShowS
[Entropic] -> ShowS
Entropic -> String
(Int -> Entropic -> ShowS)
-> (Entropic -> String) -> ([Entropic] -> ShowS) -> Show Entropic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entropic] -> ShowS
$cshowList :: [Entropic] -> ShowS
show :: Entropic -> String
$cshow :: Entropic -> String
showsPrec :: Int -> Entropic -> ShowS
$cshowsPrec :: Int -> Entropic -> ShowS
Show)
  deriving newtype (Int -> Entropic
Entropic -> Int
Entropic -> [Entropic]
Entropic -> Entropic
Entropic -> Entropic -> [Entropic]
Entropic -> Entropic -> Entropic -> [Entropic]
(Entropic -> Entropic)
-> (Entropic -> Entropic)
-> (Int -> Entropic)
-> (Entropic -> Int)
-> (Entropic -> [Entropic])
-> (Entropic -> Entropic -> [Entropic])
-> (Entropic -> Entropic -> [Entropic])
-> (Entropic -> Entropic -> Entropic -> [Entropic])
-> Enum Entropic
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Entropic -> Entropic -> Entropic -> [Entropic]
$cenumFromThenTo :: Entropic -> Entropic -> Entropic -> [Entropic]
enumFromTo :: Entropic -> Entropic -> [Entropic]
$cenumFromTo :: Entropic -> Entropic -> [Entropic]
enumFromThen :: Entropic -> Entropic -> [Entropic]
$cenumFromThen :: Entropic -> Entropic -> [Entropic]
enumFrom :: Entropic -> [Entropic]
$cenumFrom :: Entropic -> [Entropic]
fromEnum :: Entropic -> Int
$cfromEnum :: Entropic -> Int
toEnum :: Int -> Entropic
$ctoEnum :: Int -> Entropic
pred :: Entropic -> Entropic
$cpred :: Entropic -> Entropic
succ :: Entropic -> Entropic
$csucc :: Entropic -> Entropic
Enum, Integer -> Entropic
Entropic -> Entropic
Entropic -> Entropic -> Entropic
(Entropic -> Entropic -> Entropic)
-> (Entropic -> Entropic -> Entropic)
-> (Entropic -> Entropic -> Entropic)
-> (Entropic -> Entropic)
-> (Entropic -> Entropic)
-> (Entropic -> Entropic)
-> (Integer -> Entropic)
-> Num Entropic
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Entropic
$cfromInteger :: Integer -> Entropic
signum :: Entropic -> Entropic
$csignum :: Entropic -> Entropic
abs :: Entropic -> Entropic
$cabs :: Entropic -> Entropic
negate :: Entropic -> Entropic
$cnegate :: Entropic -> Entropic
* :: Entropic -> Entropic -> Entropic
$c* :: Entropic -> Entropic -> Entropic
- :: Entropic -> Entropic -> Entropic
$c- :: Entropic -> Entropic -> Entropic
+ :: Entropic -> Entropic -> Entropic
$c+ :: Entropic -> Entropic -> Entropic
Num, [Entropic] -> Value
[Entropic] -> Encoding
Entropic -> Value
Entropic -> Encoding
(Entropic -> Value)
-> (Entropic -> Encoding)
-> ([Entropic] -> Value)
-> ([Entropic] -> Encoding)
-> ToJSON Entropic
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Entropic] -> Encoding
$ctoEncodingList :: [Entropic] -> Encoding
toJSONList :: [Entropic] -> Value
$ctoJSONList :: [Entropic] -> Value
toEncoding :: Entropic -> Encoding
$ctoEncoding :: Entropic -> Encoding
toJSON :: Entropic -> Value
$ctoJSON :: Entropic -> Value
ToJSON, Value -> Parser [Entropic]
Value -> Parser Entropic
(Value -> Parser Entropic)
-> (Value -> Parser [Entropic]) -> FromJSON Entropic
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Entropic]
$cparseJSONList :: Value -> Parser [Entropic]
parseJSON :: Value -> Parser Entropic
$cparseJSON :: Value -> Parser Entropic
FromJSON, Typeable Entropic
Typeable Entropic
-> (Entropic -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy Entropic -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Entropic] -> Size)
-> ToCBOR Entropic
Entropic -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Entropic] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy Entropic -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Entropic] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Entropic] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Entropic -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Entropic -> Size
toCBOR :: Entropic -> Encoding
$ctoCBOR :: Entropic -> Encoding
$cp1ToCBOR :: Typeable Entropic
ToCBOR, Typeable Entropic
Decoder s Entropic
Typeable Entropic
-> (forall s. Decoder s Entropic)
-> (Proxy Entropic -> Text)
-> FromCBOR Entropic
Proxy Entropic -> Text
forall s. Decoder s Entropic
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy Entropic -> Text
$clabel :: Proxy Entropic -> Text
fromCBOR :: Decoder s Entropic
$cfromCBOR :: forall s. Decoder s Entropic
$cp1FromCBOR :: Typeable Entropic
FromCBOR)

instance Semigroup Entropic where
  Entropic Integer
a <> :: Entropic -> Entropic -> Entropic
<> Entropic Integer
b = Integer -> Entropic
Entropic (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b)

instance Monoid Entropic where
  mempty :: Entropic
mempty = Integer -> Entropic
Entropic Integer
0


toColeEntropic :: Entropic -> Maybe Cole.Entropic
toColeEntropic :: Entropic -> Maybe Entropic
toColeEntropic (Entropic Integer
x) =
    case Integer -> Either EntropicError Entropic
Cole.integerToEntropic Integer
x of
      Left  EntropicError
_  -> Maybe Entropic
forall a. Maybe a
Nothing
      Right Entropic
x' -> Entropic -> Maybe Entropic
forall a. a -> Maybe a
Just Entropic
x'

fromColeEntropic :: Cole.Entropic -> Entropic
fromColeEntropic :: Entropic -> Entropic
fromColeEntropic = Integer -> Entropic
Entropic (Integer -> Entropic)
-> (Entropic -> Integer) -> Entropic -> Entropic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entropic -> Integer
Cole.entropicToInteger

toSophieEntropic :: Entropic -> Sophie.Coin
toSophieEntropic :: Entropic -> Coin
toSophieEntropic (Entropic Integer
l) = Integer -> Coin
Sophie.Coin Integer
l
--TODO: validate bounds

fromSophieEntropic :: Sophie.Coin -> Entropic
fromSophieEntropic :: Coin -> Entropic
fromSophieEntropic (Sophie.Coin Integer
l) = Integer -> Entropic
Entropic Integer
l

fromSophieDeltaEntropic :: Sophie.DeltaCoin -> Entropic
fromSophieDeltaEntropic :: DeltaCoin -> Entropic
fromSophieDeltaEntropic (Sophie.DeltaCoin Integer
d) = Integer -> Entropic
Entropic Integer
d


-- ----------------------------------------------------------------------------
-- Multi asset Value
--

newtype Quantity = Quantity Integer
  deriving newtype (Quantity -> Quantity -> Bool
(Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool) -> Eq Quantity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quantity -> Quantity -> Bool
$c/= :: Quantity -> Quantity -> Bool
== :: Quantity -> Quantity -> Bool
$c== :: Quantity -> Quantity -> Bool
Eq, Eq Quantity
Eq Quantity
-> (Quantity -> Quantity -> Ordering)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Quantity)
-> (Quantity -> Quantity -> Quantity)
-> Ord Quantity
Quantity -> Quantity -> Bool
Quantity -> Quantity -> Ordering
Quantity -> Quantity -> Quantity
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 :: Quantity -> Quantity -> Quantity
$cmin :: Quantity -> Quantity -> Quantity
max :: Quantity -> Quantity -> Quantity
$cmax :: Quantity -> Quantity -> Quantity
>= :: Quantity -> Quantity -> Bool
$c>= :: Quantity -> Quantity -> Bool
> :: Quantity -> Quantity -> Bool
$c> :: Quantity -> Quantity -> Bool
<= :: Quantity -> Quantity -> Bool
$c<= :: Quantity -> Quantity -> Bool
< :: Quantity -> Quantity -> Bool
$c< :: Quantity -> Quantity -> Bool
compare :: Quantity -> Quantity -> Ordering
$ccompare :: Quantity -> Quantity -> Ordering
$cp1Ord :: Eq Quantity
Ord, Integer -> Quantity
Quantity -> Quantity
Quantity -> Quantity -> Quantity
(Quantity -> Quantity -> Quantity)
-> (Quantity -> Quantity -> Quantity)
-> (Quantity -> Quantity -> Quantity)
-> (Quantity -> Quantity)
-> (Quantity -> Quantity)
-> (Quantity -> Quantity)
-> (Integer -> Quantity)
-> Num Quantity
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Quantity
$cfromInteger :: Integer -> Quantity
signum :: Quantity -> Quantity
$csignum :: Quantity -> Quantity
abs :: Quantity -> Quantity
$cabs :: Quantity -> Quantity
negate :: Quantity -> Quantity
$cnegate :: Quantity -> Quantity
* :: Quantity -> Quantity -> Quantity
$c* :: Quantity -> Quantity -> Quantity
- :: Quantity -> Quantity -> Quantity
$c- :: Quantity -> Quantity -> Quantity
+ :: Quantity -> Quantity -> Quantity
$c+ :: Quantity -> Quantity -> Quantity
Num, Int -> Quantity -> ShowS
[Quantity] -> ShowS
Quantity -> String
(Int -> Quantity -> ShowS)
-> (Quantity -> String) -> ([Quantity] -> ShowS) -> Show Quantity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Quantity] -> ShowS
$cshowList :: [Quantity] -> ShowS
show :: Quantity -> String
$cshow :: Quantity -> String
showsPrec :: Int -> Quantity -> ShowS
$cshowsPrec :: Int -> Quantity -> ShowS
Show, [Quantity] -> Value
[Quantity] -> Encoding
Quantity -> Value
Quantity -> Encoding
(Quantity -> Value)
-> (Quantity -> Encoding)
-> ([Quantity] -> Value)
-> ([Quantity] -> Encoding)
-> ToJSON Quantity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Quantity] -> Encoding
$ctoEncodingList :: [Quantity] -> Encoding
toJSONList :: [Quantity] -> Value
$ctoJSONList :: [Quantity] -> Value
toEncoding :: Quantity -> Encoding
$ctoEncoding :: Quantity -> Encoding
toJSON :: Quantity -> Value
$ctoJSON :: Quantity -> Value
ToJSON, Value -> Parser [Quantity]
Value -> Parser Quantity
(Value -> Parser Quantity)
-> (Value -> Parser [Quantity]) -> FromJSON Quantity
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Quantity]
$cparseJSONList :: Value -> Parser [Quantity]
parseJSON :: Value -> Parser Quantity
$cparseJSON :: Value -> Parser Quantity
FromJSON)

instance Semigroup Quantity where
  Quantity Integer
a <> :: Quantity -> Quantity -> Quantity
<> Quantity Integer
b = Integer -> Quantity
Quantity (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b)

instance Monoid Quantity where
  mempty :: Quantity
mempty = Integer -> Quantity
Quantity Integer
0

entropicToQuantity :: Entropic -> Quantity
entropicToQuantity :: Entropic -> Quantity
entropicToQuantity (Entropic Integer
x) = Integer -> Quantity
Quantity Integer
x

quantityToEntropic :: Quantity -> Entropic
quantityToEntropic :: Quantity -> Entropic
quantityToEntropic (Quantity Integer
x) = Integer -> Entropic
Entropic Integer
x


newtype PolicyId = PolicyId ScriptHash
  deriving stock (PolicyId -> PolicyId -> Bool
(PolicyId -> PolicyId -> Bool)
-> (PolicyId -> PolicyId -> Bool) -> Eq PolicyId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolicyId -> PolicyId -> Bool
$c/= :: PolicyId -> PolicyId -> Bool
== :: PolicyId -> PolicyId -> Bool
$c== :: PolicyId -> PolicyId -> Bool
Eq, Eq PolicyId
Eq PolicyId
-> (PolicyId -> PolicyId -> Ordering)
-> (PolicyId -> PolicyId -> Bool)
-> (PolicyId -> PolicyId -> Bool)
-> (PolicyId -> PolicyId -> Bool)
-> (PolicyId -> PolicyId -> Bool)
-> (PolicyId -> PolicyId -> PolicyId)
-> (PolicyId -> PolicyId -> PolicyId)
-> Ord PolicyId
PolicyId -> PolicyId -> Bool
PolicyId -> PolicyId -> Ordering
PolicyId -> PolicyId -> PolicyId
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 :: PolicyId -> PolicyId -> PolicyId
$cmin :: PolicyId -> PolicyId -> PolicyId
max :: PolicyId -> PolicyId -> PolicyId
$cmax :: PolicyId -> PolicyId -> PolicyId
>= :: PolicyId -> PolicyId -> Bool
$c>= :: PolicyId -> PolicyId -> Bool
> :: PolicyId -> PolicyId -> Bool
$c> :: PolicyId -> PolicyId -> Bool
<= :: PolicyId -> PolicyId -> Bool
$c<= :: PolicyId -> PolicyId -> Bool
< :: PolicyId -> PolicyId -> Bool
$c< :: PolicyId -> PolicyId -> Bool
compare :: PolicyId -> PolicyId -> Ordering
$ccompare :: PolicyId -> PolicyId -> Ordering
$cp1Ord :: Eq PolicyId
Ord)
  deriving (Int -> PolicyId -> ShowS
[PolicyId] -> ShowS
PolicyId -> String
(Int -> PolicyId -> ShowS)
-> (PolicyId -> String) -> ([PolicyId] -> ShowS) -> Show PolicyId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolicyId] -> ShowS
$cshowList :: [PolicyId] -> ShowS
show :: PolicyId -> String
$cshow :: PolicyId -> String
showsPrec :: Int -> PolicyId -> ShowS
$cshowsPrec :: Int -> PolicyId -> ShowS
Show, String -> PolicyId
(String -> PolicyId) -> IsString PolicyId
forall a. (String -> a) -> IsString a
fromString :: String -> PolicyId
$cfromString :: String -> PolicyId
IsString, [PolicyId] -> Value
[PolicyId] -> Encoding
PolicyId -> Value
PolicyId -> Encoding
(PolicyId -> Value)
-> (PolicyId -> Encoding)
-> ([PolicyId] -> Value)
-> ([PolicyId] -> Encoding)
-> ToJSON PolicyId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PolicyId] -> Encoding
$ctoEncodingList :: [PolicyId] -> Encoding
toJSONList :: [PolicyId] -> Value
$ctoJSONList :: [PolicyId] -> Value
toEncoding :: PolicyId -> Encoding
$ctoEncoding :: PolicyId -> Encoding
toJSON :: PolicyId -> Value
$ctoJSON :: PolicyId -> Value
ToJSON, Value -> Parser [PolicyId]
Value -> Parser PolicyId
(Value -> Parser PolicyId)
-> (Value -> Parser [PolicyId]) -> FromJSON PolicyId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PolicyId]
$cparseJSONList :: Value -> Parser [PolicyId]
parseJSON :: Value -> Parser PolicyId
$cparseJSON :: Value -> Parser PolicyId
FromJSON) via UsingRawBytesHex PolicyId

instance HasTypeProxy PolicyId where
    data AsType PolicyId = AsPolicyId
    proxyToAsType :: Proxy PolicyId -> AsType PolicyId
proxyToAsType Proxy PolicyId
_ = AsType PolicyId
AsPolicyId

instance SerialiseAsRawBytes PolicyId where
    serialiseToRawBytes :: PolicyId -> ByteString
serialiseToRawBytes (PolicyId ScriptHash
sh) = ScriptHash -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes ScriptHash
sh
    deserialiseFromRawBytes :: AsType PolicyId -> ByteString -> Maybe PolicyId
deserialiseFromRawBytes AsType PolicyId
AsPolicyId ByteString
bs =
      ScriptHash -> PolicyId
PolicyId (ScriptHash -> PolicyId) -> Maybe ScriptHash -> Maybe PolicyId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType ScriptHash -> ByteString -> Maybe ScriptHash
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes AsType ScriptHash
AsScriptHash ByteString
bs

scriptPolicyId :: Script lang -> PolicyId
scriptPolicyId :: Script lang -> PolicyId
scriptPolicyId = ScriptHash -> PolicyId
PolicyId (ScriptHash -> PolicyId)
-> (Script lang -> ScriptHash) -> Script lang -> PolicyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript


newtype AssetName = AssetName ByteString
    deriving stock (AssetName -> AssetName -> Bool
(AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool) -> Eq AssetName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssetName -> AssetName -> Bool
$c/= :: AssetName -> AssetName -> Bool
== :: AssetName -> AssetName -> Bool
$c== :: AssetName -> AssetName -> Bool
Eq, Eq AssetName
Eq AssetName
-> (AssetName -> AssetName -> Ordering)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> Bool)
-> (AssetName -> AssetName -> AssetName)
-> (AssetName -> AssetName -> AssetName)
-> Ord AssetName
AssetName -> AssetName -> Bool
AssetName -> AssetName -> Ordering
AssetName -> AssetName -> AssetName
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 :: AssetName -> AssetName -> AssetName
$cmin :: AssetName -> AssetName -> AssetName
max :: AssetName -> AssetName -> AssetName
$cmax :: AssetName -> AssetName -> AssetName
>= :: AssetName -> AssetName -> Bool
$c>= :: AssetName -> AssetName -> Bool
> :: AssetName -> AssetName -> Bool
$c> :: AssetName -> AssetName -> Bool
<= :: AssetName -> AssetName -> Bool
$c<= :: AssetName -> AssetName -> Bool
< :: AssetName -> AssetName -> Bool
$c< :: AssetName -> AssetName -> Bool
compare :: AssetName -> AssetName -> Ordering
$ccompare :: AssetName -> AssetName -> Ordering
$cp1Ord :: Eq AssetName
Ord)
    deriving newtype (Int -> AssetName -> ShowS
[AssetName] -> ShowS
AssetName -> String
(Int -> AssetName -> ShowS)
-> (AssetName -> String)
-> ([AssetName] -> ShowS)
-> Show AssetName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssetName] -> ShowS
$cshowList :: [AssetName] -> ShowS
show :: AssetName -> String
$cshow :: AssetName -> String
showsPrec :: Int -> AssetName -> ShowS
$cshowsPrec :: Int -> AssetName -> ShowS
Show)    

instance IsString AssetName where
    fromString :: String -> AssetName
fromString String
s
      | let bs :: ByteString
bs = Text -> ByteString
Text.encodeUtf8 (String -> Text
Text.pack String
s)
      , ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 = ByteString -> AssetName
AssetName (String -> ByteString
BSC.pack String
s)
      | Bool
otherwise          = String -> AssetName
forall a. HasCallStack => String -> a
error String
"fromString: AssetName over 32 bytes"

instance HasTypeProxy AssetName where
    data AsType AssetName = AsAssetName
    proxyToAsType :: Proxy AssetName -> AsType AssetName
proxyToAsType Proxy AssetName
_ = AsType AssetName
AsAssetName

instance SerialiseAsRawBytes AssetName where
    serialiseToRawBytes :: AssetName -> ByteString
serialiseToRawBytes (AssetName ByteString
bs) = ByteString
bs
    deserialiseFromRawBytes :: AsType AssetName -> ByteString -> Maybe AssetName
deserialiseFromRawBytes AsType AssetName
AsAssetName ByteString
bs
      | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 = AssetName -> Maybe AssetName
forall a. a -> Maybe a
Just (ByteString -> AssetName
AssetName ByteString
bs)
      | Bool
otherwise          = Maybe AssetName
forall a. Maybe a
Nothing

instance ToJSON AssetName where
  toJSON :: AssetName -> Value
toJSON (AssetName ByteString
an) = Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8 ByteString
an

instance FromJSON AssetName where
  parseJSON :: Value -> Parser AssetName
parseJSON = String -> (Text -> Parser AssetName) -> Value -> Parser AssetName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"AssetName" (AssetName -> Parser AssetName
forall (m :: * -> *) a. Monad m => a -> m a
return (AssetName -> Parser AssetName)
-> (Text -> AssetName) -> Text -> Parser AssetName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AssetName
AssetName (ByteString -> AssetName)
-> (Text -> ByteString) -> Text -> AssetName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8)

instance ToJSONKey AssetName where
  toJSONKey :: ToJSONKeyFunction AssetName
toJSONKey = (AssetName -> Text) -> ToJSONKeyFunction AssetName
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (\(AssetName ByteString
asset) -> ByteString -> Text
Text.decodeUtf8 ByteString
asset)

instance FromJSONKey AssetName where
  fromJSONKey :: FromJSONKeyFunction AssetName
fromJSONKey = (Text -> AssetName) -> FromJSONKeyFunction AssetName
forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText (ByteString -> AssetName
AssetName (ByteString -> AssetName)
-> (Text -> ByteString) -> Text -> AssetName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8)


data AssetId = BccAssetId
             | AssetId !PolicyId !AssetName
  deriving (AssetId -> AssetId -> Bool
(AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool) -> Eq AssetId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssetId -> AssetId -> Bool
$c/= :: AssetId -> AssetId -> Bool
== :: AssetId -> AssetId -> Bool
$c== :: AssetId -> AssetId -> Bool
Eq, Eq AssetId
Eq AssetId
-> (AssetId -> AssetId -> Ordering)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> AssetId)
-> (AssetId -> AssetId -> AssetId)
-> Ord AssetId
AssetId -> AssetId -> Bool
AssetId -> AssetId -> Ordering
AssetId -> AssetId -> AssetId
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 :: AssetId -> AssetId -> AssetId
$cmin :: AssetId -> AssetId -> AssetId
max :: AssetId -> AssetId -> AssetId
$cmax :: AssetId -> AssetId -> AssetId
>= :: AssetId -> AssetId -> Bool
$c>= :: AssetId -> AssetId -> Bool
> :: AssetId -> AssetId -> Bool
$c> :: AssetId -> AssetId -> Bool
<= :: AssetId -> AssetId -> Bool
$c<= :: AssetId -> AssetId -> Bool
< :: AssetId -> AssetId -> Bool
$c< :: AssetId -> AssetId -> Bool
compare :: AssetId -> AssetId -> Ordering
$ccompare :: AssetId -> AssetId -> Ordering
$cp1Ord :: Eq AssetId
Ord, Int -> AssetId -> ShowS
[AssetId] -> ShowS
AssetId -> String
(Int -> AssetId -> ShowS)
-> (AssetId -> String) -> ([AssetId] -> ShowS) -> Show AssetId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssetId] -> ShowS
$cshowList :: [AssetId] -> ShowS
show :: AssetId -> String
$cshow :: AssetId -> String
showsPrec :: Int -> AssetId -> ShowS
$cshowsPrec :: Int -> AssetId -> ShowS
Show)


newtype Value = Value (Map AssetId Quantity)
  deriving Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq

instance Show Value where
  showsPrec :: Int -> Value -> ShowS
showsPrec Int
d Value
v = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"valueFromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(AssetId, Quantity)] -> ShowS
forall a. Show a => a -> ShowS
shows (Value -> [(AssetId, Quantity)]
valueToList Value
v)

instance Semigroup Value where
  Value Map AssetId Quantity
a <> :: Value -> Value -> Value
<> Value Map AssetId Quantity
b = Map AssetId Quantity -> Value
Value (Map AssetId Quantity
-> Map AssetId Quantity -> Map AssetId Quantity
mergeAssetMaps Map AssetId Quantity
a Map AssetId Quantity
b)

instance Monoid Value where
  mempty :: Value
mempty = Map AssetId Quantity -> Value
Value Map AssetId Quantity
forall k a. Map k a
Map.empty


{-# NOINLINE mergeAssetMaps #-} -- as per advice in Data.Map.Merge docs
mergeAssetMaps :: Map AssetId Quantity
               -> Map AssetId Quantity
               -> Map AssetId Quantity
mergeAssetMaps :: Map AssetId Quantity
-> Map AssetId Quantity -> Map AssetId Quantity
mergeAssetMaps =
    SimpleWhenMissing AssetId Quantity Quantity
-> SimpleWhenMissing AssetId Quantity Quantity
-> SimpleWhenMatched AssetId Quantity Quantity Quantity
-> Map AssetId Quantity
-> Map AssetId Quantity
-> Map AssetId Quantity
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
      SimpleWhenMissing AssetId Quantity Quantity
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
      SimpleWhenMissing AssetId Quantity Quantity
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
      ((AssetId -> Quantity -> Quantity -> Maybe Quantity)
-> SimpleWhenMatched AssetId Quantity Quantity Quantity
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched AssetId -> Quantity -> Quantity -> Maybe Quantity
mergeQuantity)
  where
    mergeQuantity :: AssetId -> Quantity -> Quantity -> Maybe Quantity
    mergeQuantity :: AssetId -> Quantity -> Quantity -> Maybe Quantity
mergeQuantity AssetId
_k Quantity
a Quantity
b =
      case Quantity
a Quantity -> Quantity -> Quantity
forall a. Semigroup a => a -> a -> a
<> Quantity
b of
        Quantity Integer
0 -> Maybe Quantity
forall a. Maybe a
Nothing
        Quantity
c          -> Quantity -> Maybe Quantity
forall a. a -> Maybe a
Just Quantity
c

instance ToJSON Value where
  toJSON :: Value -> Value
toJSON = ValueNestedRep -> Value
forall a. ToJSON a => a -> Value
toJSON (ValueNestedRep -> Value)
-> (Value -> ValueNestedRep) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ValueNestedRep
valueToNestedRep

instance FromJSON Value where
  parseJSON :: Value -> Parser Value
parseJSON Value
v = ValueNestedRep -> Value
valueFromNestedRep (ValueNestedRep -> Value) -> Parser ValueNestedRep -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ValueNestedRep
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v


selectAsset :: Value -> (AssetId -> Quantity)
selectAsset :: Value -> AssetId -> Quantity
selectAsset (Value Map AssetId Quantity
m) AssetId
a = Quantity -> AssetId -> Map AssetId Quantity -> Quantity
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Quantity
forall a. Monoid a => a
mempty AssetId
a Map AssetId Quantity
m

valueFromList :: [(AssetId, Quantity)] -> Value
valueFromList :: [(AssetId, Quantity)] -> Value
valueFromList = Map AssetId Quantity -> Value
Value
              (Map AssetId Quantity -> Value)
-> ([(AssetId, Quantity)] -> Map AssetId Quantity)
-> [(AssetId, Quantity)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quantity -> Bool) -> Map AssetId Quantity -> Map AssetId Quantity
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/= Quantity
0)
              (Map AssetId Quantity -> Map AssetId Quantity)
-> ([(AssetId, Quantity)] -> Map AssetId Quantity)
-> [(AssetId, Quantity)]
-> Map AssetId Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quantity -> Quantity -> Quantity)
-> [(AssetId, Quantity)] -> Map AssetId Quantity
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Quantity -> Quantity -> Quantity
forall a. Semigroup a => a -> a -> a
(<>)

valueToList :: Value -> [(AssetId, Quantity)]
valueToList :: Value -> [(AssetId, Quantity)]
valueToList (Value Map AssetId Quantity
m) = Map AssetId Quantity -> [(AssetId, Quantity)]
forall k a. Map k a -> [(k, a)]
Map.toList Map AssetId Quantity
m

-- | This lets you write @a - b@ as @a <> negateValue b@.
--
negateValue :: Value -> Value
negateValue :: Value -> Value
negateValue (Value Map AssetId Quantity
m) = Map AssetId Quantity -> Value
Value ((Quantity -> Quantity)
-> Map AssetId Quantity -> Map AssetId Quantity
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Quantity -> Quantity
forall a. Num a => a -> a
negate Map AssetId Quantity
m)

filterValue :: (AssetId -> Bool) -> Value -> Value
filterValue :: (AssetId -> Bool) -> Value -> Value
filterValue AssetId -> Bool
p (Value Map AssetId Quantity
m) = Map AssetId Quantity -> Value
Value ((AssetId -> Quantity -> Bool)
-> Map AssetId Quantity -> Map AssetId Quantity
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\AssetId
k Quantity
_v -> AssetId -> Bool
p AssetId
k) Map AssetId Quantity
m)

selectEntropic :: Value -> Entropic
selectEntropic :: Value -> Entropic
selectEntropic = Quantity -> Entropic
quantityToEntropic (Quantity -> Entropic) -> (Value -> Quantity) -> Value -> Entropic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> AssetId -> Quantity) -> AssetId -> Value -> Quantity
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value -> AssetId -> Quantity
selectAsset AssetId
BccAssetId

entropicToValue :: Entropic -> Value
entropicToValue :: Entropic -> Value
entropicToValue = Map AssetId Quantity -> Value
Value (Map AssetId Quantity -> Value)
-> (Entropic -> Map AssetId Quantity) -> Entropic -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetId -> Quantity -> Map AssetId Quantity
forall k a. k -> a -> Map k a
Map.singleton AssetId
BccAssetId (Quantity -> Map AssetId Quantity)
-> (Entropic -> Quantity) -> Entropic -> Map AssetId Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entropic -> Quantity
entropicToQuantity

-- | Check if the 'Value' consists of /only/ 'Entropic' and no other assets,
-- and if so then return the Entropic.
--
-- See also 'selectEntropic' to select the Entropic quantity from the Value,
-- ignoring other assets.
--
valueToEntropic :: Value -> Maybe Entropic
valueToEntropic :: Value -> Maybe Entropic
valueToEntropic Value
v =
    case Value -> [(AssetId, Quantity)]
valueToList Value
v of
      []                -> Entropic -> Maybe Entropic
forall a. a -> Maybe a
Just (Integer -> Entropic
Entropic Integer
0)
      [(AssetId
BccAssetId, Quantity
q)] -> Entropic -> Maybe Entropic
forall a. a -> Maybe a
Just (Quantity -> Entropic
quantityToEntropic Quantity
q)
      [(AssetId, Quantity)]
_                 -> Maybe Entropic
forall a. Maybe a
Nothing

toJenValue :: Value -> Jen.Value StandardCrypto
toJenValue :: Value -> Value StandardCrypto
toJenValue Value
v =
    Integer
-> Map (PolicyID StandardCrypto) (Map AssetName Integer)
-> Value StandardCrypto
forall crypto.
Integer
-> Map (PolicyID crypto) (Map AssetName Integer) -> Value crypto
Jen.Value Integer
entropic Map (PolicyID StandardCrypto) (Map AssetName Integer)
other
  where
    Quantity Integer
entropic = Value -> AssetId -> Quantity
selectAsset Value
v AssetId
BccAssetId
      --TODO: write QC tests to show it's ok to use Map.fromAscListWith here
    other :: Map (PolicyID StandardCrypto) (Map AssetName Integer)
other = (Map AssetName Integer
 -> Map AssetName Integer -> Map AssetName Integer)
-> [(PolicyID StandardCrypto, Map AssetName Integer)]
-> Map (PolicyID StandardCrypto) (Map AssetName Integer)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Map AssetName Integer
-> Map AssetName Integer -> Map AssetName Integer
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
              [ (PolicyId -> PolicyID StandardCrypto
toJenPolicyID PolicyId
pid, AssetName -> Integer -> Map AssetName Integer
forall k a. k -> a -> Map k a
Map.singleton (AssetName -> AssetName
toJenAssetName AssetName
name) Integer
q)
              | (AssetId PolicyId
pid AssetName
name, Quantity Integer
q) <- Value -> [(AssetId, Quantity)]
valueToList Value
v ]

    toJenPolicyID :: PolicyId -> Jen.PolicyID StandardCrypto
    toJenPolicyID :: PolicyId -> PolicyID StandardCrypto
toJenPolicyID (PolicyId ScriptHash
sh) = ScriptHash StandardCrypto -> PolicyID StandardCrypto
forall crypto. ScriptHash crypto -> PolicyID crypto
Jen.PolicyID (ScriptHash -> ScriptHash StandardCrypto
toSophieScriptHash ScriptHash
sh)

    toJenAssetName :: AssetName -> Jen.AssetName
    toJenAssetName :: AssetName -> AssetName
toJenAssetName (AssetName ByteString
n) = ByteString -> AssetName
Jen.AssetName ByteString
n


fromJenValue :: Jen.Value StandardCrypto -> Value
fromJenValue :: Value StandardCrypto -> Value
fromJenValue (Jen.Value Integer
entropic Map (PolicyID StandardCrypto) (Map AssetName Integer)
other) =
    Map AssetId Quantity -> Value
Value (Map AssetId Quantity -> Value) -> Map AssetId Quantity -> Value
forall a b. (a -> b) -> a -> b
$
      --TODO: write QC tests to show it's ok to use Map.fromAscList here
      [(AssetId, Quantity)] -> Map AssetId Quantity
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(AssetId, Quantity)] -> Map AssetId Quantity)
-> [(AssetId, Quantity)] -> Map AssetId Quantity
forall a b. (a -> b) -> a -> b
$
        [ (AssetId
BccAssetId, Integer -> Quantity
Quantity Integer
entropic) | Integer
entropic Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 ]
     [(AssetId, Quantity)]
-> [(AssetId, Quantity)] -> [(AssetId, Quantity)]
forall a. [a] -> [a] -> [a]
++ [ (PolicyId -> AssetName -> AssetId
AssetId (PolicyID StandardCrypto -> PolicyId
fromJenPolicyID PolicyID StandardCrypto
pid) (AssetName -> AssetName
fromJenAssetName AssetName
name), Integer -> Quantity
Quantity Integer
q)
        | (PolicyID StandardCrypto
pid, Map AssetName Integer
as) <- Map (PolicyID StandardCrypto) (Map AssetName Integer)
-> [(PolicyID StandardCrypto, Map AssetName Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (PolicyID StandardCrypto) (Map AssetName Integer)
other
        , (AssetName
name, Integer
q) <- Map AssetName Integer -> [(AssetName, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList Map AssetName Integer
as ]
  where
    fromJenPolicyID :: Jen.PolicyID StandardCrypto -> PolicyId
    fromJenPolicyID :: PolicyID StandardCrypto -> PolicyId
fromJenPolicyID (Jen.PolicyID ScriptHash StandardCrypto
sh) = ScriptHash -> PolicyId
PolicyId (ScriptHash StandardCrypto -> ScriptHash
fromSophieScriptHash ScriptHash StandardCrypto
sh)

    fromJenAssetName :: Jen.AssetName -> AssetName
    fromJenAssetName :: AssetName -> AssetName
fromJenAssetName (Jen.AssetName ByteString
n) = ByteString -> AssetName
AssetName ByteString
n

-- | Calculate cost of making a UTxO entry for a given 'Value' and
-- mininimum UTxO value derived from the 'ProtocolParameters'
calcMinimumDeposit :: Value -> Entropic -> Entropic
calcMinimumDeposit :: Value -> Entropic -> Entropic
calcMinimumDeposit Value
v Entropic
minUTxo =
  Coin -> Entropic
fromSophieEntropic (Coin -> Entropic) -> Coin -> Entropic
forall a b. (a -> b) -> a -> b
$ Value StandardCrypto -> Coin -> Coin
forall v. Val v => v -> Coin -> Coin
Sophie.scaledMinDeposit (Value -> Value StandardCrypto
toJenValue Value
v) (Entropic -> Coin
toSophieEntropic Entropic
minUTxo)

-- ----------------------------------------------------------------------------
-- An alternative nested representation
--

-- | An alternative nested representation for 'Value' that groups assets that
-- share a 'PolicyId'.
--
newtype ValueNestedRep = ValueNestedRep [ValueNestedBundle]
  deriving (ValueNestedRep -> ValueNestedRep -> Bool
(ValueNestedRep -> ValueNestedRep -> Bool)
-> (ValueNestedRep -> ValueNestedRep -> Bool) -> Eq ValueNestedRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueNestedRep -> ValueNestedRep -> Bool
$c/= :: ValueNestedRep -> ValueNestedRep -> Bool
== :: ValueNestedRep -> ValueNestedRep -> Bool
$c== :: ValueNestedRep -> ValueNestedRep -> Bool
Eq, Eq ValueNestedRep
Eq ValueNestedRep
-> (ValueNestedRep -> ValueNestedRep -> Ordering)
-> (ValueNestedRep -> ValueNestedRep -> Bool)
-> (ValueNestedRep -> ValueNestedRep -> Bool)
-> (ValueNestedRep -> ValueNestedRep -> Bool)
-> (ValueNestedRep -> ValueNestedRep -> Bool)
-> (ValueNestedRep -> ValueNestedRep -> ValueNestedRep)
-> (ValueNestedRep -> ValueNestedRep -> ValueNestedRep)
-> Ord ValueNestedRep
ValueNestedRep -> ValueNestedRep -> Bool
ValueNestedRep -> ValueNestedRep -> Ordering
ValueNestedRep -> ValueNestedRep -> ValueNestedRep
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 :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
$cmin :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
max :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
$cmax :: ValueNestedRep -> ValueNestedRep -> ValueNestedRep
>= :: ValueNestedRep -> ValueNestedRep -> Bool
$c>= :: ValueNestedRep -> ValueNestedRep -> Bool
> :: ValueNestedRep -> ValueNestedRep -> Bool
$c> :: ValueNestedRep -> ValueNestedRep -> Bool
<= :: ValueNestedRep -> ValueNestedRep -> Bool
$c<= :: ValueNestedRep -> ValueNestedRep -> Bool
< :: ValueNestedRep -> ValueNestedRep -> Bool
$c< :: ValueNestedRep -> ValueNestedRep -> Bool
compare :: ValueNestedRep -> ValueNestedRep -> Ordering
$ccompare :: ValueNestedRep -> ValueNestedRep -> Ordering
$cp1Ord :: Eq ValueNestedRep
Ord, Int -> ValueNestedRep -> ShowS
[ValueNestedRep] -> ShowS
ValueNestedRep -> String
(Int -> ValueNestedRep -> ShowS)
-> (ValueNestedRep -> String)
-> ([ValueNestedRep] -> ShowS)
-> Show ValueNestedRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueNestedRep] -> ShowS
$cshowList :: [ValueNestedRep] -> ShowS
show :: ValueNestedRep -> String
$cshow :: ValueNestedRep -> String
showsPrec :: Int -> ValueNestedRep -> ShowS
$cshowsPrec :: Int -> ValueNestedRep -> ShowS
Show)

-- | A bundle within a 'ValueNestedRep' for a single 'PolicyId', or for the
-- special case of bcc.
--
data ValueNestedBundle = ValueNestedBundleBcc Quantity
                       | ValueNestedBundle PolicyId (Map AssetName Quantity)
  deriving (ValueNestedBundle -> ValueNestedBundle -> Bool
(ValueNestedBundle -> ValueNestedBundle -> Bool)
-> (ValueNestedBundle -> ValueNestedBundle -> Bool)
-> Eq ValueNestedBundle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c/= :: ValueNestedBundle -> ValueNestedBundle -> Bool
== :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c== :: ValueNestedBundle -> ValueNestedBundle -> Bool
Eq, Eq ValueNestedBundle
Eq ValueNestedBundle
-> (ValueNestedBundle -> ValueNestedBundle -> Ordering)
-> (ValueNestedBundle -> ValueNestedBundle -> Bool)
-> (ValueNestedBundle -> ValueNestedBundle -> Bool)
-> (ValueNestedBundle -> ValueNestedBundle -> Bool)
-> (ValueNestedBundle -> ValueNestedBundle -> Bool)
-> (ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle)
-> (ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle)
-> Ord ValueNestedBundle
ValueNestedBundle -> ValueNestedBundle -> Bool
ValueNestedBundle -> ValueNestedBundle -> Ordering
ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
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 :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
$cmin :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
max :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
$cmax :: ValueNestedBundle -> ValueNestedBundle -> ValueNestedBundle
>= :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c>= :: ValueNestedBundle -> ValueNestedBundle -> Bool
> :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c> :: ValueNestedBundle -> ValueNestedBundle -> Bool
<= :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c<= :: ValueNestedBundle -> ValueNestedBundle -> Bool
< :: ValueNestedBundle -> ValueNestedBundle -> Bool
$c< :: ValueNestedBundle -> ValueNestedBundle -> Bool
compare :: ValueNestedBundle -> ValueNestedBundle -> Ordering
$ccompare :: ValueNestedBundle -> ValueNestedBundle -> Ordering
$cp1Ord :: Eq ValueNestedBundle
Ord, Int -> ValueNestedBundle -> ShowS
[ValueNestedBundle] -> ShowS
ValueNestedBundle -> String
(Int -> ValueNestedBundle -> ShowS)
-> (ValueNestedBundle -> String)
-> ([ValueNestedBundle] -> ShowS)
-> Show ValueNestedBundle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueNestedBundle] -> ShowS
$cshowList :: [ValueNestedBundle] -> ShowS
show :: ValueNestedBundle -> String
$cshow :: ValueNestedBundle -> String
showsPrec :: Int -> ValueNestedBundle -> ShowS
$cshowsPrec :: Int -> ValueNestedBundle -> ShowS
Show)


valueToNestedRep :: Value -> ValueNestedRep
valueToNestedRep :: Value -> ValueNestedRep
valueToNestedRep Value
v =
    -- unflatten all the non-bcc assets, and add bcc separately
    [ValueNestedBundle] -> ValueNestedRep
ValueNestedRep ([ValueNestedBundle] -> ValueNestedRep)
-> [ValueNestedBundle] -> ValueNestedRep
forall a b. (a -> b) -> a -> b
$
        [ Quantity -> ValueNestedBundle
ValueNestedBundleBcc Quantity
q | let q :: Quantity
q = Value -> AssetId -> Quantity
selectAsset Value
v AssetId
BccAssetId, Quantity
q Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/= Quantity
0 ]
     [ValueNestedBundle] -> [ValueNestedBundle] -> [ValueNestedBundle]
forall a. [a] -> [a] -> [a]
++ [ PolicyId -> Map AssetName Quantity -> ValueNestedBundle
ValueNestedBundle PolicyId
pId Map AssetName Quantity
qs | (PolicyId
pId, Map AssetName Quantity
qs) <- Map PolicyId (Map AssetName Quantity)
-> [(PolicyId, Map AssetName Quantity)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PolicyId (Map AssetName Quantity)
nonBccAssets ]
  where
    nonBccAssets :: Map PolicyId (Map AssetName Quantity)
    nonBccAssets :: Map PolicyId (Map AssetName Quantity)
nonBccAssets =
      (Map AssetName Quantity
 -> Map AssetName Quantity -> Map AssetName Quantity)
-> [(PolicyId, Map AssetName Quantity)]
-> Map PolicyId (Map AssetName Quantity)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((Quantity -> Quantity -> Quantity)
-> Map AssetName Quantity
-> Map AssetName Quantity
-> Map AssetName Quantity
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Quantity -> Quantity -> Quantity
forall a. Semigroup a => a -> a -> a
(<>))
        [ (PolicyId
pId, AssetName -> Quantity -> Map AssetName Quantity
forall k a. k -> a -> Map k a
Map.singleton AssetName
aName Quantity
q)
        | (AssetId PolicyId
pId AssetName
aName, Quantity
q) <- Value -> [(AssetId, Quantity)]
valueToList Value
v ]

valueFromNestedRep :: ValueNestedRep -> Value
valueFromNestedRep :: ValueNestedRep -> Value
valueFromNestedRep (ValueNestedRep [ValueNestedBundle]
bundles) =
    [(AssetId, Quantity)] -> Value
valueFromList
      [ (AssetId
aId, Quantity
q)
      | ValueNestedBundle
bundle   <- [ValueNestedBundle]
bundles
      , (AssetId
aId, Quantity
q) <- case ValueNestedBundle
bundle of
                      ValueNestedBundleBcc  Quantity
q  -> [ (AssetId
BccAssetId, Quantity
q) ]
                      ValueNestedBundle PolicyId
pId Map AssetName Quantity
qs -> [ (PolicyId -> AssetName -> AssetId
AssetId PolicyId
pId AssetName
aName, Quantity
q)
                                                  | (AssetName
aName, Quantity
q) <- Map AssetName Quantity -> [(AssetName, Quantity)]
forall k a. Map k a -> [(k, a)]
Map.toList Map AssetName Quantity
qs ]
      ]

instance ToJSON ValueNestedRep where
  toJSON :: ValueNestedRep -> Value
toJSON (ValueNestedRep [ValueNestedBundle]
bundles) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (ValueNestedBundle -> Pair) -> [ValueNestedBundle] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ValueNestedBundle -> Pair
toPair [ValueNestedBundle]
bundles
    where
     toPair :: ValueNestedBundle -> (Text, Aeson.Value)
     toPair :: ValueNestedBundle -> Pair
toPair (ValueNestedBundleBcc Quantity
q) = (Text
"entropic", Quantity -> Value
forall a. ToJSON a => a -> Value
toJSON Quantity
q)
     toPair (ValueNestedBundle PolicyId
pid Map AssetName Quantity
assets) = (PolicyId -> Text
renderPolicyId PolicyId
pid, Map AssetName Quantity -> Value
forall a. ToJSON a => a -> Value
toJSON Map AssetName Quantity
assets)

instance FromJSON ValueNestedRep where
  parseJSON :: Value -> Parser ValueNestedRep
parseJSON =
      String
-> (Object -> Parser ValueNestedRep)
-> Value
-> Parser ValueNestedRep
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ValueNestedRep" ((Object -> Parser ValueNestedRep)
 -> Value -> Parser ValueNestedRep)
-> (Object -> Parser ValueNestedRep)
-> Value
-> Parser ValueNestedRep
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        [ValueNestedBundle] -> ValueNestedRep
ValueNestedRep ([ValueNestedBundle] -> ValueNestedRep)
-> Parser [ValueNestedBundle] -> Parser ValueNestedRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser ValueNestedBundle] -> Parser [ValueNestedBundle]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [ Pair -> Parser ValueNestedBundle
parsePid Pair
keyValTuple
                                   | Pair
keyValTuple <- Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList Object
obj ]
    where
      parsePid :: (Text, Aeson.Value) -> Parser ValueNestedBundle
      parsePid :: Pair -> Parser ValueNestedBundle
parsePid (Text
"entropic", Value
q) = Quantity -> ValueNestedBundle
ValueNestedBundleBcc (Quantity -> ValueNestedBundle)
-> Parser Quantity -> Parser ValueNestedBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Quantity
forall a. FromJSON a => Value -> Parser a
parseJSON Value
q
      parsePid (Text
pid, Value
q) =
        case AsType ScriptHash -> ByteString -> Maybe ScriptHash
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex AsType ScriptHash
AsScriptHash (Text -> ByteString
Text.encodeUtf8 Text
pid) of
          Just ScriptHash
sHash -> PolicyId -> Map AssetName Quantity -> ValueNestedBundle
ValueNestedBundle (ScriptHash -> PolicyId
PolicyId ScriptHash
sHash) (Map AssetName Quantity -> ValueNestedBundle)
-> Parser (Map AssetName Quantity) -> Parser ValueNestedBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map AssetName Quantity)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
q
          Maybe ScriptHash
Nothing -> String -> Parser ValueNestedBundle
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ValueNestedBundle)
-> String -> Parser ValueNestedBundle
forall a b. (a -> b) -> a -> b
$ String
"Failure when deserialising PolicyId: "
                         String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
pid

-- ----------------------------------------------------------------------------
-- Printing and pretty-printing
--

-- | Render a textual representation of a 'Value'.
--
renderValue :: Value -> Text
renderValue :: Value -> Text
renderValue  Value
v =
    Text -> [Text] -> Text
Text.intercalate
      Text
" + "
      (((AssetId, Quantity) -> Text) -> [(AssetId, Quantity)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (AssetId, Quantity) -> Text
renderAssetIdQuantityPair [(AssetId, Quantity)]
vals)
  where
    vals :: [(AssetId, Quantity)]
    vals :: [(AssetId, Quantity)]
vals = Value -> [(AssetId, Quantity)]
valueToList Value
v

-- | Render a \"prettified\" textual representation of a 'Value'.
renderValuePretty :: Value -> Text
renderValuePretty :: Value -> Text
renderValuePretty Value
v =
    Text -> [Text] -> Text
Text.intercalate
      (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
4 Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"+ ")
      (((AssetId, Quantity) -> Text) -> [(AssetId, Quantity)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (AssetId, Quantity) -> Text
renderAssetIdQuantityPair [(AssetId, Quantity)]
vals)
  where
    vals :: [(AssetId, Quantity)]
    vals :: [(AssetId, Quantity)]
vals = Value -> [(AssetId, Quantity)]
valueToList Value
v

renderAssetIdQuantityPair :: (AssetId, Quantity) -> Text
renderAssetIdQuantityPair :: (AssetId, Quantity) -> Text
renderAssetIdQuantityPair (AssetId
aId, Quantity
quant) =
  String -> Text
Text.pack (Quantity -> String
forall a. Show a => a -> String
show Quantity
quant) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AssetId -> Text
renderAssetId AssetId
aId

renderPolicyId :: PolicyId -> Text
renderPolicyId :: PolicyId -> Text
renderPolicyId (PolicyId ScriptHash
scriptHash) = ScriptHash -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText ScriptHash
scriptHash

renderAssetId :: AssetId -> Text
renderAssetId :: AssetId -> Text
renderAssetId AssetId
BccAssetId = Text
"entropic"
renderAssetId (AssetId PolicyId
polId (AssetName ByteString
assetName))
  | ByteString -> Bool
BS.null ByteString
assetName = PolicyId -> Text
renderPolicyId PolicyId
polId
  | Bool
otherwise         = PolicyId -> Text
renderPolicyId PolicyId
polId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeUtf8 ByteString
assetName