Source file sodium_fmt.ml

(* 
 * This file is part of sodium-fmt (https://git.sr.ht/~schube/sodium-fmt).
 * Copyright © 2022 Victor Schubert.
 *
 * sodium-fmt 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.
 *
 * sodium-fmt 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
 * sodium-fmt. If not, see <https://www.gnu.org/licenses/>. 
 *)

open Fmt

let base64 : bytes Fmt.t =
  let base64' bytes =
    bytes |> Bytes.unsafe_to_string
    |> Base64.(encode_exn ~alphabet:uri_safe_alphabet)
  in
  using base64' string

let parens_pair left right = parens @@ hvbox @@ pair ~sep:sp left right

let prefix prefix fmt formatter value =
  (parens_pair string fmt) formatter (prefix, value)

let of_typed prefix_fmt fmt conv formatter value =
  match conv value with
  | value -> fmt formatter value
  | exception Sodium.Size_mismatch _ ->
      (prefix_fmt @@ styled `Bold
      @@ styled (`Fg (`Hi `Red))
      @@ const string "<size mismatch>")
        formatter ()

module Box = struct
  open Sodium.Box.Bytes

  let secret_key_prefix fmt = prefix "Box.secret_key" fmt
  let secret_key = secret_key_prefix @@ using of_secret_key base64
  let public_key_prefix fmt = prefix "Box.public_key" fmt
  let public_key = public_key_prefix @@ using of_public_key base64
  let channel_key_prefix fmt = prefix "Box.channel_key" fmt
  let channel_key = channel_key_prefix @@ using of_channel_key base64
  let nonce_prefix fmt = prefix "Box.nonce" fmt
  let nonce = nonce_prefix @@ using of_nonce base64
  let keypair = parens_pair secret_key public_key

  module type S = sig
    type storage

    val secret_key : storage Fmt.t
    val public_key : storage Fmt.t
    val channel_key : storage Fmt.t
    val nonce : storage Fmt.t
  end

  module type Storage = sig
    open Sodium.Box

    type storage

    val to_secret_key : storage -> secret_key
    val to_public_key : storage -> public_key
    val to_channel_key : storage -> channel_key
    val to_nonce : storage -> nonce
  end

  module Make (Storage : Storage) = struct
    type storage = Storage.storage

    open Storage

    let secret_key = of_typed secret_key_prefix secret_key to_secret_key
    let public_key = of_typed public_key_prefix public_key to_public_key
    let channel_key = of_typed channel_key_prefix channel_key to_channel_key
    let nonce = of_typed nonce_prefix nonce to_nonce
  end

  module Bytes = Make (Sodium.Box.Bytes)
  module Bigbytes = Make (Sodium.Box.Bigbytes)
end

module Scalar_mult = struct
  open Sodium.Scalar_mult.Bytes

  let group_elt_prefix fmt = prefix "Scalar_mult.group_elt" fmt
  let group_elt = group_elt_prefix @@ using of_group_elt base64
  let integer_prefix fmt = prefix "Scalar_mult.integer" fmt
  let integer = integer_prefix @@ using of_integer base64

  module type S = sig
    type storage

    val group_elt : storage Fmt.t
    val integer : storage Fmt.t
  end

  module type Storage = sig
    open Sodium.Scalar_mult

    type storage

    val to_group_elt : storage -> group_elt
    val to_integer : storage -> integer
  end

  module Make (Storage : Storage) = struct
    type storage = Storage.storage

    open Storage

    let group_elt = of_typed group_elt_prefix group_elt to_group_elt
    let integer = of_typed integer_prefix integer to_integer
  end

  module Bytes = Make (Sodium.Scalar_mult.Bytes)
  module Bigbytes = Make (Sodium.Scalar_mult.Bigbytes)
end

module Sign = struct
  open Sodium.Sign.Bytes

  let secret_key_prefix fmt = prefix "Sign.secret_key" fmt
  let secret_key = secret_key_prefix @@ using of_secret_key base64
  let public_key_prefix fmt = prefix "Sign.public_key" fmt
  let public_key = public_key_prefix @@ using of_public_key base64
  let keypair = parens_pair secret_key public_key
  let signature_prefix fmt = prefix "Sign.signature" fmt
  let signature = signature_prefix @@ using of_signature base64
  let seed_prefix fmt = prefix "Sign.seed" fmt
  let seed = seed_prefix @@ using of_seed base64

  module type S = sig
    type storage

    val secret_key : storage Fmt.t
    val public_key : storage Fmt.t
    val signature : storage Fmt.t
    val seed : storage Fmt.t
  end

  module type Storage = sig
    open Sodium.Sign

    type storage

    val to_secret_key : storage -> secret_key
    val to_public_key : storage -> public_key
    val to_signature : storage -> signature
    val to_seed : storage -> seed
  end

  module Make (Storage : Storage) = struct
    type storage = Storage.storage

    open Storage

    let secret_key = of_typed secret_key_prefix secret_key to_secret_key
    let public_key = of_typed public_key_prefix public_key to_public_key
    let signature = of_typed signature_prefix signature to_signature
    let seed = of_typed seed_prefix seed to_seed
  end

  module Bytes = Make (Sodium.Sign.Bytes)
  module Bigbytes = Make (Sodium.Sign.Bigbytes)
end

module Password_hash = struct
  open Sodium.Password_hash.Bytes

  let salt_prefix fmt = prefix "Password_hash.salt" fmt
  let salt = salt_prefix @@ using of_salt base64

  module type S = sig
    type storage

    val salt : storage Fmt.t
  end

  module type Storage = sig
    open Sodium.Password_hash

    type storage

    val to_salt : storage -> salt
  end

  module Make (Storage : Storage) = struct
    type storage = Storage.storage

    open Storage

    let salt = of_typed salt_prefix salt to_salt
  end

  module Bytes = Make (Sodium.Password_hash.Bytes)
  module Bigbytes = Make (Sodium.Password_hash.Bigbytes)
end

module Secret_box = struct
  open Sodium.Secret_box.Bytes

  let secret_key_prefix fmt = prefix "Secret_box.secret_key" fmt
  let secret_key = secret_key_prefix @@ using of_key base64
  let nonce_prefix fmt = prefix "Secret_box.nonce" fmt
  let nonce = nonce_prefix @@ using of_nonce base64

  module type S = sig
    type storage

    val secret_key : storage Fmt.t
    val nonce : storage Fmt.t
  end

  module type Storage = sig
    open Sodium.Secret_box

    type storage

    val to_key : storage -> secret_key
    val to_nonce : storage -> nonce
  end

  module Make (Storage : Storage) = struct
    type storage = Storage.storage

    open Storage

    let secret_key = of_typed secret_key_prefix secret_key to_key
    let nonce = of_typed nonce_prefix nonce to_nonce
  end

  module Bytes = Make (Sodium.Secret_box.Bytes)
  module Bigbytes = Make (Sodium.Secret_box.Bigbytes)
end

module Stream = struct
  open Sodium.Stream.Bytes

  let secret_key_prefix fmt = prefix "Stream.secret_key" fmt
  let secret_key = secret_key_prefix @@ using of_key base64
  let nonce_prefix fmt = prefix "Stream.nonce" fmt
  let nonce = nonce_prefix @@ using of_nonce base64

  module type S = sig
    type storage

    val secret_key : storage Fmt.t
    val nonce : storage Fmt.t
  end

  module type Storage = sig
    open Sodium.Stream

    type storage

    val to_key : storage -> secret_key
    val to_nonce : storage -> nonce
  end

  module Make (Storage : Storage) = struct
    type storage = Storage.storage

    open Storage

    let secret_key = of_typed secret_key_prefix secret_key to_key
    let nonce = of_typed nonce_prefix nonce to_nonce
  end

  module Bytes = Make (Sodium.Stream.Bytes)
  module Bigbytes = Make (Sodium.Stream.Bigbytes)
end

module Auth = struct
  open Sodium.Auth.Bytes

  let secret_key_prefix fmt = prefix "Auth.secret_key" fmt
  let secret_key = secret_key_prefix @@ using of_key base64

  module type S = sig
    type storage

    val secret_key : storage Fmt.t
  end

  module type Storage = sig
    open Sodium.Auth

    type storage

    val to_key : storage -> secret_key
  end

  module Make (Storage : Storage) = struct
    type storage = Storage.storage

    open Storage

    let secret_key = of_typed secret_key_prefix secret_key to_key
  end

  module Bytes = Make (Sodium.Auth.Bytes)
  module Bigbytes = Make (Sodium.Auth.Bigbytes)
end

module One_time_auth = struct
  open Sodium.One_time_auth.Bytes

  let secret_key_prefix fmt = prefix "One_time_auth.secret_key" fmt
  let secret_key = secret_key_prefix @@ using of_key base64

  module type S = sig
    type storage

    val secret_key : storage Fmt.t
  end

  module type Storage = sig
    open Sodium.One_time_auth

    type storage

    val to_key : storage -> secret_key
  end

  module Make (Storage : Storage) = struct
    type storage = Storage.storage

    open Storage

    let secret_key = of_typed secret_key_prefix secret_key to_key
  end

  module Bytes = Make (Sodium.One_time_auth.Bytes)
  module Bigbytes = Make (Sodium.One_time_auth.Bigbytes)
end

module Hash = struct
  open Sodium.Hash.Bytes

  let hash_prefix fmt = prefix "Hash.hash" fmt
  let hash = hash_prefix @@ using of_hash base64

  module type S = sig
    type storage

    val hash : storage Fmt.t
  end

  module type Storage = sig
    open Sodium.Hash

    type storage

    val to_hash : storage -> hash
  end

  module Make (Storage : Storage) = struct
    type storage = Storage.storage

    open Storage

    let hash = of_typed hash_prefix hash to_hash
  end

  module Bytes = Make (Sodium.Hash.Bytes)
  module Bigbytes = Make (Sodium.Hash.Bigbytes)
end

module Generichash = struct
  open Sodium.Generichash.Bytes

  let hash_prefix fmt = prefix "Generichash.hash" fmt
  let hash = hash_prefix @@ using of_hash base64
  let secret_key_prefix fmt = prefix "Generichash.secret_key" fmt
  let secret_key = secret_key_prefix @@ using of_key base64

  module type S = sig
    type storage

    val hash : storage Fmt.t
    val secret_key : storage Fmt.t
  end

  module type Storage = sig
    open Sodium.Generichash

    type storage

    val to_hash : storage -> hash
    val to_key : storage -> secret_key
  end

  module Make (Storage : Storage) = struct
    type storage = Storage.storage

    open Storage

    let hash = of_typed hash_prefix hash to_hash
    let secret_key = of_typed secret_key_prefix secret_key to_key
  end

  module Bytes = Make (Sodium.Generichash.Bytes)
  module Bigbytes = Make (Sodium.Generichash.Bigbytes)
end