Lessons learned building a small blog engine

Lessons learned building a small blog engine

[Amirouche Boubekki]

[-- Attachment #1: Type: text/plain, Size: 2583 bytes --]

Héllo all,


Last week end I tried to build a blog engine.

   git clone https://github.com/a-guile-mind/presence

In the backend I used GNU Guile and the following:

- wiredtiger with feature-space database which rely
   on microkanren for querying. I learned nothing new
   in this regard, except that now I know well enough
   the API (which is rather simple anyway).

   Here is an example query to fetch comments associated
   with object having UID as unique identifier:

   (run* (uid? username? website? body? published-at?)
     (fresh ()
       (fs:queryo uid? 'comment/uid uid)
       (fs:queryo uid? 'comment/username username?)
       (fs:queryo uid? 'comment/website website?)
       (fs:queryo uid? 'comment/body body?)
       (fs:queryo uid? 'comment/published-at published-at?)))

   This is somewhat equivalent to:

     SELECT comment/username comment/website comment/body 
comment/published-at
     WHERE comment/uid = uid;

   feature space is not typed and can be called schemaless
   like document databases like mongodb except it doesn't have
   a concept of collection and transaction can span several
   documents.

- I created small bindings for argon2i [0] which is cryptographic
   library that is useful for hashing password.

   [0] https://github.com/P-H-C/phc-winner-argon2

   The public API is missing the use of a pepper which is
   a secret not stored in the database.

- I also use industria sha-2 for signing "cookies".
   Here is the interesting code if you plan on using
   industria it can be helpful:

     (define (make-hash string)
       (let ((hash (make-sha-512)))
         (sha-512-update! hash (string->utf8 string))
         (sha-512-update! hash (string->utf8 secret))
         (sha-512-finish! hash)
         (sha-512->string hash)))

     (define (string-sign string)
       (let ((hash (make-hash string)))
         (string-append string "$" hash)))

     (define (string-verify string)
       (match (string-split string #\$)
         ((value signature) (if (string=? signature (make-hash value))
                                value
                                #f))
         (_ #f)))

   secret is a global variable.

Frontend side I used BiwaScheme using my frontend framework
that takes inspiration from ReactJS. This is where there is
a bug I don't know how to fix, yet. It's linked to autocomplete
feature of firefox which is documented that it can be disabled
but actually it can not...

This work is based on https://github.com/a-guile-mind/guile-web


Happy hacking!

-- 
Amirouche ~ amz3 ~ http://www.hyperdev.fr

[-- Attachment #2: argon2.scm --]
[-- Type: text/plain, Size: 5070 bytes --]

;;; Copyright © 2017  Amirouche Boubekki <amirouche@hypermove.net>
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;; Comment:
;;
;;  https://martinfowler.com/articles/web-security-basics.html
;;
(define-module (argon2))

(use-modules (ice-9 binary-ports))
(use-modules (ice-9 iconv))
(use-modules (rnrs bytevectors))
(use-modules (system foreign))


(define (urandom length)
  "Return a bytevector of length LENGTH generated by /dev/urandom"
  (let ((bv (make-bytevector length)))
    (call-with-input-file "/dev/urandom"
      (lambda (port)
        (let loop ((index 0))
          (unless (eq? index length)
            (let ((byte (get-u8 port)))
              (bytevector-u8-set! bv index byte)
              (loop (+ index 1))))))
      #:binary #true)
    bv))

(define* (dynamic-link* #:optional library-name)
  (let ((shared-object (if library-name
                           (dynamic-link library-name)
                           (dynamic-link))))
    (lambda (return-value function-name . arguments)
      (let ((function (dynamic-func function-name shared-object)))
        (pointer->procedure return-value function arguments)))))

(define argon2 (dynamic-link* "/usr/lib/x86_64-linux-gnu/libargon2.so"))

(define error-message
  (let ((func (argon2 '*
                       "argon2_error_message"
                       int)))
    (lambda (error-code)
      (pointer->string (func error-code)))))

(define encoded-length
  (let ((func (argon2 size_t
                      "argon2_encodedlen"
                      uint32
                      uint32
                      uint32
                      uint32
                      uint32)))
    (lambda (time-cost memory-cost parallelism salt-length hash-length)
      (func time-cost memory-cost parallelism salt-length hash-length))))

(define argon2i-hash-encode
  (let ((func (argon2 int
                      "argon2i_hash_encoded"
                      uint32    ;; t_cost number of iterations
                      uint32    ;; m_cost memory usage 
                      uint32    ;; parallelism number
                      '*        ;; password
                      size_t    ;; password length
                      '*        ;; salt 
                      size_t    ;; salt length
                      size_t    ;; desired length of the hash in bytes
                      '*        ;; buffer
                      size_t))) ;; buffer length
    (lambda (time-cost memory-cost parallelism password salt hash-length length)
      (let ((hash (make-bytevector length)))
        (let ((out (func time-cost
                         memory-cost
                         parallelism
                         (bytevector->pointer password)
                         (bytevector-length password)
                         (if salt (bytevector->pointer salt) %null-pointer)
                         (if salt (bytevector-length salt) 0)
                         hash-length
                         (bytevector->pointer hash)
                         length)))
          (if (zero? out)
            hash
            (throw 'argon2 (error-message out))))))))

(define-public (hash-secret password)
  (let ((time-cost 2)  ;; default values from argon2_cffi
        (memory-cost 512)
        (parallelism 2)
        (length 16)
        (salt (urandom 16)))
    (let ((total (encoded-length time-cost
                                 memory-cost
                                 parallelism
                                 length
                                 length)))
      (utf8->string (argon2i-hash-encode time-cost
                                         memory-cost
                                         parallelism
                                         (string->utf8 password)
                                         salt
                                         length
                                         total)))))

(define argon2i-verify (argon2 int
                               "argon2i_verify"
                               '*
                               '*
                               size_t))

(define-public (verify encoded password)
  (let ((password* (string->utf8 password)))
    (let ((out (argon2i-verify (bytevector->pointer (string->utf8 encoded))
                               (bytevector->pointer password*)
                               (bytevector-length password*))))
      (if (zero? out)
          #t
          (throw 'argon2 (error-message out))))))

[-- Attachment #3: hmac.scm --]
[-- Type: text/plain, Size: 2565 bytes --]

;; -*- mode: scheme; coding: utf-8 -*-
;; Copyright © 2009, 2012 Göran Weinholt <goran@weinholt.se>

;; Permission is hereby granted, free of charge, to any person obtaining a
;; copy of this software and associated documentation files (the "Software"),
;; to deal in the Software without restriction, including without limitation
;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
;; and/or sell copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.

;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;; DEALINGS IN THE SOFTWARE.
#!r6rs

;; RFC 2104, FIPS-198-1.

(library (hmac)
  (export make-hmac)
  (import (rnrs))

  ;; Returns a procedure that calculates the HMAC given a secret and
  ;; data (both of which are bytevectors).
  (define (make-hmac block-length hash ->bytevector make-hash update! finish! clear!)
    (lambda (secret . data)
      (let lp ((secret secret))
        (if (> (bytevector-length secret) block-length)
            (lp (->bytevector (hash secret)))
            (let ((k-ipad (make-bytevector block-length 0))
                  (k-opad (make-bytevector block-length 0)))
              (bytevector-copy! secret 0 k-ipad 0 (bytevector-length secret))
              (bytevector-copy! secret 0 k-opad 0 (bytevector-length secret))
              (do ((i 0 (fx+ i 1)))
                  ((fx=? i block-length))
                (bytevector-u8-set! k-ipad i (fxxor #x36 (bytevector-u8-ref k-ipad i)))
                (bytevector-u8-set! k-opad i (fxxor #x5c (bytevector-u8-ref k-opad i))))
              (let ((state (make-hash)))
                (update! state k-ipad)
                (for-each (lambda (d) (update! state d)) data)
                (finish! state)
                (let ((digest (->bytevector state)))
                  (clear! state)
                  (update! state k-opad)
                  (update! state digest)
                  (finish! state)
                  state)))))))
  )

[-- Attachment #4: sha-2.scm --]
[-- Type: text/plain, Size: 24648 bytes --]

;; -*- mode: scheme; coding: utf-8 -*-
;; Copyright © 2009, 2010, 2012 Göran Weinholt <goran@weinholt.se>

;; Permission is hereby granted, free of charge, to any person obtaining a
;; copy of this software and associated documentation files (the "Software"),
;; to deal in the Software without restriction, including without limitation
;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
;; and/or sell copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.

;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;; DEALINGS IN THE SOFTWARE.
#!r6rs

;; Byte-oriented SHA-224/256 and SHA-384/512 from FIPS 180-3

;; RFC3874 SHA-224

;; TODO: give an error if more than 2^64 / 2^128 bits are processed?
;; TODO: Optimize. Should be simple enough with the help of a profiler.

(library (sha-2)
  (export make-sha-224 sha-224-update! sha-224-finish! sha-224-clear!
          sha-224 sha-224-copy sha-224-finish sha-224-length
          sha-224-copy-hash! sha-224-128-copy-hash!
          sha-224->bytevector sha-224->string
          sha-224-hash=? sha-224-128-hash=?
          hmac-sha-224

          make-sha-256 sha-256-update! sha-256-finish! sha-256-clear!
          sha-256 sha-256-copy sha-256-finish sha-256-length
          sha-256-copy-hash! sha-256-128-copy-hash!
          sha-256->bytevector sha-256->string
          sha-256-hash=? sha-256-128-hash=?
          hmac-sha-256

          make-sha-384 sha-384-update! sha-384-finish! sha-384-clear!
          sha-384 sha-384-copy sha-384-finish sha-384-length
          sha-384-copy-hash! sha-384-128-copy-hash!
          sha-384->bytevector sha-384->string
          sha-384-hash=? sha-384-128-hash=?
          hmac-sha-384

          make-sha-512 sha-512-update! sha-512-finish! sha-512-clear!
          sha-512 sha-512-copy sha-512-finish sha-512-length
          sha-512-copy-hash! sha-512-128-copy-hash!
          sha-512->bytevector sha-512->string
          sha-512-hash=? sha-512-128-hash=?
          hmac-sha-512)
  (import (rnrs)
          (hmac))

  (define (sha-224-length) 224/8)
  (define (sha-256-length) 256/8)
  (define (sha-384-length) 384/8)
  (define (sha-512-length) 512/8)
  
  (define (vector-copy x) (vector-map (lambda (i) i) x))

  (define (ror32 n count)
    (let ((field1 (bitwise-and #xffffffff (bitwise-arithmetic-shift-left n (- 32 count))))
          (field2 (bitwise-arithmetic-shift-right n count)))
      (bitwise-ior field1 field2)))

  (define (ror64 n count)
    (let ((field1 (bitwise-and #xffffffffffffffff
                               (bitwise-arithmetic-shift-left n (- 64 count))))
          (field2 (bitwise-arithmetic-shift-right n count)))
      (bitwise-ior field1 field2)))


  (define-record-type sha-state
    (fields (immutable H)               ;Hash
            (immutable init)            ;initial hash
            (immutable W)               ;temporary data
            (immutable m)               ;unprocessed data
            (mutable pending)           ;length of unprocessed data
            (mutable processed)))       ;length of processed data

  (define (make-sha-2 initial-hash)
    (let ((W (make-vector 80 #f))
          (m (make-bytevector (* 4 32))))
      (make-sha-state (list->vector initial-hash)
                      initial-hash
                      W m 0 0)))

  (define (make-sha-224) (make-sha-2 initial-hash224))
  (define (make-sha-256) (make-sha-2 initial-hash256))
  (define (make-sha-384) (make-sha-2 initial-hash384))
  (define (make-sha-512) (make-sha-2 initial-hash512))

  (define (sha-2-copy state)
    (let ((H (vector-copy (sha-state-H state)))
          (W (make-vector 80 #f))
          (m (bytevector-copy (sha-state-m state))))
      (make-sha-state H
                      (sha-state-init state)
                      W m
                      (sha-state-pending state)
                      (sha-state-processed state))))

  (define (sha-224-copy x) (sha-2-copy x))
  (define (sha-256-copy x) (sha-2-copy x))
  (define (sha-384-copy x) (sha-2-copy x))
  (define (sha-512-copy x) (sha-2-copy x))

  (define (sha-2-clear! state)
    (do ((init (sha-state-init state) (cdr init))
         (i 0 (+ i 1)))
        ((null? init))
      (vector-set! (sha-state-H state) i (car init)))
    (vector-fill! (sha-state-W state) #f)
    (bytevector-fill! (sha-state-m state) 0)
    (sha-state-pending-set! state 0)
    (sha-state-processed-set! state 0))

  (define (sha-224-clear! state) (sha-2-clear! state))
  (define (sha-256-clear! state) (sha-2-clear! state))
  (define (sha-384-clear! state) (sha-2-clear! state))
  (define (sha-512-clear! state) (sha-2-clear! state))


  (define initial-hash224 '(#xc1059ed8 #x367cd507 #x3070dd17 #xf70e5939
                            #xffc00b31 #x68581511 #x64f98fa7 #xbefa4fa4))

  (define initial-hash256 '(#x6a09e667 #xbb67ae85 #x3c6ef372 #xa54ff53a
                            #x510e527f #x9b05688c #x1f83d9ab #x5be0cd19))

  (define initial-hash384 '(#xcbbb9d5dc1059ed8 #x629a292a367cd507
                            #x9159015a3070dd17 #x152fecd8f70e5939
                            #x67332667ffc00b31 #x8eb44a8768581511
                            #xdb0c2e0d64f98fa7 #x47b5481dbefa4fa4))

  (define initial-hash512 '(#x6a09e667f3bcc908 #xbb67ae8584caa73b
                            #x3c6ef372fe94f82b #xa54ff53a5f1d36f1
                            #x510e527fade682d1 #x9b05688c2b3e6c1f
                            #x1f83d9abfb41bd6b #x5be0cd19137e2179))


  (define (Ch x y z)
    (bitwise-xor (bitwise-and x y)
                 (bitwise-and (bitwise-not x) z)))

  (define Parity bitwise-xor)

  (define (Maj x y z)
    (bitwise-xor (bitwise-and x y)
                 (bitwise-and x z)
                 (bitwise-and y z)))



  (define (Sigma0-256 x)
    (bitwise-xor (ror32 x 2)
                 (ror32 x 13)
                 (ror32 x 22)))

  (define (Sigma1-256 x)
    (bitwise-xor (ror32 x 6)
                 (ror32 x 11)
                 (ror32 x 25)))

  (define (sigma0-256 x)
    (bitwise-xor (ror32 x 7)
                 (ror32 x 18)
                 (bitwise-arithmetic-shift-right x 3)))

  (define (sigma1-256 x)
    (bitwise-xor (ror32 x 17)
                 (ror32 x 19)
                 (bitwise-arithmetic-shift-right x 10)))


  (define (Sigma0-512 x)
    (bitwise-xor (ror64 x 28)
                 (ror64 x 34)
                 (ror64 x 39)))

  (define (Sigma1-512 x)
    (bitwise-xor (ror64 x 14)
                 (ror64 x 18)
                 (ror64 x 41)))

  (define (sigma0-512 x)
    (bitwise-xor (ror64 x 1)
                 (ror64 x 8)
                 (bitwise-arithmetic-shift-right x 7)))

  (define (sigma1-512 x)
    (bitwise-xor (ror64 x 19)
                 (ror64 x 61)
                 (bitwise-arithmetic-shift-right x 6)))

  (define k-256
    '#(#x428a2f98 #x71374491 #xb5c0fbcf #xe9b5dba5
       #x3956c25b #x59f111f1 #x923f82a4 #xab1c5ed5
       #xd807aa98 #x12835b01 #x243185be #x550c7dc3
       #x72be5d74 #x80deb1fe #x9bdc06a7 #xc19bf174
       #xe49b69c1 #xefbe4786 #x0fc19dc6 #x240ca1cc
       #x2de92c6f #x4a7484aa #x5cb0a9dc #x76f988da
       #x983e5152 #xa831c66d #xb00327c8 #xbf597fc7
       #xc6e00bf3 #xd5a79147 #x06ca6351 #x14292967
       #x27b70a85 #x2e1b2138 #x4d2c6dfc #x53380d13
       #x650a7354 #x766a0abb #x81c2c92e #x92722c85
       #xa2bfe8a1 #xa81a664b #xc24b8b70 #xc76c51a3
       #xd192e819 #xd6990624 #xf40e3585 #x106aa070
       #x19a4c116 #x1e376c08 #x2748774c #x34b0bcb5
       #x391c0cb3 #x4ed8aa4a #x5b9cca4f #x682e6ff3
       #x748f82ee #x78a5636f #x84c87814 #x8cc70208
       #x90befffa #xa4506ceb #xbef9a3f7 #xc67178f2))

  (define k-512
    '#(#x428a2f98d728ae22 #x7137449123ef65cd #xb5c0fbcfec4d3b2f #xe9b5dba58189dbbc
       #x3956c25bf348b538 #x59f111f1b605d019 #x923f82a4af194f9b #xab1c5ed5da6d8118
       #xd807aa98a3030242 #x12835b0145706fbe #x243185be4ee4b28c #x550c7dc3d5ffb4e2
       #x72be5d74f27b896f #x80deb1fe3b1696b1 #x9bdc06a725c71235 #xc19bf174cf692694
       #xe49b69c19ef14ad2 #xefbe4786384f25e3 #x0fc19dc68b8cd5b5 #x240ca1cc77ac9c65
       #x2de92c6f592b0275 #x4a7484aa6ea6e483 #x5cb0a9dcbd41fbd4 #x76f988da831153b5
       #x983e5152ee66dfab #xa831c66d2db43210 #xb00327c898fb213f #xbf597fc7beef0ee4
       #xc6e00bf33da88fc2 #xd5a79147930aa725 #x06ca6351e003826f #x142929670a0e6e70
       #x27b70a8546d22ffc #x2e1b21385c26c926 #x4d2c6dfc5ac42aed #x53380d139d95b3df
       #x650a73548baf63de #x766a0abb3c77b2a8 #x81c2c92e47edaee6 #x92722c851482353b
       #xa2bfe8a14cf10364 #xa81a664bbc423001 #xc24b8b70d0f89791 #xc76c51a30654be30
       #xd192e819d6ef5218 #xd69906245565a910 #xf40e35855771202a #x106aa07032bbd1b8
       #x19a4c116b8d2d0c8 #x1e376c085141ab53 #x2748774cdf8eeb99 #x34b0bcb5e19b48a8
       #x391c0cb3c5c95a63 #x4ed8aa4ae3418acb #x5b9cca4f7763e373 #x682e6ff3d6b2b8a3
       #x748f82ee5defb2fc #x78a5636f43172f60 #x84c87814a1f0ab72 #x8cc702081a6439ec
       #x90befffa23631e28 #xa4506cebde82bde9 #xbef9a3f7b2c67915 #xc67178f2e372532b
       #xca273eceea26619c #xd186b8c721c0c207 #xeada7dd6cde0eb1e #xf57d4f7fee6ed178
       #x06f067aa72176fba #x0a637dc5a2c898a6 #x113f9804bef90dae #x1b710b35131c471b
       #x28db77f523047d84 #x32caab7b40c72493 #x3c9ebe0a15c9bebc #x431d67c49c100d4c
       #x4cc5d4becb3e42b6 #x597f299cfc657e2a #x5fcb6fab3ad6faec #x6c44198c4a475817))

  ;; This function transforms a whole 512 bit block.
  (define (sha-256-transform! H* W m offset)
    ;; Copy the message block
    (do ((t 0 (+ t 1)))
        ((= t 16))
      (vector-set! W t (bytevector-u32-ref m (+ (* t 4) offset) (endianness big))))
    ;; Initialize W[16..63]
    (do ((t 16 (+ t 1)))
        ((= t 64))
      (vector-set! W t (bitwise-and (+ (sigma1-256 (vector-ref W (- t 2)))
                                       (vector-ref W (- t 7))
                                       (sigma0-256 (vector-ref W (- t 15)))
                                       (vector-ref W (- t 16)))
                                    #xffffffff)))
    ;; Do the hokey pokey
    (let lp ((A (vector-ref H* 0))
             (B (vector-ref H* 1))
             (C (vector-ref H* 2))
             (D (vector-ref H* 3))
             (E (vector-ref H* 4))
             (F (vector-ref H* 5))
             (G (vector-ref H* 6))
             (H (vector-ref H* 7))
             (t 0))
      (cond ((= t 64)
             (vector-set! H* 0 (bitwise-and #xffffffff (+ A (vector-ref H* 0))))
             (vector-set! H* 1 (bitwise-and #xffffffff (+ B (vector-ref H* 1))))
             (vector-set! H* 2 (bitwise-and #xffffffff (+ C (vector-ref H* 2))))
             (vector-set! H* 3 (bitwise-and #xffffffff (+ D (vector-ref H* 3))))
             (vector-set! H* 4 (bitwise-and #xffffffff (+ E (vector-ref H* 4))))
             (vector-set! H* 5 (bitwise-and #xffffffff (+ F (vector-ref H* 5))))
             (vector-set! H* 6 (bitwise-and #xffffffff (+ G (vector-ref H* 6))))
             (vector-set! H* 7 (bitwise-and #xffffffff (+ H (vector-ref H* 7)))))
            (else
             (let ((T1 (+ H (Sigma1-256 E) (Ch E F G)
                          (vector-ref k-256 t) (vector-ref W t)))
                   (T2 (+ (Sigma0-256 A) (Maj A B C))))
               (lp (bitwise-and #xffffffff (+ T1 T2))
                   A B C
                   (bitwise-and #xffffffff (+ D T1))
                   E F G
                   (+ t 1)))))))

  ;; This function transforms a whole 1024 bit block.
  (define (sha-512-transform! H* W m offset)
    ;; Copy the message block
    (do ((t 0 (+ t 1)))
        ((= t 16))
      (vector-set! W t (bytevector-u64-ref m (+ (* t 8) offset) (endianness big))))
    ;; Initialize W[16..63]
    (do ((t 16 (+ t 1)))
        ((= t 80))
      (vector-set! W t (bitwise-and (+ (sigma1-512 (vector-ref W (- t 2)))
                                       (vector-ref W (- t 7))
                                       (sigma0-512 (vector-ref W (- t 15)))
                                       (vector-ref W (- t 16)))
                                    #xffffffffffffffff)))
    ;; Do the hokey pokey
    (let lp ((A (vector-ref H* 0))
             (B (vector-ref H* 1))
             (C (vector-ref H* 2))
             (D (vector-ref H* 3))
             (E (vector-ref H* 4))
             (F (vector-ref H* 5))
             (G (vector-ref H* 6))
             (H (vector-ref H* 7))
             (t 0))
      (cond ((= t 80)
             (vector-set! H* 0 (bitwise-and #xffffffffffffffff (+ A (vector-ref H* 0))))
             (vector-set! H* 1 (bitwise-and #xffffffffffffffff (+ B (vector-ref H* 1))))
             (vector-set! H* 2 (bitwise-and #xffffffffffffffff (+ C (vector-ref H* 2))))
             (vector-set! H* 3 (bitwise-and #xffffffffffffffff (+ D (vector-ref H* 3))))
             (vector-set! H* 4 (bitwise-and #xffffffffffffffff (+ E (vector-ref H* 4))))
             (vector-set! H* 5 (bitwise-and #xffffffffffffffff (+ F (vector-ref H* 5))))
             (vector-set! H* 6 (bitwise-and #xffffffffffffffff (+ G (vector-ref H* 6))))
             (vector-set! H* 7 (bitwise-and #xffffffffffffffff (+ H (vector-ref H* 7)))))
            (else
             (let ((T1 (+ H (Sigma1-512 E) (Ch E F G)
                          (vector-ref k-512 t) (vector-ref W t)))
                   (T2 (+ (Sigma0-512 A) (Maj A B C))))
               (lp (bitwise-and #xffffffffffffffff (+ T1 T2))
                   A B C
                   (bitwise-and #xffffffffffffffff (+ D T1))
                   E F G
                   (+ t 1)))))))

  (define (sha-224-update! . x) (apply sha-256-update! x))

  ;; Add a bytevector to the state. Align your data to whole blocks if
  ;; you want this to go a little faster.
  (define sha-256-update!
    (case-lambda
      ((state data start end)
       (let ((m (sha-state-m state))    ;unprocessed data
             (H (sha-state-H state))
             (W (sha-state-W state)))
         (let lp ((offset start))
           (cond ((= (sha-state-pending state) 64)
                  ;; A whole block is pending
                  (sha-256-transform! H W m 0)
                  (sha-state-pending-set! state 0)
                  (sha-state-processed-set! state (+ 64 (sha-state-processed state)))
                  (lp offset))
                 ((= offset end)
                  (values))
                 ((or (> (sha-state-pending state) 0)
                      (> (+ offset 64) end))
                  ;; Pending data exists or less than a block remains.
                  ;; Add more pending data.
                  (let ((added (min (- 64 (sha-state-pending state))
                                    (- end offset))))
                    (bytevector-copy! data offset
                                      m (sha-state-pending state)
                                      added)
                    (sha-state-pending-set! state (+ added (sha-state-pending state)))
                    (lp (+ offset added))))
                 (else
                  ;; Consume a whole block
                  (sha-256-transform! H W data offset)
                  (sha-state-processed-set! state (+ 64 (sha-state-processed state)))
                  (lp (+ offset 64)))))))
      ((state data)
       (sha-256-update! state data 0 (bytevector-length data)))))

  (define (sha-384-update! . x) (apply sha-512-update! x))

  (define sha-512-update!
    (case-lambda
      ((state data start end)
       (let ((m (sha-state-m state))    ;unprocessed data
             (H (sha-state-H state))
             (W (sha-state-W state)))
         (let lp ((offset start))
           (cond ((= (sha-state-pending state) 128)
                  ;; A whole block is pending
                  (sha-512-transform! H W m 0)
                  (sha-state-pending-set! state 0)
                  (sha-state-processed-set! state (+ 128 (sha-state-processed state)))
                  (lp offset))
                 ((= offset end)
                  (values))
                 ((or (> (sha-state-pending state) 0)
                      (> (+ offset 128) end))
                  ;; Pending data exists or less than a block remains.
                  ;; Add more pending data.
                  (let ((added (min (- 128 (sha-state-pending state))
                                    (- end offset))))
                    (bytevector-copy! data offset
                                      m (sha-state-pending state)
                                      added)
                    (sha-state-pending-set! state (+ added (sha-state-pending state)))
                    (lp (+ offset added))))
                 (else
                  ;; Consume a whole block
                  (sha-512-transform! H W data offset)
                  (sha-state-processed-set! state (+ 128 (sha-state-processed state)))
                  (lp (+ offset 128)))))))
      ((state data)
       (sha-512-update! state data 0 (bytevector-length data)))))


  (define zero-block (make-bytevector 128 0))

  (define (sha-224-finish! state) (sha-256-finish! state))

  ;; Finish the state by adding a 1, zeros and the counter.
  (define (sha-256-finish! state)
    (let ((m (sha-state-m state))
          (pending (+ (sha-state-pending state) 1)))
      (bytevector-u8-set! m (sha-state-pending state) #x80)
      (cond ((> pending 56)
             (bytevector-copy! zero-block 0
                               m pending
                               (- 64 pending))
             (sha-256-transform! (sha-state-H state)
                                 (sha-state-W state)
                                 m
                                 0)
             (bytevector-fill! m 0))
            (else
             (bytevector-copy! zero-block 0
                               m pending
                               (- 64 pending))))
      ;; Number of bits in the data
      (bytevector-u64-set! m 56
                           (* (+ (sha-state-processed state)
                                 (- pending 1))
                              8)
                           (endianness big))
      (sha-256-transform! (sha-state-H state)
                          (sha-state-W state)
                          m
                          0)))

  (define (sha-384-finish! state) (sha-512-finish! state))

  (define (sha-512-finish! state)
    (let ((m (sha-state-m state))
          (pending (+ (sha-state-pending state) 1)))
      (bytevector-u8-set! m (sha-state-pending state) #x80)
      (cond ((> pending 112)
             (bytevector-copy! zero-block 0
                               m pending
                               (- 128 pending))
             (sha-512-transform! (sha-state-H state)
                                 (sha-state-W state)
                                 m
                                 0)
             (bytevector-fill! m 0))
            (else
             (bytevector-copy! zero-block 0
                               m pending
                               (- 128 pending))))
      ;; Number of bits in the data
      (bytevector-uint-set! m 112
                            (* (+ (sha-state-processed state)
                                  (- pending 1))
                               8)
                            (endianness big)
                            16)
      (sha-512-transform! (sha-state-H state)
                          (sha-state-W state)
                          m
                          0)))

  (define (sha-2-finish copy finish!)
    (lambda (state)
      (let ((copy (copy state)))
        (finish! copy)
        copy)))

  (define sha-224-finish (sha-2-finish sha-224-copy sha-224-finish!))
  (define sha-256-finish (sha-2-finish sha-256-copy sha-256-finish!))
  (define sha-384-finish (sha-2-finish sha-384-copy sha-384-finish!))
  (define sha-512-finish (sha-2-finish sha-512-copy sha-512-finish!))

  ;; Find the message digest of the concatenation of the given bytevectors.
  (define (sha-2 make update! finish!)
    (lambda data
      (let ((state (make)))
        (for-each (lambda (d) (update! state d))
                  data)
        (finish! state)
        state)))

  (define sha-224 (sha-2 make-sha-224 sha-224-update! sha-224-finish!))
  (define sha-256 (sha-2 make-sha-256 sha-256-update! sha-256-finish!))
  (define sha-384 (sha-2 make-sha-384 sha-384-update! sha-384-finish!))
  (define sha-512 (sha-2 make-sha-512 sha-512-update! sha-512-finish!))

  (define (sha-2/32-copy-hash! len)
    (lambda (state bv off)
      (do ((i 0 (+ i 1)))
          ((= i len))
        (bytevector-u32-set! bv (+ off (* 4 i))
                             (vector-ref (sha-state-H state) i)
                             (endianness big)))))

  (define sha-224-copy-hash! (sha-2/32-copy-hash! 224/32))
  (define sha-256-copy-hash! (sha-2/32-copy-hash! 256/32))
  (define sha-224-128-copy-hash! (sha-2/32-copy-hash! 128/32))
  (define sha-256-128-copy-hash! (sha-2/32-copy-hash! 128/32))

  (define (sha-2/64-copy-hash! len)
    (lambda (state bv off)
      (do ((i 0 (+ i 1)))
          ((= i len))
        (bytevector-u64-set! bv (+ off (* 8 i))
                             (vector-ref (sha-state-H state) i)
                             (endianness big)))))

  (define sha-384-copy-hash! (sha-2/64-copy-hash! 384/64))
  (define sha-512-copy-hash! (sha-2/64-copy-hash! 512/64))
  (define sha-384-128-copy-hash! (sha-2/64-copy-hash! 128/64))
  (define sha-512-128-copy-hash! (sha-2/64-copy-hash! 128/64))

  (define (sha-2->bytevector copy! len)
    (lambda (state)
      (let ((ret (make-bytevector (* 4 len))))
        (copy! state ret 0)
        ret)))

  (define sha-224->bytevector (sha-2->bytevector sha-224-copy-hash! 224/32))
  (define sha-256->bytevector (sha-2->bytevector sha-256-copy-hash! 256/32))
  (define sha-384->bytevector (sha-2->bytevector sha-384-copy-hash! 384/32))
  (define sha-512->bytevector (sha-2->bytevector sha-512-copy-hash! 512/32))

  (define (sha-2->string ->bytevector)
    (lambda (state)
      (apply string-append
             (map (lambda (x)
                    (if (< x #x10)
                        (string-append "0" (number->string x 16))
                        (number->string x 16)))
                  (bytevector->u8-list (->bytevector state))))))

  (define sha-224->string (sha-2->string sha-224->bytevector))
  (define sha-256->string (sha-2->string sha-256->bytevector))
  (define sha-384->string (sha-2->string sha-384->bytevector))
  (define sha-512->string (sha-2->string sha-512->bytevector))

  (define (cmp/32 state bv len)
    (do ((i 0 (fx+ i 1))
         (diff 0 (+ diff
                    (bitwise-xor
                     (bytevector-u32-ref bv (* 4 i) (endianness big))
                     (vector-ref (sha-state-H state) i)))))
        ((fx=? i len)
         (zero? diff))))

  (define (sha-224-hash=? state bv) (cmp/32 state bv 224/32))
  (define (sha-256-hash=? state bv) (cmp/32 state bv 256/32))
  (define (sha-384-hash=? state bv) (cmp/64 state bv 384/64))
  (define (sha-512-hash=? state bv) (cmp/64 state bv 512/64))

  (define (cmp/64 state bv len)
    (do ((i 0 (fx+ i 1))
         (diff 0 (+ diff
                    (bitwise-xor
                     (bytevector-u64-ref bv (* 8 i) (endianness big))
                     (vector-ref (sha-state-H state) i)))))
        ((fx=? i len)
         (zero? diff))))

  (define (sha-224-128-hash=? state bv) (cmp/32 state bv 128/32))
  (define (sha-256-128-hash=? state bv) (cmp/32 state bv 128/32))
  (define (sha-384-128-hash=? state bv) (cmp/64 state bv 128/64))
  (define (sha-512-128-hash=? state bv) (cmp/64 state bv 128/64))

  (define hmac-sha-224
    (make-hmac 64 sha-224 sha-224->bytevector make-sha-224 sha-224-update! sha-224-finish! sha-224-clear!))

  (define hmac-sha-256
    (make-hmac 64 sha-256 sha-256->bytevector make-sha-256 sha-256-update! sha-256-finish! sha-256-clear!))

  (define hmac-sha-384
    (make-hmac 128 sha-384 sha-384->bytevector make-sha-384 sha-384-update! sha-384-finish! sha-384-clear!))

  (define hmac-sha-512
    (make-hmac 128 sha-512 sha-512->bytevector make-sha-512 sha-512-update! sha-512-finish! sha-512-clear!))

  )

Re: Lessons learned building a small blog engine

[Amirouche Boubekki]

On 2017-10-09 13:36, Amirouche Boubekki wrote:
> Héllo all,
> 
> 
> Last week end I tried to build a blog engine.
> 
>   git clone https://github.com/a-guile-mind/presence
> 

Now, accept to following challenge:

    Try to add an article on http://presence.hyperdev.fr/

Tips: For that you need to read the code.

Happy hacking!

Re: Lessons learned building a small blog engine

[Amirouche Boubekki]

On 2017-10-09 21:14, Amirouche Boubekki wrote:
> On 2017-10-09 13:36, Amirouche Boubekki wrote:
>> Héllo all,
>> 
>> 
>> Last week end I tried to build a blog engine.
>> 
>>   git clone https://github.com/a-guile-mind/presence
>> 
> 
> Now, accept to following challenge:
> 
>    Try to add an article on http://presence.hyperdev.fr/
> 
> Tips: For that you need to read the code.
> 
> Happy hacking!

Another tips: You need to workaround at least two bugs.

Please post a mail on the mailing list if you succeed.

Re: Lessons learned building a small blog engine

[Arne Babenhauserheide]

[-- Attachment #1: Type: text/plain, Size: 829 bytes --]


Amirouche Boubekki <amirouche@hypermove.net> writes:

> On 2017-10-09 21:14, Amirouche Boubekki wrote:
>> On 2017-10-09 13:36, Amirouche Boubekki wrote:
>>> Last week end I tried to build a blog engine.
>>>   git clone https://github.com/a-guile-mind/presence
>> Now, accept to following challenge:
>> 
>>    Try to add an article on http://presence.hyperdev.fr/
>> 
>> Tips: For that you need to read the code.
>> 
>> Happy hacking!
>
> Another tips: You need to workaround at least two bugs.
>
> Please post a mail on the mailing list if you succeed.

I got here http://presence.hyperdev.fr/admin/post/create/

But I don’t have time to continue now. I’d like to pass on the baton.

Good luck and happy hacking!

Best wishes,
Arne
-- 
Unpolitisch sein
heißt politisch sein
ohne es zu merken

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

Re: Lessons learned building a small blog engine

[Erik Edrosa]

On 10/09/2017 03:17 PM, Amirouche Boubekki wrote:
> On 2017-10-09 21:14, Amirouche Boubekki wrote:
>> On 2017-10-09 13:36, Amirouche Boubekki wrote:
>>> Héllo all,
>>>
>>>
>>> Last week end I tried to build a blog engine.
>>>
>>>   git clone https://github.com/a-guile-mind/presence
>>>
>>
>> Now, accept to following challenge:
>>
>>    Try to add an article on http://presence.hyperdev.fr/
>>
>> Tips: For that you need to read the code.
>>
>> Happy hacking!
> 
> Another tips: You need to workaround at least two bugs.
> 
> Please post a mail on the mailing list if you succeed.
> 


Managed to add an article. The key is to look at the routes in the
scheme code and then sort of follow it. The bugs prevent you from easily
progressing but you can still proceed if you follow the routes. Thank
you Amirouche for the fun little challenge.

- Erik (OrangeShark)