sicp-ex-3.7

<< Previous exercise (3.6) | Index | Next exercise (3.8) >>

x3v

Added a separate auth layer in the make-account procedure. Enables message-passing style implementation for "chained" joint accounts. 

  
 (define (make-account balance password) 
   (define incorrect-count 0) 
   (define (withdraw amount) 
     (if (>= balance amount) 
         (begin (set! balance (- balance amount)) 
                balance) 
         "insufficient")) 
   (define (deposit amount) 
     (set! balance (+ balance amount)) 
     balance) 
   (define (issue-warning) 
     (if (> incorrect-count 7) 
         (error "the cops are on their way") 
         (error (- 7 incorrect-count) 'more 'attempts))) 
   (define (auth-layer pw . m) 
     (cond ((null? m) (eq? pw password)) 
           ((eq? pw password) (dispatch (car m))) 
           (else (begin (set! incorrect-count (+ incorrect-count 1)) 
                        (issue-warning))))) 
   (define (dispatch m) 
     (set! incorrect-count 0) 
     (cond ((eq? m 'withdraw) withdraw) 
           ((eq? m 'deposit) deposit) 
           (else (error "Unknown request" m)))) 
   auth-layer) 
  
 (define (make-joint acc pw-prev pw-next) 
   (define (dispatch pw . m) 
     (if (null? m) 
         (eq? pw pw-next) 
         (acc (if (eq? pw pw-next) pw-prev pw-next) (car m)))) 
   (if (acc pw-prev) 
       dispatch 
       (error "Incorrect password to original account" pw-prev))) 
  
 (Define peter-acc (make-account 100 'open-sesame)) 
 (define paul-acc (make-joint peter-acc 'open-sesame 'rosebud)) 
 (define pan-acc (make-joint paul-acc 'rosebud 'vvv)) 
  
 ;; tests 
 ((pan-acc 'vvv 'deposit) 100)  ;; 200 
 ((peter-acc 'open-sesame 'deposit) 100) ;; 300 
 ((paul-acc 'rosebud 'deposit) 100) ;; 400 
 ((peter-acc 'rosebud 'deposit) 100)  ;; error as intended

woofy

arbitrary number of layers of joint account: 

 (define (make-account balance password) 
  
     (define (withdraw amount) 
         (if (>= balance amount) 
             (begin (set! balance (- balance amount)) balance) 
             "Insufficient funds")) 
      
     (define (deposit amount) 
         (set! balance (+ balance amount)) 
         balance) 
      
     (define (dispatch pwd m) 
         (if (eq? m 'auth) 
             (lambda () (eq? pwd password)) 
             (if (eq? pwd password) 
                 (cond ((eq? m 'withdraw) withdraw) 
                       ((eq? m 'deposit) deposit) 
                       (else (error "Unknown request -- MAKE-ACCOUNT" m))) 
                 (error "Incorrect password")))) 
      
     dispatch) 
  
 (define (make-joint account orig-pwd joint-pwd) 
  
     (define (withdraw amount) ((account orig-pwd 'withdraw) amount)) 
     (define (deposit amount) ((account orig-pwd 'deposit) amount)) 
  
     (define (dispatch pwd m) 
         (if (eq? m 'auth) 
             (lambda () (eq? pwd joint-pwd)) 
             (if (eq? pwd joint-pwd) 
                 (cond ((eq? m 'withdraw) withdraw) 
                       ((eq? m 'deposit) deposit) 
                       (else (error "Unknown request -- MAKE-ACCOUNT" m))) 
                 (error "Incorrect password")))) 
  
     (if ((account orig-pwd 'auth)) 
         dispatch 
         (error "Incorrect original password of target account"))) 
  
 ; test 
 (define peter-acc (make-account 100 'open-sesame)) 
 (define paul-acc (make-joint peter-acc 'open-sesame 'rosebud)) ;joint account 
 (define woofy-acc (make-joint paul-acc 'rosebud 'longleg)) ; joint joint account 
  
 ((peter-acc 'open-sesame 'withdraw) 50) ;50 
 ((paul-acc 'rosebud 'withdraw) 10) ;40 
 ((peter-acc 'open-sesame 'deposit) 0) ;40 
 ((woofy-acc 'longleg 'withdraw) 33) ;7 
 ((peter-acc 'open-sesame 'deposit) 0) ;7 
  
 ((woofy-acc 'rosebud 'withdraw) 100) ;wrong pwd 
 ((woofy-acc 'open-sesame 'withdraw) 100) ;wrong pwd

See sicp-ex-3.3-3.4 for the definition of make-account. 

 (define (make-joint account old-pass new-pass) 
   (and (number? ((account old-pass 'withdraw) 0)) 
        (lambda (pass msg) 
          (if (eq? pass new-pass) 
              (account old-pass msg) 
              (account 'bad-pass 'foo))))) ;increment bad-passwords

Alternative implementation: 

 (define (call-the-cops) 
   (display "calling the cops\n")) 
  
 (define (password-protect password subject) 
   (let ((num-attempts 0)) 
     (lambda (provided-password msg) 
       (if (eq? provided-password password) 
           (begin (set! num-attempts 0) 
                  (subject msg)) 
           (begin (set! num-attempts (+ 1 num-attempts)) 
                  (when (>= num-attempts 7) 
                    (call-the-cops)) 
                  (lambda (arg . rest) "invalid password")))))) 
  
 (define (make-account password balance) 
   (define (withdraw amount) 
     (if (>= balance amount) 
         (begin (set! balance (- balance amount)) 
                balance) 
         "insufficient funds")) 
   (define (deposit amount) 
     (set! balance (+ balance amount)) 
     balance) 
   (define (dispatch msg) 
     (cond ((eq? msg 'withdraw) withdraw) 
           ((eq? msg 'deposit) deposit) 
           (else (error "Unknown request -- MAKE-ACCOUNT" 
                        msg)))) 
   (password-protect password dispatch)) 
  
 (define (make-joint-account account original-password password) 
   (define (dispatch msg) 
     (account original-password msg)) 
   (password-protect password dispatch)) 

 (define (make-account balance secret-words) 
  
   (define (withdraw amount) 
     (if (>= balance amount) 
         (begin (set! balance (- balance amount)) balance) 
         "Insufficient funds")) 
  
   (define (deposit amount) 
     (set! balance (+ balance amount)) balance) 
  
   (define (make-join secret-words) (set-sw secret-words)) 
      
   (define (dispatch m) 
     (cond ((eq? m 'withdraw) withdraw) 
           ((eq? m 'deposit) deposit) 
           ((eq? m 'make-join) make-join) 
           (else (error "Unknown request -- MAKE-ACCOUNT" 
                        m)))) 
  
   (define (set-sw secret-words) 
     (lambda(pw m) 
       (cond ((eq? pw secret-words)(dispatch m)) 
             (else (error "Permission Denied -- MAKE-ACCOUNT"))))) 
  
   (set-sw secret-words))

CrazyAlvaro

Implements above are correct, just provide another way to do it 

  
 (define (make-account balance pass-origin) 
   (define (withdraw amount) 
     (if (>= balance amount) 
         (begin (set! balance (- balance amount)) 
                balance) 
         "Insufficient funds")) 
  
   (define (deposit amount) 
     (set! balance (+ balance amount)) 
     balance) 
  
   (define (make-joint another-pass) 
     (dispatch another-pass)) 
  
   (define (dispatch password) 
     (lambda (pass m) 
       (if (eq? pass password) 
         (cond ((eq? m 'withdraw) withdraw) 
               ((eq? m 'deposit) deposit) 
               ((eq? m 'make-joint) make-joint) 
               (else (error "Unknown request -- MAKE-ACCOUNT" 
                            m))) 
         (lambda (x) 
           "Incorrect password")))) 
            
   (dispatch pass-origin))

drugkeeper

This checks if you keyed in the 1st-password correctly when making the joint acc, by trying out the 1st pass to deposit 0 dollars into the account.

When depositing or withdrawing, it takes your password and checks it against new-pass, if its correct then it converts the password to 1st-pass and passes the message to the original account.

You can also make many joint accounts all sharing together as all the passwords are converted to the 1st-pass. 

 (define (make-joint acc 1st-pass new-pass) 
   (define (dispatch p m) 
     (cond ((eq? p new-pass) (acc 1st-pass m)) 
           (else (error "Wrong password")))) 
   (begin ((acc 1st-pass 'deposit) 0) ;this does a clever check on whether 1st-pass is correct. 
          dispatch))

master

This solution uses a password list to keep track of all the authorized passwords. Anybody can use any of the passwords contained in the list, however. I don't really see any way around that because there aren't any usernames, and there's no easy way to tell at the moment under what name the account is invoked. No need to make a dummy transaction as the only way to create a joint account is via an internal procedure in make-account. 

 (define (make-account balance password) 
   (let ((tries 0) 
         (password-list (list password))) 
     (define (withdraw amount) 
       (if (>= balance amount) 
           (begin (set! balance (- balance amount)) 
                  balance) 
           "Insufficient funds")) 
     (define (deposit amount) 
       (set! balance (+ balance amount)) 
       balance) 
     (define (contains? p plist) 
       (if (not (eq? (memq p plist) #f)) 
           #t 
           (lambda (x) "Incorrect password"))) 
     (define (add-user pass) 
       (set! password-list (cons pass password-list))) 
     (define (dispatch p m) 
             (if (contains? p password-list) 
              (cond ((eq? m 'withdraw) withdraw) 
                    ((eq? m 'deposit) deposit) 
                    ((eq? m 'add-user) add-user) 
                    (else (error "Unknown request: MAKE-ACCOUNT" 
                                 m))) 
             (lambda (x) "Incorrect password"))) 
     dispatch)) 
  
 (define (make-joint account password new-password) 
   ((account password 'add-user) new-password) 
   account)

santi

  
  
  
 #!/usr/bin/racket 
 #lang racket 
  
 (define (make-account balance pass) 
   (define (withdraw amount) 
     (if (>= balance amount) 
         (begin (set! balance (- balance amount)) 
                balance) 
         "Insufficient funds")) 
   (define (deposit amount) 
     (set! balance (+ balance amount)) 
     balance) 
   (define (incorrect-pass _) 
     "Incorrect password") 
  
   (define (dispatch m) 
     (cond ((eq? m 'withdraw) withdraw) 
           ((eq? m 'deposit) deposit) 
           ((eq? m 'joint) secure-dispatch) 
           (else (error "Unknown request: MAKE-ACCOUNT" 
                        m)))) 
  
   (define (secure-dispatch new-pass) 
     (lambda (input-pass m) 
       (if (eq? input-pass new-pass) 
           (dispatch m) 
           incorrect-pass 
           ))) 
  
   (secure-dispatch pass)) 
  
 ; (define acc (make-account 100)) 
  
 (define (make-joint acc pass new-pass) 
     ((acc pass 'joint) new-pass) 
   ) 
  
 ;tests 
  
 (define peter-acc (make-account 100 'open-sesame)) 
 (define paul-acc  (make-joint peter-acc 'open-sesame 'rosebud)) 
  
 ((peter-acc 'open-sesame 'withdraw) 10) ; 90 
 ((paul-acc 'rosebud 'withdraw) 10) ; 80 
 ((paul-acc 'open-sesame 'withdraw) 10) ; Incorrect password

denis manikhin

thank you very much x3v for idee with auth-layer 

  
 #lang sicp 
  
 (define (make-account balance)  
    (define (withdraw amount)  
      (if (>= balance amount)  
          (begin (set! balance (- balance amount))  
                 balance)  
          "Insufficient funds"))  
    (define (deposit amount)  
      (set! balance (+ balance amount))  
      balance)  
    (define (dispatch m)  
      (cond  ((eq? m 'withdraw) withdraw)  
             ((eq? m 'deposit) deposit)             
             (else (error "Unknown request -- MAKE-ACCOUNT"  
                          m))))  
    dispatch)  
  
  
 (define (make-passworded f f-password) 
   (lambda (password . z) 
     (cond 
       ((null? z) (eq? password f-password)) 
       ((eq? password f-password) (f (car z))) 
       (else (lambda _ "incorrect-password"))))) 
  
 (define (make-passworded-acc balance password) 
   (make-passworded (make-account balance) password)) 
  
 (define acc-denis ( make-passworded-acc 1000 'denis-secret)) 
  
 ((acc-denis 'denis-secret 'withdraw) 20) 
 ((acc-denis 'denis-secret 'withdraw) 20) 
  
 (define (make-joint main-acc main-password joint-password) 
   (if (main-acc main-password)  
       (make-passworded (lambda (x) (main-acc main-password x)) joint-password) 
       (display "incorrect password for main account "))) 
  
 (define acc-aisha (make-joint acc-denis 'denis-secret 'aisha-secret)) 
  
 ((acc-aisha 'aisha-secret 'deposit) 500) 
  
 (define acc-victoria (make-joint acc-aisha 'aisha-secret 'victoria-secret)) 
  
 ((acc-victoria 'victoria-secret 'deposit) 400) 
  
 (define acc-oxana (make-joint acc-denis 'oxana-secret 'oxana-secret))

Last modified : 2022-11-22 19:16:36
WiLiKi 0.5-tekili-7 running on Gauche 0.9