WringTwistree (empty) → 0.0.1.0

raw patch · 18 files changed

+2442/−0 lines, 18 filesdep +WringTwistreedep +arithmoidep +arraysetup-changed

Dependencies added: WringTwistree, arithmoi, array, base, bytestring, containers, deepseq, mod, multiarg, parallel, sort, split, tasty, tasty-hunit, tasty-quickcheck, utf8-string, vector

Files

• CHANGELOG.md +23/−0
• LICENSE +30/−0
• README.md +38/−0
• Setup.hs +2/−0
• WringTwistree.cabal +100/−0
• app/Cryptanalysis.hs +526/−0
• app/Main.hs +222/−0
• app/Stats.hs +124/−0
• src/Cryptography/Twistree.hs +113/−0
• src/Cryptography/Wring.hs +269/−0
• src/Cryptography/WringTwistree/Blockize.hs +76/−0
• src/Cryptography/WringTwistree/Compress.hs +145/−0
• src/Cryptography/WringTwistree/KeySchedule.hs +65/−0
• src/Cryptography/WringTwistree/Mix3.hs +128/−0
• src/Cryptography/WringTwistree/Permute.hs +69/−0
• src/Cryptography/WringTwistree/RotBitcount.hs +84/−0
• src/Cryptography/WringTwistree/Sboxes.hs +74/−0
• test/Spec.hs +354/−0

@@ -0,0 +1,23 @@+# Changelog for `WringTwistree`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/) for Haskell+and [Semantic Versioning](https://semver.org/) for Rust.++## Unreleased++## 0.0.1.0 - 0.1.0 - 2024-01-03++### Added++- Keying, common to Wring and Twistree+- Whole-message cipher Wring+- Keyed hash algorithm Twistree+- Test vectors for both algorithms+- Shell script to test that both implementations give identical results+- Related-key cryptanalysis of Wring+- Integral cryptanalysis of Wring+- Restricted-byte differential cryptanalysis of Twistree

@@ -0,0 +1,30 @@+Copyright Pierre Abbat (c) 2024++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Pierre Abbat nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,38 @@+# WringTwistree+Wring is a whole-message cipher. This is like a block cipher, but the block can be arbitrarily large, up to about 3 GiB (the Rust version will start getting multiplication overflows about there). Wring can also be used as a length-preserving all-or-nothing transform.++Twistree is a hash function. It constructs two trees out of the blocks of data, runs the compression function at each node of the trees, and combines the results with the compression function.++Both algorithms are keyed. The key is turned into 96 16-bit words, which are then used to make three S-boxes. The key can be any byte string, including the empty string.++# Features+A round consists of four operations:++1. The `mix3Parts` operation splits the message or block in three equal parts and mixes them nonlinearly. This provides both diffusion and nonlinearity. The number of rounds in Wring increases logarithmically with message size so that diffusion spreads to the entire message.+2. The three key-dependent 8×8 S-boxes provide confusion and +resist linear cryptanalysis.+3. Rotating by the population count thwarts integral and differential cryptanalysis by moving the difference around to a different part of the message.+4. Wring's round constant, which is dependent on the byte position as well as the round number, is added to every byte to prevent slide attacks and ensure that an all-zero message doesn't stay that way.+4. Twistree runs a CRC backwards to make the four bytes about to be dropped affect all the other bytes.++# Rust+To run the program, type `cargo run`. The first time you run it, Cargo may download a quarter-gigabyte of data, which is the index to all crates. You can also test the program with `cargo test`.++# Haskell+You can run WringTwistree in the REPL with `stack ghci`, compile and run it with `stack run`, or use other Stack commands. You can also test the program with `stack test`.++# Command-line options+`stack run -- -k key -e plaintext -o ciphertext` enciphers a file. Omit `-o ciphertext` to encipher in place.++`stack run -- -k key -d ciphertext -o plaintext` deciphers a file. Omit `-o plaintext` to decipher in place.++`stack run -- -k key -H plaintext -o hash` hashes a file. Omit `-o hash` to output the hash to stdout.++`stack run -- -c foo` runs cryptanalysis of type `foo`, which is currently `relkey` for related-key cryptanalysis. This option is not available in the Rust implementation.++`cargo` instead of `stack` runs the Rust implementation; the options are the same, except that hash is `-h`.++The Rust binary is `wring-twistree` and can be installed with `cargo install --path .`; the Haskell binary is `WringTwistree` and can be installed with `stack install`. They take the options after `--`.++# Test vectors+Test vectors are in `test/Spec.hs` and `src/lib.rs`.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,100 @@+cabal-version: 1.18++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack++name:           WringTwistree+version:        0.0.1.0+synopsis:       Whole-message cipher and tree hash+description:    Please see the README on GitHub at <https://github.com/phma/wring-twistree#readme>+category:       Cryptography+homepage:       https://github.com/phma/wring-twistree#readme+bug-reports:    https://github.com/phma/wring-twistree/issues+author:         Pierre Abbat+maintainer:     phma@bezitopo.org+copyright:      2024 Pierre Abbat+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/phma/wring-twistree++library+  exposed-modules:+      Cryptography.Twistree+      Cryptography.Wring+  other-modules:+      Cryptography.WringTwistree.Blockize+      Cryptography.WringTwistree.Compress+      Cryptography.WringTwistree.KeySchedule+      Cryptography.WringTwistree.Mix3+      Cryptography.WringTwistree.Permute+      Cryptography.WringTwistree.RotBitcount+      Cryptography.WringTwistree.Sboxes+  hs-source-dirs:+      src+  ghc-options: -O2 -fllvm -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      arithmoi+    , array+    , base >=4.17 && <5+    , bytestring+    , containers+    , mod+    , parallel+    , split+    , utf8-string+    , vector+  default-language: Haskell2010++executable WringTwistree+  main-is: Main.hs+  other-modules:+      Cryptanalysis+      Stats+      Paths_WringTwistree+  hs-source-dirs:+      app+  ghc-options: -O2 -fllvm -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      WringTwistree+    , arithmoi+    , array+    , base >=4.17 && <5+    , bytestring+    , containers+    , deepseq+    , multiarg+    , parallel+    , sort+    , split+    , utf8-string+    , vector+  default-language: Haskell2010++test-suite WringTwistree-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_WringTwistree+  hs-source-dirs:+      test+  ghc-options: -O2 -fllvm -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      WringTwistree+    , array+    , base >=4.17 && <5+    , bytestring+    , containers+    , tasty+    , tasty-hunit+    , tasty-quickcheck+    , utf8-string+    , vector+  default-language: Haskell2010

