-----------------------------------------------------------------------------
--
-- Module      :  $Headers
-- Copyright   :  (c) 2021 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <code@functionally.io>
-- Stability   :  Experimental
-- Portability :  Portable
--
-- | Types for chain operations.
--
-----------------------------------------------------------------------------


module Pigy.Chain.Types (
-- * Addresses
  MaryAddress
, MaryScript
-- * Tracking
, Origins
, Pendings
, History
-- * State
, Chain
, ChainState(..)
, activeLens
, currentLens
, originsLens
, pendingsLens
, historyLens
, withChainState
) where


import Cardano.Api                (AddressInEra(..), MaryEra, ScriptHash, ScriptInEra(..), SlotNo(..), TxIn(..), Value)
import Control.Lens               (Lens', lens)
import Control.Monad.State.Strict (StateT(..))
import Data.Default               (Default(..))
import Data.IORef                 (IORef, readIORef, writeIORef)
import Pigy.Types                 (Context(..))

import qualified Data.Map.Strict as M  (Map, empty)


-- | A Mary address.
type MaryAddress = AddressInEra MaryEra


-- | A Mary script.
type MaryScript = ScriptInEra MaryEra


-- | Map of origins of transactions.
type Origins = M.Map TxIn MaryAddress


-- | Map of transactions that to be processed.
type Pendings = M.Map TxIn ([MaryAddress], Value)


-- | History of transaction origins and pending transactions.
type History = [(SlotNo, (Origins, Pendings))]


-- | The state of the chain.
data ChainState =
  ChainState
  {
    ChainState -> Context
context       :: Context        -- ^ The service context.
  , ChainState -> Bool
active        :: Bool           -- ^ Whether the service can mint.
  , ChainState -> SlotNo
current       :: SlotNo         -- ^ The curent slot number.
  , ChainState -> Origins
origins       :: Origins        -- ^ The originating addresses of UTxOs being tracked.
  , ChainState -> Pendings
pendings      :: Pendings       -- ^ Queued minting operations.
  , ChainState -> History
history       :: History        -- ^ The transaction history, for rollbacks.
  , ChainState -> MaryAddress
scriptAddress :: MaryAddress    -- ^ The minting script address.
  , ChainState -> MaryScript
script        :: MaryScript     -- ^ The minting script.
  , ChainState -> ScriptHash
scriptHash    :: ScriptHash     -- ^ The hash of the miting script.
  , ChainState -> Value -> Bool
checker       :: Value -> Bool  -- ^ Function to check validity.
  }

instance Default ChainState where
  def :: ChainState
def =
    ChainState :: Context
-> Bool
-> SlotNo
-> Origins
-> Pendings
-> History
-> MaryAddress
-> MaryScript
-> ScriptHash
-> (Value -> Bool)
-> ChainState
ChainState
    {
      context :: Context
context       = Context
forall a. HasCallStack => a
undefined
    , active :: Bool
active        = Bool
False
    , current :: SlotNo
current       = Word64 -> SlotNo
SlotNo Word64
0
    , origins :: Origins
origins       = Origins
forall k a. Map k a
M.empty
    , pendings :: Pendings
pendings      = Pendings
forall k a. Map k a
M.empty
    , history :: History
history       = [(Word64 -> SlotNo
SlotNo Word64
0, (Origins
forall k a. Map k a
M.empty, Pendings
forall k a. Map k a
M.empty))]
    , scriptAddress :: MaryAddress
scriptAddress = MaryAddress
forall a. HasCallStack => a
undefined
    , script :: MaryScript
script        = MaryScript
forall a. HasCallStack => a
undefined
    , scriptHash :: ScriptHash
scriptHash    = ScriptHash
forall a. HasCallStack => a
undefined
    , checker :: Value -> Bool
checker       = Value -> Bool
forall a. HasCallStack => a
undefined
    }


-- | Lens for the active state.
activeLens :: Lens' ChainState Bool
activeLens :: (Bool -> f Bool) -> ChainState -> f ChainState
activeLens = (ChainState -> Bool)
-> (ChainState -> Bool -> ChainState)
-> Lens ChainState ChainState Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChainState -> Bool
active ((ChainState -> Bool -> ChainState)
 -> Lens ChainState ChainState Bool Bool)
-> (ChainState -> Bool -> ChainState)
-> Lens ChainState ChainState Bool Bool
forall a b. (a -> b) -> a -> b
$ \ChainState
x Bool
active' -> ChainState
x {active :: Bool
active = Bool
active'}


-- | Lens for the current slot number.
currentLens :: Lens' ChainState SlotNo
currentLens :: (SlotNo -> f SlotNo) -> ChainState -> f ChainState
currentLens = (ChainState -> SlotNo)
-> (ChainState -> SlotNo -> ChainState)
-> Lens ChainState ChainState SlotNo SlotNo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChainState -> SlotNo
current ((ChainState -> SlotNo -> ChainState)
 -> Lens ChainState ChainState SlotNo SlotNo)
-> (ChainState -> SlotNo -> ChainState)
-> Lens ChainState ChainState SlotNo SlotNo
forall a b. (a -> b) -> a -> b
$ \ChainState
x SlotNo
current' -> ChainState
x {current :: SlotNo
current = SlotNo
current'}


-- | Lens for the originating addresses being tracked.
originsLens :: Lens' ChainState Origins
originsLens :: (Origins -> f Origins) -> ChainState -> f ChainState
originsLens = (ChainState -> Origins)
-> (ChainState -> Origins -> ChainState)
-> Lens ChainState ChainState Origins Origins
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChainState -> Origins
origins ((ChainState -> Origins -> ChainState)
 -> Lens ChainState ChainState Origins Origins)
-> (ChainState -> Origins -> ChainState)
-> Lens ChainState ChainState Origins Origins
forall a b. (a -> b) -> a -> b
$ \ChainState
x Origins
origins' -> ChainState
x {origins :: Origins
origins = Origins
origins'}


-- | Lens for the queued mintings.
pendingsLens :: Lens' ChainState Pendings
pendingsLens :: (Pendings -> f Pendings) -> ChainState -> f ChainState
pendingsLens = (ChainState -> Pendings)
-> (ChainState -> Pendings -> ChainState)
-> Lens ChainState ChainState Pendings Pendings
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChainState -> Pendings
pendings ((ChainState -> Pendings -> ChainState)
 -> Lens ChainState ChainState Pendings Pendings)
-> (ChainState -> Pendings -> ChainState)
-> Lens ChainState ChainState Pendings Pendings
forall a b. (a -> b) -> a -> b
$ \ChainState
x Pendings
pendings' -> ChainState
x {pendings :: Pendings
pendings = Pendings
pendings'}


-- | Lens for the tracking history.
historyLens :: Lens' ChainState History
historyLens :: (History -> f History) -> ChainState -> f ChainState
historyLens = (ChainState -> History)
-> (ChainState -> History -> ChainState)
-> Lens ChainState ChainState History History
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChainState -> History
history ((ChainState -> History -> ChainState)
 -> Lens ChainState ChainState History History)
-> (ChainState -> History -> ChainState)
-> Lens ChainState ChainState History History
forall a b. (a -> b) -> a -> b
$ \ChainState
x History
history' -> ChainState
x {history :: History
history = History
history'}


-- | The monad for the chain state.
type Chain a = StateT ChainState IO a


-- | Modify the chain state.
withChainState :: IORef ChainState -- ^ Reference to the chain state.
               -> Chain a          -- ^ Action for modifying the chain state.
               -> IO a             -- ^ Action returning the result of the modification.
withChainState :: IORef ChainState -> Chain a -> IO a
withChainState IORef ChainState
ref Chain a
transition =
  do
    ChainState
initial <- IORef ChainState -> IO ChainState
forall a. IORef a -> IO a
readIORef IORef ChainState
ref
    (a
result, ChainState
final) <- Chain a -> ChainState -> IO (a, ChainState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Chain a
transition ChainState
initial
    IORef ChainState -> ChainState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ChainState
ref ChainState
final
    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result