Compare commits
No commits in common. "uni2work" and "blake2-update" have entirely different histories.
uni2work
...
blake2-upd
@ -1,29 +0,0 @@
|
||||
# ~*~ 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%
|
||||
|
||||
|
||||
1
.gitignore
vendored
1
.gitignore
vendored
@ -12,4 +12,3 @@ benchs/Hash
|
||||
*.sublime-workspace
|
||||
.cabal-sandbox/
|
||||
cabal.sandbox.config
|
||||
stack.yaml.lock
|
||||
|
||||
26
.haskell-ci
26
.haskell-ci
@ -1,26 +0,0 @@
|
||||
# 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
|
||||
@ -1,3 +0,0 @@
|
||||
- arguments: [ --cpp-define=ARCH_X86_64
|
||||
]
|
||||
- ignore: { name: Use camelCase }
|
||||
119
.travis.yml
119
.travis.yml
@ -1,83 +1,50 @@
|
||||
# ~*~ auto-generated by haskell-ci with config : 4fdddfa41dd039e198b8d125a70471f7dd140fa01001d99126af56fb31429ece ~*~
|
||||
sudo: false
|
||||
|
||||
# Caching so the next build will be fast too.
|
||||
cache:
|
||||
directories:
|
||||
- $HOME/.ghc
|
||||
- $HOME/.stack
|
||||
- $HOME/.local
|
||||
env:
|
||||
- CABALVER=1.18 GHCVER=7.8.4
|
||||
- CABALVER=1.22 GHCVER=7.10.3
|
||||
- CABALVER=1.24 GHCVER=8.0.2
|
||||
- CABALVER=head GHCVER=head RUNTEST=0
|
||||
|
||||
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 ] } } }
|
||||
matrix:
|
||||
allow_failures:
|
||||
- { env: BUILD=hlint }
|
||||
- { env: BUILD=weeder, addons: { apt: { packages: [ libgmp-dev ] } } }
|
||||
- env: CABALVER=head GHCVER=head RUNTEST=0
|
||||
|
||||
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.2
|
||||
- ghc-head
|
||||
|
||||
before_install:
|
||||
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
|
||||
|
||||
install:
|
||||
- export PATH=$HOME/.local/bin:$HOME/.cabal/bin:$PATH
|
||||
- mkdir -p ~/.local/bin
|
||||
- |
|
||||
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
|
||||
- cabal --version
|
||||
- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
||||
- travis_retry cabal update
|
||||
- if [ "${RUNTEST}" != "0" ]; then cabal install --only-dependencies --enable-tests; else cabal install --only-dependencies; fi
|
||||
|
||||
script:
|
||||
- |
|
||||
set -ex
|
||||
if [ "x${RUNTEST}" = "xfalse" ]; then exit 0; fi
|
||||
case "$BUILD" in
|
||||
stack)
|
||||
# create the build stack.yaml
|
||||
case "$RESOLVER" in
|
||||
ghc-8.0)
|
||||
echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18, gauge-0.2.1 ], flags: {} }" > stack.yaml
|
||||
stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps
|
||||
;;
|
||||
ghc-8.2)
|
||||
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
|
||||
|
||||
- if [ "${RUNTEST}" != "0" ]; then cabal configure --enable-tests -v2; else cabal configure -v2; fi
|
||||
- cabal build
|
||||
- if [ "${RUNTEST}" != "0" ]; then cabal test; fi;
|
||||
- cabal check
|
||||
- cabal sdist
|
||||
- export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;
|
||||
cd dist/;
|
||||
if [ -f "$SRC_TGZ" ]; then
|
||||
cabal install --force-reinstalls "$SRC_TGZ";
|
||||
else
|
||||
echo "expected '$SRC_TGZ' not found";
|
||||
exit 1;
|
||||
fi
|
||||
|
||||
112
CHANGELOG.md
112
CHANGELOG.md
@ -1,115 +1,3 @@
|
||||
## 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.
|
||||
|
||||
@ -14,11 +14,12 @@ 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)
|
||||
@ -46,6 +47,15 @@ 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 \
|
||||
@ -57,7 +67,6 @@ 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 \
|
||||
|
||||
@ -11,46 +11,39 @@
|
||||
--
|
||||
module Crypto.Cipher.AES.Primitive
|
||||
(
|
||||
-- * Block cipher data types
|
||||
-- * block cipher data types
|
||||
AES
|
||||
|
||||
-- * Authenticated encryption block cipher types
|
||||
, AESGCM
|
||||
, AESOCB
|
||||
|
||||
-- * Creation
|
||||
-- * creation
|
||||
, initAES
|
||||
|
||||
-- * Miscellanea
|
||||
-- * misc
|
||||
, genCTR
|
||||
, genCounter
|
||||
|
||||
-- * Encryption
|
||||
-- * encryption
|
||||
, encryptECB
|
||||
, encryptCBC
|
||||
, encryptCTR
|
||||
, encryptXTS
|
||||
|
||||
-- * Decryption
|
||||
-- * decryption
|
||||
, decryptECB
|
||||
, decryptCBC
|
||||
, decryptCTR
|
||||
, decryptXTS
|
||||
|
||||
-- * CTR with 32-bit wrapping
|
||||
, combineC32
|
||||
|
||||
-- * Incremental GCM
|
||||
-- * incremental GCM
|
||||
, gcmMode
|
||||
, gcmInit
|
||||
|
||||
-- * Incremental OCB
|
||||
-- * incremental OCB
|
||||
, ocbMode
|
||||
, ocbInit
|
||||
|
||||
-- * CCM
|
||||
, ccmMode
|
||||
, ccmInit
|
||||
) where
|
||||
|
||||
import Data.Word
|
||||
@ -80,7 +73,6 @@ 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
|
||||
@ -104,15 +96,6 @@ 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
|
||||
@ -126,19 +109,12 @@ newtype AESGCM = AESGCM ScrubbedBytes
|
||||
newtype AESOCB = AESOCB ScrubbedBytes
|
||||
deriving (NFData)
|
||||
|
||||
-- | AESCCM State
|
||||
newtype AESCCM = AESCCM ScrubbedBytes
|
||||
deriving (NFData)
|
||||
|
||||
sizeGCM :: Int
|
||||
sizeGCM = 320
|
||||
sizeGCM = 80
|
||||
|
||||
sizeOCB :: Int
|
||||
sizeOCB = 160
|
||||
|
||||
sizeCCM :: Int
|
||||
sizeCCM = 80
|
||||
|
||||
keyToPtr :: AES -> (Ptr AES -> IO a) -> IO a
|
||||
keyToPtr (AES b) f = withByteArray b (f . castPtr)
|
||||
|
||||
@ -176,13 +152,6 @@ 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
|
||||
@ -320,21 +289,6 @@ 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 ())
|
||||
@ -493,78 +447,6 @@ 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 ()
|
||||
@ -596,9 +478,6 @@ 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 ()
|
||||
|
||||
@ -629,17 +508,3 @@ 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 ()
|
||||
|
||||
@ -1,193 +0,0 @@
|
||||
-- |
|
||||
-- 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
|
||||
@ -5,33 +5,15 @@
|
||||
-- Portability : Good
|
||||
{-# LANGUAGE MagicHash #-}
|
||||
module Crypto.Cipher.Blowfish.Box
|
||||
( KeySchedule(..)
|
||||
, createKeySchedule
|
||||
, copyKeySchedule
|
||||
( createKeySchedule
|
||||
) where
|
||||
|
||||
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)
|
||||
import Crypto.Internal.WordArray (mutableArray32FromAddrBE, MutableArray32)
|
||||
|
||||
-- | Create a key schedule mutable array of the pbox followed by
|
||||
-- all the sboxes.
|
||||
createKeySchedule :: IO KeySchedule
|
||||
createKeySchedule = KeySchedule `fmap` mutableArray32FromAddrBE 1042 "\
|
||||
createKeySchedule :: IO MutableArray32
|
||||
createKeySchedule = 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\
|
||||
|
||||
@ -5,254 +5,197 @@
|
||||
-- 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
|
||||
, KeySchedule
|
||||
, createKeySchedule
|
||||
, freezeKeySchedule
|
||||
, expandKey
|
||||
, expandKeyWithSalt
|
||||
, cipherBlockMutable
|
||||
, eksBlowfish
|
||||
) 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
|
||||
|
||||
newtype Context = Context Array32
|
||||
-- | variable keyed blowfish state
|
||||
data Context = BF (Int -> Word32) -- p
|
||||
(Int -> Word32) -- sbox0
|
||||
(Int -> Word32) -- sbox1
|
||||
(Int -> Word32) -- sbox2
|
||||
(Int -> Word32) -- sbox2
|
||||
|
||||
instance NFData Context where
|
||||
rnf a = a `seq` ()
|
||||
rnf (BF p a b c d) = p `seq` a `seq` b `seq` c `seq` d `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
|
||||
| B.length key > (448 `div` 8) = CryptoFailed CryptoError_KeySizeInvalid
|
||||
| otherwise = CryptoPassed $ unsafeDoIO $ do
|
||||
ks <- createKeySchedule
|
||||
expandKey ks key
|
||||
freezeKeySchedule ks
|
||||
| len > (448 `div` 8) = CryptoFailed CryptoError_KeySizeInvalid
|
||||
| otherwise = CryptoPassed $ makeKeySchedule key (Nothing :: Maybe (Bytes, Int))
|
||||
where len = B.length key
|
||||
|
||||
-- | 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
|
||||
-- | The BCrypt "expensive key schedule" version of blowfish.
|
||||
--
|
||||
-- Input need to be a multiple of 8 bytes
|
||||
encrypt :: ByteArray ba => Context -> ba -> ba
|
||||
encrypt ctx ba
|
||||
| B.length ba == 0 = B.empty
|
||||
| B.length ba `mod` 8 /= 0 = error "invalid data length"
|
||||
| otherwise = B.mapAsWord64 (cipherBlock ctx False) ba
|
||||
-- Salt must be 128 bits
|
||||
-- Cost must be between 4 and 31 inclusive
|
||||
-- See <https://www.usenix.org/conference/1999-usenix-annual-technical-conference/future-adaptable-password-scheme>
|
||||
eksBlowfish :: (ByteArrayAccess salt, ByteArrayAccess password) => Int -> salt -> password -> Context
|
||||
eksBlowfish cost salt key
|
||||
| B.length salt /= 16 = error "bcrypt salt must be 16 bytes"
|
||||
| otherwise = makeKeySchedule key (Just (salt, cost))
|
||||
|
||||
-- | Decrypt blocks
|
||||
--
|
||||
-- Input need to be a multiple of 8 bytes
|
||||
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
|
||||
coreCrypto :: Context -> Word64 -> Word64
|
||||
coreCrypto (BF p s0 s1 s2 s3) 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
|
||||
newi = ((i `shiftL` 32) `xor` f newr) .|. fromIntegral newr
|
||||
let newr = fromIntegral (i `shiftR` 32) `xor` (p roundIndex)
|
||||
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 (0xff .&. (t `shiftR` 24))
|
||||
b = s1 (0xff .&. (t `shiftR` 16))
|
||||
c = s2 (0xff .&. (t `shiftR` 8))
|
||||
d = s3 (0xff .&. t)
|
||||
f t = let a = s0 (fromIntegral $ (t `shiftR` 24) .&. 0xff)
|
||||
b = s1 (fromIntegral $ (t `shiftR` 16) .&. 0xff)
|
||||
c = s2 (fromIntegral $ (t `shiftR` 8) .&. 0xff)
|
||||
d = s3 (fromIntegral $ t .&. 0xff)
|
||||
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
|
||||
|
||||
-- | Blowfish encrypt a Word using the current state of the key schedule
|
||||
cipherBlockMutable :: KeySchedule -> Word64 -> IO Word64
|
||||
cipherBlockMutable (KeySchedule ma) input = doRound input 0
|
||||
where
|
||||
-- | Transform the input over 16 rounds
|
||||
doRound !i roundIndex
|
||||
| roundIndex == 16 = do
|
||||
pVal1 <- mutableArrayRead32 ma 16
|
||||
pVal2 <- mutableArrayRead32 ma 17
|
||||
let final = (fromIntegral pVal1 `shiftL` 32) .|. fromIntegral pVal2
|
||||
return $ rotateL (i `xor` final) 32
|
||||
| otherwise = do
|
||||
pVal <- mutableArrayRead32 ma roundIndex
|
||||
let newr = fromIntegral (i `shiftR` 32) `xor` pVal
|
||||
newr' <- f newr
|
||||
let newi = ((i `shiftL` 32) `xor` newr') .|. fromIntegral newr
|
||||
doRound newi (roundIndex+1)
|
||||
-- | Create a key schedule for either plain Blowfish or the BCrypt "EKS" version
|
||||
-- For the expensive version, the salt and cost factor are supplied. Salt must be
|
||||
-- a 128-bit byte array.
|
||||
--
|
||||
-- The standard case is just a single key expansion with the salt set to zero.
|
||||
makeKeySchedule :: (ByteArrayAccess key, ByteArrayAccess salt) => key-> Maybe (salt, Int) -> Context
|
||||
makeKeySchedule keyBytes saltCost =
|
||||
let v = unsafeDoIO $ do
|
||||
mv <- createKeySchedule
|
||||
case saltCost of
|
||||
-- Standard blowfish
|
||||
Nothing -> expandKey mv 0 0 keyBytes
|
||||
-- The expensive case
|
||||
Just (s, cost) -> do
|
||||
let (salt1, salt2) = splitSalt s
|
||||
expandKey mv salt1 salt2 keyBytes
|
||||
forM_ [1..2^cost :: Int] $ \_ -> do
|
||||
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))
|
||||
|
||||
-- | The Blowfish Feistel function F
|
||||
f :: Word32 -> IO Word64
|
||||
f t = do
|
||||
a <- s0 (0xff .&. (t `shiftR` 24))
|
||||
b <- s1 (0xff .&. (t `shiftR` 16))
|
||||
c <- s2 (0xff .&. (t `shiftR` 8))
|
||||
d <- s3 (0xff .&. t)
|
||||
return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32)
|
||||
-- Indices of the S-Box arrays, each containing 256 32-bit words
|
||||
-- The first 18 words contain the P-Array of subkeys
|
||||
s0 = 18
|
||||
s1 = 274
|
||||
s2 = 530
|
||||
s3 = 786
|
||||
|
||||
-- | S-Box arrays, each containing 256 32-bit words
|
||||
-- The first 18 words contain the P-Array of subkeys
|
||||
s0, s1, s2, s3 :: Word32 -> IO Word32
|
||||
s0 i = mutableArrayRead32 ma (fromIntegral i + 18)
|
||||
s1 i = mutableArrayRead32 ma (fromIntegral i + 274)
|
||||
s2 i = mutableArrayRead32 ma (fromIntegral i + 530)
|
||||
s3 i = mutableArrayRead32 ma (fromIntegral i + 786)
|
||||
expandKey :: ByteArrayAccess ba
|
||||
=> MutableArray32 -- ^ The key schedule
|
||||
-> Word64 -- ^ First word of the salt
|
||||
-> Word64 -- ^ Second word of the salt
|
||||
-> ba -- ^ The key
|
||||
-> IO ()
|
||||
expandKey mv salt1 salt2 key = do
|
||||
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
|
||||
|
||||
iterKeyStream :: (ByteArrayAccess x)
|
||||
=> x
|
||||
-> Word32
|
||||
-> Word32
|
||||
-> (Int -> Word32 -> Word32 -> Word32 -> Word32 -> (Word32 -> Word32 -> IO ()) -> IO ())
|
||||
-> IO ()
|
||||
iterKeyStream x a0 a1 g = f 0 0 a0 a1
|
||||
where
|
||||
len = B.length x
|
||||
-- Avoiding the modulo operation when interating over the ring
|
||||
-- buffer is assumed to be more efficient here. All other
|
||||
-- implementations do this, too. The branch prediction shall prefer
|
||||
-- the branch with the increment.
|
||||
n j = if j + 1 >= len then 0 else j + 1
|
||||
f i j0 b0 b1 = g i l r b0 b1 (f (i + 2) j8)
|
||||
where
|
||||
j1 = n j0
|
||||
j2 = n j1
|
||||
j3 = n j2
|
||||
j4 = n j3
|
||||
j5 = n j4
|
||||
j6 = n j5
|
||||
j7 = n j6
|
||||
j8 = n j7
|
||||
x0 = fromIntegral (B.index x j0)
|
||||
x1 = fromIntegral (B.index x j1)
|
||||
x2 = fromIntegral (B.index x j2)
|
||||
x3 = fromIntegral (B.index x j3)
|
||||
x4 = fromIntegral (B.index x j4)
|
||||
x5 = fromIntegral (B.index x j5)
|
||||
x6 = fromIntegral (B.index x j6)
|
||||
x7 = fromIntegral (B.index x j7)
|
||||
l = shiftL x0 24 .|. shiftL x1 16 .|. shiftL x2 8 .|. x3
|
||||
r = shiftL x4 24 .|. shiftL x5 16 .|. shiftL x6 8 .|. x7
|
||||
{-# INLINE iterKeyStream #-}
|
||||
-- Benchmarking shows that GHC considers this function too big to inline
|
||||
-- although forcing inlining causes an actual improvement.
|
||||
-- It is assumed that all function calls (especially the continuation)
|
||||
-- collapse into a tight loop after inlining.
|
||||
-- | Go through the entire key schedule overwriting the P-Array and S-Boxes
|
||||
prepare mctx = loop 0 salt1 salt1 salt2
|
||||
where loop i input slt1 slt2
|
||||
| i == 1042 = return ()
|
||||
| otherwise = do
|
||||
ninput <- coreCryptoMutable input
|
||||
let (nl, nr) = w64to32 ninput
|
||||
mutableArrayWrite32 mctx i nl
|
||||
mutableArrayWrite32 mctx (i+1) nr
|
||||
loop (i+2) (ninput `xor` slt2) slt2 slt1
|
||||
|
||||
-- | Blowfish encrypt a Word using the current state of the key schedule
|
||||
coreCryptoMutable :: Word64 -> IO Word64
|
||||
coreCryptoMutable input = doRound input 0
|
||||
where doRound i roundIndex
|
||||
| roundIndex == 16 = do
|
||||
pVal1 <- mutableArrayRead32 mctx 16
|
||||
pVal2 <- mutableArrayRead32 mctx 17
|
||||
let final = (fromIntegral pVal1 `shiftL` 32) .|. fromIntegral pVal2
|
||||
return $ rotateL (i `xor` final) 32
|
||||
| otherwise = do
|
||||
pVal <- mutableArrayRead32 mctx roundIndex
|
||||
let newr = fromIntegral (i `shiftR` 32) `xor` pVal
|
||||
newr' <- f newr
|
||||
let newi = ((i `shiftL` 32) `xor` newr') .|. (fromIntegral newr)
|
||||
doRound newi (roundIndex+1)
|
||||
|
||||
-- The Blowfish Feistel function F
|
||||
f :: Word32 -> IO Word64
|
||||
f t = do a <- mutableArrayRead32 mctx (s0 + fromIntegral ((t `shiftR` 24) .&. 0xff))
|
||||
b <- mutableArrayRead32 mctx (s1 + fromIntegral ((t `shiftR` 16) .&. 0xff))
|
||||
c <- mutableArrayRead32 mctx (s2 + fromIntegral ((t `shiftR` 8) .&. 0xff))
|
||||
d <- mutableArrayRead32 mctx (s3 + fromIntegral (t .&. 0xff))
|
||||
return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32)
|
||||
where s0 = 18
|
||||
s1 = 274
|
||||
s2 = 530
|
||||
s3 = 786
|
||||
|
||||
@ -1,43 +0,0 @@
|
||||
-- |
|
||||
-- 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
|
||||
@ -1,573 +0,0 @@
|
||||
{-# 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"#
|
||||
@ -6,8 +6,8 @@
|
||||
-- Stability : experimental
|
||||
-- Portability : Good
|
||||
--
|
||||
-- This only cover Camellia 128 bits for now. The API will change once
|
||||
-- 192 and 256 mode are implemented too.
|
||||
-- this only cover Camellia 128 bits for now, API will change once
|
||||
-- 192 and 256 mode are implemented too
|
||||
{-# LANGUAGE MagicHash #-}
|
||||
module Crypto.Cipher.Camellia.Primitive
|
||||
( Camellia
|
||||
|
||||
@ -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,26 +41,24 @@ initialize :: (ByteArrayAccess key, ByteArrayAccess nonce)
|
||||
-> nonce -- ^ the nonce (64 or 96 bits)
|
||||
-> State -- ^ the initial ChaCha state
|
||||
initialize nbRounds key nonce
|
||||
| kLen `notElem` [16,32] = error "ChaCha: key length should be 128 or 256 bits"
|
||||
| nonceLen `notElem` [8,12] = error "ChaCha: nonce length should be 64 or 96 bits"
|
||||
| nbRounds `notElem` [8,12,20] = error "ChaCha: rounds should be 8, 12 or 20"
|
||||
| not (kLen `elem` [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"
|
||||
| not (nbRounds `elem` [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 nbRounds kLen keyPtr nonceLen noncePtr
|
||||
ccryptonite_chacha_init stPtr (fromIntegral nbRounds) kLen keyPtr nonceLen noncePtr
|
||||
return $ State stPtr
|
||||
where kLen = B.length key
|
||||
nonceLen = B.length nonce
|
||||
|
||||
-- | Initialize simple ChaCha State
|
||||
--
|
||||
-- The seed need to be at least 40 bytes long
|
||||
initializeSimple :: ByteArrayAccess seed
|
||||
initializeSimple :: ByteArray 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 ->
|
||||
|
||||
@ -30,11 +30,6 @@ 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)
|
||||
|
||||
|
||||
@ -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
|
||||
| kLen `notElem` [16,32] = error "Salsa: key length should be 128 or 256 bits"
|
||||
| nonceLen `notElem` [8,12] = error "Salsa: nonce length should be 64 or 96 bits"
|
||||
| nbRounds `notElem` [8,12,20] = error "Salsa: rounds should be 8, 12 or 20"
|
||||
| not (kLen `elem` [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"
|
||||
| not (nbRounds `elem` [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 nbRounds kLen keyPtr nonceLen noncePtr
|
||||
ccryptonite_salsa_init stPtr (fromIntegral nbRounds) kLen keyPtr nonceLen noncePtr
|
||||
return $ State stPtr
|
||||
where kLen = B.length key
|
||||
nonceLen = B.length nonce
|
||||
|
||||
@ -1,45 +0,0 @@
|
||||
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
|
||||
@ -1,311 +0,0 @@
|
||||
{-# 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)
|
||||
@ -5,7 +5,7 @@
|
||||
-- Stability : Stable
|
||||
-- Portability : Excellent
|
||||
--
|
||||
-- Symmetric cipher basic types
|
||||
-- symmetric cipher basic types
|
||||
--
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
module Crypto.Cipher.Types
|
||||
@ -21,8 +21,6 @@ module Crypto.Cipher.Types
|
||||
-- , cfb8Decrypt
|
||||
-- * AEAD functions
|
||||
, AEADMode(..)
|
||||
, CCM_M(..)
|
||||
, CCM_L(..)
|
||||
, module Crypto.Cipher.Types.AEAD
|
||||
-- * Initial Vector type and constructor
|
||||
, IV
|
||||
|
||||
@ -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) = aeadImplFinalize impl st
|
||||
aeadFinalize (AEAD impl st) n = (aeadImplFinalize impl) st n
|
||||
|
||||
-- | Simple AEAD encryption
|
||||
aeadSimpleEncrypt :: (ByteArrayAccess aad, ByteArray ba)
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
-- Stability : Stable
|
||||
-- Portability : Excellent
|
||||
--
|
||||
-- Symmetric cipher basic types
|
||||
-- symmetric cipher basic types
|
||||
--
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
@ -14,15 +14,12 @@ 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
|
||||
@ -37,18 +34,15 @@ type DataUnitOffset = Word32
|
||||
|
||||
-- | Authentication Tag for AE cipher mode
|
||||
newtype AuthTag = AuthTag { unAuthTag :: Bytes }
|
||||
deriving (Show, ByteArrayAccess, NFData)
|
||||
deriving (Show, ByteArrayAccess)
|
||||
|
||||
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 Int CCM_M CCM_L
|
||||
| AEAD_CCM
|
||||
| AEAD_EAX
|
||||
| AEAD_CWC
|
||||
| AEAD_GCM
|
||||
|
||||
@ -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,6 +37,7 @@ 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
|
||||
@ -163,20 +164,27 @@ nullIV = toIV undefined
|
||||
-- | Increment an IV by a number.
|
||||
--
|
||||
-- Assume the IV is in Big Endian format.
|
||||
ivAdd :: IV c -> Int -> IV c
|
||||
ivAdd :: BlockCipher c => IV c -> Int -> IV c
|
||||
ivAdd (IV b) i = IV $ copy b
|
||||
where copy :: ByteArray bs => bs -> bs
|
||||
copy bs = B.copyAndFreeze bs $ loop i (B.length bs - 1)
|
||||
copy bs = B.copyAndFreeze bs $ \p -> do
|
||||
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 ()
|
||||
loop acc ofs p
|
||||
| ofs < 0 = return ()
|
||||
| otherwise = do
|
||||
v <- peek (p `plusPtr` ofs) :: IO Word8
|
||||
let accv = acc + fromIntegral v
|
||||
(hi,lo) = accv `divMod` 256
|
||||
poke (p `plusPtr` ofs) (fromIntegral lo :: Word8)
|
||||
loop hi (ofs - 1) p
|
||||
loop :: Int -> Int -> Ptr Word8 -> IO Int
|
||||
loop 0 _ _ = return 0
|
||||
loop acc ofs p = do
|
||||
v <- peek (p `plusPtr` ofs) :: IO Word8
|
||||
let accv = acc + fromIntegral v
|
||||
(hi,lo) = accv `divMod` 256
|
||||
poke (p `plusPtr` ofs) (fromIntegral lo :: Word8)
|
||||
if ofs == 0
|
||||
then return hi
|
||||
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
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
-- Stability : Stable
|
||||
-- Portability : Excellent
|
||||
--
|
||||
-- Stream cipher basic types
|
||||
-- stream cipher basic types
|
||||
--
|
||||
module Crypto.Cipher.Types.Stream
|
||||
( StreamCipher(..)
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -1,18 +0,0 @@
|
||||
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
|
||||
@ -12,17 +12,18 @@
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
module Crypto.Cipher.XSalsa
|
||||
( initialize
|
||||
, derive
|
||||
, combine
|
||||
, generate
|
||||
, State
|
||||
) where
|
||||
|
||||
import Crypto.Internal.ByteArray (ByteArrayAccess)
|
||||
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes)
|
||||
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,
|
||||
@ -35,41 +36,15 @@ 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"
|
||||
| nbRounds `notElem` [8,12,20] = error "XSalsa: rounds should be 8, 12 or 20"
|
||||
| not (nbRounds `elem` [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 nbRounds kLen keyPtr nonceLen noncePtr
|
||||
ccryptonite_xsalsa_init stPtr (fromIntegral 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 ()
|
||||
|
||||
@ -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 inferred block cipher.
|
||||
-- | Compute Miyaguchi-Preneel one way compress using the infered block cipher.
|
||||
-- Only safe when KEY-SIZE equals to BLOCK-SIZE.
|
||||
--
|
||||
-- Simple usage /mp' msg :: MiyaguchiPreneel AES128/
|
||||
|
||||
@ -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 blockSize
|
||||
B.withByteArray rand $ \randPtr -> memCopy blockPtr randPtr (fromIntegral blockSize)
|
||||
return g'
|
||||
|
||||
-- | Merge previously diffused data back to the original data.
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- Portability : unknown
|
||||
--
|
||||
-- Various cryptographic padding commonly used for block ciphers
|
||||
-- or asymmetric systems.
|
||||
-- or assymetric systems.
|
||||
--
|
||||
module Crypto.Data.Padding
|
||||
( Format(..)
|
||||
|
||||
223
Crypto/ECC.hs
223
Crypto/ECC.hs
@ -7,8 +7,6 @@
|
||||
--
|
||||
-- Elliptic Curve Cryptography
|
||||
--
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
@ -18,33 +16,27 @@ 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.
|
||||
@ -54,14 +46,14 @@ data KeyPair curve = KeyPair
|
||||
}
|
||||
|
||||
newtype SharedSecret = SharedSecret ScrubbedBytes
|
||||
deriving (Eq, ByteArrayAccess, NFData)
|
||||
deriving (Eq, ByteArrayAccess)
|
||||
|
||||
class EllipticCurve curve where
|
||||
-- | Point on an Elliptic Curve
|
||||
type Point curve :: Type
|
||||
type Point curve :: *
|
||||
|
||||
-- | Scalar in the Elliptic Curve domain
|
||||
type Scalar curve :: Type
|
||||
type Scalar curve :: *
|
||||
|
||||
-- | Generate a new random scalar on the curve.
|
||||
-- The scalar will represent a number between 1 and the order of the curve non included
|
||||
@ -86,69 +78,22 @@ class EllipticCurve curve => EllipticCurveDH curve where
|
||||
-- is not hashed.
|
||||
--
|
||||
-- use `pointSmul` to keep the result in Point format.
|
||||
--
|
||||
-- /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
|
||||
ecdh :: proxy curve -> Scalar curve -> Point curve -> SharedSecret
|
||||
|
||||
-- | 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
|
||||
class EllipticCurve 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
|
||||
@ -166,34 +111,20 @@ 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
|
||||
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
|
||||
ecdh _ s p = SharedSecret $ P256.pointDh s p
|
||||
|
||||
data Curve_P384R1 = Curve_P384R1
|
||||
deriving (Show,Data)
|
||||
|
||||
instance EllipticCurve Curve_P384R1 where
|
||||
type Point Curve_P384R1 = Simple.Point Simple.SEC_p384r1
|
||||
@ -207,27 +138,15 @@ 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 = encodeECShared prx (Simple.pointMul s p)
|
||||
ecdh _ s p = SharedSecret $ i2ospOf_ (curveSizeBytes prx) x
|
||||
where
|
||||
prx = Proxy :: Proxy Simple.SEC_p384r1
|
||||
|
||||
instance EllipticCurveBasepointArith Curve_P384R1 where
|
||||
curveOrderBits _ = 384
|
||||
pointBaseSmul _ = Simple.pointBaseMul
|
||||
pointsSmulVarTime _ = ecPointsMulVarTime
|
||||
encodeScalar _ = ecScalarToBinary
|
||||
decodeScalar _ = ecScalarFromBinary
|
||||
scalarToInteger _ = ecScalarToInteger
|
||||
scalarFromInteger _ = ecScalarFromInteger
|
||||
scalarAdd _ = ecScalarAdd
|
||||
scalarMul _ = ecScalarMul
|
||||
prx = Proxy :: Proxy Curve_P384R1
|
||||
Simple.Point x _ = pointSmul prx s p
|
||||
|
||||
data Curve_P521R1 = Curve_P521R1
|
||||
deriving (Show,Data)
|
||||
|
||||
instance EllipticCurve Curve_P521R1 where
|
||||
type Point Curve_P521R1 = Simple.Point Simple.SEC_p521r1
|
||||
@ -241,27 +160,15 @@ 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 = encodeECShared prx (Simple.pointMul s p)
|
||||
ecdh _ s p = SharedSecret $ i2ospOf_ (curveSizeBytes prx) x
|
||||
where
|
||||
prx = Proxy :: Proxy Simple.SEC_p521r1
|
||||
|
||||
instance EllipticCurveBasepointArith Curve_P521R1 where
|
||||
curveOrderBits _ = 521
|
||||
pointBaseSmul _ = Simple.pointBaseMul
|
||||
pointsSmulVarTime _ = ecPointsMulVarTime
|
||||
encodeScalar _ = ecScalarToBinary
|
||||
decodeScalar _ = ecScalarFromBinary
|
||||
scalarToInteger _ = ecScalarToInteger
|
||||
scalarFromInteger _ = ecScalarFromInteger
|
||||
scalarAdd _ = ecScalarAdd
|
||||
scalarMul _ = ecScalarMul
|
||||
prx = Proxy :: Proxy Curve_P521R1
|
||||
Simple.Point x _ = pointSmul prx s p
|
||||
|
||||
data Curve_X25519 = Curve_X25519
|
||||
deriving (Show,Data)
|
||||
|
||||
instance EllipticCurve Curve_X25519 where
|
||||
type Point Curve_X25519 = X25519.PublicKey
|
||||
@ -275,12 +182,10 @@ instance EllipticCurve Curve_X25519 where
|
||||
decodePoint _ bs = X25519.publicKey bs
|
||||
|
||||
instance EllipticCurveDH Curve_X25519 where
|
||||
ecdhRaw _ s p = SharedSecret $ convert secret
|
||||
ecdh _ 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
|
||||
@ -294,52 +199,8 @@ instance EllipticCurve Curve_X448 where
|
||||
decodePoint _ bs = X448.publicKey bs
|
||||
|
||||
instance EllipticCurveDH Curve_X448 where
|
||||
ecdhRaw _ s p = SharedSecret $ convert secret
|
||||
ecdh _ 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"
|
||||
@ -353,7 +214,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 ->
|
||||
@ -362,47 +223,7 @@ 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
|
||||
|
||||
ecPointsMulVarTime :: forall curve . Simple.Curve curve
|
||||
=> 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)
|
||||
curveSizeBytes :: EllipticCurve c => Proxy c -> Int
|
||||
curveSizeBytes proxy = (curveSizeBits proxy + 7) `div` 8
|
||||
|
||||
@ -1,370 +0,0 @@
|
||||
-- |
|
||||
-- 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 ()
|
||||
@ -6,7 +6,6 @@ module Crypto.ECC.Simple.Prim
|
||||
( scalarGenerate
|
||||
, scalarFromInteger
|
||||
, pointAdd
|
||||
, pointNegate
|
||||
, pointDouble
|
||||
, pointBaseMul
|
||||
, pointMul
|
||||
@ -17,7 +16,8 @@ module Crypto.ECC.Simple.Prim
|
||||
) where
|
||||
|
||||
import Data.Maybe
|
||||
import Data.Proxy
|
||||
import Crypto.Internal.Imports
|
||||
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 (CurvePrimeParam p) -> Point x (p - y)
|
||||
CurvePrime {} -> Point x (-y)
|
||||
CurveBinary {} -> Point x (x `addF2m` y)
|
||||
|
||||
-- | Elliptic Curve point addition.
|
||||
|
||||
@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
-- |
|
||||
-- Module : Crypto.ECC.Simple.Types
|
||||
-- License : BSD-style
|
||||
@ -7,7 +6,7 @@
|
||||
-- Stability : Experimental
|
||||
-- Portability : Excellent
|
||||
--
|
||||
-- References:
|
||||
-- references:
|
||||
-- <https://tools.ietf.org/html/rfc5915>
|
||||
--
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
@ -21,7 +20,7 @@ module Crypto.ECC.Simple.Types
|
||||
, curveSizeBits
|
||||
, curveSizeBytes
|
||||
, CurveParameters(..)
|
||||
-- * Specific curves definition
|
||||
-- * specific curves definition
|
||||
, SEC_p112r1(..)
|
||||
, SEC_p112r2(..)
|
||||
, SEC_p128r1(..)
|
||||
@ -84,28 +83,28 @@ data CurveParameters curve = CurveParameters
|
||||
, curveEccG :: Point curve -- ^ base point
|
||||
, curveEccN :: Integer -- ^ order of G
|
||||
, curveEccH :: Integer -- ^ cofactor
|
||||
} deriving (Show,Eq,Data)
|
||||
} deriving (Show,Eq,Data,Typeable)
|
||||
|
||||
newtype CurveBinaryParam = CurveBinaryParam Integer
|
||||
deriving (Show,Read,Eq,Data)
|
||||
deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
newtype CurvePrimeParam = CurvePrimeParam Integer
|
||||
deriving (Show,Read,Eq,Data)
|
||||
deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
data CurveType =
|
||||
CurveBinary CurveBinaryParam
|
||||
| CurvePrime CurvePrimeParam
|
||||
deriving (Show,Read,Eq,Data)
|
||||
deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
-- | ECC Private Number
|
||||
newtype Scalar curve = Scalar Integer
|
||||
deriving (Show,Read,Eq,Data,NFData)
|
||||
deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
-- | Define a point on a curve.
|
||||
data Point curve =
|
||||
Point Integer Integer
|
||||
| PointO -- ^ Point at Infinity
|
||||
deriving (Show,Read,Eq,Data)
|
||||
deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
instance NFData (Point curve) where
|
||||
rnf (Point x y) = x `seq` y `seq` ()
|
||||
|
||||
@ -8,7 +8,6 @@
|
||||
-- Cryptographic Error enumeration and handling
|
||||
--
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Crypto.Error.Types
|
||||
( CryptoError(..)
|
||||
, CryptoFailable(..)
|
||||
@ -22,14 +21,13 @@ module Crypto.Error.Types
|
||||
import qualified Control.Exception as E
|
||||
import Data.Data
|
||||
|
||||
import Basement.Monad (MonadFailure(..))
|
||||
import Crypto.Internal.Imports
|
||||
|
||||
-- | 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
|
||||
@ -42,7 +40,6 @@ data CryptoError =
|
||||
| CryptoError_PointFormatInvalid
|
||||
| CryptoError_PointFormatUnsupported
|
||||
| CryptoError_PointCoordinatesInvalid
|
||||
| CryptoError_ScalarMultiplicationInvalid
|
||||
-- Message authentification error
|
||||
| CryptoError_MacKeyInvalid
|
||||
| CryptoError_AuthenticationTagSizeInvalid
|
||||
@ -52,7 +49,7 @@ data CryptoError =
|
||||
| CryptoError_SaltTooSmall
|
||||
| CryptoError_OutputLengthTooSmall
|
||||
| CryptoError_OutputLengthTooBig
|
||||
deriving (Show,Eq,Enum,Data)
|
||||
deriving (Show,Eq,Enum,Data,Typeable)
|
||||
|
||||
instance E.Exception CryptoError
|
||||
|
||||
@ -82,16 +79,12 @@ instance Applicative CryptoFailable where
|
||||
pure a = CryptoPassed a
|
||||
(<*>) fm m = fm >>= \p -> m >>= \r2 -> return (p r2)
|
||||
instance Monad CryptoFailable where
|
||||
return = pure
|
||||
return a = CryptoPassed a
|
||||
(>>=) 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
|
||||
|
||||
126
Crypto/Hash.hs
126
Crypto/Hash.hs
@ -16,8 +16,6 @@
|
||||
-- > hexSha3_512 :: ByteString -> String
|
||||
-- > hexSha3_512 bs = show (hash bs :: Digest SHA3_512)
|
||||
--
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Crypto.Hash
|
||||
(
|
||||
-- * Types
|
||||
@ -25,110 +23,77 @@ module Crypto.Hash
|
||||
, Digest
|
||||
-- * Functions
|
||||
, digestFromByteString
|
||||
-- * Hash methods parametrized by algorithm
|
||||
-- * hash methods parametrized by algorithm
|
||||
, hashInitWith
|
||||
, hashWith
|
||||
, hashPrefixWith
|
||||
-- * Hash methods
|
||||
-- * hash methods
|
||||
, hashInit
|
||||
, hashUpdates
|
||||
, hashUpdate
|
||||
, hashFinalize
|
||||
, hashFinalizePrefix
|
||||
, hashBlockSize
|
||||
, hashDigestSize
|
||||
, hash
|
||||
, hashPrefix
|
||||
, hashlazy
|
||||
, hashPutContext
|
||||
, hashGetContext
|
||||
-- * Hash algorithms
|
||||
, module Crypto.Hash.Algorithms
|
||||
) where
|
||||
|
||||
import Basement.Types.OffsetSize (CountOf (..))
|
||||
import Basement.Block (Block, unsafeFreeze)
|
||||
import Basement.Block.Mutable (copyFromPtr, new)
|
||||
import Crypto.Internal.Compat (unsafeDoIO)
|
||||
import Control.Monad
|
||||
import Crypto.Hash.Types
|
||||
import Crypto.Hash.Algorithms
|
||||
import Foreign.Ptr (Ptr, plusPtr)
|
||||
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)
|
||||
import Foreign.Ptr (Ptr)
|
||||
import Crypto.Internal.ByteArray (ByteArrayAccess)
|
||||
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 :: forall a . HashAlgorithm a => Context a
|
||||
hashInit = Context $ B.allocAndFreeze (hashInternalContextSize (undefined :: a)) $ \(ptr :: Ptr (Context a)) ->
|
||||
hashInternalInit ptr
|
||||
hashInit :: HashAlgorithm a
|
||||
=> Context a
|
||||
hashInit = doInit undefined B.allocAndFreeze
|
||||
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
|
||||
| B.null b = ctx
|
||||
| otherwise = hashUpdates ctx [b]
|
||||
hashUpdate ctx b = hashUpdates ctx [b]
|
||||
|
||||
-- | Update the context with a list of strict bytestring,
|
||||
-- and return a new context with the updates.
|
||||
hashUpdates :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba)
|
||||
hashUpdates :: (HashAlgorithm a, ByteArrayAccess ba)
|
||||
=> Context a
|
||||
-> [ba]
|
||||
-> Context a
|
||||
hashUpdates c l
|
||||
| null ls = c
|
||||
| otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) ->
|
||||
mapM_ (\b -> B.withByteArray b (processBlocks ctx (B.length b))) ls
|
||||
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))
|
||||
hashUpdates c l = doUpdates (B.copyAndFreeze c)
|
||||
where doUpdates :: HashAlgorithm a => ((Ptr (Context a) -> IO ()) -> B.Bytes) -> Context a
|
||||
doUpdates copy = Context $ copy $ \ctx ->
|
||||
mapM_ (\b -> B.withByteArray b $ \d -> hashInternalUpdate ctx d (fromIntegral $ B.length b)) l
|
||||
{-# NOINLINE hashUpdates #-}
|
||||
|
||||
-- | Finalize a context and return a digest.
|
||||
hashFinalize :: forall a . HashAlgorithm a
|
||||
hashFinalize :: HashAlgorithm a
|
||||
=> Context a
|
||||
-> Digest a
|
||||
hashFinalize !c =
|
||||
Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do
|
||||
((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig
|
||||
return ()
|
||||
|
||||
-- | Update the context with the first N bytes of a bytestring and return the
|
||||
-- digest. The code path is independent from N but much slower than a normal
|
||||
-- 'hashUpdate'. The function can be called for the last bytes of a message, in
|
||||
-- order to exclude a variable padding, without leaking the padding length. The
|
||||
-- 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 ()
|
||||
hashFinalize c = doFinalize undefined (B.copy c) (B.allocAndFreeze)
|
||||
where doFinalize :: HashAlgorithm alg
|
||||
=> alg
|
||||
-> ((Ptr (Context alg) -> IO ()) -> IO B.Bytes)
|
||||
-> (Int -> (Ptr (Digest alg) -> IO ()) -> B.Bytes)
|
||||
-> Digest alg
|
||||
doFinalize alg copy allocDigest =
|
||||
Digest $ allocDigest (hashDigestSize alg) $ \dig ->
|
||||
(void $ copy $ \ctx -> hashInternalFinalize ctx dig)
|
||||
{-# NOINLINE hashFinalize #-}
|
||||
|
||||
-- | Initialize a new context for a specified hash algorithm
|
||||
hashInitWith :: HashAlgorithm alg => alg -> Context alg
|
||||
@ -138,39 +103,14 @@ 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 :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a)
|
||||
digestFromByteString :: (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a)
|
||||
digestFromByteString = from undefined
|
||||
where
|
||||
from :: a -> ba -> Maybe (Digest a)
|
||||
from :: (HashAlgorithm a, ByteArrayAccess ba) => a -> ba -> Maybe (Digest a)
|
||||
from alg bs
|
||||
| B.length bs == (hashDigestSize alg) = Just $ Digest $ unsafeDoIO $ copyBytes bs
|
||||
| B.length bs == (hashDigestSize alg) = (Just $ Digest $ B.convert 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
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
-- |
|
||||
-- Module : Crypto.Hash.Algorithms
|
||||
-- License : BSD-style
|
||||
@ -9,9 +10,7 @@
|
||||
--
|
||||
module Crypto.Hash.Algorithms
|
||||
( HashAlgorithm
|
||||
, HashAlgorithmPrefix
|
||||
, HashAlgorithmResumable
|
||||
-- * Hash algorithms
|
||||
-- * hash algorithms
|
||||
, Blake2s_160(..)
|
||||
, Blake2s_224(..)
|
||||
, Blake2s_256(..)
|
||||
@ -43,10 +42,10 @@ module Crypto.Hash.Algorithms
|
||||
, SHA3_256(..)
|
||||
, SHA3_384(..)
|
||||
, SHA3_512(..)
|
||||
#if MIN_VERSION_base(4,7,0)
|
||||
, SHAKE128(..)
|
||||
, SHAKE256(..)
|
||||
, Blake2b(..), Blake2bp(..)
|
||||
, Blake2s(..), Blake2sp(..)
|
||||
#endif
|
||||
, Skein256_224(..)
|
||||
, Skein256_256(..)
|
||||
, Skein512_224(..)
|
||||
@ -56,7 +55,7 @@ module Crypto.Hash.Algorithms
|
||||
, Whirlpool(..)
|
||||
) where
|
||||
|
||||
import Crypto.Hash.Types (HashAlgorithm, HashAlgorithmPrefix, HashAlgorithmResumable)
|
||||
import Crypto.Hash.Types (HashAlgorithm)
|
||||
import Crypto.Hash.Blake2s
|
||||
import Crypto.Hash.Blake2sp
|
||||
import Crypto.Hash.Blake2b
|
||||
@ -77,5 +76,6 @@ import Crypto.Hash.Tiger
|
||||
import Crypto.Hash.Skein256
|
||||
import Crypto.Hash.Skein512
|
||||
import Crypto.Hash.Whirlpool
|
||||
#if MIN_VERSION_base(4,7,0)
|
||||
import Crypto.Hash.SHAKE
|
||||
import Crypto.Hash.Blake2
|
||||
#endif
|
||||
|
||||
@ -1,162 +0,0 @@
|
||||
-- |
|
||||
-- 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 ()
|
||||
@ -5,13 +5,11 @@
|
||||
-- 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_160 (..), Blake2b_224 (..), Blake2b_256 (..), Blake2b_384 (..), Blake2b_512 (..)
|
||||
) where
|
||||
@ -19,80 +17,66 @@ module Crypto.Hash.Blake2b
|
||||
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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
hashInternalContextSize _ = 361
|
||||
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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
hashInternalContextSize _ = 361
|
||||
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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
hashInternalContextSize _ = 361
|
||||
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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
hashInternalContextSize _ = 361
|
||||
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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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 _ = 248
|
||||
hashInternalContextSize _ = 361
|
||||
hashInternalInit p = c_blake2b_init p 512
|
||||
hashInternalUpdate = c_blake2b_update
|
||||
hashInternalFinalize p = c_blake2b_finalize p 512
|
||||
|
||||
@ -5,13 +5,11 @@
|
||||
-- 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
|
||||
@ -19,30 +17,28 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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 _ = 1768
|
||||
hashInternalInit p = c_blake2bp_init p 512
|
||||
hashInternalUpdate = c_blake2bp_update
|
||||
hashInternalFinalize p = c_blake2bp_finalize p 512
|
||||
hashInternalContextSize _ = 2325
|
||||
hashInternalInit p = c_blake2sp_init p 512
|
||||
hashInternalUpdate = c_blake2sp_update
|
||||
hashInternalFinalize p = c_blake2sp_finalize p 512
|
||||
|
||||
|
||||
foreign import ccall unsafe "cryptonite_blake2bp_init"
|
||||
c_blake2bp_init :: Ptr (Context a) -> Word32 -> IO ()
|
||||
foreign import ccall unsafe "cryptonite_blake2sp_init"
|
||||
c_blake2sp_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 "cryptonite_blake2sp_update"
|
||||
c_blake2sp_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 ()
|
||||
foreign import ccall unsafe "cryptonite_blake2sp_finalize"
|
||||
c_blake2sp_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
|
||||
|
||||
@ -5,13 +5,11 @@
|
||||
-- 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_160 (..), Blake2s_224 (..), Blake2s_256 (..)
|
||||
) where
|
||||
@ -19,50 +17,42 @@ module Crypto.Hash.Blake2s
|
||||
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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
hashInternalContextSize _ = 185
|
||||
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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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 _ = 136
|
||||
hashInternalContextSize _ = 185
|
||||
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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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 _ = 136
|
||||
hashInternalContextSize _ = 185
|
||||
hashInternalInit p = c_blake2s_init p 256
|
||||
hashInternalUpdate = c_blake2s_update
|
||||
hashInternalFinalize p = c_blake2s_finalize p 256
|
||||
|
||||
@ -5,13 +5,11 @@
|
||||
-- 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
|
||||
@ -19,35 +17,30 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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 _ = 1752
|
||||
hashInternalContextSize _ = 2185
|
||||
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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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 _ = 1752
|
||||
hashInternalContextSize _ = 2185
|
||||
hashInternalInit p = c_blake2sp_init p 256
|
||||
hashInternalUpdate = c_blake2sp_update
|
||||
hashInternalFinalize p = c_blake2sp_finalize p 256
|
||||
|
||||
@ -8,7 +8,6 @@
|
||||
-- Generalized impure cryptographic hash interface
|
||||
--
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Crypto.Hash.IO
|
||||
( HashAlgorithm(..)
|
||||
, MutableContext
|
||||
@ -24,11 +23,6 @@ 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)
|
||||
|
||||
@ -57,10 +51,18 @@ 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 :: forall a . HashAlgorithm a => MutableContext a -> IO (Digest a)
|
||||
hashMutableFinalize mc = do
|
||||
b <- B.alloc (hashDigestSize (undefined :: a)) $ \dig -> B.withByteArray mc $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig
|
||||
return $ Digest b
|
||||
hashMutableFinalize :: HashAlgorithm a => MutableContext a -> IO (Digest a)
|
||||
hashMutableFinalize mc = doFinalize undefined (B.withByteArray mc) B.alloc
|
||||
where doFinalize :: HashAlgorithm alg
|
||||
=> alg
|
||||
-> ((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 ()
|
||||
|
||||
@ -5,13 +5,11 @@
|
||||
-- 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
|
||||
@ -19,17 +17,15 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -37,18 +33,11 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -56,18 +45,11 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -75,18 +57,11 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -94,10 +69,6 @@ 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 ()
|
||||
@ -107,9 +78,3 @@ 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 ()
|
||||
|
||||
@ -5,28 +5,24 @@
|
||||
-- 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
instance HashAlgorithm MD2 where
|
||||
type HashBlockSize MD2 = 16
|
||||
type HashDigestSize MD2 = 16
|
||||
type HashInternalContextSize MD2 = 96
|
||||
hashBlockSize _ = 16
|
||||
hashDigestSize _ = 16
|
||||
hashInternalContextSize _ = 96
|
||||
|
||||
@ -5,28 +5,24 @@
|
||||
-- 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
instance HashAlgorithm MD4 where
|
||||
type HashBlockSize MD4 = 64
|
||||
type HashDigestSize MD4 = 16
|
||||
type HashInternalContextSize MD4 = 96
|
||||
hashBlockSize _ = 64
|
||||
hashDigestSize _ = 16
|
||||
hashInternalContextSize _ = 96
|
||||
|
||||
@ -5,28 +5,24 @@
|
||||
-- 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
instance HashAlgorithm MD5 where
|
||||
type HashBlockSize MD5 = 64
|
||||
type HashDigestSize MD5 = 16
|
||||
type HashInternalContextSize MD5 = 96
|
||||
hashBlockSize _ = 64
|
||||
hashDigestSize _ = 16
|
||||
hashInternalContextSize _ = 96
|
||||
@ -34,9 +30,6 @@ 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 ()
|
||||
|
||||
@ -45,6 +38,3 @@ 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 ()
|
||||
|
||||
@ -5,28 +5,24 @@
|
||||
-- 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
instance HashAlgorithm RIPEMD160 where
|
||||
type HashBlockSize RIPEMD160 = 64
|
||||
type HashDigestSize RIPEMD160 = 20
|
||||
type HashInternalContextSize RIPEMD160 = 128
|
||||
hashBlockSize _ = 64
|
||||
hashDigestSize _ = 20
|
||||
hashInternalContextSize _ = 128
|
||||
|
||||
@ -5,28 +5,24 @@
|
||||
-- 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
instance HashAlgorithm SHA1 where
|
||||
type HashBlockSize SHA1 = 64
|
||||
type HashDigestSize SHA1 = 20
|
||||
type HashInternalContextSize SHA1 = 96
|
||||
hashBlockSize _ = 64
|
||||
hashDigestSize _ = 20
|
||||
hashInternalContextSize _ = 96
|
||||
@ -34,9 +30,6 @@ 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 ()
|
||||
|
||||
@ -45,6 +38,3 @@ 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 ()
|
||||
|
||||
@ -5,28 +5,24 @@
|
||||
-- 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
instance HashAlgorithm SHA224 where
|
||||
type HashBlockSize SHA224 = 64
|
||||
type HashDigestSize SHA224 = 28
|
||||
type HashInternalContextSize SHA224 = 192
|
||||
hashBlockSize _ = 64
|
||||
hashDigestSize _ = 28
|
||||
hashInternalContextSize _ = 192
|
||||
@ -34,9 +30,6 @@ 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 ()
|
||||
|
||||
@ -45,6 +38,3 @@ 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 ()
|
||||
|
||||
@ -5,28 +5,24 @@
|
||||
-- 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
instance HashAlgorithm SHA256 where
|
||||
type HashBlockSize SHA256 = 64
|
||||
type HashDigestSize SHA256 = 32
|
||||
type HashInternalContextSize SHA256 = 192
|
||||
hashBlockSize _ = 64
|
||||
hashDigestSize _ = 32
|
||||
hashInternalContextSize _ = 192
|
||||
@ -34,9 +30,6 @@ 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 ()
|
||||
|
||||
@ -45,6 +38,3 @@ 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 ()
|
||||
|
||||
@ -5,13 +5,11 @@
|
||||
-- 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
|
||||
@ -19,17 +17,14 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -37,18 +32,11 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -56,18 +44,11 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -75,18 +56,11 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -94,11 +68,6 @@ 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 ()
|
||||
|
||||
@ -107,9 +76,3 @@ 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 ()
|
||||
|
||||
@ -5,28 +5,24 @@
|
||||
-- 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
instance HashAlgorithm SHA384 where
|
||||
type HashBlockSize SHA384 = 128
|
||||
type HashDigestSize SHA384 = 48
|
||||
type HashInternalContextSize SHA384 = 256
|
||||
hashBlockSize _ = 128
|
||||
hashDigestSize _ = 48
|
||||
hashInternalContextSize _ = 256
|
||||
@ -34,9 +30,6 @@ 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 ()
|
||||
|
||||
@ -45,6 +38,3 @@ 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 ()
|
||||
|
||||
@ -5,28 +5,24 @@
|
||||
-- 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
instance HashAlgorithm SHA512 where
|
||||
type HashBlockSize SHA512 = 128
|
||||
type HashDigestSize SHA512 = 64
|
||||
type HashInternalContextSize SHA512 = 256
|
||||
hashBlockSize _ = 128
|
||||
hashDigestSize _ = 64
|
||||
hashInternalContextSize _ = 256
|
||||
@ -34,9 +30,6 @@ 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 ()
|
||||
|
||||
@ -45,6 +38,3 @@ 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 ()
|
||||
|
||||
@ -5,13 +5,11 @@
|
||||
-- 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
|
||||
@ -19,17 +17,15 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -39,12 +35,9 @@ instance HashAlgorithm SHA512t_224 where
|
||||
|
||||
-- | SHA512t (256 bits) cryptographic hash algorithm
|
||||
data SHA512t_256 = SHA512t_256
|
||||
deriving (Show,Data)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
|
||||
@ -5,123 +5,78 @@
|
||||
-- Stability : experimental
|
||||
-- Portability : unknown
|
||||
--
|
||||
-- Module containing the binding functions to work with the
|
||||
-- module containing the binding functions to work with the
|
||||
-- SHA3 extendable output functions (SHAKE).
|
||||
--
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Crypto.Hash.SHAKE
|
||||
( SHAKE128 (..), SHAKE256 (..), HashSHAKE (..)
|
||||
( SHAKE128 (..), SHAKE256 (..)
|
||||
) 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 Foreign.Ptr (Ptr)
|
||||
import Data.Typeable
|
||||
import Data.Word (Word8, Word32)
|
||||
|
||||
import GHC.TypeLits (Nat, KnownNat, type (+))
|
||||
import Data.Proxy (Proxy(..))
|
||||
import GHC.TypeLits (Nat, KnownNat, natVal)
|
||||
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'.
|
||||
-- digest size (multiple of 8 bits), 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)
|
||||
deriving (Show, Typeable)
|
||||
|
||||
instance KnownNat bitlen => HashAlgorithm (SHAKE128 bitlen) where
|
||||
type HashBlockSize (SHAKE128 bitlen) = 168
|
||||
type HashDigestSize (SHAKE128 bitlen) = Div8 (bitlen + 7)
|
||||
type HashInternalContextSize (SHAKE128 bitlen) = 376
|
||||
instance (IsDivisibleBy8 bitLen, KnownNat bitLen) => HashAlgorithm (SHAKE128 bitLen) where
|
||||
hashBlockSize _ = 168
|
||||
hashDigestSize _ = byteLen (Proxy :: Proxy bitlen)
|
||||
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
|
||||
hashInternalFinalize = shakeFinalizeOutput (Proxy :: Proxy bitLen)
|
||||
|
||||
-- | SHAKE256 (256 bits) extendable output function. Supports an arbitrary
|
||||
-- digest size, to be specified as a type parameter of kind 'Nat'.
|
||||
-- digest size (multiple of 8 bits), 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)
|
||||
deriving (Show, Typeable)
|
||||
|
||||
instance KnownNat bitlen => HashAlgorithm (SHAKE256 bitlen) where
|
||||
type HashBlockSize (SHAKE256 bitlen) = 136
|
||||
type HashDigestSize (SHAKE256 bitlen) = Div8 (bitlen + 7)
|
||||
type HashInternalContextSize (SHAKE256 bitlen) = 344
|
||||
instance (IsDivisibleBy8 bitLen, KnownNat bitLen) => HashAlgorithm (SHAKE256 bitLen) where
|
||||
hashBlockSize _ = 136
|
||||
hashDigestSize _ = byteLen (Proxy :: Proxy bitlen)
|
||||
hashDigestSize _ = byteLen (Proxy :: Proxy bitLen)
|
||||
hashInternalContextSize _ = 344
|
||||
hashInternalInit p = c_sha3_init p 256
|
||||
hashInternalUpdate = c_sha3_update
|
||||
hashInternalFinalize = shakeFinalizeOutput (Proxy :: Proxy bitlen)
|
||||
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
|
||||
shakeFinalizeOutput :: (IsDivisibleBy8 bitLen, 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)
|
||||
c_sha3_output ctx dig (fromInteger (natVal d `div` 8))
|
||||
|
||||
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
|
||||
byteLen :: (KnownNat bitlen, IsDivisibleBy8 bitlen, Num a) => proxy bitlen -> a
|
||||
byteLen d = fromInteger (natVal d `div` 8)
|
||||
|
||||
foreign import ccall unsafe "cryptonite_sha3_init"
|
||||
c_sha3_init :: Ptr (Context a) -> Word32 -> IO ()
|
||||
@ -132,14 +87,5 @@ foreign import ccall "cryptonite_sha3_update"
|
||||
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 ()
|
||||
|
||||
@ -5,13 +5,11 @@
|
||||
-- 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
|
||||
@ -19,17 +17,15 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -39,12 +35,9 @@ instance HashAlgorithm Skein256_224 where
|
||||
|
||||
-- | Skein256 (256 bits) cryptographic hash algorithm
|
||||
data Skein256_256 = Skein256_256
|
||||
deriving (Show,Data)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
|
||||
@ -5,13 +5,11 @@
|
||||
-- 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
|
||||
@ -19,17 +17,15 @@ 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -39,12 +35,9 @@ instance HashAlgorithm Skein512_224 where
|
||||
|
||||
-- | Skein512 (256 bits) cryptographic hash algorithm
|
||||
data Skein512_256 = Skein512_256
|
||||
deriving (Show,Data)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -54,12 +47,9 @@ instance HashAlgorithm Skein512_256 where
|
||||
|
||||
-- | Skein512 (384 bits) cryptographic hash algorithm
|
||||
data Skein512_384 = Skein512_384
|
||||
deriving (Show,Data)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
@ -69,12 +59,9 @@ instance HashAlgorithm Skein512_384 where
|
||||
|
||||
-- | Skein512 (512 bits) cryptographic hash algorithm
|
||||
data Skein512_512 = Skein512_512
|
||||
deriving (Show,Data)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
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
|
||||
|
||||
@ -5,28 +5,24 @@
|
||||
-- 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
instance HashAlgorithm Tiger where
|
||||
type HashBlockSize Tiger = 64
|
||||
type HashDigestSize Tiger = 24
|
||||
type HashInternalContextSize Tiger = 96
|
||||
hashBlockSize _ = 64
|
||||
hashDigestSize _ = 24
|
||||
hashInternalContextSize _ = 96
|
||||
|
||||
@ -8,14 +8,8 @@
|
||||
-- Crypto hash types definitions
|
||||
--
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Crypto.Hash.Types
|
||||
( HashAlgorithm(..)
|
||||
, HashAlgorithmPrefix(..)
|
||||
, HashAlgorithmResumable(..)
|
||||
, Context(..)
|
||||
, Digest(..)
|
||||
) where
|
||||
@ -23,15 +17,7 @@ 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.
|
||||
--
|
||||
@ -39,13 +25,6 @@ import Data.Data (Data)
|
||||
-- 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
|
||||
@ -61,67 +40,19 @@ 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.
|
||||
--
|
||||
-- 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` ()
|
||||
newtype Digest a = Digest Bytes
|
||||
deriving (Eq,Ord,ByteArrayAccess,NFData)
|
||||
|
||||
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
|
||||
|
||||
@ -5,28 +5,24 @@
|
||||
-- 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)
|
||||
deriving (Show,Data,Typeable)
|
||||
|
||||
instance HashAlgorithm Whirlpool where
|
||||
type HashBlockSize Whirlpool = 64
|
||||
type HashDigestSize Whirlpool = 64
|
||||
type HashInternalContextSize Whirlpool = 168
|
||||
hashBlockSize _ = 64
|
||||
hashDigestSize _ = 64
|
||||
hashInternalContextSize _ = 168
|
||||
|
||||
@ -1,53 +0,0 @@
|
||||
-- |
|
||||
-- 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 ())
|
||||
@ -7,33 +7,13 @@
|
||||
--
|
||||
-- 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
|
||||
|
||||
@ -5,8 +5,8 @@
|
||||
-- Stability : stable
|
||||
-- Portability : Good
|
||||
--
|
||||
-- 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.
|
||||
-- This module try to keep all the difference between versions of base
|
||||
-- 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.
|
||||
-- 'unsafeDupablePerformIO' is used when possible as the
|
||||
-- | perform io for hashes that do allocation and ffi.
|
||||
-- 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
|
||||
|
||||
@ -5,11 +5,11 @@
|
||||
-- Stability : stable
|
||||
-- Portability : Compat
|
||||
--
|
||||
-- This module tries to keep all the difference between versions of ghc primitive
|
||||
-- This module try 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,21 +23,15 @@ 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
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 902
|
||||
import GHC.Prim
|
||||
#else
|
||||
import GHC.Prim hiding (Word32#)
|
||||
type Word32# = Word#
|
||||
#endif
|
||||
|
||||
-- | Byteswap Word# to or from Big Endian
|
||||
-- | byteswap Word# to or from Big Endian
|
||||
--
|
||||
-- On a big endian machine, this function is a nop.
|
||||
be32Prim :: Word32# -> Word32#
|
||||
-- on a big endian machine, this function is a nop.
|
||||
be32Prim :: Word# -> Word#
|
||||
#ifdef ARCH_IS_LITTLE_ENDIAN
|
||||
be32Prim = byteswap32Prim
|
||||
#elif defined(ARCH_IS_BIG_ENDIAN)
|
||||
@ -46,10 +40,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.
|
||||
le32Prim :: Word32# -> Word32#
|
||||
-- on a little endian machine, this function is a nop.
|
||||
le32Prim :: Word# -> Word#
|
||||
#ifdef ARCH_IS_LITTLE_ENDIAN
|
||||
le32Prim w = w
|
||||
#elif defined(ARCH_IS_BIG_ENDIAN)
|
||||
@ -60,14 +54,19 @@ 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 :: Word32# -> Word32#
|
||||
#if __GLASGOW_HASKELL__ >= 902
|
||||
byteswap32Prim w = wordToWord32# (byteSwap32# (word32ToWord# w))
|
||||
#else
|
||||
byteswap32Prim :: Word# -> Word#
|
||||
#if __GLASGOW_HASKELL__ >= 708
|
||||
byteswap32Prim w = byteSwap32# w
|
||||
#else
|
||||
byteswap32Prim 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)
|
||||
|
||||
@ -30,6 +30,4 @@ 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
|
||||
|
||||
@ -5,15 +5,11 @@
|
||||
-- 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)
|
||||
|
||||
@ -6,122 +6,12 @@
|
||||
{-# 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
|
||||
IsDiv8 bitLen 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")
|
||||
@ -131,15 +21,15 @@ type family IsDiv8 (bitLen :: Nat) (n :: Nat) where
|
||||
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
|
||||
IsDiv8 bitLen 1 = 'False
|
||||
IsDiv8 bitLen 2 = 'False
|
||||
IsDiv8 bitLen 3 = 'False
|
||||
IsDiv8 bitLen 4 = 'False
|
||||
IsDiv8 bitLen 5 = 'False
|
||||
IsDiv8 bitLen 6 = 'False
|
||||
IsDiv8 bitLen 7 = 'False
|
||||
#endif
|
||||
IsDiv8 _ n = IsDiv8 n (Mod8 n)
|
||||
IsDiv8 bitLen n = IsDiv8 n (Mod8 n)
|
||||
|
||||
type family Mod8 (n :: Nat) where
|
||||
Mod8 0 = 0
|
||||
@ -208,6 +98,4 @@ type family Mod8 (n :: Nat) where
|
||||
Mod8 63 = 7
|
||||
Mod8 n = Mod8 (n - 64)
|
||||
|
||||
-- | ensure the given `bitlen` is divisible by 8
|
||||
--
|
||||
type IsDivisibleBy8 bitLen = IsDiv8 bitLen bitLen ~ 'True
|
||||
|
||||
13
Crypto/Internal/Proxy.hs
Normal file
13
Crypto/Internal/Proxy.hs
Normal file
@ -0,0 +1,13 @@
|
||||
-- |
|
||||
-- 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
|
||||
@ -1,5 +1,5 @@
|
||||
-- |
|
||||
-- Module : Crypto.Internal.WordArray
|
||||
-- Module : Crypto.Internal.Compat
|
||||
-- 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,8 +20,6 @@ module Crypto.Internal.WordArray
|
||||
, MutableArray32
|
||||
, array8
|
||||
, array32
|
||||
, array32FromAddrBE
|
||||
, allocArray32AndFreeze
|
||||
, mutableArray32
|
||||
, array64
|
||||
, arrayRead8
|
||||
@ -60,21 +58,21 @@ array8 = Array8
|
||||
|
||||
-- | Create an Array of Word32 of specific size from a list of Word32
|
||||
array32 :: Int -> [Word32] -> Array32
|
||||
array32 n l = unsafeDoIO (mutableArray32 n l >>= mutableArray32Freeze)
|
||||
array32 (I# n) l = unsafeDoIO $ IO $ \s ->
|
||||
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 ->
|
||||
|
||||
@ -25,7 +25,7 @@ module Crypto.KDF.Argon2
|
||||
, hash
|
||||
) where
|
||||
|
||||
import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess)
|
||||
import Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess)
|
||||
import qualified Crypto.Internal.ByteArray as B
|
||||
import Crypto.Error
|
||||
import Control.Monad (when)
|
||||
@ -36,13 +36,13 @@ 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
|
||||
Argon2d -- ^ 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.
|
||||
| Argon2i -- ^ Argon2d is faster and uses data-depending memory access, which
|
||||
-- makes it suitable for cryptocurrencies and applications with no
|
||||
-- threats from side-channel timing 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
|
||||
@ -63,7 +63,7 @@ type TimeCost = Word32
|
||||
-- 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.
|
||||
-- \ 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
|
||||
@ -85,10 +85,8 @@ 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
|
||||
outputMaxLength = 0xffffffff
|
||||
|
||||
defaultOptions :: Options
|
||||
defaultOptions =
|
||||
|
||||
@ -11,7 +11,7 @@
|
||||
-- >>> validatePassword password bcryptHash
|
||||
-- >>> True
|
||||
-- >>> let otherPassword = B.pack "otherpassword"
|
||||
-- >>> otherHash <- hashPassword 12 otherPassword :: IO B.ByteString
|
||||
-- >>> otherHash <- hashPassword 12 otherPasssword :: IO B.ByteString
|
||||
-- >>> validatePassword otherPassword otherHash
|
||||
-- >>> True
|
||||
--
|
||||
@ -27,16 +27,13 @@
|
||||
-- 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 evolved to account for bugs in the standard
|
||||
-- C implementations. They don't represent different versions of the algorithm
|
||||
-- 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
|
||||
-- The different version numbers have evolved because of bugs in the standard
|
||||
-- C implementations. The most up to date version is @2b@ and this
|
||||
-- implementation 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) and less than 256
|
||||
-- characters long.
|
||||
-- if passwords are UTF-8 encoded (which they should be).
|
||||
--
|
||||
-- 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
|
||||
@ -52,16 +49,11 @@ module Crypto.KDF.BCrypt
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad (forM_, unless, when)
|
||||
import Crypto.Cipher.Blowfish.Primitive (Context, createKeySchedule,
|
||||
encrypt, expandKey,
|
||||
expandKeyWithSalt,
|
||||
freezeKeySchedule)
|
||||
import Crypto.Internal.Compat
|
||||
import Crypto.Random (MonadRandom, getRandomBytes)
|
||||
import Data.ByteArray (ByteArray, ByteArrayAccess,
|
||||
Bytes)
|
||||
import qualified Data.ByteArray as B
|
||||
import Control.Monad (unless, when)
|
||||
import Crypto.Cipher.Blowfish.Primitive (eksBlowfish, encrypt)
|
||||
import Crypto.Random (MonadRandom, getRandomBytes)
|
||||
import Data.ByteArray (ByteArrayAccess, ByteArray, Bytes)
|
||||
import qualified Data.ByteArray as B
|
||||
import Data.ByteArray.Encoding
|
||||
import Data.Char
|
||||
|
||||
@ -101,7 +93,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 'b'), dollar]
|
||||
header = B.pack [dollar, fromIntegral (ord '2'), fromIntegral (ord 'a'), dollar]
|
||||
dollar = fromIntegral (ord '$')
|
||||
zero = fromIntegral (ord '0')
|
||||
costBytes = B.pack [zero + fromIntegral (realCost `div` 10), zero + fromIntegral (realCost `mod` 10)]
|
||||
@ -141,7 +133,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 = expensiveBlowfishContext key salt cost
|
||||
ctx = eksBlowfish cost salt key
|
||||
|
||||
-- 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]
|
||||
@ -164,26 +156,10 @@ 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 + 10*costTens :: Int
|
||||
cost = costUnits + (if costTens == 0 then 0 else 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
|
||||
|
||||
@ -1,187 +0,0 @@
|
||||
-- |
|
||||
-- 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
|
||||
@ -24,7 +24,7 @@ import Data.Word
|
||||
import Data.Bits
|
||||
import Foreign.Marshal.Alloc
|
||||
import Foreign.Ptr (plusPtr, Ptr)
|
||||
import Foreign.C.Types (CUInt(..), CSize(..))
|
||||
import Foreign.C.Types (CUInt(..), CInt(..), CSize(..))
|
||||
|
||||
import Crypto.Hash (HashAlgorithm)
|
||||
import qualified Crypto.MAC.HMAC as HMAC
|
||||
|
||||
@ -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
|
||||
cipherIPT = expandIPT . blockSize where
|
||||
|
||||
-- Data type which represents the smallest irreducibule binary polynomial
|
||||
-- against specified degree.
|
||||
|
||||
@ -5,16 +5,15 @@
|
||||
-- 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
|
||||
@ -25,36 +24,28 @@ 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, ByteArrayAccess)
|
||||
import Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess)
|
||||
import qualified Crypto.Internal.ByteArray as B
|
||||
import Data.Memory.PtrMethods
|
||||
import Crypto.Internal.Compat
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Crypto.Internal.Imports
|
||||
|
||||
-- | Represent an HMAC 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.
|
||||
-- The Eq instance is constant time.
|
||||
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)
|
||||
|
||||
@ -1,144 +0,0 @@
|
||||
-- |
|
||||
-- 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)
|
||||
@ -33,11 +33,6 @@ 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)
|
||||
|
||||
|
||||
@ -8,7 +8,7 @@
|
||||
|
||||
module Crypto.Math.Polynomial
|
||||
( Monomial(..)
|
||||
-- * Polynomial operations
|
||||
-- * polynomial operations
|
||||
, Polynomial
|
||||
, toList
|
||||
, fromList
|
||||
|
||||
@ -13,15 +13,12 @@ module Crypto.Number.Basic
|
||||
, log2
|
||||
, numBits
|
||||
, numBytes
|
||||
, asPowerOf2AndOdd
|
||||
) where
|
||||
|
||||
import Data.Bits
|
||||
|
||||
import Crypto.Number.Compat
|
||||
|
||||
-- | @sqrti@ returns two integers @(l,b)@ so that @l <= sqrt i <= b@.
|
||||
-- The implementation is quite naive, use an approximation for the first number
|
||||
-- | sqrti returns two integer (l,b) so that l <= sqrt i <= b
|
||||
-- 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
|
||||
@ -52,7 +49,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
|
||||
--
|
||||
@ -66,7 +63,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
|
||||
|
||||
@ -101,16 +98,3 @@ 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)
|
||||
@ -22,9 +22,7 @@ module Crypto.Number.Compat
|
||||
, gmpSizeInBytes
|
||||
, gmpSizeInBits
|
||||
, gmpExportInteger
|
||||
, gmpExportIntegerLE
|
||||
, gmpImportInteger
|
||||
, gmpImportIntegerLE
|
||||
) where
|
||||
|
||||
#ifndef MIN_VERSION_integer_gmp
|
||||
@ -72,11 +70,7 @@ 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,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)
|
||||
#if 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)
|
||||
@ -105,9 +99,7 @@ gmpInverse _ _ = GmpUnsupported
|
||||
|
||||
-- | Get the next prime from a specific value through GMP
|
||||
gmpNextPrime :: Integer -> GmpSupported Integer
|
||||
#if MIN_VERSION_integer_gmp(1,1,0)
|
||||
gmpNextPrime _ = GmpUnsupported
|
||||
#elif MIN_VERSION_integer_gmp(0,5,1)
|
||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
||||
gmpNextPrime n = GmpSupported (nextPrimeInteger n)
|
||||
#else
|
||||
gmpNextPrime _ = GmpUnsupported
|
||||
@ -115,9 +107,7 @@ gmpNextPrime _ = GmpUnsupported
|
||||
|
||||
-- | Test if a number is prime using Miller Rabin
|
||||
gmpTestPrimeMillerRabin :: Int -> Integer -> GmpSupported Bool
|
||||
#if MIN_VERSION_integer_gmp(1,1,0)
|
||||
gmpTestPrimeMillerRabin _ _ = GmpUnsupported
|
||||
#elif MIN_VERSION_integer_gmp(0,5,1)
|
||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
||||
gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $
|
||||
case testPrimeInteger n tries of
|
||||
0# -> False
|
||||
@ -142,7 +132,7 @@ gmpSizeInBits n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 2#)))
|
||||
gmpSizeInBits _ = GmpUnsupported
|
||||
#endif
|
||||
|
||||
-- | Export an integer to a memory (big-endian)
|
||||
-- | Export an integer to a memory
|
||||
gmpExportInteger :: Integer -> Ptr Word8 -> GmpSupported (IO ())
|
||||
#if MIN_VERSION_integer_gmp(1,0,0)
|
||||
gmpExportInteger n (Ptr addr) = GmpSupported $ do
|
||||
@ -156,21 +146,7 @@ gmpExportInteger n (Ptr addr) = GmpSupported $ IO $ \s ->
|
||||
gmpExportInteger _ _ = GmpUnsupported
|
||||
#endif
|
||||
|
||||
-- | 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)
|
||||
-- | Import an integer from a memory
|
||||
gmpImportInteger :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
|
||||
#if MIN_VERSION_integer_gmp(1,0,0)
|
||||
gmpImportInteger (I# n) (Ptr addr) = GmpSupported $
|
||||
@ -181,15 +157,3 @@ 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
|
||||
|
||||
@ -16,15 +16,14 @@ 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
|
||||
@ -68,8 +67,8 @@ mulF2m :: BinaryPolynomial -- ^ Modulus
|
||||
mulF2m fx n1 n2
|
||||
| fx < 0
|
||||
|| n1 < 0
|
||||
|| n2 < 0 = error "mulF2m: negative number represent no binary polynomial"
|
||||
| fx == 0 = error "mulF2m: cannot multiply modulo zero polynomial"
|
||||
|| n2 < 0 = error "mulF2m: negative number represent no binary binary polynomial"
|
||||
| fx == 0 = error "modF2m: 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
|
||||
@ -98,37 +97,10 @@ squareF2m fx = modF2m fx . squareF2m'
|
||||
squareF2m' :: Integer
|
||||
-> Integer
|
||||
squareF2m' n
|
||||
| n < 0 = error "mulF2m: negative number represent no binary polynomial"
|
||||
| n < 0 = error "mulF2m: negative number represent no binary 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
|
||||
|
||||
@ -120,4 +120,6 @@ generateMax range
|
||||
|
||||
-- | generate a number between the inclusive bound [low,high].
|
||||
generateBetween :: MonadRandom m => Integer -> Integer -> m Integer
|
||||
generateBetween low high = (low +) <$> generateMax (high - low + 1)
|
||||
generateBetween low high
|
||||
| low == 1 = generateMax high >>= \r -> if r == 0 then generateBetween low high else return r
|
||||
| otherwise = (low +) <$> generateMax (high - low + 1)
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
-- |
|
||||
-- Module : Crypto.Number.ModArithmetic
|
||||
-- License : BSD-style
|
||||
@ -8,29 +9,26 @@
|
||||
|
||||
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)
|
||||
deriving (Show,Typeable)
|
||||
|
||||
instance Exception CoprimesAssertionError
|
||||
|
||||
-- | Compute the modular exponentiation of base^exponent using
|
||||
-- | Compute the modular exponentiation of base^exponant using
|
||||
-- algorithms design to avoid side channels and timing measurement
|
||||
--
|
||||
-- Modulo need to be odd otherwise the normal fast modular exponentiation
|
||||
@ -40,10 +38,11 @@ instance Exception CoprimesAssertionError
|
||||
-- from expFast, and thus provide the same unstudied and dubious
|
||||
-- timing and side channels claims.
|
||||
--
|
||||
-- Before GHC 8.4.2, powModSecInteger is missing from integer-gmp,
|
||||
-- so expSafe has the same security as expFast.
|
||||
-- with GHC 7.10, the powModSecInteger is missing from integer-gmp
|
||||
-- (which is now integer-gmp2), so is has the same security as old
|
||||
-- ghc version.
|
||||
expSafe :: Integer -- ^ base
|
||||
-> Integer -- ^ exponent
|
||||
-> Integer -- ^ exponant
|
||||
-> Integer -- ^ modulo
|
||||
-> Integer -- ^ result
|
||||
expSafe b e m
|
||||
@ -53,30 +52,30 @@ expSafe b e m
|
||||
| otherwise = gmpPowModInteger b e m `onGmpUnsupported`
|
||||
exponentiation b e m
|
||||
|
||||
-- | Compute the modular exponentiation of base^exponent using
|
||||
-- | Compute the modular exponentiation of base^exponant using
|
||||
-- the fastest algorithm without any consideration for
|
||||
-- hiding parameters.
|
||||
--
|
||||
-- Use this function when all the parameters are public,
|
||||
-- otherwise 'expSafe' should be preferred.
|
||||
-- otherwise 'expSafe' should be prefered.
|
||||
expFast :: Integer -- ^ base
|
||||
-> Integer -- ^ exponent
|
||||
-> Integer -- ^ exponant
|
||||
-> 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
|
||||
@ -85,133 +84,14 @@ inverse g m = gmpInverse g m `onGmpUnsupported` v
|
||||
| otherwise = Just (x `mod` m)
|
||||
(x,_,d) = gcde g m
|
||||
|
||||
-- | Compute the modular inverse of two coprime numbers.
|
||||
-- | Compute the modular inverse of 2 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
|
||||
-- will raise a 'CoprimesAssertionError'.
|
||||
-- if the numbers are not defined as coprime, this function
|
||||
-- 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'
|
||||
|
||||
@ -1,63 +0,0 @@
|
||||
-- |
|
||||
-- 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
|
||||
@ -19,6 +19,8 @@ module Crypto.Number.Prime
|
||||
, isCoprime
|
||||
) where
|
||||
|
||||
import Crypto.Internal.Imports
|
||||
|
||||
import Crypto.Number.Compat
|
||||
import Crypto.Number.Generate
|
||||
import Crypto.Number.Basic (sqrti, gcde)
|
||||
@ -29,10 +31,10 @@ import Crypto.Error
|
||||
|
||||
import Data.Bits
|
||||
|
||||
-- | Returns if the number is probably prime.
|
||||
-- First a list of small primes are implicitely tested for divisibility,
|
||||
-- | returns if the number is probably prime.
|
||||
-- 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
|
||||
@ -40,14 +42,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
|
||||
-- [2^(b-1)+2^(b-2), 2^b)).
|
||||
-- | generate a prime number of the required bitsize (i.e. in the range
|
||||
-- [2^(b-1)+2^(b-2), 2^b)).
|
||||
--
|
||||
-- May throw a 'CryptoError_PrimeSizeInvalid' if the requested size is less
|
||||
-- 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
|
||||
-- multiplied with another prime to create a key, it is guaranteed to be of
|
||||
-- the proper size.
|
||||
-- May throw a CryptoError_PrimeSizeInvalid if the requested size is less
|
||||
-- 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
|
||||
-- multiplied with another prime to create a key, it is guaranteed to be of
|
||||
-- the proper size.
|
||||
generatePrime :: MonadRandom m => Int -> m Integer
|
||||
generatePrime bits = do
|
||||
if bits < 5 then
|
||||
@ -59,13 +61,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
|
||||
@ -79,7 +81,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)
|
||||
@ -91,7 +93,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
|
||||
@ -127,7 +129,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 continuously, but just once.
|
||||
| otherwise = factorise (si+1) (vi `shiftR` 1) -- probably faster to not shift v continously, but just once.
|
||||
expmod = expSafe
|
||||
|
||||
-- when iteration reach zero, we have a probable prime
|
||||
@ -183,7 +185,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
|
||||
|
||||
@ -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,23 +19,22 @@ 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
|
||||
--
|
||||
-- The first byte is MSB (most significant byte); the last byte is the LSB (least significant byte)
|
||||
-- first byte is MSB (most significant byte), 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 takes an extra parameter for size.
|
||||
-- If the number is too big to fit in @len@ bytes, 'Nothing' is returned
|
||||
-- | just like i2osp, but take 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
|
||||
@ -45,10 +44,10 @@ i2ospOf len m
|
||||
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.
|
||||
-- | 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
|
||||
-- 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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -1,75 +0,0 @@
|
||||
-- |
|
||||
-- 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
|
||||
@ -1,54 +0,0 @@
|
||||
-- |
|
||||
-- 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
|
||||
@ -42,14 +42,15 @@ module Crypto.OTP
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Bits (shiftL, (.&.), (.|.))
|
||||
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
|
||||
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, Bytes)
|
||||
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)
|
||||
import qualified Crypto.Internal.ByteArray as B
|
||||
|
||||
|
||||
|
||||
@ -18,7 +18,7 @@ module Crypto.PubKey.Curve25519
|
||||
, dhSecret
|
||||
, publicKey
|
||||
, secretKey
|
||||
-- * Methods
|
||||
-- * methods
|
||||
, dh
|
||||
, toPublic
|
||||
, generateSecretKey
|
||||
@ -33,8 +33,9 @@ import GHC.Ptr
|
||||
import Crypto.Error
|
||||
import Crypto.Internal.Compat
|
||||
import Crypto.Internal.Imports
|
||||
import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes, Bytes, withByteArray)
|
||||
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes, Bytes, withByteArray)
|
||||
import qualified Crypto.Internal.ByteArray as B
|
||||
import Crypto.Error (CryptoFailable(..))
|
||||
import Crypto.Random
|
||||
|
||||
-- | A Curve25519 Secret key
|
||||
@ -91,10 +92,7 @@ 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.
|
||||
--
|
||||
-- This implementation may return an all-zero value as it does not check for
|
||||
-- the condition.
|
||||
-- | Compute the Diffie Hellman secret from a public key and a secret key
|
||||
dh :: PublicKey -> SecretKey -> DhSecret
|
||||
dh (PublicKey pub) (SecretKey sec) = DhSecret <$>
|
||||
B.allocAndFreeze 32 $ \result ->
|
||||
|
||||
@ -7,11 +7,8 @@
|
||||
--
|
||||
-- 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
|
||||
@ -20,7 +17,7 @@ module Crypto.PubKey.Curve448
|
||||
, dhSecret
|
||||
, publicKey
|
||||
, secretKey
|
||||
-- * Methods
|
||||
-- * methods
|
||||
, dh
|
||||
, toPublic
|
||||
, generateSecretKey
|
||||
@ -28,6 +25,7 @@ module Crypto.PubKey.Curve448
|
||||
|
||||
import Data.Word
|
||||
import Foreign.Ptr
|
||||
import GHC.Ptr
|
||||
|
||||
import Crypto.Error
|
||||
import Crypto.Random
|
||||
@ -77,16 +75,13 @@ 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.
|
||||
--
|
||||
-- This implementation may return an all-zero value as it does not check for
|
||||
-- the condition.
|
||||
-- | Compute the Diffie Hellman secret from a public key and a secret key
|
||||
dh :: PublicKey -> SecretKey -> DhSecret
|
||||
dh (PublicKey pub) (SecretKey sec) = DhSecret <$>
|
||||
B.allocAndFreeze x448_bytes $ \result ->
|
||||
withByteArray sec $ \psec ->
|
||||
withByteArray pub $ \ppub ->
|
||||
decaf_x448 result ppub psec
|
||||
ccryptonite_ed448 result psec ppub
|
||||
{-# NOINLINE dh #-}
|
||||
|
||||
-- | Create a public key from a secret key
|
||||
@ -94,7 +89,9 @@ toPublic :: SecretKey -> PublicKey
|
||||
toPublic (SecretKey sec) = PublicKey <$>
|
||||
B.allocAndFreeze x448_bytes $ \result ->
|
||||
withByteArray sec $ \psec ->
|
||||
decaf_x448_derive_public_key result psec
|
||||
ccryptonite_ed448 result psec basePoint
|
||||
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.
|
||||
@ -104,13 +101,8 @@ generateSecretKey = SecretKey <$> getRandomBytes x448_bytes
|
||||
x448_bytes :: Int
|
||||
x448_bytes = 448 `quot` 8
|
||||
|
||||
foreign import ccall "cryptonite_decaf_x448"
|
||||
decaf_x448 :: Ptr Word8 -- ^ public
|
||||
-> Ptr Word8 -- ^ basepoint
|
||||
-> Ptr Word8 -- ^ secret
|
||||
-> IO ()
|
||||
|
||||
foreign import ccall "cryptonite_decaf_x448_derive_public_key"
|
||||
decaf_x448_derive_public_key :: Ptr Word8 -- ^ public
|
||||
-> Ptr Word8 -- ^ secret
|
||||
-> IO ()
|
||||
foreign import ccall "cryptonite_x448"
|
||||
ccryptonite_ed448 :: Ptr Word8 -- ^ public
|
||||
-> Ptr Word8 -- ^ secret
|
||||
-> Ptr Word8 -- ^ basepoint
|
||||
-> IO ()
|
||||
|
||||
@ -33,22 +33,19 @@ data Params = Params
|
||||
{ params_p :: Integer
|
||||
, params_g :: Integer
|
||||
, params_bits :: Int
|
||||
} deriving (Show,Read,Eq,Data)
|
||||
|
||||
instance NFData Params where
|
||||
rnf (Params p g bits) = rnf p `seq` rnf g `seq` bits `seq` ()
|
||||
} deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
-- | Represent Diffie Hellman public number Y.
|
||||
newtype PublicNumber = PublicNumber Integer
|
||||
deriving (Show,Read,Eq,Enum,Real,Num,Ord,NFData)
|
||||
deriving (Show,Read,Eq,Enum,Real,Num,Ord)
|
||||
|
||||
-- | Represent Diffie Hellman private number X.
|
||||
newtype PrivateNumber = PrivateNumber Integer
|
||||
deriving (Show,Read,Eq,Enum,Real,Num,Ord,NFData)
|
||||
deriving (Show,Read,Eq,Enum,Real,Num,Ord)
|
||||
|
||||
-- | Represent Diffie Hellman shared secret.
|
||||
newtype SharedKey = SharedKey ScrubbedBytes
|
||||
deriving (Show,Eq,ByteArrayAccess,NFData)
|
||||
deriving (Show,Eq,ByteArrayAccess)
|
||||
|
||||
-- | 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)
|
||||
|
||||
@ -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,17 +28,18 @@ module Crypto.PubKey.DSA
|
||||
, toPrivateKey
|
||||
) where
|
||||
|
||||
|
||||
import Data.Data
|
||||
import Data.Maybe
|
||||
|
||||
import Crypto.Number.ModArithmetic (expFast, expSafe, inverse)
|
||||
import Crypto.Number.Generate
|
||||
import Crypto.Internal.ByteArray (ByteArrayAccess)
|
||||
import Crypto.Internal.Imports
|
||||
import Crypto.Hash
|
||||
import Crypto.PubKey.Internal (dsaTruncHash)
|
||||
import Crypto.Random.Types
|
||||
import Crypto.Random.Types
|
||||
import Data.Bits (testBit)
|
||||
import Data.Data
|
||||
import Data.Maybe
|
||||
import Crypto.Number.Basic (numBits)
|
||||
import Crypto.Number.ModArithmetic (expFast, expSafe, inverse)
|
||||
import Crypto.Number.Serialize
|
||||
import Crypto.Number.Generate
|
||||
import Crypto.Internal.ByteArray (ByteArrayAccess(length), convert, index, dropView, takeView)
|
||||
import Crypto.Internal.Imports
|
||||
import Crypto.Hash
|
||||
import Prelude hiding (length)
|
||||
|
||||
-- | DSA Public Number, usually embedded in DSA Public Key
|
||||
type PublicNumber = Integer
|
||||
@ -51,7 +52,7 @@ data Params = Params
|
||||
{ params_p :: Integer -- ^ DSA p
|
||||
, params_g :: Integer -- ^ DSA g
|
||||
, params_q :: Integer -- ^ DSA q
|
||||
} deriving (Show,Read,Eq,Data)
|
||||
} deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
instance NFData Params where
|
||||
rnf (Params p g q) = p `seq` g `seq` q `seq` ()
|
||||
@ -60,7 +61,7 @@ instance NFData Params where
|
||||
data Signature = Signature
|
||||
{ sign_r :: Integer -- ^ DSA r
|
||||
, sign_s :: Integer -- ^ DSA s
|
||||
} deriving (Show,Read,Eq,Data)
|
||||
} deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
instance NFData Signature where
|
||||
rnf (Signature r s) = r `seq` s `seq` ()
|
||||
@ -69,7 +70,7 @@ instance NFData Signature where
|
||||
data PublicKey = PublicKey
|
||||
{ public_params :: Params -- ^ DSA parameters
|
||||
, public_y :: PublicNumber -- ^ DSA public Y
|
||||
} deriving (Show,Read,Eq,Data)
|
||||
} deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
instance NFData PublicKey where
|
||||
rnf (PublicKey params y) = y `seq` params `seq` ()
|
||||
@ -81,14 +82,14 @@ instance NFData PublicKey where
|
||||
data PrivateKey = PrivateKey
|
||||
{ private_params :: Params -- ^ DSA parameters
|
||||
, private_x :: PrivateNumber -- ^ DSA private X
|
||||
} deriving (Show,Read,Eq,Data)
|
||||
} deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
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)
|
||||
deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
instance NFData KeyPair where
|
||||
rnf (KeyPair params y x) = x `seq` y `seq` params `seq` ()
|
||||
@ -125,7 +126,7 @@ signWith k pk hashAlg msg
|
||||
x = private_x pk
|
||||
-- compute r,s
|
||||
kInv = fromJust $ inverse k q
|
||||
hm = dsaTruncHash hashAlg msg q
|
||||
hm = os2ip $ hashWith hashAlg msg
|
||||
r = expSafe g k p `mod` q
|
||||
s = (kInv * (hm + x * r)) `mod` q
|
||||
|
||||
@ -147,8 +148,11 @@ verify hashAlg pk (Signature r s) m
|
||||
| otherwise = v == r
|
||||
where (Params p g q) = public_params pk
|
||||
y = public_y pk
|
||||
hm = dsaTruncHash hashAlg m q
|
||||
hm = os2ip . truncateHash $ hashWith hashAlg m
|
||||
|
||||
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
|
||||
|
||||
@ -11,46 +11,45 @@ module Crypto.PubKey.ECC.ECDSA
|
||||
, toPublicKey
|
||||
, toPrivateKey
|
||||
, signWith
|
||||
, signDigestWith
|
||||
, sign
|
||||
, signDigest
|
||||
, verify
|
||||
, verifyDigest
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Data
|
||||
|
||||
import Crypto.Hash
|
||||
import Crypto.Random.Types
|
||||
import Data.Bits (shiftR)
|
||||
import Crypto.Internal.ByteArray (ByteArrayAccess)
|
||||
import Data.Data
|
||||
import Crypto.Number.Basic (numBits)
|
||||
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.PubKey.Internal (dsaTruncHashDigest)
|
||||
import Crypto.Random.Types
|
||||
import Crypto.Hash
|
||||
import Crypto.Hash.Types (hashDigestSize)
|
||||
|
||||
-- | 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)
|
||||
} deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
-- | ECDSA Private Key.
|
||||
data PrivateKey = PrivateKey
|
||||
{ private_curve :: Curve
|
||||
, private_d :: PrivateNumber
|
||||
} deriving (Show,Read,Eq,Data)
|
||||
} deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
-- | ECDSA Public Key.
|
||||
data PublicKey = PublicKey
|
||||
{ public_curve :: Curve
|
||||
, public_q :: PublicPoint
|
||||
} deriving (Show,Read,Eq,Data)
|
||||
} deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
-- | ECDSA Key Pair.
|
||||
data KeyPair = KeyPair Curve PublicPoint PrivateNumber
|
||||
deriving (Show,Read,Eq,Data)
|
||||
deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
-- | Public key of a ECDSA Key pair.
|
||||
toPublicKey :: KeyPair -> PublicKey
|
||||
@ -60,26 +59,6 @@ toPublicKey (KeyPair curve pub _) = PublicKey curve pub
|
||||
toPrivateKey :: KeyPair -> PrivateKey
|
||||
toPrivateKey (KeyPair curve _ priv) = PrivateKey curve priv
|
||||
|
||||
-- | Sign digest using the private key and an explicit k number.
|
||||
--
|
||||
-- /WARNING:/ Vulnerable to timing attacks.
|
||||
signDigestWith :: HashAlgorithm hash
|
||||
=> Integer -- ^ k random number
|
||||
-> PrivateKey -- ^ private key
|
||||
-> Digest hash -- ^ digest to sign
|
||||
-> Maybe Signature
|
||||
signDigestWith k (PrivateKey curve d) digest = do
|
||||
let z = dsaTruncHashDigest digest n
|
||||
CurveCommon _ _ g n _ = common_curve curve
|
||||
let point = pointMul curve k g
|
||||
r <- case point of
|
||||
PointO -> Nothing
|
||||
Point x _ -> return $ x `mod` n
|
||||
kInv <- inverse k n
|
||||
let s = kInv * (z + r * d) `mod` n
|
||||
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.
|
||||
@ -89,35 +68,38 @@ signWith :: (ByteArrayAccess msg, HashAlgorithm hash)
|
||||
-> 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
|
||||
signWith k (PrivateKey curve d) hashAlg msg = do
|
||||
let z = tHash hashAlg msg n
|
||||
CurveCommon _ _ g n _ = common_curve curve
|
||||
let point = pointMul curve k g
|
||||
r <- case point of
|
||||
PointO -> Nothing
|
||||
Point x _ -> return $ x `mod` n
|
||||
kInv <- inverse k n
|
||||
let s = kInv * (z + r * d) `mod` n
|
||||
when (r == 0 || s == 0) Nothing
|
||||
return $ Signature r s
|
||||
|
||||
-- | 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 = signDigest pk (hashWith hashAlg msg)
|
||||
sign pk hashAlg msg = do
|
||||
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 digest using the public key.
|
||||
verifyDigest :: HashAlgorithm hash => PublicKey -> Signature -> Digest hash -> Bool
|
||||
verifyDigest (PublicKey _ PointO) _ _ = False
|
||||
verifyDigest pk@(PublicKey curve q) (Signature r s) digest
|
||||
-- | Verify a bytestring using the public key.
|
||||
verify :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> PublicKey -> Signature -> msg -> Bool
|
||||
verify _ (PublicKey _ PointO) _ _ = False
|
||||
verify hashAlg pk@(PublicKey curve q) (Signature r s) msg
|
||||
| r < 1 || r >= n || s < 1 || s >= n = False
|
||||
| otherwise = maybe False (r ==) $ do
|
||||
w <- inverse s n
|
||||
let z = dsaTruncHashDigest digest n
|
||||
let z = tHash hashAlg msg n
|
||||
u1 = z * w `mod` n
|
||||
u2 = r * w `mod` n
|
||||
x = pointAddTwoMuls curve u1 g u2 q
|
||||
@ -128,6 +110,10 @@ verifyDigest pk@(PublicKey curve q) (Signature r s) digest
|
||||
g = ecc_g cc
|
||||
cc = common_curve $ public_curve pk
|
||||
|
||||
-- | Verify a bytestring using the public key.
|
||||
verify :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> PublicKey -> Signature -> msg -> Bool
|
||||
verify hashAlg pk sig msg = verifyDigest pk sig (hashWith hashAlg msg)
|
||||
-- | Truncate and hash.
|
||||
tHash :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> msg -> Integer -> Integer
|
||||
tHash hashAlg m n
|
||||
| d > 0 = shiftR e d
|
||||
| otherwise = e
|
||||
where e = os2ip $ hashWith hashAlg m
|
||||
d = hashDigestSize hashAlg * 8 - numBits n
|
||||
|
||||
@ -8,37 +8,31 @@
|
||||
-- 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
|
||||
, unsafePointFromBinary
|
||||
-- * Scalar arithmetic
|
||||
-- * scalar arithmetic
|
||||
, scalarGenerate
|
||||
, scalarZero
|
||||
, scalarN
|
||||
, scalarIsZero
|
||||
, scalarAdd
|
||||
, scalarSub
|
||||
, scalarMul
|
||||
, scalarInv
|
||||
, scalarInvSafe
|
||||
, scalarCmp
|
||||
, scalarFromBinary
|
||||
, scalarToBinary
|
||||
@ -49,6 +43,7 @@ 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
|
||||
@ -62,11 +57,11 @@ import qualified Crypto.Number.Serialize as S (os2ip, i2ospOf)
|
||||
|
||||
-- | A P256 scalar
|
||||
newtype Scalar = Scalar ScrubbedBytes
|
||||
deriving (Show,Eq,ByteArrayAccess,NFData)
|
||||
deriving (Show,Eq,ByteArrayAccess)
|
||||
|
||||
-- | A P256 point
|
||||
newtype Point = Point Bytes
|
||||
deriving (Show,Eq,NFData)
|
||||
deriving (Show,Eq)
|
||||
|
||||
scalarSize :: Int
|
||||
scalarSize = 32
|
||||
@ -80,9 +75,6 @@ data P256Scalar
|
||||
data P256Y
|
||||
data P256X
|
||||
|
||||
order :: Integer
|
||||
order = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Point methods
|
||||
------------------------------------------------------------------------
|
||||
@ -113,27 +105,20 @@ 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 ->
|
||||
ccryptonite_p256e_point_mul n px py dx dy
|
||||
withScalar scalar $ \n -> withPoint p $ \px py -> withScalarZero $ \nzero ->
|
||||
ccryptonite_p256_points_mul_vartime nzero n px py dx dy
|
||||
|
||||
-- | Similar to 'pointMul', serializing the x coordinate as binary.
|
||||
-- When scalar is multiple of point order the result is all zero.
|
||||
-- | Similar to 'pointMul', serializing the x coordinate as binary
|
||||
pointDh :: ByteArray binary => Scalar -> Point -> binary
|
||||
pointDh scalar p =
|
||||
B.unsafeCreate scalarSize $ \dst -> withTempPoint $ \dx dy -> do
|
||||
withScalar scalar $ \n -> withPoint p $ \px py ->
|
||||
ccryptonite_p256e_point_mul n px py dx dy
|
||||
withScalar scalar $ \n -> withPoint p $ \px py -> withScalarZero $ \nzero ->
|
||||
ccryptonite_p256_points_mul_vartime nzero 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
|
||||
@ -152,19 +137,6 @@ 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 ->
|
||||
@ -200,19 +172,10 @@ 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 valid point
|
||||
-- | Convert from binary to a point
|
||||
pointFromBinary :: ByteArrayAccess ba => ba -> CryptoFailable Point
|
||||
pointFromBinary ba = unsafePointFromBinary ba >>= validatePoint
|
||||
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
|
||||
pointFromBinary 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)
|
||||
@ -235,39 +198,40 @@ 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 ->
|
||||
ccryptonite_p256e_modadd ccryptonite_SECP256r1_n pa pb d
|
||||
withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> do
|
||||
carry <- ccryptonite_p256_add 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 ->
|
||||
ccryptonite_p256e_modsub ccryptonite_SECP256r1_n pa pb d
|
||||
|
||||
-- | Perform multiplication between two scalars
|
||||
--
|
||||
-- > 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
|
||||
withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> do
|
||||
borrow <- ccryptonite_p256_sub pa pb d
|
||||
when (borrow /= 0) $ void $ ccryptonite_p256_add d ccryptonite_SECP256r1_n d
|
||||
--needReducing <- scalarNeedReducing d
|
||||
--when needReducing $ do
|
||||
-- ccryptonite_p256_mod ccryptonite_SECP256r1_n d d
|
||||
|
||||
-- | Give the inverse of the scalar
|
||||
--
|
||||
@ -279,14 +243,6 @@ 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 $
|
||||
@ -297,7 +253,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
|
||||
@ -336,11 +292,20 @@ withNewScalarFreeze f = Scalar $ B.allocAndFreeze scalarSize f
|
||||
{-# NOINLINE withNewScalarFreeze #-}
|
||||
|
||||
withTempPoint :: (Ptr P256X -> Ptr P256Y -> IO a) -> IO a
|
||||
withTempPoint f = allocTempScrubbed pointSize (\p -> let px = castPtr p in f px (pxToPy px))
|
||||
withTempPoint f = allocTempScrubbed scalarSize (\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
|
||||
@ -369,20 +334,18 @@ 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_p256e_modadd"
|
||||
ccryptonite_p256e_modadd :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO ()
|
||||
foreign import ccall "cryptonite_p256_add"
|
||||
ccryptonite_p256_add :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO CInt
|
||||
foreign import ccall "cryptonite_p256_add_d"
|
||||
ccryptonite_p256_add_d :: Ptr P256Scalar -> P256Digit -> Ptr P256Scalar -> IO CInt
|
||||
foreign import ccall "cryptonite_p256e_modsub"
|
||||
ccryptonite_p256e_modsub :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO ()
|
||||
foreign import ccall "cryptonite_p256_sub"
|
||||
ccryptonite_p256_sub :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO CInt
|
||||
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"
|
||||
@ -398,18 +361,6 @@ 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
|
||||
|
||||
@ -4,7 +4,6 @@
|
||||
module Crypto.PubKey.ECC.Prim
|
||||
( scalarGenerate
|
||||
, pointAdd
|
||||
, pointNegate
|
||||
, pointDouble
|
||||
, pointBaseMul
|
||||
, pointMul
|
||||
@ -31,9 +30,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 (CurveFP c) (Point x y) = Point x (ecc_p c - y)
|
||||
pointNegate CurveF2m{} (Point x y) = Point x (x `addF2m` y)
|
||||
pointNegate _ PointO = PointO
|
||||
pointNegate CurveFP{} (Point x y) = Point x (-y)
|
||||
pointNegate CurveF2m{} (Point x y) = Point x (x `addF2m` y)
|
||||
|
||||
-- | Elliptic Curve point addition.
|
||||
--
|
||||
|
||||
@ -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)
|
||||
deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
-- | 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)
|
||||
deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
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)
|
||||
deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
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)
|
||||
deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
-- | 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)
|
||||
} deriving (Show,Read,Eq,Data,Typeable)
|
||||
|
||||
-- | 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)
|
||||
deriving (Show,Read,Eq,Ord,Enum,Bounded,Data,Typeable)
|
||||
|
||||
{-
|
||||
curvesOIDs :: [ (CurveName, [Integer]) ]
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user