{- |
Module      : Singular.Registry.Config.Application
Description : The application pin a registry derives from its seed
License     : Apache-2.0

A registry's four pins (#157 genesis-policy-pins) are derived, never written down:
the application policy and @witness(kind, registry)@ at kinds 0, 1 and 2,
all for the registry identity the boot seed determines (state policy ‖
the token name the seed derives). Which application the first pin comes
from is the caller's pin ('Singular.Registry.Application'): a hash given
as input, or a blueprint validator title applied to that identity.

'configForApplication' is the derivation: from a seed, the configuration
the boot pins and the codes the bookings and folds run. A command that
joins a registry later derives it again from the seed its state token's
minting transaction spent ("Singular.Registry.StateToken") and never
trusts a pin it did not derive.
-}
module Singular.Registry.Config.Application
    ( RegistryEconomics (..)
    , registryIdentity
    , configForApplication
    ) where

import Data.ByteString (ByteString)
import Data.ByteString.Short qualified as SBS

import Cardano.Ledger.BaseTypes (Network (..))

import Singular.Registry.Application (ApplicationPin, applyPin)
import Singular.Registry.AssetName (deriveAssetName)
import Singular.Registry.Blueprint (NamingCodes (..))
import Singular.Registry.Config (CageConfig (..))
import Singular.Registry.Ledger (Coin)
import Singular.Registry.TxBuilder.Edges (namingPins)
import Singular.Registry.TxBuilder.Internal
    ( computeScriptHash
    , scriptHashBytes
    )
import Singular.Registry.Types (OnChainTxOutRef)

-- | The windows and tip a registry is booted with.
data RegistryEconomics = RegistryEconomics
    { RegistryEconomics -> Integer
reProcessTime :: Integer
    , RegistryEconomics -> Integer
reRetractTime :: Integer
    , RegistryEconomics -> Coin
reTip :: Coin
    }
    deriving stock (RegistryEconomics -> RegistryEconomics -> Bool
(RegistryEconomics -> RegistryEconomics -> Bool)
-> (RegistryEconomics -> RegistryEconomics -> Bool)
-> Eq RegistryEconomics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegistryEconomics -> RegistryEconomics -> Bool
== :: RegistryEconomics -> RegistryEconomics -> Bool
$c/= :: RegistryEconomics -> RegistryEconomics -> Bool
/= :: RegistryEconomics -> RegistryEconomics -> Bool
Eq, Int -> RegistryEconomics -> ShowS
[RegistryEconomics] -> ShowS
RegistryEconomics -> String
(Int -> RegistryEconomics -> ShowS)
-> (RegistryEconomics -> String)
-> ([RegistryEconomics] -> ShowS)
-> Show RegistryEconomics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegistryEconomics -> ShowS
showsPrec :: Int -> RegistryEconomics -> ShowS
$cshow :: RegistryEconomics -> String
show :: RegistryEconomics -> String
$cshowList :: [RegistryEconomics] -> ShowS
showList :: [RegistryEconomics] -> ShowS
Show)

-- | The registry identity a seed determines: state policy then token name.
registryIdentity
    :: SBS.ShortByteString -> OnChainTxOutRef -> ByteString
registryIdentity :: ShortByteString -> OnChainTxOutRef -> ByteString
registryIdentity ShortByteString
stateBytes OnChainTxOutRef
seed =
    ScriptHash -> ByteString
scriptHashBytes (ShortByteString -> ScriptHash
computeScriptHash ShortByteString
stateBytes) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> OnChainTxOutRef -> ByteString
deriveAssetName OnChainTxOutRef
seed

{- | The configuration a boot from this seed pins, and the codes as that
registry runs them (the application applied when it takes the identity).
-}
configForApplication
    :: ApplicationPin
    -> NamingCodes
    -- ^ The application and witness codes as the blueprint carries them
    -> SBS.ShortByteString
    -- ^ State validator
    -> SBS.ShortByteString
    -- ^ Request validator
    -> RegistryEconomics
    -> Network
    -> OnChainTxOutRef
    -- ^ The seed the boot consumes
    -> (CageConfig, NamingCodes)
configForApplication :: ApplicationPin
-> NamingCodes
-> ShortByteString
-> ShortByteString
-> RegistryEconomics
-> Network
-> OnChainTxOutRef
-> (CageConfig, NamingCodes)
configForApplication ApplicationPin
pin NamingCodes
codes ShortByteString
stateBytes ShortByteString
requestBytes RegistryEconomics
econ Network
net OnChainTxOutRef
seed =
    let registryId :: ByteString
registryId = ShortByteString -> OnChainTxOutRef -> ByteString
registryIdentity ShortByteString
stateBytes OnChainTxOutRef
seed
        (ShortByteString
appPin, NamingCodes
pinned) = ApplicationPin
-> ByteString -> NamingCodes -> (ShortByteString, NamingCodes)
applyPin ApplicationPin
pin ByteString
registryId NamingCodes
codes
        (ShortByteString
_, ShortByteString
absentPin, ShortByteString
activePin, ShortByteString
terminalPin) = NamingCodes
-> ByteString
-> (ShortByteString, ShortByteString, ShortByteString,
    ShortByteString)
namingPins NamingCodes
pinned ByteString
registryId
    in  ( CageConfig
            { cageScriptBytes :: ShortByteString
cageScriptBytes = ShortByteString
stateBytes
            , requestScriptBytes :: ShortByteString
requestScriptBytes = ShortByteString
requestBytes
            , cfgScriptHash :: ScriptHash
cfgScriptHash = ShortByteString -> ScriptHash
computeScriptHash ShortByteString
stateBytes
            , cageSeed :: OnChainTxOutRef
cageSeed = OnChainTxOutRef
seed
            , defaultProcessTime :: Integer
defaultProcessTime = RegistryEconomics -> Integer
reProcessTime RegistryEconomics
econ
            , defaultRetractTime :: Integer
defaultRetractTime = RegistryEconomics -> Integer
reRetractTime RegistryEconomics
econ
            , defaultTip :: Coin
defaultTip = RegistryEconomics -> Coin
reTip RegistryEconomics
econ
            , cfgApplicationPolicy :: ShortByteString
cfgApplicationPolicy = ShortByteString
appPin
            , cfgActivePolicy :: ShortByteString
cfgActivePolicy = ShortByteString
activePin
            , cfgAbsentPolicy :: ShortByteString
cfgAbsentPolicy = ShortByteString
absentPin
            , cfgTerminalPolicy :: ShortByteString
cfgTerminalPolicy = ShortByteString
terminalPin
            , cfgConsumerScript :: ShortByteString
cfgConsumerScript = ShortByteString
SBS.empty
            , network :: Network
network = Network
net
            }
        , NamingCodes
pinned
        )