(library (sph storage dg account)
  (export
    dg-acc-authenticate
    dg-acc-create
    dg-acc-data
    dg-acc-data-ref
    dg-acc-data-update
    dg-acc-delete
    dg-acc-exists?
    dg-acc-id->name
    dg-acc-init
    dg-acc-name->id
    dg-acc-update-name
    dg-acc-update-password)
  (import
    (sph)
    (sph storage dg)
    (sph storage dg authentication)
    (sph storage dg dictionary)
    (sph storage dg one)
    (only (rnrs base) set!)
    (only (sph list) first-or-false))

  ; data
  ;   r: "account" "account" account-id
  ;   r: account-id "name" name
  ;   r: account-id "data" data-id
  ;   r: data-id key value
  (define ids-intern-account)
  (define ids-intern-name)
  (define ids-intern-data)

  (define (dg-acc-init)
    (dg-txn-call-write
      (l (txn)
        (apply
          (l (data name account) (set! ids-intern-data data)
            (set! ids-intern-name name) (set! ids-intern-account account))
          (dg-intern-ensure txn (list "account" "name" "data"))))))

  (define (dg-acc-id->name txn . ids) "dg-txn integer ... -> (string ...)"
    (dg-intern-id->data txn (dg-dictionary-ref txn ids ids-intern-name) (q string) #t))

  (define (dg-acc-name->id txn . names)
    "dg-txn string ... -> (integer ...)
     if any name does not correspond to a account-id the result is null"
    (let (names (dg-intern-data->id txn names #t))
      (if (null? names) names
        (let (account-ids (dg-relation-select-read txn null names ids-intern-name (q left)))
          (dg-relation-select-read txn ids-intern-account account-ids ids-intern-account (q right))))))

  (define (dg-acc-exists? txn . names) "dg-txn string ... -> boolean"
    (not (null? (apply dg-acc-name->id txn names))))

  (define (dg-acc-update-name txn account-id new-name) "dg-txn integer string ->"
    (and (not (dg-acc-exists? new-name))
      (dg-dictionary-update-one account-id ids-intern-name new-name)))

  (define (dg-acc-create txn name password)
    "dg-txn string string/bytevector -> false/integer:account-id
     false if a account with the given name already exists"
    ; auth-authorise creates the password hash
    (and (not (dg-acc-exists? txn name))
      (let (ids (dg-id-create txn))
        (dg-relation-ensure txn ids-intern-account ids ids-intern-account)
        (dg-dictionary-add txn ids ids-intern-name (dg-intern-ensure txn (list name)))
        (dg-auth-authorise txn dg-auth-cost-mid
          #f (first ids-intern-account) (first ids) name password)
        (first ids))))

  (define (dg-acc-update-password txn account-id new-password) "dg-txn integer string/bytevector"
    (dg-auth-authorise txn dg-auth-cost-mid
      #f ids-intern-account (list account-id) account-id new-password))

  (define (dg-acc-delete txn . ids) "dg-txn integer ... -> unspecified"
    (dg-auth-disallow txn ids-intern-account ids)
    (let (account-data (dg-dictionary-ref txn ids (list ids-intern-data)))
      (if (not (null? account-data)) (apply dg-dictionary-delete txn account-data)))
    (apply dg-dictionary-delete txn ids))

  (define (dg-acc-data txn . account-ids) "dg-txn integer ... -> (integer ...)"
    (dg-dictionary-ref txn account-ids (list ids-intern-data)))

  (define (dg-acc-data-update txn account-id key . values)
    "dg-txn integer integer integer ... -> unspecified
     remove eventual existing values for key and set the given new values"
    (dg-dictionary-update txn (dg-acc-data txn account-id) (list key) values))

  (define* (dg-acc-data-ref txn account-id key #:optional (values null))
    "dg-txn integer integer [(integer ...)] -> (integer ...)
     if values is given then it effectively filters existing values"
    (dg-dictionary-ref txn (dg-acc-data txn account-id) (list key) values))

  (define (dg-acc-authenticate txn name password) "dg-txn string string -> integer/false"
    (let (account-id (first-or-false (dg-acc-name->id txn name)))
      (and account-id
        (dg-auth-authenticate-entity txn (first ids-intern-account) account-id name password)
        account-id))))