{- |
Module      : Singular.Registry.Wire.State
Description : Token state, policy accessors, and the cage datum
License     : Apache-2.0

What the cage holds: the eight-field token state with its codec and
policy-byte accessors, and the cage datum — a pending request, a
state, or the refund-only custody of an absent token. Reads
"Singular.Registry.Wire.Primitive" and
"Singular.Registry.Wire.Request"; nothing here is importable by a
caller — the public surface is the "Singular.Registry.Types" facade.
-}
module Singular.Registry.Wire.State
    ( -- * On-chain token state
      OnChainTokenState (..)
    , stateActivePolicyBytes
    , stateAppPolicyBytes
    , stateAbsentPolicyBytes
    , stateTerminalPolicyBytes

      -- * Cage datum
    , CageDatum (..)
    ) where

import Data.ByteString (ByteString)
import PlutusCore.Data (Data (..))
import PlutusTx.Builtins.Internal
    ( BuiltinByteString (..)
    )
import PlutusTx.IsData.Class
    ( FromData (..)
    , ToData (..)
    , UnsafeFromData (..)
    )
import Singular.Registry.Wire.Primitive
    ( OnChainRoot (..)
    , bbsFromD
    , bbsToD
    , bsFromD
    , bsToD
    , mkD
    , unD
    )
import Singular.Registry.Wire.Request
    ( OnChainRequest (..)
    )

{- | On-chain token state. Matches Aiken @types\/State@ (#157 state-datum-fields: eight
fields, replacing the six). `consumer_pin` is deleted with the pinned
consumer; `representative_policy` is renamed `active_policy`; the
application, absent and terminal policies are new. All four policies are
set at genesis and preserved by every `Modify`.
-}
data OnChainTokenState = OnChainTokenState
    { OnChainTokenState -> OnChainRoot
stateRoot :: !OnChainRoot
    -- ^ Current Merkle root of the token's trie
    , OnChainTokenState -> Integer
stateMaxFee :: !Integer
    -- ^ Oracle tip (lovelace) charged per request
    , OnChainTokenState -> Integer
stateProcessTime :: !Integer
    -- ^ Oracle processing window duration (ms)
    , OnChainTokenState -> Integer
stateRetractTime :: !Integer
    -- ^ Requester retract window duration (ms)
    , OnChainTokenState -> BuiltinByteString
stateAppPolicy :: !BuiltinByteString
    {- ^ The application policy that certifies requests (#157 tree-edge-admission-by-approval): a
    request whose operation changes the trie is folded only if its
    UTxO carries one asset under this policy whose name is the
    request's approval binding.
    -}
    , OnChainTokenState -> BuiltinByteString
stateActivePolicy :: !BuiltinByteString
    {- ^ The policy that mints the ACTIVE token (renamed from the
    representative policy). Under it the asset name is the registry
    key itself (#157 token-name-is-registry-key).
    -}
    , OnChainTokenState -> BuiltinByteString
stateAbsentPolicy :: !BuiltinByteString
    {- ^ The policy that mints the ABSENT token, held in the cage's own
    custody beside the inserter's refund address.
    -}
    , OnChainTokenState -> BuiltinByteString
stateTerminalPolicy :: !BuiltinByteString
    {- ^ The policy that mints the TERMINAL token: a name is over,
    forever.
    -}
    }
    deriving stock (Int -> OnChainTokenState -> ShowS
[OnChainTokenState] -> ShowS
OnChainTokenState -> String
(Int -> OnChainTokenState -> ShowS)
-> (OnChainTokenState -> String)
-> ([OnChainTokenState] -> ShowS)
-> Show OnChainTokenState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OnChainTokenState -> ShowS
showsPrec :: Int -> OnChainTokenState -> ShowS
$cshow :: OnChainTokenState -> String
show :: OnChainTokenState -> String
$cshowList :: [OnChainTokenState] -> ShowS
showList :: [OnChainTokenState] -> ShowS
Show, OnChainTokenState -> OnChainTokenState -> Bool
(OnChainTokenState -> OnChainTokenState -> Bool)
-> (OnChainTokenState -> OnChainTokenState -> Bool)
-> Eq OnChainTokenState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OnChainTokenState -> OnChainTokenState -> Bool
== :: OnChainTokenState -> OnChainTokenState -> Bool
$c/= :: OnChainTokenState -> OnChainTokenState -> Bool
/= :: OnChainTokenState -> OnChainTokenState -> Bool
Eq)

{- | The active-token policy as plain bytes (issue #77 E-001, renamed by
#157 state-datum-fields): unwraps the `BuiltinByteString` for hex comparison in
verifiers. Named for the field it reads — no alias of the
representative policy survives.
-}
stateActivePolicyBytes :: OnChainTokenState -> ByteString
stateActivePolicyBytes :: OnChainTokenState -> ByteString
stateActivePolicyBytes OnChainTokenState
st = case OnChainTokenState -> BuiltinByteString
stateActivePolicy OnChainTokenState
st of
    BuiltinByteString ByteString
bs -> ByteString
bs

-- | The application policy as plain bytes (#157 tree-edge-admission-by-approval).
stateAppPolicyBytes :: OnChainTokenState -> ByteString
stateAppPolicyBytes :: OnChainTokenState -> ByteString
stateAppPolicyBytes OnChainTokenState
st = case OnChainTokenState -> BuiltinByteString
stateAppPolicy OnChainTokenState
st of
    BuiltinByteString ByteString
bs -> ByteString
bs

-- | The absent-token policy as plain bytes (#157 mint-matches-edge-deltas).
stateAbsentPolicyBytes :: OnChainTokenState -> ByteString
stateAbsentPolicyBytes :: OnChainTokenState -> ByteString
stateAbsentPolicyBytes OnChainTokenState
st = case OnChainTokenState -> BuiltinByteString
stateAbsentPolicy OnChainTokenState
st of
    BuiltinByteString ByteString
bs -> ByteString
bs

-- | The terminal-token policy as plain bytes (#157 mint-matches-edge-deltas).
stateTerminalPolicyBytes :: OnChainTokenState -> ByteString
stateTerminalPolicyBytes :: OnChainTokenState -> ByteString
stateTerminalPolicyBytes OnChainTokenState
st = case OnChainTokenState -> BuiltinByteString
stateTerminalPolicy OnChainTokenState
st of
    BuiltinByteString ByteString
bs -> ByteString
bs

{- | Cage datum: either a pending request or a token
state. Matches Aiken @types\/CageDatum@.
-}
data CageDatum
    = -- | A pending operation request (Constr 0)
      RequestDatum !OnChainRequest
    | -- | Current token state (Constr 1)
      StateDatum !OnChainTokenState
    | {- | The cage's own custody of an absent token (Constr 2, #157
      absent-custody-datum; appended, so 0 and 1 never move): the address the
      inserter named for the refund. The registry key is the sole
      non-ADA asset carried by the output.
      -}
      AbsentCustody !ByteString
    deriving stock (Int -> CageDatum -> ShowS
[CageDatum] -> ShowS
CageDatum -> String
(Int -> CageDatum -> ShowS)
-> (CageDatum -> String)
-> ([CageDatum] -> ShowS)
-> Show CageDatum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CageDatum -> ShowS
showsPrec :: Int -> CageDatum -> ShowS
$cshow :: CageDatum -> String
show :: CageDatum -> String
$cshowList :: [CageDatum] -> ShowS
showList :: [CageDatum] -> ShowS
Show, CageDatum -> CageDatum -> Bool
(CageDatum -> CageDatum -> Bool)
-> (CageDatum -> CageDatum -> Bool) -> Eq CageDatum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CageDatum -> CageDatum -> Bool
== :: CageDatum -> CageDatum -> Bool
$c/= :: CageDatum -> CageDatum -> Bool
/= :: CageDatum -> CageDatum -> Bool
Eq)

-- ---------------------------------------------------------
-- ToData / FromData instances
-- ---------------------------------------------------------

instance ToData OnChainTokenState where
    toBuiltinData :: OnChainTokenState -> BuiltinData
toBuiltinData OnChainTokenState{Integer
BuiltinByteString
OnChainRoot
stateRoot :: OnChainTokenState -> OnChainRoot
stateMaxFee :: OnChainTokenState -> Integer
stateProcessTime :: OnChainTokenState -> Integer
stateRetractTime :: OnChainTokenState -> Integer
stateAppPolicy :: OnChainTokenState -> BuiltinByteString
stateActivePolicy :: OnChainTokenState -> BuiltinByteString
stateAbsentPolicy :: OnChainTokenState -> BuiltinByteString
stateTerminalPolicy :: OnChainTokenState -> BuiltinByteString
stateRoot :: OnChainRoot
stateMaxFee :: Integer
stateProcessTime :: Integer
stateRetractTime :: Integer
stateAppPolicy :: BuiltinByteString
stateActivePolicy :: BuiltinByteString
stateAbsentPolicy :: BuiltinByteString
stateTerminalPolicy :: BuiltinByteString
..} =
        Data -> BuiltinData
mkD (Data -> BuiltinData) -> Data -> BuiltinData
forall a b. (a -> b) -> a -> b
$
            Integer -> [Data] -> Data
Constr
                Integer
0
                [ BuiltinData -> Data
unD (OnChainRoot -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData OnChainRoot
stateRoot)
                , Integer -> Data
I Integer
stateMaxFee
                , Integer -> Data
I Integer
stateProcessTime
                , Integer -> Data
I Integer
stateRetractTime
                , BuiltinByteString -> Data
bbsToD BuiltinByteString
stateAppPolicy
                , BuiltinByteString -> Data
bbsToD BuiltinByteString
stateActivePolicy
                , BuiltinByteString -> Data
bbsToD BuiltinByteString
stateAbsentPolicy
                , BuiltinByteString -> Data
bbsToD BuiltinByteString
stateTerminalPolicy
                ]

instance FromData OnChainTokenState where
    fromBuiltinData :: BuiltinData -> Maybe OnChainTokenState
fromBuiltinData BuiltinData
bd = case BuiltinData -> Data
unD BuiltinData
bd of
        Constr Integer
0 [Data
r, I Integer
mf, I Integer
pt, I Integer
rt, Data
ap, Data
cp, Data
bp, Data
tp] -> do
            stateRoot <- BuiltinData -> Maybe OnChainRoot
forall a. FromData a => BuiltinData -> Maybe a
fromBuiltinData (Data -> BuiltinData
mkD Data
r)
            stateAppPolicy <- bbsFromD ap
            stateActivePolicy <- bbsFromD cp
            stateAbsentPolicy <- bbsFromD bp
            stateTerminalPolicy <- bbsFromD tp
            let stateMaxFee = Integer
mf
                stateProcessTime = Integer
pt
                stateRetractTime = Integer
rt
            Just OnChainTokenState{..}
        Data
_ -> Maybe OnChainTokenState
forall a. Maybe a
Nothing

instance UnsafeFromData OnChainTokenState where
    unsafeFromBuiltinData :: BuiltinData -> OnChainTokenState
unsafeFromBuiltinData BuiltinData
bd = case BuiltinData -> Data
unD BuiltinData
bd of
        Constr Integer
0 [Data
r, I Integer
mf, I Integer
pt, I Integer
rt, Data
ap, Data
cp, Data
bp, Data
tp] ->
            case (Data -> Maybe BuiltinByteString
bbsFromD Data
ap, Data -> Maybe BuiltinByteString
bbsFromD Data
cp, Data -> Maybe BuiltinByteString
bbsFromD Data
bp, Data -> Maybe BuiltinByteString
bbsFromD Data
tp) of
                (Just BuiltinByteString
appP, Just BuiltinByteString
activeP, Just BuiltinByteString
absentP, Just BuiltinByteString
terminalP) ->
                    OnChainTokenState
                        { stateRoot :: OnChainRoot
stateRoot =
                            BuiltinData -> OnChainRoot
forall a. UnsafeFromData a => BuiltinData -> a
unsafeFromBuiltinData (Data -> BuiltinData
mkD Data
r)
                        , stateMaxFee :: Integer
stateMaxFee = Integer
mf
                        , stateProcessTime :: Integer
stateProcessTime = Integer
pt
                        , stateRetractTime :: Integer
stateRetractTime = Integer
rt
                        , stateAppPolicy :: BuiltinByteString
stateAppPolicy = BuiltinByteString
appP
                        , stateActivePolicy :: BuiltinByteString
stateActivePolicy = BuiltinByteString
activeP
                        , stateAbsentPolicy :: BuiltinByteString
stateAbsentPolicy = BuiltinByteString
absentP
                        , stateTerminalPolicy :: BuiltinByteString
stateTerminalPolicy = BuiltinByteString
terminalP
                        }
                (Maybe BuiltinByteString, Maybe BuiltinByteString,
 Maybe BuiltinByteString, Maybe BuiltinByteString)
_ ->
                    String -> OnChainTokenState
forall a. HasCallStack => String -> a
error
                        String
"unsafeFromBuiltinData:\
                        \ OnChainTokenState.policies"
        Data
_ ->
            String -> OnChainTokenState
forall a. HasCallStack => String -> a
error
                String
"unsafeFromBuiltinData:\
                \ OnChainTokenState"

instance ToData CageDatum where
    toBuiltinData :: CageDatum -> BuiltinData
toBuiltinData (RequestDatum OnChainRequest
r) =
        Data -> BuiltinData
mkD (Data -> BuiltinData) -> Data -> BuiltinData
forall a b. (a -> b) -> a -> b
$
            Integer -> [Data] -> Data
Constr Integer
0 [BuiltinData -> Data
unD (OnChainRequest -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData OnChainRequest
r)]
    toBuiltinData (StateDatum OnChainTokenState
s) =
        Data -> BuiltinData
mkD (Data -> BuiltinData) -> Data -> BuiltinData
forall a b. (a -> b) -> a -> b
$
            Integer -> [Data] -> Data
Constr Integer
1 [BuiltinData -> Data
unD (OnChainTokenState -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData OnChainTokenState
s)]
    toBuiltinData (AbsentCustody ByteString
refund) =
        Data -> BuiltinData
mkD (Data -> BuiltinData) -> Data -> BuiltinData
forall a b. (a -> b) -> a -> b
$
            Integer -> [Data] -> Data
Constr Integer
2 [ByteString -> Data
bsToD ByteString
refund]

instance FromData CageDatum where
    fromBuiltinData :: BuiltinData -> Maybe CageDatum
fromBuiltinData BuiltinData
bd = case BuiltinData -> Data
unD BuiltinData
bd of
        Constr Integer
0 [Data
d] ->
            OnChainRequest -> CageDatum
RequestDatum
                (OnChainRequest -> CageDatum)
-> Maybe OnChainRequest -> Maybe CageDatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuiltinData -> Maybe OnChainRequest
forall a. FromData a => BuiltinData -> Maybe a
fromBuiltinData (Data -> BuiltinData
mkD Data
d)
        Constr Integer
1 [Data
d] ->
            OnChainTokenState -> CageDatum
StateDatum
                (OnChainTokenState -> CageDatum)
-> Maybe OnChainTokenState -> Maybe CageDatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuiltinData -> Maybe OnChainTokenState
forall a. FromData a => BuiltinData -> Maybe a
fromBuiltinData (Data -> BuiltinData
mkD Data
d)
        Constr Integer
2 [Data
refund] ->
            ByteString -> CageDatum
AbsentCustody (ByteString -> CageDatum) -> Maybe ByteString -> Maybe CageDatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data -> Maybe ByteString
bsFromD Data
refund
        Data
_ -> Maybe CageDatum
forall a. Maybe a
Nothing

instance UnsafeFromData CageDatum where
    unsafeFromBuiltinData :: BuiltinData -> CageDatum
unsafeFromBuiltinData BuiltinData
bd = case BuiltinData -> Data
unD BuiltinData
bd of
        Constr Integer
0 [Data
d] ->
            OnChainRequest -> CageDatum
RequestDatum (OnChainRequest -> CageDatum) -> OnChainRequest -> CageDatum
forall a b. (a -> b) -> a -> b
$
                BuiltinData -> OnChainRequest
forall a. UnsafeFromData a => BuiltinData -> a
unsafeFromBuiltinData (Data -> BuiltinData
mkD Data
d)
        Constr Integer
1 [Data
d] ->
            OnChainTokenState -> CageDatum
StateDatum (OnChainTokenState -> CageDatum) -> OnChainTokenState -> CageDatum
forall a b. (a -> b) -> a -> b
$
                BuiltinData -> OnChainTokenState
forall a. UnsafeFromData a => BuiltinData -> a
unsafeFromBuiltinData (Data -> BuiltinData
mkD Data
d)
        Constr Integer
2 [B ByteString
refund] -> ByteString -> CageDatum
AbsentCustody ByteString
refund
        Data
_ -> String -> CageDatum
forall a. HasCallStack => String -> a
error String
"unsafeFromBuiltinData: CageDatum"