libcrypto.rkt

#lang racket/base

(require ffi/unsafe
         ffi/unsafe/define
         net/base64
         openssl/libcrypto
         (rename-in racket/contract [-> ->/c])
         racket/match
         racket/random
         racket/string
         (only-in sha sha256))

(provide
 (contract-out
  [encrypt (bytes? bytes? . ->/c . string?)]
  [decrypt (bytes? string? . ->/c . bytes?)]))

;; ---------------------------------------------------------------------------------------------------

(define-ffi-definer define-openssl libcrypto)

(define-cpointer-type _EVP_CIPHER)
(define-cpointer-type _EVP_CIPHER_CTX)

(define-cpointer-type _ENGINE)

(define-openssl EVP_CIPHER_CTX_new (_fun -> _EVP_CIPHER_CTX))
(define-openssl EVP_CIPHER_CTX_free (_fun _EVP_CIPHER_CTX -> _void))
(define-openssl EVP_aes_256_cbc (_fun -> _EVP_CIPHER))

(define-openssl EVP_EncryptInit_ex
  (_fun _EVP_CIPHER_CTX _EVP_CIPHER _ENGINE/null _bytes _bytes -> _int))
(define-openssl EVP_DecryptInit_ex
  (_fun _EVP_CIPHER_CTX _EVP_CIPHER _ENGINE/null _bytes _bytes -> _int))

(define-openssl EVP_EncryptUpdate
  (_fun _EVP_CIPHER_CTX
        ; this magic 127 number is a lie for non-AES ciphers; should be EVP_CIPHER_block_size - 1
        (out : (_bytes o (+ (bytes-length in) 127))) (outl : (_ptr o _int))
        (in : _bytes) (_int = (bytes-length in))
        -> (r : _int)
        -> (values r (subbytes out 0 outl))))

(define-openssl EVP_EncryptFinal_ex
  (_fun (ctx in) ::
        (ctx : _EVP_CIPHER_CTX)
        ; this magic number has the same issue as the one in EVP_EncryptUpdate
        (out : (_bytes o 127)) (outl : (_ptr o _int))
        -> (r : _int)
        -> (values r (bytes-append in (subbytes out 0 outl)))))

(define-openssl EVP_DecryptUpdate
  (_fun _EVP_CIPHER_CTX
        ; this magic number has the same issue as the one in EVP_EncryptUpdate
        (out : (_bytes o (+ (bytes-length in) 127))) (outl : (_ptr o _int))
        (in : _bytes) (_int = (bytes-length in))
        -> (r : _int)
        -> (values r (subbytes out 0 outl))))

(define-openssl EVP_DecryptFinal_ex
  (_fun (ctx in) ::
        (ctx : _EVP_CIPHER_CTX)
        ; this magic number has the same issue as the one in EVP_EncryptUpdate
        (out : (_bytes o 127)) (outl : (_ptr o _int))
        -> (r : _int)
        -> (values r (bytes-append in (subbytes out 0 outl)))))

;; ---------------------------------------------------------------------------------------------------

(define (encrypt secret plaintext)
  ; get a 256 bit key from the input secret
  (define secret-digest (sha256 secret))
  ; generate a 128 bit initialization vector
  (define initialization-vector (crypto-random-bytes 16))

  ; initialize for encryption
  (define ctx (EVP_CIPHER_CTX_new))
  (define result (EVP_EncryptInit_ex ctx (EVP_aes_256_cbc) #f secret-digest initialization-vector))
  (unless (= 1 result) (error 'encrypt-aes-256-cbc "EVP_DecryptInit_ex returned ~v" result))
  
  ; perform the actual encryption
  (match-define-values [result* ciphertext] (EVP_EncryptUpdate ctx plaintext))
  (unless (= 1 result*) (error 'encrypt-aes-256-cbc "EVP_EncryptUpdate returned ~v" result*))
  (match-define-values [result** ciphertext*] (EVP_EncryptFinal_ex ctx ciphertext))
  (unless (= 1 result**) (error 'encrypt-aes-256-cbc "EVP_EncryptFinal_ex returned ~v" result**))

  ; free the cipher state
  (EVP_CIPHER_CTX_free ctx)

  ; return the base64-encoded ciphertext and initialization vector
  (bytes->string/utf-8
   (bytes-append (base64-encode ciphertext* #"") #"--"
                 (base64-encode initialization-vector #""))))

(define (decrypt secret ciphertext+initialization-vector)
  ; parse the ciphertext and initialization vector out of the input
  (match-define (list ciphertext initialization-vector)
    (map (compose1 base64-decode string->bytes/utf-8)
         (string-split ciphertext+initialization-vector "--")))

  ; get a 256 bit key from the input secret
  (define secret-digest (sha256 secret))

  ; intialize for decryption
  (define ctx (EVP_CIPHER_CTX_new))
  (define result (EVP_DecryptInit_ex ctx (EVP_aes_256_cbc) #f secret-digest initialization-vector))
  (unless (= 1 result) (error 'decrypt-aes-256-cbc "EVP_DecryptInit_ex returned ~v" result))

  ; perform the actual decryption
  (match-define-values [result* plaintext] (EVP_DecryptUpdate ctx ciphertext))
  (unless (= 1 result*) (error 'decrypt-aes-256-cbc "EVP_DecryptUpdate returned ~v" result*))
  (match-define-values [result** plaintext*] (EVP_DecryptFinal_ex ctx plaintext))
  (unless (= 1 result**) (error 'decrypt-aes-256-cbc "EVP_DecryptFinal_ex returned ~v" result**))

  ; free the cipher state
  (EVP_CIPHER_CTX_free ctx)

  ; return the decrypted data
  plaintext*)