newhope (empty) → 0.1.0.0
raw patch · 43 files changed
+6727/−0 lines, 43 filesdep +AESdep +HUnitdep +QuickCheck
Dependencies added: AES, HUnit, QuickCheck, base, bytestring, containers, deepseq, hspec, mtl, parallel, raw-strings-qq, statistics, system-fileio, system-filepath, tasty, tasty-expected-failure, tasty-hunit, tasty-quickcheck, text, trifecta, vector
Files
- ChangeLog.md +6/−0
- LICENSE +206/−0
- README.md +40/−0
- app/kat/PQCgenKAT.hs +71/−0
- app/libtest/LibTest.hs +55/−0
- app/speed/Speed.hs +411/−0
- auxiliary/AuxUtil.hs +36/−0
- auxiliary/KAT.hs +145/−0
- auxiliary/Timing.hs +41/−0
- newhope.cabal +221/−0
- src/Crypto/NewHope.hs +42/−0
- src/Crypto/NewHope/CCA_KEM.hs +47/−0
- src/Crypto/NewHope/CPA_KEM.hs +45/−0
- src/Crypto/NewHope/CPA_PKE.hs +360/−0
- src/Crypto/NewHope/FIPS202.hs +432/−0
- src/Crypto/NewHope/Internal/CCA_KEM.hs +394/−0
- src/Crypto/NewHope/Internal/CPA_KEM.hs +216/−0
- src/Crypto/NewHope/Internal/RNG.hs +234/−0
- src/Crypto/NewHope/Internal/SeedExpander.hs +153/−0
- src/Crypto/NewHope/Internals.hs +86/−0
- src/Crypto/NewHope/NTT.hs +193/−0
- src/Crypto/NewHope/Poly.hs +378/−0
- src/Crypto/NewHope/Precomp.hs +365/−0
- src/Crypto/NewHope/RNG.hs +26/−0
- src/Crypto/NewHope/Reduce.hs +46/−0
- src/Crypto/NewHope/SeedExpander.hs +54/−0
- src/Crypto/NewHope/Verify.hs +62/−0
- src/MiscUtils.hs +56/−0
- src/StringUtils.hs +111/−0
- test/ConfigFile.hs +175/−0
- test/Crypto/NewHope/Test/CCA_KEM.hs +180/−0
- test/Crypto/NewHope/Test/CPA_KEM.hs +138/−0
- test/Crypto/NewHope/Test/FIPS202.hs +190/−0
- test/Crypto/NewHope/Test/NTT.hs +191/−0
- test/Crypto/NewHope/Test/Poly.hs +363/−0
- test/Crypto/NewHope/Test/RNG.hs +268/−0
- test/Crypto/NewHope/Test/Reduce.hs +61/−0
- test/Crypto/NewHope/Test/SeedExpander.hs +136/−0
- test/Crypto/NewHope/Test/Verify.hs +206/−0
- test/Statistics.hs +44/−0
- test/Test/ConfigFile.hs +102/−0
- test/Test/KAT.hs +80/−0
- test/Util.hs +61/−0
+ ChangeLog.md view
@@ -0,0 +1,6 @@+# Changelog for newhope++2019-03-?? Initial release+++
+ LICENSE view
@@ -0,0 +1,206 @@+This library was written by Jeremy Bornstein and is licensed under the+Apache License, version 2.0. The full text of the license is+reproduced below.++++ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,40 @@+This is a Haskell implementation of the [NewHope key exchange+protocol](https://newhopecrypto.org/). It has been made via+examination of the official NewHope project's [public domain C+reference code](https://github.com/newhopecrypto/newhope) and the+author is not affiliated with that team or with NIST.++This codebase has not yet been reviewed by anyone other than the+author. Until such time as it has been competently reviewed, please+consider it as a draft implementation only, and do not rely on it for+actual securtiy in practice. Judged by comparison with the reference+library, it does produce correct results but could contain subtle (or+obvious!) flaws. In addition, it has not been optimized for+performance and at this stage is probably quite a bit slower than the+reference C implementation on any given platform.++This project uses the Haskell build manager "stack" to produceː++ * `Crypto.NewHope`, a library intended for general use.++ * `PQCgenKAT` -- a binary which generates KAT (Known Answer Test)+ files in the format required by the NIST PQC project. Invoke this+ binary with the single argument "all" to generate all of the KAT+ files.++ * `speed` -- a binary which runs performance tests of some of the+ NewHope functionality. These tests correspond to largely equivalent+ tests in the reference NewHope C code.++In addition, the project contains a fair number of+automatically-evaluated tests that cover a large swath of the important+functionality implemented, including that tested by the "test"+binaries built by the reference C source, and including comparison+between the KAT output that we produce and that produced by the+reference C implementation. To run the tests and view the results,+execute `stack test` at a command line.++लोकाः समस्ताः सुखिनोभवंतु++Patches, comments, and discussion are welcome. The most appropriate+place for these for the time being is probably the Github repository.
+ app/kat/PQCgenKAT.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE Safe #-}+{-|+ Module : PQCgenKAT+ Description : Generate files for Known Answer Tests+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ PQCgenKAT means:+ Post Quantum Cryptography generate Known Answer Tests++ This generates test vectors (according to the NIST PQC spec) which+ should be identical (in filenames and contents) to the ones generated+ by the NewHope project's reference code.++ Automated tests elsewhere in this codebase which take those+ reference implementation vectors as input to verify that we generate+ the same data with the present implementation.++-}++module Main where++import Control.Monad+import Data.ByteString.Lazy.Builder (hPutBuilder)+import Data.Text as Text (pack)+import Filesystem (IOMode (WriteMode), isFile, removeFile, withTextFile)+import Filesystem.Path.CurrentOS (fromText)+import System.Environment (getArgs)+import System.Exit (ExitCode (ExitFailure), exitWith)++import qualified Crypto.NewHope as NewHope (N (N1024, N512))+import qualified KAT+++outputTestVectors :: NewHope.N -> Int -> KAT.VectorGenerator -> IO ()+outputTestVectors n count gen = do+ let (fileName, vectors) = gen n count+ let filePath = fromText . pack $ fileName -- here's where we put it in some specific directory if we like+ fileExists <- isFile filePath+ when fileExists $ removeFile filePath+ withTextFile filePath WriteMode $ \ handle -> hPutBuilder handle vectors+++outputCcaVectors :: NewHope.N -> IO ()+outputCcaVectors n = outputTestVectors n KAT.recordsToGenerate KAT.ccaKemTestVectors++outputCpaVectors :: NewHope.N -> IO ()+outputCpaVectors n = outputTestVectors n KAT.recordsToGenerate KAT.cpaKemTestVectors+++main :: IO ()+main = do+ args <- getArgs+ runCommand args+ where+ runCommand ["all"] = do outputCcaVectors NewHope.N512+ outputCcaVectors NewHope.N1024+ outputCpaVectors NewHope.N512+ outputCpaVectors NewHope.N1024++ runCommand ["cca", "512"] = outputCcaVectors NewHope.N512+ runCommand ["cca", "1024"] = outputCcaVectors NewHope.N1024+ runCommand ["cpa", "512"] = outputCpaVectors NewHope.N512+ runCommand ["cpa", "1024"] = outputCpaVectors NewHope.N1024++ runCommand _ = do+ putStrLn "Required arguments: ([ cca | cpa ] [ 512 | 1024 ]) | all"+ exitWith $ ExitFailure 1
+ app/libtest/LibTest.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : LibTest+ Description : Testing code for the Crypto.NewHope library+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Main where++import Test.Tasty++import qualified Crypto.NewHope.Test.CCA_KEM as CCA_KEM+import qualified Crypto.NewHope.Test.CPA_KEM as CPA_KEM+import qualified Crypto.NewHope.Test.FIPS202 as FIPS202+import qualified Crypto.NewHope.Test.NTT as NTT+import qualified Crypto.NewHope.Test.Poly as Poly+import qualified Crypto.NewHope.Test.Reduce as Reduce+import qualified Crypto.NewHope.Test.RNG as RNG+import qualified Crypto.NewHope.Test.SeedExpander as SeedExpander+import qualified Crypto.NewHope.Test.Verify as Verify+import qualified Test.ConfigFile as ConfigFile+import qualified Test.KAT as KAT++++main :: IO ()+main = do+ reduceTests <- Reduce.tests+ rngTests <- RNG.tests+ katTests <- KAT.tests+ ccakemTests <- CCA_KEM.tests+ nttTests <- NTT.tests+ fips202Tests <- FIPS202.tests+ polyTests <- Poly.tests+ seedExpanderTests <- SeedExpander.tests++ defaultMain (testGroup "NewHope Library Tests" [ ConfigFile.tests+ , Verify.tests+ , reduceTests+ , fips202Tests+ , polyTests+ , rngTests+ , nttTests+ , seedExpanderTests+ , CPA_KEM.tests+ , ccakemTests+ , katTests+ ])++ return ()
+ app/speed/Speed.hs view
@@ -0,0 +1,411 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Speed+ Description : Speed tests for NewHope.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ Mirrors the functionality provided by the speed_* binaries in the+ reference C library. These are not part of our automated test suite+ per se because they don't result in pass/fail: just speed numbers.++ Because Haskell is non-strict, we have to be careful about how we do+ timing. I'm no expert, but evidence seems to indicate that the+ approach taken here is effective for the circumstances: we force+ evaluation of function arguments (with `deepseq` and associated+ NFData instances) before the function itself is called. The+ function "timingAssumptionsValid" should evaluate to IO True only+ if we can trust our assumptions about how the system works, and it+ is called before the tests proper start.++-}++module Main where++import Control.DeepSeq+import qualified Data.ByteString as BS+import Data.List hiding (sum)+import qualified Data.Vector.Unboxed as VU+import System.CPUTime++import AuxUtil+import qualified Crypto.NewHope as NewHope+import qualified Crypto.NewHope.Internal.CCA_KEM as CCA_KEM+import qualified Crypto.NewHope.Internal.CPA_KEM as CPA_KEM+import qualified Crypto.NewHope.Internals as Internals+import Crypto.NewHope.Poly (Poly (..))+import qualified Crypto.NewHope.Poly as Poly hiding (Poly)+import qualified Crypto.NewHope.RNG as RNG+import Timing++-- | We use Null as the value of `deepseq` when we don't care about+-- the type of a prerequisite but still want to deepseq it.+data Null = Null deriving Show++-- | This instance lets us deepseq, which we need to control execution order during tests.+instance NFData Null+ where+ rnf _sk = ()+++testCount :: Int+testCount = 1000+++median :: [Picoseconds] -> Picoseconds+median ns = ns' !! middle+ where+ ns' = sort ns+ middle = Prelude.length ns `div` 2++mean :: [Picoseconds] -> Picoseconds+mean ns = total `div` items+ where+ total = sum ns+ items = fromIntegral $ length ns+++summarize :: String -> NewHope.N -> [Picoseconds] -> IO ()+summarize name n values = putStrLn $ name ++ " (N=" ++ show (WrapN n) ++ "): " ++ timingStr+ where+ timingStr+ | meanMilliseconds > 1 = ": mean " ++ show meanMilliseconds ++ "ms; median: " ++ show medianMilliseconds ++ "ms"+ | meanMicroseconds > 1 = ": mean " ++ show meanMicroseconds ++ "μs; median: " ++ show medianMicroseconds ++ "μs"+ | meanFemtoseconds > 1 = ": mean " ++ show meanFemtoseconds ++ "fs; median: " ++ show medianFemtoseconds ++ "fs"+ | otherwise = ": mean " ++ show meanPicoseconds ++ "ps; median: " ++ show medianPicoseconds ++ "ps"++ meanPicoseconds = mean values+ medianPicoseconds = median values++ meanMilliseconds = milliseconds meanPicoseconds+ medianMilliseconds = milliseconds medianPicoseconds++ meanMicroseconds = microseconds meanPicoseconds+ medianMicroseconds = microseconds medianPicoseconds++ meanFemtoseconds = femtoseconds meanPicoseconds+ medianFemtoseconds = femtoseconds medianPicoseconds+++-- | A TimingPair is a list of computations, the first of each which+-- is a prerequisite for the second. This is used to help isolate the+-- functions which we wish to time.+type TimingPair a b = (a, b)+++-- | Given a list of TimingPair, return a list of times that each item+-- in the corresponding pair takes to compute. The only reason we care+-- about the timing of the first item is to ensure ourselves that our+-- assumptions about how evaluation works are warranted. In most+-- cases we only want to use a wrapper around this function that+-- discards the first item of each pair.+timeEvaluationsAndPrereqs :: (NFData a, NFData b) => [TimingPair a b] -> IO [(Picoseconds, Picoseconds)]+timeEvaluationsAndPrereqs input = do+ output <- mapM go input+ -- we compute but ignore the first result for reasons detailed below+ return $ tail output+ where+ go :: (NFData c, NFData d) => (c, d) -> IO (Picoseconds, Picoseconds)+ go (c, d) = do+ start <- getCPUTime+ middle <- deepseq c getCPUTime+ end <- deepseq d getCPUTime+ return (middle - start, end - middle)+++-- | Given a list of TimingPair, return a list of times that each+-- second item in the pair takes to evaluate, after evaluation of the+-- first. We require NFData so that we can call `deepseq` to force+-- evaluation to normal form (and thereby ensure that the value is+-- computed before we check the time).+--+-- In cases where the jig itself is not being tested, we don't care+-- about the timing of the prerequisite, so this function discards it.+timeEvaluationsWithPrereqs :: (NFData a, NFData b) => [TimingPair a b] -> IO [Picoseconds]+timeEvaluationsWithPrereqs input = fmap snd <$> timeEvaluationsAndPrereqs input+++-- | Given a list of computations, return a list of times that each+-- takes to evaluate. Can be used when the function to be tested+-- takes no arguments. We require NFData so that we can call+-- `deepseq` to force evaluation to normal form (and thereby ensure+-- that the value is computed before we check the time).+timeEvaluations :: NFData a => [a] -> IO [Picoseconds]+timeEvaluations input = do+ output <- mapM go input+ -- we compute but ignore the first result for reasons detailed below+ return $ tail output+ where+ go :: NFData a => a -> IO Picoseconds+ go p = do+ start <- getCPUTime+ end <- deepseq p getCPUTime+ return $ end - start+++-- | An automatic test to let us know (by evaluating to IO True) if we+-- can seemingly trust our assumptions about how values computed by+-- prerequisites are cached in practice. If this returns IO False, we+-- probably can't trust our timing methodology: in that case,+-- something may have changed at the platform level. Our test is that+-- on each of three iterations, the expensive-to-compute prerequisite+-- must take more than 20 times as long as the cheap-to-compute main+-- function.+timingAssumptionsValid :: IO Bool+timingAssumptionsValid = prerequisitesAreVastlyMoreExpensive $ compute 3+ where+ prerequisitesAreVastlyMoreExpensive :: (NFData a, NFData b) => [TimingPair a b] -> IO Bool+ prerequisitesAreVastlyMoreExpensive f = and <$> (fmap . fmap) check times+ where+ times = timeEvaluationsAndPrereqs f+ check (a, b) = (fromIntegral b * 100) / fromIntegral a < (0.05 :: Float)++ -- a list of pairs of computations, the first of each of which+ -- should be much slower than the second, which uses the results+ -- of the first.+ compute :: Int -> [TimingPair Int Int]+ compute count = foldr go [] [0 .. count]+ where+ go a results = new : results+ where+ expensive = fact $ 1000000 + a -- takes time to compute. include 'a' so we avoid caching+ new = (expensive, testfn a)+ fact 0 = 1+ fact n = n * fact (n - 1)+ testfn b = b + expensive -- fast, apart from time spent computing expensive+++-- | An infinite list of Seeds+seeds :: [Internals.Seed]+seeds = fst <$> next ctx+ where+ ctx = let randomSeed = RNG.makeRandomSeed $ BS.pack [0 .. 47]+ in RNG.randomBytesInit randomSeed Nothing 0+ next ctx_ = (seed, ctx_) : next ctx_'+ where+ (seedData, ctx_') = RNG.randomBytes ctx_ Internals.seedBytes+ seed = Internals.makeSeed seedData+++-- * test computations+++-- | Time computation of Poly.ntt+testPolyNTT :: Int -> NewHope.N -> [Poly]+testPolyNTT count n = foldr go [start] [0 .. count]+ where+ start :: Poly+ start = Poly $ VU.fromList [1 .. fromIntegral (Internals.value n)]+ go _a [] = [] -- non-occurring pattern included to shut up the compiler+ go _a results@(first : _rest) = nextResult : results+ where+ nextResult = Poly.ntt first+++-- | Time computation of Poly.invntt+testPolyInvNTT :: Int -> NewHope.N -> [Poly]+testPolyInvNTT count n = foldr go [start] [0 .. count]+ where+ start :: Poly+ start = Poly $ VU.fromList [1 .. fromIntegral (Internals.value n)]+ go :: Int -> [Poly] -> [Poly]+ go _a [] = [] -- non-occurring pattern included to shut up the compiler+ go _a results@(first : _rest) = nextResult : results+ where+ nextResult = Poly.invntt first+++-- | Time computation of Poly.uniform. Note that this differs from the+-- reference library's test of this function in that we use a+-- different seed for each call to uniform, in case the system+-- helpfully caches the result of that function call for us. The+-- reference library makes the exact same call n times, though there+-- is no likely risk of the result being cached in that case.+testPolyUniform :: Int -> NewHope.N -> [TimingPair Internals.Seed Poly]+testPolyUniform count n = foldr go [(head seeds, start)] $ take count $ drop 1 seeds+ where+ start :: Poly+ start = Poly $ VU.fromList [1 .. fromIntegral (Internals.value n)]+ go seed results = nextResult : results+ where+ nextResult = (seed, Poly.uniform n seed)+++-- | Time computation of Poly.sample, using a unique Seed for each+-- invocation.+testPolySample :: Int -> NewHope.N -> [TimingPair Internals.Seed Poly]+testPolySample count n = foldr go [(head seeds, start)] $ take count $ drop 1 seeds+ where+ start :: Poly+ start = Poly $ VU.fromList [1 .. fromIntegral (Internals.value n)]+ go seed results = nextResult : results+ where+ nextResult = (seed, Poly.sample n seed 1)+++-- | Time computation of CPA_KEM.keypair. Results are returned in two+-- TimingPair lists for use in subsequent tests.+testCPAKeypair :: Int -> NewHope.N -> ([TimingPair RNG.Context CPA_KEM.PublicKey], [TimingPair RNG.Context CPA_KEM.SecretKey])+testCPAKeypair count n = (pks, sks)+ where+ (_finalCTX, pks, sks) = foldr go (initialCTX, [], []) [0 .. count]+ seed = RNG.makeRandomSeed "Assise en tailleur face à l'écran, Nadine appuie"+ initialCTX = RNG.randomBytesInit seed Nothing 0+ go _a (ctx, pkResults, skResults) = (ctx', nextPK' : pkResults, nextSK' : skResults)+ where+ (nextPK, nextSK, ctx') = CPA_KEM.keypair ctx n+ nextPK' = (ctx, nextPK)+ nextSK' = (ctx, nextSK)+++-- | Time computation of CCA_KEM.keypair. Results are returned in two+-- TimingPair lists for use in subsequent tests.+testCCAKeypair :: Int -> NewHope.N -> ([TimingPair RNG.Context CCA_KEM.PublicKey], [TimingPair RNG.Context CCA_KEM.SecretKey])+testCCAKeypair count n = (pks, sks)+ where+ (_finalCTX, pks, sks) = foldr go (initialCTX, [], []) [0 .. count]+ seed = RNG.makeRandomSeed "Assise en tailleur face à l'écran, Nadine appuie"+ initialCTX = RNG.randomBytesInit seed Nothing 0+ go _a (ctx, pkResults, skResults) = (ctx', nextPK' : pkResults, nextSK' : skResults)+ where+ (nextPK, nextSK, ctx') = CCA_KEM.keypair ctx n+ nextPK' = (ctx, nextPK)+ nextSK' = (ctx, nextSK)+++-- | Time computation of CPA_KEM.encrypt.+testCPAEncrypt :: [CPA_KEM.PublicKey] -> [TimingPair Null CPA_KEM.CipherText]+testCPAEncrypt pks = snd $ foldr go (initialCTX, []) pks+ where+ seed = RNG.makeRandomSeed "Assise en tailleur face à l'écran, Nadine appuie"+ initialCTX = RNG.randomBytesInit seed Nothing 0+ go pk (ctx, results) = (ctx', nextResult : results)+ where+ (ct, _ss, ctx') = CPA_KEM.encrypt ctx pk+ prereq' = seq (ctx, pk) Null -- not worth the typing to expose this upwards; deepseq will take care of it+ nextResult = (prereq', ct)+++-- | Time computation of CCA_KEM.encrypt.+testCCAEncrypt :: [CCA_KEM.PublicKey] -> [TimingPair Null CCA_KEM.CipherText]+testCCAEncrypt pks = snd $ foldr go (initialCTX, []) pks+ where+ seed = RNG.makeRandomSeed "Assise en tailleur face à l'écran, Nadine appuie"+ initialCTX = RNG.randomBytesInit seed Nothing 0+ go pk (ctx, results) = (ctx', nextResult : results)+ where+ (ct, _ss, ctx') = CCA_KEM.encrypt ctx pk+ prereq' = seq (ctx, pk) Null -- not worth the typing to expose this upwards; deepseq will take care of it+ nextResult = (prereq', ct)+++-- | Time computation of CPA_KEM.decrypt.+testCPADecrypt :: [CPA_KEM.CipherText] -> [CPA_KEM.SecretKey] -> [TimingPair Null CPA_KEM.SharedSecret]+testCPADecrypt cts sks = foldr go [] $ zip cts sks+ where+ go (ct, sk) results = nextResult : results+ where+ prereq = seq (ct, sk) Null+ ss = CPA_KEM.decrypt ct sk+ nextResult = (prereq, ss)+++-- | Time computation of CCA_KEM.decrypt.+testCCADecrypt :: [CCA_KEM.CipherText] -> [CCA_KEM.SecretKey] -> [TimingPair Null (Bool, CCA_KEM.SharedSecret)]+testCCADecrypt cts sks = foldr go [] $ zip cts sks+ where+ go :: (CCA_KEM.CipherText, CCA_KEM.SecretKey) -> [TimingPair Null (Bool, CCA_KEM.SharedSecret)] -> [TimingPair Null (Bool, CCA_KEM.SharedSecret)]+ go (ct, sk) results = nextResult : results+ where+ prereq = seq (ct, sk) Null -- not worth the typing to expose this upwards; deepseq will take care of it+ ss = CCA_KEM.decrypt ct sk+ nextResult = (prereq, ss)+++-- | For tests that involve multiple stages of data, this version does+-- all of the non-timed work first. The chunks are organized so that a+-- garbage collector could save some space in-between unrelated+-- sections.+testN :: NewHope.N -> IO ()+testN n = do+ putStrLn ""+ putStrLn $ "*** Testing N = " ++ show (WrapN n)++ -- we add an extra test so that the first test will absorb any+ -- effects associated with dynamic loading of code or other+ -- subtleties that may apply. (In practice, the first test often+ -- takes significantly longer, so it seems reasonable not to count+ -- it.)+ let testCount' = testCount + 1++ polyNTTTimes <- timeEvaluations $ testPolyNTT testCount' n+ summarize "Poly NTT" n polyNTTTimes++ polyInvNTTTimes <- timeEvaluations $ testPolyInvNTT testCount' n+ summarize "Poly inverse NTT" n polyInvNTTTimes++ polyUniformTimes <- timeEvaluationsWithPrereqs $ testPolyUniform testCount' n+ summarize "Poly uniform" n polyUniformTimes++ polySampleTimes <- timeEvaluationsWithPrereqs $ testPolySample testCount' n+ summarize "Poly sample" n polySampleTimes+++ putStr "Staging CPA computations for tests..."+ let (cpaPKs, cpaSKs) = testCPAKeypair testCount' n+ let cpaCTs = testCPAEncrypt (snd <$> cpaPKs)+ let cpaSSs = testCPADecrypt (snd <$> cpaCTs) (snd <$> cpaSKs)+ putStrLn " Done."++ let cpaPKSKs = let go (pkPrereq, pk) (skPrereq, sk) = ((pkPrereq, skPrereq), (pk, sk))+ in zipWith go cpaPKs cpaSKs++ cpaKeypairTimes <- timeEvaluationsWithPrereqs cpaPKSKs+ summarize "CPA_KEM.keypair" n cpaKeypairTimes++ cpaEncryptTimes <- timeEvaluationsWithPrereqs cpaCTs+ summarize "CPA_KEM.encrypt" n cpaEncryptTimes++ cpaDecryptTimes <- timeEvaluationsWithPrereqs cpaSSs+ summarize "CPA_KEM.decrypt" n cpaDecryptTimes++ ---++ putStr "Staging CCA computations for tests..."+ let (ccaPKs, ccaSKs) = testCCAKeypair testCount' n+ let ccaCTs = testCCAEncrypt (snd <$> ccaPKs)+ let ccaSSs = testCCADecrypt (snd <$> ccaCTs) (snd <$> ccaSKs)+ putStrLn " Done."++ let ccaPKSKs = let go (pkPrereq, pk) (skPrereq, sk) = ((pkPrereq, skPrereq), (pk, sk))+ in zipWith go ccaPKs ccaSKs++ ccaKeypairTimes <- timeEvaluationsWithPrereqs ccaPKSKs+ summarize "CCA_KEM.keypair" n ccaKeypairTimes++ ccaEncryptTimes <- timeEvaluations ccaCTs+ summarize "CCA_KEM.encrypt" n ccaEncryptTimes++ ccaDecryptTimes <- timeEvaluations ccaSSs+ summarize "CCA_KEM.decrypt" n ccaDecryptTimes++ return ()+++main :: IO ()+main = do+ putStr "*** Validating assumptions about timing.... "+ timingOK <- timingAssumptionsValid+ if timingOK+ then putStrLn "Validated."+ else error "Not validated. Timing results are questionable."++ putStrLn ""+ putStrLn $ "NOTE: Each named test in this run comprises " ++ show testCount ++ " individual test iterations."+ putStrLn ""++ testN NewHope.N512+ testN NewHope.N1024
+ auxiliary/AuxUtil.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : AuxUtil+ Description : Auxiliary utilities+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ Auxiliary utilities, used by testing and app code. Placed here to+ avoid duplication.++-}+module AuxUtil where++import Test.Tasty.QuickCheck (Arbitrary, arbitrary, frequency)++import qualified Crypto.NewHope as NewHope+++newtype WrapN = WrapN NewHope.N++instance Show WrapN+ where+ show (WrapN NewHope.N512) = "NewHope512"+ show (WrapN NewHope.N1024) = "NewHope1024"++-- TODO: isn't there a more elegant way to do this?+instance Arbitrary WrapN+ where+ arbitrary = do+ a <- frequency [ (1, return NewHope.N512)+ , (1, return NewHope.N1024)+ ]+ return $ WrapN a
+ auxiliary/KAT.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE Safe #-}+{-|+ Module : KAT+ Description : Known Answer Tests+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ KAT stands for Known Answer Test(s). The validity of an+ implementation may be judged in part by its ability to produce the+ correct output.++ This module generates test vectors (according to the NIST PQC spec)+ which should be identical (in filenames and contents) to the ones+ generated by the original NewHope reference code.++ The automated tests in this codebase contain tests which take those+ reference implementation vectors as input to verify that we generate+ the same data with the below code.++-}++module KAT where++import qualified Data.ByteString as BS+import Data.ByteString.Builder+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy.Char8 as BSLC+import Data.Char+import Data.Semigroup ((<>))++import AuxUtil+import qualified Crypto.NewHope as NewHope+import qualified Crypto.NewHope.Internal.CCA_KEM as CCA_KEM+import qualified Crypto.NewHope.Internal.CPA_KEM as CPA_KEM+import qualified Crypto.NewHope.Internal.RNG as RNG++type Filename = String+type VectorGenerator = NewHope.N -> Int -> (Filename, Builder)+++recordsToGenerate :: Int+recordsToGenerate = 100++++++-- | output ByteString as uppercase hex string representation+processBS :: BS.ByteString -> String+processBS bs = toUpper <$> (BSLC.unpack . toLazyByteString . byteStringHex) bs++++++-- | Note that the seeds used are the same for both algorithms and both variants thereof.+getSeeds :: [RNG.RandomSeed]+getSeeds = go initialCTX+ where+ initialSeed = RNG.makeRandomSeed $ BS.pack [0 .. 47]+ initialCTX = RNG.randomBytesInit initialSeed Nothing 256+ go ctx = newSeed : go nextCTX+ where+ (newSeed, nextCTX) = (RNG.makeRandomSeed seed', ctx')+ where+ (seed', ctx') = RNG.randomBytes ctx 48+++ccaKemTestVectors :: VectorGenerator+ccaKemTestVectors n count = (filename, start <> contents)+ where+ filename = "PQCkemKAT_" ++ show (CCA_KEM.secretKeyBytes n) ++ ".rsp"+ start = lazyByteString . BSLC.pack $ "# " ++ show (WrapN n) ++ "-CCAKEM\n\n"+ contents = foldr1 mappend $ outputRecord <$> Prelude.zip [0 ..] (take count getSeeds)++ outputRecord :: (Int, RNG.RandomSeed) -> Builder+ outputRecord (i, seed) = header <> record+ where+ header = lazyByteString . BSLC.pack $ "count = " ++ show i ++ "\n"+ record = testVectorsFromSeed seed++ testVectorsFromSeed :: RNG.RandomSeed -> Builder+ testVectorsFromSeed seed = seq check output'+ where+ ctx = RNG.randomBytesInit seed Nothing 256+ (pk, sk, ctx') = CCA_KEM.keypair ctx n+ (ct, ss, _) = CCA_KEM.encrypt ctx' pk+ check = let (success, ss') = CCA_KEM.decrypt ct sk+ ssOK = success && ss == ss'+ in if not ssOK+ then error "Shared secret could not be generated."+ else ()++ seedData = RNG.getRandomSeedData seed+ output = (lazyByteString . BSLC.pack) <$> [ "seed = " ++ processBS seedData ++ "\n"+ , "pk = " ++ processBS (CCA_KEM.getPKData pk) ++ "\n"+ , "sk = " ++ processBS (CCA_KEM.getSKData sk) ++ "\n"+ , "ct = " ++ processBS (CCA_KEM.getCTData ct) ++ "\n"+ , "ss = " ++ processBS (CCA_KEM.getSSData ss) ++ "\n"+ , "\n"+ ]+ output' = foldr go (byteString $ BSC.pack "") output+ where+ go a as = a <> as+++cpaKemTestVectors :: VectorGenerator+cpaKemTestVectors n count = (filename, start <> contents)+ where+ filename = "PQCkemKAT_" ++ show (CPA_KEM.secretKeyBytes n) ++ ".rsp"+ start = lazyByteString . BSLC.pack $ "# " ++ show (WrapN n) ++ "-CPAKEM\n\n"+ contents = foldr1 mappend $ outputRecord <$> Prelude.zip [0 ..] (take count getSeeds)++ outputRecord :: (Int, RNG.RandomSeed) -> Builder+ outputRecord (i, seed) = header <> record+ where+ header = lazyByteString . BSLC.pack $ "count = " ++ show i ++ "\n"+ record = testVectorsFromSeed seed++ testVectorsFromSeed :: RNG.RandomSeed -> Builder+ testVectorsFromSeed seed = seq check output'+ where+ ctx = RNG.randomBytesInit seed Nothing 256+ (pk, sk, ctx') = CPA_KEM.keypair ctx n+ (ct, ss, _) = CPA_KEM.encrypt ctx' pk+ check = let mss = CPA_KEM.decrypt ct sk+ ssOK = ss == mss+ in if not ssOK+ then error "Shared secret could not be generated."+ else ()++ seedData = RNG.getRandomSeedData seed+ output = (lazyByteString . BSLC.pack) <$> [ "seed = " ++ processBS seedData ++ "\n"+ , "pk = " ++ processBS (CPA_KEM.getPKData pk) ++ "\n"+ , "sk = " ++ processBS (CPA_KEM.getSKData sk) ++ "\n"+ , "ct = " ++ processBS (CPA_KEM.getCTData ct) ++ "\n"+ , "ss = " ++ processBS (CPA_KEM.getSSData ss) ++ "\n"+ , "\n"+ ]+ output' = foldr go (byteString $ BSC.pack "") output+ where+ go a as = a <> as
+ auxiliary/Timing.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE Safe #-}+{-|+ Module : Timing+ Description : Timing utilities+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Timing where+++type Picoseconds = Integer+type Milliseconds = Integer+type Microseconds = Integer+type Femtoseconds = Integer++milliseconds :: Picoseconds -> Milliseconds+milliseconds p = p `div` 1000000000++microseconds :: Picoseconds -> Microseconds+microseconds p = p `div` 1000000++femtoseconds :: Picoseconds -> Femtoseconds+femtoseconds p = p `div` 1000+++showTime :: Picoseconds -> String+showTime picoseconds = result+ where+ result | asMilliseconds > 1 = show asMilliseconds ++ "ms"+ | asMicroseconds > 1 = show asMicroseconds ++ "µs"+ | asFemtoseconds > 1 = show asFemtoseconds ++ "fs"+ | otherwise = show picoseconds ++ "ps"++ asMilliseconds = milliseconds picoseconds+ asMicroseconds = microseconds picoseconds+ asFemtoseconds = femtoseconds picoseconds
+ newhope.cabal view
@@ -0,0 +1,221 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: fc69f9cd0d25496be7de02d53407ea306132435af206b38a738ccf3ba3f4274e++name: newhope+version: 0.1.0.0+synopsis: Library implementing the NewHope cryptographic key-exchange protocol+description: This is a Haskell implementation of the NewHope key exchange protocol. It has been made via examination of the official NewHope project's public domain C reference code and the author is not affiliated with that team or with NIST. For further details please see the package README.+category: Library, Cryptography+homepage: https://github.com/unprolix/newhope#README.md+bug-reports: https://github.com/unprolix/newhope/issues+author: Jeremy Bornstein+maintainer: jeremy@bornstein.org+copyright: © 2019 Jeremy Bornstein+license: Apache-2.0+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/https://github.com/unprolix/newhope++library+ exposed-modules:+ Crypto.NewHope+ Crypto.NewHope.CCA_KEM+ Crypto.NewHope.CPA_KEM+ Crypto.NewHope.RNG+ Crypto.NewHope.SeedExpander+ other-modules:+ Crypto.NewHope.CPA_PKE+ Crypto.NewHope.FIPS202+ Crypto.NewHope.Internal.CCA_KEM+ Crypto.NewHope.Internal.CPA_KEM+ Crypto.NewHope.Internal.RNG+ Crypto.NewHope.Internal.SeedExpander+ Crypto.NewHope.Internals+ Crypto.NewHope.NTT+ Crypto.NewHope.Poly+ Crypto.NewHope.Precomp+ Crypto.NewHope.Reduce+ Crypto.NewHope.Verify+ MiscUtils+ StringUtils+ Paths_newhope+ hs-source-dirs:+ src+ ghc-options: -Wall -O2+ build-depends:+ AES >=0.2 && <0.3+ , base >=4.7 && <5+ , bytestring >=0.10 && <0.11+ , containers >=0.5 && <0.7+ , deepseq >=1.4 && <1.5+ , mtl >=2.2 && <2.3+ , vector >=0.12 && <0.13+ default-language: Haskell2010++executable PQCgenKAT+ main-is: PQCgenKAT.hs+ other-modules:+ AuxUtil+ KAT+ Timing+ Crypto.NewHope+ Crypto.NewHope.CCA_KEM+ Crypto.NewHope.CPA_KEM+ Crypto.NewHope.CPA_PKE+ Crypto.NewHope.FIPS202+ Crypto.NewHope.Internal.CCA_KEM+ Crypto.NewHope.Internal.CPA_KEM+ Crypto.NewHope.Internal.RNG+ Crypto.NewHope.Internal.SeedExpander+ Crypto.NewHope.Internals+ Crypto.NewHope.NTT+ Crypto.NewHope.Poly+ Crypto.NewHope.Precomp+ Crypto.NewHope.Reduce+ Crypto.NewHope.RNG+ Crypto.NewHope.SeedExpander+ Crypto.NewHope.Verify+ MiscUtils+ StringUtils+ Paths_newhope+ hs-source-dirs:+ app/kat+ auxiliary+ src+ ghc-options: -Wall -O2 -Wall -O2 -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ AES+ , base >=4.7 && <5+ , bytestring+ , containers+ , deepseq+ , mtl+ , system-fileio >=0.3 && <90.4+ , system-filepath >=0.4 && <0.5+ , tasty-quickcheck >=0.10 && <0.11+ , text >=1.2 && <1.3+ , vector+ default-language: Haskell2010++executable speed+ main-is: Speed.hs+ other-modules:+ AuxUtil+ KAT+ Timing+ Crypto.NewHope+ Crypto.NewHope.CCA_KEM+ Crypto.NewHope.CPA_KEM+ Crypto.NewHope.CPA_PKE+ Crypto.NewHope.FIPS202+ Crypto.NewHope.Internal.CCA_KEM+ Crypto.NewHope.Internal.CPA_KEM+ Crypto.NewHope.Internal.RNG+ Crypto.NewHope.Internal.SeedExpander+ Crypto.NewHope.Internals+ Crypto.NewHope.NTT+ Crypto.NewHope.Poly+ Crypto.NewHope.Precomp+ Crypto.NewHope.Reduce+ Crypto.NewHope.RNG+ Crypto.NewHope.SeedExpander+ Crypto.NewHope.Verify+ MiscUtils+ StringUtils+ Paths_newhope+ hs-source-dirs:+ app/speed+ auxiliary+ src+ ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ AES+ , base >=4.7 && <5+ , bytestring+ , containers+ , deepseq+ , mtl+ , tasty-quickcheck+ , vector+ default-language: Haskell2010++test-suite libtest+ type: exitcode-stdio-1.0+ main-is: LibTest.hs+ other-modules:+ AuxUtil+ KAT+ Timing+ Crypto.NewHope+ Crypto.NewHope.CCA_KEM+ Crypto.NewHope.CPA_KEM+ Crypto.NewHope.CPA_PKE+ Crypto.NewHope.FIPS202+ Crypto.NewHope.Internal.CCA_KEM+ Crypto.NewHope.Internal.CPA_KEM+ Crypto.NewHope.Internal.RNG+ Crypto.NewHope.Internal.SeedExpander+ Crypto.NewHope.Internals+ Crypto.NewHope.NTT+ Crypto.NewHope.Poly+ Crypto.NewHope.Precomp+ Crypto.NewHope.Reduce+ Crypto.NewHope.RNG+ Crypto.NewHope.SeedExpander+ Crypto.NewHope.Verify+ MiscUtils+ StringUtils+ ConfigFile+ Crypto.NewHope.Test.CCA_KEM+ Crypto.NewHope.Test.CPA_KEM+ Crypto.NewHope.Test.FIPS202+ Crypto.NewHope.Test.NTT+ Crypto.NewHope.Test.Poly+ Crypto.NewHope.Test.Reduce+ Crypto.NewHope.Test.RNG+ Crypto.NewHope.Test.SeedExpander+ Crypto.NewHope.Test.Verify+ Statistics+ Test.ConfigFile+ Test.KAT+ Util+ Paths_newhope+ hs-source-dirs:+ app/libtest+ auxiliary+ src+ test+ ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ AES+ , HUnit >=1.6 && <1.7+ , QuickCheck >=2.11 && <2.13+ , base >=4.7 && <5+ , bytestring+ , containers+ , deepseq+ , hspec >=2.5 && <2.7+ , mtl+ , parallel >=3.2 && <3.3+ , raw-strings-qq >=1.1 && <1.2+ , statistics >=0.14 && <0.16+ , system-fileio+ , system-filepath+ , tasty >=1.1 && <1.3+ , tasty-expected-failure >=0.11 && <0.12+ , tasty-hunit >=0.10 && <0.11+ , tasty-quickcheck+ , text+ , trifecta >=2 && <2.0+ , vector+ default-language: Haskell2010
+ src/Crypto/NewHope.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE Safe #-}+{-|+ Module : Crypto.NewHope+ Description : NewHope cryptographic key-exchange protocol library+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ This is the main (and very sparse) public module for the NewHope+ cryptography library. In order to perform useful operations, you+ will probably also wish to import "Crypto.NewHope.CPA_KEM" and/or+ "Crypto.NewHope.CCA_KEM", which each implement keypair generation,+ encryption, and decryption (see those modules for sample usage of+ these components to effect an actual key exchange). Also required+ for import will be "Crypto.NewHope.RNG" for generation of a+ 'Context' for pseudorandom number generation, used in the key+ exchange protocol.++ You may also import the "Crypto.NewHope.SeedExpander" module to use+ the seedexpander functionality, which is not otherwise necessary for+ the key exchange protocol but which is provided here because it is+ part of the NIST spec and the reference library.++ Naming of exported symbols is largely consistent with that used in+ the reference implementation, and therefore strongly related to the+ specifications required by the NIST PQC project. However changes+ have been made to naming where they seem to make sense, e.g. instead+ of the function crypto_kem_enc() being defined twice, once each for+ the IND-CPA-secure and the IND-CCA-secure variants, here we define+ the function 'encrypt' as appropriate in "Crypto.NewHope.CCA_KEM"+ and also in "Crypto.NewHope.CPA_KEM". If you are familiar with the+ reference C implementation none of these changes should be+ surprising.++-}++module Crypto.NewHope ( N(N512, N1024)+ ) where++import Crypto.NewHope.Internals (N (N1024, N512))
+ src/Crypto/NewHope/CCA_KEM.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE Safe #-}+{-|+ Module : Crypto.NewHope.CCA_KEM+ Description : IND-CCA-secure operations for the NewHope key exchange protocol+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ IND-CCA-secure operations for the NewHope key exchange protocol. The+ algorithm name is either NewHope512-CCAKEM or NewHope1024-CCAKEM,+ depending on the value of 'N'.++ This module contains the public interface. Implementation definitions+ are in the "Crypto.NewHope.Internal.CCA_KEM" module.++ * Sample usage++ @+ -- Alice initiates the exchange+ seedA = makeRandomSeed fortyEightBytesOfEntropyA -- Seed the pseudorandom number generator (Alice's side)+ ctxA = randomBytesInit seedA Nothing 256 -- Source of pseudorandomness+ (pk, skA, ctxA') = keypair ctxA N1024 -- Alice generates a public key and her secret key++ -- [Alice sends the public key to Bob]++ -- Bob uses the public key to derive the shared secret along with data to send to Alice+ seedB = makeRandomSeed fortyEightBytesOfEntropyB -- Seed the pseudorandom number generator (Bob's side)+ ctxB = randomBytesInit seedB Nothing 256 -- Source of pseudorandomness+ (sendb, keyB, ctxB') = encrypt ctxB pk -- Bob derives a secret key and creates a response++ -- [Bob sends sendb back to Alice]++ keyA = decrypt sendb skA -- Alice derives her copy of the shared secret+ @++-}++module Crypto.NewHope.CCA_KEM ( keypair+ , encrypt+ , decrypt++ ) where+++import Crypto.NewHope.Internal.CCA_KEM
+ src/Crypto/NewHope/CPA_KEM.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE Safe #-}+{-|+ Module : Crypto.NewHope.CPA_KEM+ Description : IND-CPA-secure operations for the NewHope key exchange protocol+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ IND-CPA-secure operations for the NewHope key exchange protocol. The+ algorithm name is either NewHope512-CPAKEM or NewHope1024-CPAKEM,+ depending on the value of 'N'.++ This module contains the public interface. Implementation definitions+ are in the "Crypto.NewHope.Internal.CPA_KEM" module.++ * Sample usage++ @+ -- Alice initiates the exchange+ seedA = makeRandomSeed fortyEightBytesOfEntropyA -- Seed the pseudorandom number generator (Alice's side)+ ctxA = randomBytesInit seedA Nothing 256 -- Source of pseudorandomness+ (pk, skA, ctxA') = keypair ctxA N1024 -- Alice generates a public key and her secret key++ -- [Alice sends the public key to Bob]++ -- Bob uses the public key to derive the shared secret along with data to send to Alice+ seedB = makeRandomSeed fortyEightBytesOfEntropyB -- Seed the pseudorandom number generator (Bob's side)+ ctxB = randomBytesInit seedB Nothing 256 -- Source of pseudorandomness+ (sendb, keyB, ctxB') = encrypt ctxB pk -- Bob derives a secret key and creates a response++ -- [Bob sends sendb back to Alice]++ keyA = decrypt sendb skA -- Alice derives her copy of the shared secret+ @++-}++module Crypto.NewHope.CPA_KEM ( keypair+ , encrypt+ , decrypt+ ) where++import Crypto.NewHope.Internal.CPA_KEM
+ src/Crypto/NewHope/CPA_PKE.hs view
@@ -0,0 +1,360 @@+{-# LANGUAGE Safe #-} +{-| + Module : Crypto.NewHope.CPA_PKE + Description : IND-CPA-secure key encapsulation for the NewHope key exchange protocol + Copyright : © Jeremy Bornstein 2019 + License : Apache 2.0 + Maintainer : jeremy@bornstein.org + Stability : experimental + Portability : portable + + IND-CPA-secure key encapsulation for the NewHope key exchange protocol + +-} + +module Crypto.NewHope.CPA_PKE ( keypair + , encrypt + , decrypt + + , publicKeyBytes + , secretKeyBytes + , cipherTextBytes + + , PublicKey + , makePublicKey + , makePublicKeyFromBytes + , getPKData + , getPKPolyData + , getPKPoly + , getPKSeed + + , SecretKey + , makeSecretKey + , makeSecretKeyFromBytes + , getSKPoly + , getSKPolyData + + , CipherText + , makeCipherTextFromBytes -- need to do this when decrypting + , getCTData + , getCTb + , getCTbData + , getCTv + + , makePlainText -- we use Plain instead of Clear so we have distinct abbreviations! i.e. pt != ct + , getPTData + ) where + +import Control.Applicative +import qualified Data.ByteString as BS + +import Crypto.NewHope.FIPS202 +import Crypto.NewHope.Internals (N (N1024, N512), symBytes) +import qualified Crypto.NewHope.Internals as Internals +import Crypto.NewHope.Poly (Poly) +import qualified Crypto.NewHope.Poly as Poly +import Crypto.NewHope.RNG +import StringUtils + + +-- * Counting bytes + +-- | Size in bytes of a PublicKey +publicKeyBytes :: Internals.N -> Int +publicKeyBytes n = Poly.polyBytes n + symBytes + +-- | Size in bytes of a SecretKey +secretKeyBytes :: Internals.N -> Int +secretKeyBytes = Poly.polyBytes + +-- | Size in bytes of a CipherText +cipherTextBytes :: Internals.N -> Int +cipherTextBytes = liftA2 (+) Poly.polyBytes Poly.polyCompressedBytes + + +-- * PlainText + +-- | This is a "msg" encoded from a Poly. Since these are of constant +-- length even for different N, when restoring the Poly we need to +-- know N from elsewhere. +newtype PlainText = PlainText BS.ByteString deriving Eq + +-- | Construct PlainText from ByteString +makePlainText :: BS.ByteString -> PlainText +makePlainText bs + | not lengthOK = error "Invalid length for PlainText" + | otherwise = PlainText bs + where + len = BS.length bs + lengthOK = len == Poly.polyMsgBytes + + +-- | The raw data inside a PlainText +getPTData :: PlainText -> BS.ByteString +getPTData (PlainText ptData) = ptData + + +-- | The encoded Poly inside a PlainText +getPTv :: PlainText -> Internals.N -> Poly +getPTv (PlainText ptData) n = Poly.fromMsg n ptData + + + +-- * PublicKey + +newtype PublicKey = PublicKey BS.ByteString deriving Eq + + +-- | The N associated with this key +getPKn :: PublicKey -> Internals.N +getPKn (PublicKey pkData) + | len == publicKeyBytes N512 = N512 + | len == publicKeyBytes N1024 = N1024 + | otherwise = error "Invalid N for PublicKey" + where + len = BS.length pkData + + +-- | In terms of the NewHope protocol, our PublicKey data is a +-- concatenation of the serialization of the Poly pk and the +-- public seed which generated the Poly a. +makePublicKey :: Poly -> Internals.Seed -> PublicKey +makePublicKey poly seed + | not lengthOK = error "Invalid imputed length for PublicKey" + | otherwise = PublicKey bs + where + bs = BS.append poly' seed' + poly' = Poly.toByteString poly + seed' = Internals.getSeedData seed + n = Poly.getN poly + lengthOK = BS.length bs == publicKeyBytes n + + +-- | Construct PublicKey from ByteString +makePublicKeyFromBytes :: BS.ByteString -> PublicKey +makePublicKeyFromBytes pkData + | not lengthOK = error "Invalid length for PublicKey" + | otherwise = PublicKey pkData + where + len = BS.length pkData + lengthOK = len == publicKeyBytes N512 || len == publicKeyBytes N1024 + + +-- | The raw data inside a PublicKey +getPKData :: PublicKey -> BS.ByteString +getPKData (PublicKey pkData) = pkData + + +-- | The length of the encoded Poly pk in our encoded data. +getPKPolyBytes :: PublicKey -> Int +getPKPolyBytes pk = Poly.polyBytes $ getPKn pk + + +-- | The raw data encoding the Poly pk +getPKPolyData :: PublicKey -> BS.ByteString +getPKPolyData pk@(PublicKey pkData) = encoded + where + polyBytes = getPKPolyBytes pk + encoded = BS.take polyBytes pkData + + +-- | The decoded Poly pk +getPKPoly :: PublicKey -> Poly +getPKPoly pk@(PublicKey pkData) = Poly.fromByteString encoded + where + polyBytes = getPKPolyBytes pk + encoded = BS.take polyBytes pkData + + +-- | The Seed +getPKSeed :: PublicKey -> Internals.Seed +getPKSeed (PublicKey pkData) = Internals.makeSeed seedData + where + offset = BS.length pkData - symBytes + seedData = BS.drop offset pkData + + + +-- * SecretKey + +newtype SecretKey = SecretKey BS.ByteString deriving Eq + +-- | Construct from a Poly +makeSecretKey :: Poly -> SecretKey +makeSecretKey poly + | not lengthOK = error "Invalid imputed N for SecretKey" + | otherwise = SecretKey bs + where + n = Poly.getN poly + bs = Poly.toByteString poly + lengthOK = BS.length bs == secretKeyBytes n + + +-- | Construct from a ByteString, which must contain a serialized Poly. +makeSecretKeyFromBytes :: BS.ByteString -> SecretKey +makeSecretKeyFromBytes bs + | not lengthOK = error "Invalid length for SecretKey" + | otherwise = SecretKey bs + where + len512 = secretKeyBytes N512 + len1024 = secretKeyBytes N1024 + len = BS.length bs + lengthOK = len == len512 || len == len1024 + + +-- | The N associated with this key. Prefixed with _ because nothing +-- uses this now, but it's good to have it here to document the +-- structure/contents and for possible future testing. +_getSKn :: SecretKey -> Internals.N +_getSKn (SecretKey skData) + | len == len512 = N512 + | len == len1024 = N1024 + | otherwise = error "Invalid N for SecretKey" + where + len = BS.length skData + len512 = secretKeyBytes N512 + len1024 = secretKeyBytes N1024 + + +-- | The encoded Poly data, which also happens to be all of our data +getSKPolyData :: SecretKey -> BS.ByteString +getSKPolyData (SecretKey sk) = sk + + +-- | The encapsulated Poly +getSKPoly :: SecretKey -> Poly +getSKPoly (SecretKey sk) = Poly.fromByteString sk + + + +-- * CipherText + +newtype CipherText = CipherText BS.ByteString deriving Eq + +-- TDOD: Useful for debugging. Should we retain it in the distribution? +instance Show CipherText where + show (CipherText bs) = "CipherText: " ++ byteStringToHexString bs + + +-- | Construct a CipherText from two Polys. +makeCipherText :: Poly -> Poly -> CipherText +makeCipherText b v + | not lengthOK = error "Invalid imputed length for CipherText" + | otherwise = CipherText bs + where + b' = Poly.toByteString b + v' = Poly.compress v + bs = BS.append b' v' + + lengthOK = let bn = Poly.getN b + vn = Poly.getN v + in (bn == vn) && (BS.length bs == cipherTextBytes bn) + + +-- | Construct a CipherText from the data in a ByteString +makeCipherTextFromBytes :: BS.ByteString -> CipherText +makeCipherTextFromBytes bs + | not lengthOK = error "Invalid length for CipherText" + | otherwise = CipherText bs + where + len = BS.length bs + len512 = cipherTextBytes N512 + len1024 = cipherTextBytes N1024 + lengthOK = len == len512 || len == len1024 + + +-- | The N associated with this CipherText +getCTn :: CipherText -> Internals.N +getCTn (CipherText ctData) + | len == len512 = N512 + | len == len1024 = N1024 + | otherwise = error "Invalid N for CipherText" + where + len = BS.length ctData + len512 = cipherTextBytes N512 + len1024 = cipherTextBytes N1024 + + +-- | The data encoding the encapsulated Poly b +getCTbData :: CipherText -> BS.ByteString +getCTbData ct@(CipherText ctData) = polyData + where + polyData = BS.take polyBytes ctData + n = getCTn ct + polyBytes = Poly.polyBytes n + + +-- | The encapsulated Poly b +getCTb :: CipherText -> Poly +getCTb = Poly.fromByteString . getCTbData + + +-- | The data encoding the encapsulated Poly v +getCTData :: CipherText -> BS.ByteString +getCTData (CipherText ctData) = ctData + + +-- | The encapsulated Poly v +getCTv :: CipherText -> Poly +getCTv ct@(CipherText ctData) = Poly.decompress polyData + where + polyData = BS.drop polyBytes ctData + n = getCTn ct + polyBytes = Poly.polyBytes n + + +-- | Deterministically generate public Poly a from Seed. This is just +-- `Poly.uniform` but remains here for some degree of isomorphism with +-- the reference library. +genA :: Internals.N -> Internals.Seed -> Poly +genA = Poly.uniform + + + +-- * Higher-level functions + + +-- | Generates a new keypair, along with the post-utilization Context. +keypair :: Context -> Internals.N -> (PublicKey, SecretKey, Context) +keypair ctx n = (pk, sk, ctx') + where + (z, ctx') = randomBytes ctx symBytes + (publicSeed, noiseSeed) = BS.splitAt symBytes $ shake256 z (2 * symBytes) + + shat = Poly.ntt $ Poly.sample n (Internals.makeSeed noiseSeed) 0 + ehat = Poly.ntt $ Poly.sample n (Internals.makeSeed noiseSeed) 1 + + sk = makeSecretKey shat + + pk = let ahatShat = let ahat = genA n $ Internals.makeSeed publicSeed + in Poly.mulPointwise shat ahat + bhat = Poly.add ehat ahatShat + in makePublicKey bhat $ Internals.makeSeed publicSeed + + +-- | Encrypt PlainText to CipherText +encrypt :: PlainText -> PublicKey -> Internals.Seed -> CipherText +encrypt pt pk coin = makeCipherText uhat vprime + where + n = getPKn pk + v = getPTv pt n + + bhat = getPKPoly pk + publicSeed = getPKSeed pk + sprime = Poly.ntt $ Poly.sample n coin 0 + eprime = Poly.ntt $ Poly.sample n coin 1 + uhat = Poly.add eprime $ Poly.mulPointwise sprime (genA n publicSeed) + + vprime = Poly.add v $ Poly.add (Poly.sample n coin 2) + (Poly.invntt $ Poly.mulPointwise bhat sprime) + + +-- | Decrypt CipherText to PlainText. +decrypt :: CipherText -> SecretKey -> PlainText +decrypt c sk = PlainText msg + where + shat = getSKPoly sk + uhat = getCTb c + vprime = getCTv c + msg = Poly.toMsg $ Poly.sub (Poly.invntt $ Poly.mulPointwise shat uhat) vprime +
+ src/Crypto/NewHope/FIPS202.hs view
@@ -0,0 +1,432 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.FIPS202+ Description : Implements the FIPS202 (aka SHA-3) hashing algorithm.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ Implements the FIPS202 (aka SHA-3) hashing algorithm. This version+ is based on the version from the NewHope C reference implementation,+ which in turn was based on the public domain implementation in+ crypto_hash/keccakc512/simple/ from+ http://bench.cr.yp.to/supercop.html by Ronny Van Keer, and the+ public domain "TweetFips202" implementation from+ https://twitter.com/tweetfips202 by Gilles Van Assche, Daniel+ J. Bernstein, and Peter Schwabe.++ Note: When the author wrote this, he was unaware of the Keccak+ package that already existed in Hackage, which may have significantly+ differnent performance. It would not be a mistake to see if that+ implementation has more desirable characteristics than this one.++-}++module Crypto.NewHope.FIPS202 where++import Data.Bits+import qualified Data.ByteString as BS+import qualified Data.Map as Map+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Unboxed.Mutable as VUM+import Data.Word+import Prelude hiding (round)++import StringUtils+++-- | Our basic data: unboxed vector of 64-bit integers+type KeccakVector = VU.Vector Word64++-- | Length of state vector+keccakStateLength :: Int+keccakStateLength = 25++-- | Size of blocks for SHAKE128+shake128Rate :: Int+shake128Rate = 168++-- | Size of blocks for SHAKE256+shake256Rate :: Int+shake256Rate = 136++-- | How many rounds of permutation should be performed+keccakF1600StatePermuteRoundsCount :: Int+keccakF1600StatePermuteRoundsCount = 24++-- | Starting point for computation+keccakEmpty :: KeccakVector+keccakEmpty = VU.replicate keccakStateLength 0+++++keccakFRoundConstants :: KeccakVector+keccakFRoundConstants = VU.fromList [ 0x0000000000000001, 0x0000000000008082, 0x800000000000808a, 0x8000000080008000,+ 0x000000000000808b, 0x0000000080000001, 0x8000000080008081, 0x8000000000008009,+ 0x000000000000008a, 0x0000000000000088, 0x0000000080008009, 0x000000008000000a,+ 0x000000008000808b, 0x800000000000008b, 0x8000000000008089, 0x8000000000008003,+ 0x8000000000008002, 0x8000000000000080, 0x000000000000800a, 0x800000008000000a,+ 0x8000000080008081, 0x8000000000008080, 0x0000000080000001, 0x8000000080008008]+++rol :: Word64 -> Int -> Word64+rol a offset = shift a offset `xor` shift a (offset - 64)+++-- | Given 8 bytes from a ByteString, compute a Word64 containing those bytes in little-endian order+load64 :: BS.ByteString -- ^ Source data+ -> Int -- ^ Offset within source from which to select data+ -> Word64+load64 input offset+ | BS.length trimmed < 8 = error ("TOO SHORT: \"" ++ (byteStringToHexString trimmed :: String) ++ "\"")+ | otherwise = foldl go a as+ where+ trimmed = BS.take 8 (BS.drop offset input)+ a : as = reverse $ fromIntegral <$> BS.unpack trimmed+ go d c = c .|. shift d 8+++-- | Given 8 bytes from an unboxed Vector of bytes, compute a Word64 containing those bytes in little-endian order+load64' :: VU.Vector Word8 -- ^ Source data+ -> Int -- ^ Offset within source from which to select data+ -> Word64+load64' input offset = foldl go a as+ where+ a : as = reverse $ fmap fromIntegral $ VU.toList $ VU.take 8 (VU.drop offset input)+ go d c = c .|. shift d 8+++-- | Given a Word64, compute a ByteString containing the same value in little-endian order+store64 :: Word64 -> BS.ByteString+store64 value = BS.pack $ fmap fromIntegral [ value .&. 0xFF,+ shift value $ -8 .&. 0xFF,+ shift value $ -16 .&. 0xFF,+ shift value $ -24 .&. 0xFF,+ shift value $ -32 .&. 0xFF,+ shift value $ -40 .&. 0xFF,+ shift value $ -48 .&. 0xFF,+ shift value $ -56 .&. 0xFF]++-- | Perform one round of permutation+keccakF1600StatePermute :: KeccakVector -> KeccakVector+keccakF1600StatePermute state' = runRounds state' 0+ where+ runRounds state round = if round >= keccakF1600StatePermuteRoundsCount - 2+ then result+ else runRounds result (round + 2)+ where+ aba = state VU.! 0+ abe = state VU.! 1+ abi = state VU.! 2+ abo = state VU.! 3+ abu = state VU.! 4+ aga = state VU.! 5+ age = state VU.! 6+ agi = state VU.! 7+ ago = state VU.! 8+ agu = state VU.! 9+ aka = state VU.! 10+ ake = state VU.! 11+ aki = state VU.! 12+ ako = state VU.! 13+ aku = state VU.! 14+ ama = state VU.! 15+ ame = state VU.! 16+ ami = state VU.! 17+ amo = state VU.! 18+ amu = state VU.! 19+ asa = state VU.! 20+ ase = state VU.! 21+ asi = state VU.! 22+ aso = state VU.! 23+ asu = state VU.! 24++ -- prepareTheta+ bca = aba `xor` aga `xor` aka `xor` ama `xor` asa+ bce = abe `xor` age `xor` ake `xor` ame `xor` ase+ bci = abi `xor` agi `xor` aki `xor` ami `xor` asi+ bco = abo `xor` ago `xor` ako `xor` amo `xor` aso+ bcu = abu `xor` agu `xor` aku `xor` amu `xor` asu++ -- thetaRhoPiChiIotaPrepareTheta(round , A, E)+ da = bcu `xor` rol bce 1+ de = bca `xor` rol bci 1+ di = bce `xor` rol bco 1+ do1 = bci `xor` rol bcu 1+ du = bco `xor` rol bca 1++ aba2 = aba `xor` da++ bca2 = aba2+ age2 = age `xor` de+ bce2 = rol age2 44+ aki2 = aki `xor` di+ bci2 = rol aki2 43+ amo2 = amo `xor` do1+ bco2 = rol amo2 21+ asu2 = asu `xor` du+ bcu2 = rol asu2 14+ eba4 = bca2 `xor` complement bce2 .&. bci2+ eba5 = eba4 `xor` (keccakFRoundConstants VU.! round)+ ebe = bce2 `xor` complement bci2 .&. bco2+ ebi = bci2 `xor` complement bco2 .&. bcu2+ ebo = bco2 `xor` complement bcu2 .&. bca2+ ebu = bcu2 `xor` complement bca2 .&. bce2+ abo2 = abo `xor` do1+ bca3 = rol abo2 28+ agu2 = agu `xor` du+ bce3 = rol agu2 20+ aka2 = aka `xor` da+ bci3 = rol aka2 3+ ame2 = ame `xor` de+ bco3 = rol ame2 45+ asi2 = asi `xor` di+ bcu3 = rol asi2 61+ ega = bca3 `xor` complement bce3 .&. bci3+ ege = bce3 `xor` complement bci3 .&. bco3+ egi = bci3 `xor` complement bco3 .&. bcu3+ ego = bco3 `xor` complement bcu3 .&. bca3+ egu = bcu3 `xor` complement bca3 .&. bce3++ abe2 = abe `xor` de+ bca4 = rol abe2 1+ agi2 = agi `xor` di+ bce4 = rol agi2 6+ ako2 = ako `xor` do1+ bci4 = rol ako2 25+ amu2 = amu `xor` du+ bco4 = rol amu2 8+ asa2 = asa `xor` da+ bcu4 = rol asa2 18+ eka = bca4 `xor` complement bce4 .&. bci4+ eke = bce4 `xor` complement bci4 .&. bco4+ eki = bci4 `xor` complement bco4 .&. bcu4+ eko = bco4 `xor` complement bcu4 .&. bca4+ eku = bcu4 `xor` complement bca4 .&. bce4++ abu2 = abu `xor` du+ bca5 = rol abu2 27+ aga2 = aga `xor` da+ bce5 = rol aga2 36+ ake2 = ake `xor` de+ bci5 = rol ake2 10+ ami2 = ami `xor` di+ bco5 = rol ami2 15+ aso2 = aso `xor` do1+ bcu5 = rol aso2 56++ ema = bca5 `xor` complement bce5 .&. bci5+ eme = bce5 `xor` complement bci5 .&. bco5+ emi = bci5 `xor` complement bco5 .&. bcu5+ emo = bco5 `xor` complement bcu5 .&. bca5+ emu = bcu5 `xor` complement bca5 .&. bce5++ abi2 = abi `xor` di+ bca6 = rol abi2 62+ ago2 = ago `xor` do1+ bce6 = rol ago2 55+ aku2 = aku `xor` du+ bci6 = rol aku2 39+ ama2 = ama `xor` da+ bco6 = rol ama2 41+ ase2 = ase `xor` de+ bcu6 = rol ase2 2+ esa = bca6 `xor` complement bce6 .&. bci6+ ese = bce6 `xor` complement bci6 .&. bco6+ esi = bci6 `xor` complement bco6 .&. bcu6+ eso = bco6 `xor` complement bcu6 .&. bca6+ esu = bcu6 `xor` complement bca6 .&. bce6++ -- prepareTheta+ bca7 = eba5 `xor` ega `xor` eka `xor` ema `xor` esa+ bce7 = ebe `xor` ege `xor` eke `xor` eme `xor` ese+ bci7 = ebi `xor` egi `xor` eki `xor` emi `xor` esi+ bco7 = ebo `xor` ego `xor` eko `xor` emo `xor` eso+ bcu7 = ebu `xor` egu `xor` eku `xor` emu `xor` esu++ -- thetaRhoPiChiIotaPrepareTheta(round+1, E, A)+ da2 = bcu7 `xor` rol bce7 1+ de2 = bca7 `xor` rol bci7 1+ di2 = bce7 `xor` rol bco7 1+ do2 = bci7 `xor` rol bcu7 1+ du2 = bco7 `xor` rol bca7 1++ eba6 = eba5 `xor` da2+ bca8 = eba6+ ege2 = ege `xor` de2+ bce8 = rol ege2 44+ eki2 = eki `xor` di2+ bci8 = rol eki2 43+ emo2 = emo `xor` do2+ bco8 = rol emo2 21+ esu2 = esu `xor` du2+ bcu8 = rol esu2 14+ aba3 = bca8 `xor` complement bce8 .&. bci8+ aba4 = aba3 `xor` (keccakFRoundConstants VU.! (round + 1))+ abe3 = bce8 `xor` complement bci8 .&. bco8+ abi3 = bci8 `xor` complement bco8 .&. bcu8+ abo3 = bco8 `xor` complement bcu8 .&. bca8+ abu3 = bcu8 `xor` complement bca8 .&. bce8++ ebo2 = ebo `xor` do2+ bca9 = rol ebo2 28+ egu2 = egu `xor` du2+ bce9 = rol egu2 20+ eka2 = eka `xor` da2+ bci9 = rol eka2 3+ eme2 = eme `xor` de2+ bco9 = rol eme2 45+ esi2 = esi `xor` di2+ bcu9 = rol esi2 61+ aga3 = bca9 `xor` complement bce9 .&. bci9+ age3 = bce9 `xor` complement bci9 .&. bco9+ agi3 = bci9 `xor` complement bco9 .&. bcu9+ ago3 = bco9 `xor` complement bcu9 .&. bca9+ agu3 = bcu9 `xor` complement bca9 .&. bce9++ ebe2 = ebe `xor` de2+ bcaA = rol ebe2 1+ egi2 = egi `xor` di2+ bceA = rol egi2 6+ eko2 = eko `xor` do2+ bciA = rol eko2 25+ emu2 = emu `xor` du2+ bcoA = rol emu2 8+ esa2 = esa `xor` da2+ bcuA = rol esa2 18+ aka3 = bcaA `xor` complement bceA .&. bciA+ ake3 = bceA `xor` complement bciA .&. bcoA+ aki3 = bciA `xor` complement bcoA .&. bcuA+ ako3 = bcoA `xor` complement bcuA .&. bcaA+ aku3 = bcuA `xor` complement bcaA .&. bceA++ ebu2 = ebu `xor` du2+ bcaB = rol ebu2 27+ ega2 = ega `xor` da2+ bceB = rol ega2 36+ eke2 = eke `xor` de2+ bciB = rol eke2 10+ emi2 = emi `xor` di2+ bcoB = rol emi2 15+ eso2 = eso `xor` do2+ bcuB = rol eso2 56+ ama3 = bcaB `xor` complement bceB .&. bciB+ ame3 = bceB `xor` complement bciB .&. bcoB+ ami3 = bciB `xor` complement bcoB .&. bcuB+ amo3 = bcoB `xor` complement bcuB .&. bcaB+ amu3 = bcuB `xor` complement bcaB .&. bceB++ ebi2 = ebi `xor` di2+ bcaC = rol ebi2 62+ ego2 = ego `xor` do2+ bceC = rol ego2 55+ eku2 = eku `xor` du2+ bciC = rol eku2 39+ ema2 = ema `xor` da2+ bcoC = rol ema2 41+ ese2 = ese `xor` de2+ bcuC = rol ese2 2+ asa3 = bcaC `xor` complement bceC .&. bciC+ ase3 = bceC `xor` complement bciC .&. bcoC+ asi3 = bciC `xor` complement bcoC .&. bcuC+ aso3 = bcoC `xor` complement bcuC .&. bcaC+ asu3 = bcuC `xor` complement bcaC .&. bceC++ result = VU.fromList [ aba4, abe3, abi3, abo3, abu3, aga3, age3, agi3,+ ago3, agu3, aka3, ake3, aki3, ako3, aku3, ama3,+ ame3, ami3, amo3, amu3, asa3, ase3, asi3, aso3, asu3]++++inputLoadVectors :: Int -> BS.ByteString -> Map.Map Int KeccakVector+inputLoadVectors rate input = do+ let mlen = BS.length input+ let inputOffsets = [0, rate .. mlen - rate]+ Map.fromList $ fmap vectorAt inputOffsets+ where+ vectorAt offset = (offset, VU.fromList $ take keccakStateLength $ fmap valueAt [0 .. rate `div` 8 - 1] ++ repeat 0)+ where+ valueAt i = load64 input (offset + i * 8)++++-- start with the starting vector, xor with the next vector in the list and then permute.+-- the operations need to take place from left to right.+unifiedInputLoadVectors :: KeccakVector -> Int -> BS.ByteString -> KeccakVector+unifiedInputLoadVectors start rate input = go start inputs+ where+ inputs = Map.elems $ inputLoadVectors rate input+ go start' [] = start'+ go start' (input' : inputs') = go nextStart inputs'+ where+ nextStart = keccakF1600StatePermute $ VU.zipWith xor start' input'+++keccakAbsorb :: Int -> BS.ByteString -> Word8 -> KeccakVector+keccakAbsorb rate input domainSep = s'+ where+ s = unifiedInputLoadVectors keccakEmpty rate input+ s' = let loop ss i = ss VU.// [(i, (ss VU.! i) `xor` load64' t (8 * i))]+ in foldl loop s [0 .. rate `div` 8 - 1]++ -- given a rate, an input, and a domain byte, produce the "t"+ -- array used by the keccak absorb.+ -- NOTE: input length is smaller than rate. not sure where this comes from.+ t :: VU.Vector Word8+ t = VU.modify (\ v -> VUM.write v lastIndex (xor 128 (basic VU.! lastIndex))) basic+ where+ inputOffset = (inputLength `div` rate) * rate+ input' = BS.drop inputOffset input+ inputLength = BS.length input+ inputLength' = BS.length input'+ lastIndex = rate - 1+ basic = VU.concat [VU.fromList (BS.unpack input')+ , VU.replicate 1 domainSep+ , VU.replicate (rate - inputLength' - 1) 0+ ]+++-- | Absorb step of SHAKE128 XOF.+shake128Absorb :: BS.ByteString -> KeccakVector+shake128Absorb seed = keccakAbsorb shake128Rate seed 0x1f+++-- | Squeeze step of SHAKE128 XOF. Squeezes full blocks of+-- shake128Rate each. May be used incrementally.+shake128SqueezeBlocks :: KeccakVector -- ^ Initial state+ -> Int -- ^ Number of blocks to process+ -> (BS.ByteString, KeccakVector) -- ^ Resulting output and state+shake128SqueezeBlocks = flip keccakSqueezeblocks shake128Rate+++-- | Squeeze step of Keccak. Squeezes full blocks of 'rate' bytes+-- each. May be used incrementally.+keccakSqueezeblocks :: KeccakVector -> Int -> Int -> (BS.ByteString, KeccakVector)+keccakSqueezeblocks state rate blocks+ | blocks <= 0 = (BS.empty, state)+ | otherwise = (BS.append output nextOutput, nextState)+ where+ state' = keccakF1600StatePermute state+ toEncode = VU.take (rate `div` 8) state' -- just the first rate bytes (Word64 is eight of them!)+ output = VU.foldl toLSB BS.empty toEncode+ toLSB out inp = BS.append out (store64 inp)+ (nextOutput, nextState) = keccakSqueezeblocks state' rate (blocks - 1)+++-- | Completely absorb input data with the SHAKE256 XOF.+shake256 :: BS.ByteString -- ^ Data to be absorbed+ -> Int -- ^ Desired output length+ -> BS.ByteString+shake256 input outputLength = do+ let state = keccakAbsorb shake256Rate input 0x1F+ let nblocks = outputLength `div` shake256Rate+ let (output, state') = keccakSqueezeblocks state shake256Rate nblocks+ let extraBytes = outputLength `mod` shake256Rate+ let (extraOutput, _) = keccakSqueezeblocks state' shake256Rate 1+ if extraBytes == 0+ then output+ else BS.append output (BS.take extraBytes extraOutput)
+ src/Crypto/NewHope/Internal/CCA_KEM.hs view
@@ -0,0 +1,394 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE Safe #-}+{-|+ Module : Crypto.NewHope.CCA_KEM+ Description : IND-CCA-secure operations for NewHope key exchange+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ IND-CPA-secure operations for the NewHope key exchange protocol. The+ algorithm name is either NewHope512-CPAKEM or NewHope1024-CPAKEM,+ depending on the value of N.++ This module contains the actual implementation. Exposed definitions+ are in the 'Crypto.NewHope.CPA_KEM' module.++-}++module Crypto.NewHope.Internal.CCA_KEM where+++import Control.DeepSeq+import qualified Data.ByteString as BS+import StringUtils+++import qualified Crypto.NewHope.CPA_PKE as CPA_PKE+import Crypto.NewHope.FIPS202+import Crypto.NewHope.Internals (N (N1024, N512), symBytes)+import qualified Crypto.NewHope.Internals as Internals+import Crypto.NewHope.Poly (Poly)+import qualified Crypto.NewHope.Poly as Poly+import Crypto.NewHope.RNG+import Crypto.NewHope.Verify+++-- * Counting bytes of our components. Note that all our sizes derive+-- at least in part from corresponding components in CPA_PKE.++-- | A public key is this many bytes long.+publicKeyBytes :: Internals.N -> Int+publicKeyBytes = CPA_PKE.publicKeyBytes++-- | A secret key is this many bytes long.+secretKeyBytes :: Internals.N -> Int+secretKeyBytes m = CPA_PKE.secretKeyBytes m + CPA_PKE.publicKeyBytes m + 2 * symBytes++-- | A ciphertext is this many bytes long.+cipherTextBytes :: Internals.N -> Int+cipherTextBytes m = CPA_PKE.cipherTextBytes m + symBytes -- Second part is for Targhi-Unruh+++-- * SharedSecret++-- | The secret data posessed by both parties, resulting from the key+-- exchange protocol.+newtype SharedSecret = SharedSecret BS.ByteString deriving Eq+++-- | We need this instance so that we can deepseq this data for performance tests.+instance NFData SharedSecret+ where+ rnf (SharedSecret skData) = deepseq skData ()+++-- | Create a SharedSecret from a ByteString.+makeSharedSecret :: BS.ByteString -> SharedSecret+makeSharedSecret bs+ | not lengthOK = error "Invalid length for SharedSecret"+ | otherwise = SharedSecret bs+ where+ lengthOK = BS.length bs == Internals.sharedSecretBytes+++-- | Necessary for `KAT` only.+getSSData :: SharedSecret -> BS.ByteString+getSSData (SharedSecret ssData) = ssData+++-- * PublicKey++-- | A public key; also the data sent from the first to the second party in the key exchange.+newtype PublicKey = PublicKey BS.ByteString deriving Eq++-- | We need this instance so that we can deepseq this data for performance tests.+instance NFData PublicKey+ where+ rnf _pk = ()++-- | Construct PublicKey from raw data+makePublicKey :: BS.ByteString -> PublicKey+makePublicKey bs+ | not lengthOK = error "Invalid length for PublicKey"+ | otherwise = PublicKey bs+ where+ len = BS.length bs+ len512 = publicKeyBytes N512+ len1024 = publicKeyBytes N1024+ lengthOK = len == len512 || len == len1024+++-- | The data inside the PublicKey+getPKData :: PublicKey -> BS.ByteString+getPKData (PublicKey pkData) = pkData+++----------------------- Extracting items from within our data++-- | The N for this key+getPKn :: PublicKey -> Internals.N+getPKn (PublicKey pkData)+ | len == len512 = N512+ | len == len1024 = N1024+ | otherwise = error "Invalid N for PublicKey"+ where+ len = BS.length pkData+ len512 = publicKeyBytes N512+ len1024 = publicKeyBytes N1024+++-- | The encapsulated Poly+getPKPoly :: PublicKey -> Poly+getPKPoly pk@(PublicKey pkData) = Poly.fromByteString encoded+-- This is unused but important to retain as it is useful for documenting the structure of the data.+ where+ polyBytes = Poly.polyBytes $ getPKn pk+ encoded = BS.take polyBytes pkData+++-- | The data for the encapsulated Poly+getPKPolyData :: PublicKey -> BS.ByteString+getPKPolyData pk@(PublicKey pkData) = encoded+-- This is unused but important to retain as it is useful for documenting the structure of the data.+ where+ polyBytes = Poly.polyBytes $ getPKn pk+ encoded = BS.take polyBytes pkData+++-- | The data for the encapsulated Seed+getPKSeedData :: PublicKey -> BS.ByteString+getPKSeedData pk@(PublicKey pkData) = encoded+-- This is unused but important to retain as it is useful for documenting the structure of the data.+ where+ polyBytes = Poly.polyBytes $ getPKn pk+ encoded = BS.drop polyBytes pkData+++-- * SecretKey++-- | A secret key; used to derive initiating party's copy of the+-- 'SharedSecret' in combination with a 'CipherText' from the+-- responding party.+newtype SecretKey = SecretKey BS.ByteString deriving Eq++-- | We need this instance so that we can deepseq this data during performance tests.+instance NFData SecretKey+ where+ rnf _sk = ()++-- | Construct from raw data+makeSecretKey :: BS.ByteString -> SecretKey+makeSecretKey bs+ | not lengthOK = error "Invalid length for SecretKey"+ | otherwise = SecretKey bs+ where+ len = BS.length bs+ len512 = secretKeyBytes N512+ len1024 = secretKeyBytes N1024+ lengthOK = len == len512 || len == len1024+++-- | The N for this key+getSKn :: SecretKey -> Internals.N+getSKn (SecretKey skData)+ | len == len512 = N512+ | len == len1024 = N1024+ | otherwise = error "Invalid N for SecretKey"+ where+ len = BS.length skData+ len512 = secretKeyBytes N512+ len1024 = secretKeyBytes N1024+++----------------------- Extracting items from within our data++-- | The raw data comprising the SecretKey+getSKData :: SecretKey -> BS.ByteString+getSKData (SecretKey skData) = skData+++-- | Raw data for the encapsulated CPA_PKE.SecretKey, which itself is an encoded Poly.+getSkPkeSecretKeyData :: SecretKey -> BS.ByteString+getSkPkeSecretKeyData sk@(SecretKey skData) = encoded+ where+ secretKeyBytes' = CPA_PKE.secretKeyBytes $ getSKn sk+ encoded = BS.take secretKeyBytes' skData+++-- | The encapsulated CPA_PKE.SecretKey+getSkSecretKey :: SecretKey -> CPA_PKE.SecretKey+getSkSecretKey sk = CPA_PKE.makeSecretKeyFromBytes $ getSkPkeSecretKeyData sk+++-- | Raw data for the encapsulated CPA_PKE.PublicKey+getSkPkePublicKeyData :: SecretKey -> BS.ByteString+getSkPkePublicKeyData sk@(SecretKey skData) = encoded+ where+ n = getSKn sk+ secretKeySize = CPA_PKE.secretKeyBytes n+ publicKeySize = CPA_PKE.publicKeyBytes n+ encoded = bsRange skData secretKeySize publicKeySize+++-- | The encapsulated CPA_PKE.PublicKey+getSkPkePublicKey :: SecretKey -> CPA_PKE.PublicKey+getSkPkePublicKey = CPA_PKE.makePublicKeyFromBytes . getSkPkePublicKeyData+++-- | The encapsulated hash+getSkPkHash :: SecretKey -> BS.ByteString+getSkPkHash sk@(SecretKey skData) = encoded+ where+ n = getSKn sk+ secretKeySize = CPA_PKE.secretKeyBytes n+ publicKeySize = CPA_PKE.publicKeyBytes n+ offset = secretKeySize + publicKeySize+ encoded = bsRange skData offset symBytes++-- | I think this is called Z officially -- used as random data for failures. Does it have another use?+getSkZ :: SecretKey -> BS.ByteString+getSkZ sk@(SecretKey skData) = encoded+ where+ n = getSKn sk+ secretKeySize = CPA_PKE.secretKeyBytes n+ publicKeySize = CPA_PKE.publicKeyBytes n+ offset = secretKeySize + publicKeySize + symBytes+ encoded = bsRange skData offset symBytes++-- * CipherText++-- | Secret (encrypted) data sent from the responding party back to+-- the initiating party, used for initiating party to derive the+-- 'SharedSecret'.+newtype CipherText = CipherText BS.ByteString deriving Eq++-- | We need this instance so that we can deepseq this data for performance tests.+instance NFData CipherText+ where+ rnf _sk = ()+++-- | Construct from raw data. composed of CPA_PKE.cipherTextBytes+-- (polyBytes + polyCompressedBytes) and then symBytes (Targhi-Unruh+-- hash)+makeCipherText :: BS.ByteString -> CipherText+makeCipherText bs+ | not lengthOK = error "Invalid length for CipherText"+ | otherwise = CipherText bs+ where+ len = BS.length bs+ len512 = cipherTextBytes N512+ len1024 = cipherTextBytes N1024+ lengthOK = len == len512 || len == len1024++-- | The N for this CipherText+getCTn :: CipherText -> Internals.N+getCTn (CipherText ctData)+ | len == len512 = N512+ | len == len1024 = N1024+ | otherwise = error "Invalid N for CipherText"+ where+ len = BS.length ctData+ len512 = cipherTextBytes N512+ len1024 = cipherTextBytes N1024+++-- | The raw data for this CipherText+getCTData :: CipherText -> BS.ByteString+getCTData (CipherText ctData) = ctData+++-- | The encapsulated CPA_PKE.CipherText data+getCtCTData :: CipherText -> BS.ByteString+getCtCTData ct@(CipherText ctData) = encoded+ where+ n = getCTn ct+ len = CPA_PKE.cipherTextBytes n+ encoded = BS.take len ctData+++-- | The encapsulated CPA_PKE.CipherText+getCtCT :: CipherText -> CPA_PKE.CipherText+getCtCT ct = CPA_PKE.makeCipherTextFromBytes $ getCtCTData ct+++-- * Top-level operations+++-- | The first step of the NewHope key exchange protocol. Called by+-- the initiating party, generates 'PublicKey' and 'SecretKey'. The+-- 'PublicKey' is sent to the receiving party for the next step in the+-- protocol.+keypair :: Context -> Internals.N -> (PublicKey, SecretKey, Context)+keypair ctx n = (makePublicKey pkData, makeSecretKey skData, ctx1)+ where+ (cpaPkePk, cpaPkeSk, ctx0) = CPA_PKE.keypair ctx n++ (extra, ctx1) = randomBytes ctx0 symBytes++ pkData = CPA_PKE.getPKData cpaPkePk -- all the data -- which is an encoded poly and a seed+ skParts = [ CPA_PKE.getSKPolyData cpaPkeSk+ , pkData+ , shake256 pkData symBytes+ , extra+ ]+ skData = foldr BS.append BS.empty skParts -- there must be a more idiomatic way to join a list of BSs+++-- | For the provided 'PublicKey', generates a 'CipherText' and+-- 'SharedSecret'. Called by the receiving party, this produces that+-- party's version of the 'SharedSecret' and also the message to+-- transmit to the initiating party ('CipherText').+encrypt :: Context -> PublicKey -> (CipherText, SharedSecret, Context)+encrypt ctx pk = (makeCipherText ctData, makeSharedSecret ss, ctx')+ where+ pkData = getPKData pk++ (buf, ctx') = randomBytes ctx symBytes+ bufP1Shaken = shake256 buf symBytes -- Don't release system RNG output++ (coin0, coin12) = let bufPart2 = shake256 pkData symBytes -- Multitarget countermeasure for coins + contributory KEM+ buf' = BS.append bufP1Shaken bufPart2+ kCoinsD = shake256 buf' (3 * symBytes)+ in BS.splitAt symBytes kCoinsD -- coins are in kCoinsD+NEWHOPE_SYMBYTES++ (coin1, coin2) = BS.splitAt symBytes coin12 -- just the first symBytes part of buf++ ct = let seed = Internals.makeSeed coin1+ pt = CPA_PKE.makePlainText bufP1Shaken+ pk' = CPA_PKE.makePublicKeyFromBytes pkData+ in CPA_PKE.encrypt pt pk' seed++ ctData = let ctData' = CPA_PKE.getCTData ct+ in BS.append ctData' coin2 -- copy Targhi-Unruh hash into ct++ coin1' = let n = getPKn pk+ cipherTextBytes' = cipherTextBytes n+ in shake256 (BS.take cipherTextBytes' ctData) symBytes -- overwrite coins in kCoinsD with h(c)++ kCoinsD' = BS.append coin0 coin1'+ ss = shake256 kCoinsD' symBytes+++-- | Called by the party initiating the protocol, this function+-- generates the 'SharedSecret' for the given 'CipherText' and+-- 'SecretKey'. The result is the initiating party's copy of the+-- 'SecretKey'. (In terms of encryption functions per se, it is also a+-- cleartext value.)+decrypt :: CipherText -> SecretKey -> (Bool, SharedSecret)+decrypt ct sk = (success, ss)+-- NOTE: by selective use of the ! annotation and the+-- `constantTimeChoose` function, this routine tries to keep+-- computation time invariant between successful and unsuccessful+-- decryptions -- be careful about changing it. Note that we also have+-- automated tests that attempt to verify this property.+ where+ ctData = getCTData ct++ buf = let buf' = let publicText = CPA_PKE.decrypt (getCtCT ct) (getSkSecretKey sk)+ in CPA_PKE.getPTData publicText+ in BS.append buf' $ getSkPkHash sk++ kCoinsD = shake256 buf (3 * symBytes)++ ctCmp = let coin2 = bsRange kCoinsD (2 * symBytes) symBytes+ ctCmp' = let seed = bsRange kCoinsD symBytes symBytes+ bufp1 = BS.take symBytes buf+ in CPA_PKE.encrypt (CPA_PKE.makePlainText bufp1) (getSkPkePublicKey sk) (Internals.makeSeed seed)+ in BS.append (CPA_PKE.getCTData ctCmp') coin2++ success = verify ctData ctCmp++ ssData = let firstTwoCoins = let kCoinsD' = let coin1 = shake256 ctData symBytes+ in bsReplace kCoinsD symBytes coin1 -- overwrite coins in kCoinsD with h(c)+ replacementCoin = let coin0 = BS.take symBytes kCoinsD'+ z = getSkZ sk+ in constantTimeChoose success coin0 z -- overwrite pre-k with z on re-encryption failure (possibly replace with cmov)+ kCoinsD'' = bsReplace kCoinsD' 0 replacementCoin+ in BS.take (2 * symBytes) kCoinsD''+ in shake256 firstTwoCoins symBytes -- hash concatenation of pre-k and h(c) to k+ !ss = makeSharedSecret ssData+
+ src/Crypto/NewHope/Internal/CPA_KEM.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE Safe #-}+{-|+ Module : Crypto.NewHope.Internal.CPA_KEM+ Description : IND-CPA-secure operations for the NewHope key exchange protocol+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ IND-CPA-secure operations for the NewHope key exchange protocol. The+ algorithm name is either NewHope512-CPAKEM or NewHope1024-CPAKEM,+ depending on the value of N.++ This module contains the actual implementation. Exposed definitions+ are in the 'Crypto.NewHope.CPA_KEM' module.++-}++module Crypto.NewHope.Internal.CPA_KEM where+++import Control.DeepSeq+import qualified Data.ByteString as BS+++import qualified Crypto.NewHope.CPA_PKE as CPA_PKE+import Crypto.NewHope.FIPS202+import Crypto.NewHope.Internals (N (N1024, N512))+import qualified Crypto.NewHope.Internals as Internals+import Crypto.NewHope.RNG+++-- * Counting bytes++-- | Size of a PublicKey+publicKeyBytes :: Internals.N -> Int+publicKeyBytes = CPA_PKE.publicKeyBytes++-- | Size of a SecretKey+secretKeyBytes :: Internals.N -> Int+secretKeyBytes = CPA_PKE.secretKeyBytes++-- | Size of a CipherText+cipherTextBytes :: Internals.N -> Int+cipherTextBytes = CPA_PKE.cipherTextBytes+++-- * PublicKey++-- | A public key; also the data sent from the first to the second+-- party in the key exchange.+newtype PublicKey = PublicKey BS.ByteString++-- | We need this instance so that we can deepseq this data for performance tests.+instance NFData PublicKey+ where+ rnf (PublicKey pkData) = seq pkData ()+++-- | Construct a PublicKey from a ByteString of exactly the right+-- size. The result will be a key of N512 or N1024 accordingly.+makePublicKey :: BS.ByteString -> PublicKey+makePublicKey pkData+ | not lengthOK = error "Invalid length for PublicKey"+ | otherwise = PublicKey pkData+ where+ len = BS.length pkData+ len512 = publicKeyBytes N512+ len1024 = publicKeyBytes N1024+ lengthOK = len == len512 || len == len1024+++-- | The raw data inside the PublicKey+getPKData :: PublicKey -> BS.ByteString+getPKData (PublicKey pkData) = pkData+++-- * SecretKey++-- | A secret key; used to derive initiating party's copy of the+-- 'SharedSecret' in combination with a 'CipherText' from the+-- responding party.+newtype SecretKey = SecretKey BS.ByteString++-- | We need this instance so that we can deepseq this data for performance tests.+instance NFData SecretKey+ where+ rnf (SecretKey skData) = seq skData ()+++-- | Construct a SecretKey from a ByteString of exactly the right+-- size. The result will be a key of N512 or N1024 accordingly.+makeSecretKey :: BS.ByteString -> SecretKey+makeSecretKey skData+ | not lengthOK = error "Invalid length for SecretKey"+ | otherwise = SecretKey skData+ where+ len = BS.length skData+ len512 = secretKeyBytes N512+ len1024 = secretKeyBytes N1024+ lengthOK = len == len512 || len == len1024++-- | The raw data inside the SecretKey+getSKData :: SecretKey -> BS.ByteString+getSKData (SecretKey skData) = skData+++-- * CipherText++-- | Secret data sent from the responding party back to the initiating+-- party, used for initiating party to derive the 'SharedSecret'.+newtype CipherText = CipherText BS.ByteString++-- | We need this instance so that we can deepseq this data for performance tests.+instance NFData CipherText+ where+ rnf (CipherText ctData) = seq ctData ()+++-- | Construct a CipherText from a ByteString of exactly the right+-- size. The result will be of N512 or N1024, accordingly.+makeCipherText :: BS.ByteString -> CipherText+makeCipherText ctData+ | not lengthOK = error "Invalid length for CipherText"+ | otherwise = CipherText ctData+ where+ len = BS.length ctData+ len512 = cipherTextBytes N512+ len1024 = cipherTextBytes N1024+ lengthOK = len == len512 || len == len1024+++-- | The raw data inside the CipherText+getCTData :: CipherText -> BS.ByteString+getCTData (CipherText ctData) = ctData+++-- * SharedSecret++-- | The secret data posessed by both parties, resulting from the key+-- exchange protocol.+newtype SharedSecret = SharedSecret BS.ByteString deriving Eq++-- | We need this instance so that we can deepseq this data for performance tests.+instance NFData SharedSecret+ where+ rnf (SharedSecret ssData) = seq ssData ()+++-- | Construct a SharedSecret from a ByteString of length+-- 'sharedSecretBytes'.+makeSharedSecret :: BS.ByteString -> SharedSecret+makeSharedSecret pkData+ | not lengthOK = error "Invalid length for SharedSecret."+ | otherwise = SharedSecret pkData+ where+ goodLength = Internals.sharedSecretBytes+ actualLength = BS.length pkData+ lengthOK = actualLength == goodLength++-- | The raw data inside the SharedSecret+getSSData :: SharedSecret -> BS.ByteString+getSSData (SharedSecret ssData) = ssData+++-- * Top-level operations+++-- | The first step of the NewHope key exchange protocol. Called by+-- the initiating party, generates 'PublicKey' and 'SecretKey'. The+-- 'PublicKey' is sent to the receiving party for the next step in the+-- protocol.+keypair :: Context -> Internals.N -> (PublicKey, SecretKey, Context)+keypair ctx n = (pk', sk', ctx')+ where+ -- Note that this encapsulates keys returned by CPA_PKE.+ (pk, sk, ctx') = CPA_PKE.keypair ctx n+ pk' = makePublicKey $ CPA_PKE.getPKData pk+ sk' = makeSecretKey $ CPA_PKE.getSKPolyData sk+++-- | For the provided 'PublicKey', generates a 'CipherText' and+-- 'SharedSecret'. Called by the receiving party, this produces that+-- party's version of the 'SharedSecret' and also the message to+-- transmit to the initiating party ('CipherText').+encrypt :: Context -> PublicKey -> (CipherText, SharedSecret, Context)+encrypt ctx pk = (ct, ss, ctx')+ where+ symBytes = fromIntegral Internals.symBytes+ (buf, ctx') = randomBytes ctx symBytes++ (buf0, buf1) = let buf_2sym = shake256 buf (2 * symBytes)+ in BS.splitAt symBytes buf_2sym -- we use them separately; coins are buf1 and buf0 used as cleartext++ ct = let ct' = let pk' = CPA_PKE.makePublicKeyFromBytes $ getPKData pk+ in CPA_PKE.encrypt (CPA_PKE.makePlainText buf0) pk' (Internals.makeSeed buf1)+ in makeCipherText $ CPA_PKE.getCTData ct'++ ss = let ss' = shake256 buf0 symBytes -- hash pre-k to ss+ in makeSharedSecret ss'+++-- | Called by the party initiating the protocol, this function+-- generates the 'SharedSecret' for the given 'CipherText' and+-- 'SecretKey'. The result is the initiating party's copy of the+-- 'SecretKey'. (In terms of encryption functions per se, it is also a+-- cleartext value.)+decrypt :: CipherText -> SecretKey -> SharedSecret+decrypt ct sk = SharedSecret ss+ where+ ss = let ss' = let ct' = CPA_PKE.makeCipherTextFromBytes $ getCTData ct+ sk' = CPA_PKE.makeSecretKeyFromBytes $ getSKData sk+ in CPA_PKE.decrypt ct' sk'+ symBytes = fromIntegral Internals.symBytes+ in shake256 (CPA_PKE.getPTData ss') symBytes -- hash pre-k to ss
+ src/Crypto/NewHope/Internal/RNG.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.Internal.RNG+ Description : Implements the CTR-DRBG standard on top of AES256.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ CTR-DRBG == Counter mode Deterministic Random Byte Generator.+ In addition, there are a few useful extras.++ Please see https://nvlpubs.nist.gov/nistpubs/SpecialPublications/NIST.SP.800-90Ar1.pdf+ for details on the standard.++ This module contains the actual implementation. Exposed definitions+ are in the 'Crypto.NewHope.RNG' module.++-}++module Crypto.NewHope.Internal.RNG where+++import Codec.Crypto.AES+import Control.DeepSeq+import Data.Bits+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL+import Data.Semigroup ((<>))+import Data.Word+++newtype RandomSeed = RandomSeed BS.ByteString++randomSeedBytes :: Int+randomSeedBytes = 48++getRandomSeedData :: RandomSeed -> BS.ByteString+getRandomSeedData (RandomSeed rsData) = rsData+++-- | Strings or ByteStrings may be used for source data.+class RandomSeedable a+ where+ -- | Uses external entropy (precisely 48 bytes) to create a 'RandomSeed', used for initializing the pseudorandom number generator+ makeRandomSeed :: a -> RandomSeed++instance RandomSeedable String+ where+ makeRandomSeed s | not lengthOK = error $ "Invalid length for RandomSeed. Have " ++ show len ++ " and require " ++ show randomSeedBytes ++ " bytes."+ | otherwise = RandomSeed $ BSC.pack s+ where+ len = Prelude.length s+ lengthOK = len == randomSeedBytes++instance RandomSeedable BS.ByteString+ where+ makeRandomSeed bs | not lengthOK = error $ "Invalid length for RandomSeed. Have " ++ show len ++ " and require " ++ show randomSeedBytes ++ " bytes."+ | otherwise = RandomSeed bs+ where+ len = BS.length bs+ lengthOK = len == randomSeedBytes+++-- * Key++newtype Key = Key { getKey :: BS.ByteString } deriving (Eq)++keyBytes :: Int+keyBytes = 32 -- 32 * 8 == 64 * 4 == 128 * 2 == 256 bits++createKey :: BS.ByteString -> Key+createKey value+ | BS.length value /= keyBytes = error "Incorrect key length"+ | otherwise = Key { getKey = value }+++-- * V++newtype V = V { getV :: BS.ByteString } deriving (Eq)++-- | The size of a V in bytes+vBytes :: Int+vBytes = 16 -- 16 * 8 == 32 * 4 == 64 * 2 == 128 bits++-- | Construct a V+createV :: BS.ByteString -> V+createV value+ | BS.length value /= vBytes = error $ "Incorrect V length: " ++ show (BS.length value)+ | otherwise = V { getV = value }+++-- | Increment the V+incrementV :: V -> V+incrementV (V v) = let v' = reverse $ BS.unpack v+ v'' = go v'+ v''' = BS.pack $ reverse v''++ go [] = []+ go (0xff : is) = 0 : go is+ go (i : is) = (i + 1) : is+ in V v'''+++-----------------------++-- | State for pseudorandom number generation+data Context = Context { ctxKey :: Key+ , ctxV :: V+ , ctxReseedCounter :: Int+ } deriving (Eq)++-- | We need this instance so that we can deepseq this data while doing performance tests.+instance NFData Context+ where+ rnf Context { ctxKey = key, ctxV = v } = seq key seq v ()+++-- | Update the context with new data+update :: Context -> Maybe BS.ByteString -> Context+update ctx providedData = let+ _ = ctxReseedCounter ctx+ Key key = ctxKey ctx+ v = ctxV ctx++ ecbModeDoesNotUseIV = BS.pack $ replicate 16 0++ (_, chunks) = foldr go (v, []) [0 .. (2 :: Int)]+ where+ go _ (_v, _chunks) = (v', encrypted : _chunks)+ where+ v' = incrementV _v+ encrypted = crypt' ECB key ecbModeDoesNotUseIV Encrypt (getV v')++ chunks' = reverse chunks+ unified = mconcat chunks'+ unified' = case providedData of+ Nothing -> unified+ Just providedData' -> BS.pack $ BS.zipWith xor unified providedData'++ (nextKeyData, nextVData) = BSC.splitAt 32 unified'+ nextKey = createKey nextKeyData+ nextV = createV nextVData+ ctx' = ctx { ctxKey = nextKey, ctxV = nextV }+ in ctx'++++-- * Higher-level functions using Context data++-- | Creates a 'Context' as state for the pseudorandom number generator, required for key exchange operations+randomBytesInit :: RandomSeed -- ^ External entropy to seed the generator+ -> Maybe RandomSeed -- ^ Optional additional entropy to include+ -> Integer -- ^ Security strength: unused by this implementation+ -> Context -- ^ The resulting PRNG state+randomBytesInit seed personalization _securityStrength = update ctx (Just seedMaterial)+ where+ RandomSeed entropyInput = seed+ seedMaterial = BS.pack $ case personalization of+ Nothing -> BS.unpack entropyInput+ Just (RandomSeed persData) -> zipWith xor (BS.unpack entropyInput) (BS.unpack persData)+ -- initial version with dummy data; it gets immediatlely replaced with the update.+ ctx = Context { ctxKey = createKey $ BS.pack $ replicate keyBytes 0+ , ctxV = createV $ BS.pack $ replicate vBytes 0+ , ctxReseedCounter = 1+ }+++-- | Generate pseudorandom bytes from the Context.+randomBytes :: Context -> Int -> (BS.ByteString, Context)+randomBytes ctx count = (result, ctx'')+ where+ result = BS.take count $ BSL.toStrict $ Builder.toLazyByteString results -- last block could be partial+ blocks = ceiling $ (fromIntegral count :: Double) / 16+ counter = ctxReseedCounter ctx + 1+ key = getKey $ ctxKey ctx+ ecbModeDoesNotUseIV = BS.pack $ replicate 16 0+ ctx'' = update ctx' { ctxReseedCounter = counter } Nothing+ (results, ctx') = foldr go (Builder.byteString BS.empty, ctx) [1 .. blocks :: Int]+ where+ go _ (_results, _ctx) = (_results <> Builder.byteString block, _ctx')+ where+ v = incrementV $ ctxV _ctx+ block = crypt' ECB key ecbModeDoesNotUseIV Encrypt (getV v)+ _ctx' = _ctx { ctxV = v }++++-- * Useful extras++-- | Computes a random Word64 along with the next context to use. If+-- you want a full-range Word64 value, this is what you want. If you+-- want a pretty evenly-distributed random number in a given range,+-- see randomInteger below.+nextWord64 :: Context -> (Word64, Context)+nextWord64 ctx = (value, ctx')+ where+ (fourBytes, ctx') = randomBytes ctx 4+ fourBytes' = BS.unpack fourBytes+ value = shiftL (fromIntegral (fourBytes' !! 0)) 24+ .|. shiftL (fromIntegral (fourBytes' !! 1)) 16+ .|. shiftL (fromIntegral (fourBytes' !! 2)) 8+ .|. fromIntegral (fourBytes' !! 3)+++-- | Computes a random Integer in the given range, along with the next+-- context to use. This function body is derived from and very+-- similar to randomIvalInteger as defined in System.Random (© 2001+-- The University of Glasgow). Since this is a public domain algorithm+-- and a purely functional expression thereof, I don't think that the+-- below causes the licensing terms of the foregoing to need+-- incorporation here, but I welcome correction.+randomInteger :: Context -> (Integer, Integer) -> (Integer, Context)+randomInteger ctx (minValue, maxValue)+ | minValue > maxValue = randomInteger ctx (maxValue, minValue)+ | otherwise = (fromInteger (minValue + v `mod` k), ctx')+ where+ (v, ctx') = accumulate 1 0 ctx+ (genlo, genhi) = (minBound, maxBound) :: (Word64, Word64)+ b = fromIntegral genhi - fromIntegral genlo + 1+ q = 1000+ k = maxValue - minValue + 1+ magtgt = k * q++ accumulate mag vv ctx0+ | mag >= magtgt = (vv, ctx0)+ | otherwise = v' `seq` accumulate (mag * b) v' ctx0'+ where+ (x, ctx0') = nextWord64 ctx0+ v' = vv * b + (fromIntegral x - fromIntegral genlo)
+ src/Crypto/NewHope/Internal/SeedExpander.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Trustworthy #-}+{-# OPTIONS_HADDOCK prune #-}+{-|+ Module : Crypto.NewHope.Internal.SeedExpander+ Description : Seed expander for NewHope.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ The "seed expander" is a facility specified by NIST for generating+ pseudorandom data given a seed. It is not used in the actual NewHope+ key exchange and is provided here for completeness/isomorphism with+ the NewHope C reference library.++ This module contains the actual implementation. Exposed definitions+ are in the 'Crypto.NewHope.SeedExpander' module.+++ * Sample usage++ @+ let maxLen' = case maxLen 256 of Right value -> value+ Left x -> error (show x)+ + let diversifier = case createDiversifier (BSC.pack "12345678") of Right value -> value+ Left x -> error (show x)+ + let seed = (Internals.makeSeed "32 bytes of seed data go here...")+ + let ctx = case seedexpanderInit seed diversifier maxLen' of Right value -> value+ Left x -> error (show x)+ + let (ctx', buf) = case seedexpander ctx 16 of Right value -> value+ Left x r -> error (show x)+ @++-}++module Crypto.NewHope.Internal.SeedExpander where++import Codec.Crypto.AES+import Control.Monad.Except+import Data.Bits+import Data.Semigroup ((<>))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Lazy as BSL+import Data.Word++import qualified Crypto.NewHope.Internals as Internals+import qualified Crypto.NewHope.Internal.RNG as RNG+++-- | Error conditions detected in creation and use of 'Context' data+data RNGError = BadDiversifierLen | BadMaxLen | BadReqLen deriving (Show)+++-- | Maintains state for a series of calls to generate pseudorandom data via 'seedexpander'.+data Context = Context { ctxBuffer :: BS.ByteString+ , ctxBufferPos :: Word64+ , ctxLengthRemaining :: Word64+ , ctxKey :: RNG.Key+ , ctxCounter :: RNG.V+ } deriving (Eq)+++-- | Contains extra seed material for initializing SeedExpander+newtype Diversifier = Diversifier BS.ByteString deriving Show++-- | Specifies eight bytes of data for use as part of the seed material to be expanded.+createDiversifier :: (MonadError RNGError m) => BS.ByteString -> m Diversifier+createDiversifier bs+ | BS.length bs /= 8 = throwError BadDiversifierLen+ | otherwise = return $ Diversifier bs+++-- | Contains the maximum number of bytes that a 'Context' will generate.+newtype MaxLen = MaxLen Word64++-- | Specifies the maximum number of bytes that a 'Context' will generate.+maxLen :: (MonadError RNGError m) => Word64 -> m MaxLen+maxLen n+ | n < 0 || n > 0x100000000 = throwError BadMaxLen+ | otherwise = return $ MaxLen n+ ++-- | Create a 'Context' for generation of data.+seedexpanderInit :: (MonadError RNGError m) => Internals.Seed -> Diversifier -> MaxLen -> m Context+seedexpanderInit (Internals.Seed seed) (Diversifier diversifier) (MaxLen maxLength) = return ctx+ where+ ctx = Context { ctxBuffer = BS.pack $ replicate 16 0 -- irrelevant; will be discarded on first update+ , ctxBufferPos = 16 -- at the end, so the first call will fill it+ , ctxLengthRemaining = maxLength+ , ctxKey = RNG.createKey seed+ , ctxCounter = createCounter+ }++ -- Structure of counter:+ -- 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15+ -- DIVERSIFIER-----------| maxlen----| 00 00 00 00+ -- MSB LSB ++ createCounter :: RNG.V+ createCounter = RNG.createV value+ where+ maxlenFourBytes = fromIntegral $ maxLength .&. 0xFFffFFff+ zeroCounter = 0+ value = BS.pack (BS.unpack diversifier+ ++ BSL.unpack (Builder.toLazyByteString (Builder.word32BE maxlenFourBytes))+ ++ BSL.unpack (Builder.toLazyByteString (Builder.word32BE zeroCounter)))++ +-- | Generate pseudorandom data from the given 'Context'. The returned+-- pair contains the requested data and the next 'Context' to use.+seedexpander :: (MonadError RNGError m) => Context -> Word64 -> m (BS.ByteString, Context)+seedexpander ctx xlen+ | xlen >= ctxLengthRemaining ctx = throwError BadReqLen -- i'd think it would be > and not >= but reference source' uses >=+ | xlen < 0 = return (BS.pack [], ctx)+ | xlen <= (16 - bufferPos) = return (existingBufferResult, ctx'0)+ | otherwise = do -- more than a single buffer's worth, or more than we have left in buffer+ (result', ctx') <- seedexpander ctx'1 xlen'+ return (restOfExistingBuffer <> result', ctx')+ where+ bufferPos = ctxBufferPos ctx+ bytesUsedOfBuffer = min (16 - bufferPos) (min xlen 16) -- how much from current buffer we'll use++ restOfExistingBuffer = BS.drop (fromIntegral bufferPos) (ctxBuffer ctx) -- all of the unused bytes in the current buffer+ existingBufferResult = BS.take (fromIntegral bytesUsedOfBuffer) restOfExistingBuffer -- the actual bytes we'll use from the buffer.+ -- (only calculated if we don't need more bytes)++ -- For when we are returning bytes from our existing buffer.+ lengthRemaining = ctxLengthRemaining ctx - fromIntegral bytesUsedOfBuffer -- how many bytes will be left in the Context?+ ctx'0 = ctx { ctxBufferPos = bufferPos + xlen,+ ctxLengthRemaining = lengthRemaining+ }++ -- When the existing buffer does not satisfy our appetite, prepare the next buffer and context.+ ctx'1 = ctx { ctxCounter = RNG.incrementV $ ctxCounter ctx+ , ctxBufferPos = 0+ , ctxBuffer = nextBuffer+ , ctxLengthRemaining = lengthRemaining+ }+ where+ nextBuffer = crypt' ECB keyValue ecbModeDoesNotUseIV Encrypt payloadValue+ where+ RNG.Key keyValue = ctxKey ctx+ RNG.V payloadValue = ctxCounter ctx+ ecbModeDoesNotUseIV = BS.pack $ replicate 16 0 -- we'd use ⊥ but the AES library evaluates it, even for ECB++ xlen' = xlen - bytesUsedOfBuffer
+ src/Crypto/NewHope/Internals.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Safe #-}+{-|+ Module : Crypto.NewHope.Internals+ Description : Internal constants and functions+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ Internal constants and functions++-}++module Crypto.NewHope.Internals where++import Control.DeepSeq+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+++-- | There are two legal parameter sets for NewHope: either 512 or 1024.+data N = N512 -- ^ Represents the N=512 parameter set+ | N1024 -- ^ Represents the N=1024 parameter set+ deriving (Eq)++-- | The numerical value of the parameter set in question+value :: N -> Int+value N512 = 512+value N1024 = 1024+++q :: Int+q = 12289+++-- | The size of shared key, seeds/coins, and hashes+symBytes :: Int+symBytes = 32++-- | The size of a Seed+seedBytes :: Int+seedBytes = symBytes++-- | The size of SharedSecrets+sharedSecretBytes :: Int+sharedSecretBytes = symBytes+++-- | Data used throughout the NewHope implementation. Externally, used+-- to initialize the SeedExpander pseudorandom number generator.+newtype Seed = Seed BS.ByteString deriving Eq++-- | We need this instance so that we can deepseq this data for performance tests.+instance NFData Seed+ where+ rnf (Seed seedData) = seq seedData ()+++-- | Extract data from the Seed+getSeedData :: Seed -> BS.ByteString+getSeedData (Seed seedData) = seedData+++-- | Seeds may be constructed using Strings or ByteStrings as source data.+class Seedable a+ where+ -- | Uses external entropy (precisely 32 bytes) to create a 'Seed'.+ makeSeed :: a -> Seed++instance Seedable BS.ByteString+ where+ makeSeed bs | not lengthOK = error $ "Invalid length for Seed. Have " ++ show len ++ " and require " ++ show symBytes ++ " bytes."+ | otherwise = Seed bs+ where+ len = BS.length bs+ lengthOK = len == symBytes++instance Seedable String+ where+ makeSeed s | not lengthOK = error $ "Invalid length for Seed. Have " ++ show len ++ " and require " ++ show symBytes ++ " bytes."+ | otherwise = Seed $ BSC.pack s+ where+ len = length s+ lengthOK = len == symBytes
+ src/Crypto/NewHope/NTT.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.NTT+ Description : Number-theoretic transforms for NewHope.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ Number-theoretic transforms for NewHope.++ See: https://en.wikipedia.org/wiki/Discrete_Fourier_transform_(general)#Number-theoretic_transform++-}++module Crypto.NewHope.NTT where+++import Data.Bits+import qualified Data.Vector.Unboxed as VU+import Data.Word++import qualified Crypto.NewHope.Internals as Internals+import Crypto.NewHope.Reduce (montgomeryReduce)+++type NTTVector = VU.Vector Word16++-- | Bit-reverse a vector. See https://en.wikipedia.org/wiki/Bit-reversal_permutation+bitrev :: NTTVector -> NTTVector+bitrev p = VU.imap go p+ where+ table = case len of+ 512 -> bitrevTable512+ 1024 -> bitrevTable1024+ _ -> error "unexpected vector length"+ len = VU.length p+ go i _ = p VU.! fromIntegral (table VU.! i)+++-- | Performs pointwise (coefficient-wise) multiplication of two+-- polynomials. The factors parameter contains coefficients assumed+-- to be in Montgomery representation.+mulCoefficients :: NTTVector -- ^ first polynomial, in standard representation+ -> NTTVector -- ^ second polynomial ("factors"), in Montgomery representation+ -> NTTVector+mulCoefficients = VU.zipWith go+ where+ go a b = montgomeryReduce (fromIntegral a * fromIntegral b)+++getPreReduce :: Integral a => a -> a -> a -> Word32+getPreReduce a b w = w' * (a' + (3 :: Word32) * q - b')+ where+ a' = fromIntegral a :: Word32+ b' = fromIntegral b :: Word32+ q = fromIntegral Internals.q :: Word32+ w' = fromIntegral w :: Word32+++-- | Computes number-theoretic transform (NTT) of a polynomial.+-- Inputs are bit-reversed, output is in standard order.+ntt :: NTTVector -- ^ Input polynomial, in bit-reversed order+ -> NTTVector -- ^ Powers of root of unity omega, in Montgomery domain+ -> NTTVector -- ^ Result polynomial, in normal order+ntt vec ω = foldl go vec [0, 2, 4, 6, 8]+ where+ vectorLength = VU.length vec++ modVec :: NTTVector -> Int -> Word16 -> Int -> Word16 -> NTTVector+ modVec διάνυσμα index value index2 value2 = διάνυσμα VU.// [(index, value), (index2, value2)]++ go :: NTTVector -> Int -> NTTVector+ go διάνυσμα i = if i >= 8 && vectorLength == 512+ then vec' else vec''+ where+ vec' = foldl (process distanceEven True) διάνυσμα [0..distanceEven-1]+ vec'' = foldl (process distanceOdd False) vec' [0..distanceOdd-1]+ distanceEven = shift 1 i+ distanceOdd = shift distanceEven 1++ process :: Int -> Bool -> NTTVector -> Int -> NTTVector+ process distance isEven vic start = foldl jLoop vic joinedParams+ where+ increment = 2 * distance+ second = start + increment+ limit = vectorLength - 2+ items = [start, second..limit]+ joinedParams = zip items [0..]++ jLoop :: NTTVector -> (Int, Int) -> NTTVector+ jLoop vac (j, jTwiddle) = modVec vac j value0 j' value1+ where+ j' = j + distance+ w = ω VU.! jTwiddle+ temp = vac VU.! j+ ajdist = vac VU.! j'+ value0 = if isEven+ then temp + ajdist+ else (temp + ajdist) `mod` fromIntegral Internals.q+ preReduce = getPreReduce temp ajdist w+ value1 = montgomeryReduce preReduce+++-- | Contains bit-reversed 9-bit indices to be used to re-order+-- polynomials before number theoratic transform+bitrevTable :: Int -> NTTVector+bitrevTable bits = case bits of+ 512 -> bitrevTable512+ 1024 -> bitrevTable1024+ _ -> error "Unsupported"++-- | The 512-item version of the vector+bitrevTable512 :: NTTVector+bitrevTable512 = VU.fromList [ 0,256,128,384,64,320,192,448,32,288,160,416,96,352,224,480,16,272,144,400,80,336,208,+ 464,48,304,176,432,112,368,240,496,8,264,136,392,72,328,200,456,40,296,168,424,104,+ 360,232,488,24,280,152,408,88,344,216,472,56,312,184,440,120,376,248,504,4,260,132,+ 388,68,324,196,452,36,292,164,420,100,356,228,484,20,276,148,404,84,340,212,468,52,+ 308,180,436,116,372,244,500,12,268,140,396,76,332,204,460,44,300,172,428,108,364,236,+ 492,28,284,156,412,92,348,220,476,60,316,188,444,124,380,252,508,2,258,130,386,66,+ 322,194,450,34,290,162,418,98,354,226,482,18,274,146,402,82,338,210,466,50,306,178,+ 434,114,370,242,498,10,266,138,394,74,330,202,458,42,298,170,426,106,362,234,490,26,+ 282,154,410,90,346,218,474,58,314,186,442,122,378,250,506,6,262,134,390,70,326,198,+ 454,38,294,166,422,102,358,230,486,22,278,150,406,86,342,214,470,54,310,182,438,118,+ 374,246,502,14,270,142,398,78,334,206,462,46,302,174,430,110,366,238,494,30,286,158,+ 414,94,350,222,478,62,318,190,446,126,382,254,510,1,257,129,385,65,321,193,449,33,+ 289,161,417,97,353,225,481,17,273,145,401,81,337,209,465,49,305,177,433,113,369,241,+ 497,9,265,137,393,73,329,201,457,41,297,169,425,105,361,233,489,25,281,153,409,89,+ 345,217,473,57,313,185,441,121,377,249,505,5,261,133,389,69,325,197,453,37,293,165,+ 421,101,357,229,485,21,277,149,405,85,341,213,469,53,309,181,437,117,373,245,501,13,+ 269,141,397,77,333,205,461,45,301,173,429,109,365,237,493,29,285,157,413,93,349,221,+ 477,61,317,189,445,125,381,253,509,3,259,131,387,67,323,195,451,35,291,163,419,99,+ 355,227,483,19,275,147,403,83,339,211,467,51,307,179,435,115,371,243,499,11,267,139,+ 395,75,331,203,459,43,299,171,427,107,363,235,491,27,283,155,411,91,347,219,475,59,+ 315,187,443,123,379,251,507,7,263,135,391,71,327,199,455,39,295,167,423,103,359,231,+ 487,23,279,151,407,87,343,215,471,55,311,183,439,119,375,247,503,15,271,143,399,79,+ 335,207,463,47,303,175,431,111,367,239,495,31,287,159,415,95,351,223,479,63,319,191,+ 447,127,383,255,511]+++-- | The 1024-item version of the vector+bitrevTable1024 :: NTTVector+bitrevTable1024 = VU.fromList [ 0,512,256,768,128,640,384,896,64,576,320,832,192,704,448,960,32,544,288,800,160,672,+ 416,928,96,608,352,864,224,736,480,992,16,528,272,784,144,656,400,912,80,592,336,+ 848,208,720,464,976,48,560,304,816,176,688,432,944,112,624,368,880,240,752,496,1008,+ 8,520,264,776,136,648,392,904,72,584,328,840,200,712,456,968,40,552,296,808,168,680,+ 424,936,104,616,360,872,232,744,488,1000,24,536,280,792,152,664,408,920,88,600,344,+ 856,216,728,472,984,56,568,312,824,184,696,440,952,120,632,376,888,248,760,504,1016,+ 4,516,260,772,132,644,388,900,68,580,324,836,196,708,452,964,36,548,292,804,164,676,+ 420,932,100,612,356,868,228,740,484,996,20,532,276,788,148,660,404,916,84,596,340,+ 852,212,724,468,980,52,564,308,820,180,692,436,948,116,628,372,884,244,756,500,1012,+ 12,524,268,780,140,652,396,908,76,588,332,844,204,716,460,972,44,556,300,812,172,+ 684,428,940,108,620,364,876,236,748,492,1004,28,540,284,796,156,668,412,924,92,604,+ 348,860,220,732,476,988,60,572,316,828,188,700,444,956,124,636,380,892,252,764,508,+ 1020,2,514,258,770,130,642,386,898,66,578,322,834,194,706,450,962,34,546,290,802,+ 162,674,418,930,98,610,354,866,226,738,482,994,18,530,274,786,146,658,402,914,82,+ 594,338,850,210,722,466,978,50,562,306,818,178,690,434,946,114,626,370,882,242,754,+ 498,1010,10,522,266,778,138,650,394,906,74,586,330,842,202,714,458,970,42,554,298,+ 810,170,682,426,938,106,618,362,874,234,746,490,1002,26,538,282,794,154,666,410,922,+ 90,602,346,858,218,730,474,986,58,570,314,826,186,698,442,954,122,634,378,890,250,+ 762,506,1018,6,518,262,774,134,646,390,902,70,582,326,838,198,710,454,966,38,550,+ 294,806,166,678,422,934,102,614,358,870,230,742,486,998,22,534,278,790,150,662,406,+ 918,86,598,342,854,214,726,470,982,54,566,310,822,182,694,438,950,118,630,374,886,+ 246,758,502,1014,14,526,270,782,142,654,398,910,78,590,334,846,206,718,462,974,46,+ 558,302,814,174,686,430,942,110,622,366,878,238,750,494,1006,30,542,286,798,158,670,+ 414,926,94,606,350,862,222,734,478,990,62,574,318,830,190,702,446,958,126,638,382,+ 894,254,766,510,1022,1,513,257,769,129,641,385,897,65,577,321,833,193,705,449,961,+ 33,545,289,801,161,673,417,929,97,609,353,865,225,737,481,993,17,529,273,785,145,+ 657,401,913,81,593,337,849,209,721,465,977,49,561,305,817,177,689,433,945,113,625,+ 369,881,241,753,497,1009,9,521,265,777,137,649,393,905,73,585,329,841,201,713,457,+ 969,41,553,297,809,169,681,425,937,105,617,361,873,233,745,489,1001,25,537,281,793,+ 153,665,409,921,89,601,345,857,217,729,473,985,57,569,313,825,185,697,441,953,121,+ 633,377,889,249,761,505,1017,5,517,261,773,133,645,389,901,69,581,325,837,197,709,+ 453,965,37,549,293,805,165,677,421,933,101,613,357,869,229,741,485,997,21,533,277,+ 789,149,661,405,917,85,597,341,853,213,725,469,981,53,565,309,821,181,693,437,949,+ 117,629,373,885,245,757,501,1013,13,525,269,781,141,653,397,909,77,589,333,845,205,+ 717,461,973,45,557,301,813,173,685,429,941,109,621,365,877,237,749,493,1005,29,541,+ 285,797,157,669,413,925,93,605,349,861,221,733,477,989,61,573,317,829,189,701,445,+ 957,125,637,381,893,253,765,509,1021,3,515,259,771,131,643,387,899,67,579,323,835,+ 195,707,451,963,35,547,291,803,163,675,419,931,99,611,355,867,227,739,483,995,19,+ 531,275,787,147,659,403,915,83,595,339,851,211,723,467,979,51,563,307,819,179,691,+ 435,947,115,627,371,883,243,755,499,1011,11,523,267,779,139,651,395,907,75,587,331,+ 843,203,715,459,971,43,555,299,811,171,683,427,939,107,619,363,875,235,747,491,1003,+ 27,539,283,795,155,667,411,923,91,603,347,859,219,731,475,987,59,571,315,827,187,+ 699,443,955,123,635,379,891,251,763,507,1019,7,519,263,775,135,647,391,903,71,583,+ 327,839,199,711,455,967,39,551,295,807,167,679,423,935,103,615,359,871,231,743,487,+ 999,23,535,279,791,151,663,407,919,87,599,343,855,215,727,471,983,55,567,311,823,+ 183,695,439,951,119,631,375,887,247,759,503,1015,15,527,271,783,143,655,399,911,79,+ 591,335,847,207,719,463,975,47,559,303,815,175,687,431,943,111,623,367,879,239,751,+ 495,1007,31,543,287,799,159,671,415,927,95,607,351,863,223,735,479,991,63,575,319,+ 831,191,703,447,959,127,639,383,895,255,767,511,1023]
+ src/Crypto/NewHope/Poly.hs view
@@ -0,0 +1,378 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.Poly+ Description : Polynomials and related operations.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ Polynomials and related operations.++-}++module Crypto.NewHope.Poly where++import Control.DeepSeq+import Control.Monad.State (join)+import Data.Bits+import qualified Data.ByteString as BS+import Data.Int+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Unboxed.Mutable as VUM+import Data.Word+import GHC.Generics (Generic)+import Prelude hiding (length)++import Crypto.NewHope.FIPS202+import Crypto.NewHope.Internals (N (N1024, N512))+import qualified Crypto.NewHope.Internals as Internals+import qualified Crypto.NewHope.NTT as NTT+import Crypto.NewHope.Precomp+import Crypto.NewHope.Reduce (montgomeryReduce)+import MiscUtils+++-- | Our Poly vectors are always of length N.+newtype Poly = Poly (VU.Vector Word16) deriving (Eq, Show, Generic, NFData)+++-- | Bytes taken by regular encoded polynomials.+polyBytes :: N -> Int+polyBytes v = (14 * Internals.value v) `div` 8++-- | Bytes taken by a Poly-derived msg.+polyMsgBytes :: Int+polyMsgBytes = Internals.symBytes++-- | Bytes taken by a compressed Poly.+polyCompressedBytes :: N -> Int+polyCompressedBytes v = (3 * Internals.value v) `div` 8+++-- | The length of this Poly+length :: Poly -> Int+length (Poly v) = VU.length v+++-- | The parameter set to which this Poly belongs+getN :: Poly -> N+getN p = case length p of+ 512 -> N512+ 1024 -> N1024+ _ -> error "Unexpected Poly length"+++-- | Fully reduces an integer modulo q in constant time. Returns+-- integer in {0,...,q-1} congruent to x modulo q.+coeffFreeze :: Word16 -> Word16+coeffFreeze x = r'+ where+ q = fromIntegral Internals.q+ r = x `mod` q+ m = r - q+ c = fromIntegral (fromIntegral m :: Int16) :: Int16+ c' = shiftR c 15+ c'word = fromIntegral c' :: Word16+ r' = m `xor` ((r `xor` m) .&. c'word)+++-- | computes |(x mod q) - Q/2|+flipabs :: Word16 -> Word16+flipabs x = fromIntegral $ xor m (r' + m)+ where+ q :: Int+ q = fromIntegral Internals.q+ r = fromIntegral $ coeffFreeze x+ r' = r - (q `div` 2)+ m = shiftR r' 15+++-- | Deserialize+fromByteString :: BS.ByteString -> Poly+fromByteString a+ | not bytesOK = error $ "Invalid number (" ++ show bytes ++ ") of serialized bytes for Poly."+ | otherwise = Poly result+ where+ bytes = BS.length a+ bytes512 = polyBytes N512+ bytes1024 = polyBytes N1024+ bytesOK = (bytes == bytes512) || (bytes == bytes1024)++ result = VU.fromList $ fmap fromIntegral joined+ joined = join folded+ folded = Prelude.foldr go [] as+ as = Prelude.take (bytes `div` 4) $ VU.fromList <$> chunk 7 (fromIntegral <$> BS.unpack a :: [Word16])++ go b c = [i0, i1, i2, i3] : c+ where+ b0 = b VU.! 0+ b1 = b VU.! 1+ b2 = b VU.! 2+ b3 = b VU.! 3+ b4 = b VU.! 4+ b5 = b VU.! 5+ b6 = b VU.! 6++ i0 = b0 .|. shiftL (b1 .&. 0x3f) 8+ i1 = shiftR b1 6 .|. shiftL b2 2 .|. shiftL (b3 .&. 0x0f) 10+ i2 = shiftR b3 4 .|. shiftL b4 4 .|. shiftL (b5 .&. 0x03) 12+ i3 = shiftR b5 2 .|. shiftL b6 6+++-- | Serialize+toByteString :: Poly -> BS.ByteString+toByteString (Poly v) = results+ where+ results = foldr go BS.empty inputVectors+ inputVectors = chunk 4 v++ go a = BS.append newItems+ where+ newItems = BS.pack $ fmap fromIntegral [i0, i1, i2, i3, i4, i5, i6]++ t0 = coeffFreeze $ a VU.! 0+ t1 = coeffFreeze $ a VU.! 1+ t2 = coeffFreeze $ a VU.! 2+ t3 = coeffFreeze $ a VU.! 3++ i0 = t0 .&. 0xff+ i1 = shiftR t0 8 .|. shiftL t1 6+ i2 = shiftR t1 2+ i3 = shiftR t1 10 .|. shiftL t2 4+ i4 = shiftR t2 4+ i5 = shiftR t2 12 .|. shiftL t3 2+ i6 = shiftR t3 6+++-- | Compression + serialization+compress :: Poly -> BS.ByteString+compress (Poly pData) = result+ where+ ts = VU.map t pData+ input = chunk 8 ts++ t :: Word16 -> Word32+ t n = fromIntegral $ div (shiftL n' 3 + (q `div` 2)) q .&. 0x07+ where+ n' = fromIntegral $ coeffFreeze n+ q = Internals.q++ result = BS.pack $ join $ fmap process input+ where+ process :: VU.Vector Word32 -> [Word8]+ process i = [ fromIntegral $ i0 .|. shiftL i1 3 .|. shiftL i2 6+ , fromIntegral $ shiftR i2 2 .|. shiftL i3 1 .|. shiftL i4 4 .|. shiftL i5 7+ , fromIntegral $ shiftR i5 1 .|. shiftL i6 2 .|. shiftL i7 5+ ]+ where+ i0 = i VU.! 0+ i1 = i VU.! 1+ i2 = i VU.! 2+ i3 = i VU.! 3+ i4 = i VU.! 4+ i5 = i VU.! 5+ i6 = i VU.! 6+ i7 = i VU.! 7+++-- | De-serialization and subsequent decompression of a polynomial;+-- approximate inverse of compress+decompress :: BS.ByteString -> Poly+decompress input = Poly $ VU.fromList result+ where+ inputChunks = chunk 3 $ VU.fromList (fromIntegral <$> BS.unpack input)+ process :: VU.Vector Word16 -> [Word16]+ process a = [ a0 .&. 7+ , shiftR a0 3 .&. 7+ , shiftR a0 6 .|. (shiftL a1 2 .&. 4)+ , shiftR a1 1 .&. 7+ , shiftR a1 4 .&. 7+ , shiftR a1 7 .|. (shiftL a2 1 .&. 6)+ , shiftR a2 2 .&. 7+ , shiftR a2 5+ ]+ where+ a0 = a VU.! 0+ a1 = a VU.! 1+ a2 = a VU.! 2++ finalize :: Word16 -> Word16+ finalize x = fromIntegral $ shiftR ((fromIntegral x :: Word32) * fromIntegral Internals.q + 4) 3+ result = fmap finalize $ join $ fmap process inputChunks+++-- | Restore/convert from (32-byte) message+fromMsg :: N -> BS.ByteString -> Poly+fromMsg n msg = Poly vector'+ where+ msg' = VU.fromList $ BS.unpack msg+ empty = VU.replicate 256 0+ vector'+ | n == N512 = vector VU.++ vector+ | n == N1024 = vector VU.++ vector VU.++ vector VU.++ vector+ | otherwise = error "Invalid N"+ vector = foldr go empty [0..31]+ where+ go i b = foldr go' b [0..7]+ where+ go' j = VU.modify (\v -> VUM.write v base value)+ where+ base = 8 * i + j+ mask = - ((fromIntegral (msg' VU.! i) `shiftR` j) .&. 1)+ value = mask .&. (fromIntegral Internals.q `div` 2)+++-- | Convert polynomial to (32-byte) message+toMsg :: Poly -> BS.ByteString+toMsg p@(Poly x) = BS.pack result+ where+ result = foldr (.|.) 0 <$> chunked+ chunked = chunk 8 ts++ ts = t <$> [0..255]+ where+ n = getN p++ offsets+ | n == N512 = [0, 256]+ | n == N1024 = [0, 256, 512, 768]+ | otherwise = error "Invalid vector size"++ tExtra :: Num a => a+ tExtra = fromIntegral $ if n == N1024+ then Internals.q+ else Internals.q `div` 2++ t :: Int -> Word8+ t i = fromIntegral shifted+ where+ offsets' = (+i) <$> offsets+ values = (x VU.!) <$> offsets'+ values' = flipabs <$> values+ summed = sum values' - tExtra+ shifted = shiftL (shiftR summed 15) (i .&. 7)+++-- | Sample a polynomial deterministically from a seed, with output+-- polynomial looking uniformly random+uniform :: N -> Internals.Seed -> Poly+uniform n seed = Poly vector+ where+ Internals.Seed seed' = seed+ size = Internals.value n+ vector = let empty = VU.replicate size (0 :: Word16)+ go :: Int -> VU.Vector Word16 -> VU.Vector Word16+ go i victor = victor'+ where+ (_, victor') = let (buf, _) = let extseed = BS.snoc seed' (fromIntegral i)+ staite = shake128Absorb extseed+ in shake128SqueezeBlocks staite 1+ bufBS = VU.fromList $ BS.unpack buf+ in go' bufBS 0 0 victor++ go' :: VU.Vector Word8 -> Int -> Int -> VU.Vector Word16 -> (Int, VU.Vector Word16)+ go' buf ctr j vactor = if j' < shake128Rate && ctr' < 64+ then go' buf ctr' j' vactor'+ else (ctr', vactor')+ where+ val = let b0 = fromIntegral $ buf VU.! j+ b1 = fromIntegral $ buf VU.! (j + 1)+ in b0 .|. shiftL b1 8 :: Word16+ moveCounter = val < 5 * fromIntegral Internals.q+ vactor' = if moveCounter+ then VU.modify (\v -> VUM.write v (i * 64 + ctr) val) vactor+ else vactor+ ctr' = if moveCounter+ then ctr + 1+ else ctr+ j' = j + 2+ in foldr go empty [0..size `div` 64 - 1]+++-- | The Hamming weight of a byte (the number of 1s)+hw :: Word8 -> Word8+hw a = sum [shiftR a i .&. 1 | i <- [0..7]]+++-- | Sample a polynomial deterministically from a seed and a nonce,+-- with output polynomial close to centered binomial distribution with+-- parameter k=8+sample :: N -> Internals.Seed -> Word8 -> Poly+sample n seed nonce = Poly $ foldr go empty [0..size `div` 64 - 1]+ where+ size = Internals.value n+ empty = VU.replicate size 0+ seed' = let Internals.Seed seedData = seed+ in BS.snoc seedData nonce++ go i vector = foldr go' vector [0..63]+ where+ extseed = BS.snoc seed' $ fromIntegral i+ buf = shake256 extseed 128++ go' j victor = victor'+ where+ a = fromIntegral.hw $ BS.index buf (2 * j)+ b = fromIntegral.hw $ BS.index buf (2 * j + 1)++ index = 64 * i + j+ value = a + fromIntegral Internals.q - b+ victor' = VU.modify (\v -> VUM.write v index value) victor+++-- | Multiply two polynomials pointwise (i.e., coefficient-wise).+mulPointwise :: Poly -> Poly -> Poly+mulPointwise (Poly a) (Poly b) = Poly $ VU.zipWith go a b+-- NOTE: we don't check that these are the same length, which is fine given existing code.+-- NOTE: this is not commutative.+ where+ go c d = value+ where+ t = montgomeryReduce (3186 * fromIntegral d) -- t is now in Montgomery domain+ value = montgomeryReduce (fromIntegral c * fromIntegral t) -- back in normal domain+++-- | Add two polynomials+add :: Poly -> Poly -> Poly+add (Poly a) (Poly b) = Poly $ VU.zipWith go a b+-- NOTE: we don't check that these are the same length, which is fine given existing code.+-- NOTE: this is not commutative. should it be?+ where+ go c d = (c + d) `mod` fromIntegral Internals.q+++-- | Subtract two polynomials+sub :: Poly -> Poly -> Poly+sub (Poly a) (Poly b) = Poly $ VU.zipWith go a b+ where+ q = fromIntegral Internals.q+ go c d = (c + (3 * q) - d) `mod` q+++-- | Forward NTT transform of a polynomial+-- input is assumed to have coefficients in bitreversed order output+-- has coefficients in normal order+ntt :: Poly -- ^ input polynomial, in bitreversed order+ -> Poly -- ^ transformed polynomial, in normal order+ntt p@(Poly r) = Poly result+ where+ n = getN p+ multiplied = NTT.mulCoefficients r $ ψBitrevMontgomery n+ result = NTT.ntt multiplied $ ωBitrevMontgomery n+++-- | Inverse NTT transform of a polynomial+--+-- Output has coefficients in normal order+invntt :: Poly -- ^ input, with coefficients in normal order+ -> Poly -- ^ output, with coefficients in normal order+invntt p@(Poly r) = Poly result+ where+ n = getN p+ r' = NTT.bitrev r+ r'' = NTT.ntt r' $ ωInvBitrevMontgomery n+ result = NTT.mulCoefficients r'' $ ψInvMontgomery n
+ src/Crypto/NewHope/Precomp.hs view
@@ -0,0 +1,365 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.Precomp+ Description : Precompiled vectors for use by various polynomial-manipulating functions.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Crypto.NewHope.Precomp where++import qualified Data.Vector.Unboxed as VU+import Data.Word++import Crypto.NewHope.Internals (N (N1024, N512))++-- | powers of nth root of unity in Montgomery+-- domain with R=2^18 in bit-reversed order+ωBitrevMontgomery :: N -> VU.Vector Word16+ωBitrevMontgomery n = case n of+ N512 -> ωBitrevMontgomery512+ N1024 -> ωBitrevMontgomery1024+++-- | ω table for N512+ωBitrevMontgomery512 :: VU.Vector Word16+ωBitrevMontgomery512 = VU.fromList [ 4075,5315,7965,7373,522,10120,9027,5079,2344,1278,1973,5574,1018,6364,11248,8775,+ 7500,7822,5537,4749,8500,12142,5456,7840,5445,3860,4536,11239,6171,8471,2683,11099,+ 10561,400,6137,7341,5415,8646,6136,5862,5529,5206,56,9090,8724,11635,1702,10302,+ 5339,6843,6093,3710,316,382,11821,8301,10930,5435,11035,973,8291,10256,8410,1922,+ 12097,10968,10240,4912,4698,5057,7509,8844,8807,11502,5468,1010,9162,8120,2920,5241,+ 6055,8953,677,5874,2766,10966,12237,9115,12138,10162,3957,2839,6383,2505,11858,1579,+ 9026,3600,6077,4624,11868,4080,6068,3602,605,9987,504,8076,4782,6403,3029,6695,+ 11184,142,5681,8812,2844,3438,8077,975,58,12048,1003,8757,885,6281,1956,5009,+ 12225,3656,11606,9830,1566,5782,2503,2948,7032,3834,5919,4433,3054,6803,9166,1747,+ 10211,11177,4322,1958,922,11848,4079,11231,4046,11580,1319,9139,6224,835,8049,8719,+ 7105,1200,6122,9734,3956,1360,6119,5297,4298,3329,168,2692,1594,10327,5106,6328,+ 3728,8240,5990,11130,948,1146,10885,325,8212,4016,8527,2919,295,6190,652,5766,+ 11713,8326,6142,2447,1805,2882,10238,1954,1843,9928,4115,3030,2908,12071,8760,3434,+ 5876,2281,2031,5333,8298,8320,12133,2767,11836,5908,11871,8517,6860,7515,10996,4737,+ 2500,10800,5942,1583,11026,12240,5915,10806,1815,5383,1512,11939,2057,6920,9087,7796,+ 8974,426,4754,1858,8532,10314,11942,2925,174,11566,3009,1693,2655,6554,5868,2738]++-- | ω table for N1024+ωBitrevMontgomery1024 :: VU.Vector Word16+ωBitrevMontgomery1024 = VU.fromList [ 4075,6974,7373,7965,3262,5079,522,2169,6364,1018,1041,8775,2344,11011,5574,1973,+ 4536,1050,6844,3860,3818,6118,2683,1190,4789,7822,7540,6752,5456,4449,3789,12142,+ 11973,382,3988,468,6843,5339,6196,3710,11316,1254,5435,10930,3998,10256,10367,3879,+ 11889,1728,6137,4948,5862,6136,3643,6874,8724,654,10302,1702,7083,6760,56,3199,+ 9987,605,11785,8076,5594,9260,6403,4782,6212,4624,9026,8689,4080,11868,6221,3602,+ 975,8077,8851,9445,5681,3477,1105,142,241,12231,1003,3532,5009,1956,6008,11404,+ 7377,2049,10968,12097,7591,5057,3445,4780,2920,7048,3127,8120,11279,6821,11502,8807,+ 12138,2127,2839,3957,431,1579,6383,9784,5874,677,3336,6234,2766,1323,9115,12237,+ 2031,6956,6413,2281,3969,3991,12133,9522,4737,10996,4774,5429,11871,3772,453,5908,+ 2882,1805,2051,1954,11713,3963,2447,6142,8174,3030,1843,2361,12071,2908,3529,3434,+ 3202,7796,2057,5369,11939,1512,6906,10474,11026,49,10806,5915,1489,9789,5942,10706,+ 10431,7535,426,8974,3757,10314,9364,347,5868,9551,9634,6554,10596,9280,11566,174,+ 2948,2503,6507,10723,11606,2459,64,3656,8455,5257,5919,7856,1747,9166,5486,9235,+ 6065,835,3570,4240,11580,4046,10970,9139,1058,8210,11848,922,7967,1958,10211,1112,+ 3728,4049,11130,5990,1404,325,948,11143,6190,295,11637,5766,8212,8273,2919,8527,+ 6119,6992,8333,1360,2555,6167,1200,7105,7991,3329,9597,12121,5106,5961,10695,10327,+ 3051,9923,4896,9326,81,3091,1000,7969,4611,726,1853,12149,4255,11112,2768,10654,+ 1062,2294,3553,4805,2747,4846,8577,9154,1170,2319,790,11334,9275,9088,1326,5086,+ 9094,6429,11077,10643,3504,3542,8668,9744,1479,1,8246,7143,11567,10984,4134,5736,+ 4978,10938,5777,8961,4591,5728,6461,5023,9650,7468,949,9664,2975,11726,2744,9283,+ 10092,5067,12171,2476,3748,11336,6522,827,9452,5374,12159,7935,3296,3949,9893,4452,+ 10908,2525,3584,8112,8011,10616,4989,6958,11809,9447,12280,1022,11950,9821,11745,5791,+ 5092,2089,9005,2881,3289,2013,9048,729,7901,1260,5755,4632,11955,2426,10593,1428,+ 4890,5911,3932,9558,8830,3637,5542,145,5179,8595,3707,10530,355,3382,4231,9741,+ 1207,9041,7012,1168,10146,11224,4645,11885,10911,10377,435,7952,4096,493,9908,6845,+ 6039,2422,2187,9723,8643,9852,9302,6022,7278,1002,4284,5088,1607,7313,875,8509,+ 9430,1045,2481,5012,7428,354,6591,9377,11847,2401,1067,7188,11516,390,8511,8456,+ 7270,545,8585,9611,12047,1537,4143,4714,4885,1017,5084,1632,3066,27,1440,8526,+ 9273,12046,11618,9289,3400,9890,3136,7098,8758,11813,7384,3985,11869,6730,10745,10111,+ 2249,4048,2884,11136,2126,1630,9103,5407,2686,9042,2969,8311,9424,9919,8779,5332,+ 10626,1777,4654,10863,7351,3636,9585,5291,8374,2166,4919,12176,9140,12129,7852,12286,+ 4895,10805,2780,5195,2305,7247,9644,4053,10600,3364,3271,4057,4414,9442,7917,2174]+++-- | inverses of powers of nth root of unity in Montgomery domain with+-- R=2^18 in bit-reversed order+ωInvBitrevMontgomery :: N -> VU.Vector Word16+ωInvBitrevMontgomery n = case n of+ N512 -> ωInvBitrevMontgomery512+ N1024 -> ωInvBitrevMontgomery1024+++-- | inverse ω table for N512+ωInvBitrevMontgomery512 :: VU.Vector Word16+ωInvBitrevMontgomery512 = VU.fromList [ 4075,6974,4916,4324,7210,3262,2169,11767,3514,1041,5925,11271,6715,10316,11011,9945,+ 1190,9606,3818,6118,1050,7753,8429,6844,4449,6833,147,3789,7540,6752,4467,4789,+ 10367,3879,2033,3998,11316,1254,6854,1359,3988,468,11907,11973,8579,6196,5446,6950,+ 1987,10587,654,3565,3199,12233,7083,6760,6427,6153,3643,6874,4948,6152,11889,1728,+ 7280,10333,6008,11404,3532,11286,241,12231,11314,4212,8851,9445,3477,6608,12147,1105,+ 5594,9260,5886,7507,4213,11785,2302,11684,8687,6221,8209,421,7665,6212,8689,3263,+ 10710,431,9784,5906,9450,8332,2127,151,3174,52,1323,9523,6415,11612,3336,6234,+ 7048,9369,4169,3127,11279,6821,787,3482,3445,4780,7232,7591,7377,2049,1321,192,+ 9551,6421,5735,9634,10596,9280,723,12115,9364,347,1975,3757,10431,7535,11863,3315,+ 4493,3202,5369,10232,350,10777,6906,10474,1483,6374,49,1263,10706,6347,1489,9789,+ 7552,1293,4774,5429,3772,418,6381,453,9522,156,3969,3991,6956,10258,10008,6413,+ 8855,3529,218,9381,9259,8174,2361,10446,10335,2051,9407,10484,9842,6147,3963,576,+ 6523,11637,6099,11994,9370,3762,8273,4077,11964,1404,11143,11341,1159,6299,4049,8561,+ 5961,7183,1962,10695,9597,12121,8960,7991,6992,6170,10929,8333,2555,6167,11089,5184,+ 3570,4240,11454,6065,3150,10970,709,8243,1058,8210,441,11367,10331,7967,1112,2078,+ 10542,3123,5486,9235,7856,6370,8455,5257,9341,9786,6507,10723,2459,683,8633,64]++-- | inverse ω table for N1024+ωInvBitrevMontgomery1024 :: VU.Vector Word16+ωInvBitrevMontgomery1024 = VU.fromList [ 4075,5315,4324,4916,10120,11767,7210,9027,10316,6715,1278,9945,3514,11248,11271,5925,+ 147,8500,7840,6833,5537,4749,4467,7500,11099,9606,6171,8471,8429,5445,11239,7753,+ 9090,12233,5529,5206,10587,1987,11635,3565,5415,8646,6153,6427,7341,6152,10561,400,+ 8410,1922,2033,8291,1359,6854,11035,973,8579,6093,6950,5446,11821,8301,11907,316,+ 52,3174,10966,9523,6055,8953,11612,6415,2505,5906,10710,11858,8332,9450,10162,151,+ 3482,787,5468,1010,4169,9162,5241,9369,7509,8844,7232,4698,192,1321,10240,4912,+ 885,6281,10333,7280,8757,11286,58,12048,12147,11184,8812,6608,2844,3438,4212,11314,+ 8687,6068,421,8209,3600,3263,7665,6077,7507,5886,3029,6695,4213,504,11684,2302,+ 1962,1594,6328,7183,168,2692,8960,4298,5184,11089,6122,9734,10929,3956,5297,6170,+ 3762,9370,4016,4077,6523,652,11994,6099,1146,11341,11964,10885,6299,1159,8240,8561,+ 11177,2078,10331,4322,11367,441,4079,11231,3150,1319,8243,709,8049,8719,11454,6224,+ 3054,6803,3123,10542,4433,6370,7032,3834,8633,12225,9830,683,1566,5782,9786,9341,+ 12115,723,3009,1693,5735,2655,2738,6421,11942,2925,1975,8532,3315,11863,4754,1858,+ 1583,6347,2500,10800,6374,1483,12240,1263,1815,5383,10777,350,6920,10232,4493,9087,+ 8855,8760,9381,218,9928,10446,9259,4115,6147,9842,8326,576,10335,10238,10484,9407,+ 6381,11836,8517,418,6860,7515,1293,7552,2767,156,8298,8320,10008,5876,5333,10258,+ 10115,4372,2847,7875,8232,9018,8925,1689,8236,2645,5042,9984,7094,9509,1484,7394,+ 3,4437,160,3149,113,7370,10123,3915,6998,2704,8653,4938,1426,7635,10512,1663,+ 6957,3510,2370,2865,3978,9320,3247,9603,6882,3186,10659,10163,1153,9405,8241,10040,+ 2178,1544,5559,420,8304,4905,476,3531,5191,9153,2399,8889,3000,671,243,3016,+ 3763,10849,12262,9223,10657,7205,11272,7404,7575,8146,10752,242,2678,3704,11744,5019,+ 3833,3778,11899,773,5101,11222,9888,442,2912,5698,11935,4861,7277,9808,11244,2859,+ 3780,11414,4976,10682,7201,8005,11287,5011,6267,2987,2437,3646,2566,10102,9867,6250,+ 5444,2381,11796,8193,4337,11854,1912,1378,404,7644,1065,2143,11121,5277,3248,11082,+ 2548,8058,8907,11934,1759,8582,3694,7110,12144,6747,8652,3459,2731,8357,6378,7399,+ 10861,1696,9863,334,7657,6534,11029,4388,11560,3241,10276,9000,9408,3284,10200,7197,+ 6498,544,2468,339,11267,9,2842,480,5331,7300,1673,4278,4177,8705,9764,1381,+ 7837,2396,8340,8993,4354,130,6915,2837,11462,5767,953,8541,9813,118,7222,2197,+ 3006,9545,563,9314,2625,11340,4821,2639,7266,5828,6561,7698,3328,6512,1351,7311,+ 6553,8155,1305,722,5146,4043,12288,10810,2545,3621,8747,8785,1646,1212,5860,3195,+ 7203,10963,3201,3014,955,11499,9970,11119,3135,3712,7443,9542,7484,8736,9995,11227,+ 1635,9521,1177,8034,140,10436,11563,7678,4320,11289,9198,12208,2963,7393,2366,9238]+++-- | powers of nth root of -1 in Montgomery+-- domain with R=2^18 in bit-reversed order+ψBitrevMontgomery :: N -> VU.Vector Word16+ψBitrevMontgomery n = case n of+ N512 -> ψBitrevMontgomery512+ N1024 -> ψBitrevMontgomery1024+++-- | ψ table for N512+ψBitrevMontgomery512 :: VU.Vector Word16+ψBitrevMontgomery512 = VU.fromList [ 4075,5315,7965,7373,522,10120,9027,5079,2344,1278,1973,5574,1018,6364,11248,8775,+ 7500,7822,5537,4749,8500,12142,5456,7840,5445,3860,4536,11239,6171,8471,2683,11099,+ 10561,400,6137,7341,5415,8646,6136,5862,5529,5206,56,9090,8724,11635,1702,10302,+ 5339,6843,6093,3710,316,382,11821,8301,10930,5435,11035,973,8291,10256,8410,1922,+ 12097,10968,10240,4912,4698,5057,7509,8844,8807,11502,5468,1010,9162,8120,2920,5241,+ 6055,8953,677,5874,2766,10966,12237,9115,12138,10162,3957,2839,6383,2505,11858,1579,+ 9026,3600,6077,4624,11868,4080,6068,3602,605,9987,504,8076,4782,6403,3029,6695,+ 11184,142,5681,8812,2844,3438,8077,975,58,12048,1003,8757,885,6281,1956,5009,+ 12225,3656,11606,9830,1566,5782,2503,2948,7032,3834,5919,4433,3054,6803,9166,1747,+ 10211,11177,4322,1958,922,11848,4079,11231,4046,11580,1319,9139,6224,835,8049,8719,+ 7105,1200,6122,9734,3956,1360,6119,5297,4298,3329,168,2692,1594,10327,5106,6328,+ 3728,8240,5990,11130,948,1146,10885,325,8212,4016,8527,2919,295,6190,652,5766,+ 11713,8326,6142,2447,1805,2882,10238,1954,1843,9928,4115,3030,2908,12071,8760,3434,+ 5876,2281,2031,5333,8298,8320,12133,2767,11836,5908,11871,8517,6860,7515,10996,4737,+ 2500,10800,5942,1583,11026,12240,5915,10806,1815,5383,1512,11939,2057,6920,9087,7796,+ 8974,426,4754,1858,8532,10314,11942,2925,174,11566,3009,1693,2655,6554,5868,2738,+ 11796,8193,9908,5444,10911,1912,7952,435,404,7644,11224,10146,7012,11121,11082,9041,+ 9723,2187,9867,6250,3646,9852,6267,2987,8509,875,4976,10682,8005,5088,7278,11287,+ 9223,27,3763,10849,11272,7404,5084,10657,8146,4714,12047,10752,2678,3704,545,7270,+ 1067,5101,442,2401,390,11516,3778,8456,1045,9430,9808,5012,9377,6591,11935,4861,+ 7852,3,3149,12129,12176,4919,10123,3915,3636,7351,2704,5291,1663,1777,1426,7635,+ 1484,7394,2780,7094,8236,2645,7247,2305,2847,7875,7917,10115,10600,8925,4057,3271,+ 9273,243,9289,11618,3136,5191,8889,9890,11869,5559,10111,10745,11813,8758,4905,3985,+ 9603,9042,3978,9320,3510,5332,9424,2370,9405,11136,2249,8241,10659,10163,9103,6882,+ 10810,1,5146,4043,8155,5736,11567,1305,1212,10643,9094,5860,8747,8785,8668,2545,+ 4591,6561,5023,6461,10938,4978,6512,8961,949,2625,2639,7468,11726,2975,9545,9283,+ 3091,81,11289,7969,9238,9923,2963,7393,12149,1853,11563,7678,8034,11112,1635,9521,+ 3201,3014,1326,7203,1170,9970,11334,790,3135,3712,4846,2747,3553,7484,11227,2294,+ 11267,9,9447,11809,11950,2468,5791,11745,10908,9764,8112,3584,4989,5331,4278,10616,+ 4452,9893,8340,8993,130,7935,9452,6915,8541,11336,11462,5767,7222,2197,12171,9813,+ 3241,729,3289,10276,9408,3284,2089,5092,11029,4388,5755,7657,10861,1696,2426,11955,+ 4231,2548,11934,3382,10530,3707,3694,7110,3637,8830,6747,145,7399,5911,2731,8357]++-- | ψ table for N1024+ψBitrevMontgomery1024 :: VU.Vector Word16+ψBitrevMontgomery1024 = VU.fromList [ 4075,6974,7373,7965,3262,5079,522,2169,6364,1018,1041,8775,2344,11011,5574,1973,+ 4536,1050,6844,3860,3818,6118,2683,1190,4789,7822,7540,6752,5456,4449,3789,12142,+ 11973,382,3988,468,6843,5339,6196,3710,11316,1254,5435,10930,3998,10256,10367,3879,+ 11889,1728,6137,4948,5862,6136,3643,6874,8724,654,10302,1702,7083,6760,56,3199,+ 9987,605,11785,8076,5594,9260,6403,4782,6212,4624,9026,8689,4080,11868,6221,3602,+ 975,8077,8851,9445,5681,3477,1105,142,241,12231,1003,3532,5009,1956,6008,11404,+ 7377,2049,10968,12097,7591,5057,3445,4780,2920,7048,3127,8120,11279,6821,11502,8807,+ 12138,2127,2839,3957,431,1579,6383,9784,5874,677,3336,6234,2766,1323,9115,12237,+ 2031,6956,6413,2281,3969,3991,12133,9522,4737,10996,4774,5429,11871,3772,453,5908,+ 2882,1805,2051,1954,11713,3963,2447,6142,8174,3030,1843,2361,12071,2908,3529,3434,+ 3202,7796,2057,5369,11939,1512,6906,10474,11026,49,10806,5915,1489,9789,5942,10706,+ 10431,7535,426,8974,3757,10314,9364,347,5868,9551,9634,6554,10596,9280,11566,174,+ 2948,2503,6507,10723,11606,2459,64,3656,8455,5257,5919,7856,1747,9166,5486,9235,+ 6065,835,3570,4240,11580,4046,10970,9139,1058,8210,11848,922,7967,1958,10211,1112,+ 3728,4049,11130,5990,1404,325,948,11143,6190,295,11637,5766,8212,8273,2919,8527,+ 6119,6992,8333,1360,2555,6167,1200,7105,7991,3329,9597,12121,5106,5961,10695,10327,+ 3051,9923,4896,9326,81,3091,1000,7969,4611,726,1853,12149,4255,11112,2768,10654,+ 1062,2294,3553,4805,2747,4846,8577,9154,1170,2319,790,11334,9275,9088,1326,5086,+ 9094,6429,11077,10643,3504,3542,8668,9744,1479,1,8246,7143,11567,10984,4134,5736,+ 4978,10938,5777,8961,4591,5728,6461,5023,9650,7468,949,9664,2975,11726,2744,9283,+ 10092,5067,12171,2476,3748,11336,6522,827,9452,5374,12159,7935,3296,3949,9893,4452,+ 10908,2525,3584,8112,8011,10616,4989,6958,11809,9447,12280,1022,11950,9821,11745,5791,+ 5092,2089,9005,2881,3289,2013,9048,729,7901,1260,5755,4632,11955,2426,10593,1428,+ 4890,5911,3932,9558,8830,3637,5542,145,5179,8595,3707,10530,355,3382,4231,9741,+ 1207,9041,7012,1168,10146,11224,4645,11885,10911,10377,435,7952,4096,493,9908,6845,+ 6039,2422,2187,9723,8643,9852,9302,6022,7278,1002,4284,5088,1607,7313,875,8509,+ 9430,1045,2481,5012,7428,354,6591,9377,11847,2401,1067,7188,11516,390,8511,8456,+ 7270,545,8585,9611,12047,1537,4143,4714,4885,1017,5084,1632,3066,27,1440,8526,+ 9273,12046,11618,9289,3400,9890,3136,7098,8758,11813,7384,3985,11869,6730,10745,10111,+ 2249,4048,2884,11136,2126,1630,9103,5407,2686,9042,2969,8311,9424,9919,8779,5332,+ 10626,1777,4654,10863,7351,3636,9585,5291,8374,2166,4919,12176,9140,12129,7852,12286,+ 4895,10805,2780,5195,2305,7247,9644,4053,10600,3364,3271,4057,4414,9442,7917,2174,+ 3947,11951,2455,6599,10545,10975,3654,2894,7681,7126,7287,12269,4119,3343,2151,1522,+ 7174,7350,11041,2442,2148,5959,6492,8330,8945,5598,3624,10397,1325,6565,1945,11260,+ 10077,2674,3338,3276,11034,506,6505,1392,5478,8778,1178,2776,3408,10347,11124,2575,+ 9489,12096,6092,10058,4167,6085,923,11251,11912,4578,10669,11914,425,10453,392,10104,+ 8464,4235,8761,7376,2291,3375,7954,8896,6617,7790,1737,11667,3982,9342,6680,636,+ 6825,7383,512,4670,2900,12050,7735,994,1687,11883,7021,146,10485,1403,5189,6094,+ 2483,2054,3042,10945,3981,10821,11826,8882,8151,180,9600,7684,5219,10880,6780,204,+ 11232,2600,7584,3121,3017,11053,7814,7043,4251,4739,11063,6771,7073,9261,2360,11925,+ 1928,11825,8024,3678,3205,3359,11197,5209,8581,3238,8840,1136,9363,1826,3171,4489,+ 7885,346,2068,1389,8257,3163,4840,6127,8062,8921,612,4238,10763,8067,125,11749,+ 10125,5416,2110,716,9839,10584,11475,11873,3448,343,1908,4538,10423,7078,4727,1208,+ 11572,3589,2982,1373,1721,10753,4103,2429,4209,5412,5993,9011,438,3515,7228,1218,+ 8347,5232,8682,1327,7508,4924,448,1014,10029,12221,4566,5836,12229,2717,1535,3200,+ 5588,5845,412,5102,7326,3744,3056,2528,7406,8314,9202,6454,6613,1417,10032,7784,+ 1518,3765,4176,5063,9828,2275,6636,4267,6463,2065,7725,3495,8328,8755,8144,10533,+ 5966,12077,9175,9520,5596,6302,8400,579,6781,11014,5734,11113,11164,4860,1131,10844,+ 9068,8016,9694,3837,567,9348,7000,6627,7699,5082,682,11309,5207,4050,7087,844,+ 7434,3769,293,9057,6940,9344,10883,2633,8190,3944,5530,5604,3480,2171,9282,11024,+ 2213,8136,3805,767,12239,216,11520,6763,10353,7,8566,845,7235,3154,4360,3285,+ 10268,2832,3572,1282,7559,3229,8360,10583,6105,3120,6643,6203,8536,8348,6919,3536,+ 9199,10891,11463,5043,1658,5618,8787,5789,4719,751,11379,6389,10783,3065,7806,6586,+ 2622,5386,510,7628,6921,578,10345,11839,8929,4684,12226,7154,9916,7302,8481,3670,+ 11066,2334,1590,7878,10734,1802,1891,5103,6151,8820,3418,7846,9951,4693,417,9996,+ 9652,4510,2946,5461,365,881,1927,1015,11675,11009,1371,12265,2485,11385,5039,6742,+ 8449,1842,12217,8176,9577,4834,7937,9461,2643,11194,3045,6508,4094,3451,7911,11048,+ 5406,4665,3020,6616,11345,7519,3669,5287,1790,7014,5410,11038,11249,2035,6125,10407,+ 4565,7315,5078,10506,2840,2478,9270,4194,9195,4518,7469,1160,6878,2730,10421,10036,+ 1734,3815,10939,5832,10595,10759,4423,8420,9617,7119,11010,11424,9173,189,10080,10526,+ 3466,10588,7592,3578,11511,7785,9663,530,12150,8957,2532,3317,9349,10243,1481,9332,+ 3454,3758,7899,4218,2593,11410,2276,982,6513,1849,8494,9021,4523,7988,8,457,+ 648,150,8000,2307,2301,874,5650,170,9462,2873,9855,11498,2535,11169,5808,12268,+ 9687,1901,7171,11787,3846,1573,6063,3793,466,11259,10608,3821,6320,4649,6263,2929]+++-- | inverses of powers of nth root of -1+-- divided by n in Montgomery domain with R=2^18+ψInvMontgomery :: N -> VU.Vector Word16+ψInvMontgomery n = case n of+ N512 -> ψInvMontgomery512+ N1024 -> ψInvMontgomery1024+++-- | inverse ψ table for N512+ψInvMontgomery512 :: VU.Vector Word16+ψInvMontgomery512 = VU.fromList [ 512,3944,4267,5411,9615,5900,3205,6063,9261,2021,3087,4770,1029,1590,343,530,+ 8307,4273,2769,9617,923,7302,4404,2434,1468,9004,8682,11194,2894,11924,5061,8071,+ 1687,10883,8755,7724,11111,6671,7800,6320,2600,6203,4963,6164,9847,6151,11475,10243,+ 3825,11607,1275,3869,425,5386,4238,9988,5509,11522,10029,7937,3343,6742,9307,10440,+ 11295,3480,3765,1160,1255,4483,8611,9687,11063,3229,7784,9269,6691,7186,10423,10588,+ 11667,11722,3889,12100,9489,12226,3163,12268,9247,12282,11275,4094,11951,5461,8080,10013,+ 10886,7434,7725,2478,2575,826,9051,8468,3017,6919,5102,10499,5797,7596,10125,2532,+ 3375,844,1125,8474,375,6921,125,2307,4138,769,9572,8449,7287,11009,2429,7766,+ 4906,6685,9828,10421,3276,7570,1092,10716,364,3572,8314,5287,10964,9955,7751,11511,+ 6680,3837,6323,1279,6204,8619,2068,2873,8882,5054,7057,5781,10545,1927,3515,8835,+ 5268,2945,1756,5078,8778,5789,2926,6026,9168,6105,3056,2035,5115,8871,1705,2957,+ 8761,5082,11113,1694,11897,4661,8062,5650,10880,10076,7723,7455,10767,2485,3589,9021,+ 9389,3007,7226,9195,6505,3065,10361,5118,7550,1706,6613,4665,10397,1555,7562,8711,+ 6617,7000,6302,10526,6197,7605,6162,2535,2054,845,4781,4378,5690,9652,5993,11410,+ 6094,11996,10224,8095,3408,10891,1136,11823,4475,3941,5588,5410,5959,9996,10179,3332,+ 3393,5207,1131,5832,377,1944,4222,648,9600,216,3200,72,5163,24,1721,8,+ 4670,4099,5653,9559,10077,11379,3359,3793,5216,9457,5835,11345,1945,7878,8841,2626,+ 2947,9068,9175,7119,11251,2373,11943,791,3981,4360,1327,9646,8635,11408,11071,7899,+ 11883,2633,3961,4974,9513,1658,3171,4649,1057,5646,8545,1882,11041,8820,11873,2940,+ 8054,980,6781,4423,10453,9667,11677,11415,12085,3805,12221,9461,8170,7250,10916,6513,+ 7735,2171,10771,4820,11783,5703,8024,1901,6771,4730,2257,5673,8945,1891,7078,8823,+ 10552,2941,11710,9173,12096,7154,4032,6481,1344,10353,448,3451,8342,9343,6877,11307,+ 10485,3769,3495,9449,1165,7246,8581,10608,11053,3536,11877,5275,3959,9951,5416,3317,+ 9998,5202,7429,1734,10669,578,11749,4289,12109,5526,12229,1842,12269,614,8186,4301,+ 6825,5530,2275,10036,8951,11538,7080,3846,2360,1282,4883,8620,5724,11066,1908,7785,+ 636,2595,212,865,4167,8481,1389,2827,463,9135,8347,3045,10975,1015,11851,8531,+ 12143,6940,8144,10506,6811,3502,10463,9360,7584,3120,2528,1040,4939,4443,9839,1481,+ 7376,4590,6555,1530,2185,510,8921,170,7070,4153,6453,9577,2151,11385,717,3795,+ 239,1265,4176,4518,1392,1506,464,502,4251,8360,1417,6883,8665,10487,11081,7592,+ 7790,6627,6693,2209,2231,8929,4840,11169,9806,3723,7365,1241,2455,4510,9011,9696,+ 7100,3232,6463,9270,10347,3090,3449,1030,5246,8536,5845,11038,10141,11872,11573,12150,+ 7954,4050,10844,1350,7711,450,10763,150,7684,50,10754,4113,7681,1371,10753,457]++-- | inverse ψ table for N1024+ψInvMontgomery1024 :: VU.Vector Word16+ψInvMontgomery1024 = VU.fromList [ 256,10570,1510,7238,1034,7170,6291,7921,11665,3422,4000,2327,2088,5565,795,10647,+ 1521,5484,2539,7385,1055,7173,8047,11683,1669,1994,3796,5809,4341,9398,11876,12230,+ 10525,12037,12253,3506,4012,9351,4847,2448,7372,9831,3160,2207,5582,2553,7387,6322,+ 9681,1383,10731,1533,219,5298,4268,7632,6357,9686,8406,4712,9451,10128,4958,5975,+ 11387,8649,11769,6948,11526,12180,1740,10782,6807,2728,7412,4570,4164,4106,11120,12122,+ 8754,11784,3439,5758,11356,6889,9762,11928,1704,1999,10819,12079,12259,7018,11536,1648,+ 1991,2040,2047,2048,10826,12080,8748,8272,8204,1172,1923,7297,2798,7422,6327,4415,+ 7653,6360,11442,12168,7005,8023,9924,8440,8228,2931,7441,1063,3663,5790,9605,10150,+ 1450,8985,11817,10466,10273,12001,3470,7518,1074,1909,7295,9820,4914,702,5367,7789,+ 8135,9940,1420,3714,11064,12114,12264,1752,5517,9566,11900,1700,3754,5803,829,1874,+ 7290,2797,10933,5073,7747,8129,6428,6185,11417,1631,233,5300,9535,10140,11982,8734,+ 8270,2937,10953,8587,8249,2934,9197,4825,5956,4362,9401,1343,3703,529,10609,12049,+ 6988,6265,895,3639,4031,4087,4095,585,10617,8539,4731,4187,9376,3095,9220,10095,+ 10220,1460,10742,12068,1724,5513,11321,6884,2739,5658,6075,4379,11159,10372,8504,4726,+ 9453,3106,7466,11600,10435,8513,9994,8450,9985,3182,10988,8592,2983,9204,4826,2445,+ 5616,6069,867,3635,5786,11360,5134,2489,10889,12089,1727,7269,2794,9177,1311,5454,+ 9557,6632,2703,9164,10087,1441,3717,531,3587,2268,324,5313,759,1864,5533,2546,+ 7386,9833,8427,4715,11207,1601,7251,4547,11183,12131,1733,10781,10318,1474,10744,5046,+ 4232,11138,10369,6748,964,7160,4534,7670,8118,8182,4680,11202,6867,981,8918,1274,+ 182,26,7026,8026,11680,12202,10521,1503,7237,4545,5916,9623,8397,11733,10454,3249,+ 9242,6587,941,1890,270,10572,6777,9746,6659,6218,6155,6146,878,1881,7291,11575,+ 12187,1741,7271,8061,11685,6936,4502,9421,4857,4205,7623,1089,10689,1527,8996,10063,+ 11971,10488,6765,2722,3900,9335,11867,6962,11528,5158,4248,4118,5855,2592,5637,6072,+ 2623,7397,8079,9932,4930,5971,853,3633,519,8852,11798,3441,11025,1575,225,8810,+ 11792,12218,3501,9278,3081,9218,4828,7712,8124,11694,12204,3499,4011,573,3593,5780,+ 7848,9899,10192,1456,208,7052,2763,7417,11593,10434,12024,8740,11782,10461,3250,5731,+ 7841,9898,1414,202,3540,7528,2831,2160,10842,5060,4234,4116,588,84,12,7024,+ 2759,9172,6577,11473,1639,9012,3043,7457,6332,11438,1634,1989,9062,11828,8712,11778,+ 12216,10523,6770,9745,10170,4964,9487,6622,946,8913,6540,6201,4397,9406,8366,9973,+ 8447,8229,11709,8695,10020,3187,5722,2573,10901,6824,4486,4152,9371,8361,2950,2177,+ 311,1800,9035,8313,11721,3430,490,70,10,1757,251,3547,7529,11609,3414,7510,+ 4584,4166,9373,1339,5458,7802,11648,1664,7260,9815,10180,6721,9738,10169,8475,8233,+ 9954,1422,8981,1283,5450,11312,1616,3742,11068,10359,4991,713,3613,9294,8350,4704,+ 672,96,7036,9783,11931,3460,5761,823,10651,12055,10500,1500,5481,783,3623,11051,+ 8601,8251,8201,11705,10450,5004,4226,7626,2845,2162,3820,7568,9859,3164,452,10598,+ 1514,5483,6050,6131,4387,7649,8115,6426,918,8909,8295,1185,5436,11310,8638,1234,+ 5443,11311,5127,2488,2111,10835,5059,7745,2862,3920,560,80,1767,2008,3798,11076,+ 6849,2734,10924,12094,8750,1250,10712,6797,971,7161,1023,8924,4786,7706,4612,4170,+ 7618,6355,4419,5898,11376,10403,10264,6733,4473,639,5358,2521,9138,3061,5704,4326,+ 618,5355,765,5376,768,7132,4530,9425,3102,9221,6584,11474,10417,10266,12000,6981,+ 6264,4406,2385,7363,4563,4163,7617,9866,3165,9230,11852,10471,5007,5982,11388,5138,+ 734,3616,11050,12112,6997,11533,12181,10518,12036,3475,2252,7344,9827,4915,9480,6621,+ 4457,7659,9872,6677,4465,4149,7615,4599,657,3605,515,10607,6782,4480,640,1847,+ 3775,5806,2585,5636,9583,1369,10729,8555,10000,11962,5220,7768,8132,8184,9947,1421,+ 203,29,8782,11788,1684,10774,10317,4985,9490,8378,4708,11206,5112,5997,7879,11659,+ 12199,8765,10030,4944,5973,6120,6141,6144,7900,11662,1666,238,34,3516,5769,9602,+ 8394,9977,6692,956,10670,6791,9748,11926,8726,11780,5194,742,106,8793,10034,3189,+ 10989,5081,4237,5872,4350,2377,10873,6820,6241,11425,10410,10265,3222,5727,9596,4882,+ 2453,2106,3812,11078,12116,5242,4260,11142,8614,11764,12214,5256,4262,4120,11122,5100,+ 11262,5120,2487,5622,9581,8391,8221,2930,10952,12098,6995,6266,9673,4893,699,3611,+ 4027,5842,11368,1624,232,8811,8281,1183,169,8802,3013,2186,5579,797,3625,4029,+ 11109,1587,7249,11569,8675,6506,2685,10917,12093,12261,12285,1755,7273,1039,1904,272,+ 3550,9285,3082,5707,6082,4380,7648,11626,5172,4250,9385,8363,8217,4685,5936,848,+ 8899,6538,934,1889,3781,9318,10109,10222,6727,961,5404,772,5377,9546,8386,1198,+ 8949,3034,2189,7335,4559,5918,2601,10905,5069,9502,3113,7467,8089,11689,5181,9518,+ 8382,2953,3933,4073,4093,7607,8109,2914,5683,4323,11151,1593,10761,6804,972,3650,+ 2277,5592,4310,7638,9869,4921,703,1856,9043,4803,9464,1352,8971,11815,5199,7765,+ 6376,4422,7654,2849,407,8836,6529,7955,2892,9191,1313,10721,12065,12257,1751,9028,+ 8312,2943,2176,3822,546,78,8789,11789,10462,12028,6985,4509,9422,1346,5459,4291,+ 613,10621,6784,9747,3148,7472,2823,5670,810,7138,8042,4660,7688,6365,6176,6149,+ 2634,5643,9584,10147,11983,5223,9524,11894,10477,8519,1217,3685,2282,326,10580,3267,+ 7489,4581,2410,5611,11335,6886,8006,8166,11700,3427,11023,8597,10006,3185,455,65,+ 5276,7776,4622,5927,7869,9902,11948,5218,2501,5624,2559,10899,1557,1978,10816,10323,+ 8497,4725,675,1852,10798,12076,10503,3256,9243,3076,2195,10847,12083,10504,12034,10497]
+ src/Crypto/NewHope/RNG.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE Safe #-}+{-|+ Module : Crypto.NewHope.RNG+ Description : Pseudorandom number generation for NewHope+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ Pseudorandom number generation for NewHope.++ This module contains the public interface. Implementation definitions+ are in the "Crypto.NewHope.Internal.RNG" module.++-}++module Crypto.NewHope.RNG ( Context+ , RandomSeedable+ , makeRandomSeed+ , randomBytesInit+ , randomBytes+ ) where+++import Crypto.NewHope.Internal.RNG
+ src/Crypto/NewHope/Reduce.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE Safe #-}+{-|+ Module : Crypto.NewHope.Reduce+ Description : Montgomery reduction for use in polynomial multiplication.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ See https://en.wikipedia.org/wiki/Montgomery_modular_multiplication++-}++module Crypto.NewHope.Reduce (montgomeryReduce) where++import Data.Bits+import Data.ByteString.Builder (toLazyByteString, word32BE)+import Data.ByteString.Lazy (unpack)+import Data.Word++import qualified Crypto.NewHope.Internals as Internals (q)++qinv :: Word32+qinv = 12287 -- inverse_mod(p,2^18)+++rlog :: Int+rlog = 18++-- low 16 bits, bigendianly, of a 32 bit word+low16 :: Word32 -> Word16+low16 n = shiftL hb 8 + lb where+ bytes = drop 2 $ unpack $ toLazyByteString $ word32BE n+ hb = fromIntegral (bytes !! 0)+ lb = fromIntegral (bytes !! 1)+++montgomeryReduce :: Word32 -> Word16+montgomeryReduce a = low16 result+ where+ u = a * qinv+ u' = u .&. (shiftL 1 rlog - 1 )+ u'' = u' * fromIntegral Internals.q+ a' = a + u''+ result = shiftR a' rlog
+ src/Crypto/NewHope/SeedExpander.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE Safe #-}+{-|+ Module : Crypto.NewHope.SeedExpander+ Description : Seed expander for NewHope.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ The "seed expander" is a facility specified by NIST for generating+ pseudorandom data given a seed. It is not used in the actual NewHope+ key exchange and is provided here for completeness/isomorphism with+ the NewHope C reference library.++ This module contains the public interface. Implementation definitions+ are in the "Crypto.NewHope.Internal.SeedExpander" module.++ * Sample usage++ @+ let maxLen' = case maxLen 256 of Right value -> value+ Left x -> error (show x)++ let diversifier = case createDiversifier (BSC.pack "12345678") of Right value -> value+ Left x -> error (show x)++ let seed = (Internals.makeSeed "32 bytes of seed data go here...")++ let ctx = case seedexpanderInit seed diversifier maxLen' of Right value -> value+ Left x -> error (show x)++ let (ctx', buf) = case seedexpander ctx 16 of Right value -> value+ Left x r -> error (show x)+ @++-}++module Crypto.NewHope.SeedExpander ( RNGError+ -- * Preparing parameters+ , makeSeed+ , Seedable++ , maxLen+ , createDiversifier++ -- * Expanding a seed+ , seedexpanderInit+ , seedexpander++ ) where++import Crypto.NewHope.Internal.SeedExpander+import Crypto.NewHope.Internals (Seedable, makeSeed)
+ src/Crypto/NewHope/Verify.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Safe #-}+{-|+ Module : Crypto.NewHope.Verify+ Description : Constant-time comparison and possible copying for NewHope+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ Constant time operations are important for protection against+ timing-based attacks on cryptosystems.++ We implement two versions for possible copying, one which uses+ mappend (and is valid for any Monoid) and the other which is+ ByteString-specific and does actual bit operations. The code+ currently just uses the first, but if we find a flaw with that then+ we can switch to the second.++-}++module Crypto.NewHope.Verify where++import Data.Bits+import qualified Data.ByteString as BS+import Data.Foldable+import Data.Semigroup (Semigroup, (<>))++++-- We have tests which attempt to demonstrate that these functions+-- really do take constant time, but this should probably also be done+-- by examination of the Core generated, and the assembly generated+-- from that.++-- | If the passed Bool is True, return the first of the following+-- arguments. If it is False, return the second of the following+-- arguments. Execution of this function should take constant time.+constantTimeChoose :: (Monoid a, Semigroup a) => Bool -> a -> a -> a+constantTimeChoose !v !a !b = (if v then a else mempty) <> (if v' then b else mempty)+ where+ !v' = not v++-- | If the passed Bool is True, return the first of the+-- ByteStrings. If it is False, return the second of the ByteStrings.+-- Execution of this function should take constant time on the length+-- of the shortest of the two ByteStrings.+cmov :: Bool -> BS.ByteString -> BS.ByteString -> BS.ByteString+cmov t !r !x = BS.pack $ BS.zipWith go r x+ where+ operate = (if t then 0x00 else 0xFF) .|. (if not t then 0xFF else 0x00)+ go r' x' = r' `xor` ((x' `xor` r') .&. operate)+++-- | In constant time, return True if the ByteStrings are equal and+-- False if they are not.+verify :: BS.ByteString -> BS.ByteString -> Bool+verify !a !b = Data.Foldable.foldl go True (BS.zip a b)+ where+ go accum (c, d) = (c == d) && accum
+ src/MiscUtils.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : MiscUtils+ Description : Miscellaneous utility+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer: : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ I guess it can't be truly miscellaneous because there is essentially+ only one thing here. C'est la vie.++-}++module MiscUtils where++import qualified Data.ByteString as BS+import qualified Data.Vector.Unboxed as VU+++-- | Chunkable allows an ordered container of things to be chunked+-- into a list of smaller versions of that thing, each containing N of+-- them instead of the full amount. The final item may contain fewer.+-- That is to say, a list of integers can be transformed into a list+-- of lists of 8 integers each, etc.+class Chunkable a+ where+ chunk :: Int -> a -> [a]+++instance VU.Unbox a => Chunkable (VU.Vector a)+ where+ chunk n v = if VU.null as+ then [a]+ else a : chunk n as+ where+ (a, as) = VU.splitAt n v+++instance Chunkable BS.ByteString+ where+ chunk n bs = if BS.length bs == 0+ then []+ else a : chunk n as+ where+ (a, as) = BS.splitAt 2 bs+++instance Chunkable [a]+ where+ chunk n list = if null as+ then [a]+ else a : chunk n as+ where+ (a, as) = splitAt n list
+ src/StringUtils.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Safe #-}+{-|+ Module : StringUtils+ Description : String utilities for NewHope.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ String utilities for NewHope.++-}++module StringUtils where++import qualified Data.ByteString as BS+import Data.ByteString.Builder+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BSLC+import Data.Semigroup ((<>))+import Numeric++import MiscUtils+++-- | Pad a string to a given length+class Paddable a+ where+ pad :: Char -> Int -> a -> a++instance Paddable String+ where+ pad char len str = let+ remainder = mod (len - Prelude.length str) len+ extra = replicate remainder char+ in str ++ extra++instance Paddable BS.ByteString+ where+ pad char len str = let+ remainder = mod (len - BS.length str) len+ extra = replicate remainder char+ in str <> BSC.pack extra+++-- | Convert from a readable hex representation to binary representation and vice-versa.+class HexStringable a where+ hexStringToByteString :: a -> BS.ByteString+ byteStringToHexString :: BS.ByteString -> a+ stringToHexString :: String -> a+++instance HexStringable BS.ByteString where+ hexStringToByteString s = BSLC.toStrict . toLazyByteString $ builder+ where+ builder = foldr go (byteString BS.empty) $ BSC.unpack <$> chunk 2 s+ go a builder' = newbuilder <> builder'+ where+ newbuilder = word8 . fst . head . readHex . take 2 $ a++ byteStringToHexString = BSL.toStrict . toLazyByteString . byteStringHex+ stringToHexString = byteStringToHexString . BSC.pack+++instance HexStringable BSL.ByteString where+ hexStringToByteString s = BSLC.toStrict . toLazyByteString $ builder+ where+ strict = BSL.toStrict s+ builder = foldr go (byteString BS.empty) $ BSC.unpack <$> chunk 2 strict+ go a builder' = newbuilder <> builder'+ where+ newbuilder = word8 . fst . head . readHex . take 2 $ a++ byteStringToHexString = toLazyByteString . byteStringHex+ stringToHexString = byteStringToHexString . BSC.pack+++instance HexStringable String where++ hexStringToByteString s = BSL.toStrict . toLazyByteString $ builder+ where+ builder = foldr go (byteString BS.empty) $ chunk 2 s+ go a builder' = newbuilder <> builder'+ where+ newbuilder = word8 . fst . head . readHex . take 2 $ a++ byteStringToHexString = BSLC.unpack . toLazyByteString . byteStringHex+ stringToHexString = BSLC.unpack . toLazyByteString . byteStringHex . BSC.pack+++-- | Extract a range of bytes from a ByteString+bsRange :: BS.ByteString -> Int -> Int -> BS.ByteString+bsRange source offset len = (BS.take len . BS.drop offset) source++-- | Compute a modification of input with a replacement overlaying the data at offset.+bsReplace :: BS.ByteString -> Int -> BS.ByteString -> BS.ByteString+bsReplace source offset new+ | BS.length result /= BS.length source = error errorMsg+ | otherwise = result+ where+ (initial, initialRest) = BS.splitAt offset source+ final = BS.drop (BS.length new) initialRest+ result = BS.append (BS.append initial new) final+ sourceLength = BS.length source+ newLength = BS.length new+ errorMsg = "Source length " ++ show sourceLength+ ++ "; replacement length: " ++ show newLength+ ++ " ...looks like source is shorter than required" -- constants should prevent this
+ test/ConfigFile.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-}+{-|+ Module : ConfigFile+ Description : Loads and parses configuration files for NewHope testing code+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module ConfigFile where++import Control.Applicative+import qualified Data.ByteString as BS+import Data.Map (Map)+import qualified Data.Map as M+import Data.Maybe+import Prelude hiding (map)+import Text.Trifecta+++type Name = String+type Value = String+type Assignments = Map Name Value+newtype Header = Header String deriving (Eq, Ord, Show)+data Section = Section Header Assignments deriving (Eq, Show)+newtype Config = Config (Map Header Assignments) deriving (Eq, Show)+++-- where our configuration files live+baseDirectory = "test/data/" -- ends with /+baseDirectory :: String+++fromFile :: String -> IO Config+fromFile path = do let expandedPath = baseDirectory ++ path+ fileContents <- BS.readFile expandedPath+ let m = parseByteString parseIni mempty fileContents+ case m of Success value -> return value+ _ -> return $ Config M.empty+++parseIni :: Parser Config+parseIni = do sections <- some parseSection+ let mapOfSections = foldr rollup M.empty sections+ return $ Config mapOfSections+ where+ rollup :: Section -> Map Header Assignments -> Map Header Assignments+ rollup (Section h a) = M.insert h a+++parseHeader :: Parser Header+parseHeader = parseBracketPair (Header <$> sectionIdentifier)+ where+ parseBracketPair :: Parser a -> Parser a+ parseBracketPair p = char '[' *> p <* char ']'++ sectionIdentifier :: Parser String+ sectionIdentifier = do initial <- letter+ middle <- some letterOrSpecialChar+ return $ initial : middle+ where+ letterOrSpecialChar :: CharParsing m => m Char+ letterOrSpecialChar = char '_' <|> char '.' <|> alphaNum+++skipEOL :: Parser ()+skipEOL = skipMany (oneOf "\n")+++parseSection :: Parser Section+parseSection = do+ skipWhitespace+ skipComments+ h <- parseHeader+ skipEOL+ assignments <- some parseAssignment+ return $ Section h (M.fromList assignments)+ where+ skipWhitespace :: Parser ()+ skipWhitespace = skipMany (char ' ' <|> char '\n')+++skipComments :: Parser ()+skipComments = skipMany (do _ <- char ';' <|> char '#'+ skipMany (noneOf "\n")+ skipEOL)+++parseAssignment :: Parser (Name, Value)+parseAssignment = do name <- assignmentIdentifier+ _ <- char '='+ val <- some (noneOf "\n")+ skipEOL+ return (name, val)+ where+ assignmentIdentifier :: (Monad m, CharParsing m) => m String+ assignmentIdentifier = some $ char '_' <|> char '.' <|> alphaNum++++sectionNames :: Config -> [String]+sectionNames (Config map) = [go header | header <- M.keys map]+ where+ go (Header name) = name+++sectionNamed :: Config -> String -> Assignments+sectionNamed (Config map) name = result -- map M.!? Header name+ where+ existing = map M.!? Header name+ result = if isNothing existing+ then M.empty+ else let (Just innerResult) = existing+ in innerResult+++-- * Testing Utilities+-- The following functions are used by testing code once their files+-- have been loaded.+++parseListWordIntegral :: Integral a => Parser [a]+parseListWordIntegral = do _ <- char '['+ result <- some parseIntAndMaybeComma+ _ <- char ']'+ return result+++toIntegralList :: (Enum a, Integral b) => [a] -> [b]+toIntegralList = fmap (fromIntegral . fromEnum)+++parseListIntegralPairs :: (Integral a, Integral b) => Parser [(a, b)]+parseListIntegralPairs = do _ <- char '['+ value <- some parsePairAndMaybeComma+ _ <- char ']'+ return value+ where+ parsePairAndMaybeComma :: (Integral a, Integral b) => Parser (a, b)+ parsePairAndMaybeComma = do+ _ <- char '('+ value <- integer+ _ <- char ','+ value' <- integer+ _ <- char ')'+ _ <- option 'x' $ char ','+ return (fromIntegral value, fromIntegral value')+++parseListIntegralMap :: (Integral a, Integral b) => Parser [(a, [b])]+parseListIntegralMap = do _ <- char '['+ item <- some parsePairAndMaybeComma+ _ <- char ']'+ return item+ where+ parsePairAndMaybeComma :: (Integral a, Integral b) => Parser (a, [b])+ parsePairAndMaybeComma = do _ <- char '('+ key <- integer+ _ <- char ','+ _ <- char '['+ values <- some parseIntAndMaybeComma+ _ <- char ']'+ _ <- char ')'+ _ <- option 'x' $ char ','+ return (fromIntegral key, values)+++parseIntAndMaybeComma :: Integral a => Parser a+parseIntAndMaybeComma = do value <- integer+ _ <- option 'x' $ char ','+ return $ fromIntegral value
+ test/Crypto/NewHope/Test/CCA_KEM.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.Test.CCA_KEM+ Description : Tests for IND-CCA-secure operations for NewHope+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer: : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ These tests duplicate (and in some cases improve on) the CCA tests+ executed by the "test_*" binaries from the reference C code.++-}++module Crypto.NewHope.Test.CCA_KEM where++import Control.Parallel+import System.CPUTime+import Test.Tasty (TestTree, adjustOption, testGroup)+import Test.Tasty.ExpectedFailure+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck as QC hiding (output)+++import AuxUtil+import qualified Crypto.NewHope.Internal.CCA_KEM as CCA_KEM+import qualified Crypto.NewHope.Internal.RNG as RNG+import qualified Crypto.NewHope.Internals as Internals+import Crypto.NewHope.Test.RNG+import Statistics+import Util+++-- | How many keypairs we use for timing analysis+keypairsToTestForTiming :: Int+keypairsToTestForTiming = 100+++-- | Test the basic key exchange. Note that we use multiple ctx on+-- input, which is an improvement (and more realistic test) as+-- compared to the reference code+propKeyExchange :: WrapN -> WrapContext -> WrapContext -> Bool+propKeyExchange wrappedN wrappedCtx wrappedCtx2 = success && keyA == keyB+ where+ WrapN n = wrappedN+ WrapContext ctx = wrappedCtx+ WrapContext ctx2 = wrappedCtx2++ (pk, skA, _ctx') = CCA_KEM.keypair ctx n -- Alice generates a public key+ (sendb, keyB, _ctx'2) = CCA_KEM.encrypt ctx2 pk -- Bob derives a secret key and creates a response+ (success, keyA) = CCA_KEM.decrypt sendb skA -- Alice uses Bob's response to get her secret key+++-- | Test that using random data as the secret key causes the key+-- exchange to fail. This is the test from the reference code.+propInvalidSkA :: WrapN -> WrapContext -> WrapContext -> WrapContext -> Bool+propInvalidSkA wn wctx wctx2 wctx3 = not success && keyA /= keyB+ where+ WrapN n = wn+ WrapContext ctx = wctx+ WrapContext ctx2 = wctx2+ WrapContext ctx3 = wctx3++ (pk, _skA, _ctx') = CCA_KEM.keypair ctx n -- Alice generates a public key+ (sendb, keyB, _ctx'2) = CCA_KEM.encrypt ctx2 pk -- Bob derives a secret key and creates a response+ (success, keyA) = CCA_KEM.decrypt sendb skA' -- Alice uses Bob's response to get her secret key+ where+ skA' = CCA_KEM.SecretKey randomData -- Replace secret key with random values+ (randomData, _ctx'3) = RNG.randomBytes ctx3 $ CCA_KEM.secretKeyBytes n+++-- | Test to see if mutating a certain number of bits in the secret key causes the+-- key exchange to fail. (It only does sometimes until we get to 3 bits, when it does.)+propInvalidSkAMutateNBits :: Int -> WrapN -> WrapContext -> WrapContext -> Bool+propInvalidSkAMutateNBits bits wn wctx wctx2 = not success && keyA /= keyB+ where+ WrapN n = wn+ WrapContext ctx = wctx+ WrapContext ctx2 = wctx2++ (pk, skA, ctx') = CCA_KEM.keypair ctx n -- Alice generates a public key+ (skA', _ctx'2) = mutateSecretKeyBits ctx' bits skA -- Change one or more bits in the secret key+ (sendb, keyB, _ctx2') = CCA_KEM.encrypt ctx2 pk -- Bob derives a secret key and creates a response+ (success, keyA) = CCA_KEM.decrypt sendb skA' -- Alice tries to use Bob's response to get her secret key+++-- | Does randomly mutating one or more bits in the ciphertext cause+-- the decryption to fail? It does, even at one bit.+propInvalidCiphertextMutateNBits :: Int -> WrapN -> WrapContext -> WrapContext -> WrapContext -> Bool+propInvalidCiphertextMutateNBits bits wn wctx wctx2 wctx3 = not success && keyA /= keyB+ where+ WrapN n = wn+ WrapContext ctx = wctx+ WrapContext ctx2 = wctx2+ WrapContext ctx3 = wctx3++ (pk, skA, _ctx') = CCA_KEM.keypair ctx n -- Alice generates a public key+ (sendb, keyB, _ctx'2) = CCA_KEM.encrypt ctx2 pk -- Bob derives a secret key and creates a response+ (sendb', _ctx'3) = mutateCipherTextBits ctx3 bits sendb -- Change some byte in the ciphertext (i.e., encapsulated key)+ (success, keyA) = CCA_KEM.decrypt sendb' skA -- Alice uses the damaged version of Bob's response to get her secret key+++-- | A TimingPair is a list of computations, the first of each which+-- is a prerequisite for the second. This is used to help isolate the+-- functions which we wish to time.+newtype TimingPair a b = TimingPair (a, b)+++-- An infinite list of keypairs and accompanying ctx+keypairsWithCtx :: Internals.N -> [(CCA_KEM.PublicKey, CCA_KEM.SecretKey, RNG.Context)]+keypairsWithCtx n = go initialCtx+ where+ initialSeed = RNG.makeRandomSeed "Assise en tailleur face à l'écran, Nadine appuie"+ initialCtx = RNG.randomBytesInit initialSeed Nothing 0+ go ctx = (nextPk, nextSk, ctx') : go ctx'+ where+ (nextPk, nextSk, ctx') = CCA_KEM.keypair ctx n+++mutateCipherTextBits :: RNG.Context -> Int -> CCA_KEM.CipherText -> (CCA_KEM.CipherText, RNG.Context)+mutateCipherTextBits ctx count (CCA_KEM.CipherText input) = (CCA_KEM.CipherText output, ctx')+ where+ (output, ctx') = mutateBits ctx count input++mutateSecretKeyBits :: RNG.Context -> Int -> CCA_KEM.SecretKey -> (CCA_KEM.SecretKey, RNG.Context)+mutateSecretKeyBits ctx count (CCA_KEM.SecretKey input) = (CCA_KEM.SecretKey output, ctx')+ where+ (output, ctx') = mutateBits ctx count input+++assertKeyExchangeTiming :: IO Bool+assertKeyExchangeTiming = runTimingTests timingPairs+ where+ timingPairs = pairFor <$> take keypairsToTestForTiming (keypairsWithCtx Internals.N1024)+ where+ pairFor (pk, skA, ctx) = (TimingPair (prereqA, funcA), TimingPair (prereqB, funcB))+ where++ (!sendb, _keyB, ctx'2) = CCA_KEM.encrypt ctx pk -- Bob derives a secret key and creates a response+ (!sendb', _ctx'3) = mutateCipherTextBits ctx'2 1 sendb -- alternate version of sendb to use for a bad decryption++ prereqA = (sendb, skA) -- Alice uses Bob's response to get her secret key+ funcA = CCA_KEM.decrypt sendb skA++ prereqB = (sendb', skA) -- Alice tries, but Bob's response is bad.+ funcB = CCA_KEM.decrypt sendb' skA++ runTimingTests testPairs = do allTimes <- traverse getTimeDifference testPairs+ let (low, high) = confidence 0.95 allTimes+ -- TODO: just checking for 0 being included in the confidence interval is stupidly insufficient.+ -- we should also check to see that the confidence interval is sufficiently narrow. but how narrow+ -- is appropriate?+ return $ (low < 0) && (high > 0)+ where+ -- value returned represents the difference between measurement A and measurement B for a paired observation.+ getTimeDifference (TimingPair (prereqA, funcA), TimingPair (prereqB, funcB)) = do+ start1 <- pseq prereqA getCPUTime+ time1 <- pseq funcA getCPUTime+ start2 <- pseq prereqB getCPUTime+ time2 <- pseq funcB getCPUTime+ let time1' = time1 - start1+ let time2' = time2 - start2+ return (time1' - time2')+++tests :: IO TestTree+tests = do+ assertKeyExchangeTiming' <- assertKeyExchangeTiming++ return $ testGroup "CCA_KEM Tests" [ QC.testProperty "top level key exchange" propKeyExchange+ , QC.testProperty "invalid skA" propInvalidSkA+ , expectFail $ adjustOption (\ _ -> QuickCheckTests 256) $ QC.testProperty "invalid skA (one random bit changed)" $ propInvalidSkAMutateNBits 1+ , QC.testProperty "invalid skA (two random bits changed)" $ propInvalidSkAMutateNBits 2+ , QC.testProperty "invalid skA (three random bits changed)" $ propInvalidSkAMutateNBits 3+ , adjustOption (\ _ -> QuickCheckTests 256) $ QC.testProperty "invalid ciphertext (one random bit changed)" $ propInvalidCiphertextMutateNBits 1+ , adjustOption (\ _ -> QuickCheckTests 4192) $ QC.testProperty "invalid ciphertext (two random bits changed)" $ propInvalidCiphertextMutateNBits 2+ , testCase "top level key exchange timing" (assertBool "relative timing not acceptable" assertKeyExchangeTiming')+ ]
+ test/Crypto/NewHope/Test/CPA_KEM.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.Test.CPA_KEM+ Description : Tests for IND-CPA-secure operations for NewHope.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ These tests duplicate (and in some cases improve on) the CPA tests+ executed by the "test_*" binaries from the reference C code.++-}++module Crypto.NewHope.Test.CPA_KEM where+++import Data.Bits+import qualified Data.ByteString as BS+import Test.Tasty (TestTree, adjustOption, testGroup)+import Test.Tasty.ExpectedFailure+import Test.Tasty.QuickCheck as QC hiding (output)+++import AuxUtil+import qualified Crypto.NewHope.Internal.CPA_KEM as CPA_KEM+import qualified Crypto.NewHope.Internal.RNG as RNG+import qualified Crypto.NewHope.Internals ()+import Crypto.NewHope.Test.RNG+import Util+++-- Test the basic full key exchange. Note that we use multiple ctx on+-- input, which is an improvement (and more realistic) as compared to+-- the reference code.+propKeyExchange :: WrapN -> WrapContext -> WrapContext -> Bool+propKeyExchange wrappedN wrappedCtx wrappedCtx2 = keyA == keyB+ where+ WrapN n = wrappedN+ WrapContext ctx = wrappedCtx+ WrapContext ctx2 = wrappedCtx2++ (pk, skA, _ctx') = CPA_KEM.keypair ctx n -- Alice generates a public key+ (sendb, keyB, _ctx'2) = CPA_KEM.encrypt ctx2 pk -- Bob derives a secret key and creates a response+ keyA = CPA_KEM.decrypt sendb skA -- Alice uses Bob's response to get her secret key+++-- Test that using random data as the secret key causes the key exchange to fail.+propInvalidSkA :: WrapN -> WrapContext -> WrapContext -> WrapContext -> Bool+propInvalidSkA wn wctx wctx2 wctx3 = keyA /= keyB+ where+ WrapN n = wn+ WrapContext ctx = wctx+ WrapContext ctx2 = wctx2+ WrapContext ctx3 = wctx3++ (pk, _skA, _ctx') = CPA_KEM.keypair ctx n -- Alice generates a public key+ (sendb, keyB, _ctx'2) = CPA_KEM.encrypt ctx2 pk -- Bob derives the SharedSecret and creates a response+ keyA = CPA_KEM.decrypt sendb skA' -- Alice tries to use Bob's response to get the SharedSecret+ where+ (randomData, _ctx'3) = RNG.randomBytes ctx3 $ CPA_KEM.secretKeyBytes n+ skA' = CPA_KEM.SecretKey randomData -- Replace secret key with random values+++-- | Test that the key exchange fails if three bits in the CipherText+-- are changed. This test (mirroring the reference C implementation)+-- changes the same three bits each time. An improved version of the+-- test would probably change three different bits.+propInvalidCiphertext :: WrapN -> WrapContext -> WrapContext -> Bool+propInvalidCiphertext wn wctx wctx2 = keyA /= keyB+ where+ WrapN n = wn+ WrapContext ctx = wctx+ WrapContext ctx2 = wctx2++ (pk, skA, _ctx') = CPA_KEM.keypair ctx n -- Alice generates a public key+ (sendb, keyB, _ctx'2) = CPA_KEM.encrypt ctx2 pk -- Bob derives a secret key and creates a response+ sendb' = mutateCipherText sendb -- alternate version of sendb to use for a bad decryption+ keyA = CPA_KEM.decrypt sendb' skA -- Alice tries to use Bob's response to get her secret key+++-- | Change three bits (always the same three) in the input+-- CipherText. This is the test from the reference library.+mutateCipherText :: CPA_KEM.CipherText -> CPA_KEM.CipherText+mutateCipherText (CPA_KEM.CipherText input) = CPA_KEM.CipherText output+ where+ (part1, part2) = BS.splitAt 42 input+ (part2a, part2b) = BS.splitAt 1 part2+ part2a' = BS.pack [xor (BS.index part2a 0) 0x23]+ output = BS.concat [part1, part2a', part2b]+++-- | Each time, randomly mutate some number of bits in the ciphertext.+propInvalidCiphertextMutateNBits :: Int -> WrapN -> WrapContext -> WrapContext -> WrapContext -> Bool+propInvalidCiphertextMutateNBits bits wn wctx wctx2 wctx3 = keyA /= keyB+ where+ WrapN n = wn+ WrapContext ctx = wctx+ WrapContext ctx2 = wctx2+ WrapContext ctx3 = wctx3++ (pk, skA, _ctx') = CPA_KEM.keypair ctx n -- Alice generates a public key+ (sendb, keyB, _ctx'2) = CPA_KEM.encrypt ctx2 pk -- Bob derives a secret key and creates a response+ (sendb', _ctx'3) = mutateCipherTextBits ctx3 bits sendb -- Change some byte in the ciphertext (i.e., encapsulated key)+ keyA = CPA_KEM.decrypt sendb' skA -- Alice uses the damaged version of Bob's response to get her secret key+++mutateCipherTextBits :: RNG.Context -> Int -> CPA_KEM.CipherText -> (CPA_KEM.CipherText, RNG.Context)+mutateCipherTextBits ctx count (CPA_KEM.CipherText input) = (CPA_KEM.CipherText output, ctx')+ where+ (output, ctx') = mutateBits ctx count input+++tests :: TestTree+tests = testGroup "CPA_KEM Tests" [ QC.testProperty "top level key exchange" propKeyExchange+ , QC.testProperty "invalid skA" propInvalidSkA+ , QC.testProperty "invalid ciphertext" propInvalidCiphertext+ , expectFail+ $ adjustOption (\ _ -> QuickCheckTests 256)+ $ QC.testProperty "invalid ciphertext (one random bit changed)"+ $ propInvalidCiphertextMutateNBits 1+ , expectFail+ $ adjustOption (\ _ -> QuickCheckTests 256)+ $ QC.testProperty "invalid ciphertext (two random bits changed)"+ $ propInvalidCiphertextMutateNBits 2+ , expectFail+ $ adjustOption (\ _ -> QuickCheckTests 512)+ $ QC.testProperty "invalid ciphertext (three random bits changed)"+ $ propInvalidCiphertextMutateNBits 3+ , expectFail+ $ adjustOption (\ _ -> QuickCheckTests 3200)+ $ QC.testProperty "invalid ciphertext (four random bits changed)"+ $ propInvalidCiphertextMutateNBits 4+ , QC.testProperty "invalid ciphertext (five random bits changed)" $ propInvalidCiphertextMutateNBits 5+ ]++
+ test/Crypto/NewHope/Test/FIPS202.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.Test.FIPS202+ Description : Testing code for NewHope.FIPS202 (an implementation of Keccak/SHA-3)+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Crypto.NewHope.Test.FIPS202 where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.Map as Map+import qualified Data.Vector.Unboxed as VU+import Data.Word+import Test.Tasty+import Test.Tasty.HUnit+import Text.Trifecta hiding (count)++import ConfigFile+import Crypto.NewHope.FIPS202+import StringUtils+++-- all the validation data for these tests+configFile :: IO Config+configFile = fromFile "FIPS202.cfg"+++data StatePermuteValidationParams = StatePermuteValidationParams { keccakInput :: VU.Vector Word64+ , keccakOutput :: VU.Vector Word64+ } deriving Show++keccakFromConfig :: Assignments -> StatePermuteValidationParams+keccakFromConfig section = StatePermuteValidationParams { keccakInput = inputVector, keccakOutput = outputVector }+ where+ Text.Trifecta.Success input = parseString parseListWordIntegral mempty $ section Map.! "input"+ inputVector = VU.fromList input+ Text.Trifecta.Success output = parseString parseListWordIntegral mempty $ section Map.! "output"+ outputVector = VU.fromList output++keccakPermuteCheck :: StatePermuteValidationParams -> TestTree+keccakPermuteCheck params = testCase "keccakf1600_permute"+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = keccakOutput params+ calculatedResult = keccakF1600StatePermute $ keccakInput params+++data Shake128AbsorbValidationParams = Shake128AbsorbValidationParams { absorbSeed :: BS.ByteString+ , absorbState :: [Word64]+ } deriving Show++absorbStateVector :: Shake128AbsorbValidationParams -> VU.Vector Word64+absorbStateVector params = VU.fromList $ absorbState params++absorbFromConfig :: Assignments -> Shake128AbsorbValidationParams+absorbFromConfig section = Shake128AbsorbValidationParams { absorbSeed = seed, absorbState = state }+ where+ seed = BSC.pack $ section Map.! "seed"+ Text.Trifecta.Success state = parseString parseListWordIntegral mempty $ section Map.! "state"++shake128AbsorbCheck :: Shake128AbsorbValidationParams -> String -> TestTree+shake128AbsorbCheck params variant = testCase ("shake128Absorb (" ++ variant ++ ")")+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = absorbStateVector params+ calculatedResult = shake128Absorb $ absorbSeed params+++data Shake128SqueezeValidationParams = Shake128SqueezeValidationParams { squeezeSeed :: BS.ByteString+ , squeezeOutput :: BS.ByteString+ , squeezeState :: VU.Vector Word64+ } deriving Show++squeezeFromConfig :: Assignments -> Shake128SqueezeValidationParams+squeezeFromConfig section = Shake128SqueezeValidationParams { squeezeSeed = seedVector, squeezeOutput = outputVector, squeezeState = stateVector }+ where+ seedVector = BS.pack $ toIntegralList $ section Map.! "seed"+ Text.Trifecta.Success output = parseString parseListWordIntegral mempty $ section Map.! "output"+ outputVector = BS.pack output+ Text.Trifecta.Success state = parseString parseListWordIntegral mempty $ section Map.! "state"+ stateVector = VU.fromList state++shake128SqueezeBlocksCheck :: Shake128SqueezeValidationParams -> Int -> String -> TestTree+shake128SqueezeBlocksCheck params count variant = testCase ("shake128SqueezeBlocks (" ++ variant ++ ")")+ $ assertEqual "it is" (validatedOutput, validatedOutputState) (output, outputState)+ where+ validatedOutput = squeezeOutput params+ validatedOutputState = squeezeState params+ startingState = shake128Absorb $ squeezeSeed params+ (output, outputState) = shake128SqueezeBlocks startingState count+++data Shake256ValidationParams = Shake256ValidationParams { shake256Input :: BS.ByteString+ , shake256Output :: BS.ByteString+ } deriving Show++shake256FromConfig :: Assignments -> Shake256ValidationParams+shake256FromConfig section = Shake256ValidationParams { shake256Input = inputVector, shake256Output = outputVector }+ where+ inputVector = BS.pack $ toIntegralList $ section Map.! "seed"+ Text.Trifecta.Success output = parseString parseListWordIntegral mempty $ section Map.! "output"+ outputVector = BS.pack output++shake256Check :: Shake256ValidationParams -> String -> TestTree+shake256Check params variant = testCase ("shake256 (" ++ variant ++ ")")+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = shake256Output params+ inputVector = shake256Input params+ calculatedResult = shake256 inputVector $ BS.length validatedResult+++data KeccakF1600VectorsValidationParams = KeccakF1600VectorsValidationParams { keccakVectorsInput :: BS.ByteString+ , keccakVectorsRate :: Int+ , keccakVectorsOutput :: Map.Map Int (VU.Vector Word64)+ , keccakVectorsUnifiedOutput :: VU.Vector Word64+ } deriving Show++keccakVectorsFromConfig :: Assignments -> KeccakF1600VectorsValidationParams+keccakVectorsFromConfig section = KeccakF1600VectorsValidationParams { keccakVectorsInput = inputBS+ , keccakVectorsRate = rate+ , keccakVectorsOutput = outputMap+ , keccakVectorsUnifiedOutput = unifiedVector+ }+ where+ rate = read $ section Map.! "r"+ inputBS = hexStringToByteString $ section Map.! "m"+ Text.Trifecta.Success unified = parseString parseListWordIntegral mempty $ section Map.! "unified"+ unifiedVector = VU.fromList unified+ Text.Trifecta.Success output = parseString parseListIntegralMap mempty $ section Map.! "vectors"+ outputMap = Map.fromList $ fmap go output+ where+ go (key, value) = (key, VU.fromList value)++keccakVectorsCheck :: KeccakF1600VectorsValidationParams -> TestTree+keccakVectorsCheck params = testCase "keccakf1600 vectors check"+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = keccakVectorsOutput params+ rate = keccakVectorsRate params+ input = keccakVectorsInput params+ calculatedResult = inputLoadVectors rate input+++tests :: IO TestTree+tests = do+ config <- configFile++ let+ statePermuteParams :: StatePermuteValidationParams+ statePermuteParams = keccakFromConfig $ sectionNamed config "keccakf1600_statepermute"++ absorbParams :: Shake128AbsorbValidationParams+ absorbParams = absorbFromConfig $ sectionNamed config "shake128_absorb"++ absorbParams2 :: Shake128AbsorbValidationParams+ absorbParams2 = absorbFromConfig $ sectionNamed config "shake128_absorb_2"++ squeezeParams :: Shake128SqueezeValidationParams+ squeezeParams = squeezeFromConfig $ sectionNamed config "shake128_squeezeblocks"++ squeezeParams2 :: Shake128SqueezeValidationParams+ squeezeParams2 = squeezeFromConfig $ sectionNamed config "shake128_squeezeblocks_2"++ shake256Params :: Shake256ValidationParams+ shake256Params = shake256FromConfig $ sectionNamed config "shake256"++ shake256Params2 :: Shake256ValidationParams+ shake256Params2 = shake256FromConfig $ sectionNamed config "shake256_2"++ keccakVectorsParams :: KeccakF1600VectorsValidationParams+ keccakVectorsParams = keccakVectorsFromConfig $ sectionNamed config "keccak_absorb.loop"+++ return $ testGroup "FIPS202 Tests" [ keccakPermuteCheck statePermuteParams+ , keccakVectorsCheck keccakVectorsParams+ , shake128AbsorbCheck absorbParams "#1"+ , shake128AbsorbCheck absorbParams2 "#2"+ , shake128SqueezeBlocksCheck squeezeParams 1 "#1"+ , shake128SqueezeBlocksCheck squeezeParams2 2 "#2"+ , shake256Check shake256Params "#1"+ , shake256Check shake256Params2 "#2"+ ]
+ test/Crypto/NewHope/Test/NTT.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.Test.NTT+ Description : Testing code for NTT+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Crypto.NewHope.Test.NTT where++import Data.Map+import qualified Data.Vector.Unboxed as VU+import Data.Word+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck as QC hiding (output)+import Text.Trifecta++import ConfigFile+import Crypto.NewHope.NTT+++-- all the validation data for these tests+configFile512 :: IO Config+configFile512 = fromFile "NTT_512.cfg"++configFile1024 :: IO Config+configFile1024 = fromFile "NTT_1024.cfg"+++-- generate (arbitrary :: Gen Word16Vector512)++newtype WrappedVUUnbox a = WrappedVUUnbox (VU.Vector a) deriving Show++instance (Arbitrary a, VU.Unbox a) => Arbitrary (WrappedVUUnbox a) where+ arbitrary = fmap (WrappedVUUnbox . VU.fromList) arbitrary+++newtype Word16Vector512 = Word16Vector512 (VU.Vector Word16) deriving (Eq, Show)+newtype Word16Vector1024 = Word16Vector1024 (VU.Vector Word16) deriving (Eq, Show)++instance Arbitrary Word16Vector512 where+ arbitrary = sized $ \_n -> do+ let notN = 512 :: Int+ a <- sequence [ suchThat arbitrary (< 512) | _ <- [1..notN]]+ return $ Word16Vector512 (VU.fromList a)++instance Arbitrary Word16Vector1024 where+ arbitrary = sized $ \_n -> do+ let notN = 1024 :: Int+ a <- sequence [ suchThat arbitrary (< 1024) | _ <- [1..notN]]+ return $ Word16Vector1024 (VU.fromList a)+++propRev512 :: Word16Vector512 -> Bool+propRev512 v = v0 == v2 where+ Word16Vector512 v0 = v+ v1 = bitrev v0+ v2 = bitrev v1++propRev1024 :: Word16Vector1024 -> Bool+propRev1024 v = v0 == v2 where+ Word16Vector1024 v0 = v+ v1 = bitrev v0+ v2 = bitrev v1+++data BitReverseValidationParams = BitReverseValidationParams { getBTKeySize :: Int+ , getBTInput :: VU.Vector Word16+ , getBTOutput :: VU.Vector Word16+ } deriving Show+btFromConfig :: Config -> BitReverseValidationParams+btFromConfig config = BitReverseValidationParams { getBTKeySize = bits+ , getBTInput = inputVector+ , getBTOutput = outputVector+ }+ where+ section = config `sectionNamed` "bitrev"+ bits = read $ section ! "n" :: Int+ Text.Trifecta.Success input = parseString parseListWordIntegral mempty $ section ! "input"+ inputVector = VU.fromList input+ Text.Trifecta.Success output = parseString parseListWordIntegral mempty $ section ! "output"+ outputVector = VU.fromList output+++isBitReverseAccurate :: BitReverseValidationParams -> Bool+isBitReverseAccurate config = expectedOutput == liveResult+ where+ expectedOutput = getBTOutput config+ input = getBTInput config+ liveResult = bitrev input+++bitreverseCheck :: BitReverseValidationParams -> TestTree+bitreverseCheck params = testCase ("bitreverse (N=" ++ show n ++ ")")+ (assertEqual "it is" True $ isBitReverseAccurate params)+ where+ n = getBTKeySize params+++data NTTValidationParams = NTTValidationParams { getKeySize :: Int+ , getInput :: VU.Vector Word16+ , getΩ :: VU.Vector Word16+ , getOutput :: VU.Vector Word16+ } deriving Show+++nttFromConfig :: Config -> NTTValidationParams+nttFromConfig config = NTTValidationParams { getKeySize = bits+ , getInput = inputVector+ , getΩ = ωVector+ , getOutput = outputVector+ }+ where+ section = config `sectionNamed` "ntt"+ bits = read $ findWithDefault "0" "n" section :: Int+ Text.Trifecta.Success input = parseString parseListWordIntegral mempty $ section ! "input"+ inputVector = VU.fromList input+ Text.Trifecta.Success ω = parseString parseListWordIntegral mempty $ section ! "omega"+ ωVector = VU.fromList ω+ Text.Trifecta.Success output = parseString parseListWordIntegral mempty $ section ! "output"+ outputVector = VU.fromList output+++isNTTAccurate :: NTTValidationParams -> Bool+isNTTAccurate config = validResult == liveResult+ where+ validResult = getOutput config+ inputVector = getInput config+ ωVector = getΩ config+ liveResult = ntt inputVector ωVector++nttCheck :: NTTValidationParams -> TestTree+nttCheck params = testCase ("ntt (N=" ++ show n ++ ")")+ (assertEqual "it is" True $ isNTTAccurate params)+ where+ n = getKeySize params+++-- the table entries should be symmetrical+checkTableEntry :: VU.Vector Word16 -> Integer -> Bool+checkTableEntry table n = let+ value0 = table VU.! fromIntegral n+ value1 = table VU.! fromIntegral value0+ result = value0 == value1 || value1 == fromIntegral n+ in result+++-- check the full table. this should really be sufficient instead of the spot check that the other test provides, iirc+validateBitrevTable :: Int -> Bool+validateBitrevTable bits = and $ checkTableEntry (bitrevTable bits) <$> [0..511]++bitrevTable512Ok :: TestTree+bitrevTable512Ok = testCase "bitreverse table (N=512) is legit"+ (assertEqual "it is" True $ validateBitrevTable 512)++bitrevTable1024Ok :: TestTree+bitrevTable1024Ok = testCase "bitreverse table (N=1024) is legit"+ (assertEqual "it is" True $ validateBitrevTable 1024)+++tests :: IO TestTree+tests = do+ config512 <- configFile512+ config1024 <- configFile1024++ let btParams512 :: BitReverseValidationParams+ btParams512 = btFromConfig config512++ nttParams512 :: NTTValidationParams+ nttParams512 = nttFromConfig config512++ let btParams1024 :: BitReverseValidationParams+ btParams1024 = btFromConfig config1024++ nttParams1024 :: NTTValidationParams+ nttParams1024 = nttFromConfig config1024++ return $ testGroup "NTT Tests" [ bitreverseCheck btParams512+ , bitreverseCheck btParams1024+ , bitrevTable512Ok+ , bitrevTable1024Ok+ , nttCheck nttParams512+ , nttCheck nttParams1024+ , QC.testProperty "round trip bitreversal (N=512)" propRev512+ , QC.testProperty "round trip bitreversal (N=1024)" propRev1024+ ]
+ test/Crypto/NewHope/Test/Poly.hs view
@@ -0,0 +1,363 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.Test.Poly+ Description : Testing code for Poly+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Crypto.NewHope.Test.Poly where+++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.Map+import qualified Data.Vector.Unboxed as VU+import Data.Word+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck as QC hiding (output)+import Text.Trifecta+++import ConfigFile+import qualified Crypto.NewHope.Internals as Internals+import Crypto.NewHope.Poly (Poly (..))+import qualified Crypto.NewHope.Poly as Poly+import StringUtils+++-- all the validation data for these tests+configFile :: IO Config+configFile = fromFile "Poly.cfg"+++data MiscValidationParams = MiscValidationParams { coeffFreezePairs :: [(Word16, Word16)]+ , flipabsPairs :: [(Word16, Word16)]+ } deriving Show++miscFromConfig :: Assignments -> MiscValidationParams+miscFromConfig section = MiscValidationParams { coeffFreezePairs = coeffFreezePairs', flipabsPairs = flipabsPairs' }+ where+ Text.Trifecta.Success coeffFreezePairs' = parseString parseListIntegralPairs mempty $ section ! "coeff_freeze"+ Text.Trifecta.Success flipabsPairs' = parseString parseListIntegralPairs mempty $ section ! "flipabs"++coeffFreezeCheck :: MiscValidationParams -> TestTree+coeffFreezeCheck params = testCase "coeff_freeze"+ $ assertBool "broken" allIsWell+ where+ pairs = coeffFreezePairs params+ allIsWell = go pairs+ where+ go [] = True+ go ((a, a') : rest) = (Poly.coeffFreeze a == a') || go rest++flipabsCheck :: MiscValidationParams -> TestTree+flipabsCheck params = testCase "flipabs"+ $ assertBool "broken" allIsWell+ where+ pairs = flipabsPairs params+ allIsWell = go pairs+ where+ go [] = True+ go ((a, a') : rest) = (Poly.flipabs a == a') || go rest+++newtype WrapPoly = WrapPoly Poly deriving Show++instance Arbitrary WrapPoly where+ arbitrary = do+ a <- frequency [ (1, sequence [ arbitrary | _ <- [1 .. 512 :: Int]])+ , (1, sequence [ arbitrary | _ <- [1 .. 1024 :: Int]])]+ return $ WrapPoly $ Poly (VU.fromList a)+++newtype WrapPoly512 = WrapPoly512 Poly deriving Show++instance Arbitrary WrapPoly512 where+ arbitrary = do+ a <- sequence [ arbitrary | _ <- [1 .. 512 :: Int]]+ return $ WrapPoly512 $ Poly (VU.fromList a)++newtype WrapPoly1024 = WrapPoly1024 Poly deriving Show++instance Arbitrary WrapPoly1024 where+ arbitrary = do+ a <- sequence [ arbitrary | _ <- [1 .. 1024 :: Int]]+ return $ WrapPoly1024 $ Poly (VU.fromList a)+++data ToBytesValidationParams = ToBytesValidationParams { toBytesInput :: Poly+ , toBytesOutput :: BS.ByteString+ } deriving Show++toBytesFromConfig :: Assignments -> ToBytesValidationParams+toBytesFromConfig section = ToBytesValidationParams { toBytesInput = inputPoly+ , toBytesOutput = outputBS+ }+ where+ Text.Trifecta.Success input = parseString parseListWordIntegral mempty $ section ! "input"+ inputPoly = Poly $ VU.fromList input+ outputBS = hexStringToByteString $ section ! "output"+++toBytesCheck :: ToBytesValidationParams -> TestTree+toBytesCheck params = testCase "poly_tobytes"+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = toBytesOutput params+ calculatedResult = Poly.toByteString $ toBytesInput params+++data FromBytesValidationParams = FromBytesValidationParams { fromBytesInput :: BS.ByteString+ , fromBytesOutput :: Poly+ } deriving Show++fromBytesFromConfig :: Assignments -> FromBytesValidationParams+fromBytesFromConfig section = FromBytesValidationParams { fromBytesInput = inputBS+ , fromBytesOutput = outputVector+ }+ where+ inputBS = hexStringToByteString $ section ! "input"+ Text.Trifecta.Success output = parseString parseListWordIntegral mempty $ section ! "output"+ outputVector = Poly $ VU.fromList output+++fromBytesCheck :: FromBytesValidationParams -> TestTree+fromBytesCheck params = testCase "fromByteString"+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = fromBytesOutput params+ calculatedResult = Poly.fromByteString $ fromBytesInput params+++-- we need an entire post-routine roundtrip because there is some sort of convergence happening+propPolynomialEncodeRoundtrip :: WrapPoly -> Bool+propPolynomialEncodeRoundtrip (WrapPoly poly) = let+ asBytes = Poly.toByteString poly+ asPoly = Poly.fromByteString asBytes+ asBytes' = Poly.toByteString asPoly+ in asBytes == asBytes'+++data CompressValidationParams = CompressValidationParams { compressInput :: Poly+ , compressOutput :: BS.ByteString+ } deriving Show++compressFromConfig :: Assignments -> CompressValidationParams+compressFromConfig section = CompressValidationParams { compressInput = inputPoly+ , compressOutput = outputBS+ }+ where+ Text.Trifecta.Success input = parseString parseListWordIntegral mempty $ section ! "input"+ inputPoly = Poly $ VU.fromList input+ outputBS = hexStringToByteString $ section ! "output"++compressCheck :: CompressValidationParams -> TestTree+compressCheck params = testCase "poly_compress"+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = compressOutput params+ calculatedResult = Poly.compress $ compressInput params+++data DecompressValidationParams = DecompressValidationParams { decompressInput :: BS.ByteString+ , decompressOutput :: Poly+ } deriving Show++decompressFromConfig :: Assignments -> DecompressValidationParams+decompressFromConfig section = DecompressValidationParams { decompressInput = inputBS+ , decompressOutput = outputPoly+ }+ where+ inputBS = hexStringToByteString $ section ! "input"+ Text.Trifecta.Success output = parseString parseListWordIntegral mempty $ section ! "output"+ outputPoly = Poly $ VU.fromList output+++decompressCheck :: DecompressValidationParams -> TestTree+decompressCheck params = testCase "poly_decompress"+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = decompressOutput params+ calculatedResult = Poly.decompress $ decompressInput params+++-- *should* this work?+propCompressionRoundtrip :: Poly -> Bool+propCompressionRoundtrip poly = let+ compressed = Poly.compress poly+ decompressed = Poly.decompress compressed+ recompressed = Poly.compress decompressed+ redecompressed = Poly.decompress recompressed+ in redecompressed == decompressed+++data FromMsgValidationParams = FromMsgValidationParams { fromMsgInput :: BS.ByteString+ , fromMsgOutput :: Poly+ } deriving Show++fromMsgFromConfig :: Assignments -> FromMsgValidationParams+fromMsgFromConfig section = FromMsgValidationParams { fromMsgInput = inputVector+ , fromMsgOutput = outputPoly+ }+ where+ inputVector = BSC.pack $ section ! "input"+ Text.Trifecta.Success output = parseString parseListWordIntegral mempty $ section ! "output"+ outputPoly = Poly $ VU.fromList output+++fromMsgCheck :: FromMsgValidationParams -> TestTree+fromMsgCheck params = testCase "poly_frommsg"+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = fromMsgOutput params+ n = Poly.getN validatedResult+ calculatedResult = Poly.fromMsg n $ fromMsgInput params++data ToMsgValidationParams = ToMsgValidationParams { toMsgInput :: Poly+ , toMsgOutput :: BS.ByteString+ } deriving Show++toMsgFromConfig :: Assignments -> ToMsgValidationParams+toMsgFromConfig section = ToMsgValidationParams { toMsgInput = inputPoly+ , toMsgOutput = outputBS+ }+ where+ Text.Trifecta.Success input = parseString parseListWordIntegral mempty $ section ! "input"+ inputPoly = Poly $ VU.fromList input+ outputBS = hexStringToByteString $ section ! "output"+++toMsgCheck :: ToMsgValidationParams -> TestTree+toMsgCheck params = testCase "poly_tomsg"+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = toMsgOutput params+ calculatedResult = Poly.toMsg $ toMsgInput params++-----++data UniformValidationParams = UniformValidationParams { uniformSeed :: Internals.Seed+ , uniformOutput :: Poly+ }++uniformFromConfig :: Assignments -> UniformValidationParams+uniformFromConfig section = UniformValidationParams { uniformSeed = seed+ , uniformOutput = outputPoly+ }+ where+ seed = Internals.makeSeed $ hexStringToByteString $ section ! "seed"+ Text.Trifecta.Success output = parseString parseListWordIntegral mempty $ section ! "output"+ outputPoly = Poly $ VU.fromList output+++uniformCheck :: UniformValidationParams -> TestTree+uniformCheck params = testCase "poly_uniform"+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = uniformOutput params+ n = Poly.getN validatedResult+ calculatedResult = Poly.uniform n $ uniformSeed params++-----++data SampleValidationParams = SampleValidationParams { sampleSeed :: Internals.Seed+ , sampleNonce :: Word8+ , sampleOutput :: Poly+ }++sampleFromConfig :: Assignments -> SampleValidationParams+sampleFromConfig section = SampleValidationParams { sampleSeed = seed+ , sampleNonce = nonce+ , sampleOutput = outputPoly+ }+ where+ seed = Internals.makeSeed $ hexStringToByteString $ section ! "seed"+ nonce = read $ section ! "nonce"+ Text.Trifecta.Success output = parseString parseListWordIntegral mempty $ section ! "output"+ outputPoly = Poly $ VU.fromList output+++sampleCheck :: SampleValidationParams -> TestTree+sampleCheck params = testCase "poly_sample"+ $ assertEqual "it is" validatedResult calculatedResult+ where+ validatedResult = sampleOutput params+ n = Poly.getN validatedResult+ calculatedResult = Poly.sample n (sampleSeed params) (sampleNonce params)+++propAddIsCommutative512 :: WrapPoly512 -> WrapPoly512 -> Bool+propAddIsCommutative512 (WrapPoly512 a) (WrapPoly512 b) = ab == ba+ where+ ab = Poly.add a b+ ba = Poly.add b a++propAddIsCommutative1024 :: WrapPoly1024 -> WrapPoly1024 -> Bool+propAddIsCommutative1024 (WrapPoly1024 a) (WrapPoly1024 b) = ab == ba+ where+ ab = Poly.add a b+ ba = Poly.add b a+++{-+-- this is not true, but why not?+propAddSub1024 :: WrapPoly1024 -> WrapPoly1024 -> WrapPoly1024 -> Bool+propAddSub1024 (WrapPoly1024 a) (WrapPoly1024 b) (WrapPoly1024 c) = aMinusBMinusC == aMinusQuantityBPlusC+ where+ aMinusBMinusC = Poly.sub (Poly.sub a b) c+ aMinusQuantityBPlusC = Poly.sub a (Poly.add b c)+-}++tests :: IO TestTree+tests = do+ config <- configFile++ let sampleParams :: SampleValidationParams+ sampleParams = sampleFromConfig $ config `sectionNamed` "poly.sample"++ miscParams :: MiscValidationParams+ miscParams = miscFromConfig $ config `sectionNamed` "poly.misc"++ toBytesParams :: ToBytesValidationParams+ toBytesParams = toBytesFromConfig $ config `sectionNamed` "poly.tobytes"++ fromBytesParams :: FromBytesValidationParams+ fromBytesParams = fromBytesFromConfig $ config `sectionNamed` "poly.frombytes"++ toMsgParams :: ToMsgValidationParams+ toMsgParams = toMsgFromConfig $ config `sectionNamed` "poly.tomsg"++ fromMsgParams :: FromMsgValidationParams+ fromMsgParams = fromMsgFromConfig $ config `sectionNamed` "poly.frommsg"++ compressParams :: CompressValidationParams+ compressParams = compressFromConfig $ config `sectionNamed` "poly.compress"++ decompressParams :: DecompressValidationParams+ decompressParams = decompressFromConfig $ config `sectionNamed` "poly.decompress"++ uniformParams :: UniformValidationParams+ uniformParams = uniformFromConfig $ config `sectionNamed` "poly.uniform"+++ return $ testGroup "Poly Tests" [ sampleCheck sampleParams+ , coeffFreezeCheck miscParams+ , flipabsCheck miscParams+ , toBytesCheck toBytesParams+ , fromBytesCheck fromBytesParams+ , compressCheck compressParams+ , decompressCheck decompressParams+ , fromMsgCheck fromMsgParams+ , toMsgCheck toMsgParams+ , uniformCheck uniformParams+ , QC.testProperty "round trip poly encode/decode" propPolynomialEncodeRoundtrip+ , QC.testProperty "add (N=512) is commutative" propAddIsCommutative512+ , QC.testProperty "add (N=1024) is commutative" propAddIsCommutative1024+ -- , QC.testProperty "round trip poly de/compress" propCompressionRoundtrip+ ]
+ test/Crypto/NewHope/Test/RNG.hs view
@@ -0,0 +1,268 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.Test.RNG+ Description : Testing code for RNG+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Crypto.NewHope.Test.RNG where++import Codec.Crypto.AES+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.Map+import Test.QuickCheck (Arbitrary, arbitrary)+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck as QC++import ConfigFile+import Crypto.NewHope.Internal.RNG+import StringUtils+++configFile :: IO Config+configFile = fromFile "RNG.cfg"+++newtype WrapKey = WrapKey Key++instance Show WrapKey+ where+ show (WrapKey (Key bs)) = "Key: " ++ byteStringToHexString bs+++newtype WrapV = WrapV V deriving Eq++instance Show WrapV+ where+ show (WrapV (V bs)) = "V: " ++ byteStringToHexString bs+++newtype WrapContext = WrapContext Context++instance Show WrapContext where+ show (WrapContext (Context key v reseedCounter)) = "Context {"+ ++ "ctxKey = " ++ show (WrapKey key) ++ ", "+ ++ "ctxV = " ++ show (WrapV v) ++ ", "+ ++ "ctxReseedCounter = " ++ show reseedCounter ++ "}"++++instance Arbitrary WrapKey where+ arbitrary = do+ key <- sequence [ arbitrary | _ <- [1 .. keyBytes]]+ return $ WrapKey $ createKey $ BSC.pack key++instance Arbitrary WrapV where+ arbitrary = do+ v <- sequence [ arbitrary | _ <- [1 .. vBytes]]+ return $ WrapV $ createV $ BSC.pack v++instance Arbitrary WrapContext+ where+ arbitrary = do+ wrappedKey <- arbitrary+ wrappedV <- arbitrary+ reseedCounter <- arbitrary++ let WrapKey key = wrappedKey+ let WrapV v = wrappedV++ return $ WrapContext Context { ctxKey = key+ , ctxV = v+ , ctxReseedCounter = abs reseedCounter+ }++++++data RNGValidationParams = RNGValidationParams { rngEntropy :: BS.ByteString+ , rngKey :: BS.ByteString+ , rngV :: BS.ByteString+ , rngBlock0 :: BS.ByteString+ , rngBlock1 :: BS.ByteString+ , rngBlock2 :: BS.ByteString+ } deriving Show++rngFromConfig :: Assignments -> RNGValidationParams+rngFromConfig section = RNGValidationParams { rngEntropy = hexStringToByteString $ section ! "entropy_input"+ , rngKey = hexStringToByteString $ section ! "key"+ , rngV = hexStringToByteString $ section ! "v"+ , rngBlock0 = hexStringToByteString $ section ! "block0"+ , rngBlock1 = hexStringToByteString $ section ! "block1"+ , rngBlock2 = hexStringToByteString $ section ! "block2"+ }+++keyAndVCheck :: RNGValidationParams -> TestTree+keyAndVCheck params = testCase "rng key and v generation"+ $ assertBool "broken" allIsWell+ where+ entropy = makeRandomSeed $ rngEntropy params+ ctx = randomBytesInit entropy Nothing 256 -- note that the 256 is ignored!++ keyVerified = rngKey params+ Key keyActual = ctxKey ctx+ keyIsOK = keyVerified == keyActual++ vVerified = rngV params+ V vActual = ctxV ctx+ vIsOK = vVerified == vActual++ allIsWell = keyIsOK && vIsOK+++blocksCheck :: RNGValidationParams -> TestTree+blocksCheck params = testCase "rng block generation"+ $ assertBool "broken" allIsWell+ where+ entropy = makeRandomSeed $ rngEntropy params+ ctx = randomBytesInit entropy Nothing 256 -- note that the 256 is ignored!++ block0Verified = rngBlock0 params+ (block0, ctx0) = randomBytes ctx $ BS.length block0Verified+ block0IsOK = block0Verified == block0++ block1Verified = rngBlock1 params+ (block1, ctx1) = randomBytes ctx0 $ BS.length block1Verified+ block1IsOK = block1Verified == block1++ block2Verified = rngBlock2 params+ (block2, _ctx2) = randomBytes ctx1 $ BS.length block2Verified+ block2IsOK = block2Verified == block2++ allIsWell = block0IsOK && block1IsOK && block2IsOK++blocksCheck' :: RNGValidationParams -> TestTree+blocksCheck' params = testCaseSteps "rng block generation" $ \ step -> do+ step "Making seed"+ let entropy = makeRandomSeed $ rngEntropy params+ let ctx = randomBytesInit entropy Nothing 256 -- note that the 256 is ignored!++ step "Generating block 0"+ let block0Verified = rngBlock0 params+ let (block0, ctx0) = randomBytes ctx $ BS.length block0Verified+ block0Verified == block0 @? "Block 0 not generated properly"++ step "Generating block 1"+ let block1Verified = rngBlock1 params+ let (block1, ctx1) = randomBytes ctx0 $ BS.length block1Verified+ block1Verified == block1 @? "Block 1 not generated properly"++ step "Generating block 2"+ let block2Verified = rngBlock2 params+ let (block2, _ctx2) = randomBytes ctx1 $ BS.length block2Verified+ block2Verified == block2 @? "Block 2 not generated properly"+++++testIncrementV :: TestTree+testIncrementV = testGroup "Incrementing a V" [ incrementCheckBasic+ , incrementCheckTwoWraps+ , incrementCheckFifteenWraps+ , incrementCheckWrapAround+ ]++incrementCheckBasic :: TestTree+incrementCheckBasic = testCase "Incrementing a v - final byte"+ (assertEqual "increment failed" (WrapV firstIncremented) (WrapV second)) where+ first = createV $ BS.pack [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]+ firstIncremented = incrementV first+ second = createV $ BS.pack [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,16]++incrementCheckTwoWraps :: TestTree+incrementCheckTwoWraps = testCase "Incrementing a v - two wraps"+ (assertEqual "increment failed" (WrapV firstIncremented) (WrapV second)) where+ first = createV $ BS.pack [0,1,2,3,4,5,6,7,8,9,10,11,12,13,255,255]+ firstIncremented = incrementV first+ second = createV $ BS.pack [0,1,2,3,4,5,6,7,8,9,10,11,12,14,0,0]++incrementCheckFifteenWraps :: TestTree+incrementCheckFifteenWraps = testCase "Incrementing a v - 15 wraps"+ (assertEqual "increment failed" (WrapV firstIncremented) (WrapV second)) where+ first = createV $ BS.pack [254,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255]+ firstIncremented = incrementV first+ second = createV $ BS.pack [255,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]++incrementCheckWrapAround :: TestTree+incrementCheckWrapAround = testCase "Incrementing a v - wraparound"+ (assertEqual "increment failed" (WrapV firstIncremented) (WrapV second)) where+ first = createV $ BS.pack [255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255]+ firstIncremented = incrementV first+ second = createV $ BS.pack [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]+++++-- AES tests are here because RNG is where we use AES.++newtype TestPlaintext = TestPlaintext { getText :: BS.ByteString } deriving (Eq, Show)++instance Arbitrary TestPlaintext where+ arbitrary = sized $ \ n -> do+ a <- sequence [ arbitrary | _ <- [1 .. n]]+ return $ TestPlaintext (BSC.pack a)+++newtype AES256IV = AES256IV BS.ByteString deriving Show++aes256IVLength :: Int+aes256IVLength = 16++instance Arbitrary AES256IV+ where+ arbitrary = do+ a <- sequence [ arbitrary | _ <- [1 .. aes256IVLength]]+ return $ AES256IV $ BSC.pack a+++-- using two different IVs to the crypt' function because ECB doesn't use the IV.+propCryptDecrypt :: WrapKey -> AES256IV -> AES256IV -> TestPlaintext -> Bool+propCryptDecrypt key iv iv2 plaintext = let+ WrapKey (Key key') = key+ AES256IV iv' = iv+ AES256IV iv2' = iv2+ TestPlaintext plaintext' = plaintext+ plaintext'' = pad ' ' 16 plaintext'+ encrypted = crypt' ECB key' iv' Encrypt plaintext''+ decrypted = crypt' ECB key' iv2' Decrypt encrypted+ decrypted' = BSC.take (BS.length plaintext') decrypted+ in plaintext' == decrypted'+++-------------------++-- for manual investigation, not part of test suite+encryptionRoundtrip :: String -> IO BS.ByteString+encryptionRoundtrip plaintext = do+ WrapV (V iv') <- generate (arbitrary :: Gen WrapV)+ WrapKey (Key key') <- generate (arbitrary :: Gen WrapKey)+ let plaintext' = pad ' ' 16 (BSC.pack plaintext)+ let encrypted = crypt' ECB key' iv' Encrypt plaintext'+ let decrypted = crypt' ECB key' iv' Decrypt encrypted+ let decrypted' = BSC.take (Prelude.length plaintext) decrypted+ return decrypted'+++++tests :: IO TestTree+tests = do+ config <- configFile++ let rngParams :: RNGValidationParams+ rngParams = rngFromConfig $ config `sectionNamed` "rng"++ return $ testGroup "RNG Tests" [ QC.testProperty "round trip AES encryption" propCryptDecrypt+ , QC.testProperty "round trip AES encryption (plaintext size 100)" (mapSize (const 100) propCryptDecrypt)+ , QC.testProperty "round trip AES encryption (plaintext size 1025)" (mapSize (const 1025) propCryptDecrypt)+ , testIncrementV+ , blocksCheck' rngParams]
+ test/Crypto/NewHope/Test/Reduce.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.Test.Reduce+ Description : Testing code for Reduce+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Crypto.NewHope.Test.Reduce where++import Data.Map+import Data.Word+import Test.Tasty+import Test.Tasty.HUnit+import Text.Trifecta++import ConfigFile+import Crypto.NewHope.Reduce (montgomeryReduce)+++type Values = (Word32, Word16)++newtype MontgomeryReduceValidationParams = MontgomeryReduceValidationParams { values :: [Values]+ } deriving Show+++mrFromConfig :: Config -> MontgomeryReduceValidationParams+mrFromConfig cfg = MontgomeryReduceValidationParams { values = vals }+ where+ section = cfg `sectionNamed` "montgomery_reduce"+ --Success vals = parseString parseValues mempty $ section ! "values"+ Success vals = parseString parseListIntegralPairs mempty $ section ! "values"+++isMontgomeryReduceAccurate :: MontgomeryReduceValidationParams -> Bool+isMontgomeryReduceAccurate MontgomeryReduceValidationParams { values = v } = go v+ where+ go [] = True+ go ((input, output) : rest) = montgomeryReduce input == output && go rest+++configFile :: IO Config+configFile = fromFile "Reduce.cfg"++montgomeryReduceCheck :: MontgomeryReduceValidationParams -> TestTree+montgomeryReduceCheck params = testCase "montgomery reduce"+ (assertEqual "it is" True $ isMontgomeryReduceAccurate params)+++tests :: IO TestTree+tests = do+ config <- configFile++ let mrParams :: MontgomeryReduceValidationParams+ mrParams = mrFromConfig config++ return $ testGroup "Reduce Tests" [montgomeryReduceCheck mrParams]
+ test/Crypto/NewHope/Test/SeedExpander.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.SeedExpander+ Description : Testing code for SeedExpander+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Crypto.NewHope.Test.SeedExpander where+++import qualified Data.ByteString as BS+import Data.Map+import Data.Word+import Test.Tasty+import Test.Tasty.HUnit+++import ConfigFile+import qualified Crypto.NewHope.Internal.RNG as RNG+import qualified Crypto.NewHope.Internal.SeedExpander as SE+import Crypto.NewHope.Internals (Seed, makeSeed)+import Crypto.NewHope.Test.RNG (WrapKey (..), WrapV (..))+import StringUtils+++configFile :: IO Config+configFile = fromFile "SeedExpander.cfg"++data SEContextParams = SEContextParams { ctxIndex :: Int+ , ctxBuffer :: BS.ByteString+ , ctxBufferPos :: Word64+ , ctxLengthRemaining :: Word64+ , ctxKey :: RNG.Key+ , ctxCounter :: RNG.V+ }+++makeBaseContext :: SEContextParams -> SE.Context+makeBaseContext seCtx = SE.Context { SE.ctxBuffer = ctxBuffer seCtx+ , SE.ctxBufferPos = ctxBufferPos seCtx+ , SE.ctxLengthRemaining = ctxLengthRemaining seCtx+ , SE.ctxKey = ctxKey seCtx+ , SE.ctxCounter = ctxCounter seCtx+ }++instance Show SEContextParams+ where+ show ctx = "SECP { n = " ++ show (ctxIndex ctx)+ ++ ", buffer = " ++ byteStringToHexString (ctxBuffer ctx)+ ++ ", bufferPos = " ++ show (ctxBufferPos ctx)+ ++ ", lengthRemaining = " ++ show (ctxLengthRemaining ctx)+ ++ ", key = " ++ show (WrapKey $ ctxKey ctx)+ ++ ", payload = " ++ show (WrapV $ ctxCounter ctx)+ ++ "}"+++data SEValidationParams = SEValidationParams { seSeed :: Seed+ , seDiversifier :: BS.ByteString+ , seCtxs :: [SEContextParams]+ , seGenBufs :: [BS.ByteString]+ }+++seFromConfig :: Assignments -> SEValidationParams+seFromConfig section = SEValidationParams { seSeed = seed+ , seDiversifier = diversifier+ , seCtxs = ctxs+ , seGenBufs = genBufs+ }++ where+ seed = makeSeed $ hexStringToByteString $ section ! "seed"+ diversifier = hexStringToByteString $ section ! "diversifier"+ ctxs = [getCtx 0, getCtx 1, getCtx 2, getCtx 3, getCtx 4] -- order is important.+ genBufs = [getGenBuf 1, getGenBuf 2, getGenBuf 3, getGenBuf 4] -- order is important.++ -- ctx n results in genBuf n+1 and ctx n+1+ getGenBuf :: Int -> BS.ByteString+ getGenBuf n = result+ where+ Just result = hexStringToByteString <$> section !? ("genbuf" ++ show n)++ getCtx n = SEContextParams { ctxIndex = n+ , ctxBuffer = buffer+ , ctxBufferPos = bufferPos+ , ctxLengthRemaining = lengthRemaining+ , ctxKey = key+ , ctxCounter = counter+ }+ where+ Just buffer = hexStringToByteString <$> section !? ("buffer" ++ show n)+ Just bufferPos = read <$> section !? ("buffer_pos" ++ show n)+ Just lengthRemaining = read <$> section !? ("length_remaining" ++ show n)+ Just key = RNG.createKey . hexStringToByteString <$> section !? ("key" ++ show n)+ Just counter = RNG.createV . hexStringToByteString <$> section !? ("ctr" ++ show n)+++seCheck :: SEValidationParams -> TestTree+seCheck params = testCase "seedexpander"+ $ assertBool "broken" allIsWell+ where+ maxLengthBytes = ctxLengthRemaining $ seCtxs params !! 0+ validGenBufs = seGenBufs params+ Right diversifier = SE.createDiversifier (seDiversifier params) -- >>= return+ Right maxLen = SE.maxLen maxLengthBytes+ Right ctx0 = SE.seedexpanderInit (seSeed params) diversifier maxLen+ Right (genBuf1, ctx1) = SE.seedexpander ctx0 $ fromIntegral $ BS.length (validGenBufs !! 0)+ Right (genBuf2, ctx2) = SE.seedexpander ctx1 $ fromIntegral $ BS.length (validGenBufs !! 1)+ Right (genBuf3, ctx3) = SE.seedexpander ctx2 $ fromIntegral $ BS.length (validGenBufs !! 2)+ Right (genBuf4, ctx4) = SE.seedexpander ctx3 $ fromIntegral $ BS.length (validGenBufs !! 3)+ genBufs = [genBuf1, genBuf2, genBuf3, genBuf4]++ ctxs = [ctx0, ctx1, ctx2, ctx3, ctx4]+ ctxOK :: Int -> SE.Context -> Bool+ ctxOK n ctx = ctx == makeBaseContext (seCtxs params !! n)++ allIsWell = and (zipWith ctxOK [0, 1, 2, 3, 4] ctxs)+ && and (zipWith (==) genBufs validGenBufs)+++-------------------++tests :: IO TestTree+tests = do+ config <- configFile++ let seParams :: SEValidationParams+ seParams = seFromConfig $ config `sectionNamed` "seedexpander"++ return $ testGroup "SeedExpander Test" [ seCheck seParams+ ]
+ test/Crypto/NewHope/Test/Verify.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Crypto.NewHope.Test.Verify+ Description : Test Verify+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Crypto.NewHope.Test.Verify where+++import Control.Parallel+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU+import System.CPUTime+import Test.QuickCheck.Monadic+import Test.Tasty+import Test.Tasty.QuickCheck as QC+++import Crypto.NewHope.Verify+import Statistics+++sizeOfWrappedThings :: Int+sizeOfWrappedThings = 100++trialCount :: Int+trialCount = 100000 -- this is probably enough.+++newtype WrappedVUUnbox a = WrappedVUUnbox (VU.Vector a) deriving Show++instance (Arbitrary a, VU.Unbox a) => Arbitrary (WrappedVUUnbox a) where+ arbitrary = fmap (WrappedVUUnbox . VU.fromList) arbitrary+++newtype Wrapped a = Wrapped a deriving Show++instance {-# OVERLAPS #-} Show [Wrapped a]+ where+ show as = "[array of " ++ show (length as) ++ "]"++deWrapped :: Wrapped a -> a+deWrapped (Wrapped a) = a++instance (Semigroup a) => Semigroup (Wrapped a)+ where+ (Wrapped a) <> (Wrapped b) = Wrapped (a <> b)++instance (Semigroup a, Monoid a) => Monoid (Wrapped a)+ where+ mempty = Wrapped mempty+ mappend (Wrapped a) (Wrapped b) = Wrapped (mappend a b)++instance Functor Wrapped+ where+ fmap f (Wrapped a) = Wrapped (f a)++instance Arbitrary (Wrapped String)+ where+ arbitrary = Wrapped <$> vectorOf sizeOfWrappedThings genWrappedChar+ where+ genWrappedChar = elements $ ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ " .,;:/|()[]{}!@#$%^&*<>"+++instance Arbitrary (Wrapped BS.ByteString)+ where+ arbitrary = (fmap . fmap) BSC.pack arbitrary++instance (Arbitrary a, VU.Unbox a) => Arbitrary (Wrapped (V.Vector a))+ where+ arbitrary = (fmap . fmap) V.fromList v+ where+ v = Wrapped <$> vectorOf sizeOfWrappedThings arbitrary++instance Arbitrary (Wrapped (VU.Vector Char))+ where+ arbitrary = (fmap . fmap) VU.fromList arbitrary+++genFixedLengthList :: (Arbitrary a) => Int -> Gen [a]+genFixedLengthList n = sequence [ arbitrary | _ <- [1 .. n]]+++generateBigBytestringPair :: Gen ([Wrapped BS.ByteString], [Wrapped BS.ByteString])+generateBigBytestringPair = do+ a <- genFixedLengthList trialCount :: Gen [Wrapped BS.ByteString]+ b <- genFixedLengthList trialCount :: Gen [Wrapped BS.ByteString]+ return (a, b)++generateBigBytestringPairs :: Gen [(Wrapped BS.ByteString, Wrapped BS.ByteString)]+generateBigBytestringPairs = do+ a <- arbitrary :: Gen (Wrapped BS.ByteString)+ b <- arbitrary :: Gen (Wrapped BS.ByteString)+ rest <- generateBigBytestringPairs+ let firstItem = (a, b)+ return $ firstItem : rest+++-----------------------++-- | Somewhat deep magic: Test a property in IO, which is required+-- here because we check the CPU time. The basic idea is that f1 and+-- f2 (when called on the pairs of items from as and bs) should take+-- as close to the same amount of time as possible, and this test+-- should succeed iff we should be confident that this is true.+runTimingTests :: Monoid a => (a -> a -> b) -> (a -> a -> b) -> [Wrapped a] -> [Wrapped a] -> PropertyM IO ()+runTimingTests f1 f2 as bs = do allTimes <- run (traverse getTimeDifference $ zip as' bs')+ let (low, high) = confidence 0.95 allTimes+ -- TODO: just checking for 0 being included in the confidence interval is stupidly insufficient.+ -- we should also check to see that the confidence interval is sufficiently narrow. but how narrow+ -- is appropriate?+ assert $ (low < 0) && (high > 0)+ where+ as' = deWrapped <$> as+ bs' = deWrapped <$> bs++ -- value returned represents the difference between measurement A and measurement B for a paired observation.+ getTimeDifference (a, b) = do+ start_1 <- getCPUTime+ time_1 <- pseq (f1 a b) getCPUTime+ start_2 <- getCPUTime+ time_2 <- pseq (f2 a b) getCPUTime+ let time_1' = time_1 - start_1+ let time_2' = time_2 - start_2+ return (time_1' - time_2')+++-----------------------++propTimingPairBytestringCTC :: Property+propTimingPairBytestringCTC = forAll generateBigBytestringPair evaluator+ where+ evaluator :: ([Wrapped BS.ByteString], [Wrapped BS.ByteString]) -> Property+ evaluator (as, bs) = monadicIO $ runTimingTests chooseA chooseB as bs++ chooseA = constantTimeChoose True+ chooseB = constantTimeChoose False++-----------------------++propTimingPairBytestringCmov :: Property+propTimingPairBytestringCmov = forAll generateBigBytestringPair evaluator+ where+ evaluator :: ([Wrapped BS.ByteString], [Wrapped BS.ByteString]) -> Property+ evaluator (as, bs) = monadicIO $ runTimingTests chooseA chooseB as bs++ chooseA = cmov True+ chooseB = cmov False++-----------------------++propTimingPairBytestringVerify :: Property+propTimingPairBytestringVerify = forAll generateBigBytestringPair evaluator+ where+ evaluator :: ([Wrapped BS.ByteString], [Wrapped BS.ByteString]) -> Property+ evaluator (as, bs) = monadicIO $ runTimingTests chooseA chooseB as bs++ chooseA a b = verify a b -- will return False+ chooseB a _ = verify a a -- will return True (using the first argument)++propTimingPairBytestringVerify' :: Property+propTimingPairBytestringVerify' = forAll generateBigBytestringPair evaluator+ where+ evaluator :: ([Wrapped BS.ByteString], [Wrapped BS.ByteString]) -> Property+ evaluator (as, bs) = monadicIO $ runTimingTests chooseA chooseB as bs++ chooseA a b = verify a b -- Will return False+ chooseB _ b = verify b b -- Will return True (using the second argument)++-----------------------++tests :: TestTree+tests = testGroup "Verify Tests"+ [ adjustOptions $ QC.testProperty "verify ByteString comparison is constant time (#1)" propTimingPairBytestringVerify+ , adjustOptions $ QC.testProperty "verify ByteString comparison is constant time (#2)" propTimingPairBytestringVerify'+ , adjustOptions $ QC.testProperty "constantTimeChoose is constant time" propTimingPairBytestringCTC+ , adjustOptions $ QC.testProperty "cmov is constant time" propTimingPairBytestringCmov+ ]+ where+ adjustOptions :: TestTree -> TestTree+ adjustOptions = adjustOption setTests+ . adjustOption setMaxSize+ . adjustOption setVerbose+ . adjustOption setShowReplay+ where+ setTests :: QuickCheckTests -> QuickCheckTests+ setTests _opt = QuickCheckTests 1++ setMaxSize :: QuickCheckMaxSize -> QuickCheckMaxSize+ setMaxSize _opt = QuickCheckMaxSize 1++ setVerbose :: QuickCheckVerbose -> QuickCheckVerbose+ setVerbose _opt = QuickCheckVerbose False++ setShowReplay :: QuickCheckShowReplay -> QuickCheckShowReplay+ setShowReplay _opt = QuickCheckShowReplay False
+ test/Statistics.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Statistics+ Description : Statistics helpers for testing.+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Statistics where++import Statistics.Distribution hiding (mean)+import Statistics.Distribution.StudentT+++-- | Confidence range using the Student T distribution+confidence :: Double -> [Integer] -> (Double, Double)+confidence factor as = (rangeLow, rangeHigh)+ where+ rangeLow = mean - base+ rangeHigh = mean + base+ n = length as+ df = fromIntegral $ n - 1+ mean = fromIntegral (sum as) / fromIntegral n+ σ = stddev as+ distribution = studentT df+ tQuantile = quantile distribution doubleTailProbability+ base = abs $ tQuantile * se+ se = σ / sqrt (fromIntegral n)+ doubleTailProbability = (1.0 - factor) / 2+++-- | Standard deviation+stddev :: [Integer] -> Double+stddev as = sqrt $ realToFrac (sum squaredDiffFromMean / (len - 1))+ where+ as' = toRational <$> as+ len = fromIntegral $ length as+ mean = sum as' / len+ diffFromMean = (\a -> a - toRational mean) <$> as'+ squaredDiffFromMean = (^ (2::Int)) <$> diffFromMean
+ test/Test/ConfigFile.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Test.ConfigFile+ Description : Tests our ability to parse our testing configuration files+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Test.ConfigFile where+++import qualified Data.ByteString as BS (ByteString)+import qualified Data.Map as M+import Prelude+import Test.Tasty+import Test.Tasty.HUnit+import Text.RawString.QQ+import Text.Trifecta hiding (expected)++import qualified ConfigFile+++maybeSuccess :: Result a -> Maybe a+maybeSuccess (Success a) = Just a+maybeSuccess _ = Nothing+++assignmentCheck :: TestTree+assignmentCheck = testCase "Assignment Parsing" $ do+ let m = parseByteString ConfigFile.parseAssignment mempty input+ parsed = maybeSuccess m+ input = "simply=listen"+ assertEqual "simple assignment" parsed $ Just ("simply", "listen")+++headerCheck :: TestTree+headerCheck = testCase "Header Parsing" $ do+ let m = parseByteString ConfigFile.parseHeader mempty input+ parsed = maybeSuccess m+ input = "[important]"+ assertEqual "header" parsed $ Just (ConfigFile.Header "important")+++commentCheck :: TestTree+commentCheck = testCase "Comment Parsing" $ do+ let p = ConfigFile.skipComments >> ConfigFile.parseHeader+ m = parseByteString p mempty input+ parsed = maybeSuccess m+ input = "; this is imporant\n[not_important]"+ assertEqual "skip comment before header" parsed $ Just (ConfigFile.Header "not_important")+++sectionCheck :: TestTree+sectionCheck = testCase "Section Parsing" $ do+ let m = parseByteString ConfigFile.parseSection mempty input+ parsed = maybeSuccess m+ input = "; super important\n[cheese_opinions]\ncheddar=fine"+ expected = Just (ConfigFile.Section+ (ConfigFile.Header "cheese_opinions")+ (M.fromList [("cheddar", "fine")]))+ assertEqual "skip comment before header" parsed expected+++fullFile :: BS.ByteString+fullFile = [r|+; do not read this information+; you may find it artless+[animal_info]+crawler=wombat+bird=colibri++[charming]+quokka=super+|]+++fileCheck :: TestTree+fileCheck = testCase "File Parsing" $ do+ let m = parseByteString ConfigFile.parseIni mempty fullFile+ parsed = maybeSuccess m+ sectionValues = M.fromList [ ("bird", "colibri")+ , ("crawler", "wombat")]+ charming = M.fromList [("quokka", "super")]+ expected = Just (ConfigFile.Config (M.fromList [ (ConfigFile.Header "animal_info", sectionValues)+ , (ConfigFile.Header "charming", charming)]))+ assertEqual "can parse multiple sections" parsed expected++++tests :: TestTree+tests = testGroup "ConfigFile tests" [ assignmentCheck+ , headerCheck+ , commentCheck+ , sectionCheck+ , fileCheck+ ]
+ test/Test/KAT.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE Trustworthy #-}+{-|+ Module : Test.KAT+ Description : Test validity of our KAT output+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++ Tests to demonstrate that this implementation creates the same+ PQCkemKAT data as the reference C implementation.++-}++module Test.KAT where+++import Data.ByteString.Builder+import qualified Data.ByteString.Lazy as BSL+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Text.Encoding+import Filesystem+import Filesystem.Path.CurrentOS hiding (valid)+import Test.Tasty+import Test.Tasty.HUnit+++import AuxUtil+import qualified Crypto.NewHope.Internals as Internals+import KAT+++officialKATFilesPath :: String+officialKATFilesPath = "etc/official_kat/"+++fileContents :: String -> IO Text+fileContents fn = readTextFile $ fromText . Text.pack $ fn+++cpaKatCheck :: Internals.N -> String -> Text -> TestTree+cpaKatCheck n fileName valid =+ testCase ("CPA KAT validation, N=" ++ show (WrapN n)) $ do+ fileName @=? builtFileName+ validBSLazy @=? generated+ where+ (builtFileName, built) = KAT.cpaKemTestVectors n recordsToGenerate+ validBSLazy = BSL.fromStrict validBS+ validBS = encodeUtf8 valid+ generated = toLazyByteString built+++ccaKatCheck :: Internals.N -> String -> Text -> TestTree+ccaKatCheck n fileName valid =+ testCase ("CCA KAT validation, N=" ++ show (WrapN n)) $ do+ fileName @=? builtFileName+ validBSLazy @=? generated+ where+ (builtFileName, built) = KAT.ccaKemTestVectors n recordsToGenerate+ validBSLazy = BSL.fromStrict validBS+ validBS = encodeUtf8 valid+ generated = toLazyByteString built++++tests :: IO TestTree+tests = do+ validCpa512 <- fileContents $ officialKATFilesPath ++ "PQCkemKAT_896.rsp"+ validCpa1024 <- fileContents $ officialKATFilesPath ++ "PQCkemKAT_1792.rsp"+ validCca512 <- fileContents $ officialKATFilesPath ++ "PQCkemKAT_1888.rsp"+ validCca1024 <- fileContents $ officialKATFilesPath ++ "PQCkemKAT_3680.rsp"++ return $ testGroup "KAT tests"+ [ cpaKatCheck Internals.N512 "PQCkemKAT_896.rsp" validCpa512+ , cpaKatCheck Internals.N1024 "PQCkemKAT_1792.rsp" validCpa1024+ , ccaKatCheck Internals.N512 "PQCkemKAT_1888.rsp" validCca512+ , ccaKatCheck Internals.N1024 "PQCkemKAT_3680.rsp" validCca1024+ ]
+ test/Util.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE Safe #-}+{-|+ Module : Util+ Description : Testing utility+ Copyright : © Jeremy Bornstein 2019+ License : Apache 2.0+ Maintainer : jeremy@bornstein.org+ Stability : experimental+ Portability : portable++-}++module Util where++import Data.Bits+import qualified Data.ByteString as BS+import Data.Set+import Data.Word++import qualified Crypto.NewHope.Internal.RNG as RNG++mutateOneBit :: RNG.Context -> BS.ByteString -> (BS.ByteString, RNG.Context)+mutateOneBit ctx input = (output, ctx')+ where+ (offset, ctx') = RNG.randomInteger ctx (0, fromIntegral $ BS.length input - 1)+ (bitNum, _ctx'') = RNG.randomInteger ctx' (0, 7)+ shiftedBit = shiftL (0x01 :: Word8) (fromIntegral bitNum)+ (part1, part2) = BS.splitAt (fromIntegral offset) input+ (part2a, part2b) = BS.splitAt 1 part2+ part2a' = BS.pack [xor (BS.index part2a 0) shiftedBit]+ output = BS.concat [part1, part2a', part2b]+++mutateBits :: RNG.Context -> Int -> BS.ByteString -> (BS.ByteString, RNG.Context)+mutateBits ctx n input = (output, ctx')+ where+ bitCount = BS.length input * 8+ (bitsToMutate, ctx') = randomSetOfSize ctx bitCount n+ output = Prelude.foldr go input bitsToMutate+ where+ go index bs = BS.concat [part1, part2a', part2b]+ where+ offset = index `div` 8+ shiftedBit = shiftL (0x01 :: Word8) (index `mod` 8)+ (part1, part2) = BS.splitAt (fromIntegral offset) bs+ (part2a, part2b) = BS.splitAt 1 part2+ part2a' = BS.pack [xor (BS.index part2a 0) shiftedBit]+++-- | A nonrepeating set of 大きさ (or n, whichever is smaller) random+-- integers from 0 to n.+randomSetOfSize :: RNG.Context -> Int -> Int -> (Set Int, RNG.Context)+randomSetOfSize ctx n 大きさ = go ctx empty+ where+ 大きさ' = min n 大きさ+ go ctx_ prevResult+ | length prevResult == 大きさ' = (prevResult, ctx_)+ | otherwise = go ctx_' nextResult+ where+ (choice, ctx_') = RNG.randomInteger ctx_ (0, fromIntegral n - 1)+ nextResult = insert (fromIntegral choice) prevResult