module Cryptography.WringTwistree.Permute
  ( permut8
  , permute256
  ) 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. permSbox takes a sequence of 96 Word16 (the high
 - bit is ignored) and returns a permutation of [0x00..0xff], which is
 - one of the three s-boxes.
 -}

import Data.Bits
import Data.Array.Unboxed
import Data.Word
import qualified Data.Sequence as Seq
import Data.Sequence ((><), (<|), (|>), Seq((:<|)), Seq((:|>)), update)

swapOrder :: Word16 -> [Int]
swapOrder :: Word16 -> [Int]
swapOrder Word16
n = (Word16 -> Int) -> [Word16] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word16
x2,Word16
x3,Word16
x4,Word16
x5,Word16
x6,Word16
x7,Word16
x8] where
  x2 :: Word16
x2 = Word16
n Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
1
  x4 :: Word16
x4 = (Word16
n Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`div` Word16
2) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
3
  x8 :: Word16
x8 = (Word16
n Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`div` Word16
8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
7
  x18 :: Word16
x18 = (Word16
n Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`div` Word16
64) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
15 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1
  x3 :: Word16
x3 = Word16
x18 Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`mod` Word16
3
  x6 :: Word16
x6 = Word16
x18 Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`div` Word16
3
  x35' :: Word16
x35' = (Word16
n Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`div` Word16
1024) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
31 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1
  x35 :: Word16
x35 = if Word16
x35' Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
16 then Word16
x35' Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1 else Word16
x35'
  x5 :: Word16
x5 = Word16
x35 Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`mod` Word16
5
  x7 :: Word16
x7 = Word16
x35 Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`div` Word16
5

swapmute :: Seq.Seq a -> [Int] -> Int -> Seq.Seq a
swapmute :: forall a. Seq a -> [Int] -> Int -> Seq a
swapmute Seq a
ys [] Int
_ = Seq a
ys
swapmute Seq a
ys (Int
x:[Int]
xs) Int
n = Seq a -> [Int] -> Int -> Seq a
forall a. Seq a -> [Int] -> Int -> Seq a
swapmute Seq a
ys' [Int]
xs (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) where
  b :: a
b = Seq a -> Int -> a
forall a. Seq a -> Int -> a
Seq.index Seq a
ys Int
x
  c :: a
c = Seq a -> Int -> a
forall a. Seq a -> Int -> a
Seq.index Seq a
ys Int
n
  ys' :: Seq a
ys' = Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
update Int
x a
c (Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
update Int
n a
b Seq a
ys)

-- | Permutes a `Seq` of eight bytes. Exported for testing.
permut8 :: Seq.Seq a -> Word16 -> Seq.Seq a
permut8 :: forall a. Seq a -> Word16 -> Seq a
permut8 Seq a
ys Word16
n = Seq a -> [Int] -> Int -> Seq a
forall a. Seq a -> [Int] -> Int -> Seq a
swapmute Seq a
ys (Word16 -> [Int]
swapOrder Word16
n) Int
1

permut8x32 :: Seq.Seq Word16 -> Seq.Seq a -> Seq.Seq a
permut8x32 :: forall a. Seq Word16 -> Seq a -> Seq a
permut8x32 Seq Word16
_ Seq a
Seq.Empty = Seq a
forall a. Seq a
Seq.Empty
permut8x32 Seq Word16
Seq.Empty Seq a
sbox = Seq a
sbox -- this should never happen
permut8x32 Seq Word16
key Seq a
sbox = Seq a
permHead Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
permTail where
  permHead :: Seq a
permHead = Seq a -> Word16 -> Seq a
forall a. Seq a -> Word16 -> Seq a
permut8 (Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.take Int
8 Seq a
sbox) (Seq Word16 -> Int -> Word16
forall a. Seq a -> Int -> a
Seq.index Seq Word16
key Int
0)
  permTail :: Seq a
permTail = Seq Word16 -> Seq a -> Seq a
forall a. Seq Word16 -> Seq a -> Seq a
permut8x32 (Int -> Seq Word16 -> Seq Word16
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq Word16
key) (Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.drop Int
8 Seq a
sbox)

-- polynomial 100011101, 3 bit overflow table
shift3 :: UArray Int Int
shift3    = (Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
7) [Int
0x00,Int
0x1d,Int
0x3a,Int
0x27,Int
0x74,Int
0x69,Int
0x4e,Int
0x53] :: UArray Int Int
invShift3 :: UArray Int Int
invShift3 = (Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
7) [Int
0x00,Int
0xad,Int
0x47,Int
0xea,Int
0x8e,Int
0x23,Int
0xc9,Int
0x64] :: UArray Int Int

dealInx :: Int -> Int
dealInx :: Int -> Int
dealInx Int
n = ((Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
.<<. Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` (UArray Int Int
shift3 UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! ((Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xe0) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
.>>. Int
5))

invDealInx :: Int -> Int
invDealInx :: Int -> Int
invDealInx Int
n = ((Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xf8) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
.>>. Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` (UArray Int Int
invShift3 UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x07))

dealBytes :: Seq.Seq a -> Seq.Seq a -- must be 256 long
dealBytes :: forall a. Seq a -> Seq a
dealBytes Seq a
bs = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> [a] -> Seq a
forall a b. (a -> b) -> a -> b
$ (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Seq a -> Int -> a
forall a. Seq a -> Int -> a
Seq.index Seq a
bs) ([Int] -> [a]) -> [Int] -> [a]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
invDealInx [Int
0..Int
255]

permute256 :: Seq.Seq Word16 -> Seq.Seq Word8
permute256 :: Seq Word16 -> Seq Word8
permute256 Seq Word16
k = Seq Word8 -> Seq Word8
forall a. Seq a -> Seq a
dealBytes (Seq Word8 -> Seq Word8) -> Seq Word8 -> Seq Word8
forall a b. (a -> b) -> a -> b
$ Seq Word16 -> Seq Word8 -> Seq Word8
forall a. Seq Word16 -> Seq a -> Seq a
permut8x32 Seq Word16
k2 (Seq Word8 -> Seq Word8) -> Seq Word8 -> Seq Word8
forall a b. (a -> b) -> a -> b
$ Seq Word8 -> Seq Word8
forall a. Seq a -> Seq a
dealBytes (Seq Word8 -> Seq Word8) -> Seq Word8 -> Seq Word8
forall a b. (a -> b) -> a -> b
$ Seq Word16 -> Seq Word8 -> Seq Word8
forall a. Seq Word16 -> Seq a -> Seq a
permut8x32 Seq Word16
k1 (Seq Word8 -> Seq Word8) -> Seq Word8 -> Seq Word8
forall a b. (a -> b) -> a -> b
$
               Seq Word8 -> Seq Word8
forall a. Seq a -> Seq a
dealBytes (Seq Word8 -> Seq Word8) -> Seq Word8 -> Seq Word8
forall a b. (a -> b) -> a -> b
$ Seq Word16 -> Seq Word8 -> Seq Word8
forall a. Seq Word16 -> Seq a -> Seq a
permut8x32 Seq Word16
k0 (Seq Word8 -> Seq Word8) -> Seq Word8 -> Seq Word8
forall a b. (a -> b) -> a -> b
$ [Word8] -> Seq Word8
forall a. [a] -> Seq a
Seq.fromList [Word8
0..Word8
255] where
  k012 :: Seq (Seq Word16)
k012 = Int -> Seq Word16 -> Seq (Seq Word16)
forall a. Int -> Seq a -> Seq (Seq a)
Seq.chunksOf Int
32 Seq Word16
k
  k0 :: Seq Word16
k0 = Seq (Seq Word16) -> Int -> Seq Word16
forall a. Seq a -> Int -> a
Seq.index Seq (Seq Word16)
k012 Int
0
  k1 :: Seq Word16
k1 = Seq (Seq Word16) -> Int -> Seq Word16
forall a. Seq a -> Int -> a
Seq.index Seq (Seq Word16)
k012 Int
1
  k2 :: Seq Word16
k2 = Seq (Seq Word16) -> Int -> Seq Word16
forall a. Seq a -> Int -> a
Seq.index Seq (Seq Word16)
k012 Int
2