prog/gnu/guile/web/index.scm

(add-to-load-path (dirname (current-filename)))

(use-modules
 (web server)
 (web request)
 (web response)
 (web uri)
 (decode)
 (oop goops)
 (submit)
 (sxml simple)
 (srfi srfi-9) ;;records
 ;; (srfi srfi-19)
 )

;; I might be able to use curl to email

;; https://stackoverflow.com/questions/14722556/using-curl-to-send-email
;; https://blog.edmdesigner.com/send-email-from-linux-command-line/
;; guile also has some curl bindings...

;; joshua@dobby ~$ curl --url 'smtps://smtp.dismail.de:465' -F subject='test email' --ssl-reqd --mail-from 'jbranso@dismail.de' --mail-rcpt 'jbranso@dismail.de'  --user 'jbranso@dimail.de:sticky4RunWhy;' --insecure
;; curl: (67) Login denied
;; joshua@dobby ~$


;;  I'll need to do server side validation of email
;;https://www.regular-expressions.info/email.html
;;http://synthcode.com/scheme/irregex

;;before I implement a captcha here are 10 things to check for
;;
;; 1) validate everything server side.  If input has any HTML, do not accept it.
;; 2) Check for links.  Any input should not have links.
;; 3) check for the right number of POST and GET fields.  If there are extra, it's probably a hacking attempt.
;; 4) Check the HTTP header
;; spam bots do not normally set a user agent (HTTP_USER_AGENT) or a referring page (HTTP_REFERER). You should certainly ensure the referrer is the page where your form is located.
;; 5) Use a honeypot field.   Have an input field that should be left blank!  Set it to display none.  A spammer will try
;; to fill it out.
;; 6) 90% of computer users use javascript.  Use js to checksum the data.  The server can then verify that checksum.
;; 7) Show a verification page.  Bots have a tough time verifying data.  Show the user data once more, and have them verify. and re-submit.
;; 8) Time the user response!  Put in the form the time that it was generated.  Use the user IP address as the encryption key.  If the user took 5-10 minutes to complete, then it is probably a human.  Otherwise it is probably a bot.
;; 9) Log everything.  This should help me spot hacking attempts.
;; 10) You could put a captcha in, if a user fails one of the above. You do not always have to show the captcha!

(define navbar
  '(nav (@ (class "navbar navbar-expand-lg navbar-light bg-light"))
        (a (@ (class "navbar-brand")) "My IFT")
        (button (@ (class "navbar-toggler")
                   (type "button")
                   (data-toggle "collapse")
                   (data-target "#navbarSupportedContent")
                   (aria-controls "navbarSupportedContent")
                   (aria-expanded "false")
                   (aria-label "Toggle navigation"))
                (span (@ (class "navbar-toggler-icon"))))
        (div (@ (class "collapse navbar-collapse")
                (id "navbarSupportedcontent"))
             (ul (@ (class ("navbar-nav mr-auto")))
                 ;; (li (@ (class "nav-item"))
                 ;;     (a (@ (class "nav-link")
                 ;;           (href "About"))
                 ;;        "About"))
                 ;; (li (@ (class "nav-item active"))
                 ;;     (a (@ (class "nav-link")
                 ;;           (href "apply"))
                 ;;        "Apply"))
                 ))))


(define (templatize title body)
  `(html (head (title ,title)
               (head
                (link
                 (@ (rel "stylesheet")
                    (href "https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css")
                    ;;(href "localhost:8081/css/bootstrap.min.css")
                    )
                 ))
               (body ,navbar ,@body))))

(define (insert-option-values values)
  (if (null? values) '()
      (let ([value (car values)])
        (cons `(options (@ (value ,value))
                        ,value)
              (insert-option-values (cdr values))))))

(define* (my-select id options
                    #:key
                    (required #t))
  `(select (@ (id ,id)
              (name ,id)
              ,(if (eq? required #t)
                   '(required)
                   '(not-required))
              (class "custom-select"))
           (option (@ (value "")
                      (selected ""))
                   "Choose...")
           ,(let loop ([options options])
              (if (null? options)
                  '()
                  (cons `(option (@ (value ,(car options)))
                                 ,(car options))
                        (loop (cdr options)))))))

;; (define-syntax m-basic-form-group
;;   (syntax-rules ()
;;     [(m-basic-form-group the-label id)
;;      '(div (@ (class "form-row"))
;;            (div (@ (class "col-md-8"))
;;                 (label the-label)
;;                 (input (@ (class "form-control")))
;;                 ))]
;;     [(m-basic-form-group the-label id ...)
;;      (begin
;;        '(div (@ (class "col-md-3"))
;;              (label the-label)
;;              (input (@ (class "form-control"))))
;;        (m-basic-form-group the-label id ...))]))

(define* (my-input input-type label id
                   #:optional options
                   #:key
                   (placeholder "")
                   (required #t))
  (let ([input-type input-type])
    (cond [(string= input-type "select")
           (my-select id options #:required required)]
          [(string= input-type "textarea")
           `(textarea (@ (id ,id)
                         (name ,id)
                         (type ,input-type)
                         (class "form-control")
                         ,(if (eq? required #t)
                              '(required)
                              '(not-required))
                         ;; the "" is necessary to make sxml put a
                         ;; closing </textarea>
                         (placeholder ,placeholder)) "")]
          [else (let ([input "input"])
                  (when (string= input-type "textarea")
                    (set! input "textarea"))
                  `(input (@ (id ,id)
                             (name ,id)
                             (type ,input-type)
                             (class "form-control")
                             ,(if (eq? required #t)
                                  '(required)
                                  '(not-required))
                             (placeholder ,placeholder))))])))

;; I can make this better!  (basic-form-group #:options '("red"
;;"green")) is obviously a select.  I could infer that! Also
;;(basic-form-group #:input-type "select") would have the default
;;options "No" and "Yes"
(define* (basic-form-group label id
                           #:key
                           (input-type "text")
                           (placeholder "")
                           (required #t)
                           options
                           (width 8))
  `(div (@ (class ,(string-append "form-group col-md-"
                                  (number->string width))))
        (label ,label)
        ,(my-input input-type label id options #:required required)
        ;;(input (@ (class "form-control") (placeholder ,placeholder)))
        ))

;; not working
;; (define-syntax define-record-type*
;;   (syntax-rules ()
;;     ((define-record-type* type
;;        constructor
;;        constructor?
;;        (fieldname var1) ...)

;;      (define-record-type type
;;        (constructor fieldname ...)
;;        constructor?
;;        (fieldname var1) ...))))

;; this works!!!!
(define-syntax my-define-record-type
  (syntax-rules ()
    ((my-define-record-type type
                            constructor
                            constructor?
                            (fieldname var1) ...)
     (define-record-type type
       (constructor fieldname  ...)
       constructor?
       (fieldname var1) ... ))))

(my-define-record-type <bs-form-group>
                       make-dog
                       dog?
                       (age dog-age))

(define-record-type <bs-form-group>
  (make-bs-form-group type placeholder)
  bs-form-group?
  ;; horizontal or vertical
  (type bs-form-group)
  (placeholder bs-form-group-placeholder))

(define-syntax bs-horizontal-form-group
  (syntax-rules (placeholder)
    ((bs-horizontal-form-group ((var1 var2)
                                (placeholder var3)) ...)
     (horizontal-form-group var1 var2 #:placeholder var3))))

(define* (horizontal-form-group label id
                                #:key
                                (form-class "row")
                                placeholder
                                (input-type "text")
                                (required #t)
                                options
                                )
  `(div (@ (class "form-group row"))
        (label (@ (class "col-md-2")
                  (for ,id))
               ,label)
        (div (@ (class "col-md-6"))
             ,(my-input input-type label id options #:required required)
             (div (@ (class "valid-feedback"))
                  "Looks good!"))))

(define* (respond #:optional body #:key
                  (status 200)
                  (title "My IFT")
                  (doctype "<!DOCTYPE html>\n")
                  (content-type-params '((charset . "utf-8")))
                  (content-type 'text/html)
                  (extra-headers '())
                  (sxml (and body (templatize title body))))
  (values (build-response
           #:code status
           #:headers `((content-type
                        . (,content-type ,@content-type-params))
                       ,@extra-headers))
          (lambda (port)
            (if sxml
                (begin
                  (if doctype (display doctype port))
                  (sxml->xml sxml port))))))

(define (request-path-components request)
  (split-and-decode-uri-path (uri-path (request-uri request))))

;; Paste this in your REPL
(define (not-found request)
  (values (build-response #:code 404)
          (string-append "Resource not found: "
                         (uri->string (request-uri request)))))

(define (test-form)
  (respond
   `((div (@ (class "container"))
          (div (@ (class "row")))
          (div (@ (class "col-md-12"))
               (form (@ (method "post")
                        (action "submit1")
                        (id "test-form"))
                     ,(horizontal-form-group "Your first name" "first-name"
                                             #:placeholder "Jason")
                     ,(horizontal-form-group "Your last name" "last-name"
                                             #:placeholder "Smith")
                     ,(horizontal-form-group "Your email" "email"
                                             #:placeholder "youremail@gmail.com"
                                             #:input-type "email")
                     (input (@ (name "hidden") (hidden)))
                     (div (@ (class "row"))
                          (div (@ (class "col-md-2"))
                               (input (@  (class "btn btn-primary")
                                          (type "submit")
                                          )
                                      "Submit")))
                     ))))))


(define (main-page)
  (respond
   `((div (@ (class "container"))
          (div (@ (class "row"))
               (div (@ (class "col-md-12"))
                    (h1 "Apply for a loan")
                    (form (@ (method "post")
                             (action "submit"))
                          ,(horizontal-form-group "Your first name" "first-name"
                                                  #:placeholder "James")
                          ,(horizontal-form-group "Your last name" "last-name"
                                                  #:placeholder "Jones")
                          ,(horizontal-form-group "Your number" "number"
                                                  ;;TODO
                                                  ;; I want to format this as a number via
                                                  ;;<input type="tel" name="phone" pattern="[0-9]{3}-[0-9]{2}-[0-9]{3}">
                                                  ;; as seen here: https://www.w3schools.com/html/html_form_input_types.asp
                                                  ;;#:input-type "tel"
                                                  #:placeholder "765 293 4930" )
                          ,(horizontal-form-group "Your email" "email"
                                                  #:placeholder "youremail@gmail.com"
                                                  #:input-type "email")
                          ,(horizontal-form-group "Address" "address1"
                                                  #:placeholder "123 Main Street")
                          ,(horizontal-form-group "Address Line 2" "address1"
                                                  #:placeholder "123 Main Street")
                          (div (@ (class "form-row"))
                               ,(basic-form-group "City" "city" #:width 4)
                               ,(basic-form-group "State" "state" #:width 2)
                               ,(basic-form-group "Zip" "zip" #:width 2)
                               )
                          ,(horizontal-form-group "Are you a U.S. Citizen?" "state"
                                                  #:input-type "select"
                                                  #:options '("No" "Yes"))
                          ,(basic-form-group "Co-Borrower's (If applicable)" "co-borrowers"
                                             #:required #f)
                          ,(basic-form-group "Borrower's Fico Score? (Please list all borrowers scores)"
                                        ;#:placeholder "700, 750, 800"
                                             "fico")

                          ,(basic-form-group "Company name the borrower is closing in? (must close in a corporate entity)"
                                             "company")
                          ;;This is my honeypot input.  If a user puts data in this, then they are probably not a user.
                          (input (@ (name "hidden") (hidden)))

                          ,(basic-form-group "Who makes up the entity and what are their percentages of ownership?"
                                             "percentages" #:input-type "textarea")
                          (div (@ (class "form-row"))
                               ,(basic-form-group "Do you own any other investment properties?"
                                                  "own"
                                                  #:width 6)

                               ,(basic-form-group "If yes, how many?"
                                                  "own-number"
                                                  #:width 2
                                                  #:required #f))

                          ,(basic-form-group
                            "Does the borrower have any Tax liens, judgments, past bankruptcies, past chapter filings, past foreclosures, recent or pending lawsuits against them?"
                            "past-problems"
                            #:input-type "select"
                            #:options '("No" "Yes"))
                          ,(basic-form-group "If YES, please explain and list date(s)"
                                             "past-problems-reasons"
                                             #:input-type "textarea" #:required #f)
                          ,(basic-form-group "Do you rent or own?" "rent-or-own"
                                             #:input-type "select" #:options '("Own" "Rent"))
                          ,(basic-form-group "Have you ever had any late rent payments/mortgage?"
                                             "late-payments"
                                             #:input-type "select" #:options '("No" "Yes"))
                          ,(basic-form-group "If yes when?" "late-payments-reasons" #:required #f)
                          ,(basic-form-group "Are you already working with another broker or lender?"
                                             "other-lender"
                                             #:input-type "select" #:options '("No" "Yes"))
                          ,(basic-form-group "If yes, who?" "other-lender-name" #:required #f)
                          ,(basic-form-group "Are you currently working with an 11 Capital Finance IAP?"
                                             "11-capital-lender"
                                             #:input-type "select" #:options '("Yes" "No"))
                          ,(basic-form-group "If yes, who?" "11-capital-lender-name" #:required #f)
                          ,(basic-form-group "Are you or any member of the borrowing entity related by blood or marriage?"
                                             "related-borrowers"
                                             #:input-type "select" #:options '("No" "Yes"))
                          ,(basic-form-group "What rates and terms are you expecting?"
                                             "rates-and-terms"
                                             #:input-type "textarea")

                          ;; this is the second page

                          ,(horizontal-form-group "Property Address" "address1"
                                                  #:placeholder "123 Main Street")
                          ,(horizontal-form-group "Property Address Line 2" "address1"
                                                  #:placeholder "123 Main Street")
                          ,(basic-form-group
                            "Exact property type? eg: SFR, 2unit, 7unit: (If commercial property please be very specific."
                            "exact-property-type")
                          ,(basic-form-group "What is the property square footage?: (If applicable)"
                                             "footage"
                                             #:required #f)
                          ,(basic-form-group "Loan type" "loan-type"
                                             #:input-type "select"
                                             #:options '("Permanent Finance"
                                                         "Bridge Loan"
                                                         "Rehab Loan"
                                                         "Ground up Construction"))
                          ;; this is the third page
                          ,(basic-form-group "Purchase price" "purchase-price")
                          ,(basic-form-group "Current fair market value of the property" "fair-market-value")
                          ,(basic-form-group "Are you already in a purchase and sales contract" "purchase-or-sales-contract")
                          ,(basic-form-group (string-append "How much money do you have to contribute towards "
                                                            "the transaction? (Most commercial purchases require 30% down."
                                                            "Borrower also needs to cover closing costs.")
                                             "money")
                          ,(basic-form-group "Total cash on hand?" "cash-on-hand")
                          ,(basic-form-group "What is the loan amount requested? In USD?" "loan-money")
                          ,(basic-form-group "When does the borrower need to close?" "closing date")
                          ,(basic-form-group "Is the property owner occupied or a pure investment property?"
                                             "occupied-pure-investment-property"
                                             #:input-type "select" #:options '("Owner Occupied" "Pure Investment"))
                          ,(basic-form-group "What is the monthly rental income on the property?"
                                             "monthly-rent")
                          ,(basic-form-group "What is the occupancy percentage of the property? (%)"
                                             "occupancy-percentage" #:placeholder "100%")
                          ,(basic-form-group "What are the monthly taxes on the property? In USD?"
                                             "monthly-taxes")
                          ,(basic-form-group "What is the insurance on the property?"
                                             "property-insurance")
                          ,(basic-form-group "If the property type is a condo, is this a warrantable or non-warrantable condo?"
                                             "warrantable-or-not"
                                             #:required #f
                                             #:input-type "select" #:options '("Warrantable" "Non-Warrantable"))
                          ,(basic-form-group "If yes, what are the dues?" "dues"
                                             #:required #f)
                          ,(basic-form-group "If yes, how are the dues paid? eg: monthly, quartly, yearly"
                                             "how-paid" #:required #f)
                          ,(basic-form-group "What is specific about your deal?" "specific" #:input-type "textarea")

                          (div (@ (class "row"))
                               (div (@ (class "col-md-2"))
                                    (input (@ (class "btn btn-primary")
                                              (type "submit")))))
                          )
                    ))))))


(define (run-page request body)
  ;;(display (request-path-components request))
  (let ([current-page (request-path-components request)])
    (cond [(equal? current-page '())
           (main-page)
           ;;(respond '((h1 "Are you ready to kick start your loan?")))
           ]
          [(equal? current-page '("hacker"))
           (respond '((h1 "Hello Hacker!")))]
          [(equal? current-page '("submit"))
           (respond (submit-response body))
           ;;(respond '((h1 "Thank you for submitting your request!  We will reach out to you soon!")))
           ;; (if (eq? (verify-request (request)) #t)
           ;;     (main-page))
           ]
          [(equal? current-page '("test-form"))
           (test-form)]
          [(equal? current-page '("submit1"))
           (if (verify-body body)
               (respond '((h1 "Your entered correct data")))
               (respond '((h1 "You did not enter correct data."))))]
          [(equal? current-page '("css" "bootstrap.min.css"))
           (values `((content-type . (text/css))
                     (cache-control . (public))
                     ;;(parse-header 'date ,(current-date))
                     )
                   (let ([port (open-file "css/bootstrap.min.css" "r")])
                     (define css-file (get-string-all port))
                     (close-port port)
                     css-file))]
          [(equal? current-page '("apply")
                   (main-page)
                   )]
          [(equal? current-page '("hello"))
           (values `((content-type . (text/plain))
                     )
                   "Hello hacker!")]
          [else
           (respond `((h1 "Page not found.")
                      (h1 ,(let loop ([current-page current-page])
                             (if (null? current-page) ""
                                 (string-append (car current-page) "/"
                                                (loop (cdr current-page))))))))])))


(run-server run-page 'http '(#:port 8081) ; '(#:host="localhost")
            )