module Cryptography.WringTwistree.Sboxes
  ( SBox
  , permut8 -- reexported for testing
  , mul65537 -- "
  , sboxInx
  , cycle3
  , sboxes
  , invert
  , linearSbox
  , linearInvSbox
  , sameBitcount
  ) where

{- This module is used in both Wring and Twistree.
 - It is part of the keying algorithm, which turns a byte string
 - into three s-boxes. It takes a ByteString and returns a 3×256
 - array of bytes.
 -
 - To convert a String to a ByteString, put "- utf8-string" in your
 - package.yaml dependencies, import Data.ByteString.UTF8, and use
 - fromString.
 -}

import Data.Bits
import Data.Word
import Data.Foldable (toList)
import qualified Data.ByteString as B
import Cryptography.WringTwistree.Permute
import Cryptography.WringTwistree.KeySchedule
import qualified Data.Vector.Unboxed as V

-- | Three 8×8 S-boxes used alternatively to substitute bytes
type SBox = V.Vector Word8

{-# SPECIALIZE sboxInx :: Word8 -> Word8 -> Int #-}
{-# SPECIALIZE sboxInx :: Int -> Word8 -> Int #-}
sboxInx :: (Integral a,Integral b) => a -> b -> Int
sboxInx :: forall a b. (Integral a, Integral b) => a -> b -> Int
sboxInx a
whichBox b
n = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
whichBoxInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n

cycle3 :: [Word8]
cycle3 :: [Word8]
cycle3 = Word8
0 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Word8
1 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Word8
2 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
cycle3

-- | Computes S-boxes from a key. Exported for cryptanalysis.
sboxes :: B.ByteString -> SBox
sboxes :: ByteString -> SBox
sboxes ByteString
key = Int -> [Word8] -> SBox
forall a. Unbox a => Int -> [a] -> Vector a
V.fromListN (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
256) ([Word8]
box0 [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8]
box1 [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8]
box2) where
  box0seq :: Seq Word16
box0seq = ByteString -> Seq Word16
keySchedule ByteString
key
  box1seq :: Seq Word16
box1seq = Seq Word16 -> Seq Word16
reschedule Seq Word16
box0seq
  box2seq :: Seq Word16
box2seq = Seq Word16 -> Seq Word16
reschedule Seq Word16
box1seq
  box0 :: [Word8]
box0 = Seq Word8 -> [Word8]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Word16 -> Seq Word8
permute256 Seq Word16
box0seq)
  box1 :: [Word8]
box1 = Seq Word8 -> [Word8]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Word16 -> Seq Word8
permute256 Seq Word16
box1seq)
  box2 :: [Word8]
box2 = Seq Word8 -> [Word8]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Word16 -> Seq Word8
permute256 Seq Word16
box2seq)

invert :: SBox -> SBox
invert :: SBox -> SBox
invert SBox
sbox = Int -> Word8 -> SBox
forall a. Unbox a => Int -> a -> Vector a
V.replicate (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
256) Word8
0 SBox -> [(Int, Word8)] -> SBox
forall a. Unbox a => Vector a -> [(Int, a)] -> Vector a
V.//
  [(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SBox
sbox SBox -> Int -> Word8
forall a. Unbox a => Vector a -> Int -> a
V.! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j)), Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j) | Int
i <- [Int
0..Int
2], Int
j <- [Int
0..Int
255]]

-- | A linear `SBox` used for cryptanalysis
linearSbox, linearInvSbox :: SBox
linearSbox :: SBox
linearSbox = Int -> [Word8] -> SBox
forall a. Unbox a => Int -> [a] -> Vector a
V.fromListN (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
256)
  [ Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
rotate Word8
j (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)) | Integer
i <- [Integer
0..Integer
2], Word8
j <- [Word8
0..Word8
255] ]

linearInvSbox :: SBox
linearInvSbox = Int -> [Word8] -> SBox
forall a. Unbox a => Int -> [a] -> Vector a
V.fromListN (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
256)
  [ (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
rotate Word8
j (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
7Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
i))) | Integer
i <- [Integer
0..Integer
2], Word8
j <- [Word8
0..Word8
255] ]

sameBitcount1 :: SBox -> Word8 -> Bool
sameBitcount1 :: SBox -> Word8 -> Bool
sameBitcount1 SBox
sbox Word8
n =
  Word8 -> Int
forall a. Bits a => a -> Int
popCount (SBox
sbox SBox -> Int -> Word8
forall a. Unbox a => Vector a -> Int -> a
V.! (Integer -> Word8 -> Int
forall a b. (Integral a, Integral b) => a -> b -> Int
sboxInx Integer
0 Word8
n)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> Int
forall a. Bits a => a -> Int
popCount (SBox
sbox SBox -> Int -> Word8
forall a. Unbox a => Vector a -> Int -> a
V.! (Integer -> Word8 -> Int
forall a b. (Integral a, Integral b) => a -> b -> Int
sboxInx Integer
1 Word8
n)) Bool -> Bool -> Bool
&&
  Word8 -> Int
forall a. Bits a => a -> Int
popCount (SBox
sbox SBox -> Int -> Word8
forall a. Unbox a => Vector a -> Int -> a
V.! (Integer -> Word8 -> Int
forall a b. (Integral a, Integral b) => a -> b -> Int
sboxInx Integer
1 Word8
n)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> Int
forall a. Bits a => a -> Int
popCount (SBox
sbox SBox -> Int -> Word8
forall a. Unbox a => Vector a -> Int -> a
V.! (Integer -> Word8 -> Int
forall a b. (Integral a, Integral b) => a -> b -> Int
sboxInx Integer
2 Word8
n))

-- | Returns a list of the bytes which, when looked up in the S-boxes,
-- give three bytes (which may be the same) with the same bitcount.
-- For cryptanalysis of the hash function.
sameBitcount :: SBox -> [Word8]
sameBitcount :: SBox -> [Word8]
sameBitcount SBox
sbox = [Word8
x | Word8
x <- [Word8
0..Word8
255], SBox -> Word8 -> Bool
sameBitcount1 SBox
sbox Word8
x]