Local Open Scope logic.
Definition CoreInSEP (data : SixteenByte * SixteenByte * (SixteenByte * SixteenByte))
(v: val * val * val) : mpred :=
match data with (Nonce, C, K) =>
match v with (n, c, k) =>
(SByte Nonce n) * (SByte C c) * (ThirtyTwoByte K k)
end end.
Definition prepare_data
(data : SixteenByte * SixteenByte * (SixteenByte * SixteenByte)) :=
match data with ((Nonce, C), K) =>
match Nonce with (N1, N2, N3, N4) =>
match C with (C1, C2, C3, C4) =>
match K with ((K1, K2, K3, K4), (L1, L2, L3, L4)) =>
map littleendian [C1; K1; K2; K3; K4; C2; N1; N2; N3; N4; C3; L1; L2; L3; L4; C4]
end end end
end.
Definition sumlist := combinelist _ Int.add.
Definition sumlist_Some:= combinelist _ Int.add.
Definition sumlist_SomeInv:= combinelist_SomeInv _ Int.add.
Definition sumlist_length:= combinelist_length _ Int.add.
Definition sumlist_symm:= combinelist_symm _ Int.add Int.add_commut.
Definition sumlist_char_nth:= combinelist_char_nth _ Int.add.
Definition sumlist_char_Znth:= combinelist_char_Znth _ Int.add.
Definition Snuffle20 x := bind (Snuffle 20 x) (fun y => sumlist y x).
Definition fcore_result h data l :=
match Snuffle20 (prepare_data data)
with None => False
| Some x =>
if Int.eq (Int.repr h) Int.zero
then l=QuadChunks2ValList (map littleendian_invert x)
else match data with ((Nonce, C), K) =>
match Nonce with (N1, N2, N3, N4) =>
match C with (C1, C2, C3, C4) =>
l = QuadByte2ValList (littleendian_invert (Int.sub (Znth 0 x)  (littleendian C1))) ++
QuadByte2ValList (littleendian_invert (Int.sub (Znth 5 x)  (littleendian C2))) ++
QuadByte2ValList (littleendian_invert (Int.sub (Znth 10 x) (littleendian C3))) ++
QuadByte2ValList (littleendian_invert (Int.sub (Znth 15 x) (littleendian C4))) ++
QuadByte2ValList (littleendian_invert (Int.sub (Znth 6 x)  (littleendian N1))) ++
QuadByte2ValList (littleendian_invert (Int.sub (Znth 7 x)  (littleendian N2))) ++
QuadByte2ValList (littleendian_invert (Int.sub (Znth 8 x)  (littleendian N3))) ++
QuadByte2ValList (littleendian_invert (Int.sub (Znth 9 x)  (littleendian N4)))
end end end
end.
Definition OutLen h := if Int.eq (Int.repr h) Int.zero then 64 else 32.
Definition fcorePOST_SEP h data d l out :=
CoreInSEP data d *
data_at Tsh (tarray tuchar (OutLen h)) l out.
Definition f_core_POST d out h (data: SixteenByte * SixteenByte * (SixteenByte * SixteenByte) ) :=
EX l:_,
PROP (fcore_result h data l)
LOCAL ()
SEP (fcorePOST_SEP h data d l out).
Definition core_spec :=
DECLARE _core
WITH c : val, k:val, h:Z,
nonce:val, out:val, OUT:list val,
data : SixteenByte * SixteenByte * (SixteenByte * SixteenByte)
PRE [ _out OF tptr tuchar,
_in OF tptr tuchar,
_k OF tptr tuchar,
_c OF tptr tuchar,
_h OF tint ]
PROP ()
LOCAL (temp _in nonce; temp _out out;
temp _c c; temp _k k; temp _h (Vint (Int.repr h)))
SEP (CoreInSEP data (nonce, c, k);
data_at Tsh (tarray tuchar (OutLen h)) OUT out)
POST [ tvoid ] (f_core_POST (nonce, c, k) out h data).
Definition ld32_spec :=
DECLARE _ld32
WITH x : val, B:QuadByte
PRE [ _x OF tptr tuchar ]
PROP ()
LOCAL (temp _x x)
SEP (data_at Tsh (tarray tuchar 4) (QuadByte2ValList B) x)
POST [ tuint ]
PROP ()
LOCAL (temp ret_temp (Vint (littleendian B)))
SEP (QByte B x).
Definition st32_spec :=
DECLARE _st32
WITH x : val, u:int
PRE [ _x OF tptr tuchar, _u OF tuint ]
PROP ()
LOCAL (temp _x x; temp _u (Vint u))
SEP (data_at_ Tsh (tarray tuchar 4) x)
POST [ tvoid ]
PROP ()
LOCAL ()
SEP (QByte (littleendian_invert u) x).
Definition L32_spec :=
DECLARE _L32
WITH x : int, c: int
PRE [ _x OF tuint, _c OF tint ]
PROP (0 < Int.signed c < 32) (*yes, c=Int.zero needs to be ruled out - it leads to undefined behaviour in the shift-right operation*)
LOCAL (temp _x (Vint x); temp _c (Vint c))
SEP ()
POST [ tuint ]
PROP ()
LOCAL (temp ret_temp (Vint (Int.rol x c)))
SEP ().
Definition bigendian64 (b c:QuadByte): int64 :=
match b, c with (b0, b1, b2, b3), (c0, c1, c2, c3) =>
Int64.repr
(       Byte.unsigned c3 +
2^8  * Byte.unsigned c2 +
2^16 * Byte.unsigned c1 +
2^24 * Byte.unsigned c0 +
2^32 * Byte.unsigned b3 +
2^40 * Byte.unsigned b2 +
2^48 * Byte.unsigned b1 +
2^56 * Byte.unsigned b0
)
end.
Definition dl64_spec :=
DECLARE _dl64
WITH x : val, B:QuadByte, C: QuadByte
PRE [ _x OF tptr tuchar ]
PROP ()
LOCAL (temp _x x)
SEP (data_at Tsh (tarray tuchar 8) (QuadByte2ValList B++QuadByte2ValList C) x)
POST [ tulong ]
PROP ()
LOCAL (temp ret_temp (Vlong (bigendian64 B C)))
SEP (data_at Tsh (tarray tuchar 8) (QuadByte2ValList B++QuadByte2ValList C) x).
Definition bigendian64_invert (w:int64) : QuadByte * QuadByte:=
let w3 := Int64.unsigned w in
let b3 := w3 / (2^56) in
let w2 := Z.modulo w3 (2^56) in
let b2 := w2 / (2^48) in
let w1 := Z.modulo w2 (2^48) in
let b1 := w1 / (2^40) in
let w0 := Z.modulo w1 (2^40) in
let b0 := w0 / (2^32) in
let u3 := Z.modulo w0 (2^32) in
let c3 := u3 / (2^24) in
let u2 := Z.modulo u3 (2^24) in
let c2 := u2 / (2^16) in
let u1 := Z.modulo u2 (2^16) in
let c1 := u1 / (2^8) in
let c0 := Z.modulo u1 (2^8) in
((Byte.repr b3, Byte.repr b2, Byte.repr b1, Byte.repr b0),
(Byte.repr c3, Byte.repr c2, Byte.repr c1, Byte.repr c0)).
Definition ts64_spec :=
DECLARE _ts64
WITH x : val, u:int64
PRE [ _x OF tptr tuchar, _u OF tulong ]
PROP ()
LOCAL (temp _x x; temp _u (Vlong u))
SEP (data_at_ Tsh (tarray tuchar 8) x)
POST [ tvoid ]
PROP ()
LOCAL ()
SEP (let (B, C) := bigendian64_invert u in
data_at Tsh (tarray tuchar 8) (QuadByte2ValList B++QuadByte2ValList C) x).
Definition crypto_core_salsa20_spec :=
DECLARE _crypto_core_salsa20_tweet
WITH c : val, k:val,
nonce:val, out:val,
data : SixteenByte * SixteenByte * (SixteenByte * SixteenByte)
PRE [ _out OF tptr tuchar,
_in OF tptr tuchar,
_k OF tptr tuchar,
_c OF tptr tuchar ]
PROP ()
LOCAL (temp _in nonce; temp _out out;
temp _c c; temp _k k)
SEP ( CoreInSEP data (nonce, c, k);
data_at_ Tsh (tarray tuchar 64) out)
POST [ tint ]
EX res:_,
PROP (Snuffle20 (prepare_data data) = Some res)
LOCAL (temp ret_temp (Vint (Int.repr 0)))
SEP (CoreInSEP data (nonce, c, k);
data_at Tsh (tarray tuchar 64) (QuadChunks2ValList (map littleendian_invert res)) out).
Definition hSalsaOut x :=
QuadByte2ValList (littleendian_invert (Znth 0  x)) ++
QuadByte2ValList (littleendian_invert (Znth 5  x)) ++
QuadByte2ValList (littleendian_invert (Znth 10 x)) ++
QuadByte2ValList (littleendian_invert (Znth 15 x)) ++
QuadByte2ValList (littleendian_invert (Znth 6  x)) ++
QuadByte2ValList (littleendian_invert (Znth 7  x)) ++
QuadByte2ValList (littleendian_invert (Znth 8  x)) ++
QuadByte2ValList (littleendian_invert (Znth 9  x)).
Definition crypto_core_hsalsa20_spec :=
DECLARE _crypto_core_hsalsa20_tweet
WITH c : val, k:val,
nonce:val, out:val, OUT: list val,
data : SixteenByte * SixteenByte * (SixteenByte * SixteenByte)
PRE [ _out OF tptr tuchar,
_in OF tptr tuchar,
_k OF tptr tuchar,
_c OF tptr tuchar ]
PROP ()
LOCAL (temp _in nonce; temp _out out;
temp _c c; temp _k k)
SEP (CoreInSEP data (nonce, c, k);
data_at Tsh (tarray tuchar 32) OUT out)
POST [ tint ]
EX res:list int,
PROP (Snuffle 20 (prepare_data data) = Some res)
LOCAL (temp ret_temp (Vint (Int.repr 0)))
SEP (CoreInSEP data (nonce, c, k); data_at Tsh (tarray tuchar 32) (hSalsaOut res) out).
Parameter SIGMA: SixteenByte.
Definition Sigma_vector : val -> mpred :=
data_at Tsh (tarray tuchar 16) (SixteenByte2ValList SIGMA).
Fixpoint ZZ (zbytes: list byte) (n: nat): int * list byte :=
match n with
O => (Int.one, zbytes)
| S k => match ZZ zbytes k with (u,zb) =>
let v := (Int.unsigned u + (Byte.unsigned (Znth (Z.of_nat k+8) zb)))
in (Int.shru (Int.repr v) (Int.repr 8),
upd_Znth (Z.of_nat k+8) zb (Byte.repr (Z.modulo v 256))) end
end.
Fixpoint ZCont (r: nat) (zcont: list byte): list byte :=
match r with
O => zcont
| S n => let zb := ZCont n zcont in
let zz := ZZ zb (8:nat) in snd zz
end.
Definition bytes_at x q i mbytes :=
match x with
Vint _ => list_repeat (Z.to_nat i) (Byte.zero)
| _ => sublist q (q+i) mbytes
end.
Definition bxorlist := combinelist _ Byte.xor.
Definition Bl2VL (l: list byte) := map Vint (map Int.repr (map Byte.unsigned l)).
Definition message_at (mCont: list byte) (m:val): mpred :=
match m with
Vint i => !!(i=Int.zero) && emp
| Vptr b z => data_at Tsh (tarray tuchar (Zlength mCont)) (Bl2VL mCont) m
| _ => FF
end.
Inductive CONTENT SIGMA K (mInit:val) (mCont zbytes:list byte): nat -> list byte -> list byte -> Prop :=
CONT_zero: CONTENT SIGMA K mInit mCont  zbytes O zbytes nil
| CONT_succ: forall n zN resN ,
CONTENT SIGMA K mInit mCont zbytes n zN resN ->
forall d,
SixteenByte2ValList d = Bl2VL (ZCont n zbytes) ->
forall snuff srbytes Xor,
Snuffle20 (prepare_data (d, SIGMA, K)) = Some snuff ->
QuadChunks2ValList (map littleendian_invert snuff) =
map Vint (map Int.repr (map Byte.unsigned srbytes)) ->
bxorlist (bytes_at mInit (Z.of_nat n * 64) 64 mCont) srbytes = Some Xor ->
CONTENT SIGMA K mInit mCont zbytes (S n) (snd (ZZ zN (8:nat))) (resN++Xor).

Lemma SixteenByte2ValList_exists bytes: Zlength bytes = 16 ->
exists d, SixteenByte2ValList d = map Vint (map Int.repr (map Byte.unsigned bytes)).