{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf       #-}
{-# LANGUAGE RankNTypes       #-}
{-# LANGUAGE RecordWildCards  #-}

-- | Slotting utilities.

module Pos.Core.Slotting.Util
       (
         -- * Helpers using 'MonadSlots[Data]'
         getCurrentSlotFlat
       , slotFromTimestamp

         -- * Worker which ticks when slot starts and its parameters
       , OnNewSlotParams (..)
       , defaultOnNewSlotParams
       , ActionTerminationPolicy (..)
       ) where

import           Universum

import           Data.Time.Units (Microsecond, convertUnit)

import           Pos.Core.Slotting.Class (MonadSlots (..), MonadSlotsData)
import           Pos.Core.Slotting.EpochIndex (EpochIndex (..))
import           Pos.Core.Slotting.LocalSlotIndex (LocalSlotIndex (..),
                     mkLocalSlotIndex)
import           Pos.Core.Slotting.MemState (getSystemStartM,
                     withSlottingVarAtomM)
import           Pos.Core.Slotting.SlotCount (SlotCount)
import           Pos.Core.Slotting.SlotId (FlatSlotId, SlotId (..),
                     flattenSlotId)
import           Pos.Core.Slotting.TimeDiff (addTimeDiffToTimestamp)
import           Pos.Core.Slotting.Timestamp (Timestamp (..))
import           Pos.Core.Slotting.Types (EpochSlottingData (..), SlottingData,
                     getAllEpochIndices, lookupEpochSlottingData)

import           Pos.Util.Util (leftToPanic)



-- | Get flat id of current slot based on MonadSlots.
getCurrentSlotFlat :: MonadSlots ctx m => SlotCount -> m (Maybe FlatSlotId)
getCurrentSlotFlat epochSlots =
    fmap (flattenSlotId epochSlots) <$> getCurrentSlot epochSlots


-- | Parameters for `onNewSlot`.
data OnNewSlotParams = OnNewSlotParams
    { onspStartImmediately  :: !Bool
    -- ^ Whether first action should be executed ASAP (i. e. basically
    -- when the program starts), or only when new slot starts.
    --
    -- For example, if the program is started in the middle of a slot
    -- and this parameter in 'False', we will wait for half of slot
    -- and only then will do something.
    , onspTerminationPolicy :: !ActionTerminationPolicy
    -- ^ What should be done if given action doesn't finish before new
    -- slot starts. See the description of 'ActionTerminationPolicy'.
    }

-- | Default parameters which were used by almost all code before this
-- data type was introduced.
defaultOnNewSlotParams :: OnNewSlotParams
defaultOnNewSlotParams =
    OnNewSlotParams
    { onspStartImmediately = True
    , onspTerminationPolicy = NoTerminationPolicy
    }

-- | This policy specifies what should be done if the action passed to
-- `onNewSlot` doesn't finish when current slot finishes.
--
-- We don't want to run given action more than once in parallel for
-- variety of reasons:
-- 1. If action hangs for some reason, there can be infinitely growing pool
-- of hanging actions with probably bad consequences (e. g. leaking memory).
-- 2. Thread management will be quite complicated if we want to fork
-- threads inside `onNewSlot`.
-- 3. If more than one action is launched, they may use same resources
-- concurrently, so the code must account for it.
data ActionTerminationPolicy
    = NoTerminationPolicy
    -- ^ Even if action keeps running after current slot finishes,
    -- we'll just wait and start action again only after the previous
    -- one finishes.
    | NewSlotTerminationPolicy !Text
    -- ^ If new slot starts, running action will be cancelled. Name of
    -- the action should be passed for logging.

-- | Compute current slot from current timestamp based on data
-- provided by 'MonadSlotsData'.
slotFromTimestamp
    :: MonadSlotsData ctx m
    => SlotCount
    -> Timestamp
    -> m (Maybe SlotId)
slotFromTimestamp epochSlots approxCurTime = do
    systemStart <- getSystemStartM
    withSlottingVarAtomM (iterateBackwardsSearch systemStart)
  where
    iterateBackwardsSearch
        :: Timestamp
        -> SlottingData
        -> Maybe SlotId
    iterateBackwardsSearch systemStart slottingData = do
        let allEpochIndex = getAllEpochIndices slottingData

        -- We first reverse the indices since the most common calls to this funcion
        -- will be from next/current index and close.
        let reversedEpochIndices = reverse allEpochIndex

        let iterateIndicesUntilJust
                :: [EpochIndex]
                -> Maybe SlotId
            iterateIndicesUntilJust []      = Nothing
            iterateIndicesUntilJust indices = do

              -- Get current index or return @Nothing@ if the indices list is empty.
              let mCurrentEpochIndex :: Maybe EpochIndex
                  mCurrentEpochIndex = case indices of
                      (x:_) -> Just x
                      _     -> Nothing
              -- Try to find a slot.
              let mFoundSlot = mCurrentEpochIndex >>= findSlot systemStart slottingData

              case mFoundSlot of
                -- If you found a slot, then return it
                Just foundSlot -> Just foundSlot
                -- If no slot is found, iterate with the rest of the list
                Nothing        -> iterateIndicesUntilJust $ case indices of
                    []     -> []
                    (_:xs) -> xs


        -- Iterate the indices recursively with the reverse indices, starting
        -- with the most recent one.
        iterateIndicesUntilJust reversedEpochIndices


    -- Find a slot using timestamps. If no @EpochSlottingData@ is found return
    -- @Nothing@.
    findSlot
        :: Timestamp
        -> SlottingData
        -> EpochIndex
        -> Maybe SlotId
    findSlot systemStart slottingData epochIndex = do
        epochSlottingData <- lookupEpochSlottingData epochIndex slottingData
        computeSlotUsingEpoch systemStart approxCurTime epochIndex epochSlottingData

    computeSlotUsingEpoch
        :: Timestamp
        -> Timestamp
        -> EpochIndex
        -> EpochSlottingData
        -> Maybe SlotId
    computeSlotUsingEpoch systemStart (Timestamp curTime) epoch EpochSlottingData {..}
        | curTime < epochStart = Nothing
        | curTime < epochStart + epochDuration = Just $ SlotId epoch localSlot
        | otherwise = Nothing
      where
        epochStart :: Microsecond
        epochStart = getTimestamp (esdStartDiff `addTimeDiffToTimestamp` systemStart)

        localSlotNumeric :: Word16
        localSlotNumeric = fromIntegral $ (curTime - epochStart) `div` slotDuration

        localSlot :: LocalSlotIndex
        localSlot =
            leftToPanic "computeSlotUsingEpoch: " $
            mkLocalSlotIndex epochSlots localSlotNumeric

        slotDuration :: Microsecond
        slotDuration = convertUnit esdSlotDuration

        epochDuration :: Microsecond
        epochDuration = slotDuration * fromIntegral epochSlots