@@ -0,0 +1,526 @@+module Cryptanalysis+  ( key96_0+  , key96_1+  , key96_2+  , key96_3+  , key30_0+  , key30_1+  , key30_2+  , key30_3+  , key6_0+  , key6_1+  , key6_2+  , key6_3+  , sbox30_3+  , sbox96_0+  , wring96_0+  , wring96_1+  , wring96_2+  , wring96_3+  , wring30_0+  , wring30_1+  , wring30_2+  , wring30_3+  , wring6_0+  , wring6_1+  , wring6_2+  , wring6_3+  , same30_3+  , same96_0+  , match+  , rot1Bit+  , bias+  , convolve+  , unbiasedConvolve+  , convolveDiff+  , priminal+  , byteArray+  , b125+  , b250+  , b375+  , b500+  , b625+  , b750+  , b875+  , varConvolveDiff+  , diff1Related+  , conDiff1Related+  , diffRelated+  , conDiffRelated+  , sum1Wring+  , relatedKeyHisto+  , plaintextHisto+  , sixStatsBit+  , relatedKey+  , integralHisto+  , eightStats+  , integralCr+  , integralCrFixed+  , compressBoth+  , sixtyFourNybbleArray+  , changeEachNybble+  , compressChanges+  , collisions1+  , hashColl+  , hashCollLinear+  ) where++import Data.Word+import Data.Bits+import Data.Sort+import Math.NumberTheory.Primes+import Data.Array.Unboxed+import qualified Data.Sequence as Seq+import Data.Sequence ((><), (<|), (|>), Seq((:<|)), Seq((:|>)))+import Data.Foldable (toList,foldl')+import Control.DeepSeq+import Control.Parallel+import Control.Parallel.Strategies+import GHC.Conc (numCapabilities)+import qualified Data.ByteString as B+import Data.ByteString.UTF8 (fromString)+import Debug.Trace+import Cryptography.Wring+import Cryptography.Twistree+import Stats+import qualified Data.Vector.Unboxed as V++type Crypt = Wring -> V.Vector Word8 -> V.Vector Word8++key96_0 = "Водворетраванатраведрова.Нерубидрованатраведвора!"+key96_1 = "Водворетраванатраведрова.Нерубидрованатраведвора "+key96_2 = "Водворетраванатраведрова,Нерубидрованатраведвора!"+key96_3 = "Водворетраванатраведрова,Нерубидрованатраведвора "+-- Russian tongue twister+-- In the yard is grass, on the grass is wood.+-- Do not chop the wood on the grass of yard.+-- 96 bytes in UTF-8 with single bit changes.++key30_0 = "Παντοτε χαιρετε!"+key30_1 = "Πάντοτε χαιρετε!"+key30_2 = "Παντοτε χαίρετε!"+key30_3 = "Πάντοτε χαίρετε!"+-- Always rejoice! 1 Thess. 5:16.++key6_0 = "aerate"+key6_1 = "berate"+key6_2 = "cerate"+key6_3 = "derate"++sbox30_3 = sboxes (fromString key30_3)+sbox96_0 = sboxes (fromString key96_0)+same30_3 = sameBitcount sbox30_3+same96_0 = sameBitcount sbox96_0+-- These two are the longest, 17, of the sameBitcount of the S-boxes made from+-- the above keys. sameBitcount linearSbox is all 256 bytes.+-- The bitcounts of the S-box entries are:+-- same30_3: [3,4,4,2,3,4,4,4,4,4,4,3,4,4,6,4,5]+-- same96_0: [2,3,3,3,5,5,4,5,3,5,4,3,4,3,5,4,3]+-- Using 16 of the 17 bytes, drop the 5 from same30_3 (and risk the 6)+-- or drop the 2 from same96_0.++samples = 16777216+chunkSize = 1 + div samples (2 * numCapabilities)+smallChunkSize = 1 + div samples (961 * numCapabilities)++wring96_0 = keyedWring $ fromString key96_0+wring96_1 = keyedWring $ fromString key96_1+wring96_2 = keyedWring $ fromString key96_2+wring96_3 = keyedWring $ fromString key96_3+wring30_0 = keyedWring $ fromString key30_0+wring30_1 = keyedWring $ fromString key30_1+wring30_2 = keyedWring $ fromString key30_2+wring30_3 = keyedWring $ fromString key30_3+wring6_0 = keyedWring $ fromString key6_0+wring6_1 = keyedWring $ fromString key6_1+wring6_2 = keyedWring $ fromString key6_2+wring6_3 = keyedWring $ fromString key6_3++-- Because of rotBitcount, fixed-position bit differences are inadequate to+-- telling whether two outputs of Wring are similar. Convolve them instead.++match :: [Word8] -> [Word8] -> Int+match as bs = sum $ zipWith (\a b -> 4 - popCount (a .^. b)) as bs++rot1Bit' :: Word8 -> [Word8] -> [Word8]+rot1Bit' b [a] = [(a .>>. 1) .|. (b .<<. 7)]+rot1Bit' b (a0:a1:as) = ((a0 .>>. 1) .|. (a1 .<<. 7)) : (rot1Bit' b (a1:as))++rot1Bit :: [Word8] -> [Word8]+rot1Bit [] = []+rot1Bit (a:as) = rot1Bit' a (a:as)++-- Ranges from -1 to 1, with 0 meaning half the bits are ones.+bias :: [Word8] -> Double+bias as = 1 - ((fromIntegral $ sum $ map popCount as) / (4 * fromIntegral (length as)))++convolve :: [Word8] -> [Word8] -> [Int]+-- The lists should be equally long. Returns a list 8 times as long.+convolve as bs = take nBits $ zipWith match (repeat as) (iterate rot1Bit bs) where+  nBits = 8 * length bs++unbiasedConvolve :: [Word8] -> [Word8] -> [Double]+unbiasedConvolve as bs = map ((+(- prodBias)) . (/ halfBits) . fromIntegral)+  (convolve as bs) where+    prodBias = (bias as) * (bias bs)+    halfBits = fromIntegral (4 * (length as))++-- The numbers returned by convolveDiff appear to have mean 1 and variance+-- 0.0078125, i.e. 2/256 where 256 is the number of bits.+convolveDiff :: [Word8] -> [Word8] -> Double+convolveDiff as bs = if (scale == 0) then 1 else+  (sum $ map (^2) $ unbiasedConvolve as bs) / scale where+  scale = ((1+(bias as))*(1+(bias bs))*(1-(bias as))*(1-(bias bs)))++-- Multiples of the priminal word for spreading plaintexts around the+-- space of plaintext++halfPrimes :: Int -> [Int]+halfPrimes n = takeWhile (< n) (map ((`div` 2) . (+(-3)) . unPrime) [nextPrime 3 ..])++priminal_ :: Int -> Integer+priminal_ n = sum $ map (1 .<<.) (halfPrimes n)++priminal :: Integral a => Int -> a+-- Returns a priminal word of at least n bits ending in 1.+priminal n = fromIntegral (priminal_ n)++byteArray :: (Bits a,Integral a) => Int -> a -> V.Vector Word8+byteArray len n = V.fromListN len bytes where+  bytes = map (\x -> (fromIntegral (n .>>. (8*x)) .&. 255)) [0..(len-1)]++eightByteArray :: Word64 -> V.Vector Word8+eightByteArray = byteArray 8++makeListInt :: (Bits a,Integral a) => [Word8] -> a+makeListInt [] = 0+makeListInt (n:ns) = ((makeListInt ns) .<<. 8) .|. (fromIntegral n)++makeArrayInt :: (Bits a,Integral a) => V.Vector Word8 -> a+makeArrayInt = makeListInt . V.toList++-- Random-looking bit vectors with proportions of bits set,+-- for testing convolveDiff on biased bit vectons++land :: [Word8] -> [Word8] -> [Word8]+land as bs = zipWith (.&.) as bs++lor :: [Word8] -> [Word8] -> [Word8]+lor as bs = zipWith (.|.) as bs++b125 :: Integer -> [Word8]+b125 n = land a (land b c) where+  a = V.toList $ encrypt wring6_0 $ byteArray 32 n+  b = V.toList $ encrypt wring30_0 $ byteArray 32 n+  c = V.toList $ encrypt wring96_0 $ byteArray 32 n++b250 :: Integer -> [Word8]+b250 n = land b c where+  b = V.toList $ encrypt wring30_0 $ byteArray 32 n+  c = V.toList $ encrypt wring96_0 $ byteArray 32 n++b375 :: Integer -> [Word8]+b375 n = land a (lor b c) where+  a = V.toList $ encrypt wring6_0 $ byteArray 32 n+  b = V.toList $ encrypt wring30_0 $ byteArray 32 n+  c = V.toList $ encrypt wring96_0 $ byteArray 32 n++b500 :: Integer -> [Word8]+b500 n = a where+  a = V.toList $ encrypt wring6_0 $ byteArray 32 n++b625 :: Integer -> [Word8]+b625 n = lor a (land b c) where+  a = V.toList $ encrypt wring6_0 $ byteArray 32 n+  b = V.toList $ encrypt wring30_0 $ byteArray 32 n+  c = V.toList $ encrypt wring96_0 $ byteArray 32 n++b750 :: Integer -> [Word8]+b750 n = lor b c where+  b = V.toList $ encrypt wring30_0 $ byteArray 32 n+  c = V.toList $ encrypt wring96_0 $ byteArray 32 n++b875 :: Integer -> [Word8]+b875 n = lor a (lor b c) where+  a = V.toList $ encrypt wring6_0 $ byteArray 32 n+  b = V.toList $ encrypt wring30_0 $ byteArray 32 n+  c = V.toList $ encrypt wring96_0 $ byteArray 32 n++varConvolveDiff :: (Integer -> [Word8]) -> Double+-- Assumes the mean of convolveDiff is 1+varConvolveDiff b = sum (map (\x -> (x-1)^2) sims) / 4096 where+  sims = map (\n -> convolveDiff (b (2*n)) (b (2*n+1))) [0..4095]++-- Exact bitcount:+-- b125 [21,27,48,58,61,74,82,87,91,104,112,120,142,153,156,175,180,210,213,214,251,254]+-- b250 [10,12,14,17,19,35,37,49,54,96,123,137,144,145,152,155,157,181,185,192,227,239,250]+-- b375 [15,16,63,75,79,94,99,113,141,181,186,215,249,251]+-- b500 [66,184,186,190,191,207,225,228,234,235]+-- b625 [34,45,51,53,62,77,109,164,207,249,250]+-- b750 [8,18,77,84,87,109,130,147,152,163,172,189,232,246]+-- b875 [6,13,39,45,48,52,66,71,94,95,106,108,111,122,133,161,166,173,200,203,221,228,251,254]++-- Related-key cryptanalysis+-- Take four keys which differ by one or two bytes, in pairs, and encrypt+-- the same plaintext with both and compute the difference.++-- diffRelated produces a list of integers, which are then histogrammed,+-- and the histo bars are turned into a chi-squared random variable.+-- conDiffRelated produces a list of chi-squared random variables, whose+-- mean and variance are then checked against what's expected. In both+-- cases, the chi-squared variables are scaled to have a mean of 1.++name2 :: Wring -> String -> Wring -> String+name2 w0 s w1 = (wringName w0) ++ s ++ (wringName w1)++diff1Related :: Wring -> Wring -> Word64 -> Word64+diff1Related w0 w1 pt = ct0 .^. ct1 where+  ct0 = makeArrayInt $ encrypt w0 $ eightByteArray pt+  ct1 = makeArrayInt $ encrypt w1 $ eightByteArray pt++conDiff1Related :: Wring -> Wring -> Word64 -> Double+conDiff1Related w0 w1 pt = par ct0 $ convolveDiff ct0 ct1 where+  ct0 = V.toList $ encrypt w0 $ eightByteArray pt+  ct1 = V.toList $ encrypt w1 $ eightByteArray pt++diffRelated :: Wring -> Wring -> [Word64]+diffRelated w0 w1 = traceEvent (name2 w0 "-diff-" w1) $ map ((diff1Related w0 w1) . ((priminal 64) *)) [0..]++conDiffRelated :: Wring -> Wring -> [Double]+conDiffRelated w0 w1 = traceEvent (name2 w0 "-con-" w1) $ map ((conDiff1Related w0 w1) . ((priminal 64) *)) [0..]++plaintextHisto :: Histo+plaintextHisto = foldl' hCountBits (emptyHisto 64)+  (take (div samples 2) (map ((priminal 64) *) [0..]))++relatedKeyHisto :: Wring -> Wring -> Histo+relatedKeyHisto w0 w1 = foldl' hCountBits (emptyHisto 64)+  (take (div samples 2) (diffRelated w0 w1) `using` parListDeal numCapabilities rdeepseq)++relatedKeyStatBit :: Wring -> Wring -> Double+relatedKeyStatBit w0 w1 = binomial (relatedKeyHisto w0 w1) (div samples 2)++relatedKeyStatConv :: Wring -> Wring -> (Double,Double)+relatedKeyStatConv w0 w1 = normμσ 1 (sqrt (1/32))+  (take (div samples 2) (conDiffRelated w0 w1) `using` parListDeal numCapabilities rdeepseq)++sixStatsBit :: Wring -> Wring -> Wring -> Wring -> [Double]+sixStatsBit w0 w1 w2 w3 = par s01 $ par s23 $ par s02 $ par s13 $ par s03 $ par s12 $+  [s01,s23,s02,s13,s03,s12] where+    s01 = relatedKeyStatBit w0 w1+    s23 = relatedKeyStatBit w2 w3+    s02 = relatedKeyStatBit w0 w2+    s13 = relatedKeyStatBit w1 w3+    s03 = relatedKeyStatBit w0 w3+    s12 = relatedKeyStatBit w1 w2++sixStatsConv :: Wring -> Wring -> Wring -> Wring -> [(Double,Double)]+sixStatsConv w0 w1 w2 w3 =+  par (force s01) $ par (force s23) $ par (force s02) $+  par (force s13) $ par (force s03) $ par (force s12) $+  [s01,s23,s02,s13,s03,s12] where+    s01 = relatedKeyStatConv w0 w1+    s23 = relatedKeyStatConv w2 w3+    s02 = relatedKeyStatConv w0 w2+    s13 = relatedKeyStatConv w1 w3+    s03 = relatedKeyStatConv w0 w3+    s12 = relatedKeyStatConv w1 w2++tellStat64 :: Double -> String+-- 0.635 and 1.456 are 1% tails at 64 degrees of freedom, divided by 64.+tellStat64 stat+  | stat < 0.635 = "Too smooth. They look like a low-discrepancy sequence."+  | stat < 1.456 = "The differences look random."+  | otherwise    = "Too much variation. Check for outliers."++tellStat256 :: Double -> String+-- 0.806 and 1.217 are 1% tails at 256 degrees of freedom, divided by 256.+tellStat256 stat+  | stat < 0.806 = "Too smooth. They look like a low-discrepancy sequence."+  | stat < 1.217 = "The differences look random."+  | otherwise    = "Too much variation. Check for outliers."++tellStatμσ :: (Double,Double) -> String+tellStatμσ (mean,var)+  | mean < -0.5 = "The bit patterns are close to periodic."+  | mean > 0.5  = "The bit patterns are too similar."+  | var  > 2    = "The variance is too high."+  | var  < 0.5  = "The variance is too low."+  | otherwise   = "The differences look random."++relatedKey4Bit :: Wring -> Wring -> Wring -> Wring -> IO ()+relatedKey4Bit w0 w1 w2 w3 = do+  let sixS = sixStatsBit w0 w1 w2 w3+  putStrLn (show sixS)+  putStrLn ("0,1: " ++ tellStat64 (sixS !! 0))+  putStrLn ("2,3: " ++ tellStat64 (sixS !! 1))+  putStrLn ("0,2: " ++ tellStat64 (sixS !! 2))+  putStrLn ("1,3: " ++ tellStat64 (sixS !! 3))+  putStrLn ("0,3: " ++ tellStat64 (sixS !! 4))+  putStrLn ("1,2: " ++ tellStat64 (sixS !! 5))++relatedKey4Conv :: Wring -> Wring -> Wring -> Wring -> IO ()+relatedKey4Conv w0 w1 w2 w3 = do+  let sixS = sixStatsConv w0 w1 w2 w3+  putStrLn (show sixS)+  putStrLn ("0,1: " ++ tellStatμσ (sixS !! 0))+  putStrLn ("2,3: " ++ tellStatμσ (sixS !! 1))+  putStrLn ("0,2: " ++ tellStatμσ (sixS !! 2))+  putStrLn ("1,3: " ++ tellStatμσ (sixS !! 3))+  putStrLn ("0,3: " ++ tellStatμσ (sixS !! 4))+  putStrLn ("1,2: " ++ tellStatμσ (sixS !! 5))++relatedKey :: IO ()+relatedKey = do+  traceMarkerIO "96bit"+  putStrLn "96-byte key, 8-byte data, bitwise differences:"+  relatedKey4Bit wring96_0 wring96_1 wring96_2 wring96_3+  traceMarkerIO "96conv"+  putStrLn "96-byte key, 8-byte data, convolutional differences:"+  relatedKey4Conv wring96_0 wring96_1 wring96_2 wring96_3+  traceMarkerIO "30bit"+  putStrLn "30-byte key, 8-byte data, bitwise differences:"+  relatedKey4Bit wring30_0 wring30_1 wring30_2 wring30_3+  traceMarkerIO "30conv"+  putStrLn "30-byte key, 8-byte data, convolutional differences:"+  relatedKey4Conv wring30_0 wring30_1 wring30_2 wring30_3+  traceMarkerIO "6bit"+  putStrLn "6-byte key, 8-byte data, bitwise differences:"+  relatedKey4Bit wring6_0 wring6_1 wring6_2 wring6_3+  traceMarkerIO "6conv"+  putStrLn "6-byte key, 8-byte data, convolutional differences:"+  relatedKey4Conv wring6_0 wring6_1 wring6_2 wring6_3+  traceMarkerIO "relkey done"++-- Integral cryptanalysis+-- Take one key, and each of the eight bytes of the plaintext in parallel,+-- and xor all the ciphertexts produced by changing the byte of the plaintext+-- to all 256 possibilities.++sum1Wring :: Crypt -> Wring -> Word64 -> Int -> Word64+-- Take pt with all values in the bth byte, encrypt them all,+-- and xor the ciphertexts.+sum1Wring enc w pt b = foldl' xor 0 cts where+  pts = map eightByteArray $ zipWith xor (repeat pt) (map (.<<. (b .<<. 3)) [0..255])+  cts = map makeArrayInt $ map (enc w) pts++integralHisto :: Crypt -> Wring -> Int -> Histo+integralHisto enc w b = foldl' hCountBits (emptyHisto 64)+  (take (div samples 256)+  (map ((\pt -> sum1Wring enc w pt b) . ((priminal 64) *)) [0..])+  `using` parListDeal numCapabilities rdeepseq)++integralStat :: Crypt -> Wring -> Int -> Double+integralStat enc w b = binomial (integralHisto enc w b) (div samples 256)++eightStats :: Crypt -> Wring -> [Double]+eightStats enc w =+  par s0 $ par s1 $ par s2 $ par s3 $ par s4 $ par s5 $ par s6 $ par s7 $+  [s0,s1,s2,s3,s4,s5,s6,s7] where+    s0 = integralStat enc w 0+    s1 = integralStat enc w 1+    s2 = integralStat enc w 2+    s3 = integralStat enc w 3+    s4 = integralStat enc w 4+    s5 = integralStat enc w 5+    s6 = integralStat enc w 6+    s7 = integralStat enc w 7++integral1 :: Crypt -> Wring -> IO ()+integral1 enc w = do+  let eightS = eightStats enc w+  putStrLn (show eightS)+  putStrLn ("Byte 0: " ++ tellStat64 (eightS !! 0))+  putStrLn ("Byte 1: " ++ tellStat64 (eightS !! 1))+  putStrLn ("Byte 2: " ++ tellStat64 (eightS !! 2))+  putStrLn ("Byte 3: " ++ tellStat64 (eightS !! 3))+  putStrLn ("Byte 4: " ++ tellStat64 (eightS !! 4))+  putStrLn ("Byte 5: " ++ tellStat64 (eightS !! 5))+  putStrLn ("Byte 6: " ++ tellStat64 (eightS !! 6))+  putStrLn ("Byte 7: " ++ tellStat64 (eightS !! 7))++integralCr :: IO ()+integralCr = do+  putStrLn "96-byte key, 8-byte data:"+  integral1 encrypt wring96_0+  putStrLn "30-byte key, 8-byte data:"+  integral1 encrypt wring30_0+  putStrLn "6-byte key, 8-byte data:"+  integral1 encrypt wring6_0+  putStrLn "Linear key, 8-byte data:"+  integral1 encrypt linearWring+  putStrLn "96-byte key, byte 7:" -- This byte came out as "too much variation".+  putStrLn $ show $ integralHisto encrypt wring96_0 7+  putStrLn "Linear key, byte 3:" -- This byte came out as "low-discrepancy".+  putStrLn $ show $ integralHisto encrypt linearWring 3++integralCrFixed :: IO ()+integralCrFixed = do+  putStrLn "96-byte key, 8-byte data:"+  integral1 encryptFixed wring96_0+  putStrLn "30-byte key, 8-byte data:"+  integral1 encryptFixed wring30_0+  putStrLn "6-byte key, 8-byte data:"+  integral1 encryptFixed wring6_0+  putStrLn "Linear key, 8-byte data:"+  integral1 encryptFixed linearWring++-- Attempt to find a collision of the hash compression function++compressBoth :: SBox -> V.Vector Word8 -> V.Vector Word8+-- Takes a 64-byte block, compresses it as in both the 2-tree and the 3-tree,+-- and concatenates the results.+compressBoth sbox buf = (compress sbox buf 0) <> (compress sbox buf 1)++nybbleArray :: (Bits a,Integral a) => Int -> a -> V.Vector Word8+-- Like byteArray, but the nybbles are looked up in same30_3 to get the bytes,+-- which are then assembled into a vector.+nybbleArray len n = V.fromListN len bytes where+  bytes = map (\x -> same30_3 !! (fromIntegral (n .>>. (4*x)) .&. 15)) [0..(len-1)]++sixtyFourNybbleArray :: Integer -> V.Vector Word8+sixtyFourNybbleArray = nybbleArray 64++changeOneNybble :: Integer -> Int -> [Integer]+changeOneNybble n k = map (\x -> n .^. (x .<<. (4*k))) [1..15]++changeEachNybble :: Integer -> [Integer]+-- Returns a list of 961 numbers+changeEachNybble n = foldl' (++) [n] (map (changeOneNybble n) [0..63])++compressChanges :: SBox -> Integer -> [(V.Vector Word8,V.Vector Word8)]+compressChanges sbox n = map (\x -> (x,(compressBoth sbox x))) $+  map (\x -> mix3Parts (sixtyFourNybbleArray x) 11) (changeEachNybble n)+  -- 11 is rprime for a 64-byte block++dups :: [(V.Vector Word8,V.Vector Word8)] -> [(V.Vector Word8,V.Vector Word8)]+dups [] = []+dups [x] = []+dups ((a,h0):(b,h1):xs)+  | h0==h1    = (a,b):(dups ((b,h1):xs))+  | otherwise = dups ((b,h1):xs)++collisions1 :: SBox -> Integer -> [(V.Vector Word8,V.Vector Word8)]+-- Given an S-box and a 64-nybble integer, tries compressing all 961 blocks+-- made from the integer changed by 0 or 1 nybble, and returns any collisions.+collisions1 sbox n = dups $ sortOn snd $ compressChanges sbox n++collisions :: SBox -> [(V.Vector Word8,V.Vector Word8)]+collisions sbox = foldl' (++) []+  (take (div samples 961)+  (map ((collisions1 sbox) . ((priminal 256) *)) [0..])+  `using` parListDeal numCapabilities rdeepseq)++hashColl :: IO ()+hashColl = do+  putStrLn "Hash collisions, 30-byte key:"+  let colls = collisions sbox30_3+  putStrLn (show colls)+  putStrLn ((show (length colls)) ++ " collisions")++hashCollLinear :: IO ()+hashCollLinear = do+  putStrLn "Hash collisions, linear S-box:"+  let colls = collisions linearSbox+  putStrLn (show colls)+  putStrLn ((show (length colls)) ++ " collisions")

@@ -0,0 +1,222 @@+module Main (main) where++import Cryptography.Wring+import Cryptography.Twistree+import Cryptanalysis+import Control.Parallel+import Control.Parallel.Strategies+import Text.Printf+import Data.List.Split+import Data.Word+import Data.Foldable (toList)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.ByteString.UTF8 (fromString)+import System.IO+import Multiarg+import qualified Data.Vector.Unboxed as V++lineStr :: [Word8] -> String+lineStr [] = ""+lineStr (a:as) = (printf "%02x " a)++(lineStr as)++lineStr16 :: [Word16] -> String+lineStr16 [] = ""+lineStr16 (a:as) = (printf "%04x " a)++(lineStr16 as)++blockStr :: [[Word8]] -> String+blockStr [] = ""+blockStr (a:as) = (lineStr a) ++ "\n" ++ (blockStr as)++blockStr16 :: [[Word16]] -> String+blockStr16 [] = ""+blockStr16 (a:as) = (lineStr16 a) ++ "\n" ++ (blockStr16 as)++block16str :: [Word8] -> String+-- Takes a list of 256 bytes and formats them 16 to a line.+block16str a = blockStr $ chunksOf 16 a++block16str16 :: [Word16] -> String+-- Takes a list of 96 words and formats them 16 to a line.+block16str16 a = blockStr16 $ chunksOf 16 a++wrungZeros :: V.Vector Word8+wrungZeros = encrypt linearWring (V.replicate 256 0)++readFileEager :: String -> IO (V.Vector Word8)+readFileEager fileName = do+  h <- openBinaryFile fileName ReadMode+  contents <- B.hGetContents h+  let contArray = V.fromListN (B.length contents) (B.unpack contents)+  return contArray++readFileLazy :: String -> IO (BL.ByteString)+readFileLazy fileName = do+  h <- openBinaryFile fileName ReadMode+  contents <- BL.hGetContents h+  return contents++writeFileArray :: String -> V.Vector Word8 -> IO ()+writeFileArray fileName ary = do+  h <- openBinaryFile fileName WriteMode+  BL.hPut h (BL.pack $ V.toList ary)+  hClose h++encryptFile :: String -> String -> String -> IO ()+encryptFile key plainfile cipherfile = do+  let wring = keyedWring (fromString key)+  plaintext <- readFileEager plainfile+  let ciphertext = encrypt wring plaintext+  writeFileArray cipherfile ciphertext++decryptFile :: String -> String -> String -> IO ()+decryptFile key cipherfile plainfile = do+  let wring = keyedWring (fromString key)+  ciphertext <- readFileEager cipherfile+  let plaintext = decrypt wring ciphertext+  writeFileArray plainfile plaintext++hashFile :: String -> String -> String -> IO ()+hashFile key plainfile outfile = do+  let twistree = keyedTwistree (fromString key)+  plaintext <- readFileLazy plainfile+  let hashtext = hash twistree plaintext+  if null outfile+    then putStrLn $ block16str $ V.toList hashtext+    else writeFileArray outfile hashtext++testHash :: IO ()+testHash = do+  let twistree = keyedTwistree (fromString "")+  let plaintext = (take 105 (repeat 105)) ++ (take 150 (repeat 150))+  let hashtext = hash twistree $ BL.pack plaintext+  putStrLn $ block16str $ V.toList hashtext++testSimilar :: IO ()+testSimilar = do+  putStr "b125 "+  putStrLn $ printf "%f" $ varConvolveDiff b125+  putStr "b250 "+  putStrLn $ printf "%f" $ varConvolveDiff b250+  putStr "b375 "+  putStrLn $ printf "%f" $ varConvolveDiff b375+  putStr "b500 "+  putStrLn $ printf "%f" $ varConvolveDiff b500+  putStr "b625 "+  putStrLn $ printf "%f" $ varConvolveDiff b625+  putStr "b750 "+  putStrLn $ printf "%f" $ varConvolveDiff b750+  putStr "b875 "+  putStrLn $ printf "%f" $ varConvolveDiff b875++testNothing :: IO ()+testNothing = putStrLn "No code under test"++cryptanalyze :: String -> IO ()+cryptanalyze arg = case arg of+  "relkey"  -> relatedKey+  "integral"  -> integralCr+  "integral-fixed"  -> integralCrFixed+  "hashcoll"  -> hashColl+  "hashcoll-linear"  -> hashCollLinear+  otherwise -> putStrLn ("Available cryptanalyses are:\n" +++    "relkey          Related-key cryptanalysis\n" +++    "integral        Integral cryptanalysis\n" +++    "integral-fixed  Integral cryptanalysis, fixed rotation instead of rotBitcount\n" +++    "hashcoll        Hash collisions\n" +++    "hashcoll-linear Hash collisions, linear S-box")++data WtOpt+  = Infile String+  | Analyze String+  | Encrypt+  | Decrypt+  | Hash+  | Test+  | Key String+  | Outfile String+    deriving (Show,Eq)++doWhich :: [WtOpt] -> Maybe WtOpt+-- Returns Just the action, if exactly one action is specified, else Nothing.+doWhich lst = if (length actions == 1) then Just (head actions) else Nothing where+  actions = filter+    (\x -> case x of+      Encrypt -> True+      Decrypt -> True+      Hash -> True+      Analyze _ -> True+      Test -> True+      otherwise -> False)+    lst++strings_ :: [WtOpt] -> (String,String,String)+strings_ [] = ("","","")+strings_ (Key s:ws)     = (s,infile,outfile)+  where (key,infile,outfile) = strings_ ws+strings_ (Infile s:ws)  = (key,s,outfile)+  where (key,infile,outfile) = strings_ ws+strings_ (Outfile s:ws) = (key,infile,s)+  where (key,infile,outfile) = strings_ ws+strings_ (_:ws)         = (key,infile,outfile)+  where (key,infile,outfile) = strings_ ws++strings :: [WtOpt] -> (String,String,String)+-- If no outfile is specified, write encrypted or decrypted file back to input,+-- but output hash to stdout.+strings ws = (key,infile,outfile) where+  (key,infile,outfile_) = strings_ ws+  outfile = if (null outfile_) && (doWhich ws) /= Just Hash+            then infile+            else outfile_++optSpecs :: [OptSpec WtOpt]+optSpecs =+  [ optSpec "e" ["encrypt"] (ZeroArg Encrypt)+  , optSpec "d" ["decrypt"] (ZeroArg Decrypt)+  , optSpec "c" ["cryptanalyze"] (OneArg Analyze)+  , optSpec "H" ["hash"] (ZeroArg Hash)+  , optSpec "t" ["test"] (ZeroArg Test) -- for running code I'm testing+  , optSpec "k" ["key"] (OneArg Key)+  , optSpec "o" ["output"] (OneArg Outfile)+  ]++help :: String -> String+help progName = unlines+  [ progName ++ " - Wring cipher and Twistree hash"+  , "Usage:"+  , progName ++ " [options] INPUTFILE ..."+  , ""+  , "Options:"+  , ""+  , "--encrypt,      -e       Encrypt a file."+  , "--decrypt,      -d       Decrypt a file."+  , "--cryptanalyze, -c TYPE  Run cryptanalysis type TYPE."+  , "--hash,         -H       Hash a file."+  , "--output FILE,  -o FILE  Output results to FILE."+  , "--key TEXT,     -k TEXT  Use key for encrypting, decrypting, or hashing."+  , "--test,         -t       Test the latest code."+  , "--help,         -h       Output this message."+  , ""+  , "At most one of -e, -d, -c, and -H may be specified. If -o is not specified,"+  , "the ciphertext or plaintext overwrites the original file, and the hash"+  , "is written to standard output."+  ]++doCommandLine :: [WtOpt] -> IO ()+doCommandLine parse = case action of+    Just Encrypt     -> encryptFile key infile outfile+    Just Decrypt     -> decryptFile key infile outfile+    Just Test        -> testNothing+    Just (Analyze a) -> cryptanalyze a+    Just Hash        -> hashFile key infile outfile+    Nothing          -> putStrLn "Please specify one of -e, -d, and -H"+    _                -> error "can't happen"+  where+    action = doWhich parse+    (key,infile,outfile) = strings parse++main :: IO ()+main = do+  parse <- parseCommandLine help optSpecs Infile+  doCommandLine parse

@@ -0,0 +1,124 @@+{-# LANGUAGE BangPatterns #-}+module Stats+  ( pairwiseSumCount+  , Histo (..)+  , emptyHisto+  , hCount+  , hCountBits+  , χ²+  , binomial+  , sacCountBit+  , bitFold+  , sacStats+  , normμσ+  ) where++import Data.Bits+import Data.Word+import qualified Data.Sequence as Seq+import Data.Sequence ((><), (<|), (|>), Seq((:<|)), Seq((:|>)))+import Data.Foldable (toList,foldl')+import Control.Parallel+import Control.Parallel.Strategies++addTriple :: Num a => (Int,a,a) -> (Int,a,a) -> (Int,a,a)+addTriple (!b,!c,!d) (e,f,g) = (b+e,c+f,d+g)++sumPairs :: Num a => [(Int,a,a)] -> [(Int,a,a)]+sumPairs [] = []+sumPairs [x] = [x]+sumPairs (x:y:xs) = pseq (addTriple x y) $ ((addTriple x y) : sumPairs xs)++pairwiseSumCount :: (Num a) => [(Int,a,a)] -> (Int,a,a)+pairwiseSumCount [] = (0,0,0)+pairwiseSumCount [x] = x+pairwiseSumCount xs = pairwiseSumCount (sumPairs xs)++newtype Histo = Histo (Seq.Seq Word) deriving (Show)++emptyHisto :: Int -> Histo+emptyHisto n = Histo (Seq.replicate n 0)++hCount :: Integral a => Histo -> a -> Histo+hCount (Histo h) n = Histo (Seq.adjust' (+1) (fromIntegral n) h)++listBits :: Word64 -> [Int]+listBits 0 = []+listBits n = b:listBits (clearBit n b) where+  b = countTrailingZeros n++hCountBits :: Histo -> Word64 -> Histo+hCountBits h n = foldl' hCount h (listBits n)++χ² :: Histo -> Double+χ² (Histo h) = sum $ map (\x -> ((fromIntegral x) - mean) ^(2::Int) / mean) (toList h)+  where mean = fromIntegral (sum h) / fromIntegral (length h) :: Double++-- Use this if the histo bars count one-bits and half of the n trials should+-- yield one.+-- Each bar is a binomial random variable with p=q=1/2. The mean is half the+-- number of trials, and the variance is half the mean. Returns what should be+-- a χ² random number with (length h) degrees of freedom, divided by (length h).+binomial :: Histo -> Int -> Double+binomial (Histo h) n = (sum $ map+  (\x -> ((fromIntegral x) - mean) ^(2::Int) / sdev) (toList h))+  / fromIntegral (length h)+  where+    mean = fromIntegral n / 2 :: Double+    sdev = mean/2++squareWave :: Int -> [Int]+squareWave n = map ((.&. (1::Int)) . (.>>. n)) [0..]++squareWaveInt :: Int -> [Int]+squareWaveInt n = map ((-1) ^) (squareWave n)++squareWaveBool :: Int -> [Bool]+squareWaveBool n = map (== 1) (squareWave n)++sacCountBit :: Histo -> Int -> Int+-- The histogram is produced by a strict avalanche criterion count; i.e. each+-- number counted is the xor of two outputs whose inputs differ by one bit.+sacCountBit (Histo h) n = sum $ zipWith (*) (squareWaveInt n) (map fromIntegral (toList h))++bitFoldSq :: Bits a => [a] -> [Bool] -> Seq.Seq a -> [a]+bitFoldSq [] _ _ = []+bitFoldSq _ [] _ = []+bitFoldSq (x:xs) (False:bs) as = bitFoldSq xs bs (as |> x)+bitFoldSq (x:xs) (True:bs) Seq.Empty = x:bitFoldSq xs bs Seq.Empty -- should never happen+bitFoldSq (x:xs) (True:bs) (a:<|as) = (xor x a):bitFoldSq xs bs as++bitFold :: Bits a => [a] -> Int -> [a]+bitFold xs n = bitFoldSq xs (squareWaveBool n) Seq.Empty++sacRow :: Histo -> Int -> [Int]+sacRow h nbits = parMap rpar (sacCountBit h) [0..(nbits-1)]++sacHistos' :: (Integral a,Bits a) => [a] -> Int -> Int -> [Histo]+sacHistos' xs wid b+  | null bf   = []+  | otherwise = h:(sacHistos' xs wid (b+1))+  where bf = (bitFold xs b)+        h = foldl' hCount (emptyHisto (1 .<<. wid)) bf++sacHistos :: (Integral a,Bits a) => [a] -> Int -> [Histo]+sacHistos xs wid = sacHistos' xs wid 0++sacStats :: (Integral a,FiniteBits a) => [a] -> [[Int]]+-- Takes a list of Word8, Word16, or the like, whose length is a power of 2,+-- and computes the deviations from the strict avalanche criterion.+sacStats [] = []+sacStats (x:xs) = parMap rpar (\h -> sacRow h wid) (sacHistos (x:xs) wid)+  where wid=finiteBitSize (x)++normμσ :: Double -> Double -> [Double] -> (Double,Double)+-- Takes a list of numbers, assumed to have the specified mean and standard+-- deviation, and returns the actual mean, as an offset from the specified+-- mean in specified standard deviations, and the average square deviation,+-- in specified variances. The result should be near (0,1).+normμσ μ σ devs = (mean,var) where+  ndevs = map (\x -> (x-μ)/σ) devs+  ndevsqs = map (\x -> (1,x,x^2)) ndevs+  (n,total,total2) = pairwiseSumCount ndevsqs+  mean = total / (fromIntegral n)+  var = total2 / (fromIntegral n)

@@ -0,0 +1,113 @@+module Cryptography.Twistree+  ( Twistree+  , SBox -- reexported for use in Cryptanalysis.hs+  , sboxes -- "+  , sameBitcount -- "+  , compress -- "+  , linearSbox -- "+  , linearTwistree -- Only for cryptanalysis and testing+  , parListDeal+  , keyedTwistree+  , hash+  ) where++{-+This hash function uses a double-tree construction, as shown in this drawing:++                                                  2+                               -------------------+-------------------+               ----------------+---------------                      |+       --------+--------               -------+---------             |+   ----+----       ----+----       ----+----       ----+----       --+---+ --+--   --+--   --+--   --+--   --+--   --+--   --+--   --+--   --+--  |+-+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- |+4 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *+--+-- --+-- --+-- --+-- --+-- --+-- --+-- --+-- --+-- --+-- --+-- --+-- |+  ------+------     ------+------     ------+------     ------+------   |+        ------------------+------------------                 -----+-----+                          ---------------------+--------------------+                                               3+2 3+-+-+ H++*   A block of the message to be hashed, including padding at the end.+4   Binary representation of exp(4). One is used in the binary tree and the+    other in the ternary tree.+3   Output of the ternary tree+2   Output of the binary tree+H   Final hash output+-}++import Cryptography.WringTwistree.Compress+import Cryptography.WringTwistree.Blockize+import Cryptography.WringTwistree.Sboxes+import Control.Parallel+import Control.Parallel.Strategies+import Data.List (transpose)+import Data.List.Split+import Data.Word+import Data.Bits+import Data.Array.Unboxed+import Data.Foldable (foldl')+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Vector.Unboxed as V++data Twistree = Twistree+  { sbox    :: SBox+  } deriving Show++deal n = transpose . chunksOf n -- to be used as a parallel strategy++parListDeal :: Int -> Strategy a -> Strategy [a]+parListDeal n strat xs+  | n <= 1    = evalList strat xs+  | otherwise = concat `fmap` parList (evalList strat) (deal n xs)++compressPairs :: SBox -> [V.Vector Word8] -> [V.Vector Word8]+compressPairs _ [] = []+compressPairs _ [x] = [x]+compressPairs sbox (x:y:xs) = pseq (compress2 sbox x y 0) $+  ((compress2 sbox x y 0) : compressPairs sbox xs)++hashPairs :: SBox -> [V.Vector Word8] -> V.Vector Word8+hashPairs _ [] = undefined -- can't happen, there's always at least exp(4)+hashPairs _ [x] = x+hashPairs sbox x = par (compressPairs sbox x) $+  hashPairs sbox (compressPairs sbox x)++compressTriples :: SBox -> [V.Vector Word8] -> [V.Vector Word8]+compressTriples _ [] = []+compressTriples _ [x] = [x]+compressTriples sbox [x,y] = [compress2 sbox x y 1]+compressTriples sbox (x:y:z:xs) = pseq (compress3 sbox x y z 1) $+  ((compress3 sbox x y z 1) : compressTriples sbox xs)++hashTriples :: SBox -> [V.Vector Word8] -> V.Vector Word8+hashTriples _ [] = undefined -- can't happen, there's always at least exp(4)+hashTriples _ [x] = x+hashTriples sbox x = par (compressTriples sbox x) $+  hashTriples sbox (compressTriples sbox x)++-- | A `Twistree` with linear `SBox`. Used only for testing and cryptanalysis.+linearTwistree = Twistree linearSbox++-- | Creates a `Twistree` with the given key.+-- To convert a `String` to a `ByteString`, put @- utf8-string@ in your+-- package.yaml dependencies, @import Data.ByteString.UTF8@, and use+-- `fromString`.+keyedTwistree :: B.ByteString -> Twistree+keyedTwistree key = Twistree sbox where+  sbox = sboxes key++hash+  :: Twistree -- ^ The `Twistree` made with the key to hash with+  -> BL.ByteString -- ^ The text to be hashed. It's a lazy `ByteString`,+    -- so you can hash a file bigger than RAM.+  -> V.Vector Word8 -- ^ The returned hash, 32 bytes.+hash twistree stream = par blocks $ par h2 $ par h3 $+  compress2 (sbox twistree) h2 h3 2 where+    blocks = blockize stream+    h2 = hashPairs (sbox twistree) (exp4_2adic : blocks)+    h3 = hashTriples (sbox twistree) (exp4_base2 : blocks)

@@ -0,0 +1,269 @@+module Cryptography.Wring+  ( Wring+  , mix3Parts -- reexported for use in Cryptanalysis.hs+  , permut8 -- reexported for testing+  , mul65537 -- "+  , wringName -- For events in traces when profiling+  , xorn -- Used for big hash test+  , linearWring -- Only for cryptanalysis and testing+  , keyedWring+  , encrypt+  , decrypt+  , encryptFixed -- Only for cryptanalysis and testing+  ) where++{- This cipher is intended to be used with short random keys (32 bytes or less,+ - no hard limit) or long human-readable keys (up to 96 bytes). keyedWring+ - takes arbitrarily long keys, but do not use keys longer than 96 bytes as they+ - make the cipher more vulnerable to related-key attacks.+ -+ - The Haskell implementation needs four times as much RAM as the message size,+ - plus a constant overhead.+ -}++import Cryptography.WringTwistree.Mix3+import Cryptography.WringTwistree.RotBitcount+import Cryptography.WringTwistree.Sboxes+import Text.Printf+import Data.Word+import Data.Bits+import Data.Foldable (foldl')+import qualified Data.ByteString as B+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Unboxed.Mutable as MV+import Control.Monad.ST+import Control.Monad++data Wring = Wring+  { sbox    :: SBox+  , invSbox :: SBox+  } deriving Show++-- | Generates a name from the first four bytes of the S-box.+-- Used to tag events in a profiling log.+wringName :: Wring -> String+wringName wring = printf "%02x-%02x-%02x-%02x"+  ((sbox wring) V.! 0)+  ((sbox wring) V.! 1)+  ((sbox wring) V.! 2)+  ((sbox wring) V.! 3)++nRounds :: Integral a => a -> a+nRounds len+  | len < 3 = 3+  | otherwise = (nRounds (len `div` 3)) +1++-- | Exclusive-ors all bytes in a nonnegative number. The only reason this+-- function is public is that it's used to generate a long `ByteString`+-- for a test.+xorn :: (Integral a,Bits a) => a -> Word8+xorn 0 = 0+xorn (-1) = error "xorn: negative"+xorn a = (fromIntegral a) `xor` (xorn (a .>>. 8))++xornArray :: Int -> V.Vector Word8+xornArray n = V.fromListN n (map xorn [0..(n-1)])++-- | A `Wring` with linear S-boxes. Used only for testing and cryptanalysis.+linearWring = Wring linearSbox linearInvSbox++-- | Creates a `Wring` with the given key.+-- To convert a `String` to a `ByteString`, put @- utf8-string@ in your+-- package.yaml dependencies, @import Data.ByteString.UTF8@, and use+-- `fromString`.+keyedWring :: B.ByteString -> Wring+keyedWring key = Wring sbox (invert sbox)+ where+  sbox = sboxes key++{- A round of encryption consists of four steps:+ - mix3Parts+ - sboxes+ - rotBitcount+ - add byte index xor round number+ -}++-- Original purely functional version, modified to use vectors++roundEncryptFun ::+  Int ->+  SBox ->+  V.Vector Word8 ->+  V.Vector Word8 ->+  Int ->+  V.Vector Word8+roundEncryptFun rprime sbox xornary buf rond = i4 where+  len = V.length buf+  xornrond = xorn rond+  i1 = mix3Parts buf rprime+  i2 = V.fromListN len $ map (sbox V.!) $+    zipWith sboxInx (drop rond cycle3) (V.toList i1)+  i3 = rotBitcount i2 1+  i4 = V.fromListN len $ zipWith (+) (V.toList i3)+    (map (xor xornrond) (V.toList xornary))++roundDecryptFun ::+  Int ->+  SBox ->+  V.Vector Word8 ->+  V.Vector Word8 ->+  Int ->+  V.Vector Word8+roundDecryptFun rprime sbox xornary buf rond = i4 where+  len = V.length buf+  xornrond = xorn rond+  i1 = V.fromListN len $ zipWith (-) (V.toList buf)+    (map (xor xornrond) (V.toList xornary))+  i2 = rotBitcount i1 (-1)+  i3 = V.fromListN len $ map (sbox V.!) $+    zipWith sboxInx (drop rond cycle3) (V.toList i2)+  i4 = mix3Parts i3 rprime++encryptFun :: Wring -> V.Vector Word8 -> V.Vector Word8+encryptFun wring buf = foldl' (roundEncryptFun rprime (sbox wring) xornary)+  buf rounds+  where+    len = V.length buf+    xornary = xornArray len+    rprime = fromIntegral $ findMaxOrder (fromIntegral $ len `div` 3)+    rounds = [0 .. (nRounds len) -1]++decryptFun :: Wring -> V.Vector Word8 -> V.Vector Word8+decryptFun wring buf = foldl' (roundDecryptFun rprime (invSbox wring) xornary)+  buf rounds+  where+    len = V.length buf+    xornary = xornArray len+    rprime = fromIntegral $ findMaxOrder (fromIntegral $ len `div` 3)+    rounds = reverse [0 .. (nRounds len) -1]++-- ST monad version modifies memory in place+-- by int-e++{-# NOINLINE roundEncryptST #-}+roundEncryptST ::+  Int ->+  SBox ->+  V.Vector Word8 ->+  MV.MVector s Word8 ->+  MV.MVector s Word8 ->+  Int ->+  ST s ()+roundEncryptST rprime sbox xornary buf tmp rond = do+  let len = MV.length buf+      xornrond = xorn rond+  mix3Parts' buf rprime+  forM_ [0..len-1] $ \i -> do+      a <- MV.read buf i+      MV.write tmp i (sbox V.! (sboxInx ((i + rond) `rem` 3) a))+  rotBitcount' tmp 1 buf+  forM_ [0..len-1] $ \i -> do+      a <- MV.read buf i+      let a' = a + (xornrond `xor` (xornary V.! i))+      MV.write buf i a'++{-# NOINLINE roundEncryptFixedST #-}+roundEncryptFixedST ::+  Int ->+  SBox ->+  V.Vector Word8 ->+  MV.MVector s Word8 ->+  MV.MVector s Word8 ->+  Int ->+  ST s ()+roundEncryptFixedST rprime sbox xornary buf tmp rond = do+  let len = MV.length buf+      xornrond = xorn rond+  mix3Parts' buf rprime+  forM_ [0..len-1] $ \i -> do+      a <- MV.read buf i+      MV.write tmp i (sbox V.! (sboxInx ((i + rond) `rem` 3) a))+  rotFixed' tmp 1 buf+  forM_ [0..len-1] $ \i -> do+      a <- MV.read buf i+      let a' = a + (xornrond `xor` (xornary V.! i))+      MV.write buf i a'++{-# NOINLINE roundDecryptST #-}+roundDecryptST ::+  Int ->+  SBox ->+  V.Vector Word8 ->+  MV.MVector s Word8 ->+  MV.MVector s Word8 ->+  Int ->+  ST s ()+roundDecryptST rprime sbox xornary buf tmp rond = do+  let len = MV.length buf+      xornrond = xorn rond+  forM_ [0..len-1] $ \i -> do+      a <- MV.read buf i+      let a' = a - (xornrond `xor` (xornary V.! i))+      MV.write tmp i a'+  rotBitcount' tmp (-1) buf+  forM_ [0..len-1] $ \i -> do+      a <- MV.read buf i+      MV.write buf i (sbox V.! (sboxInx ((i + rond) `rem` 3) a))+  mix3Parts' buf rprime++encryptST :: Wring -> V.Vector Word8 -> V.Vector Word8+encryptST wring buf = V.create $ do+  let len = V.length buf+      xornary = xornArray len+      rprime = fromIntegral $ findMaxOrder (fromIntegral $ len `div` 3)+      rounds = [0 .. nRounds len - 1]+  buf <- V.thaw buf+  tmp <- MV.new len+  forM_ [0..nRounds len - 1] $ \rond -> do+    roundEncryptST rprime (sbox wring) xornary buf tmp rond+  pure buf++-- Encrypts using a fixed rotation of the buffer, rather than rotating+-- by its population count. This removes a source of nonlinearity.+encryptFixedST :: Wring -> V.Vector Word8 -> V.Vector Word8+encryptFixedST wring buf = V.create $ do+  let len = V.length buf+      xornary = xornArray len+      rprime = fromIntegral $ findMaxOrder (fromIntegral $ len `div` 3)+      rounds = [0 .. nRounds len - 1]+  buf <- V.thaw buf+  tmp <- MV.new len+  forM_ [0..nRounds len - 1] $ \rond -> do+    roundEncryptFixedST rprime (sbox wring) xornary buf tmp rond+  pure buf++decryptST :: Wring -> V.Vector Word8 -> V.Vector Word8+decryptST wring buf = V.create $ do+  let len = V.length buf+      xornary = xornArray len+      rprime = fromIntegral $ findMaxOrder (fromIntegral $ len `div` 3)+      nr = nRounds len - 1+      rounds = [0 .. nr]+  buf <- V.thaw buf+  tmp <- MV.new len+  forM_ [0..nRounds len - 1] $ \rond -> do+    roundDecryptST rprime (invSbox wring) xornary buf tmp (nr - rond)+  pure buf++-- Use either the ST version or the Fun version.+-- Fun takes 4.2 times as long as ST when encrypting or decrypting a file,+-- but doing six threads in parallel for cryptanalysis, it takes only+-- 1.58 times as long. Turning off threading makes encrypting 5.2 times+-- as fast.++-- | Encrypts a message.+encrypt+  :: Wring -- ^ The `Wring` made with the key to encrypt with+  -> V.Vector Word8 -- ^ The plaintext+  -> V.Vector Word8 -- ^ The returned ciphertext+encrypt = encryptST++-- | Used only for cryptanalysis+encryptFixed = encryptFixedST++-- | Decrypts a message.+decrypt+  :: Wring -- ^ The `Wring` made with the key to decrypt with+  -> V.Vector Word8 -- ^ The ciphertext+  -> V.Vector Word8 -- ^ The returned plaintext+decrypt = decryptST

@@ -0,0 +1,76 @@+module Cryptography.WringTwistree.Blockize+  ( exp4_2adic+  , exp4_base2+  , binaryStr+  , blockize+  ) where++{- This module is used in Twistree.+ - It splits a lazy ByteString into blocks of 32 bytes, padding the last one+ - with 0,1,2,... .+ -}++import Data.Bits+import Data.Word+import Data.Array.Unboxed+import Data.List.Split (chunksOf)+import qualified Data.ByteString.Lazy as BL+import Cryptography.WringTwistree.Compress+import Text.Printf+import qualified Data.Vector.Unboxed as V++{-+$ stack ghci --package padic+> import Math.NumberTheory.Padic+> :set -XDataKinds+> exp 4 :: Q' 2 280 -- add 24 extra bits so that bit 255 is correct+11011110 00010001 11110010+00001001 00010100 10010100 01111111 11111110 01011100 01101101 11001010+00110100 10010101 00111100 10100101 11101110 01000101 10110110 00010111+11100000 10011100 01111111 10100011 01111111 00001000 11100000 00011000+11101011 00111010 00011010 01110010 00111000 10001110 01000001 01001101.0+-}++-- e⁴, in two binary representations, is prepended to the+-- blocks being hashed, so that if the message is only one block,+-- two different compressed blocks are combined at the end.+exp4_2adic :: V.Vector Word8+exp4_2adic = V.fromListN 32+  [ 0x4d, 0x41, 0x8e, 0x38, 0x72, 0x1a, 0x3a, 0xeb+  , 0x18, 0xe0, 0x08, 0x7f, 0xa3, 0x7f, 0x9c, 0xe0+  , 0x17, 0xb6, 0x45, 0xee, 0xa5, 0x3c, 0x95, 0x34+  , 0xca, 0x6d, 0x5c, 0xfe, 0x7f, 0x94, 0x14, 0x09+  ]++exp4_base2 :: V.Vector Word8+exp4_base2 = V.fromListN 32+  [ 0xe8, 0xa7, 0x66, 0xce, 0x5b, 0x2e, 0x8a, 0x39+  , 0x4b, 0xb7, 0x89, 0x2e, 0x0c, 0xd5, 0x94, 0x05+  , 0xda, 0x72, 0x7b, 0x72, 0xfb, 0x77, 0xda, 0x1a+  , 0xcf, 0xb0, 0x74, 0x4e, 0x5c, 0x20, 0x99, 0x36+  ]++{-+                 01 =    1/1   = 01+                 04 =    4/1   = 04+                 08 =   16/2   = 08+...5555555555555560 =   64/6   = 0a.aaaaaaaaaaaaaa...+...5555555555555560 =  256/24  = 0a.aaaaaaaaaaaaaa...+...7777777777777780 = 1024/120 = 08.88888888888888...+...a4fa4fa4fa4fa500 = 4096/720 = 05.b05b05b05b05b0...+   ----------------      ...     -----------------+...eb3a1a72388e414d =  exp(4)  = 36.99205c4e74b0cf...+-}++binaryStr :: [Word8] -> String+binaryStr [] = ""+binaryStr (a:as) = (printf "%08b " a)++(binaryStr as)++pad :: BL.ByteString -> [Word8]+pad bs = (BL.unpack bs) ++ [0..(blockSize-1)]++-- Breaks into blocks of 32 bytes, padding the last one to 32 bytes.+-- If the last block is already 32 bytes, adds another block of 32 bytes.+blockize :: BL.ByteString -> [V.Vector Word8]+blockize bs = map (V.fromListN blockSize) $ filter ((== blockSize) . length) $+  chunksOf blockSize $ pad bs

@@ -0,0 +1,145 @@+module Cryptography.WringTwistree.Compress+  ( blockSize+  , relPrimes+  , lfsr+  , backCrc+  , compress+  , compress2+  , compress3+  ) where++{- This module is used in Twistree.+ - It compresses two or three 32-byte blocks into one, using three s-boxes in+ - an order specified by the sboxalt argument.+ -}++import Data.Bits+import Data.Word+import Data.List (mapAccumR)+import Data.Array.Unboxed+import Cryptography.WringTwistree.Mix3+import Cryptography.WringTwistree.RotBitcount+import Cryptography.WringTwistree.Sboxes+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Unboxed.Mutable as MV+import Control.Monad.ST+import Control.Monad+import Debug.Trace++blockSize :: Integral a => a+blockSize = 32+twistPrime :: Integral a => a+twistPrime = 37+-- blockSize must be a multiple of 4. Blocks in the process of compression+-- can be any size from blockSize to 3*blockSize in steps of 4. twistPrime is+-- the smallest prime greater than blockSize, which is relatively prime to all+-- block sizes during compression.++relPrimes :: UArray Word16 Word16+-- 3/4 of this is waste. The numbers are Word16, because the last number is+-- 19, and the program will multiply 37 by 19, which doesn't fit in Word8.+relPrimes = listArray (blockSize,3*blockSize)+  (map (fromIntegral . findMaxOrder . (`div` 3))+       [blockSize..3*blockSize])++lfsr1 :: Word32 -> Word32+lfsr1 n = xor ((n .&. 1) * 0x84802140) (n .>>. 1)++lfsr :: UArray Word32 Word32+lfsr = listArray (0,255) (map (\n -> (iterate lfsr1 (fromIntegral n)) !! 8) [0..255])++backCrc1 :: Word32 -> Word32 -> Word32+backCrc1 a b = (a .>>. 8) `xor` (lfsr ! (a .&. 255)) `xor` b++backCrcM :: Word32 -> Word8 -> (Word32,Word8)+backCrcM a b = (c,(fromIntegral c)) where+  c = backCrc1 a (fromIntegral b)++backCrc :: [Word8] -> [Word8]+backCrc bytes = snd $ mapAccumR backCrcM 0xdeadc0de bytes++-- Original purely functional version, modified to use vectors++roundCompressFun :: SBox -> V.Vector Word8 -> Int -> V.Vector Word8+roundCompressFun sbox buf sboxalt = i4 where+  len = V.length buf+  rprime = relPrimes ! (fromIntegral len)+  i1 = mix3Parts buf (fromIntegral rprime)+  i2 = V.fromListN len $ map (sbox V.!) $ zipWith sboxInx (drop sboxalt cycle3) (V.toList i1)+  i3 = rotBitcount i2 twistPrime+  i4 = V.fromListN (len-4) $ backCrc (V.toList i3)++compressFun :: V.Vector Word8 -> V.Vector Word8 -> Int -> V.Vector Word8+compressFun sbox buf sboxalt+  | len <= blockSize = buf+  | len `mod` twistPrime == 0 = error "bad block size"+  | otherwise = compressFun sbox (roundCompressFun sbox buf sboxalt) sboxalt+  where len = V.length buf++-- ST monad version modifies memory in place++roundCompressST ::+  SBox ->+  MV.MVector s Word8 ->+  Int ->+  ST s (MV.MVector s Word8)+roundCompressST sbox buf sboxalt = do+  let len = MV.length buf+  let rprime = relPrimes ! (fromIntegral len)+  tmp <- MV.new len+  mix3Parts' buf (fromIntegral rprime)+  forM_ [0..len-1] $ \i -> do+    a <- MV.read buf i+    MV.write tmp i (sbox V.! (sboxInx ((i + sboxalt) `rem` 3) a))+  rotBitcount' tmp twistPrime buf+  crcVec <- MV.new (len+1)+  MV.write crcVec len 0xdeadc0de+  forM_ (reverse [0..len-1]) $ \i -> do+    a <- MV.read buf i+    c <- MV.read crcVec (i+1)+    let (c',a') = backCrcM c a+    MV.write buf i a'+    MV.write crcVec i c'+  return (MV.take (len-4) buf)++compressST :: V.Vector Word8 -> V.Vector Word8 -> Int -> V.Vector Word8+compressST sbox buf sboxalt = V.create $ do+  let len = V.length buf+  let nr = (len - blockSize) `div` 4 - 1+  let rounds = [0 .. nr]+  buf <- V.thaw buf+  res <- foldM (\b r -> roundCompressST sbox b sboxalt) buf rounds+  pure res++-- | Compresses two or three 32-byte blocks into one. Exported for cryptanalysis.+compress = compressST++{-+compress2 takes 100x operations, compress3 takes 264x operations.+Twistree does twice as many compress2 calls as compress3 calls.+So it spends 100 ms in compress2 for every 132 ms in compress3, or 43% and 57%.+Profiling shows 42.5% and 56.0%, with the rest being blockize.+Hashing 1 MiB takes 12.5 s on my box, using two threads, one for the 2-tree and+one for the 3-tree. The 3-tree takes longer, so that's 16384 compress3 calls+(ignoring the few compress2 calls in the 3-tree) in 12.5 s, or 763 µs for compress3+and 289 µs for compress2.+-}++compress2 ::+  SBox ->+  V.Vector Word8 ->+  V.Vector Word8 ->+  Int ->+  V.Vector Word8+compress2 sbox buf0 buf1 sboxalt = compress sbox buf sboxalt where+  buf = buf0 <> buf1++compress3 ::+  SBox ->+  V.Vector Word8 ->+  V.Vector Word8 ->+  V.Vector Word8 ->+  Int ->+  V.Vector Word8+compress3 sbox buf0 buf1 buf2 sboxalt = compress sbox buf sboxalt where+  buf = buf0 <> buf1 <> buf2

@@ -0,0 +1,65 @@+module Cryptography.WringTwistree.KeySchedule+  ( extendKey+  , mul65537+  , keySchedule+  , reschedule+  ) 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. KeySchedule takes a ByteString and returns a+ - sequence of 96 Word16.+ -+ - 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,foldl')+import qualified Data.Sequence as Seq+import Data.Sequence ((><), (<|), (|>), Seq((:<|)), Seq((:|>)), update)+import qualified Data.ByteString as B++-- This sequence was used as the PRNG in an Apple implementation of Forth.+-- Its cycle length is 64697.+swap13mult :: [Word16]+swap13mult = 1 : map ((`rotate` 8) . (* 13)) swap13mult++extendKey_ :: [Word8] -> Int -> Int -> [Word16]+extendKey_ str i n+  | i >= n = []+  | otherwise = (map (+ (fromIntegral (256*i))) $ map fromIntegral str)+                ++ (extendKey_ str (i+1) n)++extendKey :: B.ByteString -> [Word16]+-- Extends the key, if it isn't empty, to be at least as long as 384 words.+extendKey str = extendKey_ (B.unpack str) 0 n where+  n = if (B.length str)>0 then -((-384) `div` (B.length str)) else 0++-- | Multiplies two nonzero numbers mod 65537. Exported for testing.+mul65537 :: Word16 -> Word16 -> Word16+mul65537 a b = fromIntegral ((((fromIntegral a)+1) * +                              ((fromIntegral b)+1))+                             `mod` (65537::Word64) - 1)+-- 65537::Word32 gives the wrong answer for mul65537 65535 65535,+-- since 65536*65536 overflows a Word32.++alter :: Seq.Seq Word16 -> (Word16,Int) -> Seq.Seq Word16+-- subkey is 96 long. Alters the element at position inx.+alter subkey (keyWord,inx) = update inx newval subkey where+  i1 = mul65537 (Seq.index subkey inx) keyWord+  i2 = i1 + ((Seq.index subkey (mod (inx+59) 96)) `xor`+             (Seq.index subkey (mod (inx+36) 96)) `xor`+             (Seq.index subkey (mod (inx+62) 96)))+  newval = rotate i2 8++keySchedule :: B.ByteString -> Seq.Seq Word16+keySchedule key = foldl' alter initial extended where+  extended = zip (extendKey key) (map (`mod` 96) [0..])+  initial = Seq.fromList (take 96 swap13mult)++reschedule :: Seq.Seq Word16 -> Seq.Seq Word16+reschedule subkey = foldl' alter subkey (zip (repeat 40504) [0..95])+-- 40505 is a primitive root near 65537/φ

@@ -0,0 +1,128 @@+{-# LANGUAGE BangPatterns #-}+module Cryptography.WringTwistree.Mix3+  ( findMaxOrder+  , mix3Parts+  , mix3Parts'+  ) where++{- This module is used in Wring.+ - This module splits a buffer (an array of bytes) into three equal parts, with+ - 0, 1, or 2 bytes left over, and mixes them as follows:+ -+ - The mix function takes three bytes and flips each bit which is not the same+ - in all three bytes. This is a self-inverse, nonlinear operation.+ -+ - The 0th third is traversed forward, the 1st third is traversed backward,+ - and the 2nd third is traversed by steps close to 1/φ the length of a third.+ - Taking a 16-byte buffer as an example:+ - 00 0d 1a 27 34|41 4e 5b 68 75|82 8f 9c a9 b6|c3+ - <>            |            <>|<>            |+ -    <>         |         <>   |         <>   |+ -       <>      |      <>      |   <>         |+ -          <>   |   <>         |            <>|+ -             <>|<>            |      <>      |+ - f7 e8 cf de c9|bc b7 8e 8d 82|75 5a 61 4c 4f|c3+ -}++import Data.Bits+import Data.Word+import Data.Array.Unboxed+import Math.NumberTheory.ArithmeticFunctions+import GHC.Natural+import Math.NumberTheory.Primes+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Unboxed.Mutable as MV+import Control.Monad.ST+import Control.Monad++{-# INLINE mix #-}+mix :: Word8 -> Word8 -> Word8 -> Word8+mix a b c = xor a mask+  where mask = (a .|. b .|. c) - (a .&. b .&. c)++fibonacci = 0 : 1 : zipWith (+) fibonacci (tail fibonacci)++fiboPair :: Integer -> [Integer]+fiboPair n = take 2 $ dropWhile (<= n) fibonacci++searchDir :: Integer -> (Integer,Int)+-- fst=n/φ rounded to nearest. snd=+1 or -1, indicating search direction.+-- e.g. if n=89, returns (55,1). Search 55,56,54,57,53...+-- if n=144, returns (89,(-1)). Search 89,88,90,87,91...+searchDir n+  | r*2 < den = (q,1)+  | otherwise = (q+1,(-1))+  where [num,den] = fiboPair (2*n)+        (q,r) = (n*num) `divMod` den++isMaxOrder :: Integral a => a -> a -> [a] -> a -> Bool+-- isMaxOrder modl car fac n+-- where modl is the modulus, car is its Carmichael function,+-- fac is the set of prime factors of car (without multiplicities),+-- and n is the number being tested.+-- Returns true if n has maximum order, which implies it's a primitive root+-- if modulus has any primitive roots.+isMaxOrder modl car fac n = (powModNatural nn ncar nmodl) == 1 && allnot1+  where nn = (fromIntegral n) :: Natural+        ncar = (fromIntegral car) :: Natural+        nmodl = (fromIntegral modl) :: Natural+        powns = map ((\x -> powModNatural nn (fromIntegral x) nmodl) . (car `div`)) fac+        allnot1 = foldl (&&) True (map (/= 1) powns)++searchSeq = map (\n -> if (odd n) then (n `div` 2 + 1) else (-n `div` 2)) [0..]++searchFrom :: (Integer,Int) -> [Integer]+searchFrom (start,dir) = map (\x -> x*(fromIntegral dir)+start) searchSeq++findMaxOrder :: Integer -> Integer+-- n must be positive.+-- Returns the number of maximum multiplicative order mod n closest to n/φ.+-- n=1 is a special case, as (isMaxOrder 1 1 [] i) returns False for all i>=0.+findMaxOrder 1 = 1+findMaxOrder n = head $ filter (isMaxOrder n car fac) $ searchFrom $ searchDir n+  where car = carmichael n+        fac = map (unPrime . fst) $ factorise car++triplicate :: [(a,a,a)] -> [(a,a,a)]+triplicate [] = []+triplicate ((a,b,c):xs) = (a,b,c):(b,c,a):(c,a,b):triplicate xs++mixOrder :: Int -> Int -> [(Int,Int,Int)]+-- rprime is relatively prime to len `div` 3+mixOrder len rprime+  | len < 3 = []+  | otherwise = triplicate mixord+  where+    third = len `div` 3+    mixord = zip3+      [0..third-1]+      (map ((2*third-1) -) [0..])+      (map ((2*third) +) (iterate (\x -> (x + rprime) `mod` third) 0))++-- | Splits @buf@ into three equal parts, with 0-2 bytes left over,+-- and mixes the three parts. Exported for testing.+mix3Parts :: V.Vector Word8 -> Int -> V.Vector Word8+-- The index of buf must start at 0.+-- Compute rprime once (findMaxOrder (fromIntegral (div len 3)))+-- and pass it to mix3Parts on every round.+mix3Parts buf rprime = buf V.// mixed+  where+    mixed = map (\(a,b,c) -> (a, mix (buf V.! a) (buf V.! b) (buf V.! c))) order+    order = mixOrder len rprime+    len = V.length buf++mix3Parts' :: MV.MVector s Word8 -> Int -> ST s ()+mix3Parts' buf rprime = do+    let third = MV.length buf `quot` 3+        go _  _  _  0 = pure ()+        go !a !b !c n = do+            x <- MV.read buf a+            y <- MV.read buf b+            z <- MV.read buf c+            let mask = (x .|. y .|. z) - (x .&. y .&. z)+            MV.write buf a (x `xor` mask)+            MV.write buf b (y `xor` mask)+            MV.write buf c (z `xor` mask)+            let c' = c + rprime+            go (a+1) (b-1) (if c' >= 3*third then c' - third else c') (n-1)+    go 0 (2*third - 1) (2*third) third

@@ -0,0 +1,69 @@+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 n = map fromIntegral [x2,x3,x4,x5,x6,x7,x8] where+  x2 = n .&. 1+  x4 = (n `div` 2) .&. 3+  x8 = (n `div` 8) .&. 7+  x18 = (n `div` 64) .&. 15 + 1+  x3 = x18 `mod` 3+  x6 = x18 `div` 3+  x35' = (n `div` 1024) .&. 31 + 1+  x35 = if x35' > 16 then x35' + 1 else x35'+  x5 = x35 `mod` 5+  x7 = x35 `div` 5++swapmute :: Seq.Seq a -> [Int] -> Int -> Seq.Seq a+swapmute ys [] _ = ys+swapmute ys (x:xs) n = swapmute ys' xs (n+1) where+  b = Seq.index ys x+  c = Seq.index ys n+  ys' = update x c (update n b ys)++-- | Permutes a `Seq` of eight bytes. Exported for testing.+permut8 :: Seq.Seq a -> Word16 -> Seq.Seq a+permut8 ys n = swapmute ys (swapOrder n) 1++permut8x32 :: Seq.Seq Word16 -> Seq.Seq a -> Seq.Seq a+permut8x32 _ Seq.Empty = Seq.Empty+permut8x32 Seq.Empty sbox = sbox -- this should never happen+permut8x32 key sbox = permHead >< permTail where+  permHead = permut8 (Seq.take 8 sbox) (Seq.index key 0)+  permTail = permut8x32 (Seq.drop 1 key) (Seq.drop 8 sbox)++-- polynomial 100011101, 3 bit overflow table+shift3    = listArray (0,7) [0x00,0x1d,0x3a,0x27,0x74,0x69,0x4e,0x53] :: UArray Int Int+invShift3 = listArray (0,7) [0x00,0xad,0x47,0xea,0x8e,0x23,0xc9,0x64] :: UArray Int Int++dealInx :: Int -> Int+dealInx n = ((n .&. 0x1f) .<<. 3) `xor` (shift3 ! ((n .&. 0xe0) .>>. 5))++invDealInx :: Int -> Int+invDealInx n = ((n .&. 0xf8) .>>. 3) `xor` (invShift3 ! (n .&. 0x07))++dealBytes :: Seq.Seq a -> Seq.Seq a -- must be 256 long+dealBytes bs = Seq.fromList $ map (Seq.index bs) $ map invDealInx [0..255]++permute256 :: Seq.Seq Word16 -> Seq.Seq Word8+permute256 k = dealBytes $ permut8x32 k2 $ dealBytes $ permut8x32 k1 $+               dealBytes $ permut8x32 k0 $ Seq.fromList [0..255] where+  k012 = Seq.chunksOf 32 k+  k0 = Seq.index k012 0+  k1 = Seq.index k012 1+  k2 = Seq.index k012 2

@@ -0,0 +1,84 @@+{-# LANGUAGE BangPatterns #-}+module Cryptography.WringTwistree.RotBitcount+  ( rotBitcount+  , rotBitcount'+  , rotFixed+  , rotFixed'+  )  where++{- This module is used in both Wring and Twistree.+ - It rotates an array of bytes by a multiple of its bitcount,+ - producing another array of the same size. As long as the multiplier+ - is relatively prime to the number of bits in the array, this+ - operation satisfies the strict avalanche criterion. Changing *two*+ - bits, however, has half a chance of changing only two bits in+ - the output.+ -+ - Bit 0 of byte 0 is bit 0 of the array. Bit 0 of byte 1 is bit 8 of the array.+ - e1 00 00 00 00 00 00 00, rotated by its bitcount (4), becomes+ - 10 0e 00 00 00 00 00 00.+ -}++import Data.Bits+import Data.Word+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Unboxed.Mutable as MV+import Control.Monad.ST+import Control.Monad+import Debug.Trace++rotBitcount :: V.Vector Word8 -> Int -> V.Vector Word8+-- See Rust code for a timing leak which may be present in (.>>.).+rotBitcount src mult = V.fromListN len+  [ (src V.! ((i+len-byte)   `mod` len) .<<. bit) .|.+    (src V.! ((i+len-byte-1) `mod` len) .>>. (8-bit)) | i <- [0..(len-1)]]+  where+    len = V.length src+    multmod = if len>0 then mult `mod` (len * 8) else mult+    bitcount = sum $ map popCount $ V.toList src+    rotcount = if len>0 then (bitcount * multmod) `mod` (len * 8)+			else bitcount * multmod+    !byte = rotcount .>>. 3+    !bit = rotcount .&. 7++rotBitcount' :: MV.MVector s Word8 -> Int -> MV.MVector s Word8 -> ST s ()+rotBitcount' src mult dst = do+    bitcount <- MV.foldl' (\acc x -> acc + popCount x) 0 src+    let len = MV.length src+        !multmod = if len>0 then mult `mod` (len * 8) else mult+        rotcount = if len>0 then (bitcount * multmod) `rem` (len * 8)+			    else bitcount * multmod+        !byte = rotcount .>>. 3+        !bit = rotcount .&. 7+    forM_ [0..MV.length src - 1] $ \i -> do+        l <- MV.read src ((i+len-byte) `rem` len)+        r <- MV.read src ((i+len-byte-1) `rem` len)+        MV.write dst i ((l .<<. bit) .|. (r .>>. (8-bit)))++-- For cryptanalyzing a weakened version which replaces the SACful rotBitcount+-- with a linear fixed rotation. It rotates by two more than half the number+-- of bits in the buffer, times mult.+rotFixed :: V.Vector Word8 -> Int -> V.Vector Word8+rotFixed src mult = V.fromListN len+  [ (src V.! ((i+len-byte)   `mod` len) .<<. bit) .|.+    (src V.! ((i+len-byte-1) `mod` len) .>>. (8-bit)) | i <- [0..(len-1)]]+  where+    len = V.length src+    multmod = mult `mod` (len * 8)+    bitcount = len * 4 + 2+    rotcount = (bitcount * multmod) `mod` (len * 8)+    !byte = rotcount .>>. 3+    !bit = rotcount .&. 7++rotFixed' :: MV.MVector s Word8 -> Int -> MV.MVector s Word8 -> ST s ()+rotFixed' src mult dst = do+    let len = MV.length src+        bitcount = len * 4 + 2+        !multmod = mult `mod` (len * 8)+        rotcount = (bitcount * multmod) `rem` (len * 8)+        !byte = rotcount .>>. 3+        !bit = rotcount .&. 7+    forM_ [0..MV.length src - 1] $ \i -> do+        l <- MV.read src ((i+len-byte) `rem` len)+        r <- MV.read src ((i+len-byte-1) `rem` len)+        MV.write dst i ((l .<<. bit) .|. (r .>>. (8-bit)))

@@ -0,0 +1,74 @@+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 whichBox n = fromIntegral whichBox*256 + fromIntegral n++cycle3 :: [Word8]+cycle3 = 0 : 1 : 2 : cycle3++-- | Computes S-boxes from a key. Exported for cryptanalysis.+sboxes :: B.ByteString -> SBox+sboxes key = V.fromListN (3*256) (box0 ++ box1 ++ box2) where+  box0seq = keySchedule key+  box1seq = reschedule box0seq+  box2seq = reschedule box1seq+  box0 = toList (permute256 box0seq)+  box1 = toList (permute256 box1seq)+  box2 = toList (permute256 box2seq)++invert :: SBox -> SBox+invert sbox = V.replicate (3*256) 0 V.//+  [(i*256 + fromIntegral (sbox V.! (i*256 + j)), fromIntegral j) | i <- [0..2], j <- [0..255]]++-- | A linear `SBox` used for cryptanalysis+linearSbox, linearInvSbox :: SBox+linearSbox = V.fromListN (3*256)+  [ rotate j (fromIntegral (3*i+1)) | i <- [0..2], j <- [0..255] ]++linearInvSbox = V.fromListN (3*256)+  [ (rotate j (fromIntegral (7-3*i))) | i <- [0..2], j <- [0..255] ]++sameBitcount1 :: SBox -> Word8 -> Bool+sameBitcount1 sbox n =+  popCount (sbox V.! (sboxInx 0 n)) == popCount (sbox V.! (sboxInx 1 n)) &&+  popCount (sbox V.! (sboxInx 1 n)) == popCount (sbox V.! (sboxInx 2 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 = [x | x <- [0..255], sameBitcount1 sbox x]

@@ -0,0 +1,354 @@+{-# LANGUAGE InstanceSigs #-}+import Data.Word+import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Test.Tasty.HUnit+import Cryptography.Wring+import Cryptography.Twistree+import qualified Data.Sequence as Seq+import Data.Foldable (toList)+import Data.Vector.Unboxed (fromListN,fromList)+import Data.ByteString.UTF8 (fromString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL++key96 = "Водворетраванатраведрова.Нерубидрованатраведвора!"+key30 = "Πάντοτε χαίρετε!"+key6 = "aerate"+-- key96 is also used as a plaintext for hashing because 32|96.+text31 = "בראשית ברא אלהים "  --start of Bible+text33 = "árvíztűrő tükörfúrógépek"+text59049 = BL.pack $ map xorn [1..59049::Int]+-- This long test vector is intended for testing parallel implementations.+wring96 = keyedWring $ fromString key96+wring30 = keyedWring $ fromString key30+wring6 = keyedWring $ fromString key6+wring0 = keyedWring $ fromString ""+twistree96 = keyedTwistree $ fromString key96+twistree30 = keyedTwistree $ fromString key30+twistree6 = keyedTwistree $ fromString key6+twistree0 = keyedTwistree $ fromString ""++main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [properties, unitTests, testVectorsWring, testVectorsTwistree]++properties :: TestTree+properties = testGroup "Properties" [qcProps]++wrapPermut8 :: [a] -> Word16 -> [a]+wrapPermut8 as n = toList $ permut8 (Seq.fromList as) n++stringToBytes :: String -> [Word8]+stringToBytes = B.unpack . fromString++seq40504 = 0 : map (mul65537 40504) seq40504++qcProps = testGroup "(checked by QuickCheck)"+  [ QC.testProperty "repaints" $+      \x -> wrapPermut8 "repaints" x /= "pantries"+  , QC.testProperty "mul65537" $+      \x y -> mul65537 x y == mul65537 (65535-x) (65535-y)+  , QC.testProperty "roundtrip" $+      \a b c d e f g h ->+        (decrypt wring0 $ encrypt wring0 (fromListN 8 [a,b,c,d,e,f,g,h]))+        == (fromListN 8 [a,b,c,d,e,f,g,h])+  ]++unitTests = testGroup "Unit tests"+  [ testCase "calipers" $+      (wrapPermut8 "calipers" 0x3c45) @?= "spiracle"+  , testCase "recounts" $+      (wrapPermut8 "recounts" 0x595b) @?= "construe"+  , testCase "thousand" $+      (wrapPermut8 "thousand" 0x30da) @?= "handouts"+  , testCase "mul65537 40504" $+      (length $ takeWhile (/= 0) $ tail seq40504) @?= 65535+  , testCase "mul65537 65535" $+      (mul65537 65535 65535) @?= 0+  ]++testVectorsWring = testGroup "Test vectors for Wring"+  [ testCase "lin8nulls" $+      (encrypt linearWring (fromListN 8 [0,0,0,0,0,0,0,0]))+      @?= fromListN 8 [0x04,0xd7,0x16,0x6a,0xca,0x70,0x57,0xbc]+  , testCase "lin8ff" $+      (encrypt linearWring (fromListN 8 [255,255,255,255,255,255,255,255]))+      @?= fromListN 8 [0x84,0x91,0x95,0xa0,0x9f,0x48,0x4b,0x59]+  , testCase "lin8Twistree" $+      (encrypt linearWring (fromListN 8 $ stringToBytes "Twistree"))+      @?= fromListN 8 [0xed,0x4b,0x2e,0xc6,0xc4,0x39,0x65,0x2b]+  , testCase "lin9nulls" $+      (encrypt linearWring (fromListN 9 [0,0,0,0,0,0,0,0,0]))+      @?= fromListN 9 [0xad,0x93,0x5e,0x85,0xe1,0x49,0x45,0xca,0xe2]+  , testCase "lin9ff" $+      (encrypt linearWring (fromListN 9 [255,255,255,255,255,255,255,255,255]))+      @?= fromListN 9 [0x36,0xdf,0x60,0xae,0xf5,0xbd,0x1a,0xaf,0x6e]+  , testCase "lin9AllOrNone" $+      (encrypt linearWring (fromListN 9 $ stringToBytes "AllOrNone"))+      @?= fromListN 9 [0x53,0x28,0xe7,0xc7,0xe0,0x71,0xa5,0x2e,0x8c]+  , testCase "null8nulls" $+      (encrypt wring0 (fromListN 8 [0,0,0,0,0,0,0,0]))+      @?= fromListN 8 [0x77,0x3e,0x34,0x8f,0x48,0xa1,0x24,0x1a]+  , testCase "null8ff" $+      (encrypt wring0 (fromListN 8 [255,255,255,255,255,255,255,255]))+      @?= fromListN 8 [0xc7,0xa7,0x58,0xed,0x5c,0x2b,0xb6,0xec]+  , testCase "null8Twistree" $+      (encrypt wring0 (fromListN 8 $ stringToBytes "Twistree"))+      @?= fromListN 8 [0xa3,0xcf,0xd4,0xa1,0x0d,0x7e,0xb7,0xb3]+  , testCase "null9nulls" $+      (encrypt wring0 (fromListN 9 [0,0,0,0,0,0,0,0,0]))+      @?= fromListN 9 [0x10,0x10,0x95,0x96,0x90,0xb5,0x97,0xeb,0x38]+  , testCase "null9ff" $+      (encrypt wring0 (fromListN 9 [255,255,255,255,255,255,255,255,255]))+      @?= fromListN 9 [0x09,0x0f,0xf3,0x66,0x36,0xa4,0xac,0x8d,0x5c]+  , testCase "null9AllOrNone" $+      (encrypt wring0 (fromListN 9 $ stringToBytes "AllOrNone"))+      @?= fromListN 9 [0xee,0x15,0x02,0x05,0xdd,0xa9,0x77,0xe4,0x23]+  , testCase "aerate8nulls" $+      (encrypt wring6 (fromListN 8 [0,0,0,0,0,0,0,0]))+      @?= fromListN 8 [0x23,0x44,0x2e,0x6e,0xf3,0xd7,0xa0,0x7e]+  , testCase "aerate8ff" $+      (encrypt wring6 (fromListN 8 [255,255,255,255,255,255,255,255]))+      @?= fromListN 8 [0x7e,0x05,0xae,0x5c,0x64,0xdd,0xf4,0xeb]+  , testCase "aerate8Twistree" $+      (encrypt wring6 (fromListN 8 $ stringToBytes "Twistree"))+      @?= fromListN 8 [0x36,0x39,0x14,0x22,0x40,0x7f,0xc3,0x79]+  , testCase "aerate9nulls" $+      (encrypt wring6 (fromListN 9 [0,0,0,0,0,0,0,0,0]))+      @?= fromListN 9 [0x41,0xc1,0x44,0x0f,0x07,0x2d,0x92,0xbf,0x43]+  , testCase "aerate9ff" $+      (encrypt wring6 (fromListN 9 [255,255,255,255,255,255,255,255,255]))+      @?= fromListN 9 [0x46,0xb0,0x57,0x43,0xfb,0xdb,0x9d,0x32,0x88]+  , testCase "aerate9AllOrNone" $+      (encrypt wring6 (fromListN 9 $ stringToBytes "AllOrNone"))+      @?= fromListN 9 [0x5e,0x3b,0x49,0xd4,0xb8,0x70,0xdd,0x07,0xac]+  , testCase "χαίρετε8nulls" $+      (encrypt wring30 (fromListN 8 [0,0,0,0,0,0,0,0]))+      @?= fromListN 8 [0x90,0x4d,0x00,0x3e,0x39,0x75,0x9e,0xe4]+  , testCase "χαίρετε8ff" $+      (encrypt wring30 (fromListN 8 [255,255,255,255,255,255,255,255]))+      @?= fromListN 8 [0x85,0x56,0x3d,0x4e,0x84,0x5a,0x14,0xe3]+  , testCase "χαίρετε8Twistree" $+      (encrypt wring30 (fromListN 8 $ stringToBytes "Twistree"))+      @?= fromListN 8 [0x96,0x89,0x48,0x50,0x98,0x26,0xeb,0x03]+  , testCase "χαίρετε9nulls" $+      (encrypt wring30 (fromListN 9 [0,0,0,0,0,0,0,0,0]))+      @?= fromListN 9 [0x04,0xb0,0x1e,0xdf,0xd3,0xf0,0x39,0xa3,0x3c]+  , testCase "χαίρετε9ff" $+      (encrypt wring30 (fromListN 9 [255,255,255,255,255,255,255,255,255]))+      @?= fromListN 9 [0x7c,0x67,0xeb,0xc8,0x40,0x97,0xc2,0x5f,0x82]+  , testCase "χαίρετε9AllOrNone" $+      (encrypt wring30 (fromListN 9 $ stringToBytes "AllOrNone"))+      @?= fromListN 9 [0x4b,0xb2,0x68,0xe9,0xf1,0x64,0x0a,0x44,0xc4]+  , testCase "двор8nulls" $+      (encrypt wring96 (fromListN 8 [0,0,0,0,0,0,0,0]))+      @?= fromListN 8 [0x9c,0xc1,0x3c,0xe7,0x8a,0xc5,0x6f,0x18]+  , testCase "двор8ff" $+      (encrypt wring96 (fromListN 8 [255,255,255,255,255,255,255,255]))+      @?= fromListN 8 [0x37,0x42,0x00,0x47,0xd5,0x2f,0x9d,0x7f]+  , testCase "двор8Twistree" $+      (encrypt wring96 (fromListN 8 $ stringToBytes "Twistree"))+      @?= fromListN 8 [0x15,0x06,0xc6,0xa6,0x3d,0xef,0x19,0xf1]+  , testCase "двор9nulls" $+      (encrypt wring96 (fromListN 9 [0,0,0,0,0,0,0,0,0]))+      @?= fromListN 9 [0xd6,0x7b,0x2c,0xcc,0x71,0x24,0x5d,0x06,0x07]+  , testCase "двор9ff" $+      (encrypt wring96 (fromListN 9 [255,255,255,255,255,255,255,255,255]))+      @?= fromListN 9 [0xd3,0xa8,0x3f,0xb6,0x9a,0x5e,0x0f,0x07,0x11]+  , testCase "двор9AllOrNone" $+      (encrypt wring96 (fromListN 9 $ stringToBytes "AllOrNone"))+      @?= fromListN 9 [0x53,0x6c,0x7e,0x2d,0xcd,0xda,0xdc,0xf2,0x70]+  , testCase "searchDir" $+      (encrypt wring96 (fromList $ stringToBytes key96))+      -- This comes from a typo when translating to Julia. All the 8- and 9-byte+      -- tests passed, but the relPrimes entry which is findMaxOrder(32) was+      -- wrong, because it was searching in the wrong direction.+      -- This typo would also cause all hashes of strings >31 bytes to be wrong.+      @?= fromList+        [ 0xed, 0xbb, 0x75, 0xc4, 0xb2, 0xc9, 0xd2, 0x82+        , 0xa5, 0xbe, 0x37, 0x62, 0x4f, 0x5e, 0x7c, 0x1e +        , 0x22, 0x59, 0xca, 0x7a, 0x66, 0xb3, 0xa7, 0x91+        , 0x34, 0xec, 0x50, 0x2e, 0x45, 0x3e, 0xc5, 0xc3+        , 0xcc, 0xf3, 0xa3, 0x49, 0x72, 0x38, 0x3e, 0x5c+        , 0xf6, 0x91, 0x44, 0x1c, 0x04, 0xf7, 0x80, 0x45 +        , 0xdb, 0x9c, 0xcb, 0xe6, 0x08, 0xa2, 0x8d, 0x6a+        , 0x5d, 0x28, 0x68, 0x93, 0x43, 0xa8, 0xb2, 0x65+        , 0x2b, 0xc3, 0x1e, 0xa3, 0x70, 0xcc, 0x1e, 0x40+        , 0xee, 0x7d, 0xa8, 0x19, 0x00, 0x72, 0x1e, 0x19 +        , 0x46, 0xb1, 0x18, 0x6d, 0x9c, 0x7d, 0x88, 0x59+        , 0x1b, 0x25, 0x01, 0x5d, 0x9d, 0xd7, 0x7c, 0x6d+        ]+  ]++testVectorsTwistree = testGroup "Test vectors for Twistree"+  [ testCase "linearnull" $+      (hash linearTwistree (BL.fromStrict $ fromString ""))+      @?= fromList+        [ 0x51, 0xce, 0xe6, 0x7e, 0xbc, 0x77, 0xf0, 0xc8+        , 0xab, 0xa4, 0x8c, 0x39, 0x9a, 0x33, 0x46, 0xe7 +        , 0xe2, 0x1e, 0xc9, 0xc1, 0x39, 0x8f, 0xdb, 0x99+        , 0xb2, 0x9c, 0x41, 0x37, 0xd0, 0xd7, 0x53, 0xc2+        ]+  , testCase "linearברא" $+      (hash linearTwistree (BL.fromStrict $ fromString text31))+      @?= fromList+        [ 0x20, 0x8d, 0x61, 0x88, 0x7c, 0x13, 0x27, 0x9f+        , 0x41, 0x26, 0x48, 0x31, 0x5e, 0x64, 0x2b, 0x0e +        , 0xb1, 0xf1, 0xb6, 0xd2, 0xf9, 0x8f, 0x20, 0x29+        , 0x15, 0xf7, 0xf1, 0xe2, 0x31, 0xf3, 0x74, 0x18+        ]+  , testCase "lineargép" $+      (hash linearTwistree (BL.fromStrict $ fromString text33))+      @?= fromList+        [ 0x61, 0x6b, 0x91, 0xe4, 0x6f, 0xab, 0x4c, 0x69+        , 0x03, 0xea, 0x9f, 0x2b, 0xc0, 0x0e, 0x90, 0xa2 +        , 0xe4, 0x40, 0xc3, 0x87, 0x1c, 0xa2, 0x27, 0x5a+        , 0x12, 0x10, 0x59, 0x4d, 0x8b, 0x33, 0x7f, 0x9e+        ]+  , testCase "linearдвор" $+      (hash linearTwistree (BL.fromStrict $ fromString key96))+      @?= fromList+        [ 0x34, 0x82, 0x7e, 0xbe, 0x74, 0x06, 0x8e, 0xe1+        , 0xe7, 0x37, 0xaf, 0x31, 0x93, 0x2c, 0xd1, 0x85 +        , 0x35, 0x8c, 0x32, 0x1c, 0x0c, 0xc1, 0xda, 0x47+        , 0x97, 0x57, 0x18, 0xca, 0x57, 0xe3, 0xc8, 0xf8+        ]+  , testCase "nullnull" $+      (hash twistree0 (BL.fromStrict $ fromString ""))+      @?= fromList+        [ 0x5b, 0x62, 0x5d, 0xeb, 0x4f, 0xa6, 0x92, 0xae+        , 0x56, 0xf9, 0xba, 0x20, 0xf6, 0xb4, 0xc1, 0x05 +        , 0xff, 0x92, 0x92, 0x3c, 0x7e, 0x84, 0xee, 0x2f+        , 0x83, 0xc1, 0x0d, 0xc2, 0x8f, 0xda, 0xa3, 0x7b+        ]+  , testCase "nullברא" $+      (hash twistree0 (BL.fromStrict $ fromString text31))+      @?= fromList+        [ 0x4c, 0xc9, 0x2e, 0x58, 0xf2, 0x80, 0xaf, 0x58+        , 0x3e, 0x39, 0x6f, 0x3a, 0x9b, 0x7a, 0xdb, 0x59 +        , 0x65, 0x63, 0xb1, 0x28, 0x96, 0x68, 0x29, 0x83+        , 0xe4, 0x38, 0x1f, 0x79, 0x62, 0x78, 0x44, 0x0b+        ]+  , testCase "nullgép" $+      (hash twistree0 (BL.fromStrict $ fromString text33))+      @?= fromList+        [ 0x3b, 0x8c, 0x2e, 0x6d, 0x7a, 0x29, 0x0a, 0x84+        , 0xf4, 0x40, 0xe8, 0x37, 0xc9, 0xd5, 0x8c, 0x64 +        , 0x11, 0x2a, 0x42, 0x17, 0x92, 0xd3, 0x33, 0xa0+        , 0x24, 0xbe, 0xa3, 0x3f, 0x4a, 0x4b, 0x18, 0x1f+        ]+  , testCase "nullдвор" $+      (hash twistree0 (BL.fromStrict $ fromString key96))+      @?= fromList+        [ 0x4c, 0x19, 0x30, 0x4a, 0xae, 0x2a, 0x92, 0xba+        , 0x9c, 0x05, 0x69, 0x37, 0xd7, 0xfc, 0x36, 0x2d +        , 0x29, 0x94, 0x8e, 0xdc, 0x3c, 0x56, 0x4f, 0x50+        , 0x08, 0xa7, 0x5b, 0x0a, 0x06, 0x95, 0x90, 0xee+        ]+  , testCase "aeratenull" $+      (hash twistree6 (BL.fromStrict $ fromString ""))+      @?= fromList+        [ 0x0a, 0x4b, 0x98, 0x44, 0x15, 0xe7, 0x8b, 0xe2+        , 0xfe, 0xba, 0xf5, 0xe5, 0x51, 0x46, 0xe0, 0x05 +        , 0xc8, 0x0c, 0x13, 0x6b, 0xfb, 0x2f, 0x6f, 0xa4+        , 0xf6, 0x08, 0xbb, 0xa6, 0xe9, 0xf3, 0x35, 0xda+        ]+  , testCase "aerateברא" $+      (hash twistree6 (BL.fromStrict $ fromString text31))+      @?= fromList+        [ 0x73, 0xd6, 0xe9, 0xc0, 0x63, 0xd5, 0x3c, 0xec+        , 0x4d, 0xd8, 0x3f, 0x89, 0x9f, 0x15, 0xf3, 0xf8 +        , 0xe6, 0x7e, 0xfb, 0xc5, 0x46, 0x4e, 0x11, 0x60+        , 0x9c, 0x0b, 0x75, 0xed, 0x35, 0x23, 0x56, 0x60+        ]+  , testCase "aerategép" $+      (hash twistree6 (BL.fromStrict $ fromString text33))+      @?= fromList+        [ 0x77, 0x0b, 0xe3, 0xbe, 0xc4, 0x9c, 0xf9, 0xd0+        , 0xd1, 0x46, 0xda, 0x03, 0xea, 0xe5, 0x60, 0x4e +        , 0x47, 0xec, 0xf1, 0x54, 0xe8, 0x6b, 0x63, 0x93+        , 0x59, 0x52, 0xf0, 0x95, 0xb7, 0x32, 0x64, 0x0f+        ]+  , testCase "aerateдвор" $+      (hash twistree6 (BL.fromStrict $ fromString key96))+      @?= fromList+        [ 0x00, 0x0a, 0x4c, 0x5e, 0x61, 0xd8, 0xb0, 0x14+        , 0xfc, 0xe6, 0x46, 0xf9, 0xd3, 0x0f, 0xb2, 0x71 +        , 0x43, 0x8c, 0xc4, 0x3f, 0x7f, 0x72, 0x0a, 0xfe+        , 0xe1, 0xa3, 0xff, 0xd9, 0x5d, 0xe1, 0x65, 0x76+        ]+  , testCase "χαίρετεnull" $+      (hash twistree30 (BL.fromStrict $ fromString ""))+      @?= fromList+        [ 0x33, 0x69, 0xba, 0x2b, 0x72, 0x58, 0x6a, 0x78+        , 0x6f, 0xc5, 0xd7, 0xbe, 0x3c, 0x80, 0xac, 0x24 +        , 0x87, 0xb8, 0x6e, 0x2e, 0x1c, 0x4f, 0xee, 0x76+        , 0x71, 0x49, 0x51, 0x7c, 0x58, 0xfb, 0x2e, 0x5a+        ]+  , testCase "χαίρετεברא" $+      (hash twistree30 (BL.fromStrict $ fromString text31))+      @?= fromList+        [ 0xef, 0x78, 0x8f, 0x13, 0xb6, 0xb7, 0xd7, 0x9c+        , 0xae, 0xce, 0xbe, 0x56, 0x80, 0x14, 0x4a, 0x37 +        , 0x49, 0x26, 0xd6, 0x88, 0x69, 0x3e, 0x66, 0xd1+        , 0xc6, 0xeb, 0x82, 0x37, 0x57, 0x53, 0xe1, 0x13+        ]+  , testCase "χαίρετεgép" $+      (hash twistree30 (BL.fromStrict $ fromString text33))+      @?= fromList+        [ 0xf5, 0xde, 0x17, 0xa3, 0xc6, 0xde, 0x7e, 0x4f+        , 0x17, 0xf6, 0xef, 0x3a, 0xe5, 0x7b, 0x1e, 0xc3 +        , 0xa4, 0x9d, 0x9c, 0x7d, 0x85, 0x42, 0xf4, 0xb3+        , 0xd4, 0x85, 0x94, 0x4d, 0x73, 0x98, 0x79, 0x80+        ]+  , testCase "χαίρετεдвор" $+      (hash twistree30 (BL.fromStrict $ fromString key96))+      @?= fromList+        [ 0x51, 0x35, 0x1a, 0xb4, 0x7b, 0x42, 0x96, 0xab+        , 0x8c, 0xcd, 0xb7, 0xca, 0x12, 0x1b, 0xe2, 0x26 +        , 0x73, 0x0e, 0x43, 0xd4, 0x42, 0x70, 0xd6, 0x93+        , 0x0c, 0xee, 0xe2, 0xfe, 0x87, 0x88, 0x26, 0xee+        ]+  , testCase "дворnull" $+      (hash twistree96 (BL.fromStrict $ fromString ""))+      @?= fromList+        [ 0x4e, 0xfa, 0x85, 0x3a, 0xa1, 0xd2, 0x57, 0x43+        , 0x87, 0x44, 0xf4, 0x37, 0x6d, 0x11, 0x40, 0x73 +        , 0x38, 0x22, 0xc8, 0xd2, 0x2f, 0x0b, 0xb1, 0xba+        , 0x06, 0x3b, 0x8e, 0x55, 0x54, 0x70, 0x76, 0x4c+        ]+  , testCase "дворברא" $+      (hash twistree96 (BL.fromStrict $ fromString text31))+      @?= fromList+        [ 0xf9, 0x1d, 0x93, 0x79, 0x4e, 0x6e, 0xdd, 0x91+        , 0x92, 0xcd, 0x47, 0xc4, 0xe8, 0xd2, 0xf9, 0xba +        , 0x0b, 0x5e, 0xca, 0x38, 0x92, 0xa8, 0xf9, 0x6e+        , 0x2a, 0xdc, 0x49, 0xaa, 0x0c, 0x0b, 0x4d, 0xff+        ]+  , testCase "дворgép" $+      (hash twistree96 (BL.fromStrict $ fromString text33))+      @?= fromList+        [ 0xde, 0x94, 0xa0, 0x0c, 0xf4, 0x4c, 0x5a, 0xe2+        , 0xfb, 0xf7, 0x08, 0x3c, 0x9a, 0xdb, 0xda, 0x25 +        , 0xa0, 0x2a, 0x01, 0xfb, 0x68, 0x81, 0x94, 0x88+        , 0x8b, 0xc2, 0xbe, 0x1d, 0x6c, 0xae, 0x7b, 0x9c+        ]+  , testCase "двордвор" $+      (hash twistree96 (BL.fromStrict $ fromString key96))+      @?= fromList+        [ 0xb1, 0x1b, 0x84, 0x9d, 0xf7, 0xb4, 0x15, 0xa3+        , 0xf9, 0xdc, 0x69, 0x47, 0xe1, 0xd2, 0xc0, 0x20 +        , 0x64, 0x0d, 0x8f, 0xf6, 0x79, 0xb6, 0x7b, 0x69+        , 0xbc, 0x70, 0xe1, 0x2e, 0x3d, 0xd7, 0xeb, 0x57+        ]+  , testCase "двор59049" $+      (hash twistree96 text59049)+      @?= fromList+        [ 0xd2, 0xe3, 0x0f, 0x01, 0xa0, 0x32, 0x27, 0x51+        , 0x4e, 0x56, 0x44, 0xf1, 0x8f, 0x2e, 0x3e, 0xeb +        , 0xdb, 0x14, 0x30, 0xba, 0x96, 0x2c, 0x47, 0x24+        , 0x4b, 0x79, 0x39, 0x58, 0xbc, 0x4f, 0x79, 0x25+        ]+  ]