#lang racket/base

; Notepad application
(require
  "templates.rkt"
  "../webcontainer/weblets.rkt"
  "../webcontainer/weblet-parameter.rkt"
  "../notepad/notepad.rkt"
  "../notepad/user.rkt"
  "../notepad/notes.rkt"
  "../notepad/media.rkt"
  "../../configuration.rkt"
  web-server/http/redirect
  web-server/http/request-structs
  net/cookies/server
  net/uri-codec
  ; Formatting pages
  (prefix-in scrib: scribble/reader)
  )

(provide
  pages:notepad:page-list
  pages:notepad:page-show
  pages:notepad:page-edit
  pages:notepad:page-delete
  pages:notepad:preview
  pages:notepad:media-list
  pages:notepad:media-show
  pages:notepad:media-new
  pages:notepad:media-edit
  pages:notepad:media-delete
  pages:notepad:user-list
  pages:notepad:user-show
  pages:notepad:user-login
  pages:notepad:user-logout
  pages:notepad:user-edit
  )

; Notepad
(define notepad (make-notepad configuration:notepad:path))

; Secured : either protocol is https or dev mode is active
(define (check-secured? param)
  (or configuration:notepad:dev?
      (eq? 'https (weblet-parameter-protocol param))))

; Cookie management
; Cookie key
(define *cookie-key* "notepad")
; User from weblet parameter
(define (get-user param)
  (define cookie (weblet-parameter-cookie-ref param *cookie-key*))
  ; Precondition: check-secured? must be #t
  (and (check-secured? param)
       cookie (get-user-by-usercookie-value (string->bytes/utf-8 cookie))))

; Error pages
; Type to code + title + message
(define *error-types*
  (make-immutable-hash
    '((not-found . (404 "Not found" "Sorry, there is nothing here."))
      (unauthorized . (401 "Unauthorized" "Sorry, you can't go there."))
      (method-not-allowed . (405 "Not allowed" "Sorry, this method is not allowed."))
      )))
; As page
(define (pages:notepad:error param error-type)
  (define err (hash-ref *error-types* error-type))
  ((pages:template
     #:error-code (car err)
     #:author (number->string (car err))
     #:title (cadr err)
     #:content `(article ,(caddr err))
     )
   param))
; As result for pages:adaptable-template
(define (notepad:error error-type)
  (define err (hash-ref *error-types* error-type))
  (make-immutable-hash
    `((error-code . ,(car err))
      (author . ,(number->string (car err)))
      (title . ,(cadr err))
      (content . (article ,(caddr err)))
      )))

; Concat a lock to the name if not public
(define (displayed-name name public?)
  (string-append
    (if public? "" "🔒︎ ")
    name))

; Notepad pages

; Link to a note with a given name
(define (note-link type name . args)
  (string-append
    (case type
      ((show) "/notes/show/")
      ((edit) "/notes/edit/")
      ((delete) "/notes/delete/")
      (else ""))
    (uri-encode name)
    (apply string-append args)))

; /notes/list
; Lists all the pages of the notepad.
(define pages:notepad:page-list
  (pages:template
    #:title "Pages du bloc-note."
    #:author "feuforeve.fr"
    #:content
    (lambda (param)
      (define connected-usr (get-user param))
      (define notes (if connected-usr (get-all-notes) (get-public-notes)))
      `(article
        ,@(if (null? notes)
              '("Pas de note.")
              (map
                (lambda (n)
                `(div (a ((href ,(note-link 'show (note-name n))))
                         ,(displayed-name (note-title n) (note-public? n)))))
                notes))
        ,@(if connected-usr
              '((hr)
                (a ((href "/notes/edit")) "Ajouter une note"))
              '(""))
        ))
    ))

; /notes/show/xxx
; Show a given page of the notepad. A page is stored under a scribble-like format.
; If the page does not exists and user is logged in, redirect to the /notes/edit/xxx page.
(define (pages:notepad:page-show param)
  (define connected-usr (get-user param))
  (define page (weblet-parameter-ref param 'page #f))
  (define note (get-note-by-name page))
  (cond
    ( (and note (or (note-public? note) connected-usr))
      ( (pages:template
          #:title (displayed-name (note-title note) (note-public? note))
          #:author (note-author note)
          #:date (note-date note)
          #:content
            `(article
              ,@(format-note-content (note-content note))
              ,@(if connected-usr
                `((hr)
                  (a ((href ,(note-link 'edit page))) "Éditer") " — "
                  (a ((href ,(note-link 'delete page))) "Supprimer"))
                '())
              ))
       param))
    ( note
      ; Note exists, but is private and user cannot edit it => not authorized
      (pages:notepad:error param 'unauthorized))
    ( connected-usr
      ; Page does not exists, but user can edit => redirect to page creation
      (redirect-to
        (note-link 'edit page)
        see-other))
    ( #t
      (pages:notepad:error param 'not-found))))

; /notes/edit/xxx
; Edit an existing page, or create a new page with a given title. User must be logged in.
; Get => Form to edit page
; Post => Save page
(define (pages:notepad:page-edit param)
  (define connected-usr (get-user param))
  (define method (weblet-parameter-method param))
  (define page (weblet-parameter-ref param 'page #f))
  (define note (get-note-by-name page))
  (define err? (equal? "t" (weblet-parameter-ref param 'error #f)))
  (cond
    ( (and connected-usr (eq? method 'get))
      ; User connected, get method : read the page
      (define title (or (and note (note-title note)) ""))
      (define content (or (and note (note-content note)) ""))
      (define page-name (or page "SansNom"))
      (define public? (and note (note-public? note)))
      ( (pages:template
          #:title (string-append "Édition de la note '" page-name "'")
          #:author (user-name connected-usr)
          #:scripts '("/scripts/notepad.js")
          #:content
            ; Display the page as a form
            `(article
                ,(if err?
                    '(p "Erreur: le nom de la page ne peut être vide.")
                    "")
                (form ((action ,(note-link 'edit page-name))
                       (method "post"))
                  (label ((for "pagename")) "Nom (URL)") " "
                  (input ((id "pagename")(name "pagename")(type "text")(value ,page-name))) (br)
                  (label ((for "pagetitle")) "Titre") " "
                  (input ((id "pagetitle")(name "pagetitle")(type "text")(value ,title))) (br)
                  (label ((for "pagepublic")) "Publique")
                  (input ((id "pagepublic")(name "pagepublic")(type "checkbox")(value "on")
                          ,@(if public? '((checked "true")) '()))) (br)
                  (textarea ((rows "10")(cols "80")(id "pagecontent")(name "pagecontent"))
                    ,content) (br)
                  (input ((type "submit")
                          (value "Sauver et quitter l'édition")))
                  (input ((type "submit")(formaction ,(note-link 'edit page-name "?continue=t"))
                          (value "Sauver et continuer l'édition")))
                  (input ((type "button")(onclick ,(string-append "window.location.href='" (note-link 'show page-name) "';"))
                          (value "Annuler les modifications")))
                )
                (hr)
                (section
                   (h2 "Aperçu")
                   (button ((onclick "notepadPreview();")) "Afficher l'aperçu")
                   (button ((onclick "notepadClearPreview();")) "Effacer l'aperçu")
                   (hr)
                   (div ((id "preview")) ))
                (hr)
                (section
                  (h2 "Syntaxe")
                  "Le bloc-note utilise une syntaxe proche de celle de " (a ((href "https://docs.racket-lang.org/scribble/index.html")) "Scribble") ". " (br)
                  "Pour introduire un passage à la ligne, il faut sauter une ligne. " (br)
                  ,@(map
                      (lambda (x)
                        `(div (code "@" ,(car x) ,(if (cadr x) (string-append "[" (cadr x) "]") "")
                                    "{" ,(caddr x) "}") " " ,@(cadddr x)))
                      '(("link" "to" "desc" ("Un lien vers l'addresse " (code "to") " intitulé " (code "desc") "."))
                        ("image" "path" "alt" ("Une image située à l'addresse " (code "path") " avec le texte alternatif " (code "alt") "."))
                        ("page" "to" "desc" ("Un lien vers la page du bloc-note nommée " (code "to") " intitulé " (code "desc") "."))
                        ("media" "path" "alt" ("Média du bloc-note nommé " (code "path") " avec le texte alternatif " (code "alt") "."))
                        ("strong" #f "text" ("Affiche le texte " (code "text") " en gras."))
                        ("str" #f "text" ("Synonyme de " (code "strong") "."))
                        ("emphase" #f "text" ("Affiche le texte " (code "text") " en italique."))
                        ("emp" #f "text" ("Synonyme de " (code "emphase") "."))
                        ("section" #f "title" ("Démarre une nouvelle section de niveau 1 intitulée " (code "title") "."))
                        ("subsection" #f "title" ("Démarre une nouvelle section de niveau 2 intitulée " (code "title") "."))
                        ("subsubsection" #f "title" ("Démarre une nouvelle section de niveau 3 intitulée " (code "title") "."))
                        ("paragraph" "justify" "text" ("Démarre un paragraphe contenant " (code "text") " avec la justification " (code "justify")
                                                       " (optionnelle, valeurs possibles: " (code "left") ", " (code "right") " ou " (code "center") "). "))
                        ("para" #f "text" ("Synonyme de " (code "paragraph") "."))
                        ("list" "ord" "items" ("Demarre une liste. Le paramètre " (code "ord") " est optionnel et peut prendre les valeurs "
                                               (code "ordered") " pour une liste ordonnée et " (code "unordered") " pour une liste non-ordonnées (valeur par défaut)."))
                        ("item" #f "text" ("Un élément d'une liste contenant le texte " (code "text") "."))
                        ))
                  )
                ))
        param))
    ( (and page connected-usr (eq? method 'post))
      (define continue? (equal? "t" (weblet-parameter-ref param 'continue #f)))
      (define page-name (weblet-parameter-ref param 'pagename #f))
      (define new-note-title (weblet-parameter-ref param 'pagetitle #f))
      (define new-note-content (weblet-parameter-ref param 'pagecontent #f))
      (define new-note-name (or (and (not (equal? "" page-name)) page-name)
                                page))
      (define new-note-public? (equal? "on" (weblet-parameter-ref param 'pagepublic #f)))
      ; Check validity
      (cond
        ( (and new-note-name (not (equal? new-note-name "")))
          ; Save page
          (update-note note
            #:name new-note-name
            #:title new-note-title
            #:content new-note-content
            #:author connected-usr
            #:public? new-note-public?)
          ; Redirect
          (redirect-to
            (note-link (if continue? 'edit 'show) new-note-name)
            see-other))
        ( #t
          ; Error: redirect to edit
          (redirect-to
            (note-link 'edit page "?error=t")
            see-other))))
    ( page
      ; Edition is not allowed
      (pages:notepad:error param 'unauthorized))
    ( #t
      ; No such page
      (pages:notepad:error param 'not-found))))

; /notes/delete/xxx
; Remove an existing page. User must be logged in.
; Get => ask confirmation
; Post => remove
(define (pages:notepad:page-delete param)
  (define connected-usr (get-user param))
  (define method (weblet-parameter-method param))
  (define page (weblet-parameter-ref param 'page #f))
  (define note (get-note-by-name page))
  (cond
    ( (and note connected-usr (eq? method 'get))
      ; Method get => ask for confirmation
      ( (pages:template
          #:title (string-append "Suppression de la page " page)
          #:author (user-name connected-usr)
          #:content
            `(article
                (form ((action ,(note-link 'delete page))
                       (method "post"))
                  (h3 "Supprimer la page " ,page " ? ")
                  "Cette action est irréversible." (br)
                  (input ((type "submit")
                          (value "Oui, supprimer la page")))
                  (input ((type "submit")(formaction ,(note-link 'show page))
                          (formmethod "get")(value "Non, garder la page")))
                )))
        param))
    ( (and note connected-usr (eq? method 'post))
      ; Method post => remove
      (remove-note note)
      ; Redirect
      (redirect-to
        "/notes/list"
        see-other))
    ( note
      ; Unauthorized
      (pages:notepad:error param 'unauthorized))
    ( #t
      ; No such page
      (pages:notepad:error param 'not-found))))

; /notes/preview
; Format and return the content
; Used on the edition page to preview the content before saving it.
(define pages:notepad:preview
  (html-page-weblet
    #:error-code 200
    #:body
      (lambda (param)
        (define connected-usr (get-user param))
        (define content (weblet-parameter-ref param 'pagecontent #f))
        (if (and connected-usr content)
          `(article
            ,@(format-note-content content))
          ""))))

; Format a note content
(define (format-note-content cnt)
  ; Recursive parsing function
  (define (collect parsed)
    ; Recursively apply the parsing:
    ; - filter out #f values
    ; - Two successive "\n" (i.e a blank line) are replaced by a '(br)
    (define (recur lst)
      (filter
        values
        (map
          (lambda (x) (collect x))
          (reverse
            (foldl
              (lambda (val res)
                (if (and (not (null? res))
                          (equal? "\n" val)
                          (equal? "\n" (car res)))
                    (cons '(br) res)
                    (cons val res)))
              '()
              lst)))))
    ; Parse and transform the content
    (cond
      ; Not a list => output as is
      ((not (list? parsed)) parsed)
      (#t
        (case (car parsed)
          ; @link[path]{Text} : link to another (external) page
          ( (link)
            `(a ((href ,(symbol->string (cadr parsed))))
                ,@(recur (cddr parsed))))
          ; @image[path]{Alt text} : (external) image
          ( (image)
            (define alt (apply string-append (cddr parsed)))
            `(img ((src ,(symbol->string (cadr parsed)))
                   (alt ,alt)
                   (title ,alt))))
          ; @page[name]{Text} : link to another (internal) page : name is the name of the page (not the title)
          ( (page)
            (define pagename (symbol->string (cadr parsed)))
            `(a ((href ,(string-append "/notes/show/" pagename)))
                ,@(recur (cddr parsed))))
          ; @media[name]{Text} : (internal) media - displayed accordingly to its type
          ( (media)
            (define name (symbol->string (cadr parsed)))
            (define media (get-media-by-name name))
            (define file (and media (media-file media)))
            (define alt (apply string-append (cddr parsed)))
            (cond
              ( (and media (equal? "image" (media-type media)))
                ; Image
                `(img ((src ,(string-append "/media/get/" file))
                       (alt ,alt)
                       (title ,alt))))
              ( (and media (equal? "other" (media-type media)))
                ; Other : displayed as link
                `(a ((href ,(string-append "/media/get/" file)))
                     ,@(recur (cddr parsed))))
              (#t
                ; Ignored
                "")))
          ; @strong{Text} : strong
          ; @str{Text} : strong
          ((strong str)
            `(strong ,@(recur (cdr parsed))))
          ; @emphase{Text} : emphase
          ; @emp{Text} : emphase
          ((emphase emp)
            `(em ,@(recur (cdr parsed))))
          ; @section{Text} : title and start of section
          ((section)
            `(h2 ,@(recur (cdr parsed))))
          ; @subsection{Text} : title and start of subsection
          ((subsection)
            `(h3 ,@(recur (cdr parsed))))
          ; @subsubsection{Text} : title and start of subsubsection
          ((subsubsection)
            `(h4 ,@(recur (cdr parsed))))
          ; @paragraph[justify]{Text} : paragraph with an optional justification
          ; @para[justify]{Text} : paragraph with an optional justification
          ((paragraph para)
            (if (not (null? (cdr parsed)))
                (case (cadr parsed)
                  ((left) `(p ((style "text-align: left;")) ,@(recur (cddr parsed))))
                  ((right) `(p ((style "text-align: right;")) ,@(recur (cddr parsed))))
                  ((center centered) `(p ((style "text-align: center;")) ,@(recur (cddr parsed))))
                  (else `(p ,@(recur (cdr parsed)))))
                #f))
          ; @list[ordered|unordered]{Text} : List of items. Unordered by default.
          ((list)
            (if (not (null? (cdr parsed)))
                (case (cadr parsed)
                  ((ordered) `(ol ,@(recur (cddr parsed))))
                  ((unordered) `(ul ,@(recur (cddr parsed))))
                  (else `(ul ,@(recur (cdr parsed)))))
                #f))
          ; @item{Text} : item of list
          ((item)
            `(li ,@(recur (cdr parsed))))
          ; Other kind of lists: recurse on them
          (else
            (recur parsed))
          ))))
  ;
  (collect
    (with-handlers
      (( exn:fail?
         (lambda (e) (list (exn-message e))) ))
      (scrib:read-inside
        (open-input-string
          cnt)))))


; Media

; Link to a media with a given name
(define (media-link type name . args)
  (string-append
    (case type
      ((get) "/media/get/")
      ((show) "/media/show/")
      ((edit) "/media/edit/")
      ((delete) "/media/delete/")
      (else ""))
    (uri-encode name)
    (apply string-append args)))

; /media/list
; Lists all medias of the notepad.
(define pages:notepad:media-list
  (pages:template
    #:title "Fichiers du bloc-note."
    #:author "feuforeve.fr"
    #:content
    (lambda (param)
      (define connected-usr (get-user param))
      (define files (if connected-usr (get-all-medias) (get-public-medias)))
      `(article
        ,@(if (null? files)
              '("Pas de fichier.")
              (map
                (lambda (n)
                `(div (a ((href ,(media-link 'show (media-file n))))
                         ,(displayed-name (media-name n) (media-public? n)))))
                files))
        ,@(if connected-usr
              '((hr)
                (a ((href "/media/new")) "Ajouter un fichier"))
              '(""))
        ))
    ))

; /media/show/xxx
; Show a given media of the notepad.
(define (pages:notepad:media-show param)
  (define connected-usr (get-user param))
  (define file (weblet-parameter-ref param 'media #f))
  (define direct-link (media-link 'get file))
  (define media (get-media-by-file file))
  (cond
    ( (and media (or (media-public? media) connected-usr))
      ( (pages:template
          #:title (displayed-name (media-name media) (media-public? media))
          #:author (media-author media)
          #:date (media-date media)
          #:content
            `(article
              ,@(case (media-type media)
                  ( ("image")
                    `((a ((href ,direct-link)) (img ((src ,direct-link)(class "image-preview"))))(br)))
                  ( else
                    '()))
              (a ((href ,direct-link)) "Lien vers le fichier")
              ,@(if connected-usr
                `((hr)
                  (a ((href ,(media-link 'edit file))) "Éditer") " — "
                  (a ((href ,(media-link 'delete file))) "Supprimer"))
                '())
              ))
       param))
    ( media
      ; Media exists, but is private => not authorized
      (pages:notepad:error param 'unauthorized))
    ( #t
      (pages:notepad:error param 'not-found))))

; /media/get/xxx
; Get a given media of the notepad. Direct link.
; Managed at the webcontainer level.

; /media/new
; Add a media. User must be logged in.
; Get => Form to add a media
; Post => Process the upload, and show the media
(define (pages:notepad:media-new param)
  (define connected-usr (get-user param))
  (define method (weblet-parameter-method param))
  (define failed? (equal? "t" (weblet-parameter-ref param 'error #f)))
  (cond
    ( (and connected-usr (eq? method 'get))
      ; User connected, get method : new media form
      ( (pages:template
          #:title "Ajouter un fichier"
          #:author (user-name connected-usr)
          #:content
            ; Display the page as a form
            `(article
                ,@(if failed?
                    '("Erreur lors de l'ajout du fichier." (br))
                    '())
                (form ((action "/media/new")
                       (method "post")
                       (enctype "multipart/form-data"))
                (label ((for "filepath")) "Fichier à ajouter") (br)
                (input ((id "filepath")(name "filepath")(type "file"))) (br)
                (label ((for "filename")) "Nom du fichier") (br)
                (input ((id "filename")(name "filename")(type "text"))) (br)
                (label ((for "filepublic")) "Public")
                (input ((id "filepublic")(name "filepublic")(type "checkbox")(value "on"))) (br)
                (input ((type "submit")
                        (value "Ajouter le fichier")))
                )))
        param))
    ( (and connected-usr (eq? method 'post))
      (define filepath (weblet-parameter-ref param 'filepath #f))
      (define in (and filepath (weblet-parameter-file-port-ref param 'filepath)))
      (define filename (weblet-parameter-ref param 'filename #f))
      (define filepublic (equal? "on" (weblet-parameter-ref param 'filepublic #f)))
      ; Save file
      (cond
        ( (and filepath in filename)
          (notepad-new-media notepad
            #:path filepath
            #:input-stream in
            #:name filename
            #:author connected-usr
            #:public? filepublic)
          ; Redirect
          (redirect-to
            (media-link 'show filepath)
            see-other))
        ( #t
          ; Redirect: upload failed
          (redirect-to
            "/media/new?error=t"
            see-other))))
    ( #t
      ; Not allowed
      (pages:notepad:error param 'unauthorized))))

; /media/edit/xxx
; Edit a media (move it). User must be logged in.
; Get => Form to edit a media
; Post => Process the upload, and show the media
(define (pages:notepad:media-edit param)
  (define connected-usr (get-user param))
  (define method (weblet-parameter-method param))
  (define file (weblet-parameter-ref param 'media #f))
  (define media (get-media-by-file file))
  (define failed? (equal? "t" (weblet-parameter-ref param 'error #f)))
  (cond
    ( (and media connected-usr (eq? method 'get))
      ; User connected, get method : edit media form
      ( (pages:template
          #:title "Éditer un fichier"
          #:author (user-name connected-usr)
          #:content
            ; Display the page as a form
            `(article
                ,@(if failed?
                    '("Erreur lors du renommage du fichier. Le chemin doit être valide." (br))
                    '())
                (form
                  ((action ,(media-link 'edit file))(method "post"))
                  (label ((for "filepath")) "Chemin du fichier") " "
                  (input ((id "filepath")(name "filepath")(type "text")(value ,file))) (br)
                  (label ((for "filename")) "Nom du fichier") " "
                  (input ((id "filename")(name "filename")(type "text")(value ,(media-name media)))) (br)
                  (label ((for "filepublic")) "Public")
                  (input ((id "filepublic")(name "filepublic")(type "checkbox")(value "on")
                          ,@(if (media-public? media) '((checked "true")) '()))) (br)
                  (input ((type "submit")
                          (value "Mettre à jour le fichier")))
                )))
        param))
    ( (and media connected-usr (eq? method 'post))
      (define filepath (weblet-parameter-ref param 'filepath #f))
      (define filename (weblet-parameter-ref param 'filename #f))
      (define filepublic (equal? "on" (weblet-parameter-ref param 'filepublic #f)))
      ; Move file
      (define ok?
        (notepad-update-media notepad media
          #:path filepath
          #:name filename
          #:author connected-usr
          #:public? filepublic))
      (if ok?
        ; Redirect to show
        (redirect-to
          (media-link 'show filepath)
          see-other)
        ; Redirect: operation failed
        (redirect-to
          (media-link 'edit file "?error=t")
          see-other)))
    ( media
      ; Not allowed
      (pages:notepad:error param 'unauthorized))
    ( #t
      ; Not found
      (pages:notepad:error param 'not-found))))

; /media/delete/xxx
; Remove an existing media. User must be logged in.
; Get => ask confirmation
; Post => remove
(define (pages:notepad:media-delete param)
  (define connected-usr (get-user param))
  (define method (weblet-parameter-method param))
  (define file (weblet-parameter-ref param 'media #f))
  (define media (get-media-by-file file))
  (cond
    ( (and media connected-usr (eq? method 'get))
      ; Method get => ask for confirmation
      ( (pages:template
          #:title (string-append "Suppression de " (media-name media))
          #:author (user-name connected-usr)
          #:content
            `(article
              (form ((action ,(media-link 'delete file))
                     (method "post"))
                (h3 "Supprimer " ,(media-name media) " ? ")
                "Cette action est irréversible." (br)
                (input ((type "submit")
                        (value "Oui, supprimer le fichier")))
                (input ((type "submit")(formaction ,(media-link 'show file))
                        (formmethod "get")(value "Non, garder le fichier")))
              )))
        param))
    ( (and media connected-usr (eq? method 'post))
      ; Method post => remove
      (notepad-delete-media notepad media)
      (redirect-to
        "/media/list"
        see-other))
    ( media
      ; Unauthorized
      (pages:notepad:error param 'unauthorized))
    ( #t
      ; No such page
      (pages:notepad:error param 'not-found))))

; User
; Link to a user with a given name
(define (user-link type name . args)
  (string-append
    (case type
      ((show) "/user/show/")
      ((edit) "/user/edit/")
      ((login) "/user/login/")
      (else ""))
    (uri-encode name)
    (apply string-append args)))

; /user/list
; Lists all the users of the notepad.
(define pages:notepad:user-list
  (pages:template
    #:title "Utilisateurs du bloc-note."
    #:author "feuforeve.fr"
    #:content
    (lambda (param)
        (define users (get-all-users))
        (if (null? users)
            '(article "Pas d'utilisateurs.")
            `(article
               ,@(map
                   (lambda (u)
                    `(div (a ((href ,(user-link 'show (user-name u)))) ,(user-pseudo u))))
                   users))))
    ))

; /user/show/xxx
; Show the page of user xxx.
(define pages:notepad:user-show
  (pages:adaptable-template
    (lambda (param)
      (define usr (get-user-by-name (weblet-parameter-ref param 'name #f)))
      (define connected-usr (get-user param))
      (define edition-possible? (same-user? usr connected-usr))
      (cond
        (usr
          (make-immutable-hash
            `((author . ,(user-name usr))
              (title . ,(string-append "À propos de " (user-pseudo usr)))
              (content . (article
                          ,(cond
                            ( edition-possible?
                              `(form ((action ,(user-link 'edit (user-name usr)))
                                      (method "post"))
                                (label ((for "pseudo")) "Pseudo") " "
                                (input ((name "pseudo")(id "pseudo")(type "text")(value ,(user-pseudo usr)))) (br)
                                (label ((for "about")) "Présentation") (br)
                                (textarea ((rows "5")(cols "40")(id "about")(name "about"))
                                  ,(user-about usr)) (br)
                                (input ((type "submit")(value "Mettre à jour")))
                                ))
                            (#t
                              (user-about usr)
                              ))
                          (hr)
                          ,(cond
                            ( (and (check-secured? param) (not connected-usr))
                              `(p (a ((href ,(user-link 'login (user-name usr))))
                                  "Se connecter en tant que " ,(user-pseudo usr))))
                            ( edition-possible?
                              `(p (a ((href ,(string-append "/user/logout")))
                                  "Se déconnecter")))
                            ( #t
                              ""))
                          )))))
        (#t
          (notepad:error 'not-found))))))

; /user/login/xxx
; Login page for user xxx.
; Method GET -> show the page, with a form if user is not logged in. Show an error and a link to the logout page if user is already logged in.
; Method POST -> redirect to the page in case of failure, redirect to user-show in case of success
(define (pages:notepad:user-login param)
  ; Because of the behaviour, we cannot directly use a template
  (define usr (get-user param))
  (define method (weblet-parameter-method param))
  (define secured? (check-secured? param))
  (cond
    ( (and secured? usr (eq? method 'get))
      (pages:notepad:user-login:already-connected usr param))
    ( (and secured? (eq? method 'get))
      (pages:notepad:user-login:login-form param))
    ( (and secured? (eq? method 'post))
      (pages:notepad:user-login:sent-form param))
    ( (eq? method 'get)
      ; redirect to https
      (redirect-to-https-weblet param))
    (#t
      (pages:notepad:error param 'method-not-allowed))))
; Already connected
(define (pages:notepad:user-login:already-connected usr param)
  ((pages:template
     #:title "Déjà connecté."
     #:author (user-name usr)
     #:content
     `(article
        "Déjà connecté en tant que " ,(user-name usr) ". " (br)
        (a ((href "/user/logout")) "Se déconnecter")))
   param))
; login form
(define pages:notepad:user-login:login-form
  (pages:adaptable-template
    (lambda (param)
      (define usr (get-user-by-name (weblet-parameter-ref param 'name #f)))
      (define incorrect (weblet-parameter-ref param 'incorrect))
      (cond
        (usr
          (make-immutable-hash
            `((author . ,(user-name usr))
              (title . "Connexion")
              (content . (article
                           ,(if (equal? incorrect "t")
                                "Vous n'avez pas dit le mot magique."
                                "")
                           (form ((action ,(user-link 'login (user-name usr)))
                                  (method "post"))
                             (label ((for "pass")) "Mot de passe") " "
                             (input ((id "pass")(name "pass")(type "password")(required "true"))) (br)
                             (input ((type "submit")(value "Se connecter")))
                             )
                           )))))
        (#t
          (notepad:error 'not-found))))))
; Process login
(define (pages:notepad:user-login:sent-form param)
  (define usr (get-user-by-name (weblet-parameter-ref param 'name #f)))
  (define pass (weblet-parameter-ref param 'pass #f))
  (cond
    ( (user-check-password usr pass)
      ; Password OK, set cookie and redirect to /user/show/xxx
      (define usercookie (new-usercookie usr))
      (redirect-to
        (user-link 'show (user-name usr))
        see-other
        #:headers (list
                    (make-header
                      #"Set-Cookie"
                      (cookie->set-cookie-header
                        (make-cookie
                          *cookie-key*
                          (usercookie-value usercookie)
                          #:expires (seconds->date (usercookie-expires usercookie))
                          #:domain (weblet-parameter-host param)
                          #:path "/"
                          #:secure? (not configuration:notepad:dev?)
                          #:http-only? #t))))
        ))
    ( usr
      ; KO, redirect to /user/login/xxx?incorrect=t
      (redirect-to
        (user-link 'login (user-name usr) "?incorrect=t")
        see-other))
    (#t
      (pages:notepad:error param 'not-found))))

; /user/edit/xxx
; Edit page for the user xxx. Must be logged in as user xxx.
; Post only, as it is used to update the /user/show/xxx
(define (pages:notepad:user-edit param)
  (define usr (get-user-by-name (weblet-parameter-ref param 'name #f)))
  (define connected-usr (get-user param))
  (define edition-possible? (same-user? usr connected-usr))
  (define method (weblet-parameter-method param))
  (cond
    ( (and edition-possible?
           (eq? method 'post))
      (define pseudo (weblet-parameter-ref param 'pseudo (user-pseudo usr)))
      (define about (weblet-parameter-ref param 'about (user-about usr)))
      (update-user-info usr #:pseudo pseudo #:about about)
      (redirect-to
        (user-link 'show (user-name usr))
        see-other))
    (#t
      (pages:notepad:error param 'not-found))))

; /user/logout
; Logout page.
(define (pages:notepad:user-logout param)
  (define cookie (weblet-parameter-cookie-ref param *cookie-key*))
  (and cookie (remove-usercookie-by-value (string->bytes/utf-8 cookie)))
  (redirect-to
    "/user/list"
    see-other
    #:headers (list
                (make-header
                  #"Set-Cookie"
                  (clear-cookie-header
                    *cookie-key*
                    #:domain (weblet-parameter-host param)
                    #:path "/")))
    ))
