V1.hs

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

-- | A buggy implementation of Unsafe ledger, returns balances multiplied by 2

module Lorentz.Contracts.UpgradeableUnsafeLedger.V1
  ( UnsafeLedgerV1
  , Interface
  , migrate
  , unsafeLedgerContract

  -- The following are used in V2
  , UStoreTemplate
  , UStoreV1
  , TransferParams
  , transfer
  , getTotalSupply
  ) where

import Lorentz

import Lorentz.Contracts.Upgradeable.Common
import Lorentz.UStore

data UnsafeLedgerV1 :: VersionKind

type Interface =
  [ "transfer" ?: TransferParams
  , "getTotalSupply" ?: Void_ () Natural
  , "getBalance" ?: Void_ Address (Maybe Natural)
  ]

type TransferParams = (Address, Natural)

data UStoreTemplate = UStoreTemplate
  { ledger      :: Address |~> Natural
  , totalSupply :: UStoreField Natural
  } deriving stock (Eq, Generic)

type UStoreV1 = UStore UStoreTemplate

instance KnownContractVersion UnsafeLedgerV1 where
  type VerInterface UnsafeLedgerV1 = Interface
  type VerUStoreTemplate UnsafeLedgerV1 = UStoreTemplate
  contractVersion _ = 1

-- | Like in UpgradeableCounter, this function  populates the empty UStore_
--   with entries and initial values for each field. The result is expected
--   to adhere to V1.UStoreTemplate
migrate :: '[UStore_] :-> '[UStore_]
migrate = checkedCoercing_ @_ @UStoreV1 $ do
  push @Natural 500
  dup
  dip $ ustoreSetField #totalSupply
  sender
  ustoreInsert #ledger

unsafeLedgerContract :: UContractRouter UnsafeLedgerV1
unsafeLedgerContract = mkUContractRouter $ do
  caseUParamT @Interface
    ( #transfer /-> transfer
    , #getTotalSupply /-> getTotalSupply
    , #getBalance /-> buggyGetBalance
    )
    uparamFallbackFail

transfer :: '[TransferParams, UStoreV1]
         :-> '[([Operation], UStoreV1)]
transfer = do
  debitSource; creditTo; nil; pair;

getTotalSupply :: '[Void_ () Natural, UStoreV1]
               :-> '[([Operation], UStoreV1)]
getTotalSupply = void_ (do drop @(); ustoreToField #totalSupply)

-- Buggy getBalance returns balance multiplied by 2
buggyGetBalance :: '[Void_ Address (Maybe Natural), UStoreV1]
                :-> '[([Operation], UStoreV1)]
buggyGetBalance = void_ $ do
  ustoreGet #ledger
  if IsSome
  then push @Natural 2 >> mul >> some
  else none

debitSource :: '[TransferParams, UStoreV1]
            :-> '[TransferParams, UStoreV1]
debitSource = do
  dip $ do
    sender
    dip dup
    ustoreGet #ledger
    assertSome [mt|Sender address is not in ledger|]
  swap
  dip (dup # cdr)
  subGt0
  swap
  dip (do sender; ustoreUpdate #ledger)

creditTo :: '[TransferParams, UStoreV1] :-> '[UStoreV1]
creditTo = do
  dup; car
  swap
  dip (dip dup # ustoreGet #ledger)
  swap
  if IsSome then dip (dup >> cdr) >> add @Natural else (dup >> cdr)
  some
  dip (car)
  swap
  ustoreUpdate #ledger

subGt0 :: Natural ': Natural ': s :-> Maybe Natural ': s
subGt0 = do
  sub;
  dup; assertGe0 [mt|Transferred value is greater than balance|]
  dup; eq0
  if Holds
  then drop >> none
  else isNat