-- 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
  { UStoreTemplate -> Address |~> Natural
ledger      :: Address |~> Natural
  , UStoreTemplate -> UStoreField Natural
totalSupply :: UStoreField Natural
  } deriving stock (UStoreTemplate -> UStoreTemplate -> Bool
(UStoreTemplate -> UStoreTemplate -> Bool)
-> (UStoreTemplate -> UStoreTemplate -> Bool) -> Eq UStoreTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UStoreTemplate -> UStoreTemplate -> Bool
$c/= :: UStoreTemplate -> UStoreTemplate -> Bool
== :: UStoreTemplate -> UStoreTemplate -> Bool
$c== :: UStoreTemplate -> UStoreTemplate -> Bool
Eq, (forall x. UStoreTemplate -> Rep UStoreTemplate x)
-> (forall x. Rep UStoreTemplate x -> UStoreTemplate)
-> Generic UStoreTemplate
forall x. Rep UStoreTemplate x -> UStoreTemplate
forall x. UStoreTemplate -> Rep UStoreTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UStoreTemplate x -> UStoreTemplate
$cfrom :: forall x. UStoreTemplate -> Rep UStoreTemplate x
Generic)

type UStoreV1 = UStore UStoreTemplate

instance KnownContractVersion UnsafeLedgerV1 where
  type VerInterface UnsafeLedgerV1 = Interface
  type VerUStoreTemplate UnsafeLedgerV1 = UStoreTemplate
  contractVersion :: Proxy UnsafeLedgerV1 -> Version
contractVersion Proxy UnsafeLedgerV1
_ = Version
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 :: '[UStore_] :-> '[UStore_]
migrate = forall (s :: [*]).
Coercible_ UStore_ UStoreV1 =>
((UStoreV1 : s) :-> (UStoreV1 : s))
-> (UStore_ : s) :-> (UStore_ : s)
forall a b (s :: [*]).
Coercible_ a b =>
((b : s) :-> (b : s)) -> (a : s) :-> (a : s)
checkedCoercing_ @_ @UStoreV1 (('[UStoreV1] :-> '[UStoreV1]) -> '[UStore_] :-> '[UStore_])
-> ('[UStoreV1] :-> '[UStoreV1]) -> '[UStore_] :-> '[UStore_]
forall a b. (a -> b) -> a -> b
$ do
  Natural -> '[UStoreV1] :-> '[Natural, UStoreV1]
forall t (s :: [*]). NiceConstant t => t -> s :-> (t : s)
push @Natural Natural
500
  '[Natural, UStoreV1] :-> '[Natural, Natural, UStoreV1]
forall a (s :: [*]). (a : s) :-> (a : a : s)
dup
  ('[Natural, UStoreV1] :-> '[UStoreV1])
-> '[Natural, Natural, UStoreV1] :-> '[Natural, UStoreV1]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (('[Natural, UStoreV1] :-> '[UStoreV1])
 -> '[Natural, Natural, UStoreV1] :-> '[Natural, UStoreV1])
-> ('[Natural, UStoreV1] :-> '[UStoreV1])
-> '[Natural, Natural, UStoreV1] :-> '[Natural, UStoreV1]
forall a b. (a -> b) -> a -> b
$ Label "totalSupply"
-> '[GetUStoreField UStoreTemplate "totalSupply", UStoreV1]
   :-> '[UStoreV1]
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (GetUStoreField store name : UStore store : s)
   :-> (UStore store : s)
ustoreSetField Label "totalSupply"
forall a. IsLabel "totalSupply" a => a
forall (x :: Symbol) a. IsLabel x a => a
#totalSupply
  '[Natural, UStoreV1] :-> '[Address, Natural, UStoreV1]
forall (s :: [*]). s :-> (Address : s)
sender
  Label "ledger"
-> '[GetUStoreKey UStoreTemplate "ledger",
     GetUStoreValue UStoreTemplate "ledger", UStoreV1]
   :-> '[UStoreV1]
forall store (name :: Symbol) (s :: [*]).
(KeyAccessC store name, ValueAccessC store name) =>
Label name
-> (GetUStoreKey store name
      : GetUStoreValue store name : UStore store : s)
   :-> (UStore store : s)
ustoreInsert Label "ledger"
forall a. IsLabel "ledger" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ledger

unsafeLedgerContract :: UContractRouter UnsafeLedgerV1
unsafeLedgerContract :: UContractRouter UnsafeLedgerV1
unsafeLedgerContract = ('[VerParam UnsafeLedgerV1, VerUStore UnsafeLedgerV1]
 :-> '[([Operation], VerUStore UnsafeLedgerV1)])
-> UContractRouter UnsafeLedgerV1
forall (ver :: VersionKind).
('[VerParam ver, VerUStore ver]
 :-> '[([Operation], VerUStore ver)])
-> UContractRouter ver
mkUContractRouter (('[VerParam UnsafeLedgerV1, VerUStore UnsafeLedgerV1]
  :-> '[([Operation], VerUStore UnsafeLedgerV1)])
 -> UContractRouter UnsafeLedgerV1)
-> ('[VerParam UnsafeLedgerV1, VerUStore UnsafeLedgerV1]
    :-> '[([Operation], VerUStore UnsafeLedgerV1)])
-> UContractRouter UnsafeLedgerV1
forall a b. (a -> b) -> a -> b
$ do
  IsoRecTuple
  (Rec
     (CaseClauseU '[UStoreV1] '[([Operation], UStoreV1)]) Interface)
-> UParamFallback '[UStoreV1] '[([Operation], UStoreV1)]
-> '[UParam Interface, UStoreV1] :-> '[([Operation], UStoreV1)]
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, UStoreV1] :-> '[([Operation], UStoreV1)])
-> CaseClauseU
     '[UStoreV1]
     '[([Operation], UStoreV1)]
     '("transfer", TransferParams)
forall (name :: Symbol) body clause.
CaseArrow name body clause =>
Label name -> body -> clause
/-> '[TransferParams, UStoreV1] :-> '[([Operation], UStoreV1)]
transfer
    , Label "getTotalSupply"
forall a. IsLabel "getTotalSupply" a => a
forall (x :: Symbol) a. IsLabel x a => a
#getTotalSupply Label "getTotalSupply"
-> ('[Void_ () Natural, UStoreV1] :-> '[([Operation], UStoreV1)])
-> CaseClauseU
     '[UStoreV1]
     '[([Operation], UStoreV1)]
     '("getTotalSupply", Void_ () Natural)
forall (name :: Symbol) body clause.
CaseArrow name body clause =>
Label name -> body -> clause
/-> '[Void_ () Natural, UStoreV1] :-> '[([Operation], UStoreV1)]
getTotalSupply
    , Label "getBalance"
forall a. IsLabel "getBalance" a => a
forall (x :: Symbol) a. IsLabel x a => a
#getBalance Label "getBalance"
-> ('[Void_ Address (Maybe Natural), UStoreV1]
    :-> '[([Operation], UStoreV1)])
-> CaseClauseU
     '[UStoreV1]
     '[([Operation], UStoreV1)]
     '("getBalance", Void_ Address (Maybe Natural))
forall (name :: Symbol) body clause.
CaseArrow name body clause =>
Label name -> body -> clause
/-> '[Void_ Address (Maybe Natural), UStoreV1]
:-> '[([Operation], UStoreV1)]
buggyGetBalance
    )
    UParamFallback '[UStoreV1] '[([Operation], UStoreV1)]
forall (inp :: [*]) (out :: [*]). UParamFallback inp out
uparamFallbackFail

transfer :: '[TransferParams, UStoreV1]
         :-> '[([Operation], UStoreV1)]
transfer :: '[TransferParams, UStoreV1] :-> '[([Operation], UStoreV1)]
transfer = do
  '[TransferParams, UStoreV1] :-> '[TransferParams, UStoreV1]
debitSource; '[TransferParams, UStoreV1] :-> '[UStoreV1]
creditTo; '[UStoreV1] :-> '[[Operation], UStoreV1]
forall p (s :: [*]). KnownValue p => s :-> (List p : s)
nil; '[[Operation], UStoreV1] :-> '[([Operation], UStoreV1)]
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
pair;

getTotalSupply :: '[Void_ () Natural, UStoreV1]
               :-> '[([Operation], UStoreV1)]
getTotalSupply :: '[Void_ () Natural, UStoreV1] :-> '[([Operation], UStoreV1)]
getTotalSupply = ('[(), UStoreV1] :-> '[Natural])
-> '[Void_ () Natural, UStoreV1] :-> '[([Operation], UStoreV1)]
forall a b (s :: [*]) (s' :: [*]) (anything :: [*]).
(IsError (VoidResult b), NiceConstant b) =>
((a : s) :-> (b : s')) -> (Void_ a b : s) :-> anything
void_ (do forall (s :: [*]). (() : s) :-> s
forall a (s :: [*]). (a : s) :-> s
drop @(); Label "totalSupply"
-> '[UStoreV1] :-> '[GetUStoreField UStoreTemplate "totalSupply"]
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (UStore store : s) :-> (GetUStoreField store name : s)
ustoreToField Label "totalSupply"
forall a. IsLabel "totalSupply" a => a
forall (x :: Symbol) a. IsLabel x a => a
#totalSupply)

-- Buggy getBalance returns balance multiplied by 2
buggyGetBalance :: '[Void_ Address (Maybe Natural), UStoreV1]
                :-> '[([Operation], UStoreV1)]
buggyGetBalance :: '[Void_ Address (Maybe Natural), UStoreV1]
:-> '[([Operation], UStoreV1)]
buggyGetBalance = ('[Address, UStoreV1] :-> '[Maybe Natural])
-> '[Void_ Address (Maybe Natural), UStoreV1]
   :-> '[([Operation], UStoreV1)]
forall a b (s :: [*]) (s' :: [*]) (anything :: [*]).
(IsError (VoidResult b), NiceConstant b) =>
((a : s) :-> (b : s')) -> (Void_ a b : s) :-> anything
void_ (('[Address, UStoreV1] :-> '[Maybe Natural])
 -> '[Void_ Address (Maybe Natural), UStoreV1]
    :-> '[([Operation], UStoreV1)])
-> ('[Address, UStoreV1] :-> '[Maybe Natural])
-> '[Void_ Address (Maybe Natural), UStoreV1]
   :-> '[([Operation], UStoreV1)]
forall a b. (a -> b) -> a -> b
$ do
  Label "ledger"
-> '[GetUStoreKey UStoreTemplate "ledger", UStoreV1]
   :-> '[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
  if Condition
  '[Maybe Natural] '[Natural] '[] '[Maybe Natural] '[Maybe Natural]
forall a (argr :: [*]) (outb :: [*]).
Condition (Maybe a : argr) (a : argr) argr outb outb
IsSome
  then Natural -> '[Natural] :-> '[Natural, Natural]
forall t (s :: [*]). NiceConstant t => t -> s :-> (t : s)
push @Natural Natural
2 ('[Natural] :-> '[Natural, Natural])
-> ('[Natural, Natural] :-> '[Natural])
-> '[Natural] :-> '[Natural]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
>> '[Natural, Natural] :-> '[Natural]
forall n m (s :: [*]).
ArithOpHs Mul n m =>
(n : m : s) :-> (ArithResHs Mul n m : s)
mul ('[Natural] :-> '[Natural])
-> ('[Natural] :-> '[Maybe Natural])
-> '[Natural] :-> '[Maybe Natural]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
>> '[Natural] :-> '[Maybe Natural]
forall a (s :: [*]). (a : s) :-> (Maybe a : s)
some
  else '[] :-> '[Maybe Natural]
forall a (s :: [*]). KnownValue a => s :-> (Maybe a : s)
none

debitSource :: '[TransferParams, UStoreV1]
            :-> '[TransferParams, UStoreV1]
debitSource :: '[TransferParams, UStoreV1] :-> '[TransferParams, UStoreV1]
debitSource = do
  ('[UStoreV1] :-> '[Natural, UStoreV1])
-> '[TransferParams, UStoreV1]
   :-> '[TransferParams, Natural, UStoreV1]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (('[UStoreV1] :-> '[Natural, UStoreV1])
 -> '[TransferParams, UStoreV1]
    :-> '[TransferParams, Natural, UStoreV1])
-> ('[UStoreV1] :-> '[Natural, UStoreV1])
-> '[TransferParams, UStoreV1]
   :-> '[TransferParams, Natural, UStoreV1]
forall a b. (a -> b) -> a -> b
$ do
    '[UStoreV1] :-> '[Address, UStoreV1]
forall (s :: [*]). s :-> (Address : s)
sender
    ('[UStoreV1] :-> '[UStoreV1, UStoreV1])
-> '[Address, UStoreV1] :-> '[Address, UStoreV1, UStoreV1]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip '[UStoreV1] :-> '[UStoreV1, UStoreV1]
forall a (s :: [*]). (a : s) :-> (a : a : s)
dup
    Label "ledger"
-> '[GetUStoreKey UStoreTemplate "ledger", UStoreV1, UStoreV1]
   :-> '[Maybe (GetUStoreValue UStoreTemplate "ledger"), UStoreV1]
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
    MText -> '[Maybe Natural, UStoreV1] :-> '[Natural, UStoreV1]
forall err a (s :: [*]).
IsError err =>
err -> (Maybe a : s) :-> (a : s)
assertSome [mt|Sender address is not in ledger|]
  '[TransferParams, Natural, UStoreV1]
:-> '[Natural, TransferParams, UStoreV1]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
swap
  ('[TransferParams, UStoreV1]
 :-> '[Natural, TransferParams, UStoreV1])
-> '[Natural, TransferParams, UStoreV1]
   :-> '[Natural, Natural, TransferParams, UStoreV1]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip ('[TransferParams, UStoreV1]
:-> '[TransferParams, TransferParams, UStoreV1]
forall a (s :: [*]). (a : s) :-> (a : a : s)
dup ('[TransferParams, UStoreV1]
 :-> '[TransferParams, TransferParams, UStoreV1])
-> ('[TransferParams, TransferParams, UStoreV1]
    :-> '[Natural, TransferParams, UStoreV1])
-> '[TransferParams, UStoreV1]
   :-> '[Natural, TransferParams, UStoreV1]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[TransferParams, TransferParams, UStoreV1]
:-> '[Natural, TransferParams, UStoreV1]
forall a b (s :: [*]). ((a, b) : s) :-> (b : s)
cdr)
  '[Natural, Natural, TransferParams, UStoreV1]
:-> '[Maybe Natural, TransferParams, UStoreV1]
forall (s :: [*]). (Natural : Natural : s) :-> (Maybe Natural : s)
subGt0
  '[Maybe Natural, TransferParams, UStoreV1]
:-> '[TransferParams, Maybe Natural, UStoreV1]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
swap
  ('[Maybe Natural, UStoreV1] :-> '[UStoreV1])
-> '[TransferParams, Maybe Natural, UStoreV1]
   :-> '[TransferParams, UStoreV1]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (do '[Maybe Natural, UStoreV1] :-> '[Address, Maybe Natural, UStoreV1]
forall (s :: [*]). s :-> (Address : s)
sender; Label "ledger"
-> '[GetUStoreKey UStoreTemplate "ledger",
     Maybe (GetUStoreValue UStoreTemplate "ledger"), UStoreV1]
   :-> '[UStoreV1]
forall store (name :: Symbol) (s :: [*]).
(KeyAccessC store name, ValueAccessC store name) =>
Label name
-> (GetUStoreKey store name
      : Maybe (GetUStoreValue store name) : UStore store : s)
   :-> (UStore store : s)
ustoreUpdate Label "ledger"
forall a. IsLabel "ledger" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ledger)

creditTo :: '[TransferParams, UStoreV1] :-> '[UStoreV1]
creditTo :: '[TransferParams, UStoreV1] :-> '[UStoreV1]
creditTo = do
  '[TransferParams, UStoreV1]
:-> '[TransferParams, TransferParams, UStoreV1]
forall a (s :: [*]). (a : s) :-> (a : a : s)
dup; '[TransferParams, TransferParams, UStoreV1]
:-> '[Address, TransferParams, UStoreV1]
forall a b (s :: [*]). ((a, b) : s) :-> (a : s)
car
  '[Address, TransferParams, UStoreV1]
:-> '[TransferParams, Address, UStoreV1]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
swap
  ('[Address, UStoreV1] :-> '[Maybe Natural, UStoreV1])
-> '[TransferParams, Address, UStoreV1]
   :-> '[TransferParams, Maybe Natural, UStoreV1]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (('[UStoreV1] :-> '[UStoreV1, UStoreV1])
-> '[Address, UStoreV1] :-> '[Address, UStoreV1, UStoreV1]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip '[UStoreV1] :-> '[UStoreV1, UStoreV1]
forall a (s :: [*]). (a : s) :-> (a : a : s)
dup ('[Address, UStoreV1] :-> '[Address, UStoreV1, UStoreV1])
-> ('[Address, UStoreV1, UStoreV1] :-> '[Maybe Natural, UStoreV1])
-> '[Address, UStoreV1] :-> '[Maybe Natural, UStoreV1]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# Label "ledger"
-> '[GetUStoreKey UStoreTemplate "ledger", UStoreV1, UStoreV1]
   :-> '[Maybe (GetUStoreValue UStoreTemplate "ledger"), UStoreV1]
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)
  '[TransferParams, Maybe Natural, UStoreV1]
:-> '[Maybe Natural, TransferParams, UStoreV1]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
swap
  if Condition
  '[Maybe Natural, TransferParams, UStoreV1]
  '[Natural, TransferParams, UStoreV1]
  '[TransferParams, UStoreV1]
  '[Natural, TransferParams, UStoreV1]
  '[Natural, TransferParams, UStoreV1]
forall a (argr :: [*]) (outb :: [*]).
Condition (Maybe a : argr) (a : argr) argr outb outb
IsSome then ('[TransferParams, UStoreV1]
 :-> '[Natural, TransferParams, UStoreV1])
-> '[Natural, TransferParams, UStoreV1]
   :-> '[Natural, Natural, TransferParams, UStoreV1]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip ('[TransferParams, UStoreV1]
:-> '[TransferParams, TransferParams, UStoreV1]
forall a (s :: [*]). (a : s) :-> (a : a : s)
dup ('[TransferParams, UStoreV1]
 :-> '[TransferParams, TransferParams, UStoreV1])
-> ('[TransferParams, TransferParams, UStoreV1]
    :-> '[Natural, TransferParams, UStoreV1])
-> '[TransferParams, UStoreV1]
   :-> '[Natural, TransferParams, UStoreV1]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
>> '[TransferParams, TransferParams, UStoreV1]
:-> '[Natural, TransferParams, UStoreV1]
forall a b (s :: [*]). ((a, b) : s) :-> (b : s)
cdr) ('[Natural, TransferParams, UStoreV1]
 :-> '[Natural, Natural, TransferParams, UStoreV1])
-> ('[Natural, Natural, TransferParams, UStoreV1]
    :-> '[Natural, TransferParams, UStoreV1])
-> '[Natural, TransferParams, UStoreV1]
   :-> '[Natural, TransferParams, UStoreV1]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
>> forall m (s :: [*]).
ArithOpHs Add Natural m =>
(Natural : m : s) :-> (ArithResHs Add Natural m : s)
forall n m (s :: [*]).
ArithOpHs Add n m =>
(n : m : s) :-> (ArithResHs Add n m : s)
add @Natural else ('[TransferParams, UStoreV1]
:-> '[TransferParams, TransferParams, UStoreV1]
forall a (s :: [*]). (a : s) :-> (a : a : s)
dup ('[TransferParams, UStoreV1]
 :-> '[TransferParams, TransferParams, UStoreV1])
-> ('[TransferParams, TransferParams, UStoreV1]
    :-> '[Natural, TransferParams, UStoreV1])
-> '[TransferParams, UStoreV1]
   :-> '[Natural, TransferParams, UStoreV1]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
>> '[TransferParams, TransferParams, UStoreV1]
:-> '[Natural, TransferParams, UStoreV1]
forall a b (s :: [*]). ((a, b) : s) :-> (b : s)
cdr)
  '[Natural, TransferParams, UStoreV1]
:-> '[Maybe Natural, TransferParams, UStoreV1]
forall a (s :: [*]). (a : s) :-> (Maybe a : s)
some
  ('[TransferParams, UStoreV1] :-> '[Address, UStoreV1])
-> '[Maybe Natural, TransferParams, UStoreV1]
   :-> '[Maybe Natural, Address, UStoreV1]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip ('[TransferParams, UStoreV1] :-> '[Address, UStoreV1]
forall a b (s :: [*]). ((a, b) : s) :-> (a : s)
car)
  '[Maybe Natural, Address, UStoreV1]
:-> '[Address, Maybe Natural, UStoreV1]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
swap
  Label "ledger"
-> '[GetUStoreKey UStoreTemplate "ledger",
     Maybe (GetUStoreValue UStoreTemplate "ledger"), UStoreV1]
   :-> '[UStoreV1]
forall store (name :: Symbol) (s :: [*]).
(KeyAccessC store name, ValueAccessC store name) =>
Label name
-> (GetUStoreKey store name
      : Maybe (GetUStoreValue store name) : UStore store : s)
   :-> (UStore store : s)
ustoreUpdate Label "ledger"
forall a. IsLabel "ledger" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ledger

subGt0 :: Natural ': Natural ': s :-> Maybe Natural ': s
subGt0 :: (Natural : Natural : s) :-> (Maybe Natural : s)
subGt0 = do
  (Natural : Natural : s) :-> (Integer : s)
forall n m (s :: [*]).
ArithOpHs Sub n m =>
(n : m : s) :-> (ArithResHs Sub n m : s)
sub;
  (Integer : s) :-> (Integer : Integer : s)
forall a (s :: [*]). (a : s) :-> (a : a : s)
dup; MText -> (Integer : Integer : s) :-> (Integer : s)
forall a err (s :: [*]).
(IfCmp0Constraints a Ge, IsError err) =>
err -> (a : s) :-> s
assertGe0 [mt|Transferred value is greater than balance|]
  (Integer : s) :-> (Integer : Integer : s)
forall a (s :: [*]). (a : s) :-> (a : a : s)
dup; (Integer : Integer : s) :-> (Bool : Integer : s)
forall n (s :: [*]).
UnaryArithOpHs Eq' n =>
(n : s) :-> (UnaryArithResHs Eq' n : s)
eq0
  if Condition
  (Bool : Integer : s)
  (Integer : s)
  (Integer : s)
  (Maybe Natural : s)
  (Maybe Natural : s)
forall (argl :: [*]) (outb :: [*]).
Condition (Bool : argl) argl argl outb outb
Holds
  then (Integer : s) :-> s
forall a (s :: [*]). (a : s) :-> s
drop ((Integer : s) :-> s)
-> (s :-> (Maybe Natural : s))
-> (Integer : s) :-> (Maybe Natural : s)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
>> s :-> (Maybe Natural : s)
forall a (s :: [*]). KnownValue a => s :-> (Maybe a : s)
none
  else (Integer : s) :-> (Maybe Natural : s)
forall (s :: [*]). (Integer : s) :-> (Maybe Natural : s)
isNat