Add a simple mint

parent 85b60056
#lang racket/base
;; An extremely simple mint, straight from
;; http://erights.org/elib/capability/ode/index.html
(provide ^mint
withdraw)
(require "../core.rkt" "../utils/simple-sealers.rkt"
"methods.rkt" "cell.rkt"
racket/contract)
(define (^mint _bcom)
(define-values (decr-seal decr-unseal _decr-sealed?)
(make-sealer-triplet 'mint))
(define (^purse _bcom initial-balance)
(define-cell balance
initial-balance)
(define (<=-balance? amount)
(<= amount ($ balance)))
(define/contract (decr amount)
(-> (and/c integer? (>=/c 0) <=-balance?)
any/c)
($ balance (- ($ balance) amount)))
(define/contract (deposit-method amount src)
(-> (and/c integer? (>=/c 0)) any/c any/c)
((decr-unseal ($ src 'get-decr)) amount) ; decrement src balance
($ balance (+ ($ balance) amount))) ; increment our balance
(methods
[(get-balance) ($ balance)]
[(sprout) (spawn ^purse 0)]
[deposit deposit-method]
[(get-decr) (decr-seal decr)]))
(define/contract (fiat-make-purse initial-balance)
(-> (and/c integer? (>=/c 0)) any/c)
(spawn ^purse initial-balance))
(methods [new-purse fiat-make-purse]))
(define (withdraw from-purse amt)
(define new-purse
($ from-purse 'sprout))
($ new-purse 'deposit amt from-purse)
new-purse)
(module+ test
(require rackunit
"bootstrap.rkt")
(define am (make-actormap))
(define-actormap-run am-run am)
(define carol-mint
(am-run (spawn ^mint)))
(define alice-purse
(am-run ($ carol-mint 'new-purse 1000)))
(check-equal?
(am-run ($ alice-purse 'get-balance))
1000)
(define bob-purse
(am-run ($ carol-mint 'new-purse 300)))
(define payment-for-bob
(am-run ($ alice-purse 'sprout)))
;; transfer money from alice's purse to payment-for-bob
(am-run ($ payment-for-bob 'deposit 250 alice-purse))
(check-equal?
(am-run ($ alice-purse 'get-balance))
750)
(check-equal?
(am-run ($ payment-for-bob 'get-balance))
250)
;; give bob the money
(am-run ($ bob-purse 'deposit 250 payment-for-bob))
(check-equal?
(am-run ($ payment-for-bob 'get-balance))
0)
(check-equal?
(am-run ($ bob-purse 'get-balance))
550)
(check-equal?
(am-run ($ alice-purse 'get-balance))
750)
;; withdraw should work just as easily
(define joe-purse
(am-run ($ carol-mint 'new-purse 400)))
(define payment-for-jane
(am-run (withdraw joe-purse 150)))
(check-equal?
(am-run ($ payment-for-jane 'get-balance))
150)
(check-equal?
(am-run ($ joe-purse 'get-balance))
250)
;; Now let's make sure there are things we can't do...
;; Like have mallet make up a new mint and try to insert stuff
;; into eir wallet
(define mallet-mint
(am-run (spawn ^mint)))
(define mallet-mallet-purse
(am-run ($ mallet-mint 'new-purse 1000)))
(define mallet-carol-purse
(am-run ($ carol-mint 'new-purse 0)))
;; Now mallet tries to deposit money into their carol purse
(check-exn
any/c
(lambda ()
(am-run ($ mallet-carol-purse 'deposit mallet-mallet-purse))))
;; nice try, Mallet
(check-equal?
(am-run ($ mallet-carol-purse 'get-balance))
0)
;; Okay now let's try withdrawing more than we can
(define zed-purse
(am-run ($ carol-mint 'new-purse 100)))
(check-exn
any/c
(lambda ()
(am-run (withdraw zed-purse 9000))))
;; Likewise we can't deposit more to willow than we have
(define willow-purse
(am-run ($ carol-mint 'new-purse 0)))
(check-exn
any/c
(lambda ()
(am-run ($ willow-purse 'deposit 9000 zed-purse)))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment