Merge branch 'master' into uni2work

Small refactor

.appveyor.yml

@@ -0,0 +1,29 @@
+# ~*~ auto-generated by haskell-ci with config : 4fdddfa41dd039e198b8d125a70471f7dd140fa01001d99126af56fb31429ece ~*~
+
+version: "{build}"
+clone_folder: C:\project
+build: off
+cache:
+  - "C:\\SR -> .appveyor.yml"
+
+environment:
+  global:
+    STACK_ROOT: "C:\\SR"
+  matrix:
+    - { BUILD: "ghc-8.6", STACKCMD: "stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps", STACKCFG: "{ resolver: lts-14.27, packages: [ '.' ], extra-deps: [], flags: {} }", STACKURL: "https://www.stackage.org/stack/windows-x86_64" }
+    - { BUILD: "ghc-8.8", STACKCMD: "stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps", STACKCFG: "{ resolver: lts-15.1, packages: [ '.' ], extra-deps: [], flags: {} }", STACKURL: "https://www.stackage.org/stack/windows-x86_64" }
+
+matrix:
+  fast_finish: true
+
+install:
+  - set PATH=C:\Program Files\Git\mingw64\bin;%PATH%
+  - curl -ostack.zip -L %STACKURL%
+  - 7z x stack.zip stack.exe
+  - refreshenv
+test_script:
+  - echo %STACKCFG% > stack.yaml
+  - stack setup > nul
+  - echo "" | %STACKCMD%
+
+

.envrc

@@ -0,0 +1 @@
+use flake

.gitignore

@@ -12,3 +12,4 @@ benchs/Hash
 *.sublime-workspace
 .cabal-sandbox/
 cabal.sandbox.config
+stack.yaml.lock

.haskell-ci

@@ -0,0 +1,26 @@
+# compiler supported and their equivalent LTS
+compiler: ghc-8.0 lts-9.21
+compiler: ghc-8.2 lts-11.22
+compiler: ghc-8.4 lts-12.26
+compiler: ghc-8.6 lts-14.27
+compiler: ghc-8.8 lts-15.1
+
+# options
+# option: alias x=y z=v
+option: gaugedeps extradep=gauge-0.2.1
+option: basementmin extradep=basement-0.0.8 extradep=memory-0.14.18
+
+# builds
+build: ghc-8.0 basementmin gaugedeps
+build: ghc-8.2 basementmin
+build: ghc-8.4
+build: ghc-8.6 os=linux,osx,windows
+build: ghc-8.8 os=linux,windows
+
+# packages
+package: '.'
+
+# extra builds
+hlint: allowed-failure
+weeder: allowed-failure
+coverall: false

.hlint.yaml

@@ -0,0 +1,3 @@
+- arguments: [ --cpp-define=ARCH_X86_64
+             ]
+- ignore: { name: Use camelCase }

.travis.yml

@@ -1,50 +1,83 @@
-sudo: false
+# ~*~ auto-generated by haskell-ci with config : 4fdddfa41dd039e198b8d125a70471f7dd140fa01001d99126af56fb31429ece ~*~
 
-env:
+# Caching so the next build will be fast too.
- - CABALVER=1.18 GHCVER=7.8.4
+cache:
- - CABALVER=1.22 GHCVER=7.10.3
+  directories:
- - CABALVER=1.24 GHCVER=8.0.1 RUNTEST=0
+  - $HOME/.ghc
- - CABALVER=head GHCVER=head RUNTEST=0
+  - $HOME/.stack
+  - $HOME/.local
 
-matrix:
+language: generic
+os: linux
+
+jobs:
+  include:
+  - { env: BUILD=stack RESOLVER=ghc-8.0, addons: { apt: { packages: [ libgmp-dev ] } } }
+  - { env: BUILD=stack RESOLVER=ghc-8.2, addons: { apt: { packages: [ libgmp-dev ] } } }
+  - { env: BUILD=stack RESOLVER=ghc-8.4, addons: { apt: { packages: [ libgmp-dev ] } } }
+  - { env: BUILD=stack RESOLVER=ghc-8.6, addons: { apt: { packages: [ libgmp-dev ] } } }
+  - { env: BUILD=stack RESOLVER=ghc-8.6, addons: { apt: { packages: [ libgmp-dev ] } }, os: osx }
+  - { env: BUILD=stack RESOLVER=ghc-8.8, addons: { apt: { packages: [ libgmp-dev ] } } }
+  - { env: BUILD=hlint }
+  - { env: BUILD=weeder, addons: { apt: { packages: [ libgmp-dev ] } } }
   allow_failures:
-   - env: CABALVER=head GHCVER=head RUNTEST=0
+  - { env: BUILD=hlint }
-
+  - { env: BUILD=weeder, addons: { apt: { packages: [ libgmp-dev ] } } }
-addons:
-    apt:
-        sources:
-         - hvr-ghc
-        packages:
-         - cabal-install-1.18
-         - cabal-install-1.20
-         - cabal-install-1.22
-         - cabal-install-1.24
-         - cabal-install-head
-         - ghc-7.8.4
-         - ghc-7.10.3
-         - ghc-8.0.1
-         - ghc-head
-
-before_install:
- - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
 
 install:
- - cabal --version
+  - export PATH=$HOME/.local/bin:$HOME/.cabal/bin:$PATH
- - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
+  - mkdir -p ~/.local/bin
- - travis_retry cabal update
+  - |
- - if [ "${RUNTEST}" != "0" ]; then cabal install --only-dependencies --enable-tests; else cabal install --only-dependencies; fi
+    case "$BUILD" in
+      stack|weeder)
+        if [ `uname` = "Darwin" ]
+        then
+          travis_retry curl -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin
+        else
+          travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
+        fi
+      ;;
+    cabal)
+      ;;
+    esac
 
 script:
- - if [ "${RUNTEST}" != "0" ]; then cabal configure --enable-tests -v2; else cabal configure -v2; fi
+- |
- - cabal build
+  set -ex
- - if [ "${RUNTEST}" != "0" ]; then cabal test; fi;
+  if [ "x${RUNTEST}" = "xfalse" ]; then exit 0; fi
- - cabal check
+  case "$BUILD" in
- - cabal sdist
+    stack)
- - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;
+      # create the build stack.yaml
-   cd dist/;
+      case "$RESOLVER" in
-   if [ -f "$SRC_TGZ" ]; then
+      ghc-8.0)
-      cabal install --force-reinstalls "$SRC_TGZ";
+        echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18, gauge-0.2.1 ], flags: {} }" > stack.yaml
-   else
+        stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps
-      echo "expected '$SRC_TGZ' not found";
+        ;;
-      exit 1;
+      ghc-8.2)
-   fi
+        echo "{ resolver: lts-11.22, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18 ], flags: {} }" > stack.yaml
+        stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps
+        ;;
+      ghc-8.4)
+        echo "{ resolver: lts-12.26, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml
+        stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps
+        ;;
+      ghc-8.6)
+        echo "{ resolver: lts-14.27, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml
+        stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps
+        ;;
+      ghc-8.8)
+        echo "{ resolver: lts-15.1, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml
+        stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps
+        ;;
+      esac
+      ;;
+    hlint)
+      curl -sL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s . --cpp-define=__GLASGOW_HASKELL__=800 --cpp-define=x86_64_HOST_ARCH=1 --cpp-define=mingw32_HOST_OS=1
+      ;;
+    weeder)
+      stack --no-terminal build --install-ghc --ghc-options="-ddump-to-file -ddump-hi" --test --no-run-tests --bench --no-run-benchmarks
+      curl -sL https://raw.github.com/ndmitchell/weeder/master/misc/travis.sh | sh -s .
+      ;;
+  esac
+  set +ex
+

CHANGELOG.md

@@ -1,3 +1,115 @@
+## 0.30
+
+* Fix some C symbol blake2b prefix to be cryptonite_ prefix (fix mixing with other C library)
+* add hmac-lazy
+* Fix compilation with GHC 9.2
+* Drop support for GHC8.0, GHC8.2, GHC8.4, GHC8.6
+
+## 0.29
+
+* advance compilation with gmp breakage due to change upstream
+* Add native EdDSA support
+
+## 0.28
+
+* Add hash constant time capability
+* Prevent possible overflow during hashing by hashing in 4GB chunks
+
+## 0.27
+
+* Optimise AES GCM and CCM
+* Optimise P256R1 implementation
+* Various AES-NI building improvements
+* Add better ECDSA support
+* Add XSalsa derive
+* Implement square roots for ECC binary curve
+* Various tests and benchmarks
+
+## 0.26
+
+* Add Rabin cryptosystem (and variants)
+* Add bcrypt_pbkdf key derivation function
+* Optimize Blowfish implementation
+* Add KMAC (Keccak Message Authentication Code)
+* Add ECDSA sign/verify digest APIs
+* Hash algorithms with runtime output length
+* Update blake2 to latest upstream version
+* RSA-PSS with arbitrary key size
+* SHAKE with output length not divisible by 8
+* Add Read and Data instances for Digest type
+* Improve P256 scalar primitives
+* Fix hash truncation bug in DSA
+* Fix cost parsing for bcrypt
+* Fix ECC failures on arm64
+* Correction to PKCS#1 v1.5 padding
+* Use powModSecInteger when available
+* Drop GHC 7.8 and GHC 7.10 support, refer to pkg-guidelines
+* Optimise GCM mode
+* Add little endian serialization of integer
+
+## 0.25
+
+* Improve digest binary conversion efficiency
+* AES CCM support
+* Add MonadFailure instance for CryptoFailable
+* Various misc improvements on documentation
+* Edwards25519 lowlevel arithmetic support
+* P256 add point negation
+* Improvement in ECC (benchmark, better normalization)
+* Blake2 improvements to context size
+* Use gauge instead of criterion
+* Use haskell-ci for CI scripts
+* Improve Digest memory representation to be 2 less Ints and one less boxing
+  moving from `UArray` to `Block`
+
+## 0.24
+
+* Ed25519: generateSecret & Documentation updates
+* Repair tutorial
+* RSA: Allow signing digest directly
+* IV add: fix overflow behavior
+* P256: validate point when decoding
+* Compilation fix with deepseq disabled
+* Improve Curve448 and use decaf for Ed448
+* Compilation flag blake2 sse merged in sse support
+* Process unaligned data better in hashes and AES, on architecture needing alignment
+* Drop support for ghc 7.6
+* Add ability to create random generator Seed from binary data and
+  loosen constraint on ChaChaDRG seed from ByteArray to ByteArrayAccess.
+* Add 3 associated types with the HashAlgorithm class, to get
+  access to the constant for BlockSize, DigestSize and ContextSize at the type level.
+  the related function that this replaced will be deprecated in later release, and
+  eventually removed.
+
+API CHANGES:
+
+* Improve ECDH safety to return failure for bad inputs (e.g. public point in small order subgroup).
+  To go back to previous behavior you can replace `ecdh` by `ecdhRaw`. It's recommended to
+  use `ecdh` and handle the error appropriately.
+* Users defining their own HashAlgorithm needs to define the
+  HashBlockSize, HashDigest, HashInternalContextSize associated types
+
+## 0.23
+
+* Digest memory usage improvement by using unpinned memory
+* Fix generateBetween to generate within the right bounds
+* Add pure Twofish implementation
+* Fix memory allocation in P256 when using a temp point
+* Consolidate hash benchmark code
+* Add Nat-length Blake2 support (GHC > 8.0)
+* Update tutorial
+
+## 0.22
+
+* Add Argon2 (Password Hashing Competition winner) hash function
+* Update blake2 to latest upstream version
+* Add extra blake2 hashing size
+* Add faster PBKDF2 functions for SHA1/SHA256/SHA512
+* Add SHAKE128 and SHAKE256
+* Cleanup prime generation, and add tests
+* Add Time-based One Time Password (TOTP) and HMAC-based One Time Password (HOTP)
+* Rename Ed448 module name to Curve448, old module name still valid for now
+
 ## 0.21
 
 * Drop automated tests with GHC 7.0, GHC 7.4, GHC 7.6. support dropped, but probably still working.

Crypto/Cipher/AES.hs

@@ -14,12 +14,11 @@ module Crypto.Cipher.AES
 
 import Crypto.Error
 import Crypto.Cipher.Types
+import Crypto.Cipher.Utils
 import Crypto.Cipher.Types.Block
 import Crypto.Cipher.AES.Primitive
 import Crypto.Internal.Imports
 
-import Data.ByteArray as BA
-
 -- | AES with 128 bit key
 newtype AES128 = AES128 AES
     deriving (NFData)
@@ -47,15 +46,6 @@ instance Cipher AES256 where
     cipherKeySize _ = KeySizeFixed 32
     cipherInit k    = AES256 <$> (initAES =<< validateKeySize (undefined :: AES256) k)
 
-validateKeySize :: (ByteArrayAccess key, Cipher cipher) => cipher -> key -> CryptoFailable key
-validateKeySize c k = if validKeyLength
-                      then CryptoPassed k
-                      else CryptoFailed CryptoError_KeySizeInvalid
-  where keyLength = BA.length k
-        validKeyLength = case cipherKeySize c of
-          KeySizeRange low high -> keyLength >= low && keyLength <= high
-          KeySizeEnum lengths -> keyLength `elem` lengths
-          KeySizeFixed s -> keyLength == s
 
 #define INSTANCE_BLOCKCIPHER(CSTR) \
 instance BlockCipher CSTR where \
@@ -67,6 +57,7 @@ instance BlockCipher CSTR where \
     ; ctrCombine (CSTR aes) (IV iv) = encryptCTR aes (IV iv) \
     ; aeadInit AEAD_GCM (CSTR aes) iv = CryptoPassed $ AEAD (gcmMode aes) (gcmInit aes iv) \
     ; aeadInit AEAD_OCB (CSTR aes) iv = CryptoPassed $ AEAD (ocbMode aes) (ocbInit aes iv) \
+    ; aeadInit (AEAD_CCM n m l) (CSTR aes) iv = AEAD (ccmMode aes) <$> ccmInit aes iv n m l \
     ; aeadInit _        _          _  = CryptoFailed CryptoError_AEADModeNotSupported \
     }; \
 instance BlockCipher128 CSTR where \

Crypto/Cipher/AES/Primitive.hs

@@ -11,39 +11,46 @@
 --
 module Crypto.Cipher.AES.Primitive
     (
-    -- * block cipher data types
+    -- * Block cipher data types
       AES
 
     -- * Authenticated encryption block cipher types
     , AESGCM
     , AESOCB
 
-    -- * creation
+    -- * Creation
     , initAES
 
-    -- * misc
+    -- * Miscellanea
     , genCTR
     , genCounter
 
-    -- * encryption
+    -- * Encryption
     , encryptECB
     , encryptCBC
     , encryptCTR
     , encryptXTS
 
-    -- * decryption
+    -- * Decryption
     , decryptECB
     , decryptCBC
     , decryptCTR
     , decryptXTS
 
-    -- * incremental GCM
+    -- * CTR with 32-bit wrapping
+    , combineC32
+
+    -- * Incremental GCM
     , gcmMode
     , gcmInit
 
-    -- * incremental OCB
+    -- * Incremental OCB
     , ocbMode
     , ocbInit
+
+    -- * CCM
+    , ccmMode
+    , ccmInit
     ) where
 
 import           Data.Word
@@ -73,6 +80,7 @@ instance BlockCipher AES where
     ctrCombine = encryptCTR
     aeadInit AEAD_GCM aes iv = CryptoPassed $ AEAD (gcmMode aes) (gcmInit aes iv)
     aeadInit AEAD_OCB aes iv = CryptoPassed $ AEAD (ocbMode aes) (ocbInit aes iv)
+    aeadInit (AEAD_CCM n m l) aes iv = AEAD (ccmMode aes) <$> ccmInit aes iv n m l
     aeadInit _        _   _  = CryptoFailed CryptoError_AEADModeNotSupported
 instance BlockCipher128 AES where
     xtsEncrypt = encryptXTS
@@ -96,6 +104,15 @@ ocbMode aes = AEADModeImpl
     , aeadImplFinalize     = ocbFinish aes
     }
 
+-- | Create an AES AEAD implementation for CCM
+ccmMode :: AES -> AEADModeImpl AESCCM
+ccmMode aes = AEADModeImpl
+    { aeadImplAppendHeader = ccmAppendAAD aes
+    , aeadImplEncrypt      = ccmEncrypt aes
+    , aeadImplDecrypt      = ccmDecrypt aes
+    , aeadImplFinalize     = ccmFinish aes
+    }
+
 
 -- | AES Context (pre-processed key)
 newtype AES = AES ScrubbedBytes
@@ -109,12 +126,19 @@ newtype AESGCM = AESGCM ScrubbedBytes
 newtype AESOCB = AESOCB ScrubbedBytes
     deriving (NFData)
 
+-- | AESCCM State
+newtype AESCCM = AESCCM ScrubbedBytes
+    deriving (NFData)
+
 sizeGCM :: Int
-sizeGCM = 80
+sizeGCM = 320
 
 sizeOCB :: Int
 sizeOCB = 160
 
+sizeCCM :: Int
+sizeCCM = 80
+
 keyToPtr :: AES -> (Ptr AES -> IO a) -> IO a
 keyToPtr (AES b) f = withByteArray b (f . castPtr)
 
@@ -152,6 +176,13 @@ withOCBKeyAndCopySt aes (AESOCB gcmSt) f =
         a     <- withByteArray newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr
         return (a, AESOCB newSt)
 
+withCCMKeyAndCopySt :: AES -> AESCCM -> (Ptr AESCCM -> Ptr AES -> IO a) -> IO (a, AESCCM)
+withCCMKeyAndCopySt aes (AESCCM ccmSt) f =
+    keyToPtr aes $ \aesPtr -> do
+        newSt <- B.copy ccmSt (\_ -> return ())
+        a     <- withByteArray newSt $ \ccmStPtr -> f (castPtr ccmStPtr) aesPtr
+        return (a, AESCCM newSt)
+
 -- | Initialize a new context with a key
 --
 -- Key needs to be of length 16, 24 or 32 bytes. Any other values will return failure
@@ -289,6 +320,21 @@ decryptXTS :: ByteArray ba
            -> ba         -- ^ output decrypted
 decryptXTS = doXTS c_aes_decrypt_xts
 
+-- | encrypt/decrypt using Counter mode (32-bit wrapping used in AES-GCM-SIV)
+{-# NOINLINE combineC32 #-}
+combineC32 :: ByteArray ba
+           => AES        -- ^ AES Context
+           -> IV AES     -- ^ initial vector of AES block size (usually representing a 128 bit integer)
+           -> ba         -- ^ plaintext input
+           -> ba         -- ^ ciphertext output
+combineC32 ctx iv input
+    | len <= 0          = B.empty
+    | B.length iv /= 16 = error $ "AES error: IV length must be block size (16). Its length is: " ++ show (B.length iv)
+    | otherwise = B.allocAndFreeze len doEncrypt
+  where doEncrypt o = withKeyAndIV ctx iv $ \k v -> withByteArray input $ \i ->
+                      c_aes_encrypt_c32 (castPtr o) k v i (fromIntegral len)
+        len = B.length input
+
 {-# INLINE doECB #-}
 doECB :: ByteArray ba
       => (Ptr b -> Ptr AES -> CString -> CUInt -> IO ())
@@ -447,6 +493,78 @@ ocbFinish ctx ocb taglen = AuthTag $ B.take taglen computeTag
   where computeTag = B.allocAndFreeze 16 $ \t ->
                         withOCBKeyAndCopySt ctx ocb (c_aes_ocb_finish (castPtr t)) >> return ()
 
+ccmGetM :: CCM_M -> Int
+ccmGetL :: CCM_L -> Int
+ccmGetM m = case m of
+  CCM_M4 -> 4
+  CCM_M6 -> 6
+  CCM_M8 -> 8
+  CCM_M10 -> 10
+  CCM_M12 -> 12
+  CCM_M14 -> 14
+  CCM_M16 -> 16
+
+ccmGetL l = case l of
+  CCM_L2 -> 2
+  CCM_L3 -> 3
+  CCM_L4 -> 4
+
+-- | initialize a ccm context
+{-# NOINLINE ccmInit #-}
+ccmInit :: ByteArrayAccess iv => AES -> iv -> Int -> CCM_M -> CCM_L -> CryptoFailable AESCCM
+ccmInit ctx iv n m l
+    | 15 - li /= B.length iv = CryptoFailed CryptoError_IvSizeInvalid
+    | otherwise = unsafeDoIO $ do
+          sm <- B.alloc sizeCCM $ \ccmStPtr ->
+            withKeyAndIV ctx iv $ \k v ->
+            c_aes_ccm_init (castPtr ccmStPtr) k v (fromIntegral $ B.length iv) (fromIntegral n) (fromIntegral mi) (fromIntegral li)
+          return $ CryptoPassed (AESCCM sm)
+  where
+    mi = ccmGetM m
+    li = ccmGetL l
+
+-- | append data which is only going to be authenticated to the CCM context.
+--
+-- needs to happen after initialization and before appending encryption/decryption data.
+{-# NOINLINE ccmAppendAAD #-}
+ccmAppendAAD :: ByteArrayAccess aad => AES -> AESCCM -> aad -> AESCCM
+ccmAppendAAD ctx ccm input = unsafeDoIO $ snd <$> withCCMKeyAndCopySt ctx ccm doAppend
+  where doAppend ccmStPtr aesPtr =
+            withByteArray input $ \i -> c_aes_ccm_aad ccmStPtr aesPtr i (fromIntegral $ B.length input)
+
+-- | append data to encrypt and append to the CCM context
+--
+-- the bytearray needs to be a multiple of AES block size, unless it's the last call to this function.
+-- needs to happen after AAD appending, or after initialization if no AAD data.
+{-# NOINLINE ccmEncrypt #-}
+ccmEncrypt :: ByteArray ba => AES -> AESCCM -> ba -> (ba, AESCCM)
+ccmEncrypt ctx ccm input = unsafeDoIO $ withCCMKeyAndCopySt ctx ccm cbcmacAndIv
+  where len = B.length input
+        cbcmacAndIv ccmStPtr aesPtr =
+            B.alloc len $ \o ->
+            withByteArray input $ \i ->
+            c_aes_ccm_encrypt (castPtr o) ccmStPtr aesPtr i (fromIntegral len)
+
+-- | append data to decrypt and append to the CCM context
+--
+-- the bytearray needs to be a multiple of AES block size, unless it's the last call to this function.
+-- needs to happen after AAD appending, or after initialization if no AAD data.
+{-# NOINLINE ccmDecrypt #-}
+ccmDecrypt :: ByteArray ba => AES -> AESCCM -> ba -> (ba, AESCCM)
+ccmDecrypt ctx ccm input = unsafeDoIO $ withCCMKeyAndCopySt ctx ccm cbcmacAndIv
+  where len = B.length input
+        cbcmacAndIv ccmStPtr aesPtr =
+            B.alloc len $ \o ->
+            withByteArray input $ \i ->
+            c_aes_ccm_decrypt (castPtr o) ccmStPtr aesPtr i (fromIntegral len)
+
+-- | Generate the Tag from CCM context
+{-# NOINLINE ccmFinish #-}
+ccmFinish :: AES -> AESCCM -> Int -> AuthTag
+ccmFinish ctx ccm taglen = AuthTag $ B.take taglen computeTag
+  where computeTag = B.allocAndFreeze 16 $ \t ->
+                        withCCMKeyAndCopySt ctx ccm (c_aes_ccm_finish (castPtr t)) >> return ()
+
 ------------------------------------------------------------------------
 foreign import ccall "cryptonite_aes.h cryptonite_aes_initkey"
     c_aes_init :: Ptr AES -> CString -> CUInt -> IO ()
@@ -478,6 +596,9 @@ foreign import ccall unsafe "cryptonite_aes.h cryptonite_aes_gen_ctr_cont"
 foreign import ccall "cryptonite_aes.h cryptonite_aes_encrypt_ctr"
     c_aes_encrypt_ctr :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()
 
+foreign import ccall "cryptonite_aes.h cryptonite_aes_encrypt_c32"
+    c_aes_encrypt_c32 :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()
+
 foreign import ccall "cryptonite_aes.h cryptonite_aes_gcm_init"
     c_aes_gcm_init :: Ptr AESGCM -> Ptr AES -> Ptr Word8 -> CUInt -> IO ()
 
@@ -508,3 +629,17 @@ foreign import ccall "cryptonite_aes.h cryptonite_aes_ocb_decrypt"
 foreign import ccall "cryptonite_aes.h cryptonite_aes_ocb_finish"
     c_aes_ocb_finish :: CString -> Ptr AESOCB -> Ptr AES -> IO ()
 
+foreign import ccall "cryptonite_aes.h cryptonite_aes_ccm_init"
+    c_aes_ccm_init :: Ptr AESCCM -> Ptr AES -> Ptr Word8 -> CUInt -> CUInt -> CInt -> CInt -> IO ()
+
+foreign import ccall "cryptonite_aes.h cryptonite_aes_ccm_aad"
+    c_aes_ccm_aad :: Ptr AESCCM -> Ptr AES -> CString -> CUInt -> IO ()
+
+foreign import ccall "cryptonite_aes.h cryptonite_aes_ccm_encrypt"
+    c_aes_ccm_encrypt :: CString -> Ptr AESCCM -> Ptr AES -> CString -> CUInt -> IO ()
+
+foreign import ccall "cryptonite_aes.h cryptonite_aes_ccm_decrypt"
+    c_aes_ccm_decrypt :: CString -> Ptr AESCCM -> Ptr AES -> CString -> CUInt -> IO ()
+
+foreign import ccall "cryptonite_aes.h cryptonite_aes_ccm_finish"
+    c_aes_ccm_finish :: CString -> Ptr AESCCM -> Ptr AES -> IO ()

Crypto/Cipher/AESGCMSIV.hs

@@ -0,0 +1,193 @@
+-- |
+-- Module      : Crypto.Cipher.AESGCMSIV
+-- License     : BSD-style
+-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Implementation of AES-GCM-SIV, an AEAD scheme with nonce misuse resistance
+-- defined in <https://tools.ietf.org/html/rfc8452 RFC 8452>.
+--
+-- To achieve the nonce misuse-resistance property, encryption requires two
+-- passes on the plaintext, hence no streaming API is provided.  This AEAD
+-- operates on complete inputs held in memory.  For simplicity, the
+-- implementation of decryption uses a similar pattern, with performance
+-- penalty compared to an implementation which is able to merge both passes.
+--
+-- The specification allows inputs up to 2^36 bytes but this implementation
+-- requires AAD and plaintext/ciphertext to be both smaller than 2^32 bytes.
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Crypto.Cipher.AESGCMSIV
+    ( Nonce
+    , nonce
+    , generateNonce
+    , encrypt
+    , decrypt
+    ) where
+
+import Data.Bits
+import Data.Word
+
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Ptr (Ptr, plusPtr)
+import Foreign.Storable (peekElemOff, poke, pokeElemOff)
+
+import           Data.ByteArray
+import qualified Data.ByteArray as B
+import           Data.Memory.Endian (toLE)
+import           Data.Memory.PtrMethods (memXor)
+
+import Crypto.Cipher.AES.Primitive
+import Crypto.Cipher.Types
+import Crypto.Error
+import Crypto.Internal.Compat (unsafeDoIO)
+import Crypto.Random
+
+
+-- 12-byte nonces
+
+-- | Nonce value for AES-GCM-SIV, always 12 bytes.
+newtype Nonce = Nonce Bytes deriving (Show, Eq, ByteArrayAccess)
+
+-- | Nonce smart constructor.  Accepts only 12-byte inputs.
+nonce :: ByteArrayAccess iv => iv -> CryptoFailable Nonce
+nonce iv
+    | B.length iv == 12 = CryptoPassed (Nonce $ B.convert iv)
+    | otherwise         = CryptoFailed CryptoError_IvSizeInvalid
+
+-- | Generate a random nonce for use with AES-GCM-SIV.
+generateNonce :: MonadRandom m => m Nonce
+generateNonce = Nonce <$> getRandomBytes 12
+
+
+-- POLYVAL (mutable context)
+
+newtype Polyval = Polyval Bytes
+
+polyvalInit :: ScrubbedBytes -> IO Polyval
+polyvalInit h = Polyval <$> doInit
+  where doInit = B.alloc 272 $ \pctx -> B.withByteArray h $ \ph ->
+            c_aes_polyval_init pctx ph
+
+polyvalUpdate :: ByteArrayAccess ba => Polyval -> ba -> IO ()
+polyvalUpdate (Polyval ctx) bs = B.withByteArray ctx $ \pctx ->
+    B.withByteArray bs $ \pbs -> c_aes_polyval_update pctx pbs sz
+  where sz = fromIntegral (B.length bs)
+
+polyvalFinalize :: Polyval -> IO ScrubbedBytes
+polyvalFinalize (Polyval ctx) = B.alloc 16 $ \dst ->
+    B.withByteArray ctx $ \pctx -> c_aes_polyval_finalize pctx dst
+
+foreign import ccall unsafe "cryptonite_aes.h cryptonite_aes_polyval_init"
+    c_aes_polyval_init :: Ptr Polyval -> CString -> IO ()
+
+foreign import ccall "cryptonite_aes.h cryptonite_aes_polyval_update"
+    c_aes_polyval_update :: Ptr Polyval -> CString -> CUInt -> IO ()
+
+foreign import ccall unsafe "cryptonite_aes.h cryptonite_aes_polyval_finalize"
+    c_aes_polyval_finalize :: Ptr Polyval -> CString -> IO ()
+
+
+-- Key Generation
+
+le32iv :: Word32 -> Nonce -> Bytes
+le32iv n (Nonce iv) = B.allocAndFreeze 16 $ \ptr -> do
+    poke ptr (toLE n)
+    copyByteArrayToPtr iv (ptr `plusPtr` 4)
+
+deriveKeys :: BlockCipher128 aes => aes -> Nonce -> (ScrubbedBytes, AES)
+deriveKeys aes iv =
+    case cipherKeySize aes of
+        KeySizeFixed sz | sz `mod` 8 == 0 ->
+            let mak = buildKey [0 .. 1]
+                key = buildKey [2 .. fromIntegral (sz `div` 8) + 1]
+                mek = throwCryptoError (cipherInit key)
+             in (mak, mek)
+        _ -> error "AESGCMSIV: invalid cipher"
+  where
+    idx n = ecbEncrypt aes (le32iv n iv) `takeView` 8
+    buildKey = B.concat . map idx
+
+
+-- Encryption and decryption
+
+lengthInvalid :: ByteArrayAccess ba => ba -> Bool
+lengthInvalid bs
+    | finiteBitSize len > 32 = len >= 1 `unsafeShiftL` 32
+    | otherwise              = False
+  where len = B.length bs
+
+-- | AEAD encryption with the specified key and nonce.  The key must be given
+-- as an initialized 'Crypto.Cipher.AES.AES128' or 'Crypto.Cipher.AES.AES256'
+-- cipher.
+--
+-- Lengths of additional data and plaintext must be less than 2^32 bytes,
+-- otherwise an exception is thrown.
+encrypt :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba)
+        => aes -> Nonce -> aad -> ba -> (AuthTag, ba)
+encrypt aes iv aad plaintext
+    | lengthInvalid aad = error "AESGCMSIV: aad is too large"
+    | lengthInvalid plaintext = error "AESGCMSIV: plaintext is too large"
+    | otherwise = (AuthTag tag, ciphertext)
+  where
+    (mak, mek) = deriveKeys aes iv
+    ss = getSs mak aad plaintext
+    tag = buildTag mek ss iv
+    ciphertext = combineC32 mek (transformTag tag) plaintext
+
+-- | AEAD decryption with the specified key and nonce.  The key must be given
+-- as an initialized 'Crypto.Cipher.AES.AES128' or 'Crypto.Cipher.AES.AES256'
+-- cipher.
+--
+-- Lengths of additional data and ciphertext must be less than 2^32 bytes,
+-- otherwise an exception is thrown.
+decrypt :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba)
+        => aes -> Nonce -> aad -> ba -> AuthTag -> Maybe ba
+decrypt aes iv aad ciphertext (AuthTag tag)
+    | lengthInvalid aad = error "AESGCMSIV: aad is too large"
+    | lengthInvalid ciphertext = error "AESGCMSIV: ciphertext is too large"
+    | tag `constEq` buildTag mek ss iv = Just plaintext
+    | otherwise = Nothing
+  where
+    (mak, mek) = deriveKeys aes iv
+    ss = getSs mak aad plaintext
+    plaintext = combineC32 mek (transformTag tag) ciphertext
+
+-- Calculate S_s = POLYVAL(mak, X_1, X_2, ...).
+getSs :: (ByteArrayAccess aad, ByteArrayAccess ba)
+      => ScrubbedBytes -> aad -> ba -> ScrubbedBytes
+getSs mak aad plaintext = unsafeDoIO $ do
+    ctx <- polyvalInit mak
+    polyvalUpdate ctx aad
+    polyvalUpdate ctx plaintext
+    polyvalUpdate ctx (lb :: Bytes)  -- the "length block"
+    polyvalFinalize ctx
+  where
+    lb = B.allocAndFreeze 16 $ \ptr -> do
+            pokeElemOff ptr 0 (toLE64 $ B.length aad)
+            pokeElemOff ptr 1 (toLE64 $ B.length plaintext)
+    toLE64 x = toLE (fromIntegral x * 8 :: Word64)
+
+-- XOR the first 12 bytes of S_s with the nonce and clear the most significant
+-- bit of the last byte.
+tagInput :: ScrubbedBytes -> Nonce -> Bytes
+tagInput ss (Nonce iv) =
+    B.copyAndFreeze ss $ \ptr ->
+    B.withByteArray iv $ \ivPtr -> do
+        memXor ptr ptr ivPtr 12
+        b <- peekElemOff ptr 15
+        pokeElemOff ptr 15 (b .&. (0x7f :: Word8))
+
+-- Encrypt the result with AES using the message-encryption key to produce the
+-- tag.
+buildTag :: BlockCipher128 aes => aes -> ScrubbedBytes -> Nonce -> Bytes
+buildTag mek ss iv = ecbEncrypt mek (tagInput ss iv)
+
+-- The initial counter block is the tag with the most significant bit of the
+-- last byte set to one.
+transformTag :: Bytes -> IV AES
+transformTag tag = toIV $ B.copyAndFreeze tag $ \ptr ->
+    peekElemOff ptr 15 >>= pokeElemOff ptr 15 . (.|. (0x80 :: Word8))
+  where toIV bs = let Just iv = makeIV (bs :: Bytes) in iv

Crypto/Cipher/Blowfish/Box.hs

@@ -5,15 +5,33 @@
 -- Portability : Good
 {-# LANGUAGE MagicHash #-}
 module Crypto.Cipher.Blowfish.Box
-    ( createKeySchedule
+    (   KeySchedule(..)
+    ,   createKeySchedule
+    ,   copyKeySchedule
     ) where
 
-import Crypto.Internal.WordArray (mutableArray32FromAddrBE, MutableArray32)
+import           Crypto.Internal.WordArray (MutableArray32,
+                                            mutableArray32FromAddrBE,
+                                            mutableArrayRead32,
+                                            mutableArrayWrite32)
+
+newtype KeySchedule = KeySchedule MutableArray32
+
+-- | Copy the state of one key schedule into the other.
+--   The first parameter is the destination and the second the source.
+copyKeySchedule :: KeySchedule -> KeySchedule -> IO ()
+copyKeySchedule (KeySchedule dst) (KeySchedule src) = loop 0
+  where
+    loop 1042 = return ()
+    loop i    = do
+        w32 <-mutableArrayRead32 src i
+        mutableArrayWrite32 dst i w32
+        loop (i + 1)
 
 -- | Create a key schedule mutable array of the pbox followed by
 -- all the sboxes.
-createKeySchedule :: IO MutableArray32
+createKeySchedule :: IO KeySchedule
-createKeySchedule = mutableArray32FromAddrBE 1042 "\
+createKeySchedule = KeySchedule `fmap` mutableArray32FromAddrBE 1042 "\
     \\x24\x3f\x6a\x88\x85\xa3\x08\xd3\x13\x19\x8a\x2e\x03\x70\x73\x44\
     \\xa4\x09\x38\x22\x29\x9f\x31\xd0\x08\x2e\xfa\x98\xec\x4e\x6c\x89\
     \\x45\x28\x21\xe6\x38\xd0\x13\x77\xbe\x54\x66\xcf\x34\xe9\x0c\x6c\

Crypto/Cipher/Blowfish/Primitive.hs

@@ -5,197 +5,254 @@
 -- Portability : Good
 
 -- Rewritten by Vincent Hanquez (c) 2015
+--              Lars Petersen (c) 2018
 --
 -- Original code:
 --      Crypto.Cipher.Blowfish.Primitive, copyright (c) 2012 Stijn van Drongelen
 --      based on: BlowfishAux.hs (C) 2002 HardCore SoftWare, Doug Hoyte
 --           (as found in Crypto-4.2.4)
-
+{-# LANGUAGE BangPatterns #-}
 module Crypto.Cipher.Blowfish.Primitive
     ( Context
     , initBlowfish
     , encrypt
     , decrypt
-    , eksBlowfish
+    , KeySchedule
+    , createKeySchedule
+    , freezeKeySchedule
+    , expandKey
+    , expandKeyWithSalt
+    , cipherBlockMutable
     ) where
 
-import           Control.Monad (when)
+import           Control.Monad              (when)
 import           Data.Bits
 import           Data.Memory.Endian
 import           Data.Word
 
+import           Crypto.Cipher.Blowfish.Box
 import           Crypto.Error
+import           Crypto.Internal.ByteArray  (ByteArray, ByteArrayAccess)
+import qualified Crypto.Internal.ByteArray  as B
 import           Crypto.Internal.Compat
 import           Crypto.Internal.Imports
-import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)
-import qualified Crypto.Internal.ByteArray as B
-import           Crypto.Internal.Words
 import           Crypto.Internal.WordArray
-import           Crypto.Cipher.Blowfish.Box
 
--- | variable keyed blowfish state
+newtype Context = Context Array32
-data Context = BF (Int -> Word32) -- p
-                  (Int -> Word32) -- sbox0
-                  (Int -> Word32) -- sbox1
-                  (Int -> Word32) -- sbox2
-                  (Int -> Word32) -- sbox2
 
 instance NFData Context where
-    rnf (BF p a b c d) = p `seq` a `seq` b `seq` c `seq` d `seq` ()
+    rnf a = a `seq` ()
-
--- | Encrypt blocks
---
--- Input need to be a multiple of 8 bytes
-encrypt :: ByteArray ba => Context -> ba -> ba
-encrypt = cipher
-
--- | Decrypt blocks
---
--- Input need to be a multiple of 8 bytes
-decrypt :: ByteArray ba => Context -> ba -> ba
-decrypt = cipher . decryptContext
-
-decryptContext :: Context -> Context
-decryptContext (BF p s0 s1 s2 s3) = BF (\i -> p (17-i)) s0 s1 s2 s3
-
-cipher :: ByteArray ba => Context -> ba -> ba
-cipher ctx b
-    | B.length b == 0         = B.empty
-    | B.length b `mod` 8 /= 0 = error "invalid data length"
-    | otherwise               = B.mapAsWord64 (coreCrypto ctx) b
 
 -- | Initialize a new Blowfish context from a key.
 --
 -- key needs to be between 0 and 448 bits.
 initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context
 initBlowfish key
-    | len > (448 `div` 8) = CryptoFailed CryptoError_KeySizeInvalid
+    | B.length key > (448 `div` 8) = CryptoFailed CryptoError_KeySizeInvalid
-    | otherwise           = CryptoPassed $ makeKeySchedule key (Nothing :: Maybe (Bytes, Int))
+    | otherwise                    = CryptoPassed $ unsafeDoIO $ do
-  where len = B.length key
+        ks <- createKeySchedule
+        expandKey ks key
+        freezeKeySchedule ks
 
--- | The BCrypt "expensive key schedule" version of blowfish.
+-- | Get an immutable Blowfish context by freezing a mutable key schedule.
+freezeKeySchedule :: KeySchedule -> IO Context
+freezeKeySchedule (KeySchedule ma) = Context `fmap` mutableArray32Freeze ma
+
+expandKey :: (ByteArrayAccess key) => KeySchedule -> key -> IO ()
+expandKey ks@(KeySchedule ma) key = do
+    when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do
+        mutableArrayWriteXor32 ma i l
+        mutableArrayWriteXor32 ma (i + 1) r
+        when (i + 2 < 18) (cont a0 a1)
+    loop 0 0 0
+    where
+        loop i l r = do
+            n <- cipherBlockMutable ks (fromIntegral l `shiftL` 32 .|. fromIntegral r)
+            let nl = fromIntegral (n `shiftR` 32)
+                nr = fromIntegral (n .&. 0xffffffff)
+            mutableArrayWrite32 ma i nl
+            mutableArrayWrite32 ma (i + 1) nr
+            when (i < 18 + 1024) (loop (i + 2) nl nr)
+
+expandKeyWithSalt :: (ByteArrayAccess key, ByteArrayAccess salt)
+    => KeySchedule
+    -> key
+    -> salt
+    -> IO ()
+expandKeyWithSalt ks key salt
+    | B.length salt == 16 = expandKeyWithSalt128 ks key (fromBE $ B.toW64BE salt 0) (fromBE $ B.toW64BE salt 8)
+    | otherwise           = expandKeyWithSaltAny ks key salt
+
+expandKeyWithSaltAny :: (ByteArrayAccess key, ByteArrayAccess salt)
+    => KeySchedule         -- ^ The key schedule
+    -> key                 -- ^ The key
+    -> salt                -- ^ The salt
+    -> IO ()
+expandKeyWithSaltAny ks@(KeySchedule ma) key salt = do
+    when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do
+        mutableArrayWriteXor32 ma i l
+        mutableArrayWriteXor32 ma (i + 1) r
+        when (i + 2 < 18) (cont a0 a1)
+    -- Go through the entire key schedule overwriting the P-Array and S-Boxes
+    when (B.length salt > 0) $ iterKeyStream salt 0 0 $ \i l r a0 a1 cont-> do
+        let l' = xor l a0
+        let r' = xor r a1
+        n <- cipherBlockMutable ks (fromIntegral l' `shiftL` 32 .|. fromIntegral r')
+        let nl = fromIntegral (n `shiftR` 32)
+            nr = fromIntegral (n .&. 0xffffffff)
+        mutableArrayWrite32 ma i nl
+        mutableArrayWrite32 ma (i + 1) nr
+        when (i + 2 < 18 + 1024) (cont nl nr)
+
+expandKeyWithSalt128 :: ByteArrayAccess ba
+    => KeySchedule         -- ^ The key schedule
+    -> ba                  -- ^ The key
+    -> Word64              -- ^ First word of the salt
+    -> Word64              -- ^ Second word of the salt
+    -> IO ()
+expandKeyWithSalt128 ks@(KeySchedule ma) key salt1 salt2 = do
+    when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do
+        mutableArrayWriteXor32 ma i l
+        mutableArrayWriteXor32 ma (i + 1) r
+        when (i + 2 < 18) (cont a0 a1)
+    -- Go through the entire key schedule overwriting the P-Array and S-Boxes
+    loop 0 salt1 salt1 salt2
+    where
+        loop i input slt1 slt2
+            | i == 1042   = return ()
+            | otherwise = do
+                n <- cipherBlockMutable ks input
+                let nl = fromIntegral (n `shiftR` 32)
+                    nr = fromIntegral (n .&. 0xffffffff)
+                mutableArrayWrite32 ma i     nl
+                mutableArrayWrite32 ma (i+1) nr
+                loop (i+2) (n `xor` slt2) slt2 slt1
+
+-- | Encrypt blocks
 --
--- Salt must be 128 bits
+-- Input need to be a multiple of 8 bytes
--- Cost must be between 4 and 31 inclusive
+encrypt :: ByteArray ba => Context -> ba -> ba
--- See <https://www.usenix.org/conference/1999-usenix-annual-technical-conference/future-adaptable-password-scheme>
+encrypt ctx ba
-eksBlowfish :: (ByteArrayAccess salt, ByteArrayAccess password) => Int -> salt -> password -> Context
+    | B.length ba == 0         = B.empty
-eksBlowfish cost salt key
+    | B.length ba `mod` 8 /= 0 = error "invalid data length"
-    | B.length salt /= 16 = error "bcrypt salt must be 16 bytes"
+    | otherwise                = B.mapAsWord64 (cipherBlock ctx False) ba
-    | otherwise           = makeKeySchedule key (Just (salt, cost))
 
-coreCrypto :: Context -> Word64 -> Word64
+-- | Decrypt blocks
-coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0
+--
-  where
+-- Input need to be a multiple of 8 bytes
-    -- transform the input over 16 rounds
+decrypt :: ByteArray ba => Context -> ba -> ba
+decrypt ctx ba
+    | B.length ba == 0         = B.empty
+    | B.length ba `mod` 8 /= 0 = error "invalid data length"
+    | otherwise                = B.mapAsWord64 (cipherBlock ctx True) ba
+
+-- | Encrypt or decrypt a single block of 64 bits.
+--
+-- The inverse argument decides whether to encrypt or decrypt.
+cipherBlock :: Context -> Bool -> Word64 -> Word64
+cipherBlock (Context ar) inverse input = doRound input 0
+    where
+    -- | Transform the input over 16 rounds
     doRound :: Word64 -> Int -> Word64
-    doRound i roundIndex
+    doRound !i roundIndex
         | roundIndex == 16 =
             let final = (fromIntegral (p 16) `shiftL` 32) .|. fromIntegral (p 17)
              in rotateL (i `xor` final) 32
         | otherwise     =
-            let newr = fromIntegral (i `shiftR` 32) `xor` (p roundIndex)
+            let newr = fromIntegral (i `shiftR` 32) `xor` p roundIndex
-                newi = ((i `shiftL` 32) `xor` (f newr)) .|. (fromIntegral newr)
+                newi = ((i `shiftL` 32) `xor` f newr) .|. fromIntegral newr
              in doRound newi (roundIndex+1)
+
+    -- | The Blowfish Feistel function F
     f   :: Word32 -> Word64
-    f t = let a = s0 (fromIntegral $ (t `shiftR` 24) .&. 0xff)
+    f t = let a = s0 (0xff .&. (t `shiftR` 24))
-              b = s1 (fromIntegral $ (t `shiftR` 16) .&. 0xff)
+              b = s1 (0xff .&. (t `shiftR` 16))
-              c = s2 (fromIntegral $ (t `shiftR` 8) .&. 0xff)
+              c = s2 (0xff .&. (t `shiftR` 8))
-              d = s3 (fromIntegral $ t .&. 0xff)
+              d = s3 (0xff .&.  t)
            in fromIntegral (((a + b) `xor` c) + d) `shiftL` 32
 
+    -- | S-Box arrays, each containing 256 32-bit words
+    --   The first 18 words contain the P-Array of subkeys
+    s0, s1, s2, s3 :: Word32 -> Word32
+    s0 i            = arrayRead32 ar (fromIntegral i + 18)
+    s1 i            = arrayRead32 ar (fromIntegral i + 274)
+    s2 i            = arrayRead32 ar (fromIntegral i + 530)
+    s3 i            = arrayRead32 ar (fromIntegral i + 786)
+    p              :: Int -> Word32
+    p i | inverse   = arrayRead32 ar (17 - i)
+        | otherwise = arrayRead32 ar i
 
--- | Create a key schedule for either plain Blowfish or the BCrypt "EKS" version
+-- | Blowfish encrypt a Word using the current state of the key schedule
--- For the expensive version, the salt and cost factor are supplied. Salt must be
+cipherBlockMutable :: KeySchedule -> Word64 -> IO Word64
--- a 128-bit byte array.
+cipherBlockMutable (KeySchedule ma) input = doRound input 0
---
+    where
--- The standard case is just a single key expansion with the salt set to zero.
+    -- | Transform the input over 16 rounds
-makeKeySchedule :: (ByteArrayAccess key, ByteArrayAccess salt) => key-> Maybe (salt, Int) -> Context
+    doRound !i roundIndex
-makeKeySchedule keyBytes saltCost =
+        | roundIndex == 16 = do
-    let v = unsafeDoIO $ do
+            pVal1 <- mutableArrayRead32 ma 16
-              mv <- createKeySchedule
+            pVal2 <- mutableArrayRead32 ma 17
-              case saltCost of
+            let final = (fromIntegral pVal1 `shiftL` 32) .|. fromIntegral pVal2
-                  -- Standard blowfish
+            return $ rotateL (i `xor` final) 32
-                  Nothing -> expandKey mv 0 0 keyBytes
+        | otherwise     = do
-                  -- The expensive case
+            pVal <- mutableArrayRead32 ma roundIndex
-                  Just (s, cost)  -> do
+            let newr = fromIntegral (i `shiftR` 32) `xor` pVal
-                      let (salt1, salt2) = splitSalt s
+            newr' <- f newr
-                      expandKey mv salt1 salt2 keyBytes
+            let newi = ((i `shiftL` 32) `xor` newr') .|. fromIntegral newr
-                      forM_ [1..2^cost :: Int] $ \_ -> do
+            doRound newi (roundIndex+1)
-                          expandKey mv 0 0 keyBytes
-                          expandKey mv 0 0 s
-              mutableArray32Freeze mv
-     in BF (\i -> arrayRead32 v i)
-           (\i -> arrayRead32 v (s0+i))
-           (\i -> arrayRead32 v (s1+i))
-           (\i -> arrayRead32 v (s2+i))
-           (\i -> arrayRead32 v (s3+i))
-  where
-        splitSalt s = (fromBE (B.toW64BE s 0), fromBE (B.toW64BE s 8))
 
-        -- Indices of the S-Box arrays, each containing 256 32-bit words
+    -- | The Blowfish Feistel function F
-        -- The first 18 words contain the P-Array of subkeys
+    f   :: Word32 -> IO Word64
-        s0 = 18
+    f t = do
-        s1 = 274
+        a <- s0 (0xff .&. (t `shiftR` 24))
-        s2 = 530
+        b <- s1 (0xff .&. (t `shiftR` 16))
-        s3 = 786
+        c <- s2 (0xff .&. (t `shiftR` 8))
+        d <- s3 (0xff .&.  t)
+        return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32)
 
-expandKey :: ByteArrayAccess ba
+    -- | S-Box arrays, each containing 256 32-bit words
-          => MutableArray32      -- ^ The key schedule
+    --   The first 18 words contain the P-Array of subkeys
-          -> Word64              -- ^ First word of the salt
+    s0, s1, s2, s3 :: Word32 -> IO Word32
-          -> Word64              -- ^ Second word of the salt
+    s0 i = mutableArrayRead32 ma (fromIntegral i + 18)
-          -> ba                  -- ^ The key
+    s1 i = mutableArrayRead32 ma (fromIntegral i + 274)
-          -> IO ()
+    s2 i = mutableArrayRead32 ma (fromIntegral i + 530)
-expandKey mv salt1 salt2 key = do
+    s3 i = mutableArrayRead32 ma (fromIntegral i + 786)
-    when (len > 0) $ forM_ [0..17] $ \i -> do
-        let a = B.index key ((i * 4 + 0) `mod` len)
-            b = B.index key ((i * 4 + 1) `mod` len)
-            c = B.index key ((i * 4 + 2) `mod` len)
-            d = B.index key ((i * 4 + 3) `mod` len)
-            k = (fromIntegral a `shiftL` 24) .|.
-                (fromIntegral b `shiftL` 16) .|.
-                (fromIntegral c `shiftL`  8) .|.
-                (fromIntegral d)
-        mutableArrayWriteXor32 mv i k
-    prepare mv
-    return ()
-  where
-        len = B.length key
 
-        -- | Go through the entire key schedule overwriting the P-Array and S-Boxes
+iterKeyStream :: (ByteArrayAccess x)
-        prepare mctx = loop 0 salt1 salt1 salt2
+    => x
-          where loop i input slt1 slt2
+    -> Word32
-                  | i == 1042   = return ()
+    -> Word32
-                  | otherwise = do
+    -> (Int -> Word32 -> Word32 -> Word32 -> Word32 -> (Word32 -> Word32 -> IO ()) -> IO ())
-                      ninput <- coreCryptoMutable input
+    -> IO ()
-                      let (nl, nr) = w64to32 ninput
+iterKeyStream x a0 a1 g = f 0 0 a0 a1
-                      mutableArrayWrite32 mctx i     nl
+    where
-                      mutableArrayWrite32 mctx (i+1) nr
+        len          = B.length x
-                      loop (i+2) (ninput `xor` slt2) slt2 slt1
+        -- Avoiding the modulo operation when interating over the ring
-
+        -- buffer is assumed to be more efficient here. All other
-                -- | Blowfish encrypt a Word using the current state of the key schedule
+        -- implementations do this, too. The branch prediction shall prefer
-                coreCryptoMutable :: Word64 -> IO Word64
+        -- the branch with the increment.
-                coreCryptoMutable input = doRound input 0
+        n j          = if j + 1 >= len then 0 else j + 1
-                  where doRound i roundIndex
+        f i j0 b0 b1 = g i l r b0 b1 (f (i + 2) j8)
-                          | roundIndex == 16 = do
+            where
-                              pVal1 <- mutableArrayRead32 mctx 16
+                j1 = n j0
-                              pVal2 <- mutableArrayRead32 mctx 17
+                j2 = n j1
-                              let final = (fromIntegral pVal1 `shiftL` 32) .|. fromIntegral pVal2
+                j3 = n j2
-                              return $ rotateL (i `xor` final) 32
+                j4 = n j3
-                          | otherwise     = do
+                j5 = n j4
-                              pVal <- mutableArrayRead32 mctx roundIndex
+                j6 = n j5
-                              let newr = fromIntegral (i `shiftR` 32) `xor` pVal
+                j7 = n j6
-                              newr' <- f newr
+                j8 = n j7
-                              let newi = ((i `shiftL` 32) `xor` newr') .|. (fromIntegral newr)
+                x0 = fromIntegral (B.index x j0)
-                              doRound newi (roundIndex+1)
+                x1 = fromIntegral (B.index x j1)
-
+                x2 = fromIntegral (B.index x j2)
-                -- The Blowfish Feistel function F
+                x3 = fromIntegral (B.index x j3)
-                f   :: Word32 -> IO Word64
+                x4 = fromIntegral (B.index x j4)
-                f t = do a <- mutableArrayRead32 mctx (s0 + fromIntegral ((t `shiftR` 24) .&. 0xff))
+                x5 = fromIntegral (B.index x j5)
-                         b <- mutableArrayRead32 mctx (s1 + fromIntegral ((t `shiftR` 16) .&. 0xff))
+                x6 = fromIntegral (B.index x j6)
-                         c <- mutableArrayRead32 mctx (s2 + fromIntegral ((t `shiftR` 8) .&. 0xff))
+                x7 = fromIntegral (B.index x j7)
-                         d <- mutableArrayRead32 mctx (s3 + fromIntegral (t .&. 0xff))
+                l  = shiftL x0 24 .|. shiftL x1 16 .|. shiftL x2 8 .|. x3
-                         return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32)
+                r  = shiftL x4 24 .|. shiftL x5 16 .|. shiftL x6 8 .|. x7
-                  where s0 = 18
+{-# INLINE iterKeyStream #-}
-                        s1 = 274
+-- Benchmarking shows that GHC considers this function too big to inline
-                        s2 = 530
+-- although forcing inlining causes an actual improvement.
-                        s3 = 786
+-- It is assumed that all function calls (especially the continuation)
+-- collapse into a tight loop after inlining.

Crypto/Cipher/CAST5.hs

@@ -0,0 +1,43 @@
+-- |
+-- Module      : Crypto.Cipher.CAST5
+-- License     : BSD-style
+-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
+-- Stability   : stable
+-- Portability : good
+--
+module Crypto.Cipher.CAST5
+    ( CAST5
+    ) where
+
+import           Crypto.Error
+import           Crypto.Cipher.Types
+import           Crypto.Cipher.CAST5.Primitive
+import           Crypto.Internal.ByteArray (ByteArrayAccess)
+import qualified Crypto.Internal.ByteArray as B
+
+-- | CAST5 block cipher (also known as CAST-128).  Key is between
+-- 40 and 128 bits.
+newtype CAST5 = CAST5 Key
+
+instance Cipher CAST5 where
+    cipherName    _ = "CAST5"
+    cipherKeySize _ = KeySizeRange 5 16
+    cipherInit      = initCAST5
+
+instance BlockCipher CAST5 where
+    blockSize _ = 8
+    ecbEncrypt (CAST5 k) = B.mapAsWord64 (encrypt k)
+    ecbDecrypt (CAST5 k) = B.mapAsWord64 (decrypt k)
+
+initCAST5 :: ByteArrayAccess key => key -> CryptoFailable CAST5
+initCAST5 bs
+    | len <   5 = CryptoFailed CryptoError_KeySizeInvalid
+    | len <  16 = CryptoPassed (CAST5 $ buildKey short padded)
+    | len == 16 = CryptoPassed (CAST5 $ buildKey False bs)
+    | otherwise = CryptoFailed CryptoError_KeySizeInvalid
+  where
+    len   = B.length bs
+    short = len <= 10
+
+    padded :: B.Bytes
+    padded = B.convert bs `B.append` B.replicate (16 - len) 0

Crypto/Cipher/CAST5/Primitive.hs

@@ -0,0 +1,573 @@
+{-# LANGUAGE MagicHash #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Crypto.Cipher.CAST5.Primitive
+-- License     :  BSD-style
+--
+-- Haskell implementation of the CAST-128 Encryption Algorithm
+--
+-----------------------------------------------------------------------------
+
+
+module Crypto.Cipher.CAST5.Primitive
+    ( encrypt
+    , decrypt
+    , Key()
+    , buildKey
+    ) where
+
+import Control.Monad (void, (>=>))
+
+import Data.Bits
+import Data.Memory.Endian
+import Data.Word
+
+import           Crypto.Internal.ByteArray (ByteArrayAccess)
+import qualified Crypto.Internal.ByteArray as B
+import           Crypto.Internal.WordArray
+
+
+-- Data Types
+
+data P = P {-# UNPACK #-} !Word32 -- left word
+           {-# UNPACK #-} !Word32 -- right word
+
+data Q = Q {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32
+           {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32
+
+-- | All subkeys for 12 or 16 rounds
+data Key = K12 {-# UNPACK #-} !Array32 -- [ km1, kr1, km2, kr2, ..., km12, kr12 ]
+         | K16 {-# UNPACK #-} !Array32 -- [ km1, kr1, km2, kr2, ..., km16, kr16 ]
+
+
+-- Big-endian Transformations
+
+decomp64 :: Word64 -> P
+decomp64 x = P (fromIntegral (x `shiftR` 32)) (fromIntegral x)
+
+comp64 :: P -> Word64
+comp64 (P l r) = (fromIntegral l `shiftL` 32) .|. fromIntegral r
+
+decomp32 :: Word32 -> (Word8, Word8, Word8, Word8)
+decomp32 x =
+    let a = fromIntegral (x `shiftR` 24)
+        b = fromIntegral (x `shiftR` 16)
+        c = fromIntegral (x `shiftR`  8)
+        d = fromIntegral x
+    in (a, b, c, d)
+
+
+-- Encryption
+
+-- | Encrypts a block using the specified key
+encrypt :: Key -> Word64 -> Word64
+encrypt k = comp64 . cast_enc k . decomp64
+
+cast_enc :: Key -> P -> P
+cast_enc (K12 a) (P l0 r0) = P r12 r11
+  where
+    r1  = type1 a 0  l0  r0
+    r2  = type2 a 2  r0  r1
+    r3  = type3 a 4  r1  r2
+    r4  = type1 a 6  r2  r3
+    r5  = type2 a 8  r3  r4
+    r6  = type3 a 10 r4  r5
+    r7  = type1 a 12 r5  r6
+    r8  = type2 a 14 r6  r7
+    r9  = type3 a 16 r7  r8
+    r10 = type1 a 18 r8  r9
+    r11 = type2 a 20 r9  r10
+    r12 = type3 a 22 r10 r11
+
+cast_enc (K16 a) p = P r16 r15
+  where
+    P r12 r11 = cast_enc (K12 a) p
+
+    r13 = type1 a 24 r11 r12
+    r14 = type2 a 26 r12 r13
+    r15 = type3 a 28 r13 r14
+    r16 = type1 a 30 r14 r15
+
+-- Decryption
+
+-- | Decrypts a block using the specified key
+decrypt :: Key -> Word64 -> Word64
+decrypt k = comp64 . cast_dec k . decomp64
+
+cast_dec :: Key -> P -> P
+cast_dec (K12 a) (P r12 r11) = P l0 r0
+  where
+    r10 = type3 a 22 r12 r11
+    r9  = type2 a 20 r11 r10
+    r8  = type1 a 18 r10 r9
+    r7  = type3 a 16 r9  r8
+    r6  = type2 a 14 r8  r7
+    r5  = type1 a 12 r7  r6
+    r4  = type3 a 10 r6  r5
+    r3  = type2 a 8  r5  r4
+    r2  = type1 a 6  r4  r3
+    r1  = type3 a 4  r3  r2
+    r0  = type2 a 2  r2  r1
+    l0  = type1 a 0  r1  r0
+
+cast_dec (K16 a) (P r16 r15) = cast_dec (K12 a) (P r12 r11)
+  where
+    r14 = type1 a 30 r16 r15
+    r13 = type3 a 28 r15 r14
+    r12 = type2 a 26 r14 r13
+    r11 = type1 a 24 r13 r12
+
+
+-- Non-Identical Rounds
+
+type1 :: Array32 -> Int -> Word32 -> Word32 -> Word32
+type1 arr idx l r =
+    let km = arrayRead32 arr idx
+        kr = arrayRead32 arr (idx + 1)
+        j = (km + r) `rotateL` fromIntegral kr
+        (ja, jb, jc, jd) = decomp32 j
+     in l `xor` (((sbox_s1 ja `xor` sbox_s2 jb) - sbox_s3 jc) + sbox_s4 jd)
+
+type2 :: Array32 -> Int -> Word32 -> Word32 -> Word32
+type2 arr idx l r =
+    let km = arrayRead32 arr idx
+        kr = arrayRead32 arr (idx + 1)
+        j = (km `xor` r) `rotateL` fromIntegral kr
+        (ja, jb, jc, jd) = decomp32 j
+     in l `xor` (((sbox_s1 ja - sbox_s2 jb) + sbox_s3 jc) `xor` sbox_s4 jd)
+
+type3 :: Array32 -> Int -> Word32 -> Word32 -> Word32
+type3 arr idx l r =
+    let km = arrayRead32 arr idx
+        kr = arrayRead32 arr (idx + 1)
+        j = (km - r) `rotateL` fromIntegral kr
+        (ja, jb, jc, jd) = decomp32 j
+     in l `xor` (((sbox_s1 ja + sbox_s2 jb) `xor` sbox_s3 jc) - sbox_s4 jd)
+
+
+-- Key Schedule
+
+-- | Precompute "masking" and "rotation" subkeys
+buildKey :: ByteArrayAccess key
+         => Bool -- ^ @True@ for short keys that only need 12 rounds
+         -> key  -- ^ Input key padded to 16 bytes
+         -> Key  -- ^ Output data structure
+buildKey isShort key =
+    let P x0123 x4567 = decomp64 (fromBE $ B.toW64BE key 0)
+        P x89AB xCDEF = decomp64 (fromBE $ B.toW64BE key 8)
+     in keySchedule isShort (Q x0123 x4567 x89AB xCDEF)
+
+keySchedule :: Bool -> Q -> Key
+keySchedule isShort x
+    | isShort   = K12 $ allocArray32AndFreeze 24 $ \ma ->
+        void (steps123 ma 0 x >>= skip4 >>= steps123 ma 1)
+
+    | otherwise = K16 $ allocArray32AndFreeze 32 $ \ma ->
+        void (steps123 ma 0 x >>= step4 ma 24 >>= steps123 ma 1 >>= step4 ma 25)
+
+  where
+    sbox_s56785 a b c d e = sbox_s5 a `xor` sbox_s6 b `xor` sbox_s7 c `xor` sbox_s8 d `xor` sbox_s5 e
+    sbox_s56786 a b c d e = sbox_s5 a `xor` sbox_s6 b `xor` sbox_s7 c `xor` sbox_s8 d `xor` sbox_s6 e
+    sbox_s56787 a b c d e = sbox_s5 a `xor` sbox_s6 b `xor` sbox_s7 c `xor` sbox_s8 d `xor` sbox_s7 e
+    sbox_s56788 a b c d e = sbox_s5 a `xor` sbox_s6 b `xor` sbox_s7 c `xor` sbox_s8 d `xor` sbox_s8 e
+
+    steps123 ma off = step1 ma off >=> step2 ma (off + 8) >=> step3 ma (off + 16)
+
+    step1 :: MutableArray32 -> Int -> Q -> IO Q
+    step1 ma off (Q x0123 x4567 x89AB xCDEF) = do
+        let (x8, x9, xA, xB) = decomp32 x89AB
+            (xC, xD, xE, xF) = decomp32 xCDEF
+
+            z0123 = x0123 `xor` sbox_s56787 xD xF xC xE x8
+            z4567 = x89AB `xor` sbox_s56788 z0 z2 z1 z3 xA
+            z89AB = xCDEF `xor` sbox_s56785 z7 z6 z5 z4 x9
+            zCDEF = x4567 `xor` sbox_s56786 zA z9 zB z8 xB
+
+            (z0, z1, z2, z3) = decomp32 z0123
+            (z4, z5, z6, z7) = decomp32 z4567
+            (z8, z9, zA, zB) = decomp32 z89AB
+            (zC, zD, zE, zF) = decomp32 zCDEF
+
+        mutableArrayWrite32 ma (off + 0) $ sbox_s56785 z8 z9 z7 z6 z2
+        mutableArrayWrite32 ma (off + 2) $ sbox_s56786 zA zB z5 z4 z6
+        mutableArrayWrite32 ma (off + 4) $ sbox_s56787 zC zD z3 z2 z9
+        mutableArrayWrite32 ma (off + 6) $ sbox_s56788 zE zF z1 z0 zC
+        return (Q z0123 z4567 z89AB zCDEF)
+
+    step2 :: MutableArray32 -> Int -> Q -> IO Q
+    step2 ma off (Q z0123 z4567 z89AB zCDEF) = do
+        let (z0, z1, z2, z3) = decomp32 z0123
+            (z4, z5, z6, z7) = decomp32 z4567
+
+            x0123 = z89AB `xor` sbox_s56787 z5 z7 z4 z6 z0
+            x4567 = z0123 `xor` sbox_s56788 x0 x2 x1 x3 z2
+            x89AB = z4567 `xor` sbox_s56785 x7 x6 x5 x4 z1
+            xCDEF = zCDEF `xor` sbox_s56786 xA x9 xB x8 z3
+
+            (x0, x1, x2, x3) = decomp32 x0123
+            (x4, x5, x6, x7) = decomp32 x4567
+            (x8, x9, xA, xB) = decomp32 x89AB
+            (xC, xD, xE, xF) = decomp32 xCDEF
+
+        mutableArrayWrite32 ma (off + 0) $ sbox_s56785 x3 x2 xC xD x8
+        mutableArrayWrite32 ma (off + 2) $ sbox_s56786 x1 x0 xE xF xD
+        mutableArrayWrite32 ma (off + 4) $ sbox_s56787 x7 x6 x8 x9 x3
+        mutableArrayWrite32 ma (off + 6) $ sbox_s56788 x5 x4 xA xB x7
+        return (Q x0123 x4567 x89AB xCDEF)
+
+    step3 :: MutableArray32 -> Int -> Q -> IO Q
+    step3 ma off (Q x0123 x4567 x89AB xCDEF) = do
+        let (x8, x9, xA, xB) = decomp32 x89AB
+            (xC, xD, xE, xF) = decomp32 xCDEF
+
+            z0123 = x0123 `xor` sbox_s56787 xD xF xC xE x8
+            z4567 = x89AB `xor` sbox_s56788 z0 z2 z1 z3 xA
+            z89AB = xCDEF `xor` sbox_s56785 z7 z6 z5 z4 x9
+            zCDEF = x4567 `xor` sbox_s56786 zA z9 zB z8 xB
+
+            (z0, z1, z2, z3) = decomp32 z0123
+            (z4, z5, z6, z7) = decomp32 z4567
+            (z8, z9, zA, zB) = decomp32 z89AB
+            (zC, zD, zE, zF) = decomp32 zCDEF
+
+        mutableArrayWrite32 ma (off + 0) $ sbox_s56785 z3 z2 zC zD z9
+        mutableArrayWrite32 ma (off + 2) $ sbox_s56786 z1 z0 zE zF zC
+        mutableArrayWrite32 ma (off + 4) $ sbox_s56787 z7 z6 z8 z9 z2
+        mutableArrayWrite32 ma (off + 6) $ sbox_s56788 z5 z4 zA zB z6
+        return (Q z0123 z4567 z89AB zCDEF)
+
+    step4 :: MutableArray32 -> Int -> Q -> IO Q
+    step4 ma off (Q z0123 z4567 z89AB zCDEF) = do
+        let (z0, z1, z2, z3) = decomp32 z0123
+            (z4, z5, z6, z7) = decomp32 z4567
+
+            x0123 = z89AB `xor` sbox_s56787 z5 z7 z4 z6 z0
+            x4567 = z0123 `xor` sbox_s56788 x0 x2 x1 x3 z2
+            x89AB = z4567 `xor` sbox_s56785 x7 x6 x5 x4 z1
+            xCDEF = zCDEF `xor` sbox_s56786 xA x9 xB x8 z3
+
+            (x0, x1, x2, x3) = decomp32 x0123
+            (x4, x5, x6, x7) = decomp32 x4567
+            (x8, x9, xA, xB) = decomp32 x89AB
+            (xC, xD, xE, xF) = decomp32 xCDEF
+
+        mutableArrayWrite32 ma (off + 0) $ sbox_s56785 x8 x9 x7 x6 x3
+        mutableArrayWrite32 ma (off + 2) $ sbox_s56786 xA xB x5 x4 x7
+        mutableArrayWrite32 ma (off + 4) $ sbox_s56787 xC xD x3 x2 x8
+        mutableArrayWrite32 ma (off + 6) $ sbox_s56788 xE xF x1 x0 xD
+        return (Q x0123 x4567 x89AB xCDEF)
+
+    skip4 :: Q -> IO Q
+    skip4 (Q z0123 z4567 z89AB zCDEF) = do
+        let (z0, z1, z2, z3) = decomp32 z0123
+            (z4, z5, z6, z7) = decomp32 z4567
+
+            x0123 = z89AB `xor` sbox_s56787 z5 z7 z4 z6 z0
+            x4567 = z0123 `xor` sbox_s56788 x0 x2 x1 x3 z2
+            x89AB = z4567 `xor` sbox_s56785 x7 x6 x5 x4 z1
+            xCDEF = zCDEF `xor` sbox_s56786 xA x9 xB x8 z3
+
+            (x0, x1, x2, x3) = decomp32 x0123
+            (x4, x5, x6, x7) = decomp32 x4567
+            (x8, x9, xA, xB) = decomp32 x89AB
+
+        return (Q x0123 x4567 x89AB xCDEF)
+
+-- S-Boxes
+
+sbox_s1 :: Word8 -> Word32
+sbox_s1 i = arrayRead32 t (fromIntegral i)
+  where
+    t = array32FromAddrBE 256
+            "\x30\xfb\x40\xd4\x9f\xa0\xff\x0b\x6b\xec\xcd\x2f\x3f\x25\x8c\x7a\x1e\x21\x3f\x2f\x9c\x00\x4d\xd3\x60\x03\xe5\x40\xcf\x9f\xc9\x49\
+            \\xbf\xd4\xaf\x27\x88\xbb\xbd\xb5\xe2\x03\x40\x90\x98\xd0\x96\x75\x6e\x63\xa0\xe0\x15\xc3\x61\xd2\xc2\xe7\x66\x1d\x22\xd4\xff\x8e\
+            \\x28\x68\x3b\x6f\xc0\x7f\xd0\x59\xff\x23\x79\xc8\x77\x5f\x50\xe2\x43\xc3\x40\xd3\xdf\x2f\x86\x56\x88\x7c\xa4\x1a\xa2\xd2\xbd\x2d\
+            \\xa1\xc9\xe0\xd6\x34\x6c\x48\x19\x61\xb7\x6d\x87\x22\x54\x0f\x2f\x2a\xbe\x32\xe1\xaa\x54\x16\x6b\x22\x56\x8e\x3a\xa2\xd3\x41\xd0\
+            \\x66\xdb\x40\xc8\xa7\x84\x39\x2f\x00\x4d\xff\x2f\x2d\xb9\xd2\xde\x97\x94\x3f\xac\x4a\x97\xc1\xd8\x52\x76\x44\xb7\xb5\xf4\x37\xa7\
+            \\xb8\x2c\xba\xef\xd7\x51\xd1\x59\x6f\xf7\xf0\xed\x5a\x09\x7a\x1f\x82\x7b\x68\xd0\x90\xec\xf5\x2e\x22\xb0\xc0\x54\xbc\x8e\x59\x35\
+            \\x4b\x6d\x2f\x7f\x50\xbb\x64\xa2\xd2\x66\x49\x10\xbe\xe5\x81\x2d\xb7\x33\x22\x90\xe9\x3b\x15\x9f\xb4\x8e\xe4\x11\x4b\xff\x34\x5d\
+            \\xfd\x45\xc2\x40\xad\x31\x97\x3f\xc4\xf6\xd0\x2e\x55\xfc\x81\x65\xd5\xb1\xca\xad\xa1\xac\x2d\xae\xa2\xd4\xb7\x6d\xc1\x9b\x0c\x50\
+            \\x88\x22\x40\xf2\x0c\x6e\x4f\x38\xa4\xe4\xbf\xd7\x4f\x5b\xa2\x72\x56\x4c\x1d\x2f\xc5\x9c\x53\x19\xb9\x49\xe3\x54\xb0\x46\x69\xfe\
+            \\xb1\xb6\xab\x8a\xc7\x13\x58\xdd\x63\x85\xc5\x45\x11\x0f\x93\x5d\x57\x53\x8a\xd5\x6a\x39\x04\x93\xe6\x3d\x37\xe0\x2a\x54\xf6\xb3\
+            \\x3a\x78\x7d\x5f\x62\x76\xa0\xb5\x19\xa6\xfc\xdf\x7a\x42\x20\x6a\x29\xf9\xd4\xd5\xf6\x1b\x18\x91\xbb\x72\x27\x5e\xaa\x50\x81\x67\
+            \\x38\x90\x10\x91\xc6\xb5\x05\xeb\x84\xc7\xcb\x8c\x2a\xd7\x5a\x0f\x87\x4a\x14\x27\xa2\xd1\x93\x6b\x2a\xd2\x86\xaf\xaa\x56\xd2\x91\
+            \\xd7\x89\x43\x60\x42\x5c\x75\x0d\x93\xb3\x9e\x26\x18\x71\x84\xc9\x6c\x00\xb3\x2d\x73\xe2\xbb\x14\xa0\xbe\xbc\x3c\x54\x62\x37\x79\
+            \\x64\x45\x9e\xab\x3f\x32\x8b\x82\x77\x18\xcf\x82\x59\xa2\xce\xa6\x04\xee\x00\x2e\x89\xfe\x78\xe6\x3f\xab\x09\x50\x32\x5f\xf6\xc2\
+            \\x81\x38\x3f\x05\x69\x63\xc5\xc8\x76\xcb\x5a\xd6\xd4\x99\x74\xc9\xca\x18\x0d\xcf\x38\x07\x82\xd5\xc7\xfa\x5c\xf6\x8a\xc3\x15\x11\
+            \\x35\xe7\x9e\x13\x47\xda\x91\xd0\xf4\x0f\x90\x86\xa7\xe2\x41\x9e\x31\x36\x62\x41\x05\x1e\xf4\x95\xaa\x57\x3b\x04\x4a\x80\x5d\x8d\
+            \\x54\x83\x00\xd0\x00\x32\x2a\x3c\xbf\x64\xcd\xdf\xba\x57\xa6\x8e\x75\xc6\x37\x2b\x50\xaf\xd3\x41\xa7\xc1\x32\x75\x91\x5a\x0b\xf5\
+            \\x6b\x54\xbf\xab\x2b\x0b\x14\x26\xab\x4c\xc9\xd7\x44\x9c\xcd\x82\xf7\xfb\xf2\x65\xab\x85\xc5\xf3\x1b\x55\xdb\x94\xaa\xd4\xe3\x24\
+            \\xcf\xa4\xbd\x3f\x2d\xea\xa3\xe2\x9e\x20\x4d\x02\xc8\xbd\x25\xac\xea\xdf\x55\xb3\xd5\xbd\x9e\x98\xe3\x12\x31\xb2\x2a\xd5\xad\x6c\
+            \\x95\x43\x29\xde\xad\xbe\x45\x28\xd8\x71\x0f\x69\xaa\x51\xc9\x0f\xaa\x78\x6b\xf6\x22\x51\x3f\x1e\xaa\x51\xa7\x9b\x2a\xd3\x44\xcc\
+            \\x7b\x5a\x41\xf0\xd3\x7c\xfb\xad\x1b\x06\x95\x05\x41\xec\xe4\x91\xb4\xc3\x32\xe6\x03\x22\x68\xd4\xc9\x60\x0a\xcc\xce\x38\x7e\x6d\
+            \\xbf\x6b\xb1\x6c\x6a\x70\xfb\x78\x0d\x03\xd9\xc9\xd4\xdf\x39\xde\xe0\x10\x63\xda\x47\x36\xf4\x64\x5a\xd3\x28\xd8\xb3\x47\xcc\x96\
+            \\x75\xbb\x0f\xc3\x98\x51\x1b\xfb\x4f\xfb\xcc\x35\xb5\x8b\xcf\x6a\xe1\x1f\x0a\xbc\xbf\xc5\xfe\x4a\xa7\x0a\xec\x10\xac\x39\x57\x0a\
+            \\x3f\x04\x44\x2f\x61\x88\xb1\x53\xe0\x39\x7a\x2e\x57\x27\xcb\x79\x9c\xeb\x41\x8f\x1c\xac\xd6\x8d\x2a\xd3\x7c\x96\x01\x75\xcb\x9d\
+            \\xc6\x9d\xff\x09\xc7\x5b\x65\xf0\xd9\xdb\x40\xd8\xec\x0e\x77\x79\x47\x44\xea\xd4\xb1\x1c\x32\x74\xdd\x24\xcb\x9e\x7e\x1c\x54\xbd\
+            \\xf0\x11\x44\xf9\xd2\x24\x0e\xb1\x96\x75\xb3\xfd\xa3\xac\x37\x55\xd4\x7c\x27\xaf\x51\xc8\x5f\x4d\x56\x90\x75\x96\xa5\xbb\x15\xe6\
+            \\x58\x03\x04\xf0\xca\x04\x2c\xf1\x01\x1a\x37\xea\x8d\xbf\xaa\xdb\x35\xba\x3e\x4a\x35\x26\xff\xa0\xc3\x7b\x4d\x09\xbc\x30\x6e\xd9\
+            \\x98\xa5\x26\x66\x56\x48\xf7\x25\xff\x5e\x56\x9d\x0c\xed\x63\xd0\x7c\x63\xb2\xcf\x70\x0b\x45\xe1\xd5\xea\x50\xf1\x85\xa9\x28\x72\
+            \\xaf\x1f\xbd\xa7\xd4\x23\x48\x70\xa7\x87\x0b\xf3\x2d\x3b\x4d\x79\x42\xe0\x41\x98\x0c\xd0\xed\xe7\x26\x47\x0d\xb8\xf8\x81\x81\x4c\
+            \\x47\x4d\x6a\xd7\x7c\x0c\x5e\x5c\xd1\x23\x19\x59\x38\x1b\x72\x98\xf5\xd2\xf4\xdb\xab\x83\x86\x53\x6e\x2f\x1e\x23\x83\x71\x9c\x9e\
+            \\xbd\x91\xe0\x46\x9a\x56\x45\x6e\xdc\x39\x20\x0c\x20\xc8\xc5\x71\x96\x2b\xda\x1c\xe1\xe6\x96\xff\xb1\x41\xab\x08\x7c\xca\x89\xb9\
+            \\x1a\x69\xe7\x83\x02\xcc\x48\x43\xa2\xf7\xc5\x79\x42\x9e\xf4\x7d\x42\x7b\x16\x9c\x5a\xc9\xf0\x49\xdd\x8f\x0f\x00\x5c\x81\x65\xbf"#
+
+sbox_s2 :: Word8 -> Word32
+sbox_s2 i = arrayRead32 t (fromIntegral i)
+  where
+    t = array32FromAddrBE 256
+            "\x1f\x20\x10\x94\xef\x0b\xa7\x5b\x69\xe3\xcf\x7e\x39\x3f\x43\x80\xfe\x61\xcf\x7a\xee\xc5\x20\x7a\x55\x88\x9c\x94\x72\xfc\x06\x51\
+            \\xad\xa7\xef\x79\x4e\x1d\x72\x35\xd5\x5a\x63\xce\xde\x04\x36\xba\x99\xc4\x30\xef\x5f\x0c\x07\x94\x18\xdc\xdb\x7d\xa1\xd6\xef\xf3\
+            \\xa0\xb5\x2f\x7b\x59\xe8\x36\x05\xee\x15\xb0\x94\xe9\xff\xd9\x09\xdc\x44\x00\x86\xef\x94\x44\x59\xba\x83\xcc\xb3\xe0\xc3\xcd\xfb\
+            \\xd1\xda\x41\x81\x3b\x09\x2a\xb1\xf9\x97\xf1\xc1\xa5\xe6\xcf\x7b\x01\x42\x0d\xdb\xe4\xe7\xef\x5b\x25\xa1\xff\x41\xe1\x80\xf8\x06\
+            \\x1f\xc4\x10\x80\x17\x9b\xee\x7a\xd3\x7a\xc6\xa9\xfe\x58\x30\xa4\x98\xde\x8b\x7f\x77\xe8\x3f\x4e\x79\x92\x92\x69\x24\xfa\x9f\x7b\
+            \\xe1\x13\xc8\x5b\xac\xc4\x00\x83\xd7\x50\x35\x25\xf7\xea\x61\x5f\x62\x14\x31\x54\x0d\x55\x4b\x63\x5d\x68\x11\x21\xc8\x66\xc3\x59\
+            \\x3d\x63\xcf\x73\xce\xe2\x34\xc0\xd4\xd8\x7e\x87\x5c\x67\x2b\x21\x07\x1f\x61\x81\x39\xf7\x62\x7f\x36\x1e\x30\x84\xe4\xeb\x57\x3b\
+            \\x60\x2f\x64\xa4\xd6\x3a\xcd\x9c\x1b\xbc\x46\x35\x9e\x81\x03\x2d\x27\x01\xf5\x0c\x99\x84\x7a\xb4\xa0\xe3\xdf\x79\xba\x6c\xf3\x8c\
+            \\x10\x84\x30\x94\x25\x37\xa9\x5e\xf4\x6f\x6f\xfe\xa1\xff\x3b\x1f\x20\x8c\xfb\x6a\x8f\x45\x8c\x74\xd9\xe0\xa2\x27\x4e\xc7\x3a\x34\
+            \\xfc\x88\x4f\x69\x3e\x4d\xe8\xdf\xef\x0e\x00\x88\x35\x59\x64\x8d\x8a\x45\x38\x8c\x1d\x80\x43\x66\x72\x1d\x9b\xfd\xa5\x86\x84\xbb\
+            \\xe8\x25\x63\x33\x84\x4e\x82\x12\x12\x8d\x80\x98\xfe\xd3\x3f\xb4\xce\x28\x0a\xe1\x27\xe1\x9b\xa5\xd5\xa6\xc2\x52\xe4\x97\x54\xbd\
+            \\xc5\xd6\x55\xdd\xeb\x66\x70\x64\x77\x84\x0b\x4d\xa1\xb6\xa8\x01\x84\xdb\x26\xa9\xe0\xb5\x67\x14\x21\xf0\x43\xb7\xe5\xd0\x58\x60\
+            \\x54\xf0\x30\x84\x06\x6f\xf4\x72\xa3\x1a\xa1\x53\xda\xdc\x47\x55\xb5\x62\x5d\xbf\x68\x56\x1b\xe6\x83\xca\x6b\x94\x2d\x6e\xd2\x3b\
+            \\xec\xcf\x01\xdb\xa6\xd3\xd0\xba\xb6\x80\x3d\x5c\xaf\x77\xa7\x09\x33\xb4\xa3\x4c\x39\x7b\xc8\xd6\x5e\xe2\x2b\x95\x5f\x0e\x53\x04\
+            \\x81\xed\x6f\x61\x20\xe7\x43\x64\xb4\x5e\x13\x78\xde\x18\x63\x9b\x88\x1c\xa1\x22\xb9\x67\x26\xd1\x80\x49\xa7\xe8\x22\xb7\xda\x7b\
+            \\x5e\x55\x2d\x25\x52\x72\xd2\x37\x79\xd2\x95\x1c\xc6\x0d\x89\x4c\x48\x8c\xb4\x02\x1b\xa4\xfe\x5b\xa4\xb0\x9f\x6b\x1c\xa8\x15\xcf\
+            \\xa2\x0c\x30\x05\x88\x71\xdf\x63\xb9\xde\x2f\xcb\x0c\xc6\xc9\xe9\x0b\xee\xff\x53\xe3\x21\x45\x17\xb4\x54\x28\x35\x9f\x63\x29\x3c\
+            \\xee\x41\xe7\x29\x6e\x1d\x2d\x7c\x50\x04\x52\x86\x1e\x66\x85\xf3\xf3\x34\x01\xc6\x30\xa2\x2c\x95\x31\xa7\x08\x50\x60\x93\x0f\x13\
+            \\x73\xf9\x84\x17\xa1\x26\x98\x59\xec\x64\x5c\x44\x52\xc8\x77\xa9\xcd\xff\x33\xa6\xa0\x2b\x17\x41\x7c\xba\xd9\xa2\x21\x80\x03\x6f\
+            \\x50\xd9\x9c\x08\xcb\x3f\x48\x61\xc2\x6b\xd7\x65\x64\xa3\xf6\xab\x80\x34\x26\x76\x25\xa7\x5e\x7b\xe4\xe6\xd1\xfc\x20\xc7\x10\xe6\
+            \\xcd\xf0\xb6\x80\x17\x84\x4d\x3b\x31\xee\xf8\x4d\x7e\x08\x24\xe4\x2c\xcb\x49\xeb\x84\x6a\x3b\xae\x8f\xf7\x78\x88\xee\x5d\x60\xf6\
+            \\x7a\xf7\x56\x73\x2f\xdd\x5c\xdb\xa1\x16\x31\xc1\x30\xf6\x6f\x43\xb3\xfa\xec\x54\x15\x7f\xd7\xfa\xef\x85\x79\xcc\xd1\x52\xde\x58\
+            \\xdb\x2f\xfd\x5e\x8f\x32\xce\x19\x30\x6a\xf9\x7a\x02\xf0\x3e\xf8\x99\x31\x9a\xd5\xc2\x42\xfa\x0f\xa7\xe3\xeb\xb0\xc6\x8e\x49\x06\
+            \\xb8\xda\x23\x0c\x80\x82\x30\x28\xdc\xde\xf3\xc8\xd3\x5f\xb1\x71\x08\x8a\x1b\xc8\xbe\xc0\xc5\x60\x61\xa3\xc9\xe8\xbc\xa8\xf5\x4d\
+            \\xc7\x2f\xef\xfa\x22\x82\x2e\x99\x82\xc5\x70\xb4\xd8\xd9\x4e\x89\x8b\x1c\x34\xbc\x30\x1e\x16\xe6\x27\x3b\xe9\x79\xb0\xff\xea\xa6\
+            \\x61\xd9\xb8\xc6\x00\xb2\x48\x69\xb7\xff\xce\x3f\x08\xdc\x28\x3b\x43\xda\xf6\x5a\xf7\xe1\x97\x98\x76\x19\xb7\x2f\x8f\x1c\x9b\xa4\
+            \\xdc\x86\x37\xa0\x16\xa7\xd3\xb1\x9f\xc3\x93\xb7\xa7\x13\x6e\xeb\xc6\xbc\xc6\x3e\x1a\x51\x37\x42\xef\x68\x28\xbc\x52\x03\x65\xd6\
+            \\x2d\x6a\x77\xab\x35\x27\xed\x4b\x82\x1f\xd2\x16\x09\x5c\x6e\x2e\xdb\x92\xf2\xfb\x5e\xea\x29\xcb\x14\x58\x92\xf5\x91\x58\x4f\x7f\
+            \\x54\x83\x69\x7b\x26\x67\xa8\xcc\x85\x19\x60\x48\x8c\x4b\xac\xea\x83\x38\x60\xd4\x0d\x23\xe0\xf9\x6c\x38\x7e\x8a\x0a\xe6\xd2\x49\
+            \\xb2\x84\x60\x0c\xd8\x35\x73\x1d\xdc\xb1\xc6\x47\xac\x4c\x56\xea\x3e\xbd\x81\xb3\x23\x0e\xab\xb0\x64\x38\xbc\x87\xf0\xb5\xb1\xfa\
+            \\x8f\x5e\xa2\xb3\xfc\x18\x46\x42\x0a\x03\x6b\x7a\x4f\xb0\x89\xbd\x64\x9d\xa5\x89\xa3\x45\x41\x5e\x5c\x03\x83\x23\x3e\x5d\x3b\xb9\
+            \\x43\xd7\x95\x72\x7e\x6d\xd0\x7c\x06\xdf\xdf\x1e\x6c\x6c\xc4\xef\x71\x60\xa5\x39\x73\xbf\xbe\x70\x83\x87\x76\x05\x45\x23\xec\xf1"#
+
+sbox_s3 :: Word8 -> Word32
+sbox_s3 i = arrayRead32 t (fromIntegral i)
+  where
+    t = array32FromAddrBE 256
+            "\x8d\xef\xc2\x40\x25\xfa\x5d\x9f\xeb\x90\x3d\xbf\xe8\x10\xc9\x07\x47\x60\x7f\xff\x36\x9f\xe4\x4b\x8c\x1f\xc6\x44\xae\xce\xca\x90\
+            \\xbe\xb1\xf9\xbf\xee\xfb\xca\xea\xe8\xcf\x19\x50\x51\xdf\x07\xae\x92\x0e\x88\x06\xf0\xad\x05\x48\xe1\x3c\x8d\x83\x92\x70\x10\xd5\
+            \\x11\x10\x7d\x9f\x07\x64\x7d\xb9\xb2\xe3\xe4\xd4\x3d\x4f\x28\x5e\xb9\xaf\xa8\x20\xfa\xde\x82\xe0\xa0\x67\x26\x8b\x82\x72\x79\x2e\
+            \\x55\x3f\xb2\xc0\x48\x9a\xe2\x2b\xd4\xef\x97\x94\x12\x5e\x3f\xbc\x21\xff\xfc\xee\x82\x5b\x1b\xfd\x92\x55\xc5\xed\x12\x57\xa2\x40\
+            \\x4e\x1a\x83\x02\xba\xe0\x7f\xff\x52\x82\x46\xe7\x8e\x57\x14\x0e\x33\x73\xf7\xbf\x8c\x9f\x81\x88\xa6\xfc\x4e\xe8\xc9\x82\xb5\xa5\
+            \\xa8\xc0\x1d\xb7\x57\x9f\xc2\x64\x67\x09\x4f\x31\xf2\xbd\x3f\x5f\x40\xff\xf7\xc1\x1f\xb7\x8d\xfc\x8e\x6b\xd2\xc1\x43\x7b\xe5\x9b\
+            \\x99\xb0\x3d\xbf\xb5\xdb\xc6\x4b\x63\x8d\xc0\xe6\x55\x81\x9d\x99\xa1\x97\xc8\x1c\x4a\x01\x2d\x6e\xc5\x88\x4a\x28\xcc\xc3\x6f\x71\
+            \\xb8\x43\xc2\x13\x6c\x07\x43\xf1\x83\x09\x89\x3c\x0f\xed\xdd\x5f\x2f\x7f\xe8\x50\xd7\xc0\x7f\x7e\x02\x50\x7f\xbf\x5a\xfb\x9a\x04\
+            \\xa7\x47\xd2\xd0\x16\x51\x19\x2e\xaf\x70\xbf\x3e\x58\xc3\x13\x80\x5f\x98\x30\x2e\x72\x7c\xc3\xc4\x0a\x0f\xb4\x02\x0f\x7f\xef\x82\
+            \\x8c\x96\xfd\xad\x5d\x2c\x2a\xae\x8e\xe9\x9a\x49\x50\xda\x88\xb8\x84\x27\xf4\xa0\x1e\xac\x57\x90\x79\x6f\xb4\x49\x82\x52\xdc\x15\
+            \\xef\xbd\x7d\x9b\xa6\x72\x59\x7d\xad\xa8\x40\xd8\x45\xf5\x45\x04\xfa\x5d\x74\x03\xe8\x3e\xc3\x05\x4f\x91\x75\x1a\x92\x56\x69\xc2\
+            \\x23\xef\xe9\x41\xa9\x03\xf1\x2e\x60\x27\x0d\xf2\x02\x76\xe4\xb6\x94\xfd\x65\x74\x92\x79\x85\xb2\x82\x76\xdb\xcb\x02\x77\x81\x76\
+            \\xf8\xaf\x91\x8d\x4e\x48\xf7\x9e\x8f\x61\x6d\xdf\xe2\x9d\x84\x0e\x84\x2f\x7d\x83\x34\x0c\xe5\xc8\x96\xbb\xb6\x82\x93\xb4\xb1\x48\
+            \\xef\x30\x3c\xab\x98\x4f\xaf\x28\x77\x9f\xaf\x9b\x92\xdc\x56\x0d\x22\x4d\x1e\x20\x84\x37\xaa\x88\x7d\x29\xdc\x96\x27\x56\xd3\xdc\
+            \\x8b\x90\x7c\xee\xb5\x1f\xd2\x40\xe7\xc0\x7c\xe3\xe5\x66\xb4\xa1\xc3\xe9\x61\x5e\x3c\xf8\x20\x9d\x60\x94\xd1\xe3\xcd\x9c\xa3\x41\
+            \\x5c\x76\x46\x0e\x00\xea\x98\x3b\xd4\xd6\x78\x81\xfd\x47\x57\x2c\xf7\x6c\xed\xd9\xbd\xa8\x22\x9c\x12\x7d\xad\xaa\x43\x8a\x07\x4e\
+            \\x1f\x97\xc0\x90\x08\x1b\xdb\x8a\x93\xa0\x7e\xbe\xb9\x38\xca\x15\x97\xb0\x3c\xff\x3d\xc2\xc0\xf8\x8d\x1a\xb2\xec\x64\x38\x0e\x51\
+            \\x68\xcc\x7b\xfb\xd9\x0f\x27\x88\x12\x49\x01\x81\x5d\xe5\xff\xd4\xdd\x7e\xf8\x6a\x76\xa2\xe2\x14\xb9\xa4\x03\x68\x92\x5d\x95\x8f\
+            \\x4b\x39\xff\xfa\xba\x39\xae\xe9\xa4\xff\xd3\x0b\xfa\xf7\x93\x3b\x6d\x49\x86\x23\x19\x3c\xbc\xfa\x27\x62\x75\x45\x82\x5c\xf4\x7a\
+            \\x61\xbd\x8b\xa0\xd1\x1e\x42\xd1\xce\xad\x04\xf4\x12\x7e\xa3\x92\x10\x42\x8d\xb7\x82\x72\xa9\x72\x92\x70\xc4\xa8\x12\x7d\xe5\x0b\
+            \\x28\x5b\xa1\xc8\x3c\x62\xf4\x4f\x35\xc0\xea\xa5\xe8\x05\xd2\x31\x42\x89\x29\xfb\xb4\xfc\xdf\x82\x4f\xb6\x6a\x53\x0e\x7d\xc1\x5b\
+            \\x1f\x08\x1f\xab\x10\x86\x18\xae\xfc\xfd\x08\x6d\xf9\xff\x28\x89\x69\x4b\xcc\x11\x23\x6a\x5c\xae\x12\xde\xca\x4d\x2c\x3f\x8c\xc5\
+            \\xd2\xd0\x2d\xfe\xf8\xef\x58\x96\xe4\xcf\x52\xda\x95\x15\x5b\x67\x49\x4a\x48\x8c\xb9\xb6\xa8\x0c\x5c\x8f\x82\xbc\x89\xd3\x6b\x45\
+            \\x3a\x60\x94\x37\xec\x00\xc9\xa9\x44\x71\x52\x53\x0a\x87\x4b\x49\xd7\x73\xbc\x40\x7c\x34\x67\x1c\x02\x71\x7e\xf6\x4f\xeb\x55\x36\
+            \\xa2\xd0\x2f\xff\xd2\xbf\x60\xc4\xd4\x3f\x03\xc0\x50\xb4\xef\x6d\x07\x47\x8c\xd1\x00\x6e\x18\x88\xa2\xe5\x3f\x55\xb9\xe6\xd4\xbc\
+            \\xa2\x04\x80\x16\x97\x57\x38\x33\xd7\x20\x7d\x67\xde\x0f\x8f\x3d\x72\xf8\x7b\x33\xab\xcc\x4f\x33\x76\x88\xc5\x5d\x7b\x00\xa6\xb0\
+            \\x94\x7b\x00\x01\x57\x00\x75\xd2\xf9\xbb\x88\xf8\x89\x42\x01\x9e\x42\x64\xa5\xff\x85\x63\x02\xe0\x72\xdb\xd9\x2b\xee\x97\x1b\x69\
+            \\x6e\xa2\x2f\xde\x5f\x08\xae\x2b\xaf\x7a\x61\x6d\xe5\xc9\x87\x67\xcf\x1f\xeb\xd2\x61\xef\xc8\xc2\xf1\xac\x25\x71\xcc\x82\x39\xc2\
+            \\x67\x21\x4c\xb8\xb1\xe5\x83\xd1\xb7\xdc\x3e\x62\x7f\x10\xbd\xce\xf9\x0a\x5c\x38\x0f\xf0\x44\x3d\x60\x6e\x6d\xc6\x60\x54\x3a\x49\
+            \\x57\x27\xc1\x48\x2b\xe9\x8a\x1d\x8a\xb4\x17\x38\x20\xe1\xbe\x24\xaf\x96\xda\x0f\x68\x45\x84\x25\x99\x83\x3b\xe5\x60\x0d\x45\x7d\
+            \\x28\x2f\x93\x50\x83\x34\xb3\x62\xd9\x1d\x11\x20\x2b\x6d\x8d\xa0\x64\x2b\x1e\x31\x9c\x30\x5a\x00\x52\xbc\xe6\x88\x1b\x03\x58\x8a\
+            \\xf7\xba\xef\xd5\x41\x42\xed\x9c\xa4\x31\x5c\x11\x83\x32\x3e\xc5\xdf\xef\x46\x36\xa1\x33\xc5\x01\xe9\xd3\x53\x1c\xee\x35\x37\x83"#
+
+sbox_s4 :: Word8 -> Word32
+sbox_s4 i = arrayRead32 t (fromIntegral i)
+  where
+    t = array32FromAddrBE 256
+            "\x9d\xb3\x04\x20\x1f\xb6\xe9\xde\xa7\xbe\x7b\xef\xd2\x73\xa2\x98\x4a\x4f\x7b\xdb\x64\xad\x8c\x57\x85\x51\x04\x43\xfa\x02\x0e\xd1\
+            \\x7e\x28\x7a\xff\xe6\x0f\xb6\x63\x09\x5f\x35\xa1\x79\xeb\xf1\x20\xfd\x05\x9d\x43\x64\x97\xb7\xb1\xf3\x64\x1f\x63\x24\x1e\x4a\xdf\
+            \\x28\x14\x7f\x5f\x4f\xa2\xb8\xcd\xc9\x43\x00\x40\x0c\xc3\x22\x20\xfd\xd3\x0b\x30\xc0\xa5\x37\x4f\x1d\x2d\x00\xd9\x24\x14\x7b\x15\
+            \\xee\x4d\x11\x1a\x0f\xca\x51\x67\x71\xff\x90\x4c\x2d\x19\x5f\xfe\x1a\x05\x64\x5f\x0c\x13\xfe\xfe\x08\x1b\x08\xca\x05\x17\x01\x21\
+            \\x80\x53\x01\x00\xe8\x3e\x5e\xfe\xac\x9a\xf4\xf8\x7f\xe7\x27\x01\xd2\xb8\xee\x5f\x06\xdf\x42\x61\xbb\x9e\x9b\x8a\x72\x93\xea\x25\
+            \\xce\x84\xff\xdf\xf5\x71\x88\x01\x3d\xd6\x4b\x04\xa2\x6f\x26\x3b\x7e\xd4\x84\x00\x54\x7e\xeb\xe6\x44\x6d\x4c\xa0\x6c\xf3\xd6\xf5\
+            \\x26\x49\xab\xdf\xae\xa0\xc7\xf5\x36\x33\x8c\xc1\x50\x3f\x7e\x93\xd3\x77\x20\x61\x11\xb6\x38\xe1\x72\x50\x0e\x03\xf8\x0e\xb2\xbb\
+            \\xab\xe0\x50\x2e\xec\x8d\x77\xde\x57\x97\x1e\x81\xe1\x4f\x67\x46\xc9\x33\x54\x00\x69\x20\x31\x8f\x08\x1d\xbb\x99\xff\xc3\x04\xa5\
+            \\x4d\x35\x18\x05\x7f\x3d\x5c\xe3\xa6\xc8\x66\xc6\x5d\x5b\xcc\xa9\xda\xec\x6f\xea\x9f\x92\x6f\x91\x9f\x46\x22\x2f\x39\x91\x46\x7d\
+            \\xa5\xbf\x6d\x8e\x11\x43\xc4\x4f\x43\x95\x83\x02\xd0\x21\x4e\xeb\x02\x20\x83\xb8\x3f\xb6\x18\x0c\x18\xf8\x93\x1e\x28\x16\x58\xe6\
+            \\x26\x48\x6e\x3e\x8b\xd7\x8a\x70\x74\x77\xe4\xc1\xb5\x06\xe0\x7c\xf3\x2d\x0a\x25\x79\x09\x8b\x02\xe4\xea\xbb\x81\x28\x12\x3b\x23\
+            \\x69\xde\xad\x38\x15\x74\xca\x16\xdf\x87\x1b\x62\x21\x1c\x40\xb7\xa5\x1a\x9e\xf9\x00\x14\x37\x7b\x04\x1e\x8a\xc8\x09\x11\x40\x03\
+            \\xbd\x59\xe4\xd2\xe3\xd1\x56\xd5\x4f\xe8\x76\xd5\x2f\x91\xa3\x40\x55\x7b\xe8\xde\x00\xea\xe4\xa7\x0c\xe5\xc2\xec\x4d\xb4\xbb\xa6\
+            \\xe7\x56\xbd\xff\xdd\x33\x69\xac\xec\x17\xb0\x35\x06\x57\x23\x27\x99\xaf\xc8\xb0\x56\xc8\xc3\x91\x6b\x65\x81\x1c\x5e\x14\x61\x19\
+            \\x6e\x85\xcb\x75\xbe\x07\xc0\x02\xc2\x32\x55\x77\x89\x3f\xf4\xec\x5b\xbf\xc9\x2d\xd0\xec\x3b\x25\xb7\x80\x1a\xb7\x8d\x6d\x3b\x24\
+            \\x20\xc7\x63\xef\xc3\x66\xa5\xfc\x9c\x38\x28\x80\x0a\xce\x32\x05\xaa\xc9\x54\x8a\xec\xa1\xd7\xc7\x04\x1a\xfa\x32\x1d\x16\x62\x5a\
+            \\x67\x01\x90\x2c\x9b\x75\x7a\x54\x31\xd4\x77\xf7\x91\x26\xb0\x31\x36\xcc\x6f\xdb\xc7\x0b\x8b\x46\xd9\xe6\x6a\x48\x56\xe5\x5a\x79\
+            \\x02\x6a\x4c\xeb\x52\x43\x7e\xff\x2f\x8f\x76\xb4\x0d\xf9\x80\xa5\x86\x74\xcd\xe3\xed\xda\x04\xeb\x17\xa9\xbe\x04\x2c\x18\xf4\xdf\
+            \\xb7\x74\x7f\x9d\xab\x2a\xf7\xb4\xef\xc3\x4d\x20\x2e\x09\x6b\x7c\x17\x41\xa2\x54\xe5\xb6\xa0\x35\x21\x3d\x42\xf6\x2c\x1c\x7c\x26\
+            \\x61\xc2\xf5\x0f\x65\x52\xda\xf9\xd2\xc2\x31\xf8\x25\x13\x0f\x69\xd8\x16\x7f\xa2\x04\x18\xf2\xc8\x00\x1a\x96\xa6\x0d\x15\x26\xab\
+            \\x63\x31\x5c\x21\x5e\x0a\x72\xec\x49\xba\xfe\xfd\x18\x79\x08\xd9\x8d\x0d\xbd\x86\x31\x11\x70\xa7\x3e\x9b\x64\x0c\xcc\x3e\x10\xd7\
+            \\xd5\xca\xd3\xb6\x0c\xae\xc3\x88\xf7\x30\x01\xe1\x6c\x72\x8a\xff\x71\xea\xe2\xa1\x1f\x9a\xf3\x6e\xcf\xcb\xd1\x2f\xc1\xde\x84\x17\
+            \\xac\x07\xbe\x6b\xcb\x44\xa1\xd8\x8b\x9b\x0f\x56\x01\x39\x88\xc3\xb1\xc5\x2f\xca\xb4\xbe\x31\xcd\xd8\x78\x28\x06\x12\xa3\xa4\xe2\
+            \\x6f\x7d\xe5\x32\x58\xfd\x7e\xb6\xd0\x1e\xe9\x00\x24\xad\xff\xc2\xf4\x99\x0f\xc5\x97\x11\xaa\xc5\x00\x1d\x7b\x95\x82\xe5\xe7\xd2\
+            \\x10\x98\x73\xf6\x00\x61\x30\x96\xc3\x2d\x95\x21\xad\xa1\x21\xff\x29\x90\x84\x15\x7f\xbb\x97\x7f\xaf\x9e\xb3\xdb\x29\xc9\xed\x2a\
+            \\x5c\xe2\xa4\x65\xa7\x30\xf3\x2c\xd0\xaa\x3f\xe8\x8a\x5c\xc0\x91\xd4\x9e\x2c\xe7\x0c\xe4\x54\xa9\xd6\x0a\xcd\x86\x01\x5f\x19\x19\
+            \\x77\x07\x91\x03\xde\xa0\x3a\xf6\x78\xa8\x56\x5e\xde\xe3\x56\xdf\x21\xf0\x5c\xbe\x8b\x75\xe3\x87\xb3\xc5\x06\x51\xb8\xa5\xc3\xef\
+            \\xd8\xee\xb6\xd2\xe5\x23\xbe\x77\xc2\x15\x45\x29\x2f\x69\xef\xdf\xaf\xe6\x7a\xfb\xf4\x70\xc4\xb2\xf3\xe0\xeb\x5b\xd6\xcc\x98\x76\
+            \\x39\xe4\x46\x0c\x1f\xda\x85\x38\x19\x87\x83\x2f\xca\x00\x73\x67\xa9\x91\x44\xf8\x29\x6b\x29\x9e\x49\x2f\xc2\x95\x92\x66\xbe\xab\
+            \\xb5\x67\x6e\x69\x9b\xd3\xdd\xda\xdf\x7e\x05\x2f\xdb\x25\x70\x1c\x1b\x5e\x51\xee\xf6\x53\x24\xe6\x6a\xfc\xe3\x6c\x03\x16\xcc\x04\
+            \\x86\x44\x21\x3e\xb7\xdc\x59\xd0\x79\x65\x29\x1f\xcc\xd6\xfd\x43\x41\x82\x39\x79\x93\x2b\xcd\xf6\xb6\x57\xc3\x4d\x4e\xdf\xd2\x82\
+            \\x7a\xe5\x29\x0c\x3c\xb9\x53\x6b\x85\x1e\x20\xfe\x98\x33\x55\x7e\x13\xec\xf0\xb0\xd3\xff\xb3\x72\x3f\x85\xc5\xc1\x0a\xef\x7e\xd2"#
+
+sbox_s5 :: Word8 -> Word32
+sbox_s5 i = arrayRead32 t (fromIntegral i)
+  where
+    t = array32FromAddrBE 256
+            "\x7e\xc9\x0c\x04\x2c\x6e\x74\xb9\x9b\x0e\x66\xdf\xa6\x33\x79\x11\xb8\x6a\x7f\xff\x1d\xd3\x58\xf5\x44\xdd\x9d\x44\x17\x31\x16\x7f\
+            \\x08\xfb\xf1\xfa\xe7\xf5\x11\xcc\xd2\x05\x1b\x00\x73\x5a\xba\x00\x2a\xb7\x22\xd8\x38\x63\x81\xcb\xac\xf6\x24\x3a\x69\xbe\xfd\x7a\
+            \\xe6\xa2\xe7\x7f\xf0\xc7\x20\xcd\xc4\x49\x48\x16\xcc\xf5\xc1\x80\x38\x85\x16\x40\x15\xb0\xa8\x48\xe6\x8b\x18\xcb\x4c\xaa\xde\xff\
+            \\x5f\x48\x0a\x01\x04\x12\xb2\xaa\x25\x98\x14\xfc\x41\xd0\xef\xe2\x4e\x40\xb4\x8d\x24\x8e\xb6\xfb\x8d\xba\x1c\xfe\x41\xa9\x9b\x02\
+            \\x1a\x55\x0a\x04\xba\x8f\x65\xcb\x72\x51\xf4\xe7\x95\xa5\x17\x25\xc1\x06\xec\xd7\x97\xa5\x98\x0a\xc5\x39\xb9\xaa\x4d\x79\xfe\x6a\
+            \\xf2\xf3\xf7\x63\x68\xaf\x80\x40\xed\x0c\x9e\x56\x11\xb4\x95\x8b\xe1\xeb\x5a\x88\x87\x09\xe6\xb0\xd7\xe0\x71\x56\x4e\x29\xfe\xa7\
+            \\x63\x66\xe5\x2d\x02\xd1\xc0\x00\xc4\xac\x8e\x05\x93\x77\xf5\x71\x0c\x05\x37\x2a\x57\x85\x35\xf2\x22\x61\xbe\x02\xd6\x42\xa0\xc9\
+            \\xdf\x13\xa2\x80\x74\xb5\x5b\xd2\x68\x21\x99\xc0\xd4\x21\xe5\xec\x53\xfb\x3c\xe8\xc8\xad\xed\xb3\x28\xa8\x7f\xc9\x3d\x95\x99\x81\
+            \\x5c\x1f\xf9\x00\xfe\x38\xd3\x99\x0c\x4e\xff\x0b\x06\x24\x07\xea\xaa\x2f\x4f\xb1\x4f\xb9\x69\x76\x90\xc7\x95\x05\xb0\xa8\xa7\x74\
+            \\xef\x55\xa1\xff\xe5\x9c\xa2\xc2\xa6\xb6\x2d\x27\xe6\x6a\x42\x63\xdf\x65\x00\x1f\x0e\xc5\x09\x66\xdf\xdd\x55\xbc\x29\xde\x06\x55\
+            \\x91\x1e\x73\x9a\x17\xaf\x89\x75\x32\xc7\x91\x1c\x89\xf8\x94\x68\x0d\x01\xe9\x80\x52\x47\x55\xf4\x03\xb6\x3c\xc9\x0c\xc8\x44\xb2\
+            \\xbc\xf3\xf0\xaa\x87\xac\x36\xe9\xe5\x3a\x74\x26\x01\xb3\xd8\x2b\x1a\x9e\x74\x49\x64\xee\x2d\x7e\xcd\xdb\xb1\xda\x01\xc9\x49\x10\
+            \\xb8\x68\xbf\x80\x0d\x26\xf3\xfd\x93\x42\xed\xe7\x04\xa5\xc2\x84\x63\x67\x37\xb6\x50\xf5\xb6\x16\xf2\x47\x66\xe3\x8e\xca\x36\xc1\
+            \\x13\x6e\x05\xdb\xfe\xf1\x83\x91\xfb\x88\x7a\x37\xd6\xe7\xf7\xd4\xc7\xfb\x7d\xc9\x30\x63\xfc\xdf\xb6\xf5\x89\xde\xec\x29\x41\xda\
+            \\x26\xe4\x66\x95\xb7\x56\x64\x19\xf6\x54\xef\xc5\xd0\x8d\x58\xb7\x48\x92\x54\x01\xc1\xba\xcb\x7f\xe5\xff\x55\x0f\xb6\x08\x30\x49\
+            \\x5b\xb5\xd0\xe8\x87\xd7\x2e\x5a\xab\x6a\x6e\xe1\x22\x3a\x66\xce\xc6\x2b\xf3\xcd\x9e\x08\x85\xf9\x68\xcb\x3e\x47\x08\x6c\x01\x0f\
+            \\xa2\x1d\xe8\x20\xd1\x8b\x69\xde\xf3\xf6\x57\x77\xfa\x02\xc3\xf6\x40\x7e\xda\xc3\xcb\xb3\xd5\x50\x17\x93\x08\x4d\xb0\xd7\x0e\xba\
+            \\x0a\xb3\x78\xd5\xd9\x51\xfb\x0c\xde\xd7\xda\x56\x41\x24\xbb\xe4\x94\xca\x0b\x56\x0f\x57\x55\xd1\xe0\xe1\xe5\x6e\x61\x84\xb5\xbe\
+            \\x58\x0a\x24\x9f\x94\xf7\x4b\xc0\xe3\x27\x88\x8e\x9f\x7b\x55\x61\xc3\xdc\x02\x80\x05\x68\x77\x15\x64\x6c\x6b\xd7\x44\x90\x4d\xb3\
+            \\x66\xb4\xf0\xa3\xc0\xf1\x64\x8a\x69\x7e\xd5\xaf\x49\xe9\x2f\xf6\x30\x9e\x37\x4f\x2c\xb6\x35\x6a\x85\x80\x85\x73\x49\x91\xf8\x40\
+            \\x76\xf0\xae\x02\x08\x3b\xe8\x4d\x28\x42\x1c\x9a\x44\x48\x94\x06\x73\x6e\x4c\xb8\xc1\x09\x29\x10\x8b\xc9\x5f\xc6\x7d\x86\x9c\xf4\
+            \\x13\x4f\x61\x6f\x2e\x77\x11\x8d\xb3\x1b\x2b\xe1\xaa\x90\xb4\x72\x3c\xa5\xd7\x17\x7d\x16\x1b\xba\x9c\xad\x90\x10\xaf\x46\x2b\xa2\
+            \\x9f\xe4\x59\xd2\x45\xd3\x45\x59\xd9\xf2\xda\x13\xdb\xc6\x54\x87\xf3\xe4\xf9\x4e\x17\x6d\x48\x6f\x09\x7c\x13\xea\x63\x1d\xa5\xc7\
+            \\x44\x5f\x73\x82\x17\x56\x83\xf4\xcd\xc6\x6a\x97\x70\xbe\x02\x88\xb3\xcd\xcf\x72\x6e\x5d\xd2\xf3\x20\x93\x60\x79\x45\x9b\x80\xa5\
+            \\xbe\x60\xe2\xdb\xa9\xc2\x31\x01\xeb\xa5\x31\x5c\x22\x4e\x42\xf2\x1c\x5c\x15\x72\xf6\x72\x1b\x2c\x1a\xd2\xff\xf3\x8c\x25\x40\x4e\
+            \\x32\x4e\xd7\x2f\x40\x67\xb7\xfd\x05\x23\x13\x8e\x5c\xa3\xbc\x78\xdc\x0f\xd6\x6e\x75\x92\x22\x83\x78\x4d\x6b\x17\x58\xeb\xb1\x6e\
+            \\x44\x09\x4f\x85\x3f\x48\x1d\x87\xfc\xfe\xae\x7b\x77\xb5\xff\x76\x8c\x23\x02\xbf\xaa\xf4\x75\x56\x5f\x46\xb0\x2a\x2b\x09\x28\x01\
+            \\x3d\x38\xf5\xf7\x0c\xa8\x1f\x36\x52\xaf\x4a\x8a\x66\xd5\xe7\xc0\xdf\x3b\x08\x74\x95\x05\x51\x10\x1b\x5a\xd7\xa8\xf6\x1e\xd5\xad\
+            \\x6c\xf6\xe4\x79\x20\x75\x81\x84\xd0\xce\xfa\x65\x88\xf7\xbe\x58\x4a\x04\x68\x26\x0f\xf6\xf8\xf3\xa0\x9c\x7f\x70\x53\x46\xab\xa0\
+            \\x5c\xe9\x6c\x28\xe1\x76\xed\xa3\x6b\xac\x30\x7f\x37\x68\x29\xd2\x85\x36\x0f\xa9\x17\xe3\xfe\x2a\x24\xb7\x97\x67\xf5\xa9\x6b\x20\
+            \\xd6\xcd\x25\x95\x68\xff\x1e\xbf\x75\x55\x44\x2c\xf1\x9f\x06\xbe\xf9\xe0\x65\x9a\xee\xb9\x49\x1d\x34\x01\x07\x18\xbb\x30\xca\xb8\
+            \\xe8\x22\xfe\x15\x88\x57\x09\x83\x75\x0e\x62\x49\xda\x62\x7e\x55\x5e\x76\xff\xa8\xb1\x53\x45\x46\x6d\x47\xde\x08\xef\xe9\xe7\xd4"#
+
+sbox_s6 :: Word8 -> Word32
+sbox_s6 i = arrayRead32 t (fromIntegral i)
+  where
+    t = array32FromAddrBE 256
+            "\xf6\xfa\x8f\x9d\x2c\xac\x6c\xe1\x4c\xa3\x48\x67\xe2\x33\x7f\x7c\x95\xdb\x08\xe7\x01\x68\x43\xb4\xec\xed\x5c\xbc\x32\x55\x53\xac\
+            \\xbf\x9f\x09\x60\xdf\xa1\xe2\xed\x83\xf0\x57\x9d\x63\xed\x86\xb9\x1a\xb6\xa6\xb8\xde\x5e\xbe\x39\xf3\x8f\xf7\x32\x89\x89\xb1\x38\
+            \\x33\xf1\x49\x61\xc0\x19\x37\xbd\xf5\x06\xc6\xda\xe4\x62\x5e\x7e\xa3\x08\xea\x99\x4e\x23\xe3\x3c\x79\xcb\xd7\xcc\x48\xa1\x43\x67\
+            \\xa3\x14\x96\x19\xfe\xc9\x4b\xd5\xa1\x14\x17\x4a\xea\xa0\x18\x66\xa0\x84\xdb\x2d\x09\xa8\x48\x6f\xa8\x88\x61\x4a\x29\x00\xaf\x98\
+            \\x01\x66\x59\x91\xe1\x99\x28\x63\xc8\xf3\x0c\x60\x2e\x78\xef\x3c\xd0\xd5\x19\x32\xcf\x0f\xec\x14\xf7\xca\x07\xd2\xd0\xa8\x20\x72\
+            \\xfd\x41\x19\x7e\x93\x05\xa6\xb0\xe8\x6b\xe3\xda\x74\xbe\xd3\xcd\x37\x2d\xa5\x3c\x4c\x7f\x44\x48\xda\xb5\xd4\x40\x6d\xba\x0e\xc3\
+            \\x08\x39\x19\xa7\x9f\xba\xee\xd9\x49\xdb\xcf\xb0\x4e\x67\x0c\x53\x5c\x3d\x9c\x01\x64\xbd\xb9\x41\x2c\x0e\x63\x6a\xba\x7d\xd9\xcd\
+            \\xea\x6f\x73\x88\xe7\x0b\xc7\x62\x35\xf2\x9a\xdb\x5c\x4c\xdd\x8d\xf0\xd4\x8d\x8c\xb8\x81\x53\xe2\x08\xa1\x98\x66\x1a\xe2\xea\xc8\
+            \\x28\x4c\xaf\x89\xaa\x92\x82\x23\x93\x34\xbe\x53\x3b\x3a\x21\xbf\x16\x43\x4b\xe3\x9a\xea\x39\x06\xef\xe8\xc3\x6e\xf8\x90\xcd\xd9\
+            \\x80\x22\x6d\xae\xc3\x40\xa4\xa3\xdf\x7e\x9c\x09\xa6\x94\xa8\x07\x5b\x7c\x5e\xcc\x22\x1d\xb3\xa6\x9a\x69\xa0\x2f\x68\x81\x8a\x54\
+            \\xce\xb2\x29\x6f\x53\xc0\x84\x3a\xfe\x89\x36\x55\x25\xbf\xe6\x8a\xb4\x62\x8a\xbc\xcf\x22\x2e\xbf\x25\xac\x6f\x48\xa9\xa9\x93\x87\
+            \\x53\xbd\xdb\x65\xe7\x6f\xfb\xe7\xe9\x67\xfd\x78\x0b\xa9\x35\x63\x8e\x34\x2b\xc1\xe8\xa1\x1b\xe9\x49\x80\x74\x0d\xc8\x08\x7d\xfc\
+            \\x8d\xe4\xbf\x99\xa1\x11\x01\xa0\x7f\xd3\x79\x75\xda\x5a\x26\xc0\xe8\x1f\x99\x4f\x95\x28\xcd\x89\xfd\x33\x9f\xed\xb8\x78\x34\xbf\
+            \\x5f\x04\x45\x6d\x22\x25\x86\x98\xc9\xc4\xc8\x3b\x2d\xc1\x56\xbe\x4f\x62\x8d\xaa\x57\xf5\x5e\xc5\xe2\x22\x0a\xbe\xd2\x91\x6e\xbf\
+            \\x4e\xc7\x5b\x95\x24\xf2\xc3\xc0\x42\xd1\x5d\x99\xcd\x0d\x7f\xa0\x7b\x6e\x27\xff\xa8\xdc\x8a\xf0\x73\x45\xc1\x06\xf4\x1e\x23\x2f\
+            \\x35\x16\x23\x86\xe6\xea\x89\x26\x33\x33\xb0\x94\x15\x7e\xc6\xf2\x37\x2b\x74\xaf\x69\x25\x73\xe4\xe9\xa9\xd8\x48\xf3\x16\x02\x89\
+            \\x3a\x62\xef\x1d\xa7\x87\xe2\x38\xf3\xa5\xf6\x76\x74\x36\x48\x53\x20\x95\x10\x63\x45\x76\x69\x8d\xb6\xfa\xd4\x07\x59\x2a\xf9\x50\
+            \\x36\xf7\x35\x23\x4c\xfb\x6e\x87\x7d\xa4\xce\xc0\x6c\x15\x2d\xaa\xcb\x03\x96\xa8\xc5\x0d\xfe\x5d\xfc\xd7\x07\xab\x09\x21\xc4\x2f\
+            \\x89\xdf\xf0\xbb\x5f\xe2\xbe\x78\x44\x8f\x4f\x33\x75\x46\x13\xc9\x2b\x05\xd0\x8d\x48\xb9\xd5\x85\xdc\x04\x94\x41\xc8\x09\x8f\x9b\
+            \\x7d\xed\xe7\x86\xc3\x9a\x33\x73\x42\x41\x00\x05\x6a\x09\x17\x51\x0e\xf3\xc8\xa6\x89\x00\x72\xd6\x28\x20\x76\x82\xa9\xa9\xf7\xbe\
+            \\xbf\x32\x67\x9d\xd4\x5b\x5b\x75\xb3\x53\xfd\x00\xcb\xb0\xe3\x58\x83\x0f\x22\x0a\x1f\x8f\xb2\x14\xd3\x72\xcf\x08\xcc\x3c\x4a\x13\
+            \\x8c\xf6\x31\x66\x06\x1c\x87\xbe\x88\xc9\x8f\x88\x60\x62\xe3\x97\x47\xcf\x8e\x7a\xb6\xc8\x52\x83\x3c\xc2\xac\xfb\x3f\xc0\x69\x76\
+            \\x4e\x8f\x02\x52\x64\xd8\x31\x4d\xda\x38\x70\xe3\x1e\x66\x54\x59\xc1\x09\x08\xf0\x51\x30\x21\xa5\x6c\x5b\x68\xb7\x82\x2f\x8a\xa0\
+            \\x30\x07\xcd\x3e\x74\x71\x9e\xef\xdc\x87\x26\x81\x07\x33\x40\xd4\x7e\x43\x2f\xd9\x0c\x5e\xc2\x41\x88\x09\x28\x6c\xf5\x92\xd8\x91\
+            \\x08\xa9\x30\xf6\x95\x7e\xf3\x05\xb7\xfb\xff\xbd\xc2\x66\xe9\x6f\x6f\xe4\xac\x98\xb1\x73\xec\xc0\xbc\x60\xb4\x2a\x95\x34\x98\xda\
+            \\xfb\xa1\xae\x12\x2d\x4b\xd7\x36\x0f\x25\xfa\xab\xa4\xf3\xfc\xeb\xe2\x96\x91\x23\x25\x7f\x0c\x3d\x93\x48\xaf\x49\x36\x14\x00\xbc\
+            \\xe8\x81\x6f\x4a\x38\x14\xf2\x00\xa3\xf9\x40\x43\x9c\x7a\x54\xc2\xbc\x70\x4f\x57\xda\x41\xe7\xf9\xc2\x5a\xd3\x3a\x54\xf4\xa0\x84\
+            \\xb1\x7f\x55\x05\x59\x35\x7c\xbe\xed\xbd\x15\xc8\x7f\x97\xc5\xab\xba\x5a\xc7\xb5\xb6\xf6\xde\xaf\x3a\x47\x9c\x3a\x53\x02\xda\x25\
+            \\x65\x3d\x7e\x6a\x54\x26\x8d\x49\x51\xa4\x77\xea\x50\x17\xd5\x5b\xd7\xd2\x5d\x88\x44\x13\x6c\x76\x04\x04\xa8\xc8\xb8\xe5\xa1\x21\
+            \\xb8\x1a\x92\x8a\x60\xed\x58\x69\x97\xc5\x5b\x96\xea\xec\x99\x1b\x29\x93\x59\x13\x01\xfd\xb7\xf1\x08\x8e\x8d\xfa\x9a\xb6\xf6\xf5\
+            \\x3b\x4c\xbf\x9f\x4a\x5d\xe3\xab\xe6\x05\x1d\x35\xa0\xe1\xd8\x55\xd3\x6b\x4c\xf1\xf5\x44\xed\xeb\xb0\xe9\x35\x24\xbe\xbb\x8f\xbd\
+            \\xa2\xd7\x62\xcf\x49\xc9\x2f\x54\x38\xb5\xf3\x31\x71\x28\xa4\x54\x48\x39\x29\x05\xa6\x5b\x1d\xb8\x85\x1c\x97\xbd\xd6\x75\xcf\x2f"#
+
+sbox_s7 :: Word8 -> Word32
+sbox_s7 i = arrayRead32 t (fromIntegral i)
+  where
+    t = array32FromAddrBE 256
+            "\x85\xe0\x40\x19\x33\x2b\xf5\x67\x66\x2d\xbf\xff\xcf\xc6\x56\x93\x2a\x8d\x7f\x6f\xab\x9b\xc9\x12\xde\x60\x08\xa1\x20\x28\xda\x1f\
+            \\x02\x27\xbc\xe7\x4d\x64\x29\x16\x18\xfa\xc3\x00\x50\xf1\x8b\x82\x2c\xb2\xcb\x11\xb2\x32\xe7\x5c\x4b\x36\x95\xf2\xb2\x87\x07\xde\
+            \\xa0\x5f\xbc\xf6\xcd\x41\x81\xe9\xe1\x50\x21\x0c\xe2\x4e\xf1\xbd\xb1\x68\xc3\x81\xfd\xe4\xe7\x89\x5c\x79\xb0\xd8\x1e\x8b\xfd\x43\
+            \\x4d\x49\x50\x01\x38\xbe\x43\x41\x91\x3c\xee\x1d\x92\xa7\x9c\x3f\x08\x97\x66\xbe\xba\xee\xad\xf4\x12\x86\xbe\xcf\xb6\xea\xcb\x19\
+            \\x26\x60\xc2\x00\x75\x65\xbd\xe4\x64\x24\x1f\x7a\x82\x48\xdc\xa9\xc3\xb3\xad\x66\x28\x13\x60\x86\x0b\xd8\xdf\xa8\x35\x6d\x1c\xf2\
+            \\x10\x77\x89\xbe\xb3\xb2\xe9\xce\x05\x02\xaa\x8f\x0b\xc0\x35\x1e\x16\x6b\xf5\x2a\xeb\x12\xff\x82\xe3\x48\x69\x11\xd3\x4d\x75\x16\
+            \\x4e\x7b\x3a\xff\x5f\x43\x67\x1b\x9c\xf6\xe0\x37\x49\x81\xac\x83\x33\x42\x66\xce\x8c\x93\x41\xb7\xd0\xd8\x54\xc0\xcb\x3a\x6c\x88\
+            \\x47\xbc\x28\x29\x47\x25\xba\x37\xa6\x6a\xd2\x2b\x7a\xd6\x1f\x1e\x0c\x5c\xba\xfa\x44\x37\xf1\x07\xb6\xe7\x99\x62\x42\xd2\xd8\x16\
+            \\x0a\x96\x12\x88\xe1\xa5\xc0\x6e\x13\x74\x9e\x67\x72\xfc\x08\x1a\xb1\xd1\x39\xf7\xf9\x58\x37\x45\xcf\x19\xdf\x58\xbe\xc3\xf7\x56\
+            \\xc0\x6e\xba\x30\x07\x21\x1b\x24\x45\xc2\x88\x29\xc9\x5e\x31\x7f\xbc\x8e\xc5\x11\x38\xbc\x46\xe9\xc6\xe6\xfa\x14\xba\xe8\x58\x4a\
+            \\xad\x4e\xbc\x46\x46\x8f\x50\x8b\x78\x29\x43\x5f\xf1\x24\x18\x3b\x82\x1d\xba\x9f\xaf\xf6\x0f\xf4\xea\x2c\x4e\x6d\x16\xe3\x92\x64\
+            \\x92\x54\x4a\x8b\x00\x9b\x4f\xc3\xab\xa6\x8c\xed\x9a\xc9\x6f\x78\x06\xa5\xb7\x9a\xb2\x85\x6e\x6e\x1a\xec\x3c\xa9\xbe\x83\x86\x88\
+            \\x0e\x08\x04\xe9\x55\xf1\xbe\x56\xe7\xe5\x36\x3b\xb3\xa1\xf2\x5d\xf7\xde\xbb\x85\x61\xfe\x03\x3c\x16\x74\x62\x33\x3c\x03\x4c\x28\
+            \\xda\x6d\x0c\x74\x79\xaa\xc5\x6c\x3c\xe4\xe1\xad\x51\xf0\xc8\x02\x98\xf8\xf3\x5a\x16\x26\xa4\x9f\xee\xd8\x2b\x29\x1d\x38\x2f\xe3\
+            \\x0c\x4f\xb9\x9a\xbb\x32\x57\x78\x3e\xc6\xd9\x7b\x6e\x77\xa6\xa9\xcb\x65\x8b\x5c\xd4\x52\x30\xc7\x2b\xd1\x40\x8b\x60\xc0\x3e\xb7\
+            \\xb9\x06\x8d\x78\xa3\x37\x54\xf4\xf4\x30\xc8\x7d\xc8\xa7\x13\x02\xb9\x6d\x8c\x32\xeb\xd4\xe7\xbe\xbe\x8b\x9d\x2d\x79\x79\xfb\x06\
+            \\xe7\x22\x53\x08\x8b\x75\xcf\x77\x11\xef\x8d\xa4\xe0\x83\xc8\x58\x8d\x6b\x78\x6f\x5a\x63\x17\xa6\xfa\x5c\xf7\xa0\x5d\xda\x00\x33\
+            \\xf2\x8e\xbf\xb0\xf5\xb9\xc3\x10\xa0\xea\xc2\x80\x08\xb9\x76\x7a\xa3\xd9\xd2\xb0\x79\xd3\x42\x17\x02\x1a\x71\x8d\x9a\xc6\x33\x6a\
+            \\x27\x11\xfd\x60\x43\x80\x50\xe3\x06\x99\x08\xa8\x3d\x7f\xed\xc4\x82\x6d\x2b\xef\x4e\xeb\x84\x76\x48\x8d\xcf\x25\x36\xc9\xd5\x66\
+            \\x28\xe7\x4e\x41\xc2\x61\x0a\xca\x3d\x49\xa9\xcf\xba\xe3\xb9\xdf\xb6\x5f\x8d\xe6\x92\xae\xaf\x64\x3a\xc7\xd5\xe6\x9e\xa8\x05\x09\
+            \\xf2\x2b\x01\x7d\xa4\x17\x3f\x70\xdd\x1e\x16\xc3\x15\xe0\xd7\xf9\x50\xb1\xb8\x87\x2b\x9f\x4f\xd5\x62\x5a\xba\x82\x6a\x01\x79\x62\
+            \\x2e\xc0\x1b\x9c\x15\x48\x8a\xa9\xd7\x16\xe7\x40\x40\x05\x5a\x2c\x93\xd2\x9a\x22\xe3\x2d\xbf\x9a\x05\x87\x45\xb9\x34\x53\xdc\x1e\
+            \\xd6\x99\x29\x6e\x49\x6c\xff\x6f\x1c\x9f\x49\x86\xdf\xe2\xed\x07\xb8\x72\x42\xd1\x19\xde\x7e\xae\x05\x3e\x56\x1a\x15\xad\x6f\x8c\
+            \\x66\x62\x6c\x1c\x71\x54\xc2\x4c\xea\x08\x2b\x2a\x93\xeb\x29\x39\x17\xdc\xb0\xf0\x58\xd4\xf2\xae\x9e\xa2\x94\xfb\x52\xcf\x56\x4c\
+            \\x98\x83\xfe\x66\x2e\xc4\x05\x81\x76\x39\x53\xc3\x01\xd6\x69\x2e\xd3\xa0\xc1\x08\xa1\xe7\x16\x0e\xe4\xf2\xdf\xa6\x69\x3e\xd2\x85\
+            \\x74\x90\x46\x98\x4c\x2b\x0e\xdd\x4f\x75\x76\x56\x5d\x39\x33\x78\xa1\x32\x23\x4f\x3d\x32\x1c\x5d\xc3\xf5\xe1\x94\x4b\x26\x93\x01\
+            \\xc7\x9f\x02\x2f\x3c\x99\x7e\x7e\x5e\x4f\x95\x04\x3f\xfa\xfb\xbd\x76\xf7\xad\x0e\x29\x66\x93\xf4\x3d\x1f\xce\x6f\xc6\x1e\x45\xbe\
+            \\xd3\xb5\xab\x34\xf7\x2b\xf9\xb7\x1b\x04\x34\xc0\x4e\x72\xb5\x67\x55\x92\xa3\x3d\xb5\x22\x93\x01\xcf\xd2\xa8\x7f\x60\xae\xb7\x67\
+            \\x18\x14\x38\x6b\x30\xbc\xc3\x3d\x38\xa0\xc0\x7d\xfd\x16\x06\xf2\xc3\x63\x51\x9b\x58\x9d\xd3\x90\x54\x79\xf8\xe6\x1c\xb8\xd6\x47\
+            \\x97\xfd\x61\xa9\xea\x77\x59\xf4\x2d\x57\x53\x9d\x56\x9a\x58\xcf\xe8\x4e\x63\xad\x46\x2e\x1b\x78\x65\x80\xf8\x7e\xf3\x81\x79\x14\
+            \\x91\xda\x55\xf4\x40\xa2\x30\xf3\xd1\x98\x8f\x35\xb6\xe3\x18\xd2\x3f\xfa\x50\xbc\x3d\x40\xf0\x21\xc3\xc0\xbd\xae\x49\x58\xc2\x4c\
+            \\x51\x8f\x36\xb2\x84\xb1\xd3\x70\x0f\xed\xce\x83\x87\x8d\xda\xda\xf2\xa2\x79\xc7\x94\xe0\x1b\xe8\x90\x71\x6f\x4b\x95\x4b\x8a\xa3"#
+
+sbox_s8 :: Word8 -> Word32
+sbox_s8 i = arrayRead32 t (fromIntegral i)
+  where
+    t = array32FromAddrBE 256
+            "\xe2\x16\x30\x0d\xbb\xdd\xff\xfc\xa7\xeb\xda\xbd\x35\x64\x80\x95\x77\x89\xf8\xb7\xe6\xc1\x12\x1b\x0e\x24\x16\x00\x05\x2c\xe8\xb5\
+            \\x11\xa9\xcf\xb0\xe5\x95\x2f\x11\xec\xe7\x99\x0a\x93\x86\xd1\x74\x2a\x42\x93\x1c\x76\xe3\x81\x11\xb1\x2d\xef\x3a\x37\xdd\xdd\xfc\
+            \\xde\x9a\xde\xb1\x0a\x0c\xc3\x2c\xbe\x19\x70\x29\x84\xa0\x09\x40\xbb\x24\x3a\x0f\xb4\xd1\x37\xcf\xb4\x4e\x79\xf0\x04\x9e\xed\xfd\
+            \\x0b\x15\xa1\x5d\x48\x0d\x31\x68\x8b\xbb\xde\x5a\x66\x9d\xed\x42\xc7\xec\xe8\x31\x3f\x8f\x95\xe7\x72\xdf\x19\x1b\x75\x80\x33\x0d\
+            \\x94\x07\x42\x51\x5c\x7d\xcd\xfa\xab\xbe\x6d\x63\xaa\x40\x21\x64\xb3\x01\xd4\x0a\x02\xe7\xd1\xca\x53\x57\x1d\xae\x7a\x31\x82\xa2\
+            \\x12\xa8\xdd\xec\xfd\xaa\x33\x5d\x17\x6f\x43\xe8\x71\xfb\x46\xd4\x38\x12\x90\x22\xce\x94\x9a\xd4\xb8\x47\x69\xad\x96\x5b\xd8\x62\
+            \\x82\xf3\xd0\x55\x66\xfb\x97\x67\x15\xb8\x0b\x4e\x1d\x5b\x47\xa0\x4c\xfd\xe0\x6f\xc2\x8e\xc4\xb8\x57\xe8\x72\x6e\x64\x7a\x78\xfc\
+            \\x99\x86\x5d\x44\x60\x8b\xd5\x93\x6c\x20\x0e\x03\x39\xdc\x5f\xf6\x5d\x0b\x00\xa3\xae\x63\xaf\xf2\x7e\x8b\xd6\x32\x70\x10\x8c\x0c\
+            \\xbb\xd3\x50\x49\x29\x98\xdf\x04\x98\x0c\xf4\x2a\x9b\x6d\xf4\x91\x9e\x7e\xdd\x53\x06\x91\x85\x48\x58\xcb\x7e\x07\x3b\x74\xef\x2e\
+            \\x52\x2f\xff\xb1\xd2\x47\x08\xcc\x1c\x7e\x27\xcd\xa4\xeb\x21\x5b\x3c\xf1\xd2\xe2\x19\xb4\x7a\x38\x42\x4f\x76\x18\x35\x85\x60\x39\
+            \\x9d\x17\xde\xe7\x27\xeb\x35\xe6\xc9\xaf\xf6\x7b\x36\xba\xf5\xb8\x09\xc4\x67\xcd\xc1\x89\x10\xb1\xe1\x1d\xbf\x7b\x06\xcd\x1a\xf8\
+            \\x71\x70\xc6\x08\x2d\x5e\x33\x54\xd4\xde\x49\x5a\x64\xc6\xd0\x06\xbc\xc0\xc6\x2c\x3d\xd0\x0d\xb3\x70\x8f\x8f\x34\x77\xd5\x1b\x42\
+            \\x26\x4f\x62\x0f\x24\xb8\xd2\xbf\x15\xc1\xb7\x9e\x46\xa5\x25\x64\xf8\xd7\xe5\x4e\x3e\x37\x81\x60\x78\x95\xcd\xa5\x85\x9c\x15\xa5\
+            \\xe6\x45\x97\x88\xc3\x7b\xc7\x5f\xdb\x07\xba\x0c\x06\x76\xa3\xab\x7f\x22\x9b\x1e\x31\x84\x2e\x7b\x24\x25\x9f\xd7\xf8\xbe\xf4\x72\
+            \\x83\x5f\xfc\xb8\x6d\xf4\xc1\xf2\x96\xf5\xb1\x95\xfd\x0a\xf0\xfc\xb0\xfe\x13\x4c\xe2\x50\x6d\x3d\x4f\x9b\x12\xea\xf2\x15\xf2\x25\
+            \\xa2\x23\x73\x6f\x9f\xb4\xc4\x28\x25\xd0\x49\x79\x34\xc7\x13\xf8\xc4\x61\x81\x87\xea\x7a\x6e\x98\x7c\xd1\x6e\xfc\x14\x36\x87\x6c\
+            \\xf1\x54\x41\x07\xbe\xde\xee\x14\x56\xe9\xaf\x27\xa0\x4a\xa4\x41\x3c\xf7\xc8\x99\x92\xec\xba\xe6\xdd\x67\x01\x6d\x15\x16\x82\xeb\
+            \\xa8\x42\xee\xdf\xfd\xba\x60\xb4\xf1\x90\x7b\x75\x20\xe3\x03\x0f\x24\xd8\xc2\x9e\xe1\x39\x67\x3b\xef\xa6\x3f\xb8\x71\x87\x30\x54\
+            \\xb6\xf2\xcf\x3b\x9f\x32\x64\x42\xcb\x15\xa4\xcc\xb0\x1a\x45\x04\xf1\xe4\x7d\x8d\x84\x4a\x1b\xe5\xba\xe7\xdf\xdc\x42\xcb\xda\x70\
+            \\xcd\x7d\xae\x0a\x57\xe8\x5b\x7a\xd5\x3f\x5a\xf6\x20\xcf\x4d\x8c\xce\xa4\xd4\x28\x79\xd1\x30\xa4\x34\x86\xeb\xfb\x33\xd3\xcd\xdc\
+            \\x77\x85\x3b\x53\x37\xef\xfc\xb5\xc5\x06\x87\x78\xe5\x80\xb3\xe6\x4e\x68\xb8\xf4\xc5\xc8\xb3\x7e\x0d\x80\x9e\xa2\x39\x8f\xeb\x7c\
+            \\x13\x2a\x4f\x94\x43\xb7\x95\x0e\x2f\xee\x7d\x1c\x22\x36\x13\xbd\xdd\x06\xca\xa2\x37\xdf\x93\x2b\xc4\x24\x82\x89\xac\xf3\xeb\xc3\
+            \\x57\x15\xf6\xb7\xef\x34\x78\xdd\xf2\x67\x61\x6f\xc1\x48\xcb\xe4\x90\x52\x81\x5e\x5e\x41\x0f\xab\xb4\x8a\x24\x65\x2e\xda\x7f\xa4\
+            \\xe8\x7b\x40\xe4\xe9\x8e\xa0\x84\x58\x89\xe9\xe1\xef\xd3\x90\xfc\xdd\x07\xd3\x5b\xdb\x48\x56\x94\x38\xd7\xe5\xb2\x57\x72\x01\x01\
+            \\x73\x0e\xde\xbc\x5b\x64\x31\x13\x94\x91\x7e\x4f\x50\x3c\x2f\xba\x64\x6f\x12\x82\x75\x23\xd2\x4a\xe0\x77\x96\x95\xf9\xc1\x7a\x8f\
+            \\x7a\x5b\x21\x21\xd1\x87\xb8\x96\x29\x26\x3a\x4d\xba\x51\x0c\xdf\x81\xf4\x7c\x9f\xad\x11\x63\xed\xea\x7b\x59\x65\x1a\x00\x72\x6e\
+            \\x11\x40\x30\x92\x00\xda\x6d\x77\x4a\x0c\xdd\x61\xad\x1f\x46\x03\x60\x5b\xdf\xb0\x9e\xed\xc3\x64\x22\xeb\xe6\xa8\xce\xe7\xd2\x8a\
+            \\xa0\xe7\x36\xa0\x55\x64\xa6\xb9\x10\x85\x32\x09\xc7\xeb\x8f\x37\x2d\xe7\x05\xca\x89\x51\x57\x0f\xdf\x09\x82\x2b\xbd\x69\x1a\x6c\
+            \\xaa\x12\xe4\xf2\x87\x45\x1c\x0f\xe0\xf6\xa2\x7a\x3a\xda\x48\x19\x4c\xf1\x76\x4f\x0d\x77\x1c\x2b\x67\xcd\xb1\x56\x35\x0d\x83\x84\
+            \\x59\x38\xfa\x0f\x42\x39\x9e\xf3\x36\x99\x7b\x07\x0e\x84\x09\x3d\x4a\xa9\x3e\x61\x83\x60\xd8\x7b\x1f\xa9\x8b\x0c\x11\x49\x38\x2c\
+            \\xe9\x76\x25\xa5\x06\x14\xd1\xb7\x0e\x25\x24\x4b\x0c\x76\x83\x47\x58\x9e\x8d\x82\x0d\x20\x59\xd1\xa4\x66\xbb\x1e\xf8\xda\x0a\x82\
+            \\x04\xf1\x91\x30\xba\x6e\x4e\xc0\x99\x26\x51\x64\x1e\xe7\x23\x0d\x50\xb2\xad\x80\xea\xee\x68\x01\x8d\xb2\xa2\x83\xea\x8b\xf5\x9e"#

Crypto/Cipher/Camellia/Primitive.hs

@@ -6,8 +6,8 @@
 -- Stability   : experimental
 -- Portability : Good
 --
--- this only cover Camellia 128 bits for now, API will change once
+-- This only cover Camellia 128 bits for now. The API will change once
--- 192 and 256 mode are implemented too
+-- 192 and 256 mode are implemented too.
 {-# LANGUAGE MagicHash #-}
 module Crypto.Cipher.Camellia.Primitive
     ( Camellia

Crypto/Cipher/ChaCha.hs

@@ -12,7 +12,7 @@ module Crypto.Cipher.ChaCha
     , combine
     , generate
     , State
-    -- * simple interface for DRG purpose
+    -- * Simple interface for DRG purpose
     , initializeSimple
     , generateSimple
     , StateSimple
@@ -41,24 +41,26 @@ initialize :: (ByteArrayAccess key, ByteArrayAccess nonce)
            -> nonce -- ^ the nonce (64 or 96 bits)
            -> State -- ^ the initial ChaCha state
 initialize nbRounds key nonce
-    | not (kLen `elem` [16,32])       = error "ChaCha: key length should be 128 or 256 bits"
+    | kLen `notElem` [16,32]          = error "ChaCha: key length should be 128 or 256 bits"
-    | not (nonceLen `elem` [8,12])    = error "ChaCha: nonce length should be 64 or 96 bits"
+    | nonceLen `notElem` [8,12]       = error "ChaCha: nonce length should be 64 or 96 bits"
-    | not (nbRounds `elem` [8,12,20]) = error "ChaCha: rounds should be 8, 12 or 20"
+    | nbRounds `notElem` [8,12,20]    = error "ChaCha: rounds should be 8, 12 or 20"
     | otherwise                       = unsafeDoIO $ do
         stPtr <- B.alloc 132 $ \stPtr ->
             B.withByteArray nonce $ \noncePtr  ->
             B.withByteArray key   $ \keyPtr ->
-                ccryptonite_chacha_init stPtr (fromIntegral nbRounds) kLen keyPtr nonceLen noncePtr
+                ccryptonite_chacha_init stPtr  nbRounds kLen keyPtr nonceLen noncePtr
         return $ State stPtr
   where kLen     = B.length key
         nonceLen = B.length nonce
 
 -- | Initialize simple ChaCha State
-initializeSimple :: ByteArray seed
+--
+-- The seed need to be at least 40 bytes long
+initializeSimple :: ByteArrayAccess seed
                  => seed -- ^ a 40 bytes long seed
                  -> StateSimple
 initializeSimple seed
-    | sLen /= 40 = error "ChaCha Random: seed length should be 40 bytes"
+    | sLen < 40 = error "ChaCha Random: seed length should be 40 bytes"
     | otherwise = unsafeDoIO $ do
         stPtr <- B.alloc 64 $ \stPtr ->
                     B.withByteArray seed $ \seedPtr ->

Crypto/Cipher/RC4.hs

@@ -30,6 +30,11 @@ import           Crypto.Internal.Compat
 import           Crypto.Internal.Imports
 
 -- | The encryption state for RC4
+--
+-- This type is an instance of 'ByteArrayAccess' for debugging purpose. Internal
+-- layout is architecture dependent, may contain uninitialized data fragments,
+-- and change in future versions.  The bytearray should not be used as input to
+-- cryptographic algorithms.
 newtype State = State ScrubbedBytes
     deriving (ByteArrayAccess,NFData)
 

Crypto/Cipher/Salsa.hs

@@ -33,14 +33,14 @@ initialize :: (ByteArrayAccess key, ByteArrayAccess nonce)
            -> nonce  -- ^ the nonce (64 or 96 bits)
            -> State  -- ^ the initial Salsa state
 initialize nbRounds key nonce
-    | not (kLen `elem` [16,32])       = error "Salsa: key length should be 128 or 256 bits"
+    | kLen `notElem` [16,32]          = error "Salsa: key length should be 128 or 256 bits"
-    | not (nonceLen `elem` [8,12])    = error "Salsa: nonce length should be 64 or 96 bits"
+    | nonceLen `notElem` [8,12]       = error "Salsa: nonce length should be 64 or 96 bits"
-    | not (nbRounds `elem` [8,12,20]) = error "Salsa: rounds should be 8, 12 or 20"
+    | nbRounds `notElem` [8,12,20]    = error "Salsa: rounds should be 8, 12 or 20"
     | otherwise = unsafeDoIO $ do
         stPtr <- B.alloc 132 $ \stPtr ->
             B.withByteArray nonce $ \noncePtr  ->
             B.withByteArray key   $ \keyPtr ->
-                ccryptonite_salsa_init stPtr (fromIntegral nbRounds) kLen keyPtr nonceLen noncePtr
+                ccryptonite_salsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr
         return $ State stPtr
   where kLen     = B.length key
         nonceLen = B.length nonce

Crypto/Cipher/Twofish.hs

@@ -0,0 +1,45 @@
+module Crypto.Cipher.Twofish
+    ( Twofish128
+    , Twofish192
+    , Twofish256
+    ) where
+
+import Crypto.Cipher.Twofish.Primitive
+import Crypto.Cipher.Types
+import Crypto.Cipher.Utils
+
+newtype Twofish128 = Twofish128 Twofish
+
+instance Cipher Twofish128 where
+    cipherName    _ = "Twofish128"
+    cipherKeySize _ = KeySizeFixed 16
+    cipherInit key  = Twofish128 <$> (initTwofish =<< validateKeySize (undefined :: Twofish128) key)
+
+instance BlockCipher Twofish128 where
+    blockSize                 _ = 16
+    ecbEncrypt (Twofish128 key) = encrypt key
+    ecbDecrypt (Twofish128 key) = decrypt key
+
+newtype Twofish192 = Twofish192 Twofish
+
+instance Cipher Twofish192 where
+    cipherName    _ = "Twofish192"
+    cipherKeySize _ = KeySizeFixed 24
+    cipherInit key  = Twofish192 <$> (initTwofish =<< validateKeySize (undefined :: Twofish192) key)
+
+instance BlockCipher Twofish192 where
+    blockSize                 _ = 16
+    ecbEncrypt (Twofish192 key) = encrypt key
+    ecbDecrypt (Twofish192 key) = decrypt key
+
+newtype Twofish256 = Twofish256 Twofish
+
+instance Cipher Twofish256 where
+    cipherName    _ = "Twofish256"
+    cipherKeySize _ = KeySizeFixed 32
+    cipherInit key  = Twofish256 <$> (initTwofish =<< validateKeySize (undefined :: Twofish256) key)
+
+instance BlockCipher Twofish256 where
+    blockSize                 _ = 16
+    ecbEncrypt (Twofish256 key) = encrypt key
+    ecbDecrypt (Twofish256 key) = decrypt key

Crypto/Cipher/Twofish/Primitive.hs

@@ -0,0 +1,311 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE BangPatterns #-}
+module Crypto.Cipher.Twofish.Primitive
+    ( Twofish
+    , initTwofish
+    , encrypt
+    , decrypt
+    ) where
+
+import           Crypto.Error
+import           Crypto.Internal.ByteArray (ByteArray)
+import qualified Crypto.Internal.ByteArray as B
+import           Crypto.Internal.WordArray
+import           Data.Word
+import           Data.Bits
+import           Data.List
+
+-- Based on the Golang referance implementation
+-- https://github.com/golang/crypto/blob/master/twofish/twofish.go
+
+
+-- BlockSize is the constant block size of Twofish.
+blockSize :: Int
+blockSize = 16
+
+mdsPolynomial, rsPolynomial :: Word32
+mdsPolynomial = 0x169 -- x^8 + x^6 + x^5 + x^3 + 1, see [TWOFISH] 4.2
+rsPolynomial = 0x14d  -- x^8 + x^6 + x^3 + x^2 + 1, see [TWOFISH] 4.3
+
+data Twofish = Twofish { s :: (Array32, Array32, Array32, Array32)
+                       , k :: Array32 }
+
+data ByteSize = Bytes16 | Bytes24 | Bytes32 deriving (Eq)
+
+data KeyPackage ba = KeyPackage { rawKeyBytes :: ba
+                                , byteSize :: ByteSize }
+
+buildPackage :: ByteArray ba => ba -> Maybe (KeyPackage ba)
+buildPackage key
+    | B.length key == 16 = return $ KeyPackage key Bytes16
+    | B.length key == 24 = return $ KeyPackage key Bytes24
+    | B.length key == 32 = return $ KeyPackage key Bytes32
+    | otherwise = Nothing
+
+-- | Initialize a 128-bit, 192-bit, or 256-bit key
+--
+-- Return the initialized key or a error message if the given
+-- keyseed was not 16-bytes in length.
+initTwofish :: ByteArray key
+            => key -- ^ The key to create the twofish context
+            -> CryptoFailable Twofish
+initTwofish key =
+    case buildPackage key of Nothing -> CryptoFailed CryptoError_KeySizeInvalid
+                             Just keyPackage -> CryptoPassed Twofish { k = generatedK, s = generatedS }
+                                  where generatedK = array32 40 $ genK keyPackage
+                                        generatedS = genSboxes keyPackage $ sWords key
+
+mapBlocks :: ByteArray ba => (ba -> ba) -> ba -> ba
+mapBlocks operation input
+    | B.null rest = blockOutput
+    | otherwise = blockOutput `B.append` mapBlocks operation rest
+        where (block, rest) = B.splitAt blockSize input
+              blockOutput = operation block
+
+-- | Encrypts the given ByteString using the given Key
+encrypt :: ByteArray ba
+        => Twofish     -- ^ The key to use
+        -> ba           -- ^ The data to encrypt
+        -> ba
+encrypt cipher = mapBlocks (encryptBlock cipher)
+
+encryptBlock :: ByteArray ba => Twofish -> ba -> ba
+encryptBlock Twofish { s = (s1, s2, s3, s4), k = ks } message = store32ls ts
+    where (a, b, c, d) = load32ls message
+          a' = a `xor` arrayRead32 ks 0
+          b' = b `xor` arrayRead32 ks 1
+          c' = c `xor` arrayRead32 ks 2
+          d' = d `xor` arrayRead32 ks 3
+          (!a'', !b'', !c'', !d'') = foldl' shuffle (a', b', c', d') [0..7]
+          ts = (c'' `xor` arrayRead32 ks 4, d'' `xor` arrayRead32 ks 5, a'' `xor` arrayRead32 ks 6, b'' `xor` arrayRead32 ks 7)
+
+          shuffle :: (Word32, Word32, Word32, Word32) -> Int -> (Word32, Word32, Word32, Word32)
+          shuffle (!retA, !retB, !retC, !retD) ind = (retA', retB', retC', retD')
+            where [k0, k1, k2, k3] = fmap (\offset -> arrayRead32 ks $ (8 + 4 * ind) + offset) [0..3]
+                  t2 = byteIndex s2 retB `xor` byteIndex s3 (shiftR retB 8) `xor` byteIndex s4 (shiftR retB 16) `xor` byteIndex s1 (shiftR retB 24)
+                  t1 = (byteIndex s1 retA `xor` byteIndex s2 (shiftR retA 8) `xor` byteIndex s3 (shiftR retA 16) `xor` byteIndex s4 (shiftR retA 24)) + t2
+                  retC' = rotateR (retC `xor` (t1 + k0)) 1
+                  retD' = rotateL retD 1 `xor` (t1 + t2 + k1)
+                  t2' = byteIndex s2 retD' `xor` byteIndex s3 (shiftR retD' 8) `xor` byteIndex s4 (shiftR retD' 16) `xor` byteIndex s1 (shiftR retD' 24)
+                  t1' = (byteIndex s1 retC' `xor` byteIndex s2 (shiftR retC' 8) `xor` byteIndex s3 (shiftR retC' 16) `xor` byteIndex s4 (shiftR retC' 24)) + t2'
+                  retA' = rotateR (retA `xor` (t1' + k2)) 1
+                  retB' = rotateL retB 1 `xor` (t1' + t2' + k3)
+
+-- Unsafe, no bounds checking
+byteIndex :: Array32 -> Word32 -> Word32
+byteIndex xs ind  = arrayRead32 xs $ fromIntegral byte
+    where byte = ind `mod` 256
+
+-- | Decrypts the given ByteString using the given Key
+decrypt :: ByteArray ba
+        => Twofish     -- ^ The key to use
+        -> ba           -- ^ The data to decrypt
+        -> ba
+decrypt cipher = mapBlocks (decryptBlock cipher)
+
+{- decryption for 128 bits blocks -}
+decryptBlock :: ByteArray ba => Twofish -> ba -> ba
+decryptBlock Twofish { s = (s1, s2, s3, s4), k = ks } message = store32ls ixs
+    where (a, b, c, d) = load32ls message
+          a' = c `xor` arrayRead32 ks 6
+          b' = d `xor` arrayRead32 ks 7
+          c' = a `xor` arrayRead32 ks 4
+          d' = b `xor` arrayRead32 ks 5
+          (!a'', !b'', !c'', !d'') = foldl' unshuffle (a', b', c', d') [8, 7..1]
+          ixs = (a'' `xor` arrayRead32 ks 0, b'' `xor` arrayRead32 ks 1, c'' `xor` arrayRead32 ks 2, d'' `xor` arrayRead32 ks 3)
+
+          unshuffle :: (Word32, Word32, Word32, Word32) -> Int -> (Word32, Word32, Word32, Word32)
+          unshuffle (!retA, !retB, !retC, !retD) ind = (retA', retB', retC', retD')
+            where [k0, k1, k2, k3] = fmap (\offset -> arrayRead32 ks $ (4 + 4 * ind) + offset) [0..3]
+                  t2 = byteIndex s2 retD `xor` byteIndex s3 (shiftR retD 8) `xor` byteIndex s4 (shiftR retD 16) `xor` byteIndex s1 (shiftR retD 24)
+                  t1 = (byteIndex s1 retC `xor` byteIndex s2 (shiftR retC 8) `xor` byteIndex s3 (shiftR retC 16) `xor` byteIndex s4 (shiftR retC 24)) + t2
+                  retA' = rotateL retA 1 `xor` (t1 + k2)
+                  retB' = rotateR (retB `xor` (t2 + t1 + k3)) 1
+                  t2' = byteIndex s2 retB' `xor` byteIndex s3 (shiftR retB' 8) `xor` byteIndex s4 (shiftR retB' 16) `xor` byteIndex s1 (shiftR retB' 24)
+                  t1' = (byteIndex s1 retA' `xor` byteIndex s2 (shiftR retA' 8) `xor` byteIndex s3 (shiftR retA' 16) `xor` byteIndex s4 (shiftR retA' 24)) + t2'
+                  retC' = rotateL retC 1 `xor` (t1' + k0)
+                  retD' = rotateR (retD `xor` (t2' + t1' + k1)) 1
+
+sbox0 :: Int -> Word8
+sbox0 = arrayRead8 t
+    where t = array8
+            "\xa9\x67\xb3\xe8\x04\xfd\xa3\x76\x9a\x92\x80\x78\xe4\xdd\xd1\x38\
+            \\x0d\xc6\x35\x98\x18\xf7\xec\x6c\x43\x75\x37\x26\xfa\x13\x94\x48\
+            \\xf2\xd0\x8b\x30\x84\x54\xdf\x23\x19\x5b\x3d\x59\xf3\xae\xa2\x82\
+            \\x63\x01\x83\x2e\xd9\x51\x9b\x7c\xa6\xeb\xa5\xbe\x16\x0c\xe3\x61\
+            \\xc0\x8c\x3a\xf5\x73\x2c\x25\x0b\xbb\x4e\x89\x6b\x53\x6a\xb4\xf1\
+            \\xe1\xe6\xbd\x45\xe2\xf4\xb6\x66\xcc\x95\x03\x56\xd4\x1c\x1e\xd7\
+            \\xfb\xc3\x8e\xb5\xe9\xcf\xbf\xba\xea\x77\x39\xaf\x33\xc9\x62\x71\
+            \\x81\x79\x09\xad\x24\xcd\xf9\xd8\xe5\xc5\xb9\x4d\x44\x08\x86\xe7\
+            \\xa1\x1d\xaa\xed\x06\x70\xb2\xd2\x41\x7b\xa0\x11\x31\xc2\x27\x90\
+            \\x20\xf6\x60\xff\x96\x5c\xb1\xab\x9e\x9c\x52\x1b\x5f\x93\x0a\xef\
+            \\x91\x85\x49\xee\x2d\x4f\x8f\x3b\x47\x87\x6d\x46\xd6\x3e\x69\x64\
+            \\x2a\xce\xcb\x2f\xfc\x97\x05\x7a\xac\x7f\xd5\x1a\x4b\x0e\xa7\x5a\
+            \\x28\x14\x3f\x29\x88\x3c\x4c\x02\xb8\xda\xb0\x17\x55\x1f\x8a\x7d\
+            \\x57\xc7\x8d\x74\xb7\xc4\x9f\x72\x7e\x15\x22\x12\x58\x07\x99\x34\
+            \\x6e\x50\xde\x68\x65\xbc\xdb\xf8\xc8\xa8\x2b\x40\xdc\xfe\x32\xa4\
+            \\xca\x10\x21\xf0\xd3\x5d\x0f\x00\x6f\x9d\x36\x42\x4a\x5e\xc1\xe0"#
+
+sbox1 :: Int -> Word8
+sbox1 = arrayRead8 t
+    where t = array8
+            "\x75\xf3\xc6\xf4\xdb\x7b\xfb\xc8\x4a\xd3\xe6\x6b\x45\x7d\xe8\x4b\
+            \\xd6\x32\xd8\xfd\x37\x71\xf1\xe1\x30\x0f\xf8\x1b\x87\xfa\x06\x3f\
+            \\x5e\xba\xae\x5b\x8a\x00\xbc\x9d\x6d\xc1\xb1\x0e\x80\x5d\xd2\xd5\
+            \\xa0\x84\x07\x14\xb5\x90\x2c\xa3\xb2\x73\x4c\x54\x92\x74\x36\x51\
+            \\x38\xb0\xbd\x5a\xfc\x60\x62\x96\x6c\x42\xf7\x10\x7c\x28\x27\x8c\
+            \\x13\x95\x9c\xc7\x24\x46\x3b\x70\xca\xe3\x85\xcb\x11\xd0\x93\xb8\
+            \\xa6\x83\x20\xff\x9f\x77\xc3\xcc\x03\x6f\x08\xbf\x40\xe7\x2b\xe2\
+            \\x79\x0c\xaa\x82\x41\x3a\xea\xb9\xe4\x9a\xa4\x97\x7e\xda\x7a\x17\
+            \\x66\x94\xa1\x1d\x3d\xf0\xde\xb3\x0b\x72\xa7\x1c\xef\xd1\x53\x3e\
+            \\x8f\x33\x26\x5f\xec\x76\x2a\x49\x81\x88\xee\x21\xc4\x1a\xeb\xd9\
+            \\xc5\x39\x99\xcd\xad\x31\x8b\x01\x18\x23\xdd\x1f\x4e\x2d\xf9\x48\
+            \\x4f\xf2\x65\x8e\x78\x5c\x58\x19\x8d\xe5\x98\x57\x67\x7f\x05\x64\
+            \\xaf\x63\xb6\xfe\xf5\xb7\x3c\xa5\xce\xe9\x68\x44\xe0\x4d\x43\x69\
+            \\x29\x2e\xac\x15\x59\xa8\x0a\x9e\x6e\x47\xdf\x34\x35\x6a\xcf\xdc\
+            \\x22\xc9\xc0\x9b\x89\xd4\xed\xab\x12\xa2\x0d\x52\xbb\x02\x2f\xa9\
+            \\xd7\x61\x1e\xb4\x50\x04\xf6\xc2\x16\x25\x86\x56\x55\x09\xbe\x91"#
+
+rs :: [[Word8]]
+rs = [ [0x01, 0xA4, 0x55, 0x87, 0x5A, 0x58, 0xDB, 0x9E]
+     , [0xA4, 0x56, 0x82, 0xF3, 0x1E, 0xC6, 0x68, 0xE5]
+     , [0x02, 0xA1, 0xFC, 0xC1, 0x47, 0xAE, 0x3D, 0x19]
+     , [0xA4, 0x55, 0x87, 0x5A, 0x58, 0xDB, 0x9E, 0x03] ]
+
+
+
+load32ls :: ByteArray ba => ba -> (Word32, Word32, Word32, Word32)
+load32ls message = (intify q1, intify q2, intify q3, intify q4)
+    where (half1, half2) = B.splitAt 8 message
+          (q1, q2) = B.splitAt 4 half1
+          (q3, q4) = B.splitAt 4 half2
+
+          intify :: ByteArray ba => ba -> Word32
+          intify bytes = foldl' (\int (!word, !ind) -> int .|. shiftL (fromIntegral word) (ind * 8) ) 0 (zip (B.unpack bytes) [0..])
+
+store32ls :: ByteArray ba => (Word32, Word32, Word32, Word32) -> ba
+store32ls (a, b, c, d) = B.pack $ concatMap splitWordl [a, b, c, d]
+    where splitWordl :: Word32 -> [Word8]
+          splitWordl w = fmap (\ind -> fromIntegral $ shiftR w (8 * ind)) [0..3]
+
+
+-- Create S words
+sWords :: ByteArray ba => ba -> [Word8]
+sWords key = sWord
+    where word64Count = B.length key `div` 2
+          sWord = concatMap (\wordIndex ->
+                        map (\rsRow ->
+                            foldl' (\acc (!rsVal, !colIndex) ->
+                                acc `xor` gfMult rsPolynomial (B.index key $ 8 * wordIndex + colIndex) rsVal
+                                ) 0 (zip rsRow [0..])
+                            ) rs
+                    ) [0..word64Count - 1]
+
+data Column = Zero | One | Two | Three deriving (Show, Eq, Enum, Bounded)
+
+genSboxes :: KeyPackage ba -> [Word8] -> (Array32, Array32, Array32, Array32)
+genSboxes keyPackage ws = (mkArray b0', mkArray b1', mkArray b2', mkArray b3')
+    where range = [0..255]
+          mkArray = array32 256
+          [w0, w1, w2, w3, w4, w5, w6, w7, w8, w9, w10, w11, w12, w13, w14, w15] = take 16 ws
+          (b0', b1', b2', b3') = sboxBySize $ byteSize keyPackage
+
+          sboxBySize :: ByteSize -> ([Word32], [Word32], [Word32], [Word32])
+          sboxBySize Bytes16 = (b0, b1, b2, b3)
+            where !b0 = fmap mapper range
+                    where mapper :: Int -> Word32
+                          mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox0 . fromIntegral $ sbox0 byte `xor` w0) `xor` w4)) Zero
+                  !b1 = fmap mapper range
+                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox0 . fromIntegral $ sbox1 byte `xor` w1) `xor` w5)) One
+                  !b2 = fmap mapper range
+                    where mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox1 . fromIntegral $ sbox0 byte `xor` w2) `xor` w6)) Two
+                  !b3 = fmap mapper range
+                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox1 . fromIntegral $ sbox1 byte `xor` w3) `xor` w7)) Three
+
+          sboxBySize Bytes24 = (b0, b1, b2, b3)
+            where !b0 = fmap mapper range
+                    where mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox0 . fromIntegral) ((sbox0 . fromIntegral $ sbox1 byte `xor` w0) `xor` w4) `xor` w8)) Zero
+                  !b1 = fmap mapper range
+                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox0 . fromIntegral) ((sbox1 . fromIntegral $ sbox1 byte `xor` w1) `xor` w5) `xor` w9)) One
+                  !b2 = fmap mapper range
+                    where mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox1 . fromIntegral) ((sbox0 . fromIntegral $ sbox0 byte `xor` w2) `xor` w6) `xor` w10)) Two
+                  !b3 = fmap mapper range
+                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox1 . fromIntegral) ((sbox1 . fromIntegral $ sbox0 byte `xor` w3) `xor` w7) `xor` w11)) Three
+
+          sboxBySize Bytes32 = (b0, b1, b2, b3)
+            where !b0 = fmap mapper range
+                    where mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox0 . fromIntegral) ((sbox0 . fromIntegral) ((sbox1 . fromIntegral $ sbox1 byte `xor` w0) `xor` w4) `xor` w8) `xor` w12)) Zero
+                  !b1 = fmap mapper range
+                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox0 . fromIntegral) ((sbox1 . fromIntegral) ((sbox1 . fromIntegral $ sbox0 byte `xor` w1) `xor` w5) `xor` w9) `xor` w13)) One
+                  !b2 = fmap mapper range
+                    where mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox1 . fromIntegral) ((sbox0 . fromIntegral) ((sbox0 . fromIntegral $ sbox0 byte `xor` w2) `xor` w6) `xor` w10) `xor` w14)) Two
+                  !b3 = fmap mapper range
+                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox1 . fromIntegral) ((sbox1 . fromIntegral) ((sbox0 . fromIntegral $ sbox1 byte `xor` w3) `xor` w7) `xor` w11) `xor` w15)) Three
+
+genK :: (ByteArray ba) => KeyPackage ba -> [Word32]
+genK keyPackage = concatMap makeTuple [0..19]
+    where makeTuple :: Word8 -> [Word32]
+          makeTuple idx = [a + b', rotateL (2 * b' + a) 9]
+            where tmp1 = replicate 4 $ 2 * idx
+                  tmp2 = fmap (+1) tmp1
+                  a = h tmp1 keyPackage 0
+                  b = h tmp2 keyPackage 1
+                  b' = rotateL b 8
+
+h :: (ByteArray ba) => [Word8] -> KeyPackage ba -> Int -> Word32
+h input keyPackage offset =  foldl' xorMdsColMult 0 $ zip [y0f, y1f, y2f, y3f] $ enumFrom Zero
+    where key = rawKeyBytes keyPackage
+          [y0, y1, y2, y3] = take 4 input
+          (!y0f, !y1f, !y2f, !y3f) = run (y0, y1, y2, y3) $ byteSize keyPackage
+
+          run :: (Word8, Word8, Word8, Word8) -> ByteSize -> (Word8, Word8, Word8, Word8)
+          run (!y0'', !y1'', !y2'', !y3'') Bytes32 = run (y0', y1', y2', y3') Bytes24
+            where y0' = sbox1 (fromIntegral y0'') `xor` B.index key (4 * (6 + offset) + 0)
+                  y1' = sbox0 (fromIntegral y1'') `xor` B.index key (4 * (6 + offset) + 1)
+                  y2' = sbox0 (fromIntegral y2'') `xor` B.index key (4 * (6 + offset) + 2)
+                  y3' = sbox1 (fromIntegral y3'') `xor` B.index key (4 * (6 + offset) + 3)
+
+          run (!y0'', !y1'', !y2'', !y3'') Bytes24 = run (y0', y1', y2', y3') Bytes16
+            where y0' = sbox1 (fromIntegral y0'') `xor` B.index key (4 * (4 + offset) + 0)
+                  y1' = sbox1 (fromIntegral y1'') `xor` B.index key (4 * (4 + offset) + 1)
+                  y2' = sbox0 (fromIntegral y2'') `xor` B.index key (4 * (4 + offset) + 2)
+                  y3' = sbox0 (fromIntegral y3'') `xor` B.index key (4 * (4 + offset) + 3)
+
+          run (!y0'', !y1'', !y2'', !y3'') Bytes16 = (y0', y1', y2', y3')
+            where y0' = sbox1 . fromIntegral $ (sbox0 . fromIntegral $ (sbox0 (fromIntegral y0'') `xor` B.index key (4 * (2 + offset) + 0))) `xor` B.index key (4 * (0 + offset) + 0)
+                  y1' = sbox0 . fromIntegral $ (sbox0 . fromIntegral $ (sbox1 (fromIntegral y1'') `xor` B.index key (4 * (2 + offset) + 1))) `xor` B.index key (4 * (0 + offset) + 1)
+                  y2' = sbox1 . fromIntegral $ (sbox1 . fromIntegral $ (sbox0 (fromIntegral y2'') `xor` B.index key (4 * (2 + offset) + 2))) `xor` B.index key (4 * (0 + offset) + 2)
+                  y3' = sbox0 . fromIntegral $ (sbox1 . fromIntegral $ (sbox1 (fromIntegral y3'') `xor` B.index key (4 * (2 + offset) + 3))) `xor` B.index key (4 * (0 + offset) + 3)
+
+          xorMdsColMult :: Word32 -> (Word8, Column) -> Word32
+          xorMdsColMult acc wordAndIndex = acc `xor` uncurry mdsColumnMult wordAndIndex
+
+mdsColumnMult :: Word8 -> Column -> Word32
+mdsColumnMult !byte !col =
+    case col of Zero  -> input .|. rotateL mul5B 8 .|. rotateL mulEF 16 .|. rotateL mulEF 24
+                One   -> mulEF .|. rotateL mulEF 8 .|. rotateL mul5B 16 .|. rotateL input 24
+                Two   -> mul5B .|. rotateL mulEF 8 .|. rotateL input 16 .|. rotateL mulEF 24
+                Three -> mul5B .|. rotateL input 8 .|. rotateL mulEF 16 .|. rotateL mul5B 24
+        where input = fromIntegral byte
+              mul5B = fromIntegral $ gfMult mdsPolynomial byte 0x5B
+              mulEF = fromIntegral $ gfMult mdsPolynomial byte 0xEF
+
+tupInd :: (Bits b) => b -> (a, a) -> a
+tupInd b
+    | testBit b 0 = snd
+    | otherwise = fst
+
+gfMult :: Word32 -> Word8 -> Word8 -> Word8
+gfMult p a b = fromIntegral $ run a b' p' result 0
+    where b' = (0, fromIntegral b)
+          p' = (0, p)
+          result = 0
+
+          run :: Word8 -> (Word32, Word32) -> (Word32, Word32) -> Word32 -> Int -> Word32
+          run a' b'' p'' result' count =
+            if count == 7
+            then result''
+            else run a'' b''' p'' result'' (count + 1)
+                where result'' = result' `xor` tupInd (a' .&. 1) b''
+                      a'' = shiftR a' 1
+                      b''' = (fst b'', tupInd (shiftR (snd b'') 7) p'' `xor` shiftL (snd b'') 1)

Crypto/Cipher/Types.hs

@@ -5,7 +5,7 @@
 -- Stability   : Stable
 -- Portability : Excellent
 --
--- symmetric cipher basic types
+-- Symmetric cipher basic types
 --
 {-# LANGUAGE DeriveDataTypeable #-}
 module Crypto.Cipher.Types
@@ -21,6 +21,8 @@ module Crypto.Cipher.Types
     -- , cfb8Decrypt
     -- * AEAD functions
     , AEADMode(..)
+    , CCM_M(..)
+    , CCM_L(..)
     , module Crypto.Cipher.Types.AEAD
     -- * Initial Vector type and constructor
     , IV

Crypto/Cipher/Types/AEAD.hs

@@ -27,24 +27,24 @@ data AEADModeImpl st = AEADModeImpl
 -- | Authenticated Encryption with Associated Data algorithms
 data AEAD cipher = forall st . AEAD
     { aeadModeImpl :: AEADModeImpl st
-    , aeadState    :: st
+    , aeadState    :: !st
     }
 
 -- | Append some header information to an AEAD context
 aeadAppendHeader :: ByteArrayAccess aad => AEAD cipher -> aad -> AEAD cipher
-aeadAppendHeader (AEAD impl st) aad = AEAD impl $ (aeadImplAppendHeader impl) st aad
+aeadAppendHeader (AEAD impl st) aad = AEAD impl $ aeadImplAppendHeader impl st aad
 
 -- | Encrypt some data and update the AEAD context
 aeadEncrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher)
-aeadEncrypt (AEAD impl st) ba = second (AEAD impl) $ (aeadImplEncrypt impl) st ba
+aeadEncrypt (AEAD impl st) ba = second (AEAD impl) $ aeadImplEncrypt impl st ba
 
 -- | Decrypt some data and update the AEAD context
 aeadDecrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher)
-aeadDecrypt (AEAD impl st) ba = second (AEAD impl) $ (aeadImplDecrypt impl) st ba
+aeadDecrypt (AEAD impl st) ba = second (AEAD impl) $ aeadImplDecrypt impl st ba
 
 -- | Finalize the AEAD context and return the authentication tag
 aeadFinalize :: AEAD cipher -> Int -> AuthTag
-aeadFinalize (AEAD impl st) n = (aeadImplFinalize impl) st n
+aeadFinalize (AEAD impl st) = aeadImplFinalize impl st
 
 -- | Simple AEAD encryption
 aeadSimpleEncrypt :: (ByteArrayAccess aad, ByteArray ba)

Crypto/Cipher/Types/Base.hs

@@ -5,7 +5,7 @@
 -- Stability   : Stable
 -- Portability : Excellent
 --
--- symmetric cipher basic types
+-- Symmetric cipher basic types
 --
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -14,12 +14,15 @@ module Crypto.Cipher.Types.Base
     , Cipher(..)
     , AuthTag(..)
     , AEADMode(..)
+    , CCM_M(..)
+    , CCM_L(..)
     , DataUnitOffset
     ) where
 
 import           Data.Word
 import           Crypto.Internal.ByteArray (Bytes, ByteArrayAccess, ByteArray)
 import qualified Crypto.Internal.ByteArray as B
+import           Crypto.Internal.DeepSeq
 import           Crypto.Error
 
 -- | Different specifier for key size in bytes
@@ -34,15 +37,18 @@ type DataUnitOffset = Word32
 
 -- | Authentication Tag for AE cipher mode
 newtype AuthTag = AuthTag { unAuthTag :: Bytes }
-    deriving (Show, ByteArrayAccess)
+    deriving (Show, ByteArrayAccess, NFData)
 
 instance Eq AuthTag where
     (AuthTag a) == (AuthTag b) = B.constEq a b
 
+data CCM_M = CCM_M4 | CCM_M6 | CCM_M8 | CCM_M10 | CCM_M12 | CCM_M14 | CCM_M16 deriving (Show, Eq)
+data CCM_L = CCM_L2 | CCM_L3 | CCM_L4 deriving (Show, Eq)
+
 -- | AEAD Mode
 data AEADMode =
       AEAD_OCB -- OCB3
-    | AEAD_CCM
+    | AEAD_CCM Int CCM_M CCM_L
     | AEAD_EAX
     | AEAD_CWC
     | AEAD_GCM

Crypto/Cipher/Types/Block.hs

@@ -5,7 +5,7 @@
 -- Stability   : Stable
 -- Portability : Excellent
 --
--- block cipher basic types
+-- Block cipher basic types
 --
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ExistentialQuantification #-}
@@ -16,7 +16,7 @@ module Crypto.Cipher.Types.Block
     -- * BlockCipher
       BlockCipher(..)
     , BlockCipher128(..)
-    -- * initialization vector (IV)
+    -- * Initialization vector (IV)
     , IV(..)
     , makeIV
     , nullIV
@@ -37,7 +37,6 @@ module Crypto.Cipher.Types.Block
     ) where
 
 import           Data.Word
-import           Data.Monoid
 import           Crypto.Error
 import           Crypto.Cipher.Types.Base
 import           Crypto.Cipher.Types.GF
@@ -164,27 +163,20 @@ nullIV = toIV undefined
 -- | Increment an IV by a number.
 --
 -- Assume the IV is in Big Endian format.
-ivAdd :: BlockCipher c => IV c -> Int -> IV c
+ivAdd :: IV c -> Int -> IV c
 ivAdd (IV b) i = IV $ copy b
   where copy :: ByteArray bs => bs -> bs
-        copy bs = B.copyAndFreeze bs $ \p -> do
+        copy bs = B.copyAndFreeze bs $ loop i (B.length bs - 1)
-            let until0 accu = do
-                  r <- loop accu (B.length bs - 1) p
-                  case r of
-                      0 -> return ()
-                      _ -> until0 r
-            until0 i
 
-        loop :: Int -> Int -> Ptr Word8 -> IO Int
+        loop :: Int -> Int -> Ptr Word8 -> IO ()
-        loop 0   _   _ = return 0
+        loop acc ofs p
-        loop acc ofs p = do
+            | ofs < 0   = return ()
-            v <- peek (p `plusPtr` ofs) :: IO Word8
+            | otherwise = do
-            let accv    = acc + fromIntegral v
+                v <- peek (p `plusPtr` ofs) :: IO Word8
-                (hi,lo) = accv `divMod` 256
+                let accv    = acc + fromIntegral v
-            poke (p `plusPtr` ofs) (fromIntegral lo :: Word8)
+                    (hi,lo) = accv `divMod` 256
-            if ofs == 0
+                poke (p `plusPtr` ofs) (fromIntegral lo :: Word8)
-                then return hi
+                loop hi (ofs - 1) p
-                else loop hi (ofs - 1) p
 
 cbcEncryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
 cbcEncryptGeneric cipher ivini input = mconcat $ doEnc ivini $ chunk (blockSize cipher) input

Crypto/Cipher/Types/Stream.hs

@@ -5,7 +5,7 @@
 -- Stability   : Stable
 -- Portability : Excellent
 --
--- stream cipher basic types
+-- Stream cipher basic types
 --
 module Crypto.Cipher.Types.Stream
     ( StreamCipher(..)

Crypto/Cipher/Types/Utils.hs

@@ -5,7 +5,7 @@
 -- Stability   : Stable
 -- Portability : Excellent
 --
--- basic utility for cipher related stuff
+-- Basic utility for cipher related stuff
 --
 module Crypto.Cipher.Types.Utils where
 

Crypto/Cipher/Utils.hs

@@ -0,0 +1,18 @@
+module Crypto.Cipher.Utils
+    ( validateKeySize
+    ) where
+
+import Crypto.Error
+import Crypto.Cipher.Types
+
+import Data.ByteArray as BA
+
+validateKeySize :: (ByteArrayAccess key, Cipher cipher) => cipher -> key -> CryptoFailable key
+validateKeySize c k = if validKeyLength
+                      then CryptoPassed k
+                      else CryptoFailed CryptoError_KeySizeInvalid
+  where keyLength = BA.length k
+        validKeyLength = case cipherKeySize c of
+          KeySizeRange low high -> keyLength >= low && keyLength <= high
+          KeySizeEnum lengths -> keyLength `elem` lengths
+          KeySizeFixed s -> keyLength == s

Crypto/Cipher/XSalsa.hs

@@ -12,18 +12,17 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Crypto.Cipher.XSalsa
     ( initialize
+    , derive
     , combine
     , generate
     , State
     ) where
 
-import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes)
+import           Crypto.Internal.ByteArray (ByteArrayAccess)
 import qualified Crypto.Internal.ByteArray as B
 import           Crypto.Internal.Compat
 import           Crypto.Internal.Imports
 import           Foreign.Ptr
-import           Foreign.Storable
-import           Foreign.C.Types
 import           Crypto.Cipher.Salsa hiding (initialize)
 
 -- | Initialize a new XSalsa context with the number of rounds,
@@ -36,15 +35,41 @@ initialize :: (ByteArrayAccess key, ByteArrayAccess nonce)
 initialize nbRounds key nonce
     | kLen /= 32                      = error "XSalsa: key length should be 256 bits"
     | nonceLen /= 24                  = error "XSalsa: nonce length should be 192 bits"
-    | not (nbRounds `elem` [8,12,20]) = error "XSalsa: rounds should be 8, 12 or 20"
+    | nbRounds `notElem` [8,12,20]    = error "XSalsa: rounds should be 8, 12 or 20"
     | otherwise = unsafeDoIO $ do
         stPtr <- B.alloc 132 $ \stPtr ->
             B.withByteArray nonce $ \noncePtr  ->
             B.withByteArray key   $ \keyPtr ->
-                ccryptonite_xsalsa_init stPtr (fromIntegral nbRounds) kLen keyPtr nonceLen noncePtr
+                ccryptonite_xsalsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr
         return $ State stPtr
   where kLen     = B.length key
         nonceLen = B.length nonce
 
+-- | Use an already initialized context and new nonce material to derive another
+-- XSalsa context.
+--
+-- This allows a multi-level cascade where a first key @k1@ and nonce @n1@ is
+-- used to get @HState(k1,n1)@, and this value is then used as key @k2@ to build
+-- @XSalsa(k2,n2)@.  Function 'initialize' is to be called with the first 192
+-- bits of @n1|n2@, and the call to @derive@ should add the remaining 128 bits.
+--
+-- The output context always uses the same number of rounds as the input
+-- context.
+derive :: ByteArrayAccess nonce
+       => State  -- ^ base XSalsa state
+       -> nonce  -- ^ the remainder nonce (128 bits)
+       -> State  -- ^ the new XSalsa state
+derive (State stPtr') nonce
+    | nonceLen /= 16 = error "XSalsa: nonce length should be 128 bits"
+    | otherwise = unsafeDoIO $ do
+        stPtr <- B.copy stPtr' $ \stPtr ->
+            B.withByteArray nonce $ \noncePtr  ->
+                ccryptonite_xsalsa_derive stPtr nonceLen noncePtr
+        return $ State stPtr
+  where nonceLen = B.length nonce
+
 foreign import ccall "cryptonite_xsalsa_init"
     ccryptonite_xsalsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
+
+foreign import ccall "cryptonite_xsalsa_derive"
+    ccryptonite_xsalsa_derive :: Ptr State -> Int -> Ptr Word8 -> IO ()

Crypto/ConstructHash/MiyaguchiPreneel.hs

@@ -5,7 +5,7 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- provide the hash function construction method from block cipher
+-- Provide the hash function construction method from block cipher
 -- <https://en.wikipedia.org/wiki/One-way_compression_function>
 --
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -44,7 +44,7 @@ compute' g = MP . foldl' (step $ g) (B.replicate bsz 0) . chunks . pad (ZERO bsz
       where
         (hd, tl) = B.splitAt bsz msg
 
--- | Compute Miyaguchi-Preneel one way compress using the infered block cipher.
+-- | Compute Miyaguchi-Preneel one way compress using the inferred block cipher.
 --   Only safe when KEY-SIZE equals to BLOCK-SIZE.
 --
 --   Simple usage /mp' msg :: MiyaguchiPreneel AES128/

Crypto/Data/AFIS.hs

@@ -5,7 +5,7 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- haskell implementation of the Anti-forensic information splitter
+-- Haskell implementation of the Anti-forensic information splitter
 -- available in LUKS. <http://clemens.endorphin.org/AFsplitter>
 --
 -- The algorithm bloats an arbitrary secret with many bits that are necessary for
@@ -77,7 +77,7 @@ split hashAlg rng expandTimes src
             diffuse hashAlg lastBlock blockSize
         fillRandomBlock g blockPtr = do
             let (rand :: Bytes, g') = randomBytesGenerate blockSize g
-            B.withByteArray rand $ \randPtr -> memCopy blockPtr randPtr (fromIntegral blockSize)
+            B.withByteArray rand $ \randPtr -> memCopy blockPtr randPtr blockSize
             return g'
 
 -- | Merge previously diffused data back to the original data.

Crypto/Data/Padding.hs

@@ -6,7 +6,7 @@
 -- Portability : unknown
 --
 -- Various cryptographic padding commonly used for block ciphers
--- or assymetric systems.
+-- or asymmetric systems.
 --
 module Crypto.Data.Padding
     ( Format(..)

Crypto/ECC.hs

@@ -7,6 +7,8 @@
 --
 -- Elliptic Curve Cryptography
 --
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -16,27 +18,33 @@ module Crypto.ECC
     , Curve_P521R1(..)
     , Curve_X25519(..)
     , Curve_X448(..)
+    , Curve_Edwards25519(..)
     , EllipticCurve(..)
     , EllipticCurveDH(..)
     , EllipticCurveArith(..)
+    , EllipticCurveBasepointArith(..)
     , KeyPair(..)
     , SharedSecret(..)
     ) where
 
 import qualified Crypto.PubKey.ECC.P256 as P256
+import qualified Crypto.ECC.Edwards25519 as Edwards25519
 import qualified Crypto.ECC.Simple.Types as Simple
 import qualified Crypto.ECC.Simple.Prim as Simple
 import           Crypto.Random
 import           Crypto.Error
-import           Crypto.Internal.Proxy
 import           Crypto.Internal.Imports
 import           Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
 import qualified Crypto.Internal.ByteArray as B
+import           Crypto.Number.Basic (numBits)
 import           Crypto.Number.Serialize (i2ospOf_, os2ip)
+import qualified Crypto.Number.Serialize.LE as LE
 import qualified Crypto.PubKey.Curve25519 as X25519
 import qualified Crypto.PubKey.Curve448 as X448
-import           Data.Function (on)
 import           Data.ByteArray (convert)
+import           Data.Data (Data())
+import           Data.Kind (Type)
+import           Data.Proxy
 
 -- | An elliptic curve key pair composed of the private part (a scalar), and
 -- the associated point.
@@ -46,14 +54,14 @@ data KeyPair curve = KeyPair
     }
 
 newtype SharedSecret = SharedSecret ScrubbedBytes
-    deriving (Eq, ByteArrayAccess)
+    deriving (Eq, ByteArrayAccess, NFData)
 
 class EllipticCurve curve where
     -- | Point on an Elliptic Curve
-    type Point curve  :: *
+    type Point curve  :: Type
 
     -- | Scalar in the Elliptic Curve domain
-    type Scalar curve :: *
+    type Scalar curve :: Type
 
     -- | Generate a new random scalar on the curve.
     -- The scalar will represent a number between 1 and the order of the curve non included
@@ -78,22 +86,69 @@ class EllipticCurve curve => EllipticCurveDH curve where
     -- is not hashed.
     --
     -- use `pointSmul` to keep the result in Point format.
-    ecdh :: proxy curve -> Scalar curve -> Point curve -> SharedSecret
+    --
+    -- /WARNING:/ Curve implementations may return a special value or an
+    -- exception when the public point lies in a subgroup of small order.
+    -- This function is adequate when the scalar is in expected range and
+    -- contributory behaviour is not needed.  Otherwise use 'ecdh'.
+    ecdhRaw :: proxy curve -> Scalar curve -> Point curve -> SharedSecret
+    ecdhRaw prx s = throwCryptoError . ecdh prx s
 
-class EllipticCurve curve => EllipticCurveArith curve where
+    -- | Generate a Diffie hellman secret value and verify that the result
+    -- is not the point at infinity.
+    --
+    -- This additional test avoids risks existing with function 'ecdhRaw'.
+    -- Implementations always return a 'CryptoError' instead of a special
+    -- value or an exception.
+    ecdh :: proxy curve -> Scalar curve -> Point curve -> CryptoFailable SharedSecret
+
+class (EllipticCurve curve, Eq (Point curve)) => EllipticCurveArith curve where
     -- | Add points on a curve
     pointAdd :: proxy curve -> Point curve -> Point curve -> Point curve
 
+    -- | Negate a curve point
+    pointNegate :: proxy curve -> Point curve -> Point curve
+
     -- | Scalar Multiplication on a curve
     pointSmul :: proxy curve -> Scalar curve -> Point curve -> Point curve
 
 --   -- | Scalar Inverse
 --   scalarInverse :: Scalar curve -> Scalar curve
 
+class (EllipticCurveArith curve, Eq (Scalar curve)) => EllipticCurveBasepointArith curve where
+    -- | Get the curve order size in bits
+    curveOrderBits :: proxy curve -> Int
+
+    -- | Multiply a scalar with the curve base point
+    pointBaseSmul :: proxy curve -> Scalar curve -> Point curve
+
+    -- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@
+    pointsSmulVarTime :: proxy curve -> Scalar curve -> Scalar curve -> Point curve -> Point curve
+    pointsSmulVarTime prx s1 s2 p = pointAdd prx (pointBaseSmul prx s1) (pointSmul prx s2 p)
+
+    -- | Encode an elliptic curve scalar into big-endian form
+    encodeScalar :: ByteArray bs => proxy curve -> Scalar curve -> bs
+
+    -- | Try to decode the big-endian form of an elliptic curve scalar
+    decodeScalar :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Scalar curve)
+
+    -- | Convert an elliptic curve scalar to an integer
+    scalarToInteger :: proxy curve -> Scalar curve -> Integer
+
+    -- | Try to create an elliptic curve scalar from an integer
+    scalarFromInteger :: proxy curve -> Integer -> CryptoFailable (Scalar curve)
+
+    -- | Add two scalars and reduce modulo the curve order
+    scalarAdd :: proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
+
+    -- | Multiply two scalars and reduce modulo the curve order
+    scalarMul :: proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
+
 -- | P256 Curve
 --
 -- also known as P256
 data Curve_P256R1 = Curve_P256R1
+    deriving (Show,Data)
 
 instance EllipticCurve Curve_P256R1 where
     type Point Curve_P256R1 = P256.Point
@@ -111,20 +166,34 @@ instance EllipticCurve Curve_P256R1 where
             uncompressed = B.singleton 4
             xy = P256.pointToBinary p
     decodePoint _ mxy = case B.uncons mxy of
-        Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid
+        Nothing -> CryptoFailed CryptoError_PointSizeInvalid
         Just (m,xy)
             -- uncompressed
             | m == 4 -> P256.pointFromBinary xy
-            | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid
+            | otherwise -> CryptoFailed CryptoError_PointFormatInvalid
 
 instance EllipticCurveArith Curve_P256R1 where
     pointAdd  _ a b = P256.pointAdd a b
+    pointNegate _ p = P256.pointNegate p
     pointSmul _ s p = P256.pointMul s p
 
 instance EllipticCurveDH Curve_P256R1 where
-    ecdh _ s p = SharedSecret $ P256.pointDh s p
+    ecdhRaw _ s p = SharedSecret $ P256.pointDh s p
+    ecdh  prx s p = checkNonZeroDH (ecdhRaw prx s p)
+
+instance EllipticCurveBasepointArith Curve_P256R1 where
+    curveOrderBits _ = 256
+    pointBaseSmul _ = P256.toPoint
+    pointsSmulVarTime _ = P256.pointsMulVarTime
+    encodeScalar _ = P256.scalarToBinary
+    decodeScalar _ = P256.scalarFromBinary
+    scalarToInteger _ = P256.scalarToInteger
+    scalarFromInteger _ = P256.scalarFromInteger
+    scalarAdd _ = P256.scalarAdd
+    scalarMul _ = P256.scalarMul
 
 data Curve_P384R1 = Curve_P384R1
+    deriving (Show,Data)
 
 instance EllipticCurve Curve_P384R1 where
     type Point Curve_P384R1 = Simple.Point Simple.SEC_p384r1
@@ -138,15 +207,27 @@ instance EllipticCurve Curve_P384R1 where
 
 instance EllipticCurveArith Curve_P384R1 where
     pointAdd _ a b = Simple.pointAdd a b
+    pointNegate _ p = Simple.pointNegate p
     pointSmul _ s p = Simple.pointMul s p
 
 instance EllipticCurveDH Curve_P384R1 where
-    ecdh _ s p = SharedSecret $ i2ospOf_ (curveSizeBytes prx) x
+    ecdh _ s p = encodeECShared prx (Simple.pointMul s p)
       where
-        prx = Proxy :: Proxy Curve_P384R1
+        prx = Proxy :: Proxy Simple.SEC_p384r1
-        Simple.Point x _ = pointSmul prx s p
+
+instance EllipticCurveBasepointArith Curve_P384R1 where
+    curveOrderBits _ = 384
+    pointBaseSmul _ = Simple.pointBaseMul
+    pointsSmulVarTime _ = ecPointsMulVarTime
+    encodeScalar _ = ecScalarToBinary
+    decodeScalar _ = ecScalarFromBinary
+    scalarToInteger _ = ecScalarToInteger
+    scalarFromInteger _ = ecScalarFromInteger
+    scalarAdd _ = ecScalarAdd
+    scalarMul _ = ecScalarMul
 
 data Curve_P521R1 = Curve_P521R1
+    deriving (Show,Data)
 
 instance EllipticCurve Curve_P521R1 where
     type Point Curve_P521R1 = Simple.Point Simple.SEC_p521r1
@@ -160,15 +241,27 @@ instance EllipticCurve Curve_P521R1 where
 
 instance EllipticCurveArith Curve_P521R1 where
     pointAdd _ a b = Simple.pointAdd a b
+    pointNegate _ p = Simple.pointNegate p
     pointSmul _ s p = Simple.pointMul s p
 
 instance EllipticCurveDH Curve_P521R1 where
-    ecdh _ s p = SharedSecret $ i2ospOf_ (curveSizeBytes prx) x
+    ecdh _ s p = encodeECShared prx (Simple.pointMul s p)
       where
-        prx = Proxy :: Proxy Curve_P521R1
+        prx = Proxy :: Proxy Simple.SEC_p521r1
-        Simple.Point x _ = pointSmul prx s p
+
+instance EllipticCurveBasepointArith Curve_P521R1 where
+    curveOrderBits _ = 521
+    pointBaseSmul _ = Simple.pointBaseMul
+    pointsSmulVarTime _ = ecPointsMulVarTime
+    encodeScalar _ = ecScalarToBinary
+    decodeScalar _ = ecScalarFromBinary
+    scalarToInteger _ = ecScalarToInteger
+    scalarFromInteger _ = ecScalarFromInteger
+    scalarAdd _ = ecScalarAdd
+    scalarMul _ = ecScalarMul
 
 data Curve_X25519 = Curve_X25519
+    deriving (Show,Data)
 
 instance EllipticCurve Curve_X25519 where
     type Point Curve_X25519 = X25519.PublicKey
@@ -182,10 +275,12 @@ instance EllipticCurve Curve_X25519 where
     decodePoint _ bs = X25519.publicKey bs
 
 instance EllipticCurveDH Curve_X25519 where
-    ecdh _ s p = SharedSecret $ convert secret
+    ecdhRaw _ s p = SharedSecret $ convert secret
       where secret = X25519.dh p s
+    ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p)
 
 data Curve_X448 = Curve_X448
+    deriving (Show,Data)
 
 instance EllipticCurve Curve_X448 where
     type Point Curve_X448 = X448.PublicKey
@@ -199,8 +294,52 @@ instance EllipticCurve Curve_X448 where
     decodePoint _ bs = X448.publicKey bs
 
 instance EllipticCurveDH Curve_X448 where
-    ecdh _ s p = SharedSecret $ convert secret
+    ecdhRaw _ s p = SharedSecret $ convert secret
       where secret = X448.dh p s
+    ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p)
+
+data Curve_Edwards25519 = Curve_Edwards25519
+    deriving (Show,Data)
+
+instance EllipticCurve Curve_Edwards25519 where
+    type Point Curve_Edwards25519 = Edwards25519.Point
+    type Scalar Curve_Edwards25519 = Edwards25519.Scalar
+    curveSizeBits _ = 255
+    curveGenerateScalar _ = Edwards25519.scalarGenerate
+    curveGenerateKeyPair _ = toKeyPair <$> Edwards25519.scalarGenerate
+      where toKeyPair scalar = KeyPair (Edwards25519.toPoint scalar) scalar
+    encodePoint _ point = Edwards25519.pointEncode point
+    decodePoint _ bs = Edwards25519.pointDecode bs
+
+instance EllipticCurveArith Curve_Edwards25519 where
+    pointAdd _ a b = Edwards25519.pointAdd a b
+    pointNegate _ p = Edwards25519.pointNegate p
+    pointSmul _ s p = Edwards25519.pointMul s p
+
+instance EllipticCurveBasepointArith Curve_Edwards25519 where
+    curveOrderBits _ = 253
+    pointBaseSmul _ = Edwards25519.toPoint
+    pointsSmulVarTime _ = Edwards25519.pointsMulVarTime
+    encodeScalar _ = B.reverse . Edwards25519.scalarEncode
+    decodeScalar _ bs
+        | B.length bs == 32 = Edwards25519.scalarDecodeLong (B.reverse bs)
+        | otherwise         = CryptoFailed CryptoError_SecretKeySizeInvalid
+    scalarToInteger _ s = LE.os2ip (Edwards25519.scalarEncode s :: B.Bytes)
+    scalarFromInteger _ i =
+        case LE.i2ospOf 32 i of
+            Nothing -> CryptoFailed CryptoError_SecretKeySizeInvalid
+            Just bs -> Edwards25519.scalarDecodeLong (bs :: B.Bytes)
+    scalarAdd _ = Edwards25519.scalarAdd
+    scalarMul _ = Edwards25519.scalarMul
+
+checkNonZeroDH :: SharedSecret -> CryptoFailable SharedSecret
+checkNonZeroDH s@(SharedSecret b)
+    | B.constAllZero b = CryptoFailed CryptoError_ScalarMultiplicationInvalid
+    | otherwise        = CryptoPassed s
+
+encodeECShared :: Simple.Curve curve => Proxy curve -> Simple.Point curve -> CryptoFailable SharedSecret
+encodeECShared _   Simple.PointO      = CryptoFailed CryptoError_ScalarMultiplicationInvalid
+encodeECShared prx (Simple.Point x _) = CryptoPassed . SharedSecret $ i2ospOf_ (Simple.curveSizeBytes prx) x
 
 encodeECPoint :: forall curve bs . (Simple.Curve curve, ByteArray bs) => Simple.Point curve -> bs
 encodeECPoint Simple.PointO      = error "encodeECPoint: cannot serialize point at infinity"
@@ -214,7 +353,7 @@ encodeECPoint (Simple.Point x y) = B.concat [uncompressed,xb,yb]
 
 decodeECPoint :: (Simple.Curve curve, ByteArray bs) => bs -> CryptoFailable (Simple.Point curve)
 decodeECPoint mxy = case B.uncons mxy of
-    Nothing     -> CryptoFailed $ CryptoError_PointSizeInvalid
+    Nothing     -> CryptoFailed CryptoError_PointSizeInvalid
     Just (m,xy)
         -- uncompressed
         | m == 4 ->
@@ -223,7 +362,47 @@ decodeECPoint mxy = case B.uncons mxy of
                 x = os2ip xb
                 y = os2ip yb
              in Simple.pointFromIntegers (x,y)
-        | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid
+        | otherwise -> CryptoFailed CryptoError_PointFormatInvalid
 
-curveSizeBytes :: EllipticCurve c => Proxy c -> Int
+ecPointsMulVarTime :: forall curve . Simple.Curve curve
-curveSizeBytes proxy = (curveSizeBits proxy + 7) `div` 8
+                   => Simple.Scalar curve
+                   -> Simple.Scalar curve -> Simple.Point curve
+                   -> Simple.Point curve
+ecPointsMulVarTime n1 = Simple.pointAddTwoMuls n1 g
+  where g = Simple.curveEccG $ Simple.curveParameters (Proxy :: Proxy curve)
+
+ecScalarFromBinary :: forall curve bs . (Simple.Curve curve, ByteArrayAccess bs)
+                   => bs -> CryptoFailable (Simple.Scalar curve)
+ecScalarFromBinary ba
+    | B.length ba /= size = CryptoFailed CryptoError_SecretKeySizeInvalid
+    | otherwise           = CryptoPassed (Simple.Scalar $ os2ip ba)
+  where size = ecCurveOrderBytes (Proxy :: Proxy curve)
+
+ecScalarToBinary :: forall curve bs . (Simple.Curve curve, ByteArray bs)
+                 => Simple.Scalar curve -> bs
+ecScalarToBinary (Simple.Scalar s) = i2ospOf_ size s
+  where size = ecCurveOrderBytes (Proxy :: Proxy curve)
+
+ecScalarFromInteger :: forall curve . Simple.Curve curve
+                    => Integer -> CryptoFailable (Simple.Scalar curve)
+ecScalarFromInteger s
+    | numBits s > nb = CryptoFailed CryptoError_SecretKeySizeInvalid
+    | otherwise      = CryptoPassed (Simple.Scalar s)
+  where nb = 8 * ecCurveOrderBytes (Proxy :: Proxy curve)
+
+ecScalarToInteger :: Simple.Scalar curve -> Integer
+ecScalarToInteger (Simple.Scalar s) = s
+
+ecCurveOrderBytes :: Simple.Curve c => proxy c -> Int
+ecCurveOrderBytes prx = (numBits n + 7) `div` 8
+  where n = Simple.curveEccN $ Simple.curveParameters prx
+
+ecScalarAdd :: forall curve . Simple.Curve curve
+            => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve
+ecScalarAdd (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a + b) `mod` n)
+  where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve)
+
+ecScalarMul :: forall curve . Simple.Curve curve
+            => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve
+ecScalarMul (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a * b) `mod` n)
+  where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve)

Crypto/ECC/Edwards25519.hs

@@ -0,0 +1,370 @@
+-- |
+-- Module      : Crypto.ECC.Edwards25519
+-- License     : BSD-style
+-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Arithmetic primitives over curve edwards25519.
+--
+-- Twisted Edwards curves are a familly of elliptic curves allowing
+-- complete addition formulas without any special case and no point at
+-- infinity.  Curve edwards25519 is based on prime 2^255 - 19 for
+-- efficient implementation.  Equation and parameters are given in
+-- <https://tools.ietf.org/html/rfc7748 RFC 7748>.
+--
+-- This module provides types and primitive operations that are useful
+-- to implement cryptographic schemes based on curve edwards25519:
+--
+-- - arithmetic functions for point addition, doubling, negation,
+-- scalar multiplication with an arbitrary point, with the base point,
+-- etc.
+--
+-- - arithmetic functions dealing with scalars modulo the prime order
+-- L of the base point
+--
+-- All functions run in constant time unless noted otherwise.
+--
+-- Warnings:
+--
+-- 1. Curve edwards25519 has a cofactor h = 8 so the base point does
+-- not generate the entire curve and points with order 2, 4, 8 exist.
+-- When implementing cryptographic algorithms, special care must be
+-- taken using one of the following methods:
+--
+--     - points must be checked for membership in the prime-order
+--     subgroup
+--
+--     - or cofactor must be cleared by multiplying points by 8
+--
+--     Utility functions are provided to implement this.  Testing
+--     subgroup membership with 'pointHasPrimeOrder' is 50-time slower
+--     than call 'pointMulByCofactor'.
+--
+-- 2. Scalar arithmetic is always reduced modulo L, allowing fixed
+-- length and constant execution time, but this reduction is valid
+-- only when points are in the prime-order subgroup.
+--
+-- 3. Because of modular reduction in this implementation it is not
+-- possible to multiply points directly by scalars like 8.s or L.
+-- This has to be decomposed into several steps.
+--
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Crypto.ECC.Edwards25519
+    ( Scalar
+    , Point
+    -- * Scalars
+    , scalarGenerate
+    , scalarDecodeLong
+    , scalarEncode
+    -- * Points
+    , pointDecode
+    , pointEncode
+    , pointHasPrimeOrder
+    -- * Arithmetic functions
+    , toPoint
+    , scalarAdd
+    , scalarMul
+    , pointNegate
+    , pointAdd
+    , pointDouble
+    , pointMul
+    , pointMulByCofactor
+    , pointsMulVarTime
+    ) where
+
+import           Data.Word
+import           Foreign.C.Types
+import           Foreign.Ptr
+
+import           Crypto.Error
+import           Crypto.Internal.ByteArray (Bytes, ScrubbedBytes, withByteArray)
+import qualified Crypto.Internal.ByteArray as B
+import           Crypto.Internal.Compat
+import           Crypto.Internal.Imports
+import           Crypto.Random
+
+
+scalarArraySize :: Int
+scalarArraySize = 40 -- maximum [9 * 4 {- 32 bits -}, 5 * 8 {- 64 bits -}]
+
+-- | A scalar modulo prime order of curve edwards25519.
+newtype Scalar = Scalar ScrubbedBytes
+    deriving (Show,NFData)
+
+instance Eq Scalar where
+    (Scalar s1) == (Scalar s2) = unsafeDoIO $
+        withByteArray s1 $ \ps1 ->
+        withByteArray s2 $ \ps2 ->
+            fmap (/= 0) (ed25519_scalar_eq ps1 ps2)
+    {-# NOINLINE (==) #-}
+
+pointArraySize :: Int
+pointArraySize = 160 -- maximum [4 * 10 * 4 {- 32 bits -}, 4 * 5 * 8 {- 64 bits -}]
+
+-- | A point on curve edwards25519.
+newtype Point = Point Bytes
+    deriving NFData
+
+instance Show Point where
+    showsPrec d p =
+        let bs = pointEncode p :: Bytes
+         in showParen (d > 10) $ showString "Point "
+                               . shows (B.convertToBase B.Base16 bs :: Bytes)
+
+instance Eq Point where
+    (Point p1) == (Point p2) = unsafeDoIO $
+        withByteArray p1 $ \pp1 ->
+        withByteArray p2 $ \pp2 ->
+            fmap (/= 0) (ed25519_point_eq pp1 pp2)
+    {-# NOINLINE (==) #-}
+
+-- | Generate a random scalar.
+scalarGenerate :: MonadRandom randomly => randomly Scalar
+scalarGenerate = throwCryptoError . scalarDecodeLong <$> generate
+  where
+    -- Scalar generation is based on a fixed number of bytes so that
+    -- there is no timing leak.  But because of modular reduction
+    -- distribution is not uniform.  We use many more bytes than
+    -- necessary so the probability bias is small.  With 512 bits we
+    -- get 22% of scalars with a higher frequency, but the relative
+    -- probability difference is only 2^(-260).
+    generate :: MonadRandom randomly => randomly ScrubbedBytes
+    generate = getRandomBytes 64
+
+-- | Serialize a scalar to binary, i.e. a 32-byte little-endian
+-- number.
+scalarEncode :: B.ByteArray bs => Scalar -> bs
+scalarEncode (Scalar s) =
+    B.allocAndFreeze 32 $ \out ->
+        withByteArray s $ \ps -> ed25519_scalar_encode out ps
+
+-- | Deserialize a little-endian number as a scalar.  Input array can
+-- have any length from 0 to 64 bytes.
+--
+-- Note: it is not advised to put secret information in the 3 lowest
+-- bits of a scalar if this scalar may be multiplied to untrusted
+-- points outside the prime-order subgroup.
+scalarDecodeLong :: B.ByteArrayAccess bs => bs -> CryptoFailable Scalar
+scalarDecodeLong bs
+    | B.length bs > 64 = CryptoFailed CryptoError_EcScalarOutOfBounds
+    | otherwise        = unsafeDoIO $ withByteArray bs initialize
+  where
+    len = fromIntegral $ B.length bs
+    initialize inp = do
+        s <- B.alloc scalarArraySize $ \ps ->
+                 ed25519_scalar_decode_long ps inp len
+        return $ CryptoPassed (Scalar s)
+{-# NOINLINE scalarDecodeLong #-}
+
+-- | Add two scalars.
+scalarAdd :: Scalar -> Scalar -> Scalar
+scalarAdd (Scalar a) (Scalar b) =
+    Scalar $ B.allocAndFreeze scalarArraySize $ \out ->
+        withByteArray a $ \pa ->
+        withByteArray b $ \pb ->
+             ed25519_scalar_add out pa pb
+
+-- | Multiply two scalars.
+scalarMul :: Scalar -> Scalar -> Scalar
+scalarMul (Scalar a) (Scalar b) =
+    Scalar $ B.allocAndFreeze scalarArraySize $ \out ->
+        withByteArray a $ \pa ->
+        withByteArray b $ \pb ->
+             ed25519_scalar_mul out pa pb
+
+-- | Multiplies a scalar with the curve base point.
+toPoint :: Scalar -> Point
+toPoint (Scalar scalar) =
+    Point $ B.allocAndFreeze pointArraySize $ \out ->
+        withByteArray scalar $ \pscalar ->
+            ed25519_point_base_scalarmul out pscalar
+
+-- | Serialize a point to a 32-byte array.
+--
+-- Format is binary compatible with 'Crypto.PubKey.Ed25519.PublicKey'
+-- from module "Crypto.PubKey.Ed25519".
+pointEncode :: B.ByteArray bs => Point -> bs
+pointEncode (Point p) =
+    B.allocAndFreeze 32 $ \out ->
+        withByteArray p $ \pp ->
+             ed25519_point_encode out pp
+
+-- | Deserialize a 32-byte array as a point, ensuring the point is
+-- valid on edwards25519.
+--
+-- /WARNING:/ variable time
+pointDecode :: B.ByteArrayAccess bs => bs -> CryptoFailable Point
+pointDecode bs
+    | B.length bs == 32 = unsafeDoIO $ withByteArray bs initialize
+    | otherwise         = CryptoFailed CryptoError_PointSizeInvalid
+  where
+    initialize inp = do
+        (res, p) <- B.allocRet pointArraySize $ \pp ->
+                        ed25519_point_decode_vartime pp inp
+        if res == 0 then return $ CryptoFailed CryptoError_PointCoordinatesInvalid
+                    else return $ CryptoPassed (Point p)
+{-# NOINLINE pointDecode #-}
+
+-- | Test whether a point belongs to the prime-order subgroup
+-- generated by the base point.  Result is 'True' for the identity
+-- point.
+--
+-- @
+-- pointHasPrimeOrder p = 'pointNegate' p == 'pointMul' l_minus_one p
+-- @
+pointHasPrimeOrder :: Point -> Bool
+pointHasPrimeOrder (Point p) = unsafeDoIO $
+    withByteArray p $ \pp ->
+        fmap (/= 0) (ed25519_point_has_prime_order pp)
+{-# NOINLINE pointHasPrimeOrder #-}
+
+-- | Negate a point.
+pointNegate :: Point -> Point
+pointNegate (Point a) =
+    Point $ B.allocAndFreeze pointArraySize $ \out ->
+        withByteArray a $ \pa ->
+             ed25519_point_negate out pa
+
+-- | Add two points.
+pointAdd :: Point -> Point -> Point
+pointAdd (Point a) (Point b) =
+    Point $ B.allocAndFreeze pointArraySize $ \out ->
+        withByteArray a $ \pa ->
+        withByteArray b $ \pb ->
+             ed25519_point_add out pa pb
+
+-- | Add a point to itself.
+--
+-- @
+-- pointDouble p = 'pointAdd' p p
+-- @
+pointDouble :: Point -> Point
+pointDouble (Point a) =
+    Point $ B.allocAndFreeze pointArraySize $ \out ->
+        withByteArray a $ \pa ->
+             ed25519_point_double out pa
+
+-- | Multiply a point by h = 8.
+--
+-- @
+-- pointMulByCofactor p = 'pointMul' scalar_8 p
+-- @
+pointMulByCofactor :: Point -> Point
+pointMulByCofactor (Point a) =
+    Point $ B.allocAndFreeze pointArraySize $ \out ->
+        withByteArray a $ \pa ->
+             ed25519_point_mul_by_cofactor out pa
+
+-- | Scalar multiplication over curve edwards25519.
+--
+-- Note: when the scalar had reduction modulo L and the input point
+-- has a torsion component, the output point may not be in the
+-- expected subgroup.
+pointMul :: Scalar -> Point -> Point
+pointMul (Scalar scalar) (Point base) =
+    Point $ B.allocAndFreeze pointArraySize $ \out ->
+        withByteArray scalar $ \pscalar ->
+        withByteArray base   $ \pbase   ->
+             ed25519_point_scalarmul out pbase pscalar
+
+-- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@.
+--
+-- @
+-- pointsMulVarTime s1 s2 p = 'pointAdd' ('toPoint' s1) ('pointMul' s2 p)
+-- @
+--
+-- /WARNING:/ variable time
+pointsMulVarTime :: Scalar -> Scalar -> Point -> Point
+pointsMulVarTime (Scalar s1) (Scalar s2) (Point p) =
+    Point $ B.allocAndFreeze pointArraySize $ \out ->
+        withByteArray s1 $ \ps1 ->
+        withByteArray s2 $ \ps2 ->
+        withByteArray p  $ \pp  ->
+             ed25519_base_double_scalarmul_vartime out ps1 pp ps2
+
+foreign import ccall unsafe "cryptonite_ed25519_scalar_eq"
+    ed25519_scalar_eq :: Ptr Scalar
+                      -> Ptr Scalar
+                      -> IO CInt
+
+foreign import ccall unsafe "cryptonite_ed25519_scalar_encode"
+    ed25519_scalar_encode :: Ptr Word8
+                          -> Ptr Scalar
+                          -> IO ()
+
+foreign import ccall unsafe "cryptonite_ed25519_scalar_decode_long"
+    ed25519_scalar_decode_long :: Ptr Scalar
+                               -> Ptr Word8
+                               -> CSize
+                               -> IO ()
+
+foreign import ccall unsafe "cryptonite_ed25519_scalar_add"
+    ed25519_scalar_add :: Ptr Scalar -- sum
+                       -> Ptr Scalar -- a
+                       -> Ptr Scalar -- b
+                       -> IO ()
+
+foreign import ccall unsafe "cryptonite_ed25519_scalar_mul"
+    ed25519_scalar_mul :: Ptr Scalar -- out
+                       -> Ptr Scalar -- a
+                       -> Ptr Scalar -- b
+                       -> IO ()
+
+foreign import ccall unsafe "cryptonite_ed25519_point_encode"
+    ed25519_point_encode :: Ptr Word8
+                         -> Ptr Point
+                         -> IO ()
+
+foreign import ccall unsafe "cryptonite_ed25519_point_decode_vartime"
+    ed25519_point_decode_vartime :: Ptr Point
+                                 -> Ptr Word8
+                                 -> IO CInt
+
+foreign import ccall unsafe "cryptonite_ed25519_point_eq"
+    ed25519_point_eq :: Ptr Point
+                     -> Ptr Point
+                     -> IO CInt
+
+foreign import ccall "cryptonite_ed25519_point_has_prime_order"
+    ed25519_point_has_prime_order :: Ptr Point
+                                  -> IO CInt
+
+foreign import ccall unsafe "cryptonite_ed25519_point_negate"
+    ed25519_point_negate :: Ptr Point -- minus_a
+                         -> Ptr Point -- a
+                         -> IO ()
+
+foreign import ccall unsafe "cryptonite_ed25519_point_add"
+    ed25519_point_add :: Ptr Point -- sum
+                      -> Ptr Point -- a
+                      -> Ptr Point -- b
+                      -> IO ()
+
+foreign import ccall unsafe "cryptonite_ed25519_point_double"
+    ed25519_point_double :: Ptr Point -- two_a
+                         -> Ptr Point -- a
+                         -> IO ()
+
+foreign import ccall unsafe "cryptonite_ed25519_point_mul_by_cofactor"
+    ed25519_point_mul_by_cofactor :: Ptr Point -- eight_a
+                                  -> Ptr Point -- a
+                                  -> IO ()
+
+foreign import ccall "cryptonite_ed25519_point_base_scalarmul"
+    ed25519_point_base_scalarmul :: Ptr Point  -- scaled
+                                 -> Ptr Scalar -- scalar
+                                 -> IO ()
+
+foreign import ccall "cryptonite_ed25519_point_scalarmul"
+    ed25519_point_scalarmul :: Ptr Point  -- scaled
+                            -> Ptr Point  -- base
+                            -> Ptr Scalar -- scalar
+                            -> IO ()
+
+foreign import ccall "cryptonite_ed25519_base_double_scalarmul_vartime"
+    ed25519_base_double_scalarmul_vartime :: Ptr Point  -- combo
+                                          -> Ptr Scalar -- scalar1
+                                          -> Ptr Point  -- base2
+                                          -> Ptr Scalar -- scalar2
+                                          -> IO ()

Crypto/ECC/Simple/Prim.hs

@@ -6,6 +6,7 @@ module Crypto.ECC.Simple.Prim
     ( scalarGenerate
     , scalarFromInteger
     , pointAdd
+    , pointNegate
     , pointDouble
     , pointBaseMul
     , pointMul
@@ -16,8 +17,7 @@ module Crypto.ECC.Simple.Prim
     ) where
 
 import Data.Maybe
-import Crypto.Internal.Imports
+import Data.Proxy
-import Crypto.Internal.Proxy
 import Crypto.Number.ModArithmetic
 import Crypto.Number.F2m
 import Crypto.Number.Generate (generateBetween)
@@ -49,7 +49,7 @@ pointNegate :: Curve curve => Point curve -> Point curve
 pointNegate        PointO     = PointO
 pointNegate point@(Point x y) =
     case curveType point of
-        CurvePrime {}  -> Point x (-y)
+        CurvePrime (CurvePrimeParam p) -> Point x (p - y)
         CurveBinary {} -> Point x (x `addF2m` y)
 
 -- | Elliptic Curve point addition.

Crypto/ECC/Simple/Types.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 -- |
 -- Module      : Crypto.ECC.Simple.Types
 -- License     : BSD-style
@@ -6,7 +7,7 @@
 -- Stability   : Experimental
 -- Portability : Excellent
 --
--- references:
+-- References:
 --   <https://tools.ietf.org/html/rfc5915>
 --
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
@@ -20,7 +21,7 @@ module Crypto.ECC.Simple.Types
     , curveSizeBits
     , curveSizeBytes
     , CurveParameters(..)
-    -- * specific curves definition
+    -- * Specific curves definition
     , SEC_p112r1(..)
     , SEC_p112r2(..)
     , SEC_p128r1(..)
@@ -83,28 +84,28 @@ data CurveParameters curve = CurveParameters
     , curveEccG :: Point curve -- ^ base point
     , curveEccN :: Integer     -- ^ order of G
     , curveEccH :: Integer     -- ^ cofactor
-    } deriving (Show,Eq,Data,Typeable)
+    } deriving (Show,Eq,Data)
 
 newtype CurveBinaryParam = CurveBinaryParam Integer
-    deriving (Show,Read,Eq,Data,Typeable)
+    deriving (Show,Read,Eq,Data)
 
 newtype CurvePrimeParam = CurvePrimeParam Integer
-    deriving (Show,Read,Eq,Data,Typeable)
+    deriving (Show,Read,Eq,Data)
 
 data CurveType =
       CurveBinary CurveBinaryParam
     | CurvePrime CurvePrimeParam
-    deriving (Show,Read,Eq,Data,Typeable)
+    deriving (Show,Read,Eq,Data)
 
 -- | ECC Private Number
 newtype Scalar curve = Scalar Integer
-    deriving (Show,Read,Eq,Data,Typeable)
+    deriving (Show,Read,Eq,Data,NFData)
 
 -- | Define a point on a curve.
 data Point curve =
       Point Integer Integer
     | PointO -- ^ Point at Infinity
-    deriving (Show,Read,Eq,Data,Typeable)
+    deriving (Show,Read,Eq,Data)
 
 instance NFData (Point curve) where
     rnf (Point x y) = x `seq` y `seq` ()

Crypto/Error/Types.hs

@@ -8,6 +8,7 @@
 -- Cryptographic Error enumeration and handling
 --
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TypeFamilies       #-}
 module Crypto.Error.Types
     ( CryptoError(..)
     , CryptoFailable(..)
@@ -21,13 +22,14 @@ module Crypto.Error.Types
 import qualified Control.Exception as E
 import           Data.Data
 
-import           Crypto.Internal.Imports
+import           Basement.Monad (MonadFailure(..))
 
 -- | Enumeration of all possible errors that can be found in this library
 data CryptoError =
     -- symmetric cipher errors
       CryptoError_KeySizeInvalid
     | CryptoError_IvSizeInvalid
+    | CryptoError_SeedSizeInvalid
     | CryptoError_AEADModeNotSupported
     -- public key cryptography error
     | CryptoError_SecretKeySizeInvalid
@@ -40,12 +42,17 @@ data CryptoError =
     | CryptoError_PointFormatInvalid
     | CryptoError_PointFormatUnsupported
     | CryptoError_PointCoordinatesInvalid
+    | CryptoError_ScalarMultiplicationInvalid
     -- Message authentification error
     | CryptoError_MacKeyInvalid
     | CryptoError_AuthenticationTagSizeInvalid
     -- Prime generation error
     | CryptoError_PrimeSizeInvalid
-    deriving (Show,Eq,Enum,Data,Typeable)
+    -- Parameter errors
+    | CryptoError_SaltTooSmall
+    | CryptoError_OutputLengthTooSmall
+    | CryptoError_OutputLengthTooBig
+    deriving (Show,Eq,Enum,Data)
 
 instance E.Exception CryptoError
 
@@ -75,12 +82,16 @@ instance Applicative CryptoFailable where
     pure a     = CryptoPassed a
     (<*>) fm m = fm >>= \p -> m >>= \r2 -> return (p r2)
 instance Monad CryptoFailable where
-    return a = CryptoPassed a
+    return = pure
     (>>=) m1 m2 = do
         case m1 of
             CryptoPassed a -> m2 a
             CryptoFailed e -> CryptoFailed e
 
+instance MonadFailure CryptoFailable where
+    type Failure CryptoFailable = CryptoError
+    mFail = CryptoFailed
+
 -- | Throw an CryptoError as exception on CryptoFailed result,
 -- otherwise return the computed value
 throwCryptoErrorIO :: CryptoFailable a -> IO a

Crypto/Hash.hs

@@ -16,6 +16,8 @@
 -- > hexSha3_512 :: ByteString -> String
 -- > hexSha3_512 bs = show (hash bs :: Digest SHA3_512)
 --
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns        #-}
 module Crypto.Hash
     (
     -- * Types
@@ -23,77 +25,110 @@ module Crypto.Hash
     , Digest
     -- * Functions
     , digestFromByteString
-    -- * hash methods parametrized by algorithm
+    -- * Hash methods parametrized by algorithm
     , hashInitWith
     , hashWith
-    -- * hash methods
+    , hashPrefixWith
+    -- * Hash methods
     , hashInit
     , hashUpdates
     , hashUpdate
     , hashFinalize
+    , hashFinalizePrefix
     , hashBlockSize
     , hashDigestSize
     , hash
+    , hashPrefix
     , hashlazy
+    , hashPutContext
+    , hashGetContext
     -- * Hash algorithms
     , module Crypto.Hash.Algorithms
     ) where
 
-import           Control.Monad
+import           Basement.Types.OffsetSize (CountOf (..))
+import           Basement.Block (Block, unsafeFreeze)
+import           Basement.Block.Mutable (copyFromPtr, new)
+import           Crypto.Internal.Compat (unsafeDoIO)
 import           Crypto.Hash.Types
 import           Crypto.Hash.Algorithms
-import           Foreign.Ptr (Ptr)
+import           Foreign.Ptr (Ptr, plusPtr)
-import           Crypto.Internal.ByteArray (ByteArrayAccess)
+import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)
 import qualified Crypto.Internal.ByteArray as B
 import qualified Data.ByteString.Lazy as L
+import           Data.Word (Word8)
+import           Data.Int (Int32)
 
 -- | Hash a strict bytestring into a digest.
 hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a
 hash bs = hashFinalize $ hashUpdate hashInit bs
 
+-- | Hash the first N bytes of a bytestring, with code path independent from N.
+hashPrefix :: (ByteArrayAccess ba, HashAlgorithmPrefix a) => ba -> Int -> Digest a
+hashPrefix = hashFinalizePrefix hashInit
+
 -- | Hash a lazy bytestring into a digest.
 hashlazy :: HashAlgorithm a => L.ByteString -> Digest a
 hashlazy lbs = hashFinalize $ hashUpdates hashInit (L.toChunks lbs)
 
 -- | Initialize a new context for this hash algorithm
-hashInit :: HashAlgorithm a
+hashInit :: forall a . HashAlgorithm a => Context a
-         => Context a
+hashInit = Context $ B.allocAndFreeze (hashInternalContextSize (undefined :: a)) $ \(ptr :: Ptr (Context a)) ->
-hashInit = doInit undefined B.allocAndFreeze
+    hashInternalInit ptr
-  where
-        doInit :: HashAlgorithm a => a -> (Int -> (Ptr (Context a) -> IO ()) -> B.Bytes) -> Context a
-        doInit alg alloc = Context $ alloc (hashInternalContextSize alg) hashInternalInit
-{-# NOINLINE hashInit #-}
 
 -- | run hashUpdates on one single bytestring and return the updated context.
 hashUpdate :: (ByteArrayAccess ba, HashAlgorithm a) => Context a -> ba -> Context a
-hashUpdate ctx b = hashUpdates ctx [b]
+hashUpdate ctx b
+    | B.null b  = ctx
+    | otherwise = hashUpdates ctx [b]
 
 -- | Update the context with a list of strict bytestring,
 -- and return a new context with the updates.
-hashUpdates :: (HashAlgorithm a, ByteArrayAccess ba)
+hashUpdates :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba)
             => Context a
             -> [ba]
             -> Context a
-hashUpdates c l = doUpdates (B.copyAndFreeze c)
+hashUpdates c l
-  where doUpdates :: HashAlgorithm a => ((Ptr (Context a) -> IO ()) -> B.Bytes) -> Context a
+    | null ls   = c
-        doUpdates copy = Context $ copy $ \ctx ->
+    | otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) ->
-            mapM_ (\b -> B.withByteArray b $ \d -> hashInternalUpdate ctx d (fromIntegral $ B.length b)) l
+        mapM_ (\b -> B.withByteArray b (processBlocks ctx (B.length b))) ls
-{-# NOINLINE hashUpdates #-}
+  where
+    ls = filter (not . B.null) l
+    -- process the data in 2GB chunks to fit in uint32_t and Int on 32 bit systems
+    processBlocks ctx bytesLeft dataPtr
+        | bytesLeft == 0 = return ()
+        | otherwise = do
+            hashInternalUpdate ctx dataPtr (fromIntegral actuallyProcessed)
+            processBlocks ctx (bytesLeft - actuallyProcessed) (dataPtr `plusPtr` actuallyProcessed)
+        where
+            actuallyProcessed = min bytesLeft (fromIntegral (maxBound :: Int32))
 
 -- | Finalize a context and return a digest.
-hashFinalize :: HashAlgorithm a
+hashFinalize :: forall a . HashAlgorithm a
              => Context a
              -> Digest a
-hashFinalize c = doFinalize undefined (B.copy c) (B.allocAndFreeze)
+hashFinalize !c =
-  where doFinalize :: HashAlgorithm alg
+    Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do
-                   => alg
+        ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig
-                   -> ((Ptr (Context alg) -> IO ()) -> IO B.Bytes)
+        return ()
-                   -> (Int -> (Ptr (Digest alg)  -> IO ()) -> B.Bytes)
+
-                   -> Digest alg
+-- | Update the context with the first N bytes of a bytestring and return the
-        doFinalize alg copy allocDigest =
+-- digest.  The code path is independent from N but much slower than a normal
-            Digest $ allocDigest (hashDigestSize alg) $ \dig ->
+-- 'hashUpdate'.  The function can be called for the last bytes of a message, in
-                (void $ copy $ \ctx -> hashInternalFinalize ctx dig)
+-- order to exclude a variable padding, without leaking the padding length.  The
-{-# NOINLINE hashFinalize #-}
+-- begining of the message, never impacted by the padding, should preferably go
+-- through 'hashUpdate' for better performance.
+hashFinalizePrefix :: forall a ba . (HashAlgorithmPrefix a, ByteArrayAccess ba)
+                   => Context a
+                   -> ba
+                   -> Int
+                   -> Digest a
+hashFinalizePrefix !c b len =
+    Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do
+        ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) ->
+            B.withByteArray b $ \d ->
+                hashInternalFinalizePrefix ctx d (fromIntegral $ B.length b) (fromIntegral len) dig
+        return ()
 
 -- | Initialize a new context for a specified hash algorithm
 hashInitWith :: HashAlgorithm alg => alg -> Context alg
@@ -103,14 +138,39 @@ hashInitWith _ = hashInit
 hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg
 hashWith _ = hash
 
+-- | Run the 'hashPrefix' function but takes an explicit hash algorithm parameter
+hashPrefixWith :: (ByteArrayAccess ba, HashAlgorithmPrefix alg) => alg -> ba -> Int -> Digest alg
+hashPrefixWith _ = hashPrefix
+
 -- | Try to transform a bytearray into a Digest of specific algorithm.
 --
 -- If the digest is not the right size for the algorithm specified, then
 -- Nothing is returned.
-digestFromByteString :: (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a)
+digestFromByteString :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a)
 digestFromByteString = from undefined
   where
-        from :: (HashAlgorithm a, ByteArrayAccess ba) => a -> ba -> Maybe (Digest a)
+        from :: a -> ba -> Maybe (Digest a)
         from alg bs
-            | B.length bs == (hashDigestSize alg) = (Just $ Digest $ B.convert bs)
+            | B.length bs == (hashDigestSize alg) = Just $ Digest $ unsafeDoIO $ copyBytes bs
             | otherwise                           = Nothing
+
+        copyBytes :: ba -> IO (Block Word8)
+        copyBytes ba = do
+            muArray <- new count
+            B.withByteArray ba $ \ptr -> copyFromPtr ptr muArray 0 count
+            unsafeFreeze muArray
+          where
+            count = CountOf (B.length ba)
+
+hashPutContext :: forall a ba. (HashAlgorithmResumable a, ByteArray ba) => Context a -> ba
+hashPutContext !c = B.allocAndFreeze (hashInternalContextSize (undefined :: a)) $ \(ptr :: Ptr Word8) ->
+  B.withByteArray c $ \(ctx :: Ptr (Context a)) -> hashInternalPutContextBE ctx ptr
+
+hashGetContext :: forall a ba. (HashAlgorithmResumable a, ByteArrayAccess ba) => ba -> Maybe (Context a)
+hashGetContext = from undefined
+  where
+        from :: a -> ba -> Maybe (Context a)
+        from alg bs
+          | B.length bs == (hashInternalContextSize alg) = Just $ Context $ B.allocAndFreeze (B.length bs) $ \(ctx :: Ptr (Context a)) ->
+              B.withByteArray bs $ \ptr -> hashInternalGetContextBE ptr ctx
+          | otherwise                                    = Nothing

Crypto/Hash/Algorithms.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 -- |
 -- Module      : Crypto.Hash.Algorithms
 -- License     : BSD-style
@@ -10,11 +9,18 @@
 --
 module Crypto.Hash.Algorithms
     ( HashAlgorithm
-    -- * hash algorithms
+    , HashAlgorithmPrefix
+    , HashAlgorithmResumable
+    -- * Hash algorithms
+    , Blake2s_160(..)
     , Blake2s_224(..)
-    , Blake2sp_224(..)
     , Blake2s_256(..)
+    , Blake2sp_224(..)
     , Blake2sp_256(..)
+    , Blake2b_160(..)
+    , Blake2b_224(..)
+    , Blake2b_256(..)
+    , Blake2b_384(..)
     , Blake2b_512(..)
     , Blake2bp_512(..)
     , MD2(..)
@@ -37,6 +43,10 @@ module Crypto.Hash.Algorithms
     , SHA3_256(..)
     , SHA3_384(..)
     , SHA3_512(..)
+    , SHAKE128(..)
+    , SHAKE256(..)
+    , Blake2b(..), Blake2bp(..)
+    , Blake2s(..), Blake2sp(..)
     , Skein256_224(..)
     , Skein256_256(..)
     , Skein512_224(..)
@@ -46,7 +56,7 @@ module Crypto.Hash.Algorithms
     , Whirlpool(..)
     ) where
 
-import           Crypto.Hash.Types (HashAlgorithm)
+import           Crypto.Hash.Types (HashAlgorithm, HashAlgorithmPrefix, HashAlgorithmResumable)
 import           Crypto.Hash.Blake2s
 import           Crypto.Hash.Blake2sp
 import           Crypto.Hash.Blake2b
@@ -67,3 +77,5 @@ import           Crypto.Hash.Tiger
 import           Crypto.Hash.Skein256
 import           Crypto.Hash.Skein512
 import           Crypto.Hash.Whirlpool
+import           Crypto.Hash.SHAKE
+import           Crypto.Hash.Blake2

Crypto/Hash/Blake2.hs

@@ -0,0 +1,162 @@
+-- |
+-- Module      : Crypto.Hash.Blake2
+-- License     : BSD-style
+-- Maintainer  : Nicolas Di Prima <nicolas@primetype.co.uk>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Module containing the binding functions to work with the
+-- Blake2
+--
+-- Implementation based from [RFC7693](https://tools.ietf.org/html/rfc7693)
+--
+-- Please consider the following when chosing a hash:
+--
+--      Algorithm     | Target | Collision | Digest Size |
+--         Identifier |  Arch  |  Security |   in bytes  |
+--     ---------------+--------+-----------+-------------+
+--      id-blake2b160 | 64-bit |   2**80   |         20  |
+--      id-blake2b256 | 64-bit |   2**128  |         32  |
+--      id-blake2b384 | 64-bit |   2**192  |         48  |
+--      id-blake2b512 | 64-bit |   2**256  |         64  |
+--     ---------------+--------+-----------+-------------+
+--      id-blake2s128 | 32-bit |   2**64   |         16  |
+--      id-blake2s160 | 32-bit |   2**80   |         20  |
+--      id-blake2s224 | 32-bit |   2**112  |         28  |
+--      id-blake2s256 | 32-bit |   2**128  |         32  |
+--     ---------------+--------+-----------+-------------+
+--
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+module Crypto.Hash.Blake2
+    ( Blake2s(..)
+    , Blake2sp(..)
+    , Blake2b(..)
+    , Blake2bp(..)
+    ) where
+
+import           Crypto.Hash.Types
+import           Foreign.Ptr (Ptr)
+import           Data.Data
+import           Data.Word (Word8, Word32)
+import           GHC.TypeLits (Nat, KnownNat)
+import           Crypto.Internal.Nat
+
+-- | Fast and secure alternative to SHA1 and HMAC-SHA1
+--
+-- It is espacially known to target 32bits architectures.
+--
+-- Known supported digest sizes:
+--
+-- * Blake2s 160
+-- * Blake2s 224
+-- * Blake2s 256
+--
+data Blake2s (bitlen :: Nat) = Blake2s
+    deriving (Show,Data)
+
+instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 256)
+      => HashAlgorithm (Blake2s bitlen)
+      where
+    type HashBlockSize           (Blake2s bitlen) = 64
+    type HashDigestSize          (Blake2s bitlen) = Div8 bitlen
+    type HashInternalContextSize (Blake2s bitlen) = 136
+    hashBlockSize  _          = 64
+    hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
+    hashInternalContextSize _ = 136
+    hashInternalInit p        = c_blake2s_init p (integralNatVal (Proxy :: Proxy bitlen))
+    hashInternalUpdate        = c_blake2s_update
+    hashInternalFinalize p    = c_blake2s_finalize p (integralNatVal (Proxy :: Proxy bitlen))
+
+foreign import ccall unsafe "cryptonite_blake2s_init"
+    c_blake2s_init :: Ptr (Context a) -> Word32 -> IO ()
+foreign import ccall "cryptonite_blake2s_update"
+    c_blake2s_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
+foreign import ccall unsafe "cryptonite_blake2s_finalize"
+    c_blake2s_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
+
+-- | Fast cryptographic hash.
+--
+-- It is especially known to target 64bits architectures.
+--
+-- Known supported digest sizes:
+--
+-- * Blake2b 160
+-- * Blake2b 224
+-- * Blake2b 256
+-- * Blake2b 384
+-- * Blake2b 512
+--
+data Blake2b (bitlen :: Nat) = Blake2b
+    deriving (Show,Data)
+
+instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 512)
+      => HashAlgorithm (Blake2b bitlen)
+      where
+    type HashBlockSize           (Blake2b bitlen) = 128
+    type HashDigestSize          (Blake2b bitlen) = Div8 bitlen
+    type HashInternalContextSize (Blake2b bitlen) = 248
+    hashBlockSize  _          = 128
+    hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
+    hashInternalContextSize _ = 248
+    hashInternalInit p        = c_blake2b_init p (integralNatVal (Proxy :: Proxy bitlen))
+    hashInternalUpdate        = c_blake2b_update
+    hashInternalFinalize p    = c_blake2b_finalize p (integralNatVal (Proxy :: Proxy bitlen))
+
+foreign import ccall unsafe "cryptonite_blake2b_init"
+    c_blake2b_init :: Ptr (Context a) -> Word32 -> IO ()
+foreign import ccall "cryptonite_blake2b_update"
+    c_blake2b_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
+foreign import ccall unsafe "cryptonite_blake2b_finalize"
+    c_blake2b_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
+
+data Blake2sp (bitlen :: Nat) = Blake2sp
+    deriving (Show,Data)
+
+instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 256)
+      => HashAlgorithm (Blake2sp bitlen)
+      where
+    type HashBlockSize           (Blake2sp bitlen) = 64
+    type HashDigestSize          (Blake2sp bitlen) = Div8 bitlen
+    type HashInternalContextSize (Blake2sp bitlen) = 2185
+    hashBlockSize  _          = 64
+    hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
+    hashInternalContextSize _ = 2185
+    hashInternalInit p        = c_blake2sp_init p (integralNatVal (Proxy :: Proxy bitlen))
+    hashInternalUpdate        = c_blake2sp_update
+    hashInternalFinalize p    = c_blake2sp_finalize p (integralNatVal (Proxy :: Proxy bitlen))
+
+foreign import ccall unsafe "cryptonite_blake2sp_init"
+    c_blake2sp_init :: Ptr (Context a) -> Word32 -> IO ()
+foreign import ccall "cryptonite_blake2sp_update"
+    c_blake2sp_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
+foreign import ccall unsafe "cryptonite_blake2sp_finalize"
+    c_blake2sp_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
+
+data Blake2bp (bitlen :: Nat) = Blake2bp
+    deriving (Show,Data)
+
+instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 512)
+      => HashAlgorithm (Blake2bp bitlen)
+      where
+    type HashBlockSize           (Blake2bp bitlen) = 128
+    type HashDigestSize          (Blake2bp bitlen) = Div8 bitlen
+    type HashInternalContextSize (Blake2bp bitlen) = 2325
+    hashBlockSize  _          = 128
+    hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
+    hashInternalContextSize _ = 2325
+    hashInternalInit p        = c_blake2bp_init p (integralNatVal (Proxy :: Proxy bitlen))
+    hashInternalUpdate        = c_blake2bp_update
+    hashInternalFinalize p    = c_blake2bp_finalize p (integralNatVal (Proxy :: Proxy bitlen))
+
+
+foreign import ccall unsafe "cryptonite_blake2bp_init"
+    c_blake2bp_init :: Ptr (Context a) -> Word32 -> IO ()
+foreign import ccall "cryptonite_blake2bp_update"
+    c_blake2bp_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
+foreign import ccall unsafe "cryptonite_blake2bp_finalize"
+    c_blake2bp_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()

Crypto/Hash/Blake2b.hs

@@ -5,30 +5,94 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- Blake2b cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.Blake2b
-    (  Blake2b_512 (..)
+    (  Blake2b_160 (..), Blake2b_224 (..), Blake2b_256 (..), Blake2b_384 (..), Blake2b_512 (..)
     ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 
+-- | Blake2b (160 bits) cryptographic hash algorithm
+data Blake2b_160 = Blake2b_160
+    deriving (Show,Data)
+
+instance HashAlgorithm Blake2b_160 where
+    type HashBlockSize           Blake2b_160 = 128
+    type HashDigestSize          Blake2b_160 = 20
+    type HashInternalContextSize Blake2b_160 = 248
+    hashBlockSize  _          = 128
+    hashDigestSize _          = 20
+    hashInternalContextSize _ = 248
+    hashInternalInit p        = c_blake2b_init p 160
+    hashInternalUpdate        = c_blake2b_update
+    hashInternalFinalize p    = c_blake2b_finalize p 160
+
+-- | Blake2b (224 bits) cryptographic hash algorithm
+data Blake2b_224 = Blake2b_224
+    deriving (Show,Data)
+
+instance HashAlgorithm Blake2b_224 where
+    type HashBlockSize           Blake2b_224 = 128
+    type HashDigestSize          Blake2b_224 = 28
+    type HashInternalContextSize Blake2b_224 = 248
+    hashBlockSize  _          = 128
+    hashDigestSize _          = 28
+    hashInternalContextSize _ = 248
+    hashInternalInit p        = c_blake2b_init p 224
+    hashInternalUpdate        = c_blake2b_update
+    hashInternalFinalize p    = c_blake2b_finalize p 224
+
+-- | Blake2b (256 bits) cryptographic hash algorithm
+data Blake2b_256 = Blake2b_256
+    deriving (Show,Data)
+
+instance HashAlgorithm Blake2b_256 where
+    type HashBlockSize           Blake2b_256 = 128
+    type HashDigestSize          Blake2b_256 = 32
+    type HashInternalContextSize Blake2b_256 = 248
+    hashBlockSize  _          = 128
+    hashDigestSize _          = 32
+    hashInternalContextSize _ = 248
+    hashInternalInit p        = c_blake2b_init p 256
+    hashInternalUpdate        = c_blake2b_update
+    hashInternalFinalize p    = c_blake2b_finalize p 256
+
+-- | Blake2b (384 bits) cryptographic hash algorithm
+data Blake2b_384 = Blake2b_384
+    deriving (Show,Data)
+
+instance HashAlgorithm Blake2b_384 where
+    type HashBlockSize           Blake2b_384 = 128
+    type HashDigestSize          Blake2b_384 = 48
+    type HashInternalContextSize Blake2b_384 = 248
+    hashBlockSize  _          = 128
+    hashDigestSize _          = 48
+    hashInternalContextSize _ = 248
+    hashInternalInit p        = c_blake2b_init p 384
+    hashInternalUpdate        = c_blake2b_update
+    hashInternalFinalize p    = c_blake2b_finalize p 384
+
 -- | Blake2b (512 bits) cryptographic hash algorithm
 data Blake2b_512 = Blake2b_512
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Blake2b_512 where
+    type HashBlockSize           Blake2b_512 = 128
+    type HashDigestSize          Blake2b_512 = 64
+    type HashInternalContextSize Blake2b_512 = 248
     hashBlockSize  _          = 128
     hashDigestSize _          = 64
-    hashInternalContextSize _ = 361
+    hashInternalContextSize _ = 248
     hashInternalInit p        = c_blake2b_init p 512
     hashInternalUpdate        = c_blake2b_update
     hashInternalFinalize p    = c_blake2b_finalize p 512

Crypto/Hash/Blake2bp.hs

@@ -5,11 +5,13 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- Blake2bp cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.Blake2bp
     (  Blake2bp_512 (..)
     ) where
@@ -17,28 +19,30 @@ module Crypto.Hash.Blake2bp
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 
 -- | Blake2bp (512 bits) cryptographic hash algorithm
 data Blake2bp_512 = Blake2bp_512
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Blake2bp_512 where
+    type HashBlockSize           Blake2bp_512 = 128
+    type HashDigestSize          Blake2bp_512 = 64
+    type HashInternalContextSize Blake2bp_512 = 1768
     hashBlockSize  _          = 128
     hashDigestSize _          = 64
-    hashInternalContextSize _ = 2325
+    hashInternalContextSize _ = 1768
-    hashInternalInit p        = c_blake2sp_init p 512
+    hashInternalInit p        = c_blake2bp_init p 512
-    hashInternalUpdate        = c_blake2sp_update
+    hashInternalUpdate        = c_blake2bp_update
-    hashInternalFinalize p    = c_blake2sp_finalize p 512
+    hashInternalFinalize p    = c_blake2bp_finalize p 512
 
 
-foreign import ccall unsafe "cryptonite_blake2sp_init"
+foreign import ccall unsafe "cryptonite_blake2bp_init"
-    c_blake2sp_init :: Ptr (Context a) -> Word32 -> IO ()
+    c_blake2bp_init :: Ptr (Context a) -> Word32 -> IO ()
 
-foreign import ccall "cryptonite_blake2sp_update"
+foreign import ccall "cryptonite_blake2bp_update"
-    c_blake2sp_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
+    c_blake2bp_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
 
-foreign import ccall unsafe "cryptonite_blake2sp_finalize"
+foreign import ccall unsafe "cryptonite_blake2bp_finalize"
-    c_blake2sp_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
+    c_blake2bp_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()

Crypto/Hash/Blake2s.hs

@@ -5,42 +5,64 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- Blake2s cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.Blake2s
-    (  Blake2s_224 (..), Blake2s_256 (..)
+    (  Blake2s_160 (..), Blake2s_224 (..), Blake2s_256 (..)
     ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 
+-- | Blake2s (160 bits) cryptographic hash algorithm
+data Blake2s_160 = Blake2s_160
+    deriving (Show,Data)
+
+instance HashAlgorithm Blake2s_160 where
+    type HashBlockSize           Blake2s_160 = 64
+    type HashDigestSize          Blake2s_160 = 20
+    type HashInternalContextSize Blake2s_160 = 136
+    hashBlockSize  _          = 64
+    hashDigestSize _          = 20
+    hashInternalContextSize _ = 136
+    hashInternalInit p        = c_blake2s_init p 160
+    hashInternalUpdate        = c_blake2s_update
+    hashInternalFinalize p    = c_blake2s_finalize p 160
+
 -- | Blake2s (224 bits) cryptographic hash algorithm
 data Blake2s_224 = Blake2s_224
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Blake2s_224 where
+    type HashBlockSize           Blake2s_224 = 64
+    type HashDigestSize          Blake2s_224 = 28
+    type HashInternalContextSize Blake2s_224 = 136
     hashBlockSize  _          = 64
     hashDigestSize _          = 28
-    hashInternalContextSize _ = 185
+    hashInternalContextSize _ = 136
     hashInternalInit p        = c_blake2s_init p 224
     hashInternalUpdate        = c_blake2s_update
     hashInternalFinalize p    = c_blake2s_finalize p 224
 
 -- | Blake2s (256 bits) cryptographic hash algorithm
 data Blake2s_256 = Blake2s_256
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Blake2s_256 where
+    type HashBlockSize           Blake2s_256 = 64
+    type HashDigestSize          Blake2s_256 = 32
+    type HashInternalContextSize Blake2s_256 = 136
     hashBlockSize  _          = 64
     hashDigestSize _          = 32
-    hashInternalContextSize _ = 185
+    hashInternalContextSize _ = 136
     hashInternalInit p        = c_blake2s_init p 256
     hashInternalUpdate        = c_blake2s_update
     hashInternalFinalize p    = c_blake2s_finalize p 256

Crypto/Hash/Blake2sp.hs

@@ -5,11 +5,13 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- Blake2sp cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.Blake2sp
     (  Blake2sp_224 (..), Blake2sp_256 (..)
     ) where
@@ -17,30 +19,35 @@ module Crypto.Hash.Blake2sp
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 
 -- | Blake2sp (224 bits) cryptographic hash algorithm
 data Blake2sp_224 = Blake2sp_224
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Blake2sp_224 where
+    type HashBlockSize           Blake2sp_224 = 64
+    type HashDigestSize          Blake2sp_224 = 28
+    type HashInternalContextSize Blake2sp_224 = 1752
     hashBlockSize  _          = 64
     hashDigestSize _          = 28
-    hashInternalContextSize _ = 2185
+    hashInternalContextSize _ = 1752
     hashInternalInit p        = c_blake2sp_init p 224
     hashInternalUpdate        = c_blake2sp_update
     hashInternalFinalize p    = c_blake2sp_finalize p 224
 
 -- | Blake2sp (256 bits) cryptographic hash algorithm
 data Blake2sp_256 = Blake2sp_256
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Blake2sp_256 where
+    type HashBlockSize           Blake2sp_256 = 64
+    type HashDigestSize          Blake2sp_256 = 32
+    type HashInternalContextSize Blake2sp_256 = 1752
     hashBlockSize  _          = 64
     hashDigestSize _          = 32
-    hashInternalContextSize _ = 2185
+    hashInternalContextSize _ = 1752
     hashInternalInit p        = c_blake2sp_init p 256
     hashInternalUpdate        = c_blake2sp_update
     hashInternalFinalize p    = c_blake2sp_finalize p 256

Crypto/Hash/IO.hs

@@ -8,6 +8,7 @@
 -- Generalized impure cryptographic hash interface
 --
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
 module Crypto.Hash.IO
     ( HashAlgorithm(..)
     , MutableContext
@@ -23,6 +24,11 @@ import qualified Crypto.Internal.ByteArray as B
 import           Foreign.Ptr
 
 -- | A Mutable hash context
+--
+-- This type is an instance of 'B.ByteArrayAccess' for debugging purpose.
+-- Internal layout is architecture dependent, may contain uninitialized data
+-- fragments, and change in future versions.  The bytearray should not be used
+-- as input to cryptographic algorithms.
 newtype MutableContext a = MutableContext B.Bytes
     deriving (B.ByteArrayAccess)
 
@@ -51,18 +57,10 @@ hashMutableUpdate mc dat = doUpdate mc (B.withByteArray mc)
                 hashInternalUpdate ctx d (fromIntegral $ B.length dat)
 
 -- | Finalize a mutable hash context and compute a digest
-hashMutableFinalize :: HashAlgorithm a => MutableContext a -> IO (Digest a)
+hashMutableFinalize :: forall a . HashAlgorithm a => MutableContext a -> IO (Digest a)
-hashMutableFinalize mc = doFinalize undefined (B.withByteArray mc) B.alloc
+hashMutableFinalize mc = do
-  where doFinalize :: HashAlgorithm alg
+    b <- B.alloc (hashDigestSize (undefined :: a)) $ \dig -> B.withByteArray mc $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig
-                   => alg
+    return $ Digest b
-                   -> ((Ptr (Context alg) -> IO ()) -> IO ())
-                   -> (Int -> (Ptr (Digest alg)  -> IO ()) -> IO B.Bytes)
-                   -> IO (Digest alg)
-        doFinalize alg withCtx allocDigest = do
-            b <- allocDigest (hashDigestSize alg) $ \dig ->
-                    withCtx $ \ctx ->
-                        hashInternalFinalize ctx dig
-            return $ Digest b
 
 -- | Reset the mutable context to the initial state of the hash
 hashMutableReset :: HashAlgorithm a => MutableContext a -> IO ()

Crypto/Hash/Keccak.hs

@@ -5,11 +5,13 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- Keccak cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.Keccak
     (  Keccak_224 (..), Keccak_256 (..), Keccak_384 (..), Keccak_512 (..)
     ) where
@@ -17,15 +19,17 @@ module Crypto.Hash.Keccak
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 
 -- | Keccak (224 bits) cryptographic hash algorithm
 data Keccak_224 = Keccak_224
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Keccak_224 where
+    type HashBlockSize           Keccak_224 = 144
+    type HashDigestSize          Keccak_224 = 28
+    type HashInternalContextSize Keccak_224 = 352
     hashBlockSize  _          = 144
     hashDigestSize _          = 28
     hashInternalContextSize _ = 352
@@ -33,11 +37,18 @@ instance HashAlgorithm Keccak_224 where
     hashInternalUpdate        = c_keccak_update
     hashInternalFinalize p    = c_keccak_finalize p 224
 
+instance HashAlgorithmResumable Keccak_224 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | Keccak (256 bits) cryptographic hash algorithm
 data Keccak_256 = Keccak_256
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Keccak_256 where
+    type HashBlockSize           Keccak_256 = 136
+    type HashDigestSize          Keccak_256 = 32
+    type HashInternalContextSize Keccak_256 = 344
     hashBlockSize  _          = 136
     hashDigestSize _          = 32
     hashInternalContextSize _ = 344
@@ -45,11 +56,18 @@ instance HashAlgorithm Keccak_256 where
     hashInternalUpdate        = c_keccak_update
     hashInternalFinalize p    = c_keccak_finalize p 256
 
+instance HashAlgorithmResumable Keccak_256 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | Keccak (384 bits) cryptographic hash algorithm
 data Keccak_384 = Keccak_384
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Keccak_384 where
+    type HashBlockSize           Keccak_384 = 104
+    type HashDigestSize          Keccak_384 = 48
+    type HashInternalContextSize Keccak_384 = 312
     hashBlockSize  _          = 104
     hashDigestSize _          = 48
     hashInternalContextSize _ = 312
@@ -57,11 +75,18 @@ instance HashAlgorithm Keccak_384 where
     hashInternalUpdate        = c_keccak_update
     hashInternalFinalize p    = c_keccak_finalize p 384
 
+instance HashAlgorithmResumable Keccak_384 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | Keccak (512 bits) cryptographic hash algorithm
 data Keccak_512 = Keccak_512
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Keccak_512 where
+    type HashBlockSize           Keccak_512 = 72
+    type HashDigestSize          Keccak_512 = 64
+    type HashInternalContextSize Keccak_512 = 280
     hashBlockSize  _          = 72
     hashDigestSize _          = 64
     hashInternalContextSize _ = 280
@@ -69,6 +94,10 @@ instance HashAlgorithm Keccak_512 where
     hashInternalUpdate        = c_keccak_update
     hashInternalFinalize p    = c_keccak_finalize p 512
 
+instance HashAlgorithmResumable Keccak_512 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 
 foreign import ccall unsafe "cryptonite_keccak_init"
     c_keccak_init :: Ptr (Context a) -> Word32 -> IO ()
@@ -78,3 +107,9 @@ foreign import ccall "cryptonite_keccak_update"
 
 foreign import ccall unsafe "cryptonite_keccak_finalize"
     c_keccak_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_ctx_to_be"
+    c_sha3_ctx_to_be :: Ptr (Context a) -> Ptr Word8 -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_be_to_ctx"
+    c_sha3_be_to_ctx :: Ptr Word8 -> Ptr (Context a) -> IO ()

Crypto/Hash/MD2.hs

@@ -5,24 +5,28 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- MD2 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.MD2 ( MD2 (..) ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 -- | MD2 cryptographic hash algorithm
 data MD2 = MD2
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm MD2 where
+    type HashBlockSize           MD2 = 16
+    type HashDigestSize          MD2 = 16
+    type HashInternalContextSize MD2 = 96
     hashBlockSize  _          = 16
     hashDigestSize _          = 16
     hashInternalContextSize _ = 96

Crypto/Hash/MD4.hs

@@ -5,24 +5,28 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- MD4 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.MD4 ( MD4 (..) ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 -- | MD4 cryptographic hash algorithm
 data MD4 = MD4
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm MD4 where
+    type HashBlockSize           MD4 = 64
+    type HashDigestSize          MD4 = 16
+    type HashInternalContextSize MD4 = 96
     hashBlockSize  _          = 64
     hashDigestSize _          = 16
     hashInternalContextSize _ = 96

Crypto/Hash/MD5.hs

@@ -5,24 +5,28 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- MD5 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.MD5 ( MD5 (..) ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 -- | MD5 cryptographic hash algorithm
 data MD5 = MD5
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm MD5 where
+    type HashBlockSize           MD5 = 64
+    type HashDigestSize          MD5 = 16
+    type HashInternalContextSize MD5 = 96
     hashBlockSize  _          = 64
     hashDigestSize _          = 16
     hashInternalContextSize _ = 96
@@ -30,6 +34,9 @@ instance HashAlgorithm MD5 where
     hashInternalUpdate        = c_md5_update
     hashInternalFinalize      = c_md5_finalize
 
+instance HashAlgorithmPrefix MD5 where
+    hashInternalFinalizePrefix = c_md5_finalize_prefix
+
 foreign import ccall unsafe "cryptonite_md5_init"
     c_md5_init :: Ptr (Context a)-> IO ()
 
@@ -38,3 +45,6 @@ foreign import ccall "cryptonite_md5_update"
 
 foreign import ccall unsafe "cryptonite_md5_finalize"
     c_md5_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()
+
+foreign import ccall "cryptonite_md5_finalize_prefix"
+    c_md5_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO ()

Crypto/Hash/RIPEMD160.hs

@@ -5,24 +5,28 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- RIPEMD160 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.RIPEMD160 ( RIPEMD160 (..) ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 -- | RIPEMD160 cryptographic hash algorithm
 data RIPEMD160 = RIPEMD160
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm RIPEMD160 where
+    type HashBlockSize           RIPEMD160 = 64
+    type HashDigestSize          RIPEMD160 = 20
+    type HashInternalContextSize RIPEMD160 = 128
     hashBlockSize  _          = 64
     hashDigestSize _          = 20
     hashInternalContextSize _ = 128

Crypto/Hash/SHA1.hs

@@ -5,24 +5,28 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- SHA1 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.SHA1 ( SHA1 (..) ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 -- | SHA1 cryptographic hash algorithm
 data SHA1 = SHA1
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm SHA1 where
+    type HashBlockSize           SHA1 = 64
+    type HashDigestSize          SHA1 = 20
+    type HashInternalContextSize SHA1 = 96
     hashBlockSize  _          = 64
     hashDigestSize _          = 20
     hashInternalContextSize _ = 96
@@ -30,6 +34,9 @@ instance HashAlgorithm SHA1 where
     hashInternalUpdate        = c_sha1_update
     hashInternalFinalize      = c_sha1_finalize
 
+instance HashAlgorithmPrefix SHA1 where
+    hashInternalFinalizePrefix = c_sha1_finalize_prefix
+
 foreign import ccall unsafe "cryptonite_sha1_init"
     c_sha1_init :: Ptr (Context a)-> IO ()
 
@@ -38,3 +45,6 @@ foreign import ccall "cryptonite_sha1_update"
 
 foreign import ccall unsafe "cryptonite_sha1_finalize"
     c_sha1_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()
+
+foreign import ccall "cryptonite_sha1_finalize_prefix"
+    c_sha1_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO ()

Crypto/Hash/SHA224.hs

@@ -5,24 +5,28 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- SHA224 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.SHA224 ( SHA224 (..) ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 -- | SHA224 cryptographic hash algorithm
 data SHA224 = SHA224
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm SHA224 where
+    type HashBlockSize           SHA224 = 64
+    type HashDigestSize          SHA224 = 28
+    type HashInternalContextSize SHA224 = 192
     hashBlockSize  _          = 64
     hashDigestSize _          = 28
     hashInternalContextSize _ = 192
@@ -30,6 +34,9 @@ instance HashAlgorithm SHA224 where
     hashInternalUpdate        = c_sha224_update
     hashInternalFinalize      = c_sha224_finalize
 
+instance HashAlgorithmPrefix SHA224 where
+    hashInternalFinalizePrefix = c_sha224_finalize_prefix
+
 foreign import ccall unsafe "cryptonite_sha224_init"
     c_sha224_init :: Ptr (Context a)-> IO ()
 
@@ -38,3 +45,6 @@ foreign import ccall "cryptonite_sha224_update"
 
 foreign import ccall unsafe "cryptonite_sha224_finalize"
     c_sha224_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()
+
+foreign import ccall "cryptonite_sha224_finalize_prefix"
+    c_sha224_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO ()

Crypto/Hash/SHA256.hs

@@ -5,24 +5,28 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- SHA256 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.SHA256 ( SHA256 (..) ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 -- | SHA256 cryptographic hash algorithm
 data SHA256 = SHA256
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm SHA256 where
+    type HashBlockSize           SHA256 = 64
+    type HashDigestSize          SHA256 = 32
+    type HashInternalContextSize SHA256 = 192
     hashBlockSize  _          = 64
     hashDigestSize _          = 32
     hashInternalContextSize _ = 192
@@ -30,6 +34,9 @@ instance HashAlgorithm SHA256 where
     hashInternalUpdate        = c_sha256_update
     hashInternalFinalize      = c_sha256_finalize
 
+instance HashAlgorithmPrefix SHA256 where
+    hashInternalFinalizePrefix = c_sha256_finalize_prefix
+
 foreign import ccall unsafe "cryptonite_sha256_init"
     c_sha256_init :: Ptr (Context a)-> IO ()
 
@@ -38,3 +45,6 @@ foreign import ccall "cryptonite_sha256_update"
 
 foreign import ccall unsafe "cryptonite_sha256_finalize"
     c_sha256_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()
+
+foreign import ccall "cryptonite_sha256_finalize_prefix"
+    c_sha256_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO ()

Crypto/Hash/SHA3.hs

@@ -5,11 +5,13 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- SHA3 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.SHA3
     (  SHA3_224 (..), SHA3_256 (..), SHA3_384 (..), SHA3_512 (..)
     ) where
@@ -17,15 +19,17 @@ module Crypto.Hash.SHA3
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 
 -- | SHA3 (224 bits) cryptographic hash algorithm
 data SHA3_224 = SHA3_224
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm SHA3_224 where
+    type HashBlockSize           SHA3_224 = 144
+    type HashDigestSize          SHA3_224 = 28
+    type HashInternalContextSize SHA3_224 = 352
     hashBlockSize  _          = 144
     hashDigestSize _          = 28
     hashInternalContextSize _ = 352
@@ -33,11 +37,18 @@ instance HashAlgorithm SHA3_224 where
     hashInternalUpdate        = c_sha3_update
     hashInternalFinalize p    = c_sha3_finalize p 224
 
+instance HashAlgorithmResumable SHA3_224 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | SHA3 (256 bits) cryptographic hash algorithm
 data SHA3_256 = SHA3_256
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm SHA3_256 where
+    type HashBlockSize           SHA3_256 = 136
+    type HashDigestSize          SHA3_256 = 32
+    type HashInternalContextSize SHA3_256 = 344
     hashBlockSize  _          = 136
     hashDigestSize _          = 32
     hashInternalContextSize _ = 344
@@ -45,11 +56,18 @@ instance HashAlgorithm SHA3_256 where
     hashInternalUpdate        = c_sha3_update
     hashInternalFinalize p    = c_sha3_finalize p 256
 
+instance HashAlgorithmResumable SHA3_256 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | SHA3 (384 bits) cryptographic hash algorithm
 data SHA3_384 = SHA3_384
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm SHA3_384 where
+    type HashBlockSize           SHA3_384 = 104
+    type HashDigestSize          SHA3_384 = 48
+    type HashInternalContextSize SHA3_384 = 312
     hashBlockSize  _          = 104
     hashDigestSize _          = 48
     hashInternalContextSize _ = 312
@@ -57,11 +75,18 @@ instance HashAlgorithm SHA3_384 where
     hashInternalUpdate        = c_sha3_update
     hashInternalFinalize p    = c_sha3_finalize p 384
 
+instance HashAlgorithmResumable SHA3_384 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | SHA3 (512 bits) cryptographic hash algorithm
 data SHA3_512 = SHA3_512
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm SHA3_512 where
+    type HashBlockSize           SHA3_512 = 72
+    type HashDigestSize          SHA3_512 = 64
+    type HashInternalContextSize SHA3_512 = 280
     hashBlockSize  _          = 72
     hashDigestSize _          = 64
     hashInternalContextSize _ = 280
@@ -69,6 +94,10 @@ instance HashAlgorithm SHA3_512 where
     hashInternalUpdate        = c_sha3_update
     hashInternalFinalize p    = c_sha3_finalize p 512
 
+instance HashAlgorithmResumable SHA3_512 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 
 foreign import ccall unsafe "cryptonite_sha3_init"
     c_sha3_init :: Ptr (Context a) -> Word32 -> IO ()
@@ -78,3 +107,9 @@ foreign import ccall "cryptonite_sha3_update"
 
 foreign import ccall unsafe "cryptonite_sha3_finalize"
     c_sha3_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_ctx_to_be"
+    c_sha3_ctx_to_be :: Ptr (Context a) -> Ptr Word8 -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_be_to_ctx"
+    c_sha3_be_to_ctx :: Ptr Word8 -> Ptr (Context a) -> IO ()

Crypto/Hash/SHA384.hs

@@ -5,24 +5,28 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- SHA384 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.SHA384 ( SHA384 (..) ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 -- | SHA384 cryptographic hash algorithm
 data SHA384 = SHA384
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm SHA384 where
+    type HashBlockSize           SHA384 = 128
+    type HashDigestSize          SHA384 = 48
+    type HashInternalContextSize SHA384 = 256
     hashBlockSize  _          = 128
     hashDigestSize _          = 48
     hashInternalContextSize _ = 256
@@ -30,6 +34,9 @@ instance HashAlgorithm SHA384 where
     hashInternalUpdate        = c_sha384_update
     hashInternalFinalize      = c_sha384_finalize
 
+instance HashAlgorithmPrefix SHA384 where
+    hashInternalFinalizePrefix = c_sha384_finalize_prefix
+
 foreign import ccall unsafe "cryptonite_sha384_init"
     c_sha384_init :: Ptr (Context a)-> IO ()
 
@@ -38,3 +45,6 @@ foreign import ccall "cryptonite_sha384_update"
 
 foreign import ccall unsafe "cryptonite_sha384_finalize"
     c_sha384_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()
+
+foreign import ccall "cryptonite_sha384_finalize_prefix"
+    c_sha384_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO ()

Crypto/Hash/SHA512.hs

@@ -5,24 +5,28 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- SHA512 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.SHA512 ( SHA512 (..) ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 -- | SHA512 cryptographic hash algorithm
 data SHA512 = SHA512
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm SHA512 where
+    type HashBlockSize           SHA512 = 128
+    type HashDigestSize          SHA512 = 64
+    type HashInternalContextSize SHA512 = 256
     hashBlockSize  _          = 128
     hashDigestSize _          = 64
     hashInternalContextSize _ = 256
@@ -30,6 +34,9 @@ instance HashAlgorithm SHA512 where
     hashInternalUpdate        = c_sha512_update
     hashInternalFinalize      = c_sha512_finalize
 
+instance HashAlgorithmPrefix SHA512 where
+    hashInternalFinalizePrefix = c_sha512_finalize_prefix
+
 foreign import ccall unsafe "cryptonite_sha512_init"
     c_sha512_init :: Ptr (Context a)-> IO ()
 
@@ -38,3 +45,6 @@ foreign import ccall "cryptonite_sha512_update"
 
 foreign import ccall unsafe "cryptonite_sha512_finalize"
     c_sha512_finalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()
+
+foreign import ccall "cryptonite_sha512_finalize_prefix"
+    c_sha512_finalize_prefix :: Ptr (Context a) -> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO ()

Crypto/Hash/SHA512t.hs

@@ -5,11 +5,13 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- SHA512t cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.SHA512t
     (  SHA512t_224 (..), SHA512t_256 (..)
     ) where
@@ -17,15 +19,17 @@ module Crypto.Hash.SHA512t
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 
 -- | SHA512t (224 bits) cryptographic hash algorithm
 data SHA512t_224 = SHA512t_224
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm SHA512t_224 where
+    type HashBlockSize           SHA512t_224 = 128
+    type HashDigestSize          SHA512t_224 = 28
+    type HashInternalContextSize SHA512t_224 = 256
     hashBlockSize  _          = 128
     hashDigestSize _          = 28
     hashInternalContextSize _ = 256
@@ -35,9 +39,12 @@ instance HashAlgorithm SHA512t_224 where
 
 -- | SHA512t (256 bits) cryptographic hash algorithm
 data SHA512t_256 = SHA512t_256
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm SHA512t_256 where
+    type HashBlockSize           SHA512t_256 = 128
+    type HashDigestSize          SHA512t_256 = 32
+    type HashInternalContextSize SHA512t_256 = 256
     hashBlockSize  _          = 128
     hashDigestSize _          = 32
     hashInternalContextSize _ = 256

Crypto/Hash/SHAKE.hs

@@ -0,0 +1,145 @@
+-- |
+-- Module      : Crypto.Hash.SHAKE
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Module containing the binding functions to work with the
+-- SHA3 extendable output functions (SHAKE).
+--
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Crypto.Hash.SHAKE
+    (  SHAKE128 (..), SHAKE256 (..), HashSHAKE (..)
+    ) where
+
+import           Control.Monad (when)
+import           Crypto.Hash.Types
+import           Foreign.Ptr (Ptr, castPtr)
+import           Foreign.Storable (Storable(..))
+import           Data.Bits
+import           Data.Data
+import           Data.Word (Word8, Word32)
+
+import           GHC.TypeLits (Nat, KnownNat, type (+))
+import           Crypto.Internal.Nat
+
+-- | Type class of SHAKE algorithms.
+class HashAlgorithm a => HashSHAKE a where
+    -- | Alternate finalization needed for cSHAKE
+    cshakeInternalFinalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()
+    -- | Get the digest bit length
+    cshakeOutputLength :: a -> Int
+
+-- | SHAKE128 (128 bits) extendable output function.  Supports an arbitrary
+-- digest size, to be specified as a type parameter of kind 'Nat'.
+--
+-- Note: outputs from @'SHAKE128' n@ and @'SHAKE128' m@ for the same input are
+-- correlated (one being a prefix of the other).  Results are unrelated to
+-- 'SHAKE256' results.
+data SHAKE128 (bitlen :: Nat) = SHAKE128
+    deriving (Show, Data)
+
+instance KnownNat bitlen => HashAlgorithm (SHAKE128 bitlen) where
+    type HashBlockSize           (SHAKE128 bitlen)  = 168
+    type HashDigestSize          (SHAKE128 bitlen) = Div8 (bitlen + 7)
+    type HashInternalContextSize (SHAKE128 bitlen) = 376
+    hashBlockSize  _          = 168
+    hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
+    hashInternalContextSize _ = 376
+    hashInternalInit p        = c_sha3_init p 128
+    hashInternalUpdate        = c_sha3_update
+    hashInternalFinalize      = shakeFinalizeOutput (Proxy :: Proxy bitlen)
+
+instance KnownNat bitlen => HashSHAKE (SHAKE128 bitlen) where
+    cshakeInternalFinalize = cshakeFinalizeOutput (Proxy :: Proxy bitlen)
+    cshakeOutputLength _ = integralNatVal (Proxy :: Proxy bitlen)
+
+instance KnownNat bitlen => HashAlgorithmResumable (SHAKE128 bitlen) where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
+-- | SHAKE256 (256 bits) extendable output function.  Supports an arbitrary
+-- digest size, to be specified as a type parameter of kind 'Nat'.
+--
+-- Note: outputs from @'SHAKE256' n@ and @'SHAKE256' m@ for the same input are
+-- correlated (one being a prefix of the other).  Results are unrelated to
+-- 'SHAKE128' results.
+data SHAKE256 (bitlen :: Nat) = SHAKE256
+    deriving (Show, Data)
+
+instance KnownNat bitlen => HashAlgorithm (SHAKE256 bitlen) where
+    type HashBlockSize           (SHAKE256 bitlen) = 136
+    type HashDigestSize          (SHAKE256 bitlen) = Div8 (bitlen + 7)
+    type HashInternalContextSize (SHAKE256 bitlen) = 344
+    hashBlockSize  _          = 136
+    hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
+    hashInternalContextSize _ = 344
+    hashInternalInit p        = c_sha3_init p 256
+    hashInternalUpdate        = c_sha3_update
+    hashInternalFinalize      = shakeFinalizeOutput (Proxy :: Proxy bitlen)
+
+instance KnownNat bitlen => HashSHAKE (SHAKE256 bitlen) where
+    cshakeInternalFinalize = cshakeFinalizeOutput (Proxy :: Proxy bitlen)
+    cshakeOutputLength _ = integralNatVal (Proxy :: Proxy bitlen)
+
+instance KnownNat bitlen => HashAlgorithmResumable (SHAKE256 bitlen) where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
+shakeFinalizeOutput :: KnownNat bitlen
+                    => proxy bitlen
+                    -> Ptr (Context a)
+                    -> Ptr (Digest a)
+                    -> IO ()
+shakeFinalizeOutput d ctx dig = do
+    c_sha3_finalize_shake ctx
+    c_sha3_output ctx dig (byteLen d)
+    shakeTruncate d (castPtr dig)
+
+cshakeFinalizeOutput :: KnownNat bitlen
+                     => proxy bitlen
+                     -> Ptr (Context a)
+                     -> Ptr (Digest a)
+                     -> IO ()
+cshakeFinalizeOutput d ctx dig = do
+    c_sha3_finalize_cshake ctx
+    c_sha3_output ctx dig (byteLen d)
+    shakeTruncate d (castPtr dig)
+
+shakeTruncate :: KnownNat bitlen => proxy bitlen -> Ptr Word8 -> IO ()
+shakeTruncate d ptr =
+    when (bits > 0) $ do
+        byte <- peekElemOff ptr index
+        pokeElemOff ptr index (byte .&. mask)
+  where
+    mask = (1 `shiftL` bits) - 1
+    (index, bits) = integralNatVal d `divMod` 8
+
+foreign import ccall unsafe "cryptonite_sha3_init"
+    c_sha3_init :: Ptr (Context a) -> Word32 -> IO ()
+
+foreign import ccall "cryptonite_sha3_update"
+    c_sha3_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_finalize_shake"
+    c_sha3_finalize_shake :: Ptr (Context a) -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_finalize_cshake"
+    c_sha3_finalize_cshake :: Ptr (Context a) -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_output"
+    c_sha3_output :: Ptr (Context a) -> Ptr (Digest a) -> Word32 -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_ctx_to_be"
+    c_sha3_ctx_to_be :: Ptr (Context a) -> Ptr Word8 -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_be_to_ctx"
+    c_sha3_be_to_ctx :: Ptr Word8 -> Ptr (Context a) -> IO ()

Crypto/Hash/Skein256.hs

@@ -5,11 +5,13 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- Skein256 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.Skein256
     (  Skein256_224 (..), Skein256_256 (..)
     ) where
@@ -17,15 +19,17 @@ module Crypto.Hash.Skein256
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 
 -- | Skein256 (224 bits) cryptographic hash algorithm
 data Skein256_224 = Skein256_224
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Skein256_224 where
+    type HashBlockSize           Skein256_224 = 32
+    type HashDigestSize          Skein256_224 = 28
+    type HashInternalContextSize Skein256_224 = 96
     hashBlockSize  _          = 32
     hashDigestSize _          = 28
     hashInternalContextSize _ = 96
@@ -35,9 +39,12 @@ instance HashAlgorithm Skein256_224 where
 
 -- | Skein256 (256 bits) cryptographic hash algorithm
 data Skein256_256 = Skein256_256
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Skein256_256 where
+    type HashBlockSize           Skein256_256 = 32
+    type HashDigestSize          Skein256_256 = 32
+    type HashInternalContextSize Skein256_256 = 96
     hashBlockSize  _          = 32
     hashDigestSize _          = 32
     hashInternalContextSize _ = 96

Crypto/Hash/Skein512.hs

@@ -5,11 +5,13 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- Skein512 cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.Skein512
     (  Skein512_224 (..), Skein512_256 (..), Skein512_384 (..), Skein512_512 (..)
     ) where
@@ -17,15 +19,17 @@ module Crypto.Hash.Skein512
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 
 -- | Skein512 (224 bits) cryptographic hash algorithm
 data Skein512_224 = Skein512_224
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Skein512_224 where
+    type HashBlockSize           Skein512_224 = 64
+    type HashDigestSize          Skein512_224 = 28
+    type HashInternalContextSize Skein512_224 = 160
     hashBlockSize  _          = 64
     hashDigestSize _          = 28
     hashInternalContextSize _ = 160
@@ -35,9 +39,12 @@ instance HashAlgorithm Skein512_224 where
 
 -- | Skein512 (256 bits) cryptographic hash algorithm
 data Skein512_256 = Skein512_256
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Skein512_256 where
+    type HashBlockSize           Skein512_256 = 64
+    type HashDigestSize          Skein512_256 = 32
+    type HashInternalContextSize Skein512_256 = 160
     hashBlockSize  _          = 64
     hashDigestSize _          = 32
     hashInternalContextSize _ = 160
@@ -47,9 +54,12 @@ instance HashAlgorithm Skein512_256 where
 
 -- | Skein512 (384 bits) cryptographic hash algorithm
 data Skein512_384 = Skein512_384
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Skein512_384 where
+    type HashBlockSize           Skein512_384 = 64
+    type HashDigestSize          Skein512_384 = 48
+    type HashInternalContextSize Skein512_384 = 160
     hashBlockSize  _          = 64
     hashDigestSize _          = 48
     hashInternalContextSize _ = 160
@@ -59,9 +69,12 @@ instance HashAlgorithm Skein512_384 where
 
 -- | Skein512 (512 bits) cryptographic hash algorithm
 data Skein512_512 = Skein512_512
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Skein512_512 where
+    type HashBlockSize           Skein512_512 = 64
+    type HashDigestSize          Skein512_512 = 64
+    type HashInternalContextSize Skein512_512 = 160
     hashBlockSize  _          = 64
     hashDigestSize _          = 64
     hashInternalContextSize _ = 160

Crypto/Hash/Tiger.hs

@@ -5,24 +5,28 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- Tiger cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.Tiger ( Tiger (..) ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 -- | Tiger cryptographic hash algorithm
 data Tiger = Tiger
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Tiger where
+    type HashBlockSize           Tiger = 64
+    type HashDigestSize          Tiger = 24
+    type HashInternalContextSize Tiger = 96
     hashBlockSize  _          = 64
     hashDigestSize _          = 24
     hashInternalContextSize _ = 96

Crypto/Hash/Types.hs

@@ -8,8 +8,14 @@
 -- Crypto hash types definitions
 --
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.Types
     ( HashAlgorithm(..)
+    , HashAlgorithmPrefix(..)
+    , HashAlgorithmResumable(..)
     , Context(..)
     , Digest(..)
     ) where
@@ -17,7 +23,15 @@ module Crypto.Hash.Types
 import           Crypto.Internal.Imports
 import           Crypto.Internal.ByteArray (ByteArrayAccess, Bytes)
 import qualified Crypto.Internal.ByteArray as B
+import           Control.Monad.ST
+import           Data.Char (digitToInt, isHexDigit)
 import           Foreign.Ptr (Ptr)
+import           Basement.Block (Block, unsafeFreeze)
+import           Basement.Block.Mutable (MutableBlock, new, unsafeWrite)
+import           Basement.NormalForm (deepseq)
+import           Basement.Types.OffsetSize (CountOf(..), Offset(..))
+import           GHC.TypeLits (Nat)
+import           Data.Data (Data)
 
 -- | Class representing hashing algorithms.
 --
@@ -25,6 +39,13 @@ import           Foreign.Ptr (Ptr)
 -- and lowlevel. the Hash module takes care of
 -- hidding the mutable interface properly.
 class HashAlgorithm a where
+    -- | Associated type for the block size of the hash algorithm
+    type HashBlockSize a :: Nat
+    -- | Associated type for the digest size of the hash algorithm
+    type HashDigestSize a :: Nat
+    -- | Associated type for the internal context size of the hash algorithm
+    type HashInternalContextSize a :: Nat
+
     -- | Get the block size of a hash algorithm
     hashBlockSize           :: a -> Int
     -- | Get the digest size of a hash algorithm
@@ -40,19 +61,67 @@ class HashAlgorithm a where
     -- | Finalize the context and set the digest raw memory to the right value
     hashInternalFinalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()
 
+-- | Hashing algorithms with a constant-time implementation.
+class HashAlgorithm a => HashAlgorithmPrefix a where
+    -- | Update the context with the first N bytes of a buffer and finalize this
+    -- context.  The code path executed is independent from N and depends only
+    -- on the complete buffer length.
+    hashInternalFinalizePrefix :: Ptr (Context a)
+                               -> Ptr Word8 -> Word32
+                               -> Word32
+                               -> Ptr (Digest a)
+                               -> IO ()
+class HashAlgorithm a => HashAlgorithmResumable a where
+  hashInternalPutContextBE :: Ptr (Context a) -> Ptr Word8 -> IO ()
+  hashInternalGetContextBE :: Ptr Word8 -> Ptr (Context a) -> IO ()
+
 {-
 hashContextGetAlgorithm :: HashAlgorithm a => Context a -> a
 hashContextGetAlgorithm = undefined
 -}
 
 -- | Represent a context for a given hash algorithm.
+--
+-- This type is an instance of 'ByteArrayAccess' for debugging purpose. Internal
+-- layout is architecture dependent, may contain uninitialized data fragments,
+-- and change in future versions.  The bytearray should not be used as input to
+-- cryptographic algorithms.
 newtype Context a = Context Bytes
     deriving (ByteArrayAccess,NFData)
 
 -- | Represent a digest for a given hash algorithm.
-newtype Digest a = Digest Bytes
+--
-    deriving (Eq,Ord,ByteArrayAccess,NFData)
+-- This type is an instance of 'ByteArrayAccess' from package
+-- <https://hackage.haskell.org/package/memory memory>.
+-- Module "Data.ByteArray" provides many primitives to work with those values
+-- including conversion to other types.
+--
+-- Creating a digest from a bytearray is also possible with function
+-- 'Crypto.Hash.digestFromByteString'.
+newtype Digest a = Digest (Block Word8)
+    deriving (Eq,Ord,ByteArrayAccess, Data)
+
+instance NFData (Digest a) where
+    rnf (Digest u) = u `deepseq` ()
 
 instance Show (Digest a) where
     show (Digest bs) = map (toEnum . fromIntegral)
                      $ B.unpack (B.convertToBase B.Base16 bs :: Bytes)
+
+instance HashAlgorithm a => Read (Digest a) where
+    readsPrec _ str = runST $ do mut <- new (CountOf len)
+                                 loop mut len str
+      where
+        len = hashDigestSize (undefined :: a)
+
+        loop :: MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
+        loop mut 0   cs          = (\b -> [(Digest b, cs)]) <$> unsafeFreeze mut
+        loop _   _   []          = return []
+        loop _   _   [_]         = return []
+        loop mut n   (c:(d:ds))
+            | not (isHexDigit c) = return []
+            | not (isHexDigit d) = return []
+            | otherwise          = do
+                let w8 = fromIntegral $ digitToInt c * 16 + digitToInt d
+                unsafeWrite mut (Offset $ len - n) w8
+                loop mut (n - 1) ds

Crypto/Hash/Whirlpool.hs

@@ -5,24 +5,28 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- module containing the binding functions to work with the
+-- Module containing the binding functions to work with the
 -- Whirlpool cryptographic hash.
 --
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.Whirlpool ( Whirlpool (..) ) where
 
 import           Crypto.Hash.Types
 import           Foreign.Ptr (Ptr)
 import           Data.Data
-import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 -- | Whirlpool cryptographic hash algorithm
 data Whirlpool = Whirlpool
-    deriving (Show,Data,Typeable)
+    deriving (Show,Data)
 
 instance HashAlgorithm Whirlpool where
+    type HashBlockSize           Whirlpool = 64
+    type HashDigestSize          Whirlpool = 64
+    type HashInternalContextSize Whirlpool = 168
     hashBlockSize  _          = 64
     hashDigestSize _          = 64
     hashInternalContextSize _ = 168

Crypto/Internal/Builder.hs

@@ -0,0 +1,53 @@
+-- |
+-- Module      : Crypto.Internal.Builder
+-- License     : BSD-style
+-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
+-- Stability   : stable
+-- Portability : Good
+--
+-- Delaying and merging ByteArray allocations.  This is similar to module
+-- "Data.ByteArray.Pack" except the total length is computed automatically based
+-- on what is appended.
+--
+{-# LANGUAGE BangPatterns #-}
+module Crypto.Internal.Builder
+    ( Builder
+    , buildAndFreeze
+    , builderLength
+    , byte
+    , bytes
+    , zero
+    ) where
+
+import           Data.ByteArray (ByteArray, ByteArrayAccess)
+import qualified Data.ByteArray as B
+import           Data.Memory.PtrMethods (memSet)
+
+import           Foreign.Ptr (Ptr, plusPtr)
+import           Foreign.Storable (poke)
+
+import           Crypto.Internal.Imports hiding (empty)
+
+data Builder =  Builder !Int (Ptr Word8 -> IO ())  -- size and initializer
+
+instance Semigroup Builder where
+    (Builder s1 f1) <> (Builder s2 f2) = Builder (s1 + s2) f
+      where f p = f1 p >> f2 (p `plusPtr` s1)
+
+builderLength :: Builder -> Int
+builderLength (Builder s _) = s
+
+buildAndFreeze :: ByteArray ba => Builder -> ba
+buildAndFreeze (Builder s f) = B.allocAndFreeze s f
+
+byte :: Word8 -> Builder
+byte !b = Builder 1 (`poke` b)
+
+bytes :: ByteArrayAccess ba => ba -> Builder
+bytes bs = Builder (B.length bs) (B.copyByteArrayToPtr bs)
+
+zero :: Int -> Builder
+zero s = if s > 0 then Builder s (\p -> memSet p 0 s) else empty
+
+empty :: Builder
+empty = Builder 0 (const $ return ())

Crypto/Internal/ByteArray.hs

@@ -7,13 +7,33 @@
 --
 -- Simple and efficient byte array types
 --
+{-# LANGUAGE BangPatterns #-}
 {-# OPTIONS_HADDOCK hide #-}
 module Crypto.Internal.ByteArray
     ( module Data.ByteArray
     , module Data.ByteArray.Mapping
     , module Data.ByteArray.Encoding
+    , constAllZero
     ) where
 
 import Data.ByteArray
 import Data.ByteArray.Mapping
 import Data.ByteArray.Encoding
+
+import Data.Bits ((.|.))
+import Data.Word (Word8)
+import Foreign.Ptr (Ptr)
+import Foreign.Storable (peekByteOff)
+
+import Crypto.Internal.Compat (unsafeDoIO)
+
+constAllZero :: ByteArrayAccess ba => ba -> Bool
+constAllZero b = unsafeDoIO $ withByteArray b $ \p -> loop p 0 0
+  where
+    loop :: Ptr b -> Int -> Word8 -> IO Bool
+    loop p i !acc
+        | i == len  = return $! acc == 0
+        | otherwise = do
+            e <- peekByteOff p i
+            loop p (i+1) (acc .|. e)
+    len = Data.ByteArray.length b

Crypto/Internal/Compat.hs

@@ -5,8 +5,8 @@
 -- Stability   : stable
 -- Portability : Good
 --
--- This module try to keep all the difference between versions of base
+-- This module tries to keep all the difference between versions of base
--- or other needed packages, so that modules don't need to use CPP
+-- or other needed packages, so that modules don't need to use CPP.
 --
 {-# LANGUAGE CPP #-}
 module Crypto.Internal.Compat
@@ -19,10 +19,10 @@ import System.IO.Unsafe
 import Data.Word
 import Data.Bits
 
--- | perform io for hashes that do allocation and ffi.
+-- | Perform io for hashes that do allocation and FFI.
--- unsafeDupablePerformIO is used when possible as the
+-- 'unsafeDupablePerformIO' is used when possible as the
 -- computation is pure and the output is directly linked
--- to the input. we also do not modify anything after it has
+-- to the input. We also do not modify anything after it has
 -- been returned to the user.
 unsafeDoIO :: IO a -> a
 #if __GLASGOW_HASKELL__ > 704

Crypto/Internal/CompatPrim.hs

@@ -5,11 +5,11 @@
 -- Stability   : stable
 -- Portability : Compat
 --
--- This module try to keep all the difference between versions of ghc primitive
+-- This module tries to keep all the difference between versions of ghc primitive
 -- or other needed packages, so that modules don't need to use CPP.
 --
 -- Note that MagicHash and CPP conflicts in places, making it "more interesting"
--- to write compat code for primitives
+-- to write compat code for primitives.
 --
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
@@ -23,15 +23,21 @@ module Crypto.Internal.CompatPrim
     , convert4To32
     ) where
 
-import GHC.Prim
 #if !defined(ARCH_IS_LITTLE_ENDIAN) && !defined(ARCH_IS_BIG_ENDIAN)
 import Data.Memory.Endian (getSystemEndianness, Endianness(..))
 #endif
 
--- | byteswap Word# to or from Big Endian
+#if __GLASGOW_HASKELL__ >= 902
+import GHC.Prim
+#else
+import GHC.Prim hiding (Word32#)
+type Word32# = Word#
+#endif
+
+-- | Byteswap Word# to or from Big Endian
 --
--- on a big endian machine, this function is a nop.
+-- On a big endian machine, this function is a nop.
-be32Prim :: Word# -> Word#
+be32Prim :: Word32# -> Word32#
 #ifdef ARCH_IS_LITTLE_ENDIAN
 be32Prim = byteswap32Prim
 #elif defined(ARCH_IS_BIG_ENDIAN)
@@ -40,10 +46,10 @@ be32Prim = id
 be32Prim w = if getSystemEndianness == LittleEndian then byteswap32Prim w else w
 #endif
 
--- | byteswap Word# to or from Little Endian
+-- | Byteswap Word# to or from Little Endian
 --
--- on a little endian machine, this function is a nop.
+-- On a little endian machine, this function is a nop.
-le32Prim :: Word# -> Word#
+le32Prim :: Word32# -> Word32#
 #ifdef ARCH_IS_LITTLE_ENDIAN
 le32Prim w = w
 #elif defined(ARCH_IS_BIG_ENDIAN)
@@ -54,19 +60,14 @@ le32Prim w = if getSystemEndianness == LittleEndian then w else byteswap32Prim w
 
 -- | Simple compatibility for byteswap the lower 32 bits of a Word#
 -- at the primitive level
-byteswap32Prim :: Word# -> Word#
+byteswap32Prim :: Word32# -> Word32#
-#if __GLASGOW_HASKELL__ >= 708
+#if __GLASGOW_HASKELL__ >= 902
-byteswap32Prim w = byteSwap32# w
+byteswap32Prim w = wordToWord32# (byteSwap32# (word32ToWord# w))
 #else
-byteswap32Prim w =
+byteswap32Prim w = byteSwap32# w
-    let !a =       uncheckedShiftL# w 24#
-        !b = and# (uncheckedShiftL# w 8#) 0x00ff0000##
-        !c = and# (uncheckedShiftRL# w 8#) 0x0000ff00##
-        !d = and# (uncheckedShiftRL# w 24#) 0x000000ff##
-     in or# a (or# b (or# c d))
 #endif
 
--- | combine 4 word8 [a,b,c,d] to a word32 representing [a,b,c,d]
+-- | Combine 4 word8 [a,b,c,d] to a word32 representing [a,b,c,d]
 convert4To32 :: Word# -> Word# -> Word# -> Word#
              -> Word#
 convert4To32 a b c d = or# (or# c1 c2) (or# c3 c4)

Crypto/Internal/DeepSeq.hs

@@ -30,4 +30,6 @@ instance NFData Word64 where rnf w = w `seq` ()
 instance NFData Bytes where rnf b = b `seq` ()
 instance NFData ScrubbedBytes where rnf b = b `seq` ()
 
+instance NFData Integer  where rnf i = i `seq` ()
+
 #endif

Crypto/Internal/Imports.hs

@@ -5,11 +5,15 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
+{-# LANGUAGE CPP #-}
 module Crypto.Internal.Imports
     ( module X
     ) where
 
 import Data.Word               as X
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup          as X (Semigroup(..))
+#endif
 import Control.Applicative     as X
 import Control.Monad           as X (forM, forM_, void)
 import Control.Arrow           as X (first, second)

Crypto/Internal/Nat.hs

@@ -0,0 +1,213 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Crypto.Internal.Nat
+    ( type IsDivisibleBy8
+    , type IsAtMost, type IsAtLeast
+    , byteLen
+    , integralNatVal
+    , type IsDiv8
+    , type Div8
+    , type Mod8
+    ) where
+
+import           GHC.TypeLits
+
+byteLen :: (KnownNat bitlen, Num a) => proxy bitlen -> a
+byteLen d = fromInteger ((natVal d + 7) `div` 8)
+
+integralNatVal :: (KnownNat bitlen, Num a) => proxy bitlen -> a
+integralNatVal = fromInteger . natVal
+
+type family IsLE (bitlen :: Nat) (n :: Nat) (c :: Bool) where
+    IsLE _ _ 'True  = 'True
+#if MIN_VERSION_base(4,9,0)
+    IsLE bitlen n 'False = TypeError
+      (     ('Text "bitlen " ':<>: 'ShowType bitlen ':<>: 'Text " is greater than " ':<>: 'ShowType n)
+      ':$$: ('Text "You have tried to use an invalid Digest size. Please, refer to the documentation.")
+      )
+#else
+    IsLE bitlen n 'False = 'False
+#endif
+
+-- | ensure the given `bitlen` is lesser or equal to `n`
+--
+type IsAtMost  (bitlen :: Nat) (n :: Nat) = IsLE bitlen n (bitlen <=? n) ~ 'True
+
+type family IsGE (bitlen :: Nat) (n :: Nat) (c :: Bool) where
+    IsGE _ _ 'True  = 'True
+#if MIN_VERSION_base(4,9,0)
+    IsGE bitlen n 'False = TypeError
+      (     ('Text "bitlen " ':<>: 'ShowType bitlen ':<>: 'Text " is lesser than " ':<>: 'ShowType n)
+      ':$$: ('Text "You have tried to use an invalid Digest size. Please, refer to the documentation.")
+      )
+#else
+    IsGE bitlen n 'False = 'False
+#endif
+
+-- | ensure the given `bitlen` is greater or equal to `n`
+--
+type IsAtLeast (bitlen :: Nat) (n :: Nat) = IsGE bitlen n (n <=? bitlen) ~ 'True
+
+type family Div8 (bitLen :: Nat) where
+    Div8 0 = 0
+    Div8 1 = 0
+    Div8 2 = 0
+    Div8 3 = 0
+    Div8 4 = 0
+    Div8 5 = 0
+    Div8 6 = 0
+    Div8 7 = 0
+    Div8 8 = 1
+    Div8 9 = 1
+    Div8 10 = 1
+    Div8 11 = 1
+    Div8 12 = 1
+    Div8 13 = 1
+    Div8 14 = 1
+    Div8 15 = 1
+    Div8 16 = 2
+    Div8 17 = 2
+    Div8 18 = 2
+    Div8 19 = 2
+    Div8 20 = 2
+    Div8 21 = 2
+    Div8 22 = 2
+    Div8 23 = 2
+    Div8 24 = 3
+    Div8 25 = 3
+    Div8 26 = 3
+    Div8 27 = 3
+    Div8 28 = 3
+    Div8 29 = 3
+    Div8 30 = 3
+    Div8 31 = 3
+    Div8 32 = 4
+    Div8 33 = 4
+    Div8 34 = 4
+    Div8 35 = 4
+    Div8 36 = 4
+    Div8 37 = 4
+    Div8 38 = 4
+    Div8 39 = 4
+    Div8 40 = 5
+    Div8 41 = 5
+    Div8 42 = 5
+    Div8 43 = 5
+    Div8 44 = 5
+    Div8 45 = 5
+    Div8 46 = 5
+    Div8 47 = 5
+    Div8 48 = 6
+    Div8 49 = 6
+    Div8 50 = 6
+    Div8 51 = 6
+    Div8 52 = 6
+    Div8 53 = 6
+    Div8 54 = 6
+    Div8 55 = 6
+    Div8 56 = 7
+    Div8 57 = 7
+    Div8 58 = 7
+    Div8 59 = 7
+    Div8 60 = 7
+    Div8 61 = 7
+    Div8 62 = 7
+    Div8 63 = 7
+    Div8 64 = 8
+    Div8 n  = 8 + Div8 (n - 64)
+
+type family IsDiv8 (bitLen :: Nat) (n :: Nat) where
+    IsDiv8 _ 0 = 'True
+#if MIN_VERSION_base(4,9,0)
+    IsDiv8 bitLen 1 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 2 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 3 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 4 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 5 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 6 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+    IsDiv8 bitLen 7 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
+#else
+    IsDiv8 _ 1 = 'False
+    IsDiv8 _ 2 = 'False
+    IsDiv8 _ 3 = 'False
+    IsDiv8 _ 4 = 'False
+    IsDiv8 _ 5 = 'False
+    IsDiv8 _ 6 = 'False
+    IsDiv8 _ 7 = 'False
+#endif
+    IsDiv8 _ n = IsDiv8 n (Mod8 n)
+
+type family Mod8 (n :: Nat) where
+    Mod8 0 = 0
+    Mod8 1 = 1
+    Mod8 2 = 2
+    Mod8 3 = 3
+    Mod8 4 = 4
+    Mod8 5 = 5
+    Mod8 6 = 6
+    Mod8 7 = 7
+    Mod8 8 = 0
+    Mod8 9 = 1
+    Mod8 10 = 2
+    Mod8 11 = 3
+    Mod8 12 = 4
+    Mod8 13 = 5
+    Mod8 14 = 6
+    Mod8 15 = 7
+    Mod8 16 = 0
+    Mod8 17 = 1
+    Mod8 18 = 2
+    Mod8 19 = 3
+    Mod8 20 = 4
+    Mod8 21 = 5
+    Mod8 22 = 6
+    Mod8 23 = 7
+    Mod8 24 = 0
+    Mod8 25 = 1
+    Mod8 26 = 2
+    Mod8 27 = 3
+    Mod8 28 = 4
+    Mod8 29 = 5
+    Mod8 30 = 6
+    Mod8 31 = 7
+    Mod8 32 = 0
+    Mod8 33 = 1
+    Mod8 34 = 2
+    Mod8 35 = 3
+    Mod8 36 = 4
+    Mod8 37 = 5
+    Mod8 38 = 6
+    Mod8 39 = 7
+    Mod8 40 = 0
+    Mod8 41 = 1
+    Mod8 42 = 2
+    Mod8 43 = 3
+    Mod8 44 = 4
+    Mod8 45 = 5
+    Mod8 46 = 6
+    Mod8 47 = 7
+    Mod8 48 = 0
+    Mod8 49 = 1
+    Mod8 50 = 2
+    Mod8 51 = 3
+    Mod8 52 = 4
+    Mod8 53 = 5
+    Mod8 54 = 6
+    Mod8 55 = 7
+    Mod8 56 = 0
+    Mod8 57 = 1
+    Mod8 58 = 2
+    Mod8 59 = 3
+    Mod8 60 = 4
+    Mod8 61 = 5
+    Mod8 62 = 6
+    Mod8 63 = 7
+    Mod8 n = Mod8 (n - 64)
+
+-- | ensure the given `bitlen` is divisible by 8
+--
+type IsDivisibleBy8 bitLen = IsDiv8 bitLen bitLen ~ 'True

Crypto/Internal/Proxy.hs

@@ -1,13 +0,0 @@
--- |
--- Module      : Crypto.Internal.Proxy
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : Good
---
-module Crypto.Internal.Proxy
-    ( Proxy(..)
-    ) where
-
--- | A type witness for 'a' as phantom type
-data Proxy a = Proxy

Crypto/Internal/WordArray.hs

@@ -1,5 +1,5 @@
 -- |
--- Module      : Crypto.Internal.Compat
+-- Module      : Crypto.Internal.WordArray
 -- License     : BSD-style
 -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
 -- Stability   : stable
@@ -8,7 +8,7 @@
 -- Small and self contained array representation
 -- with limited safety for internal use.
 --
--- the array produced should never be exposed to the user directly
+-- The array produced should never be exposed to the user directly.
 --
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE MagicHash #-}
@@ -20,6 +20,8 @@ module Crypto.Internal.WordArray
     , MutableArray32
     , array8
     , array32
+    , array32FromAddrBE
+    , allocArray32AndFreeze
     , mutableArray32
     , array64
     , arrayRead8
@@ -58,21 +60,21 @@ array8 = Array8
 
 -- | Create an Array of Word32 of specific size from a list of Word32
 array32 :: Int -> [Word32] -> Array32
-array32 (I# n) l = unsafeDoIO $ IO $ \s ->
+array32 n l = unsafeDoIO (mutableArray32 n l >>= mutableArray32Freeze)
-    case newAlignedPinnedByteArray# (n *# 4#) 4# s of
-        (# s', mbarr #) -> loop 0# s' mbarr l
-  where
-        loop _ st mb [] = freezeArray mb st
-        loop i st mb ((W32# x):xs)
-            | booleanPrim (i ==# n) = freezeArray mb st
-            | otherwise =
-                let !st' = writeWord32Array# mb i x st
-                 in loop (i +# 1#) st' mb xs
-        freezeArray mb st =
-            case unsafeFreezeByteArray# mb st of
-                (# st', b #) -> (# st', Array32 b #)
 {-# NOINLINE array32 #-}
 
+-- | Create an Array of BE Word32 aliasing an Addr
+array32FromAddrBE :: Int -> Addr# -> Array32
+array32FromAddrBE n a =
+    unsafeDoIO (mutableArray32FromAddrBE n a >>= mutableArray32Freeze)
+{-# NOINLINE array32FromAddrBE #-}
+
+-- | Create an Array of Word32 using an initializer
+allocArray32AndFreeze :: Int -> (MutableArray32 -> IO ()) -> Array32
+allocArray32AndFreeze n f =
+    unsafeDoIO (mutableArray32 n [] >>= \m -> f m >> mutableArray32Freeze m)
+{-# NOINLINE allocArray32AndFreeze #-}
+
 -- | Create an Array of Word64 of specific size from a list of Word64
 array64 :: Int -> [Word64] -> Array64
 array64 (I# n) l = unsafeDoIO $ IO $ \s ->

Crypto/KDF/Argon2.hs

@@ -0,0 +1,157 @@
+-- |
+-- Module      : Crypto.KDF.Argon2
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Argon2 hashing function (P-H-C winner)
+--
+-- Recommended to use this module qualified
+--
+-- File started from Argon2.hs, from Oliver Charles
+-- at https://github.com/ocharles/argon2
+--
+module Crypto.KDF.Argon2
+    (
+      Options(..)
+    , TimeCost
+    , MemoryCost
+    , Parallelism
+    , Variant(..)
+    , Version(..)
+    , defaultOptions
+    -- * Hashing function
+    , hash
+    ) where
+
+import           Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess)
+import qualified Crypto.Internal.ByteArray as B
+import           Crypto.Error
+import           Control.Monad (when)
+import           Data.Word
+import           Foreign.C
+import           Foreign.Ptr
+
+-- | Which variant of Argon2 to use. You should choose the variant that is most
+-- applicable to your intention to hash inputs.
+data Variant =
+      Argon2d  -- ^ Argon2d is faster than Argon2i and uses data-depending memory access,
+               -- which makes it suitable for cryptocurrencies and applications with no
+               -- threats from side-channel timing attacks.
+    | Argon2i  -- ^ Argon2i uses data-independent memory access, which is preferred
+               -- for password hashing and password-based key derivation. Argon2i
+               -- is slower as it makes more passes over the memory to protect from
+               -- tradeoff attacks.
+    | Argon2id -- ^ Argon2id is a hybrid of Argon2i and Argon2d, using a combination
+               -- of data-depending and data-independent memory accesses, which gives
+               -- some of Argon2i's resistance to side-channel cache timing attacks
+               -- and much of Argon2d's resistance to GPU cracking attacks
+    deriving (Eq,Ord,Read,Show,Enum,Bounded)
+
+-- | Which version of Argon2 to use
+data Version = Version10 | Version13
+    deriving (Eq,Ord,Read,Show,Enum,Bounded)
+
+-- | The time cost, which defines the amount of computation realized and therefore the execution time, given in number of iterations.
+--
+-- 'FFI.ARGON2_MIN_TIME' <= 'hashIterations' <= 'FFI.ARGON2_MAX_TIME'
+type TimeCost = Word32
+
+-- | The memory cost, which defines the memory usage, given in kibibytes.
+--
+-- max 'FFI.ARGON2_MIN_MEMORY' (8 * 'hashParallelism') <= 'hashMemory' <= 'FFI.ARGON2_MAX_MEMORY'
+type MemoryCost = Word32
+
+-- | A parallelism degree, which defines the number of parallel threads.
+--
+-- 'FFI.ARGON2_MIN_LANES' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_LANES' && 'FFI.ARGON_MIN_THREADS' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_THREADS'
+type Parallelism = Word32
+
+-- | Parameters that can be adjusted to change the runtime performance of the
+-- hashing.
+data Options = Options
+    { iterations  :: !TimeCost
+    , memory      :: !MemoryCost
+    , parallelism :: !Parallelism
+    , variant     :: !Variant     -- ^ Which variant of Argon2 to use.
+    , version     :: !Version     -- ^ Which version of Argon2 to use.
+    }
+    deriving (Eq,Ord,Read,Show)
+
+saltMinLength :: Int
+saltMinLength = 8
+
+outputMinLength :: Int
+outputMinLength = 4
+
+-- specification allows up to 2^32-1 but this is too big for a signed Int
+-- on a 32-bit architecture, so we limit tag length to 2^31-1 bytes
+outputMaxLength :: Int
+outputMaxLength = 0x7fffffff
+
+defaultOptions :: Options
+defaultOptions =
+    Options { iterations  = 1
+            , memory      = 2 ^ (17 :: Int)
+            , parallelism = 4
+            , variant     = Argon2i
+            , version     = Version13
+            }
+
+hash :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray out)
+     => Options
+     -> password
+     -> salt
+     -> Int
+     -> CryptoFailable out
+hash options password salt outLen
+    | saltLen < saltMinLength  = CryptoFailed CryptoError_SaltTooSmall
+    | outLen < outputMinLength = CryptoFailed CryptoError_OutputLengthTooSmall
+    | outLen > outputMaxLength = CryptoFailed CryptoError_OutputLengthTooBig
+    | otherwise                = CryptoPassed $ B.allocAndFreeze outLen $ \out -> do
+        res <- B.withByteArray password $ \pPass ->
+               B.withByteArray salt     $ \pSalt ->
+                    argon2_hash (iterations options)
+                                (memory options)
+                                (parallelism options)
+                                pPass
+                                (csizeOfInt passwordLen)
+                                pSalt
+                                (csizeOfInt saltLen)
+                                out
+                                (csizeOfInt outLen)
+                                (cOfVariant $ variant options)
+                                (cOfVersion $ version options)
+        when (res /= 0) $ error "argon2: hash: internal error"
+  where
+    saltLen = B.length salt
+    passwordLen = B.length password
+
+data Pass
+data Salt
+data HashOut
+
+type CVariant = CInt -- valid value is 0 (Argon2d), 1 (Argon2i) and 2 (Argon2id)
+type CVersion = CInt -- valid value is 0x10, 0x13
+
+cOfVersion :: Version -> CVersion
+cOfVersion Version10 = 0x10
+cOfVersion Version13 = 0x13
+
+cOfVariant :: Variant -> CVariant
+cOfVariant Argon2d  = 0
+cOfVariant Argon2i  = 1
+cOfVariant Argon2id = 2
+
+csizeOfInt :: Int -> CSize
+csizeOfInt = fromIntegral
+
+foreign import ccall unsafe "cryptonite_argon2_hash"
+    argon2_hash :: Word32 -> Word32 -> Word32
+                -> Ptr Pass -> CSize
+                -> Ptr Salt -> CSize
+                -> Ptr HashOut -> CSize
+                -> CVariant
+                -> CVersion
+                -> IO CInt

Crypto/KDF/BCrypt.hs

@@ -11,7 +11,7 @@
 -- >>> validatePassword password bcryptHash
 -- >>> True
 -- >>> let otherPassword = B.pack "otherpassword"
--- >>> otherHash <- hashPassword 12 otherPasssword :: IO B.ByteString
+-- >>> otherHash <- hashPassword 12 otherPassword :: IO B.ByteString
 -- >>> validatePassword otherPassword otherHash
 -- >>> True
 --
@@ -27,13 +27,16 @@
 -- salt and hash bytes (each separately Base64 encoded. Incrementing the
 -- cost parameter approximately doubles the time taken to calculate the hash.
 --
--- The different version numbers have evolved because of bugs in the standard
+-- The different version numbers evolved to account for bugs in the standard
--- C implementations. The most up to date version is @2b@ and this
+-- C implementations. They don't represent different versions of the algorithm
--- implementation the @2b@ version prefix, but will also attempt to validate
+-- itself and in most cases should produce identical results.
+-- The most up to date version is @2b@ and this implementation uses the
+-- @2b@ version prefix, but will also attempt to validate
 -- against hashes with versions @2a@ and @2y@. Version @2@ or @2x@ will be
 -- rejected. No attempt is made to differentiate between the different versions
 -- when validating a password, but in practice this shouldn't cause any problems
--- if passwords are UTF-8 encoded (which they should be).
+-- if passwords are UTF-8 encoded (which they should be) and less than 256
+-- characters long.
 --
 -- The cost parameter can be between 4 and 31 inclusive, but anything less than
 -- 10 is probably not strong enough. High values may be prohibitively slow
@@ -49,11 +52,16 @@ module Crypto.KDF.BCrypt
     )
 where
 
-import           Control.Monad (unless, when)
+import           Control.Monad                    (forM_, unless, when)
-import           Crypto.Cipher.Blowfish.Primitive (eksBlowfish, encrypt)
+import           Crypto.Cipher.Blowfish.Primitive (Context, createKeySchedule,
-import           Crypto.Random (MonadRandom, getRandomBytes)
+                                                   encrypt, expandKey,
-import           Data.ByteArray (ByteArrayAccess, ByteArray, Bytes)
+                                                   expandKeyWithSalt,
-import qualified Data.ByteArray as B
+                                                   freezeKeySchedule)
+import           Crypto.Internal.Compat
+import           Crypto.Random                    (MonadRandom, getRandomBytes)
+import           Data.ByteArray                   (ByteArray, ByteArrayAccess,
+                                                   Bytes)
+import qualified Data.ByteArray                   as B
 import           Data.ByteArray.Encoding
 import           Data.Char
 
@@ -93,7 +101,7 @@ bcrypt :: (ByteArray salt, ByteArray password, ByteArray output)
 bcrypt cost salt password = B.concat [header, B.snoc costBytes dollar, b64 salt, b64 hash]
   where
     hash   = rawHash 'b' realCost salt password
-    header = B.pack [dollar, fromIntegral (ord '2'), fromIntegral (ord 'a'), dollar]
+    header = B.pack [dollar, fromIntegral (ord '2'), fromIntegral (ord 'b'), dollar]
     dollar = fromIntegral (ord '$')
     zero   = fromIntegral (ord '0')
     costBytes  = B.pack [zero + fromIntegral (realCost `div` 10), zero + fromIntegral (realCost `mod` 10)]
@@ -133,7 +141,7 @@ rawHash _ cost salt password = B.take 23 hash -- Another compatibility bug. Igno
     -- Truncate the password if necessary and append a null byte for C compatibility
     key = B.snoc (B.take 72 password) 0
 
-    ctx = eksBlowfish cost salt key
+    ctx = expensiveBlowfishContext key salt cost
 
     -- The BCrypt plaintext: "OrpheanBeholderScryDoubt"
     orpheanBeholder = B.pack [79,114,112,104,101,97,110,66,101,104,111,108,100,101,114,83,99,114,121,68,111,117,98,116]
@@ -156,10 +164,26 @@ parseBCryptHash bc = do
     costTens  = fromIntegral (B.index bc 4) - zero
     costUnits = fromIntegral (B.index bc 5) - zero
     version   = chr (fromIntegral (B.index bc 2))
-    cost      = costUnits + (if costTens == 0 then 0 else 10^costTens) :: Int
+    cost      = costUnits + 10*costTens :: Int
 
     decodeSaltHash saltHash = do
         let (s, h) = B.splitAt 22 saltHash
         salt <- convertFromBase Base64OpenBSD s
         hash <- convertFromBase Base64OpenBSD h
         return (salt, hash)
+
+-- | Create a key schedule for the BCrypt "EKS" version.
+--
+-- Salt must be a 128-bit byte array.
+-- Cost must be between 4 and 31 inclusive
+-- See <https://www.usenix.org/conference/1999-usenix-annual-technical-conference/future-adaptable-password-scheme>
+expensiveBlowfishContext :: (ByteArrayAccess key, ByteArrayAccess salt) => key-> salt -> Int -> Context
+expensiveBlowfishContext keyBytes saltBytes cost
+  | B.length saltBytes /= 16 = error "bcrypt salt must be 16 bytes"
+  | otherwise = unsafeDoIO $ do
+        ks <- createKeySchedule
+        expandKeyWithSalt ks keyBytes saltBytes
+        forM_ [1..2^cost :: Int] $ \_ -> do
+            expandKey ks keyBytes
+            expandKey ks saltBytes
+        freezeKeySchedule ks

Crypto/KDF/BCryptPBKDF.hs

@@ -0,0 +1,187 @@
+-- |
+-- Module      : Crypto.KDF.BCryptPBKDF
+-- License     : BSD-style
+-- Stability   : experimental
+-- Portability : Good
+--
+-- Port of the bcrypt_pbkdf key derivation function from OpenBSD
+-- as described at <http://man.openbsd.org/bcrypt_pbkdf.3>.
+module Crypto.KDF.BCryptPBKDF
+    ( Parameters (..)
+    , generate
+    , hashInternal
+    )
+where
+
+import           Basement.Block                   (MutableBlock)
+import qualified Basement.Block                   as Block
+import qualified Basement.Block.Mutable           as Block
+import           Basement.Monad                   (PrimState)
+import           Basement.Types.OffsetSize        (CountOf (..), Offset (..))
+import           Control.Exception                (finally)
+import           Control.Monad                    (when)
+import qualified Crypto.Cipher.Blowfish.Box       as Blowfish
+import qualified Crypto.Cipher.Blowfish.Primitive as Blowfish
+import           Crypto.Hash.Algorithms           (SHA512 (..))
+import           Crypto.Hash.Types                (Context,
+                                                   hashDigestSize,
+                                                   hashInternalContextSize,
+                                                   hashInternalFinalize,
+                                                   hashInternalInit,
+                                                   hashInternalUpdate)
+import           Crypto.Internal.Compat           (unsafeDoIO)
+import           Data.Bits
+import qualified Data.ByteArray                   as B
+import           Data.Foldable                    (forM_)
+import           Data.Memory.PtrMethods           (memCopy, memSet, memXor)
+import           Data.Word
+import           Foreign.Ptr                      (Ptr, castPtr)
+import           Foreign.Storable                 (peekByteOff, pokeByteOff)
+
+data Parameters = Parameters
+  { iterCounts   :: Int -- ^ The number of user-defined iterations for the algorithm
+                        --   (must be > 0)
+  , outputLength :: Int -- ^ The number of bytes to generate out of BCryptPBKDF
+                        --   (must be in 1..1024)
+  } deriving (Eq, Ord, Show)
+
+-- | Derive a key of specified length using the bcrypt_pbkdf algorithm.
+generate :: (B.ByteArray pass, B.ByteArray salt, B.ByteArray output)
+       => Parameters
+       -> pass
+       -> salt
+       -> output
+generate params pass salt
+    | iterCounts params < 1       = error "BCryptPBKDF: iterCounts must be > 0"
+    | keyLen < 1 || keyLen > 1024 = error "BCryptPBKDF: outputLength must be in 1..1024"
+    | otherwise                   = B.unsafeCreate keyLen deriveKey
+  where
+    outLen, tmpLen, blkLen, keyLen, passLen, saltLen, ctxLen, hashLen, blocks :: Int
+    outLen  = 32
+    tmpLen  = 32
+    blkLen  = 4
+    passLen = B.length pass
+    saltLen = B.length salt
+    keyLen  = outputLength params
+    ctxLen  = hashInternalContextSize SHA512
+    hashLen = hashDigestSize SHA512 -- 64
+    blocks  = (keyLen + outLen - 1) `div` outLen
+
+    deriveKey :: Ptr Word8 -> IO ()
+    deriveKey keyPtr = do
+        -- Allocate all necessary memory. The algorihm shall not allocate
+        -- any more dynamic memory after this point. Blocks need to be pinned
+        -- as pointers to them are passed to the SHA512 implementation.
+        ksClean        <- Blowfish.createKeySchedule
+        ksDirty        <- Blowfish.createKeySchedule
+        ctxMBlock      <- Block.newPinned (CountOf ctxLen  :: CountOf Word8)
+        outMBlock      <- Block.newPinned (CountOf outLen  :: CountOf Word8)
+        tmpMBlock      <- Block.newPinned (CountOf tmpLen  :: CountOf Word8)
+        blkMBlock      <- Block.newPinned (CountOf blkLen  :: CountOf Word8)
+        passHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8)
+        saltHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8)
+        -- Finally erase all memory areas that contain information from
+        -- which the derived key could be reconstructed.
+        -- As all MutableBlocks are pinned it shall be guaranteed that
+        -- no temporary trampoline buffers are allocated.
+        finallyErase outMBlock $ finallyErase passHashMBlock $
+            B.withByteArray pass                $ \passPtr->
+            B.withByteArray salt                $ \saltPtr->
+            Block.withMutablePtr ctxMBlock      $ \ctxPtr->
+            Block.withMutablePtr outMBlock      $ \outPtr->
+            Block.withMutablePtr tmpMBlock      $ \tmpPtr->
+            Block.withMutablePtr blkMBlock      $ \blkPtr->
+            Block.withMutablePtr passHashMBlock $ \passHashPtr->
+            Block.withMutablePtr saltHashMBlock $ \saltHashPtr-> do
+                -- Hash the password.
+                let shaPtr = castPtr ctxPtr :: Ptr (Context SHA512)
+                hashInternalInit     shaPtr
+                hashInternalUpdate   shaPtr passPtr (fromIntegral passLen)
+                hashInternalFinalize shaPtr (castPtr passHashPtr)
+                passHashBlock <- Block.unsafeFreeze passHashMBlock
+                forM_ [1..blocks] $ \block-> do
+                    -- Poke the increased block counter.
+                    Block.unsafeWrite blkMBlock 0 (fromIntegral $ block `shiftR` 24)
+                    Block.unsafeWrite blkMBlock 1 (fromIntegral $ block `shiftR` 16)
+                    Block.unsafeWrite blkMBlock 2 (fromIntegral $ block `shiftR`  8)
+                    Block.unsafeWrite blkMBlock 3 (fromIntegral $ block `shiftR`  0)
+                    -- First round (slightly different).
+                    hashInternalInit     shaPtr
+                    hashInternalUpdate   shaPtr saltPtr (fromIntegral saltLen)
+                    hashInternalUpdate   shaPtr blkPtr  (fromIntegral blkLen)
+                    hashInternalFinalize shaPtr (castPtr saltHashPtr)
+                    Block.unsafeFreeze saltHashMBlock >>= \x-> do
+                        Blowfish.copyKeySchedule ksDirty ksClean
+                        hashInternalMutable ksDirty passHashBlock x tmpMBlock
+                    memCopy outPtr tmpPtr outLen
+                    -- Remaining rounds.
+                    forM_ [2..iterCounts params] $ const $ do
+                        hashInternalInit     shaPtr
+                        hashInternalUpdate   shaPtr tmpPtr (fromIntegral tmpLen)
+                        hashInternalFinalize shaPtr (castPtr saltHashPtr)
+                        Block.unsafeFreeze saltHashMBlock >>= \x-> do
+                            Blowfish.copyKeySchedule ksDirty ksClean
+                            hashInternalMutable ksDirty passHashBlock x tmpMBlock
+                        memXor outPtr outPtr tmpPtr outLen
+                    -- Spread the current out buffer evenly over the key buffer.
+                    -- After both loops have run every byte of the key buffer
+                    -- will have been written to exactly once and every byte
+                    -- of the output will have been used.
+                    forM_ [0..outLen - 1] $ \outIdx-> do
+                        let keyIdx = outIdx * blocks + block - 1
+                        when (keyIdx < keyLen) $ do
+                            w8 <- peekByteOff outPtr outIdx :: IO Word8
+                            pokeByteOff keyPtr keyIdx w8
+
+-- | Internal hash function used by `generate`.
+--
+-- Normal users should not need this.
+hashInternal :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt, B.ByteArray output)
+    => pass
+    -> salt
+    -> output
+hashInternal passHash saltHash
+    | B.length passHash /= 64 = error "passHash must be 512 bits"
+    | B.length saltHash /= 64 = error "saltHash must be 512 bits"
+    | otherwise = unsafeDoIO $ do
+        ks0 <- Blowfish.createKeySchedule
+        outMBlock <- Block.newPinned 32
+        hashInternalMutable ks0 passHash saltHash outMBlock
+        B.convert `fmap` Block.freeze outMBlock
+
+hashInternalMutable :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt)
+    => Blowfish.KeySchedule
+    -> pass
+    -> salt
+    -> MutableBlock Word8 (PrimState IO)
+    -> IO ()
+hashInternalMutable bfks passHash saltHash outMBlock = do
+    Blowfish.expandKeyWithSalt bfks passHash saltHash
+    forM_ [0..63 :: Int] $ const $ do
+        Blowfish.expandKey bfks saltHash
+        Blowfish.expandKey bfks passHash
+    -- "OxychromaticBlowfishSwatDynamite" represented as 4 Word64 in big-endian.
+    store  0 =<< cipher 64 0x4f78796368726f6d
+    store  8 =<< cipher 64 0x61746963426c6f77
+    store 16 =<< cipher 64 0x6669736853776174
+    store 24 =<< cipher 64 0x44796e616d697465
+    where
+        store :: Offset Word8 -> Word64 -> IO ()
+        store o w64 = do
+            Block.unsafeWrite outMBlock (o + 0) (fromIntegral $ w64 `shiftR` 32)
+            Block.unsafeWrite outMBlock (o + 1) (fromIntegral $ w64 `shiftR` 40)
+            Block.unsafeWrite outMBlock (o + 2) (fromIntegral $ w64 `shiftR` 48)
+            Block.unsafeWrite outMBlock (o + 3) (fromIntegral $ w64 `shiftR` 56)
+            Block.unsafeWrite outMBlock (o + 4) (fromIntegral $ w64 `shiftR`  0)
+            Block.unsafeWrite outMBlock (o + 5) (fromIntegral $ w64 `shiftR`  8)
+            Block.unsafeWrite outMBlock (o + 6) (fromIntegral $ w64 `shiftR` 16)
+            Block.unsafeWrite outMBlock (o + 7) (fromIntegral $ w64 `shiftR` 24)
+        cipher :: Int -> Word64 -> IO Word64
+        cipher 0 block = return block
+        cipher i block = Blowfish.cipherBlockMutable bfks block >>= cipher (i - 1)
+
+finallyErase :: MutableBlock Word8 (PrimState IO) -> IO () -> IO ()
+finallyErase mblock action =
+    action `finally` Block.withMutablePtr mblock (\ptr-> memSet ptr 0 len)
+    where
+        CountOf len = Block.mutableLengthBytes mblock

Crypto/KDF/PBKDF2.hs

@@ -24,7 +24,7 @@ import           Data.Word
 import           Data.Bits
 import           Foreign.Marshal.Alloc
 import           Foreign.Ptr (plusPtr, Ptr)
-import           Foreign.C.Types (CUInt(..), CInt(..), CSize(..))
+import           Foreign.C.Types (CUInt(..), CSize(..))
 
 import           Crypto.Hash (HashAlgorithm)
 import qualified Crypto.MAC.HMAC as HMAC

Crypto/MAC/CMAC.hs

@@ -5,7 +5,7 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- provide the CMAC (Cipher based Message Authentification Code) base algorithm.
+-- Provide the CMAC (Cipher based Message Authentification Code) base algorithm.
 -- <http://en.wikipedia.org/wiki/CMAC>
 -- <http://csrc.nist.gov/publications/nistpubs/800-38B/SP_800-38B.pdf>
 --
@@ -94,7 +94,7 @@ bxor = B.xor
 
 
 cipherIPT :: BlockCipher k => k -> [Word8]
-cipherIPT = expandIPT . blockSize   where
+cipherIPT = expandIPT . blockSize
 
 -- Data type which represents the smallest irreducibule binary polynomial
 -- against specified degree.

Crypto/MAC/HMAC.hs

@@ -5,15 +5,16 @@
 -- Stability   : experimental
 -- Portability : unknown
 --
--- provide the HMAC (Hash based Message Authentification Code) base algorithm.
+-- Provide the HMAC (Hash based Message Authentification Code) base algorithm.
 -- <http://en.wikipedia.org/wiki/HMAC>
 --
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Crypto.MAC.HMAC
     ( hmac
+    , hmacLazy
     , HMAC(..)
-    -- * incremental
+    -- * Incremental
     , Context(..)
     , initialize
     , update
@@ -24,28 +25,36 @@ module Crypto.MAC.HMAC
 import           Crypto.Hash hiding (Context)
 import qualified Crypto.Hash as Hash (Context)
 import           Crypto.Hash.IO
-import           Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess)
+import           Crypto.Internal.ByteArray (ScrubbedBytes, ByteArrayAccess)
 import qualified Crypto.Internal.ByteArray as B
 import           Data.Memory.PtrMethods
 import           Crypto.Internal.Compat
-import           Crypto.Internal.Imports
+import qualified Data.ByteString.Lazy as L
 
 -- | Represent an HMAC that is a phantom type with the hash used to produce the mac.
 --
--- The Eq instance is constant time.
+-- The Eq instance is constant time.  No Show instance is provided, to avoid
+-- printing by mistake.
 newtype HMAC a = HMAC { hmacGetDigest :: Digest a }
     deriving (ByteArrayAccess)
 
 instance Eq (HMAC a) where
     (HMAC b1) == (HMAC b2) = B.constEq b1 b2
 
--- | compute a MAC using the supplied hashing function
+-- | Compute a MAC using the supplied hashing function
 hmac :: (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a)
      => key     -- ^ Secret key
      -> message -- ^ Message to MAC
      -> HMAC a
 hmac secret msg = finalize $ updates (initialize secret) [msg]
 
+-- | Compute a MAC using the supplied hashing function, for a lazy input
+hmacLazy :: (ByteArrayAccess key, HashAlgorithm a)
+     => key     -- ^ Secret key
+     -> L.ByteString -- ^ Message to MAC
+     -> HMAC a
+hmacLazy secret msg = finalize $ updates (initialize secret) (L.toChunks msg)
+
 -- | Represent an ongoing HMAC state, that can be appended with 'update'
 -- and finalize to an HMAC with 'hmacFinalize'
 data Context hashalg = Context !(Hash.Context hashalg) !(Hash.Context hashalg)

Crypto/MAC/KMAC.hs

@@ -0,0 +1,144 @@
+-- |
+-- Module      : Crypto.MAC.KMAC
+-- License     : BSD-style
+-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Provide the KMAC (Keccak Message Authentication Code) algorithm, derived from
+-- the SHA-3 base algorithm Keccak and defined in NIST SP800-185.
+--
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Crypto.MAC.KMAC
+    ( HashSHAKE
+    , kmac
+    , KMAC(..)
+    -- * Incremental
+    , Context
+    , initialize
+    , update
+    , updates
+    , finalize
+    ) where
+
+import qualified Crypto.Hash as H
+import           Crypto.Hash.SHAKE (HashSHAKE(..))
+import           Crypto.Hash.Types (HashAlgorithm(..), Digest(..))
+import qualified Crypto.Hash.Types as H
+import           Crypto.Internal.Builder
+import           Crypto.Internal.Imports
+import           Foreign.Ptr (Ptr)
+import           Data.Bits (shiftR)
+import           Data.ByteArray (ByteArrayAccess)
+import qualified Data.ByteArray as B
+
+
+-- cSHAKE
+
+cshakeInit :: forall a name string prefix . (HashSHAKE a, ByteArrayAccess name, ByteArrayAccess string, ByteArrayAccess prefix)
+           => name -> string -> prefix -> H.Context a
+cshakeInit n s p = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) -> do
+    hashInternalInit ptr
+    B.withByteArray b $ \d -> hashInternalUpdate ptr d (fromIntegral $ B.length b)
+    B.withByteArray p $ \d -> hashInternalUpdate ptr d (fromIntegral $ B.length p)
+  where
+    c = hashInternalContextSize (undefined :: a)
+    w = hashBlockSize (undefined :: a)
+    x = encodeString n <> encodeString s
+    b = buildAndFreeze (bytepad x w) :: B.Bytes
+
+cshakeUpdate :: (HashSHAKE a, ByteArrayAccess ba)
+             => H.Context a -> ba -> H.Context a
+cshakeUpdate = H.hashUpdate
+
+cshakeUpdates :: (HashSHAKE a, ByteArrayAccess ba)
+              => H.Context a -> [ba] -> H.Context a
+cshakeUpdates = H.hashUpdates
+
+cshakeFinalize :: forall a suffix . (HashSHAKE a, ByteArrayAccess suffix)
+               => H.Context a -> suffix -> Digest a
+cshakeFinalize !c s =
+    Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \dig -> do
+        ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (H.Context a)) -> do
+            B.withByteArray s $ \d ->
+                hashInternalUpdate ctx d (fromIntegral $ B.length s)
+            cshakeInternalFinalize ctx dig
+        return ()
+
+
+-- KMAC
+
+-- | Represent a KMAC that is a phantom type with the hash used to produce the
+-- mac.
+--
+-- The Eq instance is constant time.  No Show instance is provided, to avoid
+-- printing by mistake.
+newtype KMAC a = KMAC { kmacGetDigest :: Digest a }
+    deriving (ByteArrayAccess,NFData)
+
+instance Eq (KMAC a) where
+    (KMAC b1) == (KMAC b2) = B.constEq b1 b2
+
+-- | Compute a KMAC using the supplied customization string and key.
+kmac :: (HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key, ByteArrayAccess ba)
+     => string -> key -> ba -> KMAC a
+kmac str key msg = finalize $ updates (initialize str key) [msg]
+
+-- | Represent an ongoing KMAC state, that can be appended with 'update' and
+-- finalized to a 'KMAC' with 'finalize'.
+newtype Context a = Context (H.Context a)
+
+-- | Initialize a new incremental KMAC context with the supplied customization
+-- string and key.
+initialize :: forall a string key . (HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key)
+           => string -> key -> Context a
+initialize str key = Context $ cshakeInit n str p
+  where
+    n = B.pack [75,77,65,67] :: B.Bytes  -- "KMAC"
+    w = hashBlockSize (undefined :: a)
+    p = buildAndFreeze (bytepad (encodeString key) w) :: B.ScrubbedBytes
+
+-- | Incrementally update a KMAC context.
+update :: (HashSHAKE a, ByteArrayAccess ba) => Context a -> ba -> Context a
+update (Context ctx) = Context . cshakeUpdate ctx
+
+-- | Incrementally update a KMAC context with multiple inputs.
+updates :: (HashSHAKE a, ByteArrayAccess ba) => Context a -> [ba] -> Context a
+updates (Context ctx) = Context . cshakeUpdates ctx
+
+-- | Finalize a KMAC context and return the KMAC.
+finalize :: forall a . HashSHAKE a => Context a -> KMAC a
+finalize (Context ctx) = KMAC $ cshakeFinalize ctx suffix
+  where
+    l = cshakeOutputLength (undefined :: a)
+    suffix = buildAndFreeze (rightEncode l) :: B.Bytes
+
+
+-- Utilities
+
+bytepad :: Builder -> Int -> Builder
+bytepad x w = prefix <> x <> zero padLen
+  where
+    prefix = leftEncode w
+    padLen = (w - builderLength prefix - builderLength x) `mod` w
+
+encodeString :: ByteArrayAccess bin => bin -> Builder
+encodeString s = leftEncode (8 * B.length s) <> bytes s
+
+leftEncode :: Int -> Builder
+leftEncode x = byte len <> digits
+  where
+    digits = i2osp x
+    len    = fromIntegral (builderLength digits)
+
+rightEncode :: Int -> Builder
+rightEncode x = digits <> byte len
+  where
+    digits = i2osp x
+    len    = fromIntegral (builderLength digits)
+
+i2osp :: Int -> Builder
+i2osp i | i >= 256  = i2osp (shiftR i 8) <> byte (fromIntegral i)
+        | otherwise = byte (fromIntegral i)

Crypto/MAC/Poly1305.hs

@@ -33,6 +33,11 @@ import           Crypto.Internal.DeepSeq
 import           Crypto.Error
 
 -- | Poly1305 State
+--
+-- This type is an instance of 'ByteArrayAccess' for debugging purpose. Internal
+-- layout is architecture dependent, may contain uninitialized data fragments,
+-- and change in future versions.  The bytearray should not be used as input to
+-- cryptographic algorithms.
 newtype State = State ScrubbedBytes
     deriving (ByteArrayAccess)
 

Crypto/Math/Polynomial.hs

@@ -8,7 +8,7 @@
 
 module Crypto.Math.Polynomial
     ( Monomial(..)
-    -- * polynomial operations
+    -- * Polynomial operations
     , Polynomial
     , toList
     , fromList

Crypto/Number/Basic.hs

@@ -13,12 +13,15 @@ module Crypto.Number.Basic
     , log2
     , numBits
     , numBytes
+    , asPowerOf2AndOdd
     ) where
 
+import Data.Bits
+
 import Crypto.Number.Compat
 
--- | sqrti returns two integer (l,b) so that l <= sqrt i <= b
+-- | @sqrti@ returns two integers @(l,b)@ so that @l <= sqrt i <= b@.
--- the implementation is quite naive, use an approximation for the first number
+-- The implementation is quite naive, use an approximation for the first number
 -- and use a dichotomy algorithm to compute the bound relatively efficiently.
 sqrti :: Integer -> (Integer, Integer)
 sqrti i
@@ -49,7 +52,7 @@ sqrti i
                         else iter (lb+d) ub
             sq a = a * a
 
--- | get the extended GCD of two integer using integer divMod
+-- | Get the extended GCD of two integer using integer divMod
 --
 -- gcde 'a' 'b' find (x,y,gcd(a,b)) where ax + by = d
 --
@@ -63,7 +66,7 @@ gcde a b = onGmpUnsupported (gmpGcde a b) $
         let (q, r) = a' `divMod` b' in
         f t (r, sa - (q * sb), ta - (q * tb))
 
--- | check if a list of integer are all even
+-- | Check if a list of integer are all even
 areEven :: [Integer] -> Bool
 areEven = and . map even
 
@@ -98,3 +101,16 @@ numBits n = gmpSizeInBits n `onGmpUnsupported` (if n == 0 then 1 else computeBit
 -- | Compute the number of bytes for an integer
 numBytes :: Integer -> Int
 numBytes n = gmpSizeInBytes n `onGmpUnsupported` ((numBits n + 7) `div` 8)
+
+-- | Express an integer as an odd number and a power of 2
+asPowerOf2AndOdd :: Integer -> (Int, Integer)
+asPowerOf2AndOdd a
+    | a == 0       = (0, 0)
+    | odd a        = (0, a)
+    | a < 0        = let (e, a1) = asPowerOf2AndOdd $ abs a in (e, -a1)
+    | isPowerOf2 a = (log2 a, 1)
+    | otherwise    = loop a 0
+        where      
+          isPowerOf2 n = (n /= 0) && ((n .&. (n - 1)) == 0)
+          loop n pw = if n `mod` 2 == 0 then loop (n `div` 2) (pw + 1)
+                      else (pw, n)

Crypto/Number/Compat.hs

@@ -22,7 +22,9 @@ module Crypto.Number.Compat
     , gmpSizeInBytes
     , gmpSizeInBits
     , gmpExportInteger
+    , gmpExportIntegerLE
     , gmpImportInteger
+    , gmpImportIntegerLE
     ) where
 
 #ifndef MIN_VERSION_integer_gmp
@@ -70,7 +72,11 @@ gmpLog2 _ = GmpUnsupported
 -- | Compute the power modulus using extra security to remain constant
 -- time wise through GMP
 gmpPowModSecInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
-#if MIN_VERSION_integer_gmp(1,0,0)
+#if MIN_VERSION_integer_gmp(1,1,0)
+gmpPowModSecInteger _ _ _ = GmpUnsupported
+#elif MIN_VERSION_integer_gmp(1,0,2)
+gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
+#elif MIN_VERSION_integer_gmp(1,0,0)
 gmpPowModSecInteger _ _ _ = GmpUnsupported
 #elif MIN_VERSION_integer_gmp(0,5,1)
 gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
@@ -99,7 +105,9 @@ gmpInverse _ _ = GmpUnsupported
 
 -- | Get the next prime from a specific value through GMP
 gmpNextPrime :: Integer -> GmpSupported Integer
-#if MIN_VERSION_integer_gmp(0,5,1)
+#if MIN_VERSION_integer_gmp(1,1,0)
+gmpNextPrime _ = GmpUnsupported
+#elif MIN_VERSION_integer_gmp(0,5,1)
 gmpNextPrime n = GmpSupported (nextPrimeInteger n)
 #else
 gmpNextPrime _ = GmpUnsupported
@@ -107,7 +115,9 @@ gmpNextPrime _ = GmpUnsupported
 
 -- | Test if a number is prime using Miller Rabin
 gmpTestPrimeMillerRabin :: Int -> Integer -> GmpSupported Bool
-#if MIN_VERSION_integer_gmp(0,5,1)
+#if MIN_VERSION_integer_gmp(1,1,0)
+gmpTestPrimeMillerRabin _ _ = GmpUnsupported
+#elif MIN_VERSION_integer_gmp(0,5,1)
 gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $
     case testPrimeInteger n tries of
         0# -> False
@@ -132,7 +142,7 @@ gmpSizeInBits n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 2#)))
 gmpSizeInBits _ = GmpUnsupported
 #endif
 
--- | Export an integer to a memory
+-- | Export an integer to a memory (big-endian)
 gmpExportInteger :: Integer -> Ptr Word8 -> GmpSupported (IO ())
 #if MIN_VERSION_integer_gmp(1,0,0)
 gmpExportInteger n (Ptr addr) = GmpSupported $ do
@@ -146,7 +156,21 @@ gmpExportInteger n (Ptr addr) = GmpSupported $ IO $ \s ->
 gmpExportInteger _ _ = GmpUnsupported
 #endif
 
--- | Import an integer from a memory
+-- | Export an integer to a memory (little-endian)
+gmpExportIntegerLE :: Integer -> Ptr Word8 -> GmpSupported (IO ())
+#if MIN_VERSION_integer_gmp(1,0,0)
+gmpExportIntegerLE n (Ptr addr) = GmpSupported $ do
+    _ <- exportIntegerToAddr n addr 0#
+    return ()
+#elif MIN_VERSION_integer_gmp(0,5,1)
+gmpExportIntegerLE n (Ptr addr) = GmpSupported $ IO $ \s ->
+    case exportIntegerToAddr n addr 0# s of
+        (# s2, _ #) -> (# s2, () #)
+#else
+gmpExportIntegerLE _ _ = GmpUnsupported
+#endif
+
+-- | Import an integer from a memory (big-endian)
 gmpImportInteger :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
 #if MIN_VERSION_integer_gmp(1,0,0)
 gmpImportInteger (I# n) (Ptr addr) = GmpSupported $
@@ -157,3 +181,15 @@ gmpImportInteger (I# n) (Ptr addr) = GmpSupported $ IO $ \s ->
 #else
 gmpImportInteger _ _ = GmpUnsupported
 #endif
+
+-- | Import an integer from a memory (little-endian)
+gmpImportIntegerLE :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
+#if MIN_VERSION_integer_gmp(1,0,0)
+gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $
+    importIntegerFromAddr addr (int2Word# n) 0#
+#elif MIN_VERSION_integer_gmp(0,5,1)
+gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $ IO $ \s ->
+    importIntegerFromAddr addr (int2Word# n) 0# s
+#else
+gmpImportIntegerLE _ _ = GmpUnsupported
+#endif

Crypto/Number/F2m.hs

@@ -16,14 +16,15 @@ module Crypto.Number.F2m
     , mulF2m
     , squareF2m'
     , squareF2m
+    , powF2m
     , modF2m
+    , sqrtF2m
     , invF2m
     , divF2m
     ) where
 
 import Data.Bits (xor, shift, testBit, setBit)
 import Data.List
-import Crypto.Internal.Imports
 import Crypto.Number.Basic
 
 -- | Binary Polynomial represented by an integer
@@ -67,8 +68,8 @@ mulF2m :: BinaryPolynomial -- ^ Modulus
 mulF2m fx n1 n2
     |    fx < 0
       || n1 < 0
-      || n2 < 0 = error "mulF2m: negative number represent no binary binary polynomial"
+      || n2 < 0 = error "mulF2m: negative number represent no binary polynomial"
-    | fx == 0   = error "modF2m: cannot multiply modulo zero polynomial"
+    | fx == 0   = error "mulF2m: cannot multiply modulo zero polynomial"
     | otherwise = modF2m fx $ go (if n2 `mod` 2 == 1 then n1 else 0) (log2 n2)
       where
         go n s | s == 0  = n
@@ -97,10 +98,37 @@ squareF2m fx = modF2m fx . squareF2m'
 squareF2m' :: Integer
            -> Integer
 squareF2m' n
-    | n < 0     = error "mulF2m: negative number represent no binary binary polynomial"
+    | n < 0     = error "mulF2m: negative number represent no binary polynomial"
     | otherwise = foldl' (\acc s -> if testBit n s then setBit acc (2 * s) else acc) 0 [0 .. log2 n]
 {-# INLINE squareF2m' #-}
 
+-- | Exponentiation in F₂m by computing @a^b mod fx@.
+--
+-- This implements an exponentiation by squaring based solution. It inherits the
+-- same restrictions as 'squareF2m'. Negative exponents are disallowed.
+powF2m :: BinaryPolynomial -- ^Modulus
+       -> Integer          -- ^a
+       -> Integer          -- ^b
+       -> Integer
+powF2m fx a b
+  | b < 0     = error "powF2m: negative exponents disallowed"
+  | b == 0    = if fx > 1 then 1 else 0
+  | even b    = squareF2m fx x
+  | otherwise = mulF2m fx a (squareF2m' x)
+  where x = powF2m fx a (b `div` 2)
+
+-- | Square rooot in F₂m.
+--
+-- We exploit the fact that @a^(2^m) = a@, or in particular, @a^(2^m - 1) = 1@
+-- from a classical result by Lagrange. Thus the square root is simply @a^(2^(m
+-- - 1))@.
+sqrtF2m :: BinaryPolynomial -- ^Modulus
+        -> Integer          -- ^a
+        -> Integer
+sqrtF2m fx a = go (log2 fx - 1) a
+  where go 0 x = x
+        go n x = go (n - 1) (squareF2m fx x)
+
 -- | Extended GCD algorithm for polynomials. For @a@ and @b@ returns @(g, u, v)@ such that @a * u + b * v == g@.
 --
 -- Reference: https://en.wikipedia.org/wiki/Polynomial_greatest_common_divisor#B.C3.A9zout.27s_identity_and_extended_GCD_algorithm

Crypto/Number/Generate.hs

@@ -120,6 +120,4 @@ generateMax range
 
 -- | generate a number between the inclusive bound [low,high].
 generateBetween :: MonadRandom m => Integer -> Integer -> m Integer
-generateBetween low high
+generateBetween low high = (low +) <$> generateMax (high - low + 1)
-    | low == 1  = generateMax high >>= \r -> if r == 0 then generateBetween low high else return r
-    | otherwise = (low +) <$> generateMax (high - low + 1)

Crypto/Number/ModArithmetic.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 -- |
 -- Module      : Crypto.Number.ModArithmetic
 -- License     : BSD-style
@@ -9,26 +8,29 @@
 
 module Crypto.Number.ModArithmetic
     (
-    -- * exponentiation
+    -- * Exponentiation
       expSafe
     , expFast
-    -- * inverse computing
+    -- * Inverse computing
     , inverse
     , inverseCoprimes
+    , inverseFermat
+    -- * Squares
+    , jacobi
+    , squareRoot
     ) where
 
 import Control.Exception (throw, Exception)
-import Data.Typeable
 import Crypto.Number.Basic
 import Crypto.Number.Compat
 
 -- | Raised when two numbers are supposed to be coprimes but are not.
 data CoprimesAssertionError = CoprimesAssertionError
-    deriving (Show,Typeable)
+    deriving (Show)
 
 instance Exception CoprimesAssertionError
 
--- | Compute the modular exponentiation of base^exponant using
+-- | Compute the modular exponentiation of base^exponent using
 -- algorithms design to avoid side channels and timing measurement
 --
 -- Modulo need to be odd otherwise the normal fast modular exponentiation
@@ -38,11 +40,10 @@ instance Exception CoprimesAssertionError
 -- from expFast, and thus provide the same unstudied and dubious
 -- timing and side channels claims.
 --
--- with GHC 7.10, the powModSecInteger is missing from integer-gmp
+-- Before GHC 8.4.2, powModSecInteger is missing from integer-gmp,
--- (which is now integer-gmp2), so is has the same security as old
+-- so expSafe has the same security as expFast.
--- ghc version.
 expSafe :: Integer -- ^ base
-        -> Integer -- ^ exponant
+        -> Integer -- ^ exponent
         -> Integer -- ^ modulo
         -> Integer -- ^ result
 expSafe b e m
@@ -52,30 +53,30 @@ expSafe b e m
     | otherwise = gmpPowModInteger b e m    `onGmpUnsupported`
                   exponentiation b e m
 
--- | Compute the modular exponentiation of base^exponant using
+-- | Compute the modular exponentiation of base^exponent using
 -- the fastest algorithm without any consideration for
 -- hiding parameters.
 --
 -- Use this function when all the parameters are public,
--- otherwise 'expSafe' should be prefered.
+-- otherwise 'expSafe' should be preferred.
 expFast :: Integer -- ^ base
-        -> Integer -- ^ exponant
+        -> Integer -- ^ exponent
         -> Integer -- ^ modulo
         -> Integer -- ^ result
 expFast b e m = gmpPowModInteger b e m `onGmpUnsupported` exponentiation b e m
 
--- | exponentiation computes modular exponentiation as b^e mod m
+-- | @exponentiation@ computes modular exponentiation as /b^e mod m/
 -- using repetitive squaring.
 exponentiation :: Integer -> Integer -> Integer -> Integer
 exponentiation b e m
     | b == 1    = b
     | e == 0    = 1
     | e == 1    = b `mod` m
-    | even e    = let p = (exponentiation b (e `div` 2) m) `mod` m
+    | even e    = let p = exponentiation b (e `div` 2) m `mod` m
                    in (p^(2::Integer)) `mod` m
     | otherwise = (b * exponentiation b (e-1) m) `mod` m
 
--- | inverse computes the modular inverse as in g^(-1) mod m
+-- | @inverse@ computes the modular inverse as in /g^(-1) mod m/.
 inverse :: Integer -> Integer -> Maybe Integer
 inverse g m = gmpInverse g m `onGmpUnsupported` v
   where
@@ -84,14 +85,133 @@ inverse g m = gmpInverse g m `onGmpUnsupported` v
         | otherwise = Just (x `mod` m)
     (x,_,d) = gcde g m
 
--- | Compute the modular inverse of 2 coprime numbers.
+-- | Compute the modular inverse of two coprime numbers.
 -- This is equivalent to inverse except that the result
 -- is known to exists.
 --
--- if the numbers are not defined as coprime, this function
+-- If the numbers are not defined as coprime, this function
--- will raise a CoprimesAssertionError.
+-- will raise a 'CoprimesAssertionError'.
 inverseCoprimes :: Integer -> Integer -> Integer
 inverseCoprimes g m =
     case inverse g m of
         Nothing -> throw CoprimesAssertionError
         Just i  -> i
+
+-- | Computes the Jacobi symbol (a/n).
+-- 0 ≤ a < n; n ≥ 3 and odd.
+--
+-- The Legendre and Jacobi symbols are indistinguishable exactly when the
+-- lower argument is an odd prime, in which case they have the same value.
+--
+-- See algorithm 2.149 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al.
+jacobi :: Integer -> Integer -> Maybe Integer
+jacobi a n
+    | n < 3 || even n  = Nothing
+    | a == 0 || a == 1 = Just a
+    | n <= a           = jacobi (a `mod` n) n
+    | a < 0            =
+      let b = if n `mod` 4 == 1 then 1 else -1
+       in fmap (*b) (jacobi (-a) n)
+    | otherwise        =
+      let (e, a1) = asPowerOf2AndOdd a
+          nMod8   = n `mod` 8
+          nMod4   = n `mod` 4
+          a1Mod4  = a1 `mod` 4
+          s'      = if even e || nMod8 == 1 || nMod8 == 7 then 1 else -1
+          s       = if nMod4 == 3 && a1Mod4 == 3 then -s' else s'
+          n1      = n `mod` a1
+       in if a1 == 1 then Just s
+          else fmap (*s) (jacobi n1 a1)
+
+-- | Modular inverse using Fermat's little theorem.  This works only when
+-- the modulus is prime but avoids side channels like in 'expSafe'.
+inverseFermat :: Integer -> Integer -> Integer
+inverseFermat g p = expSafe g (p - 2) p
+
+-- | Raised when the assumption about the modulus is invalid.
+data ModulusAssertionError = ModulusAssertionError
+    deriving (Show)
+
+instance Exception ModulusAssertionError
+
+-- | Modular square root of @g@ modulo a prime @p@.
+--
+-- If the modulus is found not to be prime, the function will raise a
+-- 'ModulusAssertionError'.
+--
+-- This implementation is variable time and should be used with public
+-- parameters only.
+squareRoot :: Integer -> Integer -> Maybe Integer
+squareRoot p
+    | p < 2     = throw ModulusAssertionError
+    | otherwise =
+        case p `divMod` 8 of
+           (v, 3) -> method1 (2 * v + 1)
+           (v, 7) -> method1 (2 * v + 2)
+           (u, 5) -> method2 u
+           (_, 1) -> tonelliShanks p
+           (0, 2) -> \a -> Just (if even a then 0 else 1)
+           _      -> throw ModulusAssertionError
+
+  where
+    x `eqMod` y = (x - y) `mod` p == 0
+
+    validate g y | (y * y) `eqMod` g = Just y
+                 | otherwise         = Nothing
+
+    -- p == 4u + 3 and u' == u + 1
+    method1 u' g =
+        let y = expFast g u' p
+         in validate g y
+
+    -- p == 8u + 5
+    method2 u g =
+        let gamma = expFast (2 * g) u p
+            g_gamma = g * gamma
+            i = (2 * g_gamma * gamma) `mod` p
+            y = (g_gamma * (i - 1)) `mod` p
+         in validate g y
+
+tonelliShanks :: Integer -> Integer -> Maybe Integer
+tonelliShanks p a
+    | aa == 0   = Just 0
+    | otherwise =
+        case expFast aa p2 p of
+            b | b == p1   -> Nothing
+              | b == 1    -> Just $ go (expFast aa ((s + 1) `div` 2) p)
+                                       (expFast aa s p)
+                                       (expFast n  s p)
+                                       e
+              | otherwise -> throw ModulusAssertionError
+  where
+    aa = a `mod` p
+    p1 = p - 1
+    p2 = p1 `div` 2
+    n  = findN 2
+
+    x `mul` y = (x * y) `mod` p
+
+    pow2m 0 x = x
+    pow2m i x = pow2m (i - 1) (x `mul` x)
+
+    (e, s) = asPowerOf2AndOdd p1
+
+    -- find a quadratic non-residue
+    findN i
+        | expFast i p2 p == p1 = i
+        | otherwise            = findN (i + 1)
+
+    -- find m such that b^(2^m) == 1 (mod p)
+    findM b i
+        | b == 1    = i
+        | otherwise = findM (b `mul` b) (i + 1)
+
+    go !x b g !r
+        | b == 1    = x
+        | otherwise =
+            let r' = findM b 0
+                z = pow2m (r - r' - 1) g
+                x' = x `mul` z
+                b' = b `mul` g'
+                g' = z `mul` z
+             in go x' b' g' r'

Crypto/Number/Nat.hs

@@ -0,0 +1,63 @@
+-- |
+-- Module      : Crypto.Number.Nat
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : Good
+--
+-- Numbers at type level.
+--
+-- This module provides extensions to "GHC.TypeLits" and "GHC.TypeNats" useful
+-- to work with cryptographic algorithms parameterized with a variable bit
+-- length.  Constraints like @'IsDivisibleBy8' n@ ensure that the type-level
+-- parameter is applicable to the algorithm.
+--
+-- Functions are also provided to test whether constraints are satisfied from
+-- values known at runtime.  The following example shows how to discharge
+-- 'IsDivisibleBy8' in a computation @fn@ requiring this constraint:
+--
+-- > withDivisibleBy8 :: Integer
+-- >                  -> (forall proxy n . (KnownNat n, IsDivisibleBy8 n) => proxy n -> a)
+-- >                  -> Maybe a
+-- > withDivisibleBy8 len fn = do
+-- >     SomeNat p <- someNatVal len
+-- >     Refl <- isDivisibleBy8 p
+-- >     pure (fn p)
+--
+-- Function @withDivisibleBy8@ above returns 'Nothing' when the argument @len@
+-- is negative or not divisible by 8.
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+module Crypto.Number.Nat
+    ( type IsDivisibleBy8
+    , type IsAtMost, type IsAtLeast
+    , isDivisibleBy8
+    , isAtMost
+    , isAtLeast
+    ) where
+
+import           Data.Type.Equality
+import           GHC.TypeLits
+import           Unsafe.Coerce (unsafeCoerce)
+
+import           Crypto.Internal.Nat
+
+-- | get a runtime proof that the constraint @'IsDivisibleBy8' n@ is satified
+isDivisibleBy8 :: KnownNat n => proxy n -> Maybe (IsDiv8 n n :~: 'True)
+isDivisibleBy8 n
+    | mod (natVal n) 8 == 0 = Just (unsafeCoerce Refl)
+    | otherwise             = Nothing
+
+-- | get a runtime proof that the constraint @'IsAtMost' value bound@ is
+-- satified
+isAtMost :: (KnownNat value, KnownNat bound)
+         => proxy value -> proxy' bound -> Maybe ((value <=? bound) :~: 'True)
+isAtMost x y
+    | natVal x <= natVal y  = Just (unsafeCoerce Refl)
+    | otherwise             = Nothing
+
+-- | get a runtime proof that the constraint @'IsAtLeast' value bound@ is
+-- satified
+isAtLeast :: (KnownNat value, KnownNat bound)
+          => proxy value -> proxy' bound -> Maybe ((bound <=? value) :~: 'True)
+isAtLeast = flip isAtMost

Crypto/Number/Prime.hs

@@ -19,8 +19,6 @@ module Crypto.Number.Prime
     , isCoprime
     ) where
 
-import Crypto.Internal.Imports
-
 import Crypto.Number.Compat
 import Crypto.Number.Generate
 import Crypto.Number.Basic (sqrti, gcde)
@@ -31,10 +29,10 @@ import Crypto.Error
 
 import Data.Bits
 
--- | returns if the number is probably prime.
+-- | Returns if the number is probably prime.
--- first a list of small primes are implicitely tested for divisibility,
+-- First a list of small primes are implicitely tested for divisibility,
 -- then a fermat primality test is used with arbitrary numbers and
--- then the Miller Rabin algorithm is used with an accuracy of 30 recursions
+-- then the Miller Rabin algorithm is used with an accuracy of 30 recursions.
 isProbablyPrime :: Integer -> Bool
 isProbablyPrime !n
     | any (\p -> p `divides` n) (filter (< n) firstPrimes) = False
@@ -42,14 +40,14 @@ isProbablyPrime !n
     | primalityTestFermat 50 (n `div` 2) n                 = primalityTestMillerRabin 30 n
     | otherwise                                            = False
 
--- | generate a prime number of the required bitsize (i.e. in the range
+-- | Generate a prime number of the required bitsize (i.e. in the range
---   [2^(b-1)+2^(b-2), 2^b)).
+-- [2^(b-1)+2^(b-2), 2^b)).
 --
---   May throw a CryptoError_PrimeSizeInvalid if the requested size is less
+-- May throw a 'CryptoError_PrimeSizeInvalid' if the requested size is less
---   than 5 bits, as the smallest prime meeting these conditions is 29.
+-- than 5 bits, as the smallest prime meeting these conditions is 29.
---   This function requires that the two highest bits are set, so that when
+-- This function requires that the two highest bits are set, so that when
---   multiplied with another prime to create a key, it is guaranteed to be of
+-- multiplied with another prime to create a key, it is guaranteed to be of
---   the proper size.
+-- the proper size.
 generatePrime :: MonadRandom m => Int -> m Integer
 generatePrime bits = do
     if bits < 5 then
@@ -61,13 +59,13 @@ generatePrime bits = do
             return $ prime
         else generatePrime bits
 
--- | generate a prime number of the form 2p+1 where p is also prime.
+-- | Generate a prime number of the form 2p+1 where p is also prime.
 -- it is also knowed as a Sophie Germaine prime or safe prime.
 --
 -- The number of safe prime is significantly smaller to the number of prime,
 -- as such it shouldn't be used if this number is supposed to be kept safe.
 --
--- May throw a CryptoError_PrimeSizeInvalid if the requested size is less than
+-- May throw a 'CryptoError_PrimeSizeInvalid' if the requested size is less than
 -- 6 bits, as the smallest safe prime with the two highest bits set is 59.
 generateSafePrime :: MonadRandom m => Int -> m Integer
 generateSafePrime bits = do
@@ -81,7 +79,7 @@ generateSafePrime bits = do
             return $ val
         else generateSafePrime bits
 
--- | find a prime from a starting point where the property hold.
+-- | Find a prime from a starting point where the property hold.
 findPrimeFromWith :: (Integer -> Bool) -> Integer -> Integer
 findPrimeFromWith prop !n
     | even n        = findPrimeFromWith prop (n+1)
@@ -93,7 +91,7 @@ findPrimeFromWith prop !n
                     then n
                     else findPrimeFromWith prop (n+2)
 
--- | find a prime from a starting point with no specific property.
+-- | Find a prime from a starting point with no specific property.
 findPrimeFrom :: Integer -> Integer
 findPrimeFrom n =
     case gmpNextPrime n of
@@ -129,7 +127,7 @@ primalityTestMillerRabin tries !n =
     factorise :: Integer -> Integer -> (Integer, Integer)
     factorise !si !vi
         | vi `testBit` 0 = (si, vi)
-        | otherwise     = factorise (si+1) (vi `shiftR` 1) -- probably faster to not shift v continously, but just once.
+        | otherwise     = factorise (si+1) (vi `shiftR` 1) -- probably faster to not shift v continuously, but just once.
     expmod = expSafe
 
     -- when iteration reach zero, we have a probable prime
@@ -185,7 +183,7 @@ primalityTestNaive n
 isCoprime :: Integer -> Integer -> Bool
 isCoprime m n = case gcde m n of (_,_,d) -> d == 1
 
--- | list of the first primes till 2903..
+-- | List of the first primes till 2903.
 firstPrimes :: [Integer]
 firstPrimes =
     [ 2    , 3    , 5    , 7    , 11   , 13   , 17   , 19   , 23   , 29

Crypto/Number/Serialize.hs

@@ -5,7 +5,7 @@
 -- Stability   : experimental
 -- Portability : Good
 --
--- fast serialization primitives for integer
+-- Fast serialization primitives for integer
 {-# LANGUAGE BangPatterns #-}
 module Crypto.Number.Serialize
     ( i2osp
@@ -19,22 +19,23 @@ import           Crypto.Internal.Compat (unsafeDoIO)
 import qualified Crypto.Internal.ByteArray as B
 import qualified Crypto.Number.Serialize.Internal as Internal
 
--- | os2ip converts a byte string into a positive integer
+-- | @os2ip@ converts a byte string into a positive integer.
 os2ip :: B.ByteArrayAccess ba => ba -> Integer
 os2ip bs = unsafeDoIO $ B.withByteArray bs (\p -> Internal.os2ip p (B.length bs))
 
--- | i2osp converts a positive integer into a byte string
+-- | @i2osp@ converts a positive integer into a byte string.
 --
--- first byte is MSB (most significant byte), last byte is the LSB (least significant byte)
+-- The first byte is MSB (most significant byte); the last byte is the LSB (least significant byte)
 i2osp :: B.ByteArray ba => Integer -> ba
 i2osp 0 = B.allocAndFreeze 1  (\p -> Internal.i2osp 0 p 1 >> return ())
 i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ())
   where
         !sz = numBytes m
 
--- | just like i2osp, but take an extra parameter for size.
+-- | Just like 'i2osp', but takes an extra parameter for size.
--- if the number is too big to fit in @len@ bytes, 'Nothing' is returned
+-- If the number is too big to fit in @len@ bytes, 'Nothing' is returned
 -- otherwise the number is padded with 0 to fit the @len@ required.
+{-# INLINABLE i2ospOf #-}
 i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba
 i2ospOf len m
     | len <= 0  = Nothing
@@ -44,10 +45,10 @@ i2ospOf len m
   where
         !sz = numBytes m
 
--- | just like i2ospOf except that it doesn't expect a failure: i.e.
+-- | Just like 'i2ospOf' except that it doesn't expect a failure: i.e.
--- an integer larger than the number of output bytes requested
+-- an integer larger than the number of output bytes requested.
 --
--- for example if you just took a modulo of the number that represent
+-- For example if you just took a modulo of the number that represent
 -- the size (example the RSA modulo n).
 i2ospOf_ :: B.ByteArray ba => Int -> Integer -> ba
 i2ospOf_ len = maybe (error "i2ospOf_: integer is larger than expected") id . i2ospOf len

Crypto/Number/Serialize/Internal.hs

@@ -5,7 +5,7 @@
 -- Stability   : experimental
 -- Portability : Good
 --
--- fast serialization primitives for integer using raw pointers
+-- Fast serialization primitives for integer using raw pointers
 {-# LANGUAGE BangPatterns #-}
 module Crypto.Number.Serialize.Internal
     ( i2osp
@@ -21,12 +21,12 @@ import           Data.Word (Word8)
 import           Foreign.Ptr
 import           Foreign.Storable
 
--- | fill a pointer with the big endian binary representation of an integer
+-- | Fill a pointer with the big endian binary representation of an integer
 --
--- if the room available @ptrSz is less than the number of bytes needed,
+-- If the room available @ptrSz@ is less than the number of bytes needed,
 -- 0 is returned. Likewise if a parameter is invalid, 0 is returned.
 --
--- returns the number of bytes written
+-- Returns the number of bytes written
 i2osp :: Integer -> Ptr Word8 -> Int -> IO Int
 i2osp m ptr ptrSz
     | ptrSz <= 0 = return 0
@@ -61,7 +61,7 @@ fillPtr p sz m = gmpExportInteger m p `onGmpUnsupported` export (sz-1) m
             pokeByteOff p ofs (fromIntegral b :: Word8)
             export (ofs-1) i'
 
--- | transform a big endian binary integer representation pointed by a pointer and a size
+-- | Transform a big endian binary integer representation pointed by a pointer and a size
 -- into an integer
 os2ip :: Ptr Word8 -> Int -> IO Integer
 os2ip ptr ptrSz
@@ -69,7 +69,7 @@ os2ip ptr ptrSz
     | otherwise  = gmpImportInteger ptrSz ptr `onGmpUnsupported` loop 0 0 ptr
   where
     loop :: Integer -> Int -> Ptr Word8 -> IO Integer
-    loop !acc i p
+    loop !acc i !p
         | i == ptrSz = return acc
         | otherwise  = do
             w <- peekByteOff p i :: IO Word8

Crypto/Number/Serialize/Internal/LE.hs

@@ -0,0 +1,75 @@
+-- |
+-- Module      : Crypto.Number.Serialize.Internal.LE
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : Good
+--
+-- Fast serialization primitives for integer using raw pointers (little endian)
+{-# LANGUAGE BangPatterns #-}
+module Crypto.Number.Serialize.Internal.LE
+    ( i2osp
+    , i2ospOf
+    , os2ip
+    ) where
+
+import           Crypto.Number.Compat
+import           Crypto.Number.Basic
+import           Data.Bits
+import           Data.Memory.PtrMethods
+import           Data.Word (Word8)
+import           Foreign.Ptr
+import           Foreign.Storable
+
+-- | Fill a pointer with the little endian binary representation of an integer
+--
+-- If the room available @ptrSz@ is less than the number of bytes needed,
+-- 0 is returned. Likewise if a parameter is invalid, 0 is returned.
+--
+-- Returns the number of bytes written
+i2osp :: Integer -> Ptr Word8 -> Int -> IO Int
+i2osp m ptr ptrSz
+    | ptrSz <= 0 = return 0
+    | m < 0      = return 0
+    | m == 0     = pokeByteOff ptr 0 (0 :: Word8) >> return 1
+    | ptrSz < sz = return 0
+    | otherwise  = fillPtr ptr sz m >> return sz
+  where
+    !sz    = numBytes m
+
+-- | Similar to 'i2osp', except it will pad any remaining space with zero.
+i2ospOf :: Integer -> Ptr Word8 -> Int -> IO Int
+i2ospOf m ptr ptrSz
+    | ptrSz <= 0 = return 0
+    | m < 0      = return 0
+    | ptrSz < sz = return 0
+    | otherwise  = do
+        memSet ptr 0 ptrSz
+        fillPtr ptr sz m
+        return ptrSz
+  where
+    !sz    = numBytes m
+
+fillPtr :: Ptr Word8 -> Int -> Integer -> IO ()
+fillPtr p sz m = gmpExportIntegerLE m p `onGmpUnsupported` export 0 m
+  where
+    export ofs i
+        | ofs >= sz = return ()
+        | otherwise = do
+            let (i', b) = i `divMod` 256
+            pokeByteOff p ofs (fromIntegral b :: Word8)
+            export (ofs+1) i'
+
+-- | Transform a little endian binary integer representation pointed by a
+-- pointer and a size into an integer
+os2ip :: Ptr Word8 -> Int -> IO Integer
+os2ip ptr ptrSz
+    | ptrSz <= 0 = return 0
+    | otherwise  = gmpImportIntegerLE ptrSz ptr `onGmpUnsupported` loop 0 (ptrSz-1) ptr
+  where
+    loop :: Integer -> Int -> Ptr Word8 -> IO Integer
+    loop !acc i !p
+        | i < 0      = return acc
+        | otherwise  = do
+            w <- peekByteOff p i :: IO Word8
+            loop ((acc `shiftL` 8) .|. fromIntegral w) (i-1) p

Crypto/Number/Serialize/LE.hs

@@ -0,0 +1,54 @@
+-- |
+-- Module      : Crypto.Number.Serialize.LE
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : Good
+--
+-- Fast serialization primitives for integer (little endian)
+{-# LANGUAGE BangPatterns #-}
+module Crypto.Number.Serialize.LE
+    ( i2osp
+    , os2ip
+    , i2ospOf
+    , i2ospOf_
+    ) where
+
+import           Crypto.Number.Basic
+import           Crypto.Internal.Compat (unsafeDoIO)
+import qualified Crypto.Internal.ByteArray as B
+import qualified Crypto.Number.Serialize.Internal.LE as Internal
+
+-- | @os2ip@ converts a byte string into a positive integer.
+os2ip :: B.ByteArrayAccess ba => ba -> Integer
+os2ip bs = unsafeDoIO $ B.withByteArray bs (\p -> Internal.os2ip p (B.length bs))
+
+-- | @i2osp@ converts a positive integer into a byte string.
+--
+-- The first byte is LSB (least significant byte); the last byte is the MSB (most significant byte)
+i2osp :: B.ByteArray ba => Integer -> ba
+i2osp 0 = B.allocAndFreeze 1  (\p -> Internal.i2osp 0 p 1 >> return ())
+i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ())
+  where
+        !sz = numBytes m
+
+-- | Just like 'i2osp', but takes an extra parameter for size.
+-- If the number is too big to fit in @len@ bytes, 'Nothing' is returned
+-- otherwise the number is padded with 0 to fit the @len@ required.
+{-# INLINABLE i2ospOf #-}
+i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba
+i2ospOf len m
+    | len <= 0  = Nothing
+    | m < 0     = Nothing
+    | sz > len  = Nothing
+    | otherwise = Just $ B.unsafeCreate len (\p -> Internal.i2ospOf m p len >> return ())
+  where
+        !sz = numBytes m
+
+-- | Just like 'i2ospOf' except that it doesn't expect a failure: i.e.
+-- an integer larger than the number of output bytes requested.
+--
+-- For example if you just took a modulo of the number that represent
+-- the size (example the RSA modulo n).
+i2ospOf_ :: B.ByteArray ba => Int -> Integer -> ba
+i2ospOf_ len = maybe (error "i2ospOf_: integer is larger than expected") id . i2ospOf len

Crypto/OTP.hs

@@ -42,15 +42,14 @@ module Crypto.OTP
     )
 where
 
-import           Data.Bits (shiftL, shiftR, (.&.), (.|.))
+import           Data.Bits (shiftL, (.&.), (.|.))
 import           Data.ByteArray.Mapping (fromW64BE)
 import           Data.List (elemIndex)
 import           Data.Word
-import           Foreign.Storable (poke)
 import           Control.Monad (unless)
 import           Crypto.Hash (HashAlgorithm, SHA1(..))
 import           Crypto.MAC.HMAC
-import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)
+import           Crypto.Internal.ByteArray (ByteArrayAccess, Bytes)
 import qualified Crypto.Internal.ByteArray as B
 
 

Crypto/PubKey/Curve25519.hs

@@ -18,7 +18,7 @@ module Crypto.PubKey.Curve25519
     , dhSecret
     , publicKey
     , secretKey
-    -- * methods
+    -- * Methods
     , dh
     , toPublic
     , generateSecretKey
@@ -33,9 +33,8 @@ import           GHC.Ptr
 import           Crypto.Error
 import           Crypto.Internal.Compat
 import           Crypto.Internal.Imports
-import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes, Bytes, withByteArray)
+import           Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes, Bytes, withByteArray)
 import qualified Crypto.Internal.ByteArray as B
-import           Crypto.Error (CryptoFailable(..))
 import           Crypto.Random
 
 -- | A Curve25519 Secret key
@@ -92,7 +91,10 @@ dhSecret bs
     | B.length bs == 32 = CryptoPassed $ DhSecret $ B.copyAndFreeze bs (\_ -> return ())
     | otherwise         = CryptoFailed CryptoError_SharedSecretSizeInvalid
 
--- | Compute the Diffie Hellman secret from a public key and a secret key
+-- | Compute the Diffie Hellman secret from a public key and a secret key.
+--
+-- This implementation may return an all-zero value as it does not check for
+-- the condition.
 dh :: PublicKey -> SecretKey -> DhSecret
 dh (PublicKey pub) (SecretKey sec) = DhSecret <$>
     B.allocAndFreeze 32        $ \result ->

Crypto/PubKey/Curve448.hs

@@ -7,8 +7,11 @@
 --
 -- Curve448 support
 --
+-- Internally uses Decaf point compression to omit the cofactor
+-- and implementation by Mike Hamburg.  Externally API and
+-- data types are compatible with the encoding specified in RFC 7748.
+--
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MagicHash #-}
 module Crypto.PubKey.Curve448
     ( SecretKey
     , PublicKey
@@ -17,7 +20,7 @@ module Crypto.PubKey.Curve448
     , dhSecret
     , publicKey
     , secretKey
-    -- * methods
+    -- * Methods
     , dh
     , toPublic
     , generateSecretKey
@@ -25,7 +28,6 @@ module Crypto.PubKey.Curve448
 
 import           Data.Word
 import           Foreign.Ptr
-import           GHC.Ptr
 
 import           Crypto.Error
 import           Crypto.Random
@@ -75,13 +77,16 @@ dhSecret bs
     | B.length bs == x448_bytes = CryptoPassed $ DhSecret $ B.copyAndFreeze bs (\_ -> return ())
     | otherwise                 = CryptoFailed CryptoError_SharedSecretSizeInvalid
 
--- | Compute the Diffie Hellman secret from a public key and a secret key
+-- | Compute the Diffie Hellman secret from a public key and a secret key.
+--
+-- This implementation may return an all-zero value as it does not check for
+-- the condition.
 dh :: PublicKey -> SecretKey -> DhSecret
 dh (PublicKey pub) (SecretKey sec) = DhSecret <$>
     B.allocAndFreeze x448_bytes $ \result ->
     withByteArray sec           $ \psec   ->
     withByteArray pub           $ \ppub   ->
-        ccryptonite_ed448 result psec ppub
+        decaf_x448 result ppub psec
 {-# NOINLINE dh #-}
 
 -- | Create a public key from a secret key
@@ -89,9 +94,7 @@ toPublic :: SecretKey -> PublicKey
 toPublic (SecretKey sec) = PublicKey <$>
     B.allocAndFreeze x448_bytes     $ \result ->
     withByteArray sec               $ \psec   ->
-        ccryptonite_ed448 result psec basePoint
+        decaf_x448_derive_public_key result psec
-  where
-        basePoint = Ptr "\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
 {-# NOINLINE toPublic #-}
 
 -- | Generate a secret key.
@@ -101,8 +104,13 @@ generateSecretKey = SecretKey <$> getRandomBytes x448_bytes
 x448_bytes :: Int
 x448_bytes = 448 `quot` 8
 
-foreign import ccall "cryptonite_x448"
+foreign import ccall "cryptonite_decaf_x448"
-    ccryptonite_ed448 :: Ptr Word8 -- ^ public
+    decaf_x448 :: Ptr Word8 -- ^ public
-                      -> Ptr Word8 -- ^ secret
+               -> Ptr Word8 -- ^ basepoint
-                      -> Ptr Word8 -- ^ basepoint
+               -> Ptr Word8 -- ^ secret
-                      -> IO ()
+               -> IO ()
+
+foreign import ccall "cryptonite_decaf_x448_derive_public_key"
+    decaf_x448_derive_public_key :: Ptr Word8 -- ^ public
+                                 -> Ptr Word8 -- ^ secret
+                                 -> IO ()

Crypto/PubKey/DH.hs

@@ -33,19 +33,22 @@ data Params = Params
     { params_p :: Integer
     , params_g :: Integer
     , params_bits :: Int
-    } deriving (Show,Read,Eq,Data,Typeable)
+    } deriving (Show,Read,Eq,Data)
+
+instance NFData Params where
+    rnf (Params p g bits) = rnf p `seq` rnf g `seq` bits `seq` ()
 
 -- | Represent Diffie Hellman public number Y.
 newtype PublicNumber = PublicNumber Integer
-    deriving (Show,Read,Eq,Enum,Real,Num,Ord)
+    deriving (Show,Read,Eq,Enum,Real,Num,Ord,NFData)
 
 -- | Represent Diffie Hellman private number X.
 newtype PrivateNumber = PrivateNumber Integer
-    deriving (Show,Read,Eq,Enum,Real,Num,Ord)
+    deriving (Show,Read,Eq,Enum,Real,Num,Ord,NFData)
 
 -- | Represent Diffie Hellman shared secret.
 newtype SharedKey = SharedKey ScrubbedBytes
-    deriving (Show,Eq,ByteArrayAccess)
+    deriving (Show,Eq,ByteArrayAccess,NFData)
 
 -- | generate params from a specific generator (2 or 5 are common values)
 -- we generate a safe prime (a prime number of the form 2p+1 where p is also prime)

Crypto/PubKey/DSA.hs

@@ -14,13 +14,13 @@ module Crypto.PubKey.DSA
     , PrivateKey(..)
     , PublicNumber
     , PrivateNumber
-    -- * generation
+    -- * Generation
     , generatePrivate
     , calculatePublic
-    -- * signature primitive
+    -- * Signature primitive
     , sign
     , signWith
-    -- * verification primitive
+    -- * Verification primitive
     , verify
     -- * Key pair
     , KeyPair(..)
@@ -28,18 +28,17 @@ module Crypto.PubKey.DSA
     , toPrivateKey
     ) where
 
-import           Crypto.Random.Types
+
-import           Data.Bits (testBit)
+import Data.Data
-import           Data.Data
+import Data.Maybe
-import           Data.Maybe
+
-import           Crypto.Number.Basic (numBits)
+import Crypto.Number.ModArithmetic (expFast, expSafe, inverse)
-import           Crypto.Number.ModArithmetic (expFast, expSafe, inverse)
+import Crypto.Number.Generate
-import           Crypto.Number.Serialize
+import Crypto.Internal.ByteArray (ByteArrayAccess)
-import           Crypto.Number.Generate
+import Crypto.Internal.Imports
-import           Crypto.Internal.ByteArray (ByteArrayAccess(length), convert, index, dropView, takeView)
+import Crypto.Hash
-import           Crypto.Internal.Imports
+import Crypto.PubKey.Internal (dsaTruncHash)
-import           Crypto.Hash
+import Crypto.Random.Types
-import           Prelude hiding (length)
 
 -- | DSA Public Number, usually embedded in DSA Public Key
 type PublicNumber = Integer
@@ -52,7 +51,7 @@ data Params = Params
     { params_p :: Integer -- ^ DSA p
     , params_g :: Integer -- ^ DSA g
     , params_q :: Integer -- ^ DSA q
-    } deriving (Show,Read,Eq,Data,Typeable)
+    } deriving (Show,Read,Eq,Data)
 
 instance NFData Params where
     rnf (Params p g q) = p `seq` g `seq` q `seq` ()
@@ -61,7 +60,7 @@ instance NFData Params where
 data Signature = Signature
     { sign_r :: Integer -- ^ DSA r
     , sign_s :: Integer -- ^ DSA s
-    } deriving (Show,Read,Eq,Data,Typeable)
+    } deriving (Show,Read,Eq,Data)
 
 instance NFData Signature where
     rnf (Signature r s) = r `seq` s `seq` ()
@@ -70,7 +69,7 @@ instance NFData Signature where
 data PublicKey = PublicKey
     { public_params :: Params       -- ^ DSA parameters
     , public_y      :: PublicNumber -- ^ DSA public Y
-    } deriving (Show,Read,Eq,Data,Typeable)
+    } deriving (Show,Read,Eq,Data)
 
 instance NFData PublicKey where
     rnf (PublicKey params y) = y `seq` params `seq` ()
@@ -82,14 +81,14 @@ instance NFData PublicKey where
 data PrivateKey = PrivateKey
     { private_params :: Params        -- ^ DSA parameters
     , private_x      :: PrivateNumber -- ^ DSA private X
-    } deriving (Show,Read,Eq,Data,Typeable)
+    } deriving (Show,Read,Eq,Data)
 
 instance NFData PrivateKey where
     rnf (PrivateKey params x) = x `seq` params `seq` ()
 
 -- | Represent a DSA key pair
 data KeyPair = KeyPair Params PublicNumber PrivateNumber
-    deriving (Show,Read,Eq,Data,Typeable)
+    deriving (Show,Read,Eq,Data)
 
 instance NFData KeyPair where
     rnf (KeyPair params y x) = x `seq` y `seq` params `seq` ()
@@ -126,7 +125,7 @@ signWith k pk hashAlg msg
           x              = private_x pk
           -- compute r,s
           kInv      = fromJust $ inverse k q
-          hm        = os2ip $ hashWith hashAlg msg
+          hm        = dsaTruncHash hashAlg msg q
           r         = expSafe g k p `mod` q
           s         = (kInv * (hm + x * r)) `mod` q
 
@@ -148,11 +147,8 @@ verify hashAlg pk (Signature r s) m
     | otherwise                            = v == r
     where (Params p g q) = public_params pk
           y       = public_y pk
-          hm      = os2ip . truncateHash $ hashWith hashAlg m
+          hm      = dsaTruncHash hashAlg m q
-
           w       = fromJust $ inverse s q
           u1      = (hm*w) `mod` q
           u2      = (r*w) `mod` q
           v       = ((expFast g u1 p) * (expFast y u2 p)) `mod` p `mod` q
-          -- if the hash is larger than the size of q, truncate it; FIXME: deal with the case of a q not evenly divisible by 8
-          truncateHash h = if numBits (os2ip h) > numBits q then takeView h (numBits q `div` 8) else dropView h 0

Crypto/PubKey/ECC/ECDSA.hs

@@ -11,45 +11,46 @@ module Crypto.PubKey.ECC.ECDSA
     , toPublicKey
     , toPrivateKey
     , signWith
+    , signDigestWith
     , sign
+    , signDigest
     , verify
+    , verifyDigest
     ) where
 
 import Control.Monad
-import Crypto.Random.Types
-import Data.Bits (shiftR)
-import Crypto.Internal.ByteArray (ByteArrayAccess)
 import Data.Data
-import Crypto.Number.Basic (numBits)
+
+import Crypto.Hash
+import Crypto.Internal.ByteArray (ByteArrayAccess)
 import Crypto.Number.ModArithmetic (inverse)
-import Crypto.Number.Serialize
 import Crypto.Number.Generate
 import Crypto.PubKey.ECC.Types
 import Crypto.PubKey.ECC.Prim
-import Crypto.Hash
+import Crypto.PubKey.Internal (dsaTruncHashDigest)
-import Crypto.Hash.Types (hashDigestSize)
+import Crypto.Random.Types
 
 -- | Represent a ECDSA signature namely R and S.
 data Signature = Signature
     { sign_r :: Integer -- ^ ECDSA r
     , sign_s :: Integer -- ^ ECDSA s
-    } deriving (Show,Read,Eq,Data,Typeable)
+    } deriving (Show,Read,Eq,Data)
 
 -- | ECDSA Private Key.
 data PrivateKey = PrivateKey
     { private_curve :: Curve
     , private_d     :: PrivateNumber
-    } deriving (Show,Read,Eq,Data,Typeable)
+    } deriving (Show,Read,Eq,Data)
 
 -- | ECDSA Public Key.
 data PublicKey = PublicKey
     { public_curve :: Curve
     , public_q     :: PublicPoint
-    } deriving (Show,Read,Eq,Data,Typeable)
+    } deriving (Show,Read,Eq,Data)
 
 -- | ECDSA Key Pair.
 data KeyPair = KeyPair Curve PublicPoint PrivateNumber
-    deriving (Show,Read,Eq,Data,Typeable)
+    deriving (Show,Read,Eq,Data)
 
 -- | Public key of a ECDSA Key pair.
 toPublicKey :: KeyPair -> PublicKey
@@ -59,17 +60,16 @@ toPublicKey (KeyPair curve pub _) = PublicKey curve pub
 toPrivateKey :: KeyPair -> PrivateKey
 toPrivateKey (KeyPair curve _ priv) = PrivateKey curve priv
 
--- | Sign message using the private key and an explicit k number.
+-- | Sign digest using the private key and an explicit k number.
 --
 -- /WARNING:/ Vulnerable to timing attacks.
-signWith :: (ByteArrayAccess msg, HashAlgorithm hash)
+signDigestWith :: HashAlgorithm hash
-         => Integer    -- ^ k random number
+               => Integer     -- ^ k random number
-         -> PrivateKey -- ^ private key
+               -> PrivateKey  -- ^ private key
-         -> hash       -- ^ hash function
+               -> Digest hash -- ^ digest to sign
-         -> msg        -- ^ message to sign
+               -> Maybe Signature
-         -> Maybe Signature
+signDigestWith k (PrivateKey curve d) digest = do
-signWith k (PrivateKey curve d) hashAlg msg = do
+    let z = dsaTruncHashDigest digest n
-    let z = tHash hashAlg msg n
         CurveCommon _ _ g n _ = common_curve curve
     let point = pointMul curve k g
     r <- case point of
@@ -80,26 +80,44 @@ signWith k (PrivateKey curve d) hashAlg msg = do
     when (r == 0 || s == 0) Nothing
     return $ Signature r s
 
+-- | Sign message using the private key and an explicit k number.
+--
+-- /WARNING:/ Vulnerable to timing attacks.
+signWith :: (ByteArrayAccess msg, HashAlgorithm hash)
+         => Integer    -- ^ k random number
+         -> PrivateKey -- ^ private key
+         -> hash       -- ^ hash function
+         -> msg        -- ^ message to sign
+         -> Maybe Signature
+signWith k pk hashAlg msg = signDigestWith k pk (hashWith hashAlg msg)
+
+-- | Sign digest using the private key.
+--
+-- /WARNING:/ Vulnerable to timing attacks.
+signDigest :: (HashAlgorithm hash, MonadRandom m)
+           => PrivateKey -> Digest hash -> m Signature
+signDigest pk digest = do
+    k <- generateBetween 1 (n - 1)
+    case signDigestWith k pk digest of
+         Nothing  -> signDigest pk digest
+         Just sig -> return sig
+  where n = ecc_n . common_curve $ private_curve pk
+
 -- | Sign message using the private key.
 --
 -- /WARNING:/ Vulnerable to timing attacks.
 sign :: (ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m)
      => PrivateKey -> hash -> msg -> m Signature
-sign pk hashAlg msg = do
+sign pk hashAlg msg = signDigest pk (hashWith hashAlg msg)
-    k <- generateBetween 1 (n - 1)
-    case signWith k pk hashAlg msg of
-         Nothing  -> sign pk hashAlg msg
-         Just sig -> return sig
-  where n = ecc_n . common_curve $ private_curve pk
 
--- | Verify a bytestring using the public key.
+-- | Verify a digest using the public key.
-verify :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> PublicKey -> Signature -> msg -> Bool
+verifyDigest :: HashAlgorithm hash => PublicKey -> Signature -> Digest hash -> Bool
-verify _       (PublicKey _ PointO) _ _ = False
+verifyDigest (PublicKey _ PointO) _ _ = False
-verify hashAlg pk@(PublicKey curve q) (Signature r s) msg
+verifyDigest pk@(PublicKey curve q) (Signature r s) digest
     | r < 1 || r >= n || s < 1 || s >= n = False
     | otherwise = maybe False (r ==) $ do
         w <- inverse s n
-        let z  = tHash hashAlg msg n
+        let z  = dsaTruncHashDigest digest n
             u1 = z * w `mod` n
             u2 = r * w `mod` n
             x  = pointAddTwoMuls curve u1 g u2 q
@@ -110,10 +128,6 @@ verify hashAlg pk@(PublicKey curve q) (Signature r s) msg
         g = ecc_g cc
         cc = common_curve $ public_curve pk
 
--- | Truncate and hash.
+-- | Verify a bytestring using the public key.
-tHash :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> msg -> Integer -> Integer
+verify :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> PublicKey -> Signature -> msg -> Bool
-tHash hashAlg m n
+verify hashAlg pk sig msg = verifyDigest pk sig (hashWith hashAlg msg)
-    | d > 0 = shiftR e d
-    | otherwise = e
-  where e = os2ip $ hashWith hashAlg m
-        d = hashDigestSize hashAlg * 8 - numBits n

Crypto/PubKey/ECC/P256.hs

@@ -8,31 +8,37 @@
 -- P256 support
 --
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE EmptyDataDecls #-}
 {-# OPTIONS_GHC -fno-warn-unused-binds #-}
 module Crypto.PubKey.ECC.P256
     ( Scalar
     , Point
-    -- * point arithmetic
+    -- * Point arithmetic
     , pointBase
     , pointAdd
+    , pointNegate
     , pointMul
     , pointDh
     , pointsMulVarTime
     , pointIsValid
+    , pointIsAtInfinity
     , toPoint
+    , pointX
     , pointToIntegers
     , pointFromIntegers
     , pointToBinary
     , pointFromBinary
-    -- * scalar arithmetic
+    , unsafePointFromBinary
+    -- * Scalar arithmetic
     , scalarGenerate
     , scalarZero
+    , scalarN
     , scalarIsZero
     , scalarAdd
     , scalarSub
+    , scalarMul
     , scalarInv
+    , scalarInvSafe
     , scalarCmp
     , scalarFromBinary
     , scalarToBinary
@@ -43,7 +49,6 @@ module Crypto.PubKey.ECC.P256
 import           Data.Word
 import           Foreign.Ptr
 import           Foreign.C.Types
-import           Control.Monad
 
 import           Crypto.Internal.Compat
 import           Crypto.Internal.Imports
@@ -57,11 +62,11 @@ import qualified Crypto.Number.Serialize as S (os2ip, i2ospOf)
 
 -- | A P256 scalar
 newtype Scalar = Scalar ScrubbedBytes
-    deriving (Show,Eq,ByteArrayAccess)
+    deriving (Show,Eq,ByteArrayAccess,NFData)
 
 -- | A P256 point
 newtype Point = Point Bytes
-    deriving (Show,Eq)
+    deriving (Show,Eq,NFData)
 
 scalarSize :: Int
 scalarSize = 32
@@ -75,6 +80,9 @@ data P256Scalar
 data P256Y
 data P256X
 
+order :: Integer
+order = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551
+
 ------------------------------------------------------------------------
 -- Point methods
 ------------------------------------------------------------------------
@@ -105,20 +113,27 @@ pointAdd a b = withNewPoint $ \dx dy ->
     withPoint a $ \ax ay -> withPoint b $ \bx by ->
         ccryptonite_p256e_point_add ax ay bx by dx dy
 
+-- | Negate a point
+pointNegate :: Point -> Point
+pointNegate a = withNewPoint $ \dx dy ->
+    withPoint a $ \ax ay ->
+        ccryptonite_p256e_point_negate ax ay dx dy
+
 -- | Multiply a point by a scalar
 --
 -- warning: variable time
 pointMul :: Scalar -> Point -> Point
 pointMul scalar p = withNewPoint $ \dx dy ->
-    withScalar scalar $ \n -> withPoint p $ \px py -> withScalarZero $ \nzero ->
+    withScalar scalar $ \n -> withPoint p $ \px py ->
-        ccryptonite_p256_points_mul_vartime nzero n px py dx dy
+        ccryptonite_p256e_point_mul n px py dx dy
 
--- | Similar to 'pointMul', serializing the x coordinate as binary
+-- | Similar to 'pointMul', serializing the x coordinate as binary.
+-- When scalar is multiple of point order the result is all zero.
 pointDh :: ByteArray binary => Scalar -> Point -> binary
 pointDh scalar p =
     B.unsafeCreate scalarSize $ \dst -> withTempPoint $ \dx dy -> do
-        withScalar scalar $ \n -> withPoint p $ \px py -> withScalarZero $ \nzero ->
+        withScalar scalar $ \n -> withPoint p $ \px py ->
-            ccryptonite_p256_points_mul_vartime nzero n px py dx dy
+            ccryptonite_p256e_point_mul n px py dx dy
         ccryptonite_p256_to_bin (castPtr dx) dst
 
 -- | multiply the point @p with @n2 and add a lifted to curve value @n1
@@ -137,6 +152,19 @@ pointIsValid p = unsafeDoIO $ withPoint p $ \px py -> do
     r <- ccryptonite_p256_is_valid_point px py
     return (r /= 0)
 
+-- | Check if a 'Point' is the point at infinity
+pointIsAtInfinity :: Point -> Bool
+pointIsAtInfinity (Point b) = constAllZero b
+
+-- | Return the x coordinate as a 'Scalar' if the point is not at infinity
+pointX :: Point -> Maybe Scalar
+pointX p
+    | pointIsAtInfinity p = Nothing
+    | otherwise           = Just $
+        withNewScalarFreeze $ \d    ->
+        withPoint p         $ \px _ ->
+            ccryptonite_p256_mod ccryptonite_SECP256r1_n (castPtr px) (castPtr d)
+
 -- | Convert a point to (x,y) Integers
 pointToIntegers :: Point -> (Integer, Integer)
 pointToIntegers p = unsafeDoIO $ withPoint p $ \px py ->
@@ -172,10 +200,19 @@ pointToBinary p = B.unsafeCreate pointSize $ \dst -> withPoint p $ \px py -> do
     ccryptonite_p256_to_bin (castPtr px) dst
     ccryptonite_p256_to_bin (castPtr py) (dst `plusPtr` 32)
 
--- | Convert from binary to a point
+-- | Convert from binary to a valid point
 pointFromBinary :: ByteArrayAccess ba => ba -> CryptoFailable Point
-pointFromBinary ba
+pointFromBinary ba = unsafePointFromBinary ba >>= validatePoint
-    | B.length ba /= pointSize = CryptoFailed $ CryptoError_PublicKeySizeInvalid
+  where
+    validatePoint :: Point -> CryptoFailable Point
+    validatePoint p
+        | pointIsValid p = CryptoPassed p
+        | otherwise      = CryptoFailed CryptoError_PointCoordinatesInvalid
+
+-- | Convert from binary to a point, possibly invalid
+unsafePointFromBinary :: ByteArrayAccess ba => ba -> CryptoFailable Point
+unsafePointFromBinary ba
+    | B.length ba /= pointSize = CryptoFailed CryptoError_PublicKeySizeInvalid
     | otherwise                =
         CryptoPassed $ withNewPoint $ \px py -> B.withByteArray ba $ \src -> do
             ccryptonite_p256_from_bin src                        (castPtr px)
@@ -198,40 +235,39 @@ scalarGenerate = unwrap . scalarFromBinary . witness <$> getRandomBytes 32
 scalarZero :: Scalar
 scalarZero = withNewScalarFreeze $ \d -> ccryptonite_p256_init d
 
+-- | The scalar representing the curve order
+scalarN :: Scalar
+scalarN = throwCryptoError (scalarFromInteger order)
+
 -- | Check if the scalar is 0
 scalarIsZero :: Scalar -> Bool
 scalarIsZero s = unsafeDoIO $ withScalar s $ \d -> do
     result <- ccryptonite_p256_is_zero d
     return $ result /= 0
 
-scalarNeedReducing :: Ptr P256Scalar -> IO Bool
-scalarNeedReducing d = do
-    c <- ccryptonite_p256_cmp d ccryptonite_SECP256r1_n
-    return (c >= 0)
-
 -- | Perform addition between two scalars
 --
 -- > a + b
 scalarAdd :: Scalar -> Scalar -> Scalar
 scalarAdd a b =
-    withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> do
+    withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb ->
-        carry <- ccryptonite_p256_add pa pb d
+        ccryptonite_p256e_modadd ccryptonite_SECP256r1_n pa pb d
-        when (carry /= 0) $ void $ ccryptonite_p256_sub d ccryptonite_SECP256r1_n d
-        needReducing <- scalarNeedReducing d
-        when needReducing $ do
-            ccryptonite_p256_mod ccryptonite_SECP256r1_n d d
 
 -- | Perform subtraction between two scalars
 --
 -- > a - b
 scalarSub :: Scalar -> Scalar -> Scalar
 scalarSub a b =
-    withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> do
+    withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb ->
-        borrow <- ccryptonite_p256_sub pa pb d
+        ccryptonite_p256e_modsub ccryptonite_SECP256r1_n pa pb d
-        when (borrow /= 0) $ void $ ccryptonite_p256_add d ccryptonite_SECP256r1_n d
+
-        --needReducing <- scalarNeedReducing d
+-- | Perform multiplication between two scalars
-        --when needReducing $ do
+--
-        --    ccryptonite_p256_mod ccryptonite_SECP256r1_n d d
+-- > a * b
+scalarMul :: Scalar -> Scalar -> Scalar
+scalarMul a b =
+    withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb ->
+         ccryptonite_p256_modmul ccryptonite_SECP256r1_n pa 0 pb d
 
 -- | Give the inverse of the scalar
 --
@@ -243,6 +279,14 @@ scalarInv a =
     withNewScalarFreeze $ \b -> withScalar a $ \pa ->
         ccryptonite_p256_modinv_vartime ccryptonite_SECP256r1_n pa b
 
+-- | Give the inverse of the scalar using safe exponentiation
+--
+-- > 1 / a
+scalarInvSafe :: Scalar -> Scalar
+scalarInvSafe a =
+    withNewScalarFreeze $ \b -> withScalar a $ \pa ->
+        ccryptonite_p256e_scalar_invert pa b
+
 -- | Compare 2 Scalar
 scalarCmp :: Scalar -> Scalar -> Ordering
 scalarCmp a b = unsafeDoIO $
@@ -253,7 +297,7 @@ scalarCmp a b = unsafeDoIO $
 -- | convert a scalar from binary
 scalarFromBinary :: ByteArrayAccess ba => ba -> CryptoFailable Scalar
 scalarFromBinary ba
-    | B.length ba /= scalarSize = CryptoFailed $ CryptoError_SecretKeySizeInvalid
+    | B.length ba /= scalarSize = CryptoFailed CryptoError_SecretKeySizeInvalid
     | otherwise                 =
         CryptoPassed $ withNewScalarFreeze $ \p -> B.withByteArray ba $ \b ->
             ccryptonite_p256_from_bin b p
@@ -292,20 +336,11 @@ withNewScalarFreeze f = Scalar $ B.allocAndFreeze scalarSize f
 {-# NOINLINE withNewScalarFreeze #-}
 
 withTempPoint :: (Ptr P256X -> Ptr P256Y -> IO a) -> IO a
-withTempPoint f = allocTempScrubbed scalarSize (\p -> let px = castPtr p in f px (pxToPy px))
+withTempPoint f = allocTempScrubbed pointSize (\p -> let px = castPtr p in f px (pxToPy px))
-
-withTempScalar :: (Ptr P256Scalar -> IO a) -> IO a
-withTempScalar f = allocTempScrubbed scalarSize (f . castPtr)
 
 withScalar :: Scalar -> (Ptr P256Scalar -> IO a) -> IO a
 withScalar (Scalar d) f = B.withByteArray d f
 
-withScalarZero :: (Ptr P256Scalar -> IO a) -> IO a
-withScalarZero f =
-    withTempScalar $ \d -> do
-        ccryptonite_p256_init d
-        f d
-
 allocTemp :: Int -> (Ptr Word8 -> IO a) -> IO a
 allocTemp n f = ignoreSnd <$> B.allocRet n f
   where
@@ -334,18 +369,20 @@ foreign import ccall "cryptonite_p256_is_zero"
     ccryptonite_p256_is_zero :: Ptr P256Scalar -> IO CInt
 foreign import ccall "cryptonite_p256_clear"
     ccryptonite_p256_clear :: Ptr P256Scalar -> IO ()
-foreign import ccall "cryptonite_p256_add"
+foreign import ccall "cryptonite_p256e_modadd"
-    ccryptonite_p256_add :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO CInt
+    ccryptonite_p256e_modadd :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO ()
 foreign import ccall "cryptonite_p256_add_d"
     ccryptonite_p256_add_d :: Ptr P256Scalar -> P256Digit -> Ptr P256Scalar -> IO CInt
-foreign import ccall "cryptonite_p256_sub"
+foreign import ccall "cryptonite_p256e_modsub"
-    ccryptonite_p256_sub :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO CInt
+    ccryptonite_p256e_modsub :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO ()
 foreign import ccall "cryptonite_p256_cmp"
     ccryptonite_p256_cmp :: Ptr P256Scalar -> Ptr P256Scalar -> IO CInt
 foreign import ccall "cryptonite_p256_mod"
     ccryptonite_p256_mod :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO ()
 foreign import ccall "cryptonite_p256_modmul"
     ccryptonite_p256_modmul :: Ptr P256Scalar -> Ptr P256Scalar -> P256Digit -> Ptr P256Scalar -> Ptr P256Scalar -> IO ()
+foreign import ccall "cryptonite_p256e_scalar_invert"
+    ccryptonite_p256e_scalar_invert :: Ptr P256Scalar -> Ptr P256Scalar -> IO ()
 --foreign import ccall "cryptonite_p256_modinv"
 --    ccryptonite_p256_modinv :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO ()
 foreign import ccall "cryptonite_p256_modinv_vartime"
@@ -361,6 +398,18 @@ foreign import ccall "cryptonite_p256e_point_add"
                                 -> Ptr P256X -> Ptr P256Y
                                 -> IO ()
 
+foreign import ccall "cryptonite_p256e_point_negate"
+    ccryptonite_p256e_point_negate :: Ptr P256X -> Ptr P256Y
+                                   -> Ptr P256X -> Ptr P256Y
+                                   -> IO ()
+
+-- compute (out_x,out_y) = n * (in_x,in_y)
+foreign import ccall "cryptonite_p256e_point_mul"
+    ccryptonite_p256e_point_mul :: Ptr P256Scalar -- n
+                                -> Ptr P256X -> Ptr P256Y -- in_{x,y}
+                                -> Ptr P256X -> Ptr P256Y -- out_{x,y}
+                                -> IO ()
+
 -- compute (out_x,out,y) = n1 * G + n2 * (in_x,in_y)
 foreign import ccall "cryptonite_p256_points_mul_vartime"
     ccryptonite_p256_points_mul_vartime :: Ptr P256Scalar -- n1

Crypto/PubKey/ECC/Prim.hs

@@ -4,6 +4,7 @@
 module Crypto.PubKey.ECC.Prim
     ( scalarGenerate
     , pointAdd
+    , pointNegate
     , pointDouble
     , pointBaseMul
     , pointMul
@@ -30,9 +31,9 @@ scalarGenerate curve = generateBetween 1 (n - 1)
 -- | Elliptic Curve point negation:
 -- @pointNegate c p@ returns point @q@ such that @pointAdd c p q == PointO@.
 pointNegate :: Curve -> Point -> Point
-pointNegate _           PointO     = PointO
+pointNegate _            PointO     = PointO
-pointNegate CurveFP{}  (Point x y) = Point x (-y)
+pointNegate (CurveFP c) (Point x y) = Point x (ecc_p c - y)
-pointNegate CurveF2m{} (Point x y) = Point x (x `addF2m` y)
+pointNegate CurveF2m{}  (Point x y) = Point x (x `addF2m` y)
 
 -- | Elliptic Curve point addition.
 --

Crypto/PubKey/ECC/Types.hs

@@ -6,7 +6,7 @@
 -- Stability   : Experimental
 -- Portability : Excellent
 --
--- references:
+-- References:
 --   <https://tools.ietf.org/html/rfc5915>
 --
 module Crypto.PubKey.ECC.Types
@@ -21,7 +21,7 @@ module Crypto.PubKey.ECC.Types
     , ecc_fx
     , ecc_p
     , CurveCommon(..)
-    -- * recommended curves definition
+    -- * Recommended curves definition
     , CurveName(..)
     , getCurveByName
     ) where
@@ -33,7 +33,7 @@ import           Crypto.Number.Basic (numBits)
 -- | Define either a binary curve or a prime curve.
 data Curve = CurveF2m CurveBinary -- ^ 𝔽(2^m)
            | CurveFP  CurvePrime  -- ^ 𝔽p
-           deriving (Show,Read,Eq,Data,Typeable)
+           deriving (Show,Read,Eq,Data)
 
 -- | ECC Public Point
 type PublicPoint = Point
@@ -44,7 +44,7 @@ type PrivateNumber = Integer
 -- | Define a point on a curve.
 data Point = Point Integer Integer
            | PointO -- ^ Point at Infinity
-           deriving (Show,Read,Eq,Data,Typeable)
+           deriving (Show,Read,Eq,Data)
 
 instance NFData Point where
     rnf (Point x y) = x `seq` y `seq` ()
@@ -53,7 +53,7 @@ instance NFData Point where
 -- | Define an elliptic curve in 𝔽(2^m).
 -- The firt parameter is the Integer representatioin of the irreducible polynomial f(x).
 data CurveBinary = CurveBinary Integer CurveCommon
-    deriving (Show,Read,Eq,Data,Typeable)
+    deriving (Show,Read,Eq,Data)
 
 instance NFData CurveBinary where
     rnf (CurveBinary i cc) = i `seq` cc `seq` ()
@@ -61,7 +61,7 @@ instance NFData CurveBinary where
 -- | Define an elliptic curve in 𝔽p.
 -- The first parameter is the Prime Number.
 data CurvePrime = CurvePrime Integer CurveCommon
-    deriving (Show,Read,Eq,Data,Typeable)
+    deriving (Show,Read,Eq,Data)
 
 -- | Parameters in common between binary and prime curves.
 common_curve :: Curve -> CurveCommon
@@ -84,7 +84,7 @@ data CurveCommon = CurveCommon
     , ecc_g :: Point   -- ^ base point
     , ecc_n :: Integer -- ^ order of G
     , ecc_h :: Integer -- ^ cofactor
-    } deriving (Show,Read,Eq,Data,Typeable)
+    } deriving (Show,Read,Eq,Data)
 
 -- | Define names for known recommended curves.
 data CurveName =
@@ -121,7 +121,7 @@ data CurveName =
     | SEC_t409r1
     | SEC_t571k1
     | SEC_t571r1
-    deriving (Show,Read,Eq,Ord,Enum,Bounded,Data,Typeable)
+    deriving (Show,Read,Eq,Ord,Enum,Bounded,Data)
 
 {-
 curvesOIDs :: [ (CurveName, [Integer]) ]