-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | The implementation of Unsafe ledger with V1 balance bug fixed

module Lorentz.Contracts.UpgradeableUnsafeLedger.V2
  ( UnsafeLedgerV2
  , migrate
  , unsafeLedgerContract
  ) where

import Lorentz

import Lorentz.Contracts.Upgradeable.Common
import qualified Lorentz.Contracts.UpgradeableUnsafeLedger.V1 as V1
import Lorentz.UStore

data UnsafeLedgerV2 :: VersionKind

-- The storage does not change
type UStoreV2 = V1.UStoreV1

type Interface = V1.Interface

instance KnownContractVersion UnsafeLedgerV2 where
  type VerInterface UnsafeLedgerV2 = Interface
  type VerUStoreTemplate UnsafeLedgerV2 = VerUStoreTemplate V1.UnsafeLedgerV1
  contractVersion :: Proxy UnsafeLedgerV2 -> Version
contractVersion Proxy UnsafeLedgerV2
_ = Version
2

-- | Storage migration function. Since the storage is the same,
--   there's nothing to migrate
migrate :: '[UStore_] :-> '[UStore_]
migrate :: '[UStore_] :-> '[UStore_]
migrate = '[UStore_] :-> '[UStore_]
forall (s :: [*]). s :-> s
nop

-- | The second version of the UpgradeableUnsafeLedger.
--   Most of the functions are from V1 except for getBalance.
unsafeLedgerContract :: UContractRouter UnsafeLedgerV2
unsafeLedgerContract :: UContractRouter UnsafeLedgerV2
unsafeLedgerContract = ('[VerParam UnsafeLedgerV2, VerUStore UnsafeLedgerV2]
 :-> '[([Operation], VerUStore UnsafeLedgerV2)])
-> UContractRouter UnsafeLedgerV2
forall (ver :: VersionKind).
('[VerParam ver, VerUStore ver]
 :-> '[([Operation], VerUStore ver)])
-> UContractRouter ver
mkUContractRouter (('[VerParam UnsafeLedgerV2, VerUStore UnsafeLedgerV2]
  :-> '[([Operation], VerUStore UnsafeLedgerV2)])
 -> UContractRouter UnsafeLedgerV2)
-> ('[VerParam UnsafeLedgerV2, VerUStore UnsafeLedgerV2]
    :-> '[([Operation], VerUStore UnsafeLedgerV2)])
-> UContractRouter UnsafeLedgerV2
forall a b. (a -> b) -> a -> b
$ do
  IsoRecTuple
  (Rec
     (CaseClauseU
        '[UStore UStoreTemplate] '[([Operation], UStore UStoreTemplate)])
     Interface)
-> UParamFallback
     '[UStore UStoreTemplate] '[([Operation], UStore UStoreTemplate)]
-> '[UParam Interface, UStore UStoreTemplate]
   :-> '[([Operation], UStore UStoreTemplate)]
forall (entries :: [EntrypointKind]) (inp :: [*]) (out :: [*])
       clauses.
(clauses ~ Rec (CaseClauseU inp out) entries, RecFromTuple clauses,
 CaseUParam entries) =>
IsoRecTuple clauses
-> UParamFallback inp out -> (UParam entries : inp) :-> out
caseUParamT @Interface
    ( Label "transfer"
forall a. IsLabel "transfer" a => a
forall (x :: Symbol) a. IsLabel x a => a
#transfer Label "transfer"
-> ('[TransferParams, UStore UStoreTemplate]
    :-> '[([Operation], UStore UStoreTemplate)])
-> CaseClauseU
     '[UStore UStoreTemplate]
     '[([Operation], UStore UStoreTemplate)]
     '("transfer", TransferParams)
forall (name :: Symbol) body clause.
CaseArrow name body clause =>
Label name -> body -> clause
/-> '[TransferParams, UStore UStoreTemplate]
:-> '[([Operation], UStore UStoreTemplate)]
V1.transfer
    , Label "getTotalSupply"
forall a. IsLabel "getTotalSupply" a => a
forall (x :: Symbol) a. IsLabel x a => a
#getTotalSupply Label "getTotalSupply"
-> ('[Void_ () Natural, UStore UStoreTemplate]
    :-> '[([Operation], UStore UStoreTemplate)])
-> CaseClauseU
     '[UStore UStoreTemplate]
     '[([Operation], UStore UStoreTemplate)]
     '("getTotalSupply", Void_ () Natural)
forall (name :: Symbol) body clause.
CaseArrow name body clause =>
Label name -> body -> clause
/-> '[Void_ () Natural, UStore UStoreTemplate]
:-> '[([Operation], UStore UStoreTemplate)]
V1.getTotalSupply
    , Label "getBalance"
forall a. IsLabel "getBalance" a => a
forall (x :: Symbol) a. IsLabel x a => a
#getBalance Label "getBalance"
-> ('[Void_ Address (Maybe Natural), UStore UStoreTemplate]
    :-> '[([Operation], UStore UStoreTemplate)])
-> CaseClauseU
     '[UStore UStoreTemplate]
     '[([Operation], UStore UStoreTemplate)]
     '("getBalance", Void_ Address (Maybe Natural))
forall (name :: Symbol) body clause.
CaseArrow name body clause =>
Label name -> body -> clause
/-> '[Void_ Address (Maybe Natural), UStore UStoreTemplate]
:-> '[([Operation], UStore UStoreTemplate)]
getBalance
    )
    UParamFallback
  '[UStore UStoreTemplate] '[([Operation], UStore UStoreTemplate)]
forall (inp :: [*]) (out :: [*]). UParamFallback inp out
uparamFallbackFail

-- Note that the new getBalance returns the correct balance
getBalance :: '[Void_ Address (Maybe Natural), UStoreV2]
           :-> '[([Operation], UStoreV2)]
getBalance :: '[Void_ Address (Maybe Natural), UStore UStoreTemplate]
:-> '[([Operation], UStore UStoreTemplate)]
getBalance = ('[Address, UStore UStoreTemplate] :-> '[Maybe Natural])
-> '[Void_ Address (Maybe Natural), UStore UStoreTemplate]
   :-> '[([Operation], UStore UStoreTemplate)]
forall a b (s :: [*]) (s' :: [*]) (anything :: [*]).
(IsError (VoidResult b), NiceConstant b) =>
((a : s) :-> (b : s')) -> (Void_ a b : s) :-> anything
void_ (Label "ledger"
-> '[GetUStoreKey UStoreTemplate "ledger", UStore UStoreTemplate]
   :-> '[Maybe (GetUStoreValue UStoreTemplate "ledger")]
forall store (name :: Symbol) (s :: [*]).
(KeyAccessC store name, ValueAccessC store name) =>
Label name
-> (GetUStoreKey store name : UStore store : s)
   :-> (Maybe (GetUStoreValue store name) : s)
ustoreGet Label "ledger"
forall a. IsLabel "ledger" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ledger)