extra/sodium/sodium.factor

   1 ! Copyright (C) 2017-2020 Alexander Ilin.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.c-types alien.data byte-arrays init io.encodings.ascii
   4 io.encodings.string io.encodings.utf8 kernel locals math sequences
   5 sodium.ffi ;
   6 IN: sodium
   7
   8 ERROR: sodium-init-fail ;
   9 ERROR: call-fail ;
  10 ERROR: buffer-too-small ;
  11
  12 ! Call this before any other function, may be called multiple times.
  13 : sodium-init ( -- ) sodium_init 0 < [ sodium-init-fail ] when ;
  14
  15 <PRIVATE
  16
  17 : cipher-buf ( message-length n -- byte-array )
  18     + <byte-array> ;
  19
  20 : message-buf ( cipher-length n -- byte-array )
  21     - <byte-array> ;
  22
  23 : secretbox-cipher-buf ( message-length -- byte-array )
  24     crypto_secretbox_macbytes cipher-buf ;
  25
  26 : secretbox-message-buf ( cipher-length -- byte-array )
  27     crypto_secretbox_macbytes message-buf ;
  28
  29 : box-cipher-buf ( message-length -- byte-array )
  30     crypto_box_macbytes cipher-buf ;
  31
  32 : box-message-buf ( cipher-length -- byte-array )
  33     crypto_box_macbytes message-buf ;
  34
  35 PRIVATE>
  36
  37 : random-bytes ( byte-array -- byte-array' )
  38     dup dup length randombytes_buf ;
  39
  40 : n-random-bytes ( n -- byte-array )
  41     <byte-array> random-bytes ;
  42
  43 : check0 ( n -- ) 0 = [ call-fail ] unless ;
  44
  45 ERROR: sodium-malloc-error ;
  46
  47 : check-malloc ( ptr -- ptr/* )
  48     dup [ sodium-malloc-error ] unless ;
  49
  50 : sodium-malloc ( size -- ptr )
  51     sodium_malloc check-malloc ;
  52
  53 : crypto-pwhash-str ( password opslimit memlimit -- str )
  54     [ crypto_pwhash_strbytes <byte-array> dup ] 3dip
  55     [ utf8 encode dup length ] 2dip crypto_pwhash_str check0
  56     utf8 decode ;
  57
  58 : crypto-pwhash-str-verify ( str password -- ? )
  59     [ utf8 encode ] bi@ dup length crypto_pwhash_str_verify 0 = ;
  60
  61 : crypto-generichash ( out-bytes in-bytes key-bytes/f -- out-bytes' )
  62     [ dup ] 2dip [ dup length ] tri@ crypto_generichash check0 ;
  63
  64 : check-length ( byte-array min-length -- byte-array )
  65     [ dup length ] dip < [ buffer-too-small ] when ;
  66
  67 : crypto-secretbox-easy ( msg-bytes nonce-bytes key-bytes -- cipher-bytes )
  68     [ dup length [ secretbox-cipher-buf swap dupd ] keep ]
  69     [ crypto_secretbox_noncebytes check-length ]
  70     [ crypto_secretbox_keybytes check-length ] tri*
  71     crypto_secretbox_easy check0 ;
  72
  73 : crypto-secretbox-open-easy ( cipher-bytes nonce-bytes key-bytes -- msg-bytes/f )
  74     [
  75         crypto_secretbox_macbytes check-length
  76         dup length [ secretbox-message-buf swap dupd ] keep
  77     ]
  78     [ crypto_secretbox_noncebytes check-length ]
  79     [ crypto_secretbox_keybytes check-length ] tri*
  80     crypto_secretbox_open_easy 0 = [ drop f ] unless ;
  81
  82 : crypto-box-keypair ( -- public-key secret-key )
  83     crypto_box_publickeybytes <byte-array>
  84     crypto_box_secretkeybytes <byte-array>
  85     2dup crypto_box_keypair check0 ;
  86
  87 : crypto-sign-keypair ( -- public-key secret-key )
  88     crypto_sign_publickeybytes <byte-array>
  89     crypto_sign_secretkeybytes <byte-array>
  90     2dup crypto_sign_keypair check0 ;
  91
  92 : crypto-sign ( message secret-key -- signature )
  93     [ crypto_sign_bytes <byte-array> dup f ] 2dip
  94     [ dup length ] dip crypto_sign_detached check0 ;
  95
  96 : crypto-sign-verify ( signature message public-key -- ? )
  97     [ dup length ] dip crypto_sign_verify_detached 0 = ;
  98
  99 : crypto-box-nonce ( -- nonce-bytes )
 100     crypto_box_noncebytes n-random-bytes ;
 101
 102 : crypto-box-easy ( message nonce public-key private-key -- cipher-bytes )
 103     [
 104         dup length [ box-cipher-buf dup rot ] keep
 105     ] 3dip crypto_box_easy check0 ;
 106
 107 : crypto-box-open-easy ( cipher-bytes nonce public-key private-key -- message )
 108     [
 109         dup length [ box-message-buf dup rot ] keep
 110     ] 3dip crypto_box_open_easy check0 ;
 111
 112 :: sodium-base64>bin ( string -- byte-array )
 113     string length dup <byte-array> dup :> bin swap
 114     string ascii encode dup length f 0 size_t <ref> dup :> bin-length f
 115     sodium_base64_VARIANT_URLSAFE_NO_PADDING sodium_base642bin check0
 116     bin bin-length size_t deref head ;
 117
 118 : (base64-buffer) ( bin -- len byte-array )
 119     length sodium_base64_VARIANT_URLSAFE_NO_PADDING sodium_base64_encoded_len
 120     dup <byte-array> ;
 121
 122 :: sodium-bin>base64 ( byte-array -- string )
 123     byte-array (base64-buffer) dup :> b64 swap
 124     byte-array dup length sodium_base64_VARIANT_URLSAFE_NO_PADDING
 125     sodium_bin2base64 0 = [ call-fail ] when b64 ascii decode unclip-last
 126     CHAR: \0 = [ call-fail ] unless ;
 127
 128 STARTUP-HOOK: sodium-init