{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}

{-# OPTIONS_HADDOCK prune #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Provides general functions and types relating to coin selection.
--
-- The 'CoinSelection' type represents a __coin selection__, the basis for a
-- /transaction/ in a UTxO-based blockchain.
--
-- The 'CoinSelectionAlgorithm' type provides a __common interface__ to
-- algorithms that generate coin selections.
--
-- For a guide to __algorithms provided by this library__, see the
-- "Cardano.CoinSelection.Algorithm" module.
--
-- To adjust coin selections in order to __pay for transaction fees__, see
-- the "Cardano.CoinSelection.Fee" module.
--
module Cardano.CoinSelection
    (
      -- * Coin Selections
      CoinSelection (..)
    , sumInputs
    , sumOutputs
    , sumChange

      -- * Coin Selection Algorithms
    , CoinSelectionAlgorithm (..)
    , CoinSelectionParameters (..)
    , CoinSelectionResult (..)
    , CoinSelectionLimit (..)

      -- * Coins
    , Coin
    , coinFromNatural
    , coinToNatural

      -- * Coin Maps
    , CoinMap (..)
    , CoinMapEntry (..)
    , coinMapFromList
    , coinMapToList
    , coinMapValue

      -- * Coin Selection Errors
    , CoinSelectionError (..)
    , InputValueInsufficientError (..)
    , InputCountInsufficientError (..)
    , InputLimitExceededError (..)
    , InputsExhaustedError (..)

      -- # Internal Functions
    , coinMapRandomEntry

    ) where

import Prelude

import Control.Arrow
    ( (&&&) )
import Control.Monad.Trans.Except
    ( ExceptT (..) )
import Crypto.Number.Generate
    ( generateBetween )
import Crypto.Random.Types
    ( MonadRandom )
import Data.Map.Strict
    ( Map )
import Data.Word
    ( Word16 )
import GHC.Generics
    ( Generic )
import Internal.Coin
    ( Coin, coinFromNatural, coinToNatural )
import Numeric.Natural
    ( Natural )
import Quiet
    ( Quiet (Quiet) )

import qualified Data.Foldable as F
import qualified Data.Map.Strict as Map

--------------------------------------------------------------------------------
-- Coin Map
--------------------------------------------------------------------------------

-- | A mapping from unique keys to associated 'Coin' values.
--
-- A 'CoinMap' can be used to represent:
--
--   * a UTxO set, where each key within the map refers to an unspent output
--     from a previous transaction.
--
--   * a set of 'inputs' to a 'CoinSelection', where each input is an entry
--     selected from a UTxO set by a 'CoinSelectionAlgorithm'.
--
--   * a set of 'outputs' for a 'CoinSelection', where each key within the map
--     refers to the address of a payment recipient.
--
-- A 'CoinMap' can be constructed with the 'coinMapFromList' function.
--
-- The total value of a 'CoinMap' is given by the 'coinMapValue' function.
--
-- @since 1.0.0
newtype CoinMap a = CoinMap { unCoinMap :: Map a Coin }
    deriving (Eq, Generic)
    deriving Show via (Quiet (CoinMap a))

instance Foldable CoinMap where
    foldMap f = F.fold . fmap (f . entryKey) . coinMapToList

instance Ord a => Monoid (CoinMap a) where
    mempty = CoinMap mempty

instance Ord a => Semigroup (CoinMap a) where
    CoinMap a <> CoinMap b = CoinMap $ Map.unionWith (<>) a b

-- | An entry for a 'CoinMap'.
--
-- @since 1.0.0
data CoinMapEntry a = CoinMapEntry
    { entryKey
        :: a
        -- ^ The unique key associated with this entry.
    , entryValue
        :: Coin
        -- ^ The coin value associated with this entry.
    } deriving (Eq, Generic, Ord, Show)

-- | Constructs a 'CoinMap' from a list of entries.
--
-- See 'CoinMapEntry'.
--
-- @since 1.0.0
coinMapFromList :: Ord a => [CoinMapEntry a] -> CoinMap a
coinMapFromList = CoinMap
    . Map.fromListWith (<>)
    . fmap (entryKey &&& entryValue)

-- | Converts a 'CoinMap' to a list of entries.
--
-- See 'CoinMapEntry'.
--
-- @since 1.0.0
coinMapToList :: CoinMap a -> [CoinMapEntry a]
coinMapToList = fmap (uncurry CoinMapEntry) . Map.toList . unCoinMap

-- | Calculates the total coin value associated with a 'CoinMap'.
--
-- @since 1.0.0
coinMapValue :: CoinMap a -> Coin
coinMapValue = mconcat . fmap entryValue . coinMapToList

--------------------------------------------------------------------------------
-- Coin Selection
--------------------------------------------------------------------------------

-- | Provides a __common interface__ for coin selection algorithms.
--
-- The function 'selectCoins', when applied to the given
-- 'CoinSelectionParameters' object (with /available inputs/ and /requested/
-- /outputs/), will generate a 'CoinSelectionResult' (with /remaining inputs/
-- and a /coin selection/).
--
-- For implementations provided by this library, see
-- "Cardano.CoinSelection.Algorithm".
--
-- @since 1.0.0
newtype CoinSelectionAlgorithm i o m = CoinSelectionAlgorithm
    { selectCoins
        :: CoinSelectionParameters i o
        -> ExceptT CoinSelectionError m (CoinSelectionResult i o)
    }

-- | The complete set of parameters required for a 'CoinSelectionAlgorithm'.
--
-- The 'inputsAvailable' and 'outputsRequested' fields are both maps of unique
-- keys to associated 'Coin' values, where:
--
--   * Each key-value pair in the 'inputsAvailable' map corresponds to an
--     __unspent output__ from a previous transaction that is /available/
--     /for selection as an input/ by the coin selection algorithm. The /key/
--     is a unique reference to that output, and the /value/ is the amount of
--     unspent value associated with it.
--
--   * Each key-value pair in the 'outputsRequested' map corresponds to a
--     __payment__ whose value is /to be paid for/ by the coin selection
--     algorithm. The /key/ is a unique reference to a payment recipient,
--     and the /value/ is the amount of money to pay to that recipient.
--
-- A coin selection algorithm will select a __subset__ of inputs from
-- 'inputsAvailable' in order to pay for __all__ the outputs in
-- 'outputsRequested', where:
--
--   * Inputs __selected__ by the algorithm are included in the 'inputs'
--     set of the generated 'CoinSelection'.
--
--   * Inputs __not__ selected by the algorithm are included in the
--     'inputsRemaining' set of the 'CoinSelectionResult'.
--
-- The number of inputs that can selected is limited by 'limit'.
--
-- The total value of 'inputsAvailable' must be /greater than or equal to/
-- the total value of 'outputsRequested', as given by the 'coinMapValue'
-- function.
--
-- @since 1.0.0
data CoinSelectionParameters i o = CoinSelectionParameters
    { inputsAvailable :: CoinMap i
        -- ^ The set of inputs available for selection.
    , outputsRequested :: CoinMap o
        -- ^ The set of outputs requested for payment.
    , limit :: CoinSelectionLimit
        -- ^ A limit on the number of inputs that can be selected.
    }
    deriving Generic

-- | Represents the __result__ of running a coin selection algorithm.
--
-- See 'CoinSelectionAlgorithm'.
--
-- @since 1.0.0
data CoinSelectionResult i o = CoinSelectionResult
    { coinSelection :: CoinSelection i o
        -- ^ The generated coin selection.
    , inputsRemaining :: CoinMap i
        -- ^ The set of inputs that were __not__ selected.
    } deriving (Eq, Show)

-- | A __coin selection__ is the basis for a /transaction/.
--
-- It consists of a selection of 'inputs', 'outputs', and 'change'.
--
-- The 'inputs' and 'outputs' fields are both maps of unique keys to associated
-- 'Coin' values, where:
--
--   * Each key-value pair in the 'inputs' map corresponds to an
--     __unspent output__ from a previous transaction (also known as a UTxO).
--     The /key/ is a unique reference to that output, and the /value/ is the
--     amount of unspent value associated with it.
--
--   * Each key-value pair in the 'outputs' map corresponds to a __payment__.
--     The /key/ is a unique reference to a payment recipient, and the /value/
--     is the amount of money to pay to that recipient.
--
-- The 'change' field is a set of coins to be returned to the originator of the
-- transaction.
--
-- The 'CoinSelectionAlgorithm' type provides a common interface for generating
-- coin selections.
--
-- @since 1.0.0
data CoinSelection i o = CoinSelection
    { inputs :: CoinMap i
      -- ^ The set of inputs.
    , outputs :: CoinMap o
      -- ^ The set of outputs.
    , change :: [Coin]
      -- ^ The set of change.
    }
    deriving (Generic, Show, Eq)

instance (Ord i, Ord o) => Semigroup (CoinSelection i o) where
    a <> b = CoinSelection
        { inputs = inputs a <> inputs b
        , outputs = outputs a <> outputs b
        , change = change a <> change b
        }

instance (Ord i, Ord o) => Monoid (CoinSelection i o) where
    mempty = CoinSelection mempty mempty mempty

-- | Calculate the total sum of all 'inputs' for the given 'CoinSelection'.
--
-- @since 1.0.0
sumInputs :: CoinSelection i o -> Coin
sumInputs = coinMapValue . inputs

-- | Calculate the total sum of all 'outputs' for the given 'CoinSelection'.
--
-- @since 1.0.0
sumOutputs :: CoinSelection i o -> Coin
sumOutputs =  coinMapValue . outputs

-- | Calculate the total sum of all 'change' for the given 'CoinSelection'.
--
-- @since 1.0.0
sumChange :: CoinSelection i o -> Coin
sumChange = mconcat . change

-- | Defines an __inclusive upper bound__ on the /number/ of inputs that
--   a 'CoinSelectionAlgorithm' is allowed to select.
--
-- @since 1.0.0
newtype CoinSelectionLimit = CoinSelectionLimit
    { calculateLimit
        :: Word16 -> Word16
            -- ^ Calculate the maximum number of inputs allowed for a given
            -- number of outputs.
    } deriving Generic

-- | Represents the set of possible failures that can occur when attempting
--   to produce a 'CoinSelection' with a 'CoinSelectionAlgorithm'.
--
-- See 'selectCoins'.
--
-- @since 1.0.0
data CoinSelectionError
    = InputValueInsufficient
        InputValueInsufficientError
    | InputCountInsufficient
        InputCountInsufficientError
    | InputLimitExceeded
        InputLimitExceededError
    | InputsExhausted
        InputsExhaustedError
    deriving (Eq, Show)

-- | Indicates that the total value of 'inputsAvailable' is less than the total
--   value of 'outputsRequested', making it /impossible/ to cover all payments,
--   /regardless/ of which algorithm is chosen.
--
-- @since 1.0.0
data InputValueInsufficientError =
    InputValueInsufficientError
    { inputValueAvailable :: Coin
        -- ^ The total value of 'inputsAvailable'.
    , inputValueRequired :: Coin
        -- ^ The total value of 'outputsRequested'.
    }
    deriving (Eq, Show)

-- | Indicates that the total count of entries in 'inputsAvailable' is /fewer/
--   /than/ required by the algorithm. The number required depends on the
--   particular algorithm implementation.
--
-- @since 1.0.0
data InputCountInsufficientError =
    InputCountInsufficientError
    { inputCountAvailable :: Natural
        -- ^ The number of entries in 'inputsAvailable'.
    , inputCountRequired :: Natural
        -- ^ The number of entries required.
    }
    deriving (Eq, Show)

-- | Indicates that all available entries in 'inputsAvailable' were depleted
--   /before/ all the payments in 'outputsRequested' could be paid for.
--
-- This condition can occur /even if/ the total value of 'inputsAvailable' is
-- greater than or equal to the total value of 'outputsRequested', due to
-- differences in the way that algorithms select inputs.
--
-- @since 1.0.0
data InputsExhaustedError =
    InputsExhaustedError
    deriving (Eq, Show)

-- | Indicates that the coin selection algorithm is unable to cover the total
--   value of 'outputsRequested' without exceeding the maximum number of inputs
--   defined by 'limit'.
--
-- See 'calculateLimit'.
--
-- @since 1.0.0
newtype InputLimitExceededError =
    InputLimitExceededError
    { calculatedInputLimit :: Word16 }
    deriving (Eq, Show)

--------------------------------------------------------------------------------
-- Internal Functions
--------------------------------------------------------------------------------

-- Selects an entry at random from a 'CoinMap', returning both the selected
-- entry and the map with the entry removed.
--
-- If the given map is empty, this function returns 'Nothing'.
--
coinMapRandomEntry
    :: MonadRandom m
    => CoinMap a
    -> m (Maybe (CoinMapEntry a, CoinMap a))
coinMapRandomEntry (CoinMap m)
    | Map.null m =
        return Nothing
    | otherwise = Just <$> do
        ix <- fromEnum <$> generateBetween 0 (toEnum (Map.size m - 1))
        let entry = uncurry CoinMapEntry $ Map.elemAt ix m
        let remainder = CoinMap $ Map.deleteAt ix m
        return (entry, remainder)