{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLabels #-}

-- |
-- Copyright: © 2021 IOHK
-- License: Apache-2.0
--
-- This module provides a public API for planning wallet migrations.
--
-- Use 'createPlan' to create a migration plan.
--
module Cardano.Wallet.Primitive.Migration
    (
    -- * Creating a migration plan
      createPlan
    , MigrationPlan (..)
    , RewardWithdrawal (..)
    , Selection (..)

    ) where

import Prelude

import Cardano.Wallet.Primitive.Migration.Selection
    ( RewardWithdrawal (..), Selection (..) )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin )
import Cardano.Wallet.Primitive.Types.Tx
    ( TxConstraints (..), TxIn, TxOut )
import Cardano.Wallet.Primitive.Types.UTxO
    ( UTxO )
import Data.Generics.Internal.VL.Lens
    ( view )
import Data.Generics.Labels
    ()
import GHC.Generics
    ( Generic )

import qualified Cardano.Wallet.Primitive.Migration.Planning as Planning

-- | Represents a plan for migrating a 'UTxO' set.
--
-- See 'createPlan' to create a migration plan.
--
data MigrationPlan = MigrationPlan
    { MigrationPlan -> [Selection (TxIn, TxOut)]
selections :: ![Selection (TxIn, TxOut)]
      -- ^ A list of generated selections: each selection is the basis for a
      -- single transaction.
    , MigrationPlan -> UTxO
unselected :: !UTxO
      -- ^ The portion of the UTxO that was not selected.
    , MigrationPlan -> Coin
totalFee :: !Coin
      -- ^ The total fee payable: equal to the sum of the fees of the
      -- individual selections.
    }
    deriving (MigrationPlan -> MigrationPlan -> Bool
(MigrationPlan -> MigrationPlan -> Bool)
-> (MigrationPlan -> MigrationPlan -> Bool) -> Eq MigrationPlan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MigrationPlan -> MigrationPlan -> Bool
$c/= :: MigrationPlan -> MigrationPlan -> Bool
== :: MigrationPlan -> MigrationPlan -> Bool
$c== :: MigrationPlan -> MigrationPlan -> Bool
Eq, (forall x. MigrationPlan -> Rep MigrationPlan x)
-> (forall x. Rep MigrationPlan x -> MigrationPlan)
-> Generic MigrationPlan
forall x. Rep MigrationPlan x -> MigrationPlan
forall x. MigrationPlan -> Rep MigrationPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MigrationPlan x -> MigrationPlan
$cfrom :: forall x. MigrationPlan -> Rep MigrationPlan x
Generic, Int -> MigrationPlan -> ShowS
[MigrationPlan] -> ShowS
MigrationPlan -> String
(Int -> MigrationPlan -> ShowS)
-> (MigrationPlan -> String)
-> ([MigrationPlan] -> ShowS)
-> Show MigrationPlan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrationPlan] -> ShowS
$cshowList :: [MigrationPlan] -> ShowS
show :: MigrationPlan -> String
$cshow :: MigrationPlan -> String
showsPrec :: Int -> MigrationPlan -> ShowS
$cshowsPrec :: Int -> MigrationPlan -> ShowS
Show)

-- | Creates a migration plan for the given UTxO set and reward withdrawal
--   amount.
--
-- See 'MigrationPlan'.
--
createPlan
    :: TxConstraints
    -> UTxO
    -> RewardWithdrawal
    -> MigrationPlan
createPlan :: TxConstraints -> UTxO -> RewardWithdrawal -> MigrationPlan
createPlan TxConstraints
constraints UTxO
utxo RewardWithdrawal
reward = MigrationPlan :: [Selection (TxIn, TxOut)] -> UTxO -> Coin -> MigrationPlan
MigrationPlan
    { $sel:selections:MigrationPlan :: [Selection (TxIn, TxOut)]
selections = (([Selection (TxIn, TxOut)]
  -> Const [Selection (TxIn, TxOut)] [Selection (TxIn, TxOut)])
 -> MigrationPlan (TxIn, TxOut)
 -> Const [Selection (TxIn, TxOut)] (MigrationPlan (TxIn, TxOut)))
-> MigrationPlan (TxIn, TxOut) -> [Selection (TxIn, TxOut)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "selections"
  (([Selection (TxIn, TxOut)]
    -> Const [Selection (TxIn, TxOut)] [Selection (TxIn, TxOut)])
   -> MigrationPlan (TxIn, TxOut)
   -> Const [Selection (TxIn, TxOut)] (MigrationPlan (TxIn, TxOut)))
([Selection (TxIn, TxOut)]
 -> Const [Selection (TxIn, TxOut)] [Selection (TxIn, TxOut)])
-> MigrationPlan (TxIn, TxOut)
-> Const [Selection (TxIn, TxOut)] (MigrationPlan (TxIn, TxOut))
#selections MigrationPlan (TxIn, TxOut)
plan
    , $sel:unselected:MigrationPlan :: UTxO
unselected = CategorizedUTxO (TxIn, TxOut) -> UTxO
Planning.uncategorizeUTxO (((CategorizedUTxO (TxIn, TxOut)
  -> Const
       (CategorizedUTxO (TxIn, TxOut)) (CategorizedUTxO (TxIn, TxOut)))
 -> MigrationPlan (TxIn, TxOut)
 -> Const
      (CategorizedUTxO (TxIn, TxOut)) (MigrationPlan (TxIn, TxOut)))
-> MigrationPlan (TxIn, TxOut) -> CategorizedUTxO (TxIn, TxOut)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "unselected"
  ((CategorizedUTxO (TxIn, TxOut)
    -> Const
         (CategorizedUTxO (TxIn, TxOut)) (CategorizedUTxO (TxIn, TxOut)))
   -> MigrationPlan (TxIn, TxOut)
   -> Const
        (CategorizedUTxO (TxIn, TxOut)) (MigrationPlan (TxIn, TxOut)))
(CategorizedUTxO (TxIn, TxOut)
 -> Const
      (CategorizedUTxO (TxIn, TxOut)) (CategorizedUTxO (TxIn, TxOut)))
-> MigrationPlan (TxIn, TxOut)
-> Const
     (CategorizedUTxO (TxIn, TxOut)) (MigrationPlan (TxIn, TxOut))
#unselected MigrationPlan (TxIn, TxOut)
plan)
    , $sel:totalFee:MigrationPlan :: Coin
totalFee = ((Coin -> Const Coin Coin)
 -> MigrationPlan (TxIn, TxOut)
 -> Const Coin (MigrationPlan (TxIn, TxOut)))
-> MigrationPlan (TxIn, TxOut) -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "totalFee"
  ((Coin -> Const Coin Coin)
   -> MigrationPlan (TxIn, TxOut)
   -> Const Coin (MigrationPlan (TxIn, TxOut)))
(Coin -> Const Coin Coin)
-> MigrationPlan (TxIn, TxOut)
-> Const Coin (MigrationPlan (TxIn, TxOut))
#totalFee MigrationPlan (TxIn, TxOut)
plan
    }
  where
    plan :: MigrationPlan (TxIn, TxOut)
plan = TxConstraints
-> CategorizedUTxO (TxIn, TxOut)
-> RewardWithdrawal
-> MigrationPlan (TxIn, TxOut)
forall input.
TxConstraints
-> CategorizedUTxO input -> RewardWithdrawal -> MigrationPlan input
Planning.createPlan
        TxConstraints
constraints (TxConstraints -> UTxO -> CategorizedUTxO (TxIn, TxOut)
Planning.categorizeUTxO TxConstraints
constraints UTxO
utxo) RewardWithdrawal
reward