sha1.mpl

# Copyright (C) Matway Burkow
#
# This repository and all its contents belong to Matway Burkow (referred here and below as "the owner").
# The content is for demonstration purposes only.
# It is forbidden to use the content or any part of it for any purpose without explicit permission from the owner.
# By contributing to the repository, contributors acknowledge that ownership of their work transfers to the owner.

"Span.toSpan"      use
"algorithm.unhead" use
"control.@"        use
"control.Int32"    use
"control.Nat32"    use
"control.Nat64"    use
"control.Nat8"     use
"control.Natx"     use
"control.drop"     use
"control.dup"      use
"control.min"      use
"control.times"    use
"control.when"     use
"control.while"    use
"memory.memcpy"    use
"memory.memset"    use

ShaCounter: [{
  state: (0x67452301n32 0xEFCDAB89n32 0x98BADCFEn32 0x10325476n32 0xC3D2E1F0n32);
  buffer: Nat8 64 array;
  bufferProcessed: 0;
  bitSize: Nat64;

  append: [
    source: toSpan;
    source.size Nat64 cast 8n64 * bitSize + !bitSize
    [
      sz: 64 bufferProcessed - source.size min;
      sz Natx cast
      source.data storageAddress
      buffer storageAddress bufferProcessed Natx cast + memcpy drop
      @source sz unhead !source
      bufferProcessed sz + !bufferProcessed

      bufferProcessed 64 = dup [
        @state buffer Sha1Internal.transform
        0 !bufferProcessed
      ] when
    ] loop
  ];

  finish: [bufferProcessed bitSize @buffer @state Sha1Internal.finish];
}];

sha1: [
  source: toSpan;
  state: (0x67452301n32 0xEFCDAB89n32 0x98BADCFEn32 0x10325476n32 0xC3D2E1F0n32);
  bitSize: source.size Nat64 cast 3n32 lshift;
  [source.size 64 < ~] [
    @state source Sha1Internal.transform
    @source 64 unhead !source
  ] while

  buffer: Nat8 64 array;
  count: source.size;

  count Natx cast
  source.data storageAddress
  buffer storageAddress memcpy drop

  count bitSize @buffer @state Sha1Internal.finish
];

Sha1Internal: {
  rol: [
    value: count:;;
    value count lshift
    value 32n32 count - rshift
    or
  ];

  f1: [
    x: y: z:;;;
    y z xor x and z xor 0x5A827999n32 +
  ];

  f2: [
    x: y: z:;;;
    x y xor z xor 0x6ED9EBA1n32 +
  ];

  f3: [
    x: y: z:;;;
    x y and
    x y or z and or 0x8F1BBCDCn32 +
  ];

  f4: [
    x: y: z:;;;
    x y xor z xor 0xCA62C1D6n32 +
  ];

  m: [
    x: i:;;
    b: i 0x0Fn32 and Int32 cast @x @;

    b
    i 2n32 + 0x0Fn32 and Int32 cast x @ xor
    i 8n32 + 0x0Fn32 and Int32 cast x @ xor
    i 13n32 + 0x0Fn32 and Int32 cast x @ xor 1n32 rol @b set
    b new
  ];

  r: [
    a: b: c: d: e: f: m:;;;;;;;
    a 5n32 rol b c d @f call + m + e + @e set
    b 30n32 rol @b set
  ];

  finish: [
    count: bitSize: buffer: state:;;; new;

    0x80n8 count @buffer @ set
    count 1 + !count
    count 56 > [
      64 count - Natx cast
      0
      buffer storageAddress count Natx cast + memset drop
      @state buffer Sha1Internal.transform
      0 !count
    ] when

    56 count - Natx cast
    0
    buffer storageAddress count Natx cast + memset drop

    bitSize 56n32 rshift Nat8 cast 56 @buffer !
    bitSize 48n32 rshift Nat8 cast 57 @buffer !
    bitSize 40n32 rshift Nat8 cast 58 @buffer !
    bitSize 32n32 rshift Nat8 cast 59 @buffer !
    bitSize 24n32 rshift Nat8 cast 60 @buffer !
    bitSize 16n32 rshift Nat8 cast 61 @buffer !
    bitSize  8n32 rshift Nat8 cast 62 @buffer !
    bitSize              Nat8 cast 63 @buffer !

    @state buffer Sha1Internal.transform

    result: 0n8 20 array;
    5 [
      i state @ 24n32 rshift Nat8 cast i 4 * 0 + @result !
      i state @ 16n32 rshift Nat8 cast i 4 * 1 + @result !
      i state @  8n32 rshift Nat8 cast i 4 * 2 + @result !
      i state @              Nat8 cast i 4 * 3 + @result !
    ] times

    @result
  ];

  transform: [
    state: buf:;;
    x: Nat32 16 array;
    16 [
      i 4 * 0 + buf @ Nat32 cast 24n32 lshift
      i 4 * 1 + buf @ Nat32 cast 16n32 lshift or
      i 4 * 2 + buf @ Nat32 cast  8n32 lshift or
      i 4 * 3 + buf @ Nat32 cast              or
      i @x !
    ] times

    a: 0 state @ new;
    b: 1 state @ new;
    c: 2 state @ new;
    d: 3 state @ new;
    e: 4 state @ new;

    a @b c d @e @f1  0 x @ r
    e @a b c @d @f1  1 x @ r
    d @e a b @c @f1  2 x @ r
    c @d e a @b @f1  3 x @ r
    b @c d e @a @f1  4 x @ r
    a @b c d @e @f1  5 x @ r
    e @a b c @d @f1  6 x @ r
    d @e a b @c @f1  7 x @ r
    c @d e a @b @f1  8 x @ r
    b @c d e @a @f1  9 x @ r
    a @b c d @e @f1 10 x @ r
    e @a b c @d @f1 11 x @ r
    d @e a b @c @f1 12 x @ r
    c @d e a @b @f1 13 x @ r
    b @c d e @a @f1 14 x @ r
    a @b c d @e @f1 15 x @ r

    e @a b c @d @f1 @x 16n32 m r
    d @e a b @c @f1 @x 17n32 m r
    c @d e a @b @f1 @x 18n32 m r
    b @c d e @a @f1 @x 19n32 m r
    a @b c d @e @f2 @x 20n32 m r
    e @a b c @d @f2 @x 21n32 m r
    d @e a b @c @f2 @x 22n32 m r
    c @d e a @b @f2 @x 23n32 m r
    b @c d e @a @f2 @x 24n32 m r
    a @b c d @e @f2 @x 25n32 m r
    e @a b c @d @f2 @x 26n32 m r
    d @e a b @c @f2 @x 27n32 m r
    c @d e a @b @f2 @x 28n32 m r
    b @c d e @a @f2 @x 29n32 m r
    a @b c d @e @f2 @x 30n32 m r
    e @a b c @d @f2 @x 31n32 m r
    d @e a b @c @f2 @x 32n32 m r
    c @d e a @b @f2 @x 33n32 m r
    b @c d e @a @f2 @x 34n32 m r
    a @b c d @e @f2 @x 35n32 m r
    e @a b c @d @f2 @x 36n32 m r
    d @e a b @c @f2 @x 37n32 m r
    c @d e a @b @f2 @x 38n32 m r
    b @c d e @a @f2 @x 39n32 m r
    a @b c d @e @f3 @x 40n32 m r
    e @a b c @d @f3 @x 41n32 m r
    d @e a b @c @f3 @x 42n32 m r
    c @d e a @b @f3 @x 43n32 m r
    b @c d e @a @f3 @x 44n32 m r
    a @b c d @e @f3 @x 45n32 m r
    e @a b c @d @f3 @x 46n32 m r
    d @e a b @c @f3 @x 47n32 m r
    c @d e a @b @f3 @x 48n32 m r
    b @c d e @a @f3 @x 49n32 m r
    a @b c d @e @f3 @x 50n32 m r
    e @a b c @d @f3 @x 51n32 m r
    d @e a b @c @f3 @x 52n32 m r
    c @d e a @b @f3 @x 53n32 m r
    b @c d e @a @f3 @x 54n32 m r
    a @b c d @e @f3 @x 55n32 m r
    e @a b c @d @f3 @x 56n32 m r
    d @e a b @c @f3 @x 57n32 m r
    c @d e a @b @f3 @x 58n32 m r
    b @c d e @a @f3 @x 59n32 m r
    a @b c d @e @f4 @x 60n32 m r
    e @a b c @d @f4 @x 61n32 m r
    d @e a b @c @f4 @x 62n32 m r
    c @d e a @b @f4 @x 63n32 m r
    b @c d e @a @f4 @x 64n32 m r
    a @b c d @e @f4 @x 65n32 m r
    e @a b c @d @f4 @x 66n32 m r
    d @e a b @c @f4 @x 67n32 m r
    c @d e a @b @f4 @x 68n32 m r
    b @c d e @a @f4 @x 69n32 m r
    a @b c d @e @f4 @x 70n32 m r
    e @a b c @d @f4 @x 71n32 m r
    d @e a b @c @f4 @x 72n32 m r
    c @d e a @b @f4 @x 73n32 m r
    b @c d e @a @f4 @x 74n32 m r
    a @b c d @e @f4 @x 75n32 m r
    e @a b c @d @f4 @x 76n32 m r
    d @e a b @c @f4 @x 77n32 m r
    c @d e a @b @f4 @x 78n32 m r
    b @c d e @a @f4 @x 79n32 m r
    a 0 state @ + 0 @state !
    b 1 state @ + 1 @state !
    c 2 state @ + 2 @state !
    d 3 state @ + 3 @state !
    e 4 state @ + 4 @state !
  ];
};