diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # haskell-nettle -This is the source repository for the "nettle" cabal package, which is a safe binding to the [nettle](http://www.lysator.liu.se/~nisse/nettle/nettle.html) library (tested with 3.1.1, might work with 3.0, does NOT WORK with 2.x). +This is the source repository for the "nettle" cabal package, which is a safe binding to the [nettle](http://www.lysator.liu.se/~nisse/nettle/nettle.html) library (tested with 3.9.1, 3.10.1, and 3.10.2, might work with 4.0. The binding supports all hash functions, cipher functions, cipher modes and keyed hash functions (apart from Poly1305-AES) included in nettle (additionally the AEAD-CCM cipher mode is implemented in pure haskell). diff --git a/nettle.cabal b/nettle.cabal --- a/nettle.cabal +++ b/nettle.cabal @@ -1,10 +1,10 @@ Cabal-Version: 2.0 Name: nettle -Version: 0.3.1.1 +Version: 0.4 Synopsis: safe nettle binding Description: safe binding for the nettle () library. - Tested with 3.4, might work with 3.2 (but not earlier). + Tested with 3.10.2, might work with 4.x. License: MIT License-file: COPYING Copyright: Stefan Bühler @@ -19,7 +19,7 @@ , src/nettle-hash.h , src/Tests/*.hs , src/Tests/KAT/*.hs -Tested-With: GHC ==9.8.1 || ==9.6.4 || ==9.4.8 || ==9.2.8 || ==9.0.2 || ==8.10.7 || ==8.8.4 +Tested-With: GHC ==9.14.1 || ==9.12.4 || ==9.10.3 || ==9.8.1 || ==9.6.4 || ==9.4.8 Flag UsePkgConfig Description: Use pkg-config to check for library dependences @@ -28,19 +28,24 @@ Library Default-Language: Haskell2010 hs-source-dirs: src - Build-Depends: base >= 4 && < 5 + Build-Depends: base >= 4.9 && < 5 , bytestring >= 0.10.8 && < 0.13 - , byteable >= 0.1.1 && < 0.2 + , crypton >= 1.1.0 && < 1.2 + , ram >= 0.20.1 && < 0.23 , tagged >= 0.8.5 && < 0.9 - , securemem >= 0.1.9 && < 0.2 - , crypto-cipher-types >= 0.0.3 && < 0.1 Exposed-modules: Crypto.Nettle.ChaChaPoly1305 Crypto.Nettle.Ciphers Crypto.Nettle.CCM + Crypto.Nettle.CMAC + Crypto.Nettle.EAX Crypto.Nettle.Hash Crypto.Nettle.KeyedHash Crypto.Nettle.HMAC + Crypto.Nettle.OCB + Crypto.Nettle.Poly1305 + Crypto.Nettle.SIV Crypto.Nettle.UMAC + Crypto.Nettle.XOF Other-modules: Crypto.Nettle.Ciphers.Internal Crypto.Nettle.Ciphers.ForeignImports Crypto.Nettle.Hash.ForeignImports @@ -50,7 +55,7 @@ include-dirs: src C-sources: src/nettle-ciphers.c if flag(UsePkgConfig) - PkgConfig-Depends: nettle + PkgConfig-Depends: nettle >= 3.9 else Extra-libraries: nettle @@ -59,15 +64,26 @@ type: exitcode-stdio-1.0 hs-source-dirs: src/Tests Main-Is: Ciphers.hs - Build-depends: base >= 4 && < 5 + Build-depends: base >= 4.9 && < 5 , bytestring >= 0.10.8 && < 0.13 + , crypton >= 1.1.0 && < 1.2 + , ram >= 0.20.1 && < 0.23 + , HUnit >= 1.6.0 && < 1.7 , QuickCheck >= 2 && < 3 , array >= 0.5.1 && < 0.6 , test-framework >= 0.3.3 && > 0.4 + , test-framework-hunit >= 0.3.0 && < 0.4 , test-framework-quickcheck2 >= 0.2.9 - , crypto-cipher-types >= 0.0.3 && < 0.1 - , crypto-cipher-tests >= 0.0.11 && < 0.1 , nettle + Other-modules: + Ciphers.KAT + Ciphers.PropertyTests + Ciphers.TestModes + Ciphers.Utils + HexUtils + KAT.AES + KAT.SM4 + KAT.Utils ghc-options: -fno-warn-tabs Test-Suite test-hashes @@ -75,7 +91,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: src/Tests Main-Is: Hash.hs - Build-depends: base >= 4 && < 5 + Build-depends: base >= 4.9 && < 5 , bytestring >= 0.10.8 && < 0.13 , tagged >= 0.8.5 && < 0.9 , array >= 0.5.1 && < 0.6 @@ -83,6 +99,10 @@ , HUnit >= 1.6.0 && < 1.7 , test-framework-hunit >= 0.3.0 && < 0.4 , nettle + Other-modules: + HexUtils + TestUtils + VectorsHash ghc-options: -fno-warn-tabs Test-Suite test-hmac @@ -90,7 +110,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: src/Tests Main-Is: HMAC.hs - Build-depends: base >= 4 && < 5 + Build-depends: base >= 4.9 && < 5 , bytestring >= 0.10.8 && < 0.13 , tagged >= 0.8.5 && < 0.9 , array >= 0.5.1 && < 0.6 @@ -98,6 +118,10 @@ , HUnit >= 1.6.0 && < 1.7 , test-framework-hunit >= 0.3.0 && < 0.4 , nettle + Other-modules: + HexUtils + TestUtils + VectorsHMAC ghc-options: -fno-warn-tabs Test-Suite test-umac @@ -105,7 +129,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: src/Tests Main-Is: UMAC.hs - Build-depends: base >= 4 && < 5 + Build-depends: base >= 4.9 && < 5 , bytestring >= 0.10.8 && < 0.13 , tagged >= 0.8.5 && < 0.9 , array >= 0.5.1 && < 0.6 @@ -113,8 +137,85 @@ , HUnit >= 1.6.0 && < 1.7 , test-framework-hunit >= 0.3.0 && < 0.4 , nettle + Other-modules: + HexUtils + TestUtils + VectorsUMAC ghc-options: -fno-warn-tabs +Test-Suite test-shake + Default-Language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: src/Tests + Main-Is: Shake.hs + Build-depends: base >= 4.9 && < 5 + , bytestring >= 0.10.8 && < 0.13 + , tagged >= 0.8.5 && < 0.9 + , array >= 0.5.1 && < 0.6 + , test-framework >= 0.3.3 && > 0.4 + , HUnit >= 1.6.0 && < 1.7 + , test-framework-hunit >= 0.3.0 && < 0.4 + , nettle + Other-modules: + HexUtils + Shake128 + TestUtils + ghc-options: -fno-warn-tabs + +Test-Suite test-mac + Default-Language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: src/Tests + Main-Is: MAC.hs + Build-depends: base >= 4.9 && < 5 + , bytestring >= 0.10.8 && < 0.13 + , tagged >= 0.8.5 && < 0.9 + , array >= 0.5.1 && < 0.6 + , test-framework >= 0.3.3 && > 0.4 + , HUnit >= 1.6.0 && < 1.7 + , test-framework-hunit >= 0.3.0 && < 0.4 + , nettle + Other-modules: + HexUtils + TestUtils + ghc-options: -fno-warn-tabs + +Test-Suite test-aead + Default-Language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: src/Tests + Main-Is: AEAD.hs + Build-depends: base >= 4.9 && < 5 + , bytestring >= 0.10.8 && < 0.13 + , tagged >= 0.8.5 && < 0.9 + , array >= 0.5.1 && < 0.6 + , test-framework >= 0.3.3 && > 0.4 + , HUnit >= 1.6.0 && < 1.7 + , test-framework-hunit >= 0.3.0 && < 0.4 + , nettle + Other-modules: + HexUtils + TestUtils + ghc-options: -fno-warn-tabs + +Test-Suite test-chacha-poly1305 + Default-Language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: src/Tests + Main-Is: ChaChaPoly1305.hs + Build-depends: base >= 4.9 && < 5 + , bytestring >= 0.10.8 && < 0.13 + , tagged >= 0.8.5 && < 0.9 + , array >= 0.5.1 && < 0.6 + , test-framework >= 0.3.3 && > 0.4 + , HUnit >= 1.6.0 && < 1.7 + , test-framework-hunit >= 0.3.0 && < 0.4 + , nettle + Other-modules: + HexUtils + TestUtils + ghc-options: -fno-warn-tabs + source-repository head type: git - location: git://github.com/stbuehler/haskell-nettle + location: https://github.com/stbuehler/haskell-nettle diff --git a/src/Crypto/Nettle/CCM.hs b/src/Crypto/Nettle/CCM.hs --- a/src/Crypto/Nettle/CCM.hs +++ b/src/Crypto/Nettle/CCM.hs @@ -38,11 +38,12 @@ , ccmInitTLS ) where - -import Crypto.Cipher.Types -import qualified Data.ByteString as B -import Data.Byteable +import qualified Crypto.Cipher.Types as CCT +import Crypto.Error +import qualified Data.ByteArray as BA +import Data.Maybe (fromJust) +import Crypto.Nettle.Ciphers.Internal import Nettle.Utils -- internal functions are not camelCase on purpose @@ -50,33 +51,37 @@ -- ccm needs a 128-bit block cipher -data CCM cipher - = CCM_Header (Int, Int, B.ByteString) B.ByteString - | CCM_Enc (Int, Int, B.ByteString) B.ByteString (IV cipher) B.ByteString - | CCM_Dec (Int, Int, B.ByteString) B.ByteString (IV cipher) B.ByteString +data CCM cipher message nonce + = CCM_Header (Int, Int, nonce) message + | CCM_Enc (Int, Int, nonce) message (CCT.IV cipher) message + | CCM_Dec (Int, Int, nonce) message (CCT.IV cipher) message {-| Start a CCM encryption with specified tag length @t@, length @q@ of the message length field and a @15-q@ bytes long @nonce@. Fails if any parameter is invalid or the block cipher doesn't use a 16-byte 'blockSize'. -} ccmInit - :: (BlockCipher cipher, Byteable iv) + :: (CCT.BlockCipher cipher, BA.ByteArrayAccess iv) => Int -- ^ tag length @t@ -> Int -- ^ length @q@ of the message length field -> cipher -- ^ cipher initialized with key -> iv -- ^ @nonce@ with length @15-q@ - -> Maybe (AEAD cipher) -ccmInit t q cipher nonce = ccm_init t q cipher nonce >>= Just . AEAD cipher . AEADState + -> CryptoFailable (CCT.AEAD cipher ) +ccmInit t q cipher nonce = ccm_init t q cipher nonce >>= \state -> (CryptoPassed $ CCT.AEAD {CCT.aeadModeImpl = nettle_aead_mode_impl cipher, CCT.aeadState = state}) -ccm_init :: (BlockCipher cipher, Byteable iv) => Int -> Int -> cipher -> iv -> Maybe (CCM cipher) -ccm_init t q cipher nonce = if valid then Just $ CCM_Header (t, q, toBytes nonce) B.empty else Nothing +ccm_init :: (CCT.BlockCipher cipher, BA.ByteArrayAccess iv) => Int -> Int -> cipher -> iv -> CryptoFailable (CCM cipher BA.ScrubbedBytes BA.ScrubbedBytes) +ccm_init t q cipher nonce = if valid then CryptoPassed $ CCM_Header (t, q, copyAndConvertToScrubbedBytes nonce) BA.empty else CryptoFailed reason where valid = valid_cipher && valid_t && valid_q && valid_nonce - valid_cipher = blockSize cipher == 16 + valid_cipher = CCT.blockSize cipher == 16 valid_t = t >= 4 && t <= 16 && even t valid_q = q >= 2 && q <= 8 nonce_len = 15 - q - valid_nonce = byteableLength nonce == fromIntegral nonce_len + valid_nonce = BA.length nonce == fromIntegral nonce_len + reason = if not valid_cipher then CryptoError_KeySizeInvalid + else if not valid_t then CryptoError_AuthenticationTagSizeInvalid + else if not valid_nonce then CryptoError_IvSizeInvalid + else CryptoError_AEADModeNotSupported {-| Start a CCM encryption with specified tag length @t = 16@, length @q = 3@ for the message length field and a @8@ bytes long @nonce@. @@ -84,64 +89,79 @@ This are the parameters used for TLS. -} ccmInitTLS - :: (BlockCipher cipher, Byteable iv) + :: (CCT.BlockCipher cipher, BA.ByteArrayAccess iv) => cipher -- ^ cipher initialized with key -> iv -- ^ 8 byte @nonce@ - -> Maybe (AEAD cipher) + -> CryptoFailable (CCT.AEAD cipher) ccmInitTLS = ccmInit 16 3 -ccm_encodeAdditionalLength :: B.ByteString -> B.ByteString -ccm_encodeAdditionalLength s = B.append (encLen $ B.length s) s where +ccm_encodeAdditionalLength :: BA.ByteArray ba => ba -> ba +ccm_encodeAdditionalLength s = BA.append (encLen $ BA.length s) s where encLen n - | n == 0 = B.empty - | n < (2^(16::Int)-2^(8::Int)) = B.pack $ netEncode 2 n - | n < (2^(32::Int)) = B.pack (0xff:0xfe:netEncode 4 n) - | otherwise = B.pack (0xff:0xff:netEncode 8 n) + | n == 0 = BA.empty + | n < (2^(16::Int)-2^(8::Int)) = BA.pack $ netEncode 2 n + | n < (2^(32::Int)) = BA.pack (0xff:0xfe:netEncode 4 n) + | otherwise = BA.pack (0xff:0xff:netEncode 8 n) -pad_zero :: Int -> B.ByteString -> B.ByteString -pad_zero l s = B.append s $ B.replicate (l - 1 - (B.length s - 1) `mod` l) 0 +pad_zero :: BA.ByteArray ba => Int -> ba -> ba +pad_zero l s = BA.append s $ BA.replicate (l - 1 - (BA.length s - 1) `mod` l) 0 -_makeIV :: BlockCipher cipher => B.ByteString -> IV cipher -_makeIV iv = let Just iv' = makeIV iv in iv' +_makeIV :: (CCT.BlockCipher cipher, BA.ByteArrayAccess ba) => ba -> CCT.IV cipher +_makeIV = fromJust . CCT.makeIV -ccm_start_iv :: BlockCipher cipher => (Int, Int, B.ByteString) -> IV cipher -ccm_start_iv (_, q, nonce) = _makeIV $ B.concat [B.singleton $ fromIntegral $ q - 1, nonce, B.replicate (q - 1) 0, B.singleton 1] +ccm_start_iv :: (CCT.BlockCipher cipher, BA.ByteArray bn) => (Int, Int, bn) -> CCT.IV cipher +ccm_start_iv (_, q, nonce) = _makeIV $ concatToScrubbedBytes [BA.singleton $ fromIntegral $ q - 1, nonce, BA.replicate (q - 1) 0, BA.singleton 1] -ccm_tag_iv :: BlockCipher cipher => (Int, Int, B.ByteString) -> IV cipher -ccm_tag_iv (_, q, nonce) = _makeIV $ B.concat [B.singleton $ fromIntegral $ q - 1, nonce, B.replicate q 0] +ccm_tag_iv :: (CCT.BlockCipher cipher, BA.ByteArray bn) => (Int, Int, bn) -> CCT.IV cipher +ccm_tag_iv (_, q, nonce) = _makeIV $ concatToScrubbedBytes [BA.singleton $ fromIntegral $ q - 1, nonce, BA.replicate q 0] -ccm_crypt :: BlockCipher cipher => cipher -> IV cipher -> B.ByteString -> (B.ByteString, IV cipher) +ccm_crypt :: (CCT.BlockCipher cipher, BA.ByteArray ba) => cipher -> CCT.IV cipher -> ba -> (ba, CCT.IV cipher) ccm_crypt key iv src = let - blocks = (B.length src + 15) `div` 16 - dst = ctrCombine key iv src - iv' = ivAdd iv blocks + blocks = (BA.length src + 15) `div` 16 + dst = CCT.ctrCombine key iv src + iv' = CCT.ivAdd iv blocks in (dst, iv') -ccm_tag :: BlockCipher cipher => cipher -> (Int, Int, B.ByteString) -> B.ByteString -> B.ByteString -> Int -> AuthTag +ccm_tag :: (CCT.BlockCipher cipher, BA.ByteArray ba, BA.ByteArray bn) => cipher -> (Int, Int, bn) -> ba -> ba -> Int -> CCT.AuthTag ccm_tag key (t, q, nonce) header msg taglen = let -- 64*(header != "") + 8*M' + L' - auth_flags = (if B.length header > 0 then 64 else 0) + 4*(fromIntegral t - 2) + (fromIntegral q - 1) - b0 = B.concat [B.singleton auth_flags, nonce, B.pack $ netEncode q $ B.length msg] - blocks = B.concat [b0, pad_zero 16 $ ccm_encodeAdditionalLength header, pad_zero 16 msg] - tag = fst $ ccm_crypt key (ccm_tag_iv (t, q, nonce)) $ B.drop (B.length blocks - 16) $ cbcEncrypt key nullIV blocks - in AuthTag $ B.take taglen tag + auth_flags = (if BA.length header > 0 then 64 else 0) + 4*(fromIntegral t - 2) + (fromIntegral q - 1) + b0 = BA.concat [BA.singleton auth_flags, nonce, BA.pack $ netEncode q $ BA.length msg] + blocks = BA.concat [b0, pad_zero 16 $ ccm_encodeAdditionalLength header, pad_zero 16 msg] + tag = fst $ ccm_crypt key (ccm_tag_iv (t, q, nonce)) $ BA.drop (BA.length blocks - 16) $ CCT.cbcEncrypt key CCT.nullIV blocks + in CCT.AuthTag $ BA.take taglen tag -instance BlockCipher cipher => AEADModeImpl cipher (CCM cipher) where - aeadStateAppendHeader _ (CCM_Header (t, q, nonce) header) src = CCM_Header (t, q, nonce) $ B.append header src - aeadStateAppendHeader _ _ _ = error "can't aeadStateAppendHeader anymore, already have real data" - aeadStateEncrypt key (CCM_Header (t, q, nonce) header) src = aeadStateEncrypt key (CCM_Enc (t, q, nonce) header iv B.empty) src - where iv = ccm_start_iv (t, q, nonce) - aeadStateEncrypt key (CCM_Enc (t, q, nonce) header iv msg) src = let - (dst, iv') = ccm_crypt key iv src - in (dst, CCM_Enc (t, q, nonce) header iv' $ B.append msg src) - aeadStateEncrypt _ _ _ = error "can't aeadStateEncrypt anymore, already is in decrypt mode" - aeadStateDecrypt key (CCM_Header (t, q, nonce) header) src = aeadStateDecrypt key (CCM_Dec (t, q, nonce) header iv B.empty) src - where iv = ccm_start_iv (t, q, nonce) - aeadStateDecrypt key (CCM_Dec (t, q, nonce) header iv msg) src = let - (dst, iv') = ccm_crypt key iv src - in (dst, CCM_Enc (t, q, nonce) header iv' $ B.append msg dst) - aeadStateDecrypt _ _ _ = error "can't aeadStateDecrypt anymore, already is in encrypt mode" - aeadStateFinalize key (CCM_Header (t, q, nonce) header ) taglen = ccm_tag key (t, q, nonce) header B.empty taglen - aeadStateFinalize key (CCM_Enc (t, q, nonce) header _ msg) taglen = ccm_tag key (t, q, nonce) header msg taglen - aeadStateFinalize key (CCM_Dec (t, q, nonce) header _ msg) taglen = ccm_tag key (t, q, nonce) header msg taglen + +nettle_ccm_aeadImplAppendHeader :: (CCT.BlockCipher cipher, BA.ByteArrayAccess msg, BA.ByteArray ba) => cipher -> (CCM cipher ba ba) -> msg -> (CCM cipher ba ba) +nettle_ccm_aeadImplAppendHeader _ (CCM_Header (t, q, nonce) header) src = CCM_Header (t, q, nonce) $ BA.append header (BA.convert src) +nettle_ccm_aeadImplAppendHeader _ _ _ = error "can't aeadStateAppendHeader anymore, already have real data" + +nettle_ccm_aeadImplEncrypt :: (CCT.BlockCipher cipher, BA.ByteArray msg, BA.ByteArray ba) => cipher -> (CCM cipher ba ba) -> msg -> (msg, (CCM cipher ba ba)) +nettle_ccm_aeadImplEncrypt key (CCM_Header (t, q, nonce) header) src = nettle_ccm_aeadImplEncrypt key (CCM_Enc (t, q, nonce) header iv BA.empty) src + where iv = ccm_start_iv (t, q, nonce) +nettle_ccm_aeadImplEncrypt key (CCM_Enc (t, q, nonce) header iv msg) src = let + (dst, iv') = ccm_crypt key iv src + in (dst, CCM_Enc (t, q, nonce) header iv' $ BA.append msg (BA.convert src)) +nettle_ccm_aeadImplEncrypt _ _ _ = error "can't aeadStateEncrypt anymore, already is in decrypt mode" + +nettle_ccm_aeadImplDecrypt :: (CCT.BlockCipher cipher, BA.ByteArray msg, BA.ByteArray ba) => cipher -> (CCM cipher ba ba) -> msg -> (msg, (CCM cipher ba ba)) +nettle_ccm_aeadImplDecrypt key (CCM_Header (t, q, nonce) header) src = nettle_ccm_aeadImplDecrypt key (CCM_Dec (t, q, nonce) header iv BA.empty) src + where iv = ccm_start_iv (t, q, nonce) +nettle_ccm_aeadImplDecrypt key (CCM_Dec (t, q, nonce) header iv msg) src = let + (dst, iv') = ccm_crypt key iv src + in (dst, CCM_Enc (t, q, nonce) header iv' $ BA.append msg (BA.convert dst)) +nettle_ccm_aeadImplDecrypt _ _ _ = error "can't aeadStateDecrypt anymore, already is in encrypt mode" + +nettle_ccm_aeadImplFinalize :: (CCT.BlockCipher cipher, BA.ByteArray msg, BA.ByteArray nonce) => cipher -> (CCM cipher msg nonce) -> Int -> CCT.AuthTag +nettle_ccm_aeadImplFinalize key (CCM_Header (t, q, nonce) header ) taglen = ccm_tag key (t, q, nonce) header BA.empty taglen +nettle_ccm_aeadImplFinalize key (CCM_Enc (t, q, nonce) header _ msg) taglen = ccm_tag key (t, q, nonce) header msg taglen +nettle_ccm_aeadImplFinalize key (CCM_Dec (t, q, nonce) header _ msg) taglen = ccm_tag key (t, q, nonce) header msg taglen + +instance (CCT.BlockCipher cipher, BA.ByteArray ba) => NettleAeadModeImpl cipher (CCM cipher ba ba) where + nettle_aead_mode_impl c = CCT.AEADModeImpl { + CCT.aeadImplAppendHeader = nettle_ccm_aeadImplAppendHeader c + , CCT.aeadImplEncrypt = nettle_ccm_aeadImplEncrypt c + , CCT.aeadImplDecrypt = nettle_ccm_aeadImplDecrypt c + , CCT.aeadImplFinalize = nettle_ccm_aeadImplFinalize c + } diff --git a/src/Crypto/Nettle/CMAC.hs b/src/Crypto/Nettle/CMAC.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Nettle/CMAC.hs @@ -0,0 +1,179 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} + +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +{- | +Module : Crypto.Nettle.CMAC +Copyright : (c) 2026 Clint Adams +License : MIT-style (see the file COPYING) + +Maintainer : clint@debian.org +Stability : experimental +Portability : portable + +This module exports CMAC (Cipher-based Message Authentication Code, +NIST SP 800-38B) algorithms supported by nettle: + +-} +module Crypto.Nettle.CMAC + ( -- * CMAC algorithms + CMAC_AES128 + , CMAC_AES256 + , CMAC_DES3 + , cmacInit + , cmacInit' + , cmac + , cmac' + ) where + +import qualified Data.ByteArray as BA +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B +import Data.Tagged + +import Crypto.Nettle.Hash.ForeignImports +import Crypto.Nettle.Hash.Types +import Nettle.Utils + +-- internal functions are not camelCase on purpose +{-# ANN module "HLint: ignore Use camelCase" #-} + +class NettleCMAC a where + cmac_ctx_size :: Tagged a Int + cmac_digest_size :: Tagged a Int + cmac_name :: Tagged a String + cmac_set_key :: Tagged a (Ptr Word8 -> Ptr Word8 -> IO ()) + cmac_update + :: Tagged a (Ptr Word8 -> Word -> Ptr Word8 -> IO ()) + cmac_digest :: Tagged a NettleHashDigest + cmac_ctx :: a -> AlignedContext + cmac_Ctx :: AlignedContext -> a + +nettleCMACInit :: NettleCMAC a => B.ByteString -> a +nettleCMACInit key = untagSelf $ do + size <- cmac_ctx_size + setkey <- cmac_set_key + return $ + cmac_Ctx $ + unsafeDupablePerformIO $ + alignedCtxCreate size $ \ctxptr -> + BA.withByteArray key $ \keyptr -> + setkey ctxptr keyptr +nettleCMACUpdate :: NettleCMAC a => a -> B.ByteString -> a +nettleCMACUpdate c msg = untagSelf $ do + size <- cmac_ctx_size + updatefun <- cmac_update + return $ + cmac_Ctx $ + unsafeDupablePerformIO $ + alignedCtxCopy (cmac_ctx c) size $ \ctxptr -> + withByteStringPtr msg $ \msglen msgptr -> + updatefun ctxptr msglen msgptr +nettleCMACFinalize :: NettleCMAC a => a -> B.ByteString +nettleCMACFinalize c = flip witness c $ do + let ctx = cmac_ctx c + digestSize <- cmac_digest_size + digestfun <- cmac_digest + return $ + unsafeDupablePerformIO $ + B.create digestSize $ \digestptr -> + BA.withByteArray (alignedCtxBuffer ctx) $ \ctxptr -> + callNettleHashDigest + digestfun + digestSize + (ctxptr `plusPtr` alignedCtxOffset ctx) + digestptr + +#define INSTANCE_CMAC(Typ) \ +instance NettleCMAC Typ => KeyedHashAlgorithm Typ where \ + { implKeyedHashDigestSize = cmac_digest_size \ + ; implKeyedHashName = cmac_name \ + ; implKeyedHashInit = nettleCMACInit \ + ; implKeyedHashUpdate = nettleCMACUpdate \ + ; implKeyedHashFinalize = nettleCMACFinalize \ + } + +-- | 'CMAC_AES128' is the CMAC algorithm based on AES-128 (NIST SP 800-38B), with a 16 byte (128 bit) key. +data CMAC_AES128 = CMAC_AES128 {cmac_aes128_ctx :: AlignedContext} + +instance NettleCMAC CMAC_AES128 where + cmac_ctx_size = Tagged c_cmac_aes128_ctx_size + cmac_digest_size = Tagged 16 + cmac_name = Tagged "CMAC-AES128" + cmac_set_key = Tagged c_cmac_aes128_set_key + cmac_update = Tagged c_cmac_aes128_update + cmac_digest = Tagged c_cmac_aes128_digest + cmac_ctx = cmac_aes128_ctx + cmac_Ctx = CMAC_AES128 +INSTANCE_CMAC (CMAC_AES128) + +-- | 'CMAC_AES256' is the CMAC algorithm based on AES-256 (NIST SP 800-38B), with a 32 byte (256 bit) key. +data CMAC_AES256 = CMAC_AES256 {cmac_aes256_ctx :: AlignedContext} + +instance NettleCMAC CMAC_AES256 where + cmac_ctx_size = Tagged c_cmac_aes256_ctx_size + cmac_digest_size = Tagged 16 + cmac_name = Tagged "CMAC-AES256" + cmac_set_key = Tagged c_cmac_aes256_set_key + cmac_update = Tagged c_cmac_aes256_update + cmac_digest = Tagged c_cmac_aes256_digest + cmac_ctx = cmac_aes256_ctx + cmac_Ctx = CMAC_AES256 +INSTANCE_CMAC (CMAC_AES256) + +-- | 'CMAC_DES3' is the CMAC algorithm based on 3DES (NIST SP 800-38B), with a 24 byte (192 bit) key. +data CMAC_DES3 = CMAC_DES3 {cmac_des3_ctx :: AlignedContext} + +instance NettleCMAC CMAC_DES3 where + cmac_ctx_size = Tagged c_cmac_des3_ctx_size + cmac_digest_size = Tagged 8 + cmac_name = Tagged "CMAC-DES3" + cmac_set_key = Tagged c_cmac_des3_set_key + cmac_update = Tagged c_cmac_des3_update + cmac_digest = Tagged c_cmac_des3_digest + cmac_ctx = cmac_des3_ctx + cmac_Ctx = CMAC_DES3 +INSTANCE_CMAC (CMAC_DES3) + +{- | +'cmacInit' initializes a 'KeyedHash' to calculate the CMAC for a message with the given @key@. +-} +cmacInit + :: KeyedHashAlgorithm a + => B.ByteString + -- ^ @key@ argument + -> Tagged a KeyedHash +cmacInit = keyedHashInit + +{- | +Untagged variant of 'cmacInit'; takes a (possible 'undefined') typed 'CMAC' context as parameter. +-} +cmacInit' + :: KeyedHashAlgorithm a => a -> B.ByteString -> KeyedHash +cmacInit' a key = cmacInit key `witness` a + +{- | +Calculate the CMAC for a @key@ and @message@. +-} +cmac + :: KeyedHashAlgorithm a + => B.ByteString + -- ^ @key@ argument + -> B.ByteString + -- ^ @message@ argument + -> Tagged a B.ByteString +cmac = keyedHash + +{- | +Untagged variant of 'cmac'; takes a (possible 'undefined') typed 'CMAC' context as parameter. +-} +cmac' + :: KeyedHashAlgorithm a + => a -> B.ByteString -> B.ByteString -> B.ByteString +cmac' a key msg = cmac key msg `witness` a diff --git a/src/Crypto/Nettle/ChaChaPoly1305.hs b/src/Crypto/Nettle/ChaChaPoly1305.hs --- a/src/Crypto/Nettle/ChaChaPoly1305.hs +++ b/src/Crypto/Nettle/ChaChaPoly1305.hs @@ -28,9 +28,9 @@ , chaChaPoly1305Decrypt ) where +import qualified Data.ByteArray as BA import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B -import Data.SecureMem import Crypto.Nettle.Ciphers.ForeignImports import Nettle.Utils @@ -47,21 +47,22 @@ -> B.ByteString -- ^ @plain@ data to encrypt -> (B.ByteString, B.ByteString) -- ^ returns (@cipher@, @tag@) ciphertext and verification tag chaChaPoly1305Encrypt key nonce aad plain = unsafeDupablePerformIO $ do - ctx <- allocateSecureMem c_chacha_poly1305_ctx_size + let k = copyAndConvertToScrubbedBytes key + n = copyAndConvertToScrubbedBytes nonce tag <- B.create 16 (\_ -> return ()) cipher <- B.create (B.length plain) (\_ -> return ()) - withByteStringPtr plain $ \psize pptr -> + _ <- withByteStringPtr plain $ \psize pptr -> withByteStringPtr aad $ \aadsize aadptr -> withByteStringPtr cipher $ \_ cipherptr -> withByteStringPtr tag $ \_ tagptr -> - withSecureMemPtr ctx $ \ctxptr -> - withSecureMemPtrSz (toSecureMem key) $ \ksize kptr -> if ksize /= 32 then error "Invalid key length" else - withSecureMemPtrSz (toSecureMem nonce) $ \nsize nptr -> if nsize /= 12 then error "Invalid nonce length" else do + withAlignedContext c_chacha_poly1305_ctx_size $ \ctxptr -> + BA.withByteArray k $ \kptr -> if (BA.length k) /= 32 then error "Invalid key length" else + BA.withByteArray n $ \nptr -> if (BA.length n) /= 12 then error "Invalid nonce length" else do c_chacha_poly1305_set_key ctxptr kptr c_chacha_poly1305_set_nonce ctxptr nptr c_chacha_poly1305_update ctxptr aadsize aadptr c_chacha_poly1305_encrypt ctxptr psize cipherptr pptr - c_chacha_poly1305_digest ctxptr 16 tagptr + callNettleChaChaPoly1305Digest ctxptr 16 tagptr return (cipher, tag) {-| @@ -70,19 +71,20 @@ -} chaChaPoly1305Decrypt :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString -> Maybe B.ByteString chaChaPoly1305Decrypt key nonce aad cipher verifytag = unsafeDupablePerformIO $ do - ctx <- allocateSecureMem c_chacha_poly1305_ctx_size + let k = copyAndConvertToScrubbedBytes key + n = copyAndConvertToScrubbedBytes nonce tag <- B.create 16 (\_ -> return ()) plain <- B.create (B.length cipher) (\_ -> return ()) - withByteStringPtr cipher $ \psize pptr -> + _ <- withByteStringPtr cipher $ \psize pptr -> withByteStringPtr aad $ \aadsize aadptr -> withByteStringPtr plain $ \_ plainptr -> withByteStringPtr tag $ \_ tagptr -> - withSecureMemPtr ctx $ \ctxptr -> - withSecureMemPtrSz (toSecureMem key) $ \ksize kptr -> if ksize /= 32 then error "Invalid key length" else - withSecureMemPtrSz (toSecureMem nonce) $ \nsize nptr -> if nsize /= 12 then error "Invalid nonce length" else do + withAlignedContext c_chacha_poly1305_ctx_size $ \ctxptr -> + BA.withByteArray k $ \kptr -> if (BA.length k) /= 32 then error "Invalid key length" else + BA.withByteArray n $ \nptr -> if (BA.length n) /= 12 then error "Invalid nonce length" else do c_chacha_poly1305_set_key ctxptr kptr c_chacha_poly1305_set_nonce ctxptr nptr c_chacha_poly1305_update ctxptr aadsize aadptr c_chacha_poly1305_decrypt ctxptr psize plainptr pptr - c_chacha_poly1305_digest ctxptr 16 tagptr + callNettleChaChaPoly1305Digest ctxptr 16 tagptr if B.take (B.length verifytag) tag == verifytag then return $ Just plain else return Nothing diff --git a/src/Crypto/Nettle/Ciphers.hs b/src/Crypto/Nettle/Ciphers.hs --- a/src/Crypto/Nettle/Ciphers.hs +++ b/src/Crypto/Nettle/Ciphers.hs @@ -38,6 +38,8 @@ , Camellia128 , Camellia192 , Camellia256 + -- ** SM4 + , SM4 -- ** CAST-128 , CAST128 -- ** DES @@ -61,15 +63,15 @@ , ESTREAM_SALSA20 ) where -import Crypto.Cipher.Types -import Crypto.Nettle.CCM - -import Data.SecureMem -import qualified Data.ByteString as B -import Data.Word (Word64) +import qualified Crypto.Cipher.Types as CCT +import Crypto.Error import Data.Bits +import qualified Data.ByteArray as BA +import qualified Data.ByteString as B import Data.Tagged +import Data.Word (Word64) +import Crypto.Nettle.CCM import Crypto.Nettle.Ciphers.Internal import Crypto.Nettle.Ciphers.ForeignImports import Nettle.Utils @@ -78,14 +80,14 @@ {-# ANN module "HLint: ignore Use camelCase" #-} #define INSTANCE_CIPHER(Typ) \ -instance Cipher Typ where \ +instance CCT.Cipher Typ where \ { cipherInit = nettle_cipherInit \ ; cipherName = witness nc_cipherName \ ; cipherKeySize = witness nc_cipherKeySize \ } #define INSTANCE_BLOCKCIPHER(Typ) \ INSTANCE_CIPHER(Typ); \ -instance BlockCipher Typ where \ +instance CCT.BlockCipher Typ where \ { blockSize = witness nbc_blockSize \ ; ecbEncrypt = nettle_ecbEncrypt \ ; ecbDecrypt = nettle_ecbDecrypt \ @@ -94,19 +96,20 @@ ; cfbEncrypt = nettle_cfbEncrypt \ ; cfbDecrypt = nettle_cfbDecrypt \ ; ctrCombine = nettle_ctrCombine \ - ; aeadInit AEAD_GCM = nettle_gcm_aeadInit \ - ; aeadInit AEAD_CCM = ccmInitTLS \ - ; aeadInit _ = \_ _ -> Nothing \ + ; aeadInit CCT.AEAD_GCM = nettle_gcm_aeadInit \ + ; aeadInit (CCT.AEAD_CCM 0 CCT.CCM_M16 CCT.CCM_L2) = ccmInitTLS \ + ; aeadInit _ = \_ _ -> CryptoFailed CryptoError_AEADModeNotSupported \ } ; \ -instance AEADModeImpl Typ NettleGCM where \ - { aeadStateAppendHeader = nettle_gcm_aeadStateAppendHeader \ - ; aeadStateEncrypt = nettle_gcm_aeadStateEncrypt \ - ; aeadStateDecrypt = nettle_gcm_aeadStateDecrypt \ - ; aeadStateFinalize = nettle_gcm_aeadStateFinalize \ +instance NettleAeadModeImpl Typ NettleGCM where \ + nettle_aead_mode_impl c = CCT.AEADModeImpl { \ + CCT.aeadImplAppendHeader = nettle_gcm_aeadStateAppendHeader c \ + , CCT.aeadImplEncrypt = nettle_gcm_aeadStateEncrypt c \ + , CCT.aeadImplDecrypt = nettle_gcm_aeadStateDecrypt c \ + , CCT.aeadImplFinalize = nettle_gcm_aeadStateFinalize c \ } #define INSTANCE_STREAMCIPHER(Typ) \ INSTANCE_CIPHER(Typ); \ -instance StreamCipher Typ where \ +instance CCT.StreamCipher Typ where \ { streamCombine = nettle_streamCombine \ } #define INSTANCE_STREAMNONCECIPHER(Typ) \ @@ -117,7 +120,7 @@ } #define INSTANCE_BLOCKEDSTREAMCIPHER(Typ) \ INSTANCE_CIPHER(Typ); \ -instance StreamCipher Typ where \ +instance CCT.StreamCipher Typ where \ { streamCombine = nettle_blockedStreamCombine \ } #define INSTANCE_BLOCKEDSTREAMNONCECIPHER(Typ) \ @@ -133,11 +136,11 @@ 'aeadInit' only supports the 'AEAD_GCM' mode for now. -} -newtype AES = AES SecureMem +newtype AES = AES BA.ScrubbedBytes instance NettleCipher AES where nc_cipherInit = Tagged c_hs_aes_init nc_cipherName = Tagged "AES" - nc_cipherKeySize = Tagged $ KeySizeEnum [16,24,32] + nc_cipherKeySize = Tagged $ CCT.KeySizeEnum [16,24,32] nc_ctx_size = Tagged c_hs_aes_ctx_size nc_ctx (AES c) = c nc_Ctx = AES @@ -153,11 +156,11 @@ {-| 'AES128' provides the same interface as 'AES', but is restricted to 128-bit keys. -} -newtype AES128 = AES128 SecureMem +newtype AES128 = AES128 BA.ScrubbedBytes instance NettleCipher AES128 where nc_cipherInit = Tagged (\ctx _ key -> c_hs_aes128_init ctx key) nc_cipherName = Tagged "AES-128" - nc_cipherKeySize = Tagged $ KeySizeFixed 16 + nc_cipherKeySize = Tagged $ CCT.KeySizeFixed 16 nc_ctx_size = Tagged c_hs_aes128_ctx_size nc_ctx (AES128 c) = c nc_Ctx = AES128 @@ -176,11 +179,11 @@ {-| 'AES192' provides the same interface as 'AES', but is restricted to 192-bit keys. -} -newtype AES192 = AES192 SecureMem +newtype AES192 = AES192 BA.ScrubbedBytes instance NettleCipher AES192 where nc_cipherInit = Tagged (\ctx _ key -> c_hs_aes192_init ctx key) nc_cipherName = Tagged "AES-192" - nc_cipherKeySize = Tagged $ KeySizeFixed 24 + nc_cipherKeySize = Tagged $ CCT.KeySizeFixed 24 nc_ctx_size = Tagged c_hs_aes192_ctx_size nc_ctx (AES192 c) = c nc_Ctx = AES192 @@ -199,11 +202,11 @@ {-| 'AES256' provides the same interface as 'AES', but is restricted to 256-bit keys. -} -newtype AES256 = AES256 SecureMem +newtype AES256 = AES256 BA.ScrubbedBytes instance NettleCipher AES256 where nc_cipherInit = Tagged (\ctx _ key -> c_hs_aes256_init ctx key) nc_cipherName = Tagged "AES-256" - nc_cipherKeySize = Tagged $ KeySizeFixed 32 + nc_cipherKeySize = Tagged $ CCT.KeySizeFixed 32 nc_ctx_size = Tagged c_hs_aes256_ctx_size nc_ctx (AES256 c) = c nc_Ctx = AES256 @@ -227,11 +230,11 @@ 'ARCTWO' uses keysizes from 1 to 128 bytes, and uses a 'blockSize' of 64 bits (8 bytes). -} -newtype ARCTWO = ARCTWO SecureMem +newtype ARCTWO = ARCTWO BA.ScrubbedBytes instance NettleCipher ARCTWO where nc_cipherInit = Tagged c_arctwo_set_key nc_cipherName = Tagged "ARCTWO" - nc_cipherKeySize = Tagged $ KeySizeRange 1 128 + nc_cipherKeySize = Tagged $ CCT.KeySizeRange 1 128 nc_ctx_size = Tagged c_arctwo_ctx_size nc_ctx (ARCTWO c) = c nc_Ctx = ARCTWO @@ -245,13 +248,13 @@ {-| Initialize cipher with an explicit @ekb@ value (valid values from 1 to 1024, 0 meaning the same as 1024). -} -arctwoInitEKB :: Key ARCTWO -> Word -> ARCTWO +arctwoInitEKB :: BA.ByteArray key => key -> Word -> CryptoFailable ARCTWO arctwoInitEKB k ekb = nettle_cipherInit' initfun k where initfun ctxptr ksize ptr = c_arctwo_set_key_ekb ctxptr ksize ptr ekb {-| Initialize cipher with @ekb = 1024@. -} -arctwoInitGutmann :: Key ARCTWO -> ARCTWO +arctwoInitGutmann :: BA.ByteArray key => key -> CryptoFailable ARCTWO arctwoInitGutmann = nettle_cipherInit' c_arctwo_set_key_gutmann @@ -259,11 +262,11 @@ 'BLOWFISH' is a block cipher designed by Bruce Schneier. It uses a 'blockSize' of 64 bits (8 bytes), and a variable key size from 64 to 448 bits (8 to 56 bytes). -} -newtype BLOWFISH = BLOWFISH SecureMem +newtype BLOWFISH = BLOWFISH BA.ScrubbedBytes instance NettleCipher BLOWFISH where nc_cipherInit = Tagged c_blowfish_set_key nc_cipherName = Tagged "BLOWFISH" - nc_cipherKeySize = Tagged $ KeySizeRange 1 128 + nc_cipherKeySize = Tagged $ CCT.KeySizeRange 1 128 nc_ctx_size = Tagged c_blowfish_ctx_size nc_ctx (BLOWFISH c) = c nc_Ctx = BLOWFISH @@ -285,11 +288,11 @@ 'aeadInit' only supports the 'AEAD_GCM' mode for now. -} -newtype Camellia = Camellia SecureMem +newtype Camellia = Camellia BA.ScrubbedBytes instance NettleCipher Camellia where nc_cipherInit = Tagged c_hs_camellia_init nc_cipherName = Tagged "Camellia" - nc_cipherKeySize = Tagged $ KeySizeEnum [16,24,32] + nc_cipherKeySize = Tagged $ CCT.KeySizeEnum [16,24,32] nc_ctx_size = Tagged c_hs_camellia_ctx_size nc_ctx (Camellia c) = c nc_Ctx = Camellia @@ -305,11 +308,11 @@ {-| 'Camellia128' provides the same interface as 'Camellia', but is restricted to 128-bit keys. -} -newtype Camellia128 = Camellia128 SecureMem +newtype Camellia128 = Camellia128 BA.ScrubbedBytes instance NettleCipher Camellia128 where nc_cipherInit = Tagged (\ctx _ key -> c_hs_camellia128_init ctx key) nc_cipherName = Tagged "Camellia-128" - nc_cipherKeySize = Tagged $ KeySizeFixed 16 + nc_cipherKeySize = Tagged $ CCT.KeySizeFixed 16 nc_ctx_size = Tagged c_hs_camellia128_ctx_size nc_ctx (Camellia128 c) = c nc_Ctx = Camellia128 @@ -327,11 +330,11 @@ {-| 'Camellia192' provides the same interface as 'Camellia', but is restricted to 192-bit keys. -} -newtype Camellia192 = Camellia192 SecureMem +newtype Camellia192 = Camellia192 BA.ScrubbedBytes instance NettleCipher Camellia192 where nc_cipherInit = Tagged (\ctx _ key -> c_hs_camellia192_init ctx key) nc_cipherName = Tagged "Camellia-192" - nc_cipherKeySize = Tagged $ KeySizeFixed 24 + nc_cipherKeySize = Tagged $ CCT.KeySizeFixed 24 nc_ctx_size = Tagged c_hs_camellia192_ctx_size nc_ctx (Camellia192 c) = c nc_Ctx = Camellia192 @@ -349,11 +352,11 @@ {-| 'Camellia256' provides the same interface as 'Camellia', but is restricted to 256-bit keys. -} -newtype Camellia256 = Camellia256 SecureMem +newtype Camellia256 = Camellia256 BA.ScrubbedBytes instance NettleCipher Camellia256 where nc_cipherInit = Tagged (\ctx _ key -> c_hs_camellia256_init ctx key) nc_cipherName = Tagged "Camellia-256" - nc_cipherKeySize = Tagged $ KeySizeFixed 32 + nc_cipherKeySize = Tagged $ CCT.KeySizeFixed 32 nc_ctx_size = Tagged c_hs_camellia256_ctx_size nc_ctx (Camellia256 c) = c nc_Ctx = Camellia256 @@ -369,14 +372,37 @@ INSTANCE_BLOCKCIPHER(Camellia256) {-| +'SM4' is a block cipher specified in GB/T 32907-2016. It uses a 128 bit (16 bytes) key +and a 128 bit (16 bytes) 'blockSize'. +-} +newtype SM4 = SM4 BA.ScrubbedBytes +instance NettleCipher SM4 where + nc_cipherInit = Tagged (\ctx _ key -> c_hs_sm4_init ctx key) + nc_cipherName = Tagged "SM4" + nc_cipherKeySize = Tagged $ CCT.KeySizeFixed 16 + nc_ctx_size = Tagged c_hs_sm4_ctx_size + nc_ctx (SM4 c) = c + nc_Ctx = SM4 +instance NettleBlockCipher SM4 where + nbc_blockSize = Tagged 16 + nbc_encrypt_ctx_offset = Tagged c_hs_sm4_ctx_encrypt + nbc_decrypt_ctx_offset = Tagged c_hs_sm4_ctx_decrypt + nbc_ecb_encrypt = Tagged c_sm4_crypt + nbc_ecb_decrypt = Tagged c_sm4_crypt + nbc_fun_encrypt = Tagged p_sm4_crypt + nbc_fun_decrypt = Tagged p_sm4_crypt + +INSTANCE_BLOCKCIPHER(SM4) + +{-| 'CAST128' is a block cipher specified in RFC 2144. It uses a 64 bit (8 bytes) 'blockSize', and a variable key size of 40 up to 128 bits (5 to 16 bytes). -} -newtype CAST128 = CAST128 SecureMem +newtype CAST128 = CAST128 BA.ScrubbedBytes instance NettleCipher CAST128 where nc_cipherInit = Tagged c_cast5_set_key nc_cipherName = Tagged "CAST-128" - nc_cipherKeySize = Tagged $ KeySizeRange 5 16 + nc_cipherKeySize = Tagged $ CCT.KeySizeRange 5 16 nc_ctx_size = Tagged c_cast128_ctx_size nc_ctx (CAST128 c) = c nc_Ctx = CAST128 @@ -396,11 +422,11 @@ The key is given as 8 bytes, as one bit per byte is used as a parity bit. The parity bit is ignored by this implementation. -} -newtype DES = DES SecureMem +newtype DES = DES BA.ScrubbedBytes instance NettleCipher DES where nc_cipherInit = Tagged $ \ctxptr _ -> c_des_set_key ctxptr nc_cipherName = Tagged "DES" - nc_cipherKeySize = Tagged $ KeySizeFixed 8 + nc_cipherKeySize = Tagged $ CCT.KeySizeFixed 8 nc_ctx_size = Tagged c_des_ctx_size nc_ctx (DES c) = c nc_Ctx = DES @@ -420,11 +446,11 @@ The 'blockSize' is the same as for 'DES': 64 bits (8 bytes), and the keys are simply concatenated, forming a 24 byte key string (with 168 bits actually getting used). -} -newtype DES_EDE3 = DES_EDE3 SecureMem +newtype DES_EDE3 = DES_EDE3 BA.ScrubbedBytes instance NettleCipher DES_EDE3 where nc_cipherInit = Tagged $ \ctxptr _ -> c_des3_set_key ctxptr nc_cipherName = Tagged "DES-EDE3" - nc_cipherKeySize = Tagged $ KeySizeFixed 24 + nc_cipherKeySize = Tagged $ CCT.KeySizeFixed 24 nc_ctx_size = Tagged c_des3_ctx_size nc_ctx (DES_EDE3 c) = c nc_Ctx = DES_EDE3 @@ -445,11 +471,11 @@ 'aeadInit' only supports the 'AEAD_GCM' mode for now. -} -newtype SERPENT = SERPENT SecureMem +newtype SERPENT = SERPENT BA.ScrubbedBytes instance NettleCipher SERPENT where nc_cipherInit = Tagged c_serpent_set_key nc_cipherName = Tagged "SERPENT" - nc_cipherKeySize = Tagged $ KeySizeRange 16 32 + nc_cipherKeySize = Tagged $ CCT.KeySizeRange 16 32 nc_ctx_size = Tagged c_serpent_ctx_size nc_ctx (SERPENT c) = c nc_Ctx = SERPENT @@ -468,11 +494,11 @@ 'aeadInit' only supports the 'AEAD_GCM' mode for now. -} -newtype TWOFISH = TWOFISH SecureMem +newtype TWOFISH = TWOFISH BA.ScrubbedBytes instance NettleCipher TWOFISH where nc_cipherInit = Tagged c_twofish_set_key nc_cipherName = Tagged "TWOFISH" - nc_cipherKeySize = Tagged $ KeySizeEnum [16,24,32] + nc_cipherKeySize = Tagged $ CCT.KeySizeEnum [16,24,32] nc_ctx_size = Tagged c_twofish_ctx_size nc_ctx (TWOFISH c) = c nc_Ctx = TWOFISH @@ -490,11 +516,11 @@ Valid key sizes are from 1 to 256 bytes. -} -newtype ARCFOUR = ARCFOUR SecureMem +newtype ARCFOUR = ARCFOUR BA.ScrubbedBytes instance NettleCipher ARCFOUR where nc_cipherInit = Tagged c_arcfour_set_key nc_cipherName = Tagged "ARCFOUR" - nc_cipherKeySize = Tagged $ KeySizeEnum [16,24,32] + nc_cipherKeySize = Tagged $ CCT.KeySizeEnum [16,24,32] nc_ctx_size = Tagged c_arcfour_ctx_size nc_ctx (ARCFOUR c) = c nc_Ctx = ARCFOUR @@ -509,8 +535,8 @@ A good value for the nonce is a message/packet counter. Usually a nonce should not be reused with the same key. -} -class StreamCipher cipher => StreamNonceCipher cipher where - streamNonceSize :: cipher -> KeySizeSpecifier +class CCT.StreamCipher cipher => StreamNonceCipher cipher where + streamNonceSize :: cipher -> CCT.KeySizeSpecifier streamSetNonce :: cipher -> B.ByteString -> Maybe cipher word64BE :: Word64 -> B.ByteString @@ -550,11 +576,11 @@ Setting a nonce also resets the remaining padding data. -} -newtype CHACHA = CHACHA (SecureMem, B.ByteString) +newtype CHACHA = CHACHA (BA.ScrubbedBytes, B.ByteString) instance NettleCipher CHACHA where nc_cipherInit = Tagged wrap_chacha_set_key nc_cipherName = Tagged "ChaCha" - nc_cipherKeySize = Tagged $ KeySizeFixed 32 + nc_cipherKeySize = Tagged $ CCT.KeySizeFixed 32 nc_ctx_size = Tagged c_chacha_ctx_size nc_ctx (CHACHA (c, _)) = c nc_Ctx c = CHACHA (c, B.empty) @@ -563,7 +589,7 @@ nbsc_IncompleteState (CHACHA (c, _)) inc = CHACHA (c, inc) nbsc_incompleteState (CHACHA (_, inc)) = inc nbsc_streamCombine = Tagged c_chacha_crypt - nbsc_nonceSize = Tagged $ KeySizeFixed 8 + nbsc_nonceSize = Tagged $ CCT.KeySizeFixed 8 nbsc_setNonce = Tagged $ Just wrap_chacha_set_nonce INSTANCE_BLOCKEDSTREAMNONCECIPHER(CHACHA) @@ -591,11 +617,11 @@ Setting a nonce also resets the remaining padding data. -} -newtype SALSA20 = SALSA20 (SecureMem, B.ByteString) +newtype SALSA20 = SALSA20 (BA.ScrubbedBytes, B.ByteString) instance NettleCipher SALSA20 where nc_cipherInit = Tagged wrap_salsa20_set_key nc_cipherName = Tagged "Salsa20" - nc_cipherKeySize = Tagged $ KeySizeEnum [16,32] + nc_cipherKeySize = Tagged $ CCT.KeySizeEnum [16,32] nc_ctx_size = Tagged c_salsa20_ctx_size nc_ctx (SALSA20 (c, _)) = c nc_Ctx c = SALSA20 (c, B.empty) @@ -604,7 +630,7 @@ nbsc_IncompleteState (SALSA20 (c, _)) inc = SALSA20 (c, inc) nbsc_incompleteState (SALSA20 (_, inc)) = inc nbsc_streamCombine = Tagged c_salsa20_crypt - nbsc_nonceSize = Tagged $ KeySizeFixed 8 + nbsc_nonceSize = Tagged $ CCT.KeySizeFixed 8 nbsc_setNonce = Tagged $ Just wrap_salsa20_set_nonce INSTANCE_BLOCKEDSTREAMNONCECIPHER(SALSA20) @@ -612,11 +638,11 @@ {-| 'ESTREAM_SALSA20' is the same as 'SALSA20', but uses only 12 instead of 20 rounds in mixing. -} -newtype ESTREAM_SALSA20 = ESTREAM_SALSA20 (SecureMem, B.ByteString) +newtype ESTREAM_SALSA20 = ESTREAM_SALSA20 (BA.ScrubbedBytes, B.ByteString) instance NettleCipher ESTREAM_SALSA20 where nc_cipherInit = Tagged wrap_salsa20_set_key nc_cipherName = Tagged "eSTREAM-Salsa20" - nc_cipherKeySize = Tagged $ KeySizeEnum [16,32] + nc_cipherKeySize = Tagged $ CCT.KeySizeEnum [16,32] nc_ctx_size = Tagged c_salsa20_ctx_size nc_ctx (ESTREAM_SALSA20 (c, _)) = c nc_Ctx c = ESTREAM_SALSA20 (c, B.empty) @@ -625,6 +651,6 @@ nbsc_IncompleteState (ESTREAM_SALSA20 (c, _)) inc = ESTREAM_SALSA20 (c, inc) nbsc_incompleteState (ESTREAM_SALSA20 (_, inc)) = inc nbsc_streamCombine = Tagged c_salsa20r12_crypt - nbsc_nonceSize = Tagged $ KeySizeFixed 8 + nbsc_nonceSize = Tagged $ CCT.KeySizeFixed 8 nbsc_setNonce = Tagged $ Just wrap_salsa20_set_nonce INSTANCE_BLOCKEDSTREAMNONCECIPHER(ESTREAM_SALSA20) diff --git a/src/Crypto/Nettle/Ciphers/ForeignImports.hsc b/src/Crypto/Nettle/Ciphers/ForeignImports.hsc --- a/src/Crypto/Nettle/Ciphers/ForeignImports.hsc +++ b/src/Crypto/Nettle/Ciphers/ForeignImports.hsc @@ -22,6 +22,7 @@ , c_gcm_encrypt , c_gcm_decrypt , c_gcm_digest + , callNettleGcmDigest , c_hs_aes_ctx_size , c_hs_aes_init @@ -101,6 +102,13 @@ , c_camellia256_crypt , p_camellia256_crypt + , c_hs_sm4_ctx_size + , c_hs_sm4_ctx_encrypt + , c_hs_sm4_ctx_decrypt + , c_hs_sm4_init + , c_sm4_crypt + , p_sm4_crypt + , c_cast128_ctx_size , c_cast5_set_key , c_cast128_encrypt @@ -158,10 +166,54 @@ , c_chacha_poly1305_encrypt , c_chacha_poly1305_decrypt , c_chacha_poly1305_digest + , callNettleChaChaPoly1305Digest + + , NettleHashDigest + , callNettleHashDigest + + , c_eax_aes128_ctx_size + , c_eax_aes128_set_key + , c_eax_aes128_set_nonce + , c_eax_aes128_update + , c_eax_aes128_encrypt + , c_eax_aes128_decrypt + , c_eax_aes128_digest + + , c_ocb_aes128_key_ctx_size + , c_aes128_ctx_size + , c_ocb_aes128_set_encrypt_key + , c_ocb_aes128_set_decrypt_key + , c_ocb_aes128_encrypt_message + , c_ocb_aes128_decrypt_message + + , c_siv_cmac_aes128_ctx_size + , c_siv_cmac_aes256_ctx_size + , c_siv_cmac_aes128_set_key + , c_siv_cmac_aes128_encrypt_message + , c_siv_cmac_aes128_decrypt_message + , c_siv_cmac_aes256_set_key + , c_siv_cmac_aes256_encrypt_message + , c_siv_cmac_aes256_decrypt_message + + , NettleOcbDigest + , callNettleOcbDigest + + , c_ocb_aes128_ctx_size + , c_ocb_aes128_set_nonce + , c_ocb_aes128_update + , c_ocb_aes128_encrypt + , c_ocb_aes128_decrypt + , c_ocb_aes128_digest ) where import Nettle.Utils +#if (NETTLE_VERSION_MAJOR > 3) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Marshal.Utils (copyBytes) +#endif +import Foreign.C.Types (CInt(CInt)) + -- internal functions are not camelCase on purpose {-# ANN module "HLint: ignore Use camelCase" #-} @@ -171,6 +223,39 @@ type NettleBlockMode = Ptr Word8 -> FunPtr NettleCryptFunc -> Word -> Ptr Word8 -> Word -> Ptr Word8 -> Ptr Word8 -> IO () type NettleGCMMode = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> FunPtr NettleCryptFunc -> Word -> Ptr Word8 -> Ptr Word8 -> IO () +-- Nettle 4 dropped the digest size argument from all *_digest functions +#if (NETTLE_VERSION_MAJOR > 3) +type NettleGcmDigest = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> FunPtr NettleCryptFunc -> Ptr Word8 -> IO () +type NettleChaChaPoly1305Digest = Ptr Word8 -> Ptr Word8 -> IO () +type NettleHashDigest = Ptr Word8 -> Ptr Word8 -> IO () +type NettleOcbDigest = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () +#else +type NettleGcmDigest = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> FunPtr NettleCryptFunc -> Word -> Ptr Word8 -> IO () +type NettleChaChaPoly1305Digest = Ptr Word8 -> Word -> Ptr Word8 -> IO () +type NettleHashDigest = Ptr Word8 -> Word -> Ptr Word8 -> IO () +type NettleOcbDigest = Ptr Word8 -> Ptr Word8 -> Word -> Ptr Word8 -> IO () +#endif + +-- | Call a @ocb_aes128_digest@ function, adapting to the Nettle API. +-- Nettle 4 dropped the @digest_size@ argument; the @taglen@ argument +-- is only used on Nettle 3.x. +callNettleOcbDigest :: NettleOcbDigest -> Int -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () +#if (NETTLE_VERSION_MAJOR > 3) +callNettleOcbDigest digestfun _taglen ctxptr keyptr digestptr = digestfun ctxptr keyptr digestptr +#else +callNettleOcbDigest digestfun taglen ctxptr keyptr digestptr = digestfun ctxptr keyptr (fromIntegral taglen) digestptr +#endif + +-- | Call a nettle @*_digest@ function, adapting to the Nettle API. +-- Nettle 4 dropped the @digest_size@ argument; the @digestSize@ argument +-- is only used on Nettle 3.x. +callNettleHashDigest :: NettleHashDigest -> Int -> Ptr Word8 -> Ptr Word8 -> IO () +#if (NETTLE_VERSION_MAJOR > 3) +callNettleHashDigest digestfun _digestSize ctxptr digestptr = digestfun ctxptr digestptr +#else +callNettleHashDigest digestfun digestSize ctxptr digestptr = digestfun ctxptr (fromIntegral digestSize) digestptr +#endif + foreign import ccall unsafe "nettle_cbc_encrypt" c_cbc_encrypt :: NettleBlockMode foreign import ccall unsafe "nettle_cbc_decrypt" @@ -199,8 +284,23 @@ foreign import ccall unsafe "nettle_gcm_decrypt" c_gcm_decrypt :: NettleGCMMode foreign import ccall unsafe "nettle_gcm_digest" - c_gcm_digest :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> FunPtr NettleCryptFunc -> Word -> Ptr Word8 -> IO () + c_gcm_digest :: NettleGcmDigest +-- | Call @nettle_gcm_digest@, adapting to the Nettle API. Nettle 4 dropped +-- the @digest_size@ argument and always writes a full 16-byte digest, so the +-- requested @taglen@ (at most 16) is honored by truncating in Haskell. +callNettleGcmDigest + :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> FunPtr NettleCryptFunc -> Int -> Ptr Word8 -> IO () +callNettleGcmDigest ctxptr keyptr cipherptr f taglen digestptr + | taglen < 0 || taglen > 16 = error "GCM tag length must be in the range 0..16" +#if (NETTLE_VERSION_MAJOR > 3) + | otherwise = allocaBytes 16 $ \tmp -> do + c_gcm_digest ctxptr keyptr cipherptr f tmp + copyBytes digestptr tmp taglen +#else + | otherwise = c_gcm_digest ctxptr keyptr cipherptr f (fromIntegral taglen) digestptr +#endif + -- block ciphers c_hs_aes_ctx_size :: Int @@ -350,6 +450,19 @@ foreign import ccall unsafe "&nettle_camellia256_crypt" p_camellia256_crypt :: FunPtr NettleCryptFunc +c_hs_sm4_ctx_size :: Int +c_hs_sm4_ctx_size = #{size struct hs_sm4_ctx} +c_hs_sm4_ctx_encrypt :: Ptr Word8 -> Ptr Word8 +c_hs_sm4_ctx_encrypt = #ptr struct hs_sm4_ctx, encrypt +c_hs_sm4_ctx_decrypt :: Ptr Word8 -> Ptr Word8 +c_hs_sm4_ctx_decrypt = #ptr struct hs_sm4_ctx, decrypt +foreign import ccall unsafe "hs_nettle_sm4_init" + c_hs_sm4_init :: Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_sm4_crypt" + c_sm4_crypt :: NettleCryptFunc +foreign import ccall unsafe "&nettle_sm4_crypt" + p_sm4_crypt :: FunPtr NettleCryptFunc + c_cast128_ctx_size :: Int c_cast128_ctx_size = #{size struct cast128_ctx} -- cast128_set_key uses a 128-bit fixed size key, cast-5 supports the variable length @@ -458,4 +571,80 @@ foreign import ccall unsafe "nettle_chacha_poly1305_decrypt" c_chacha_poly1305_decrypt :: NettleCryptFunc foreign import ccall unsafe "nettle_chacha_poly1305_digest" - c_chacha_poly1305_digest :: Ptr Word8 -> Word -> Ptr Word8 -> IO () + c_chacha_poly1305_digest :: NettleChaChaPoly1305Digest + +-- | Call @nettle_chacha_poly1305_digest@, adapting to the Nettle API. +-- Nettle 4 dropped the @digest_size@ argument; the @taglen@ argument is +-- only used on Nettle 3.x. +callNettleChaChaPoly1305Digest :: Ptr Word8 -> Int -> Ptr Word8 -> IO () +#if (NETTLE_VERSION_MAJOR > 3) +callNettleChaChaPoly1305Digest ctxptr _taglen digestptr = c_chacha_poly1305_digest ctxptr digestptr +#else +callNettleChaChaPoly1305Digest ctxptr taglen digestptr = c_chacha_poly1305_digest ctxptr (fromIntegral taglen) digestptr +#endif + +-- EAX +c_eax_aes128_ctx_size :: Int +c_eax_aes128_ctx_size = #{size struct eax_aes128_ctx} +foreign import ccall unsafe "nettle_eax_aes128_set_key" + c_eax_aes128_set_key :: Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_eax_aes128_set_nonce" + c_eax_aes128_set_nonce :: Ptr Word8 -> Word -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_eax_aes128_update" + c_eax_aes128_update :: Ptr Word8 -> Word -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_eax_aes128_encrypt" + c_eax_aes128_encrypt :: NettleCryptFunc +foreign import ccall unsafe "nettle_eax_aes128_decrypt" + c_eax_aes128_decrypt :: NettleCryptFunc +foreign import ccall unsafe "nettle_eax_aes128_digest" + c_eax_aes128_digest :: NettleHashDigest + +-- OCB +c_ocb_aes128_key_ctx_size :: Int +c_ocb_aes128_key_ctx_size = #{size struct ocb_aes128_encrypt_key} +c_ocb_aes128_ctx_size :: Int +c_ocb_aes128_ctx_size = #{size struct ocb_ctx} +c_aes128_ctx_size :: Int +c_aes128_ctx_size = #{size struct aes128_ctx} +foreign import ccall unsafe "nettle_ocb_aes128_set_encrypt_key" + c_ocb_aes128_set_encrypt_key :: Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_ocb_aes128_set_decrypt_key" + c_ocb_aes128_set_decrypt_key :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_ocb_aes128_set_nonce" + c_ocb_aes128_set_nonce :: Ptr Word8 -> Ptr Word8 -> Word -> Word -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_ocb_aes128_update" + c_ocb_aes128_update :: Ptr Word8 -> Ptr Word8 -> Word -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_ocb_aes128_encrypt" + c_ocb_aes128_encrypt :: Ptr Word8 -> Ptr Word8 -> Word -> Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_ocb_aes128_decrypt" + c_ocb_aes128_decrypt :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word -> Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_ocb_aes128_digest" + c_ocb_aes128_digest :: NettleOcbDigest +foreign import ccall unsafe "nettle_ocb_aes128_encrypt_message" + c_ocb_aes128_encrypt_message + :: Ptr Word8 -> Word -> Ptr Word8 -> Word -> Ptr Word8 -> Word -> Word -> Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_ocb_aes128_decrypt_message" + c_ocb_aes128_decrypt_message + :: Ptr Word8 -> Ptr Word8 -> Word -> Ptr Word8 -> Word -> Ptr Word8 -> Word -> Word -> Ptr Word8 -> Ptr Word8 -> IO CInt + +-- SIV +c_siv_cmac_aes128_ctx_size :: Int +c_siv_cmac_aes128_ctx_size = #{size struct siv_cmac_aes128_ctx} +c_siv_cmac_aes256_ctx_size :: Int +c_siv_cmac_aes256_ctx_size = #{size struct siv_cmac_aes256_ctx} +foreign import ccall unsafe "nettle_siv_cmac_aes128_set_key" + c_siv_cmac_aes128_set_key :: Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_siv_cmac_aes128_encrypt_message" + c_siv_cmac_aes128_encrypt_message + :: Ptr Word8 -> Word -> Ptr Word8 -> Word -> Ptr Word8 -> Word -> Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_siv_cmac_aes128_decrypt_message" + c_siv_cmac_aes128_decrypt_message + :: Ptr Word8 -> Word -> Ptr Word8 -> Word -> Ptr Word8 -> Word -> Ptr Word8 -> Ptr Word8 -> IO CInt +foreign import ccall unsafe "nettle_siv_cmac_aes256_set_key" + c_siv_cmac_aes256_set_key :: Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_siv_cmac_aes256_encrypt_message" + c_siv_cmac_aes256_encrypt_message + :: Ptr Word8 -> Word -> Ptr Word8 -> Word -> Ptr Word8 -> Word -> Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_siv_cmac_aes256_decrypt_message" + c_siv_cmac_aes256_decrypt_message + :: Ptr Word8 -> Word -> Ptr Word8 -> Word -> Ptr Word8 -> Word -> Ptr Word8 -> Ptr Word8 -> IO CInt diff --git a/src/Crypto/Nettle/Ciphers/Internal.hs b/src/Crypto/Nettle/Ciphers/Internal.hs --- a/src/Crypto/Nettle/Ciphers/Internal.hs +++ b/src/Crypto/Nettle/Ciphers/Internal.hs @@ -1,11 +1,12 @@ {-# OPTIONS_HADDOCK hide #-} -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, LambdaCase #-} module Crypto.Nettle.Ciphers.Internal ( NettleCipher(..) , NettleBlockCipher(..) , NettleStreamCipher(..) , NettleBlockedStreamCipher(..) + , NettleAeadModeImpl(..) , NettleGCM , nettle_cipherInit , nettle_cipherInit' @@ -27,15 +28,16 @@ , nettle_gcm_aeadStateFinalize ) where -import Crypto.Cipher.Types as T +import Crypto.Cipher.Types as CCT +import Crypto.Error import Data.Tagged -import Data.Byteable (Byteable(..)) -import Data.SecureMem +import qualified Data.ByteArray as BA import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as B -import Data.Bits (xor) +import Foreign.Ptr (alignPtr, ptrToWordPtr) +import Foreign.Marshal.Utils (copyBytes) + import Nettle.Utils import Crypto.Nettle.Ciphers.ForeignImports @@ -46,10 +48,10 @@ -- | pointer to new context, key length, (const) key pointer nc_cipherInit :: Tagged c (Ptr Word8 -> Word -> Ptr Word8 -> IO()) nc_cipherName :: Tagged c String - nc_cipherKeySize :: Tagged c T.KeySizeSpecifier + nc_cipherKeySize :: Tagged c CCT.KeySizeSpecifier nc_ctx_size :: Tagged c Int - nc_ctx :: c -> SecureMem - nc_Ctx :: SecureMem -> c + nc_ctx :: c -> BA.ScrubbedBytes + nc_Ctx :: BA.ScrubbedBytes -> c class NettleCipher c => NettleBlockCipher c where nbc_blockSize :: Tagged c Int nbc_encrypt_ctx_offset :: Tagged c (Ptr Word8 -> Ptr Word8) @@ -62,8 +64,8 @@ nbc_fun_decrypt :: Tagged c (FunPtr NettleCryptFunc) class NettleCipher c => NettleStreamCipher c where nsc_streamCombine :: Tagged c NettleCryptFunc - nsc_nonceSize :: Tagged c T.KeySizeSpecifier - nsc_nonceSize = Tagged $ T.KeySizeEnum [] + nsc_nonceSize :: Tagged c CCT.KeySizeSpecifier + nsc_nonceSize = Tagged $ CCT.KeySizeEnum [] nsc_setNonce :: Tagged c (Maybe (Ptr Word8 -> Word -> Ptr Word8 -> IO ())) nsc_setNonce = Tagged Nothing @@ -75,183 +77,238 @@ nbsc_IncompleteState :: c -> B.ByteString -> c nbsc_incompleteState :: c -> B.ByteString nbsc_streamCombine :: Tagged c NettleCryptFunc - nbsc_nonceSize :: Tagged c T.KeySizeSpecifier - nbsc_nonceSize = Tagged $ T.KeySizeEnum [] + nbsc_nonceSize :: Tagged c CCT.KeySizeSpecifier + nbsc_nonceSize = Tagged $ CCT.KeySizeEnum [] nbsc_setNonce :: Tagged c (Maybe (Ptr Word8 -> Word -> Ptr Word8 -> IO ())) nbsc_setNonce = Tagged Nothing -nettle_cipherInit :: NettleCipher c => Key c -> c -nettle_cipherInit k = let ctx = nettle_cipherInit' (nc_cipherInit `witness` ctx) k in ctx +class NettleAeadModeImpl c state where + nettle_aead_mode_impl :: c -> CCT.AEADModeImpl state -nettle_cipherInit' :: NettleCipher c => (Ptr Word8 -> Word -> Ptr Word8 -> IO()) -> Key c -> c -nettle_cipherInit' f k = let ctx = nc_Ctx $ key_init f (nc_ctx_size `witness` ctx) k in ctx +nettle_cipherInit :: (NettleCipher c, BA.ByteArray key) => key -> CryptoFailable c +nettle_cipherInit k = let ctx = nettle_cipherInit' (nc_cipherInit `witness` (throwCryptoError ctx)) k in ctx -assert_blockSize :: NettleBlockCipher c => c -> B.ByteString -> a -> a -assert_blockSize c src result = if 0 /= B.length src `mod` (nbc_blockSize `witness` c) then error "input not a multiple of blockSize" else result +nettle_cipherInit' :: (NettleCipher c, BA.ByteArray key) => (Ptr Word8 -> Word -> Ptr Word8 -> IO()) -> key -> CryptoFailable c +nettle_cipherInit' f k = let ctx = (\case { + Nothing -> CryptoPassed $ nc_Ctx $ key_init f (nc_ctx_size `witness` (throwCryptoError ctx)) k + ; Just e -> CryptoFailed e + }) (validate_keySize (nc_cipherKeySize `witness` (throwCryptoError ctx)) k) + in ctx -nettle_ecbEncrypt :: NettleBlockCipher c => c -> B.ByteString -> B.ByteString +validate_keySize :: (BA.ByteArrayAccess key) => CCT.KeySizeSpecifier -> key -> Maybe CryptoError +validate_keySize spec k = case spec of + CCT.KeySizeRange bot top -> if bot <= BA.length k && BA.length k <= top then Nothing else Just CryptoError_KeySizeInvalid + CCT.KeySizeEnum list -> if (BA.length k) `elem` list then Nothing else Just CryptoError_KeySizeInvalid + CCT.KeySizeFixed f -> if BA.length k == f then Nothing else Just CryptoError_KeySizeInvalid + +assert_blockSize :: (NettleBlockCipher c, BA.ByteArrayAccess ba) => c -> ba -> a -> a +assert_blockSize c src result = if 0 /= BA.length src `mod` (nbc_blockSize `witness` c) then error "input not a multiple of blockSize" else result + +nettle_ecbEncrypt :: (CCT.BlockCipher c, NettleBlockCipher c, BA.ByteArrayAccess bin, BA.ByteArray bout) => c -> bin -> bout nettle_ecbEncrypt c src = assert_blockSize c src $ c_run_crypt (nbc_encrypt_ctx_offset `witness` c) (nbc_ecb_encrypt `witness` c) (nc_ctx c) src -nettle_ecbDecrypt :: NettleBlockCipher c => c -> B.ByteString -> B.ByteString +nettle_ecbDecrypt :: (CCT.BlockCipher c, NettleBlockCipher c, BA.ByteArrayAccess bin, BA.ByteArray bout) => c -> bin -> bout nettle_ecbDecrypt c src = assert_blockSize c src $ c_run_crypt (nbc_decrypt_ctx_offset `witness` c) (nbc_ecb_decrypt `witness` c) (nc_ctx c) src -nettle_cbcEncrypt :: NettleBlockCipher c => c -> IV c -> B.ByteString -> B.ByteString +nettle_cbcEncrypt :: (CCT.BlockCipher c, NettleBlockCipher c, BA.ByteArrayAccess bin, BA.ByteArray bout) => c -> IV c -> bin -> bout nettle_cbcEncrypt c iv src = assert_blockSize c src $ blockmode_run (nbc_encrypt_ctx_offset `witness` c) c_cbc_encrypt (nbc_fun_encrypt `witness` c) (nc_ctx c) iv src -nettle_cbcDecrypt :: NettleBlockCipher c => c -> IV c -> B.ByteString -> B.ByteString +nettle_cbcDecrypt :: (CCT.BlockCipher c, NettleBlockCipher c, BA.ByteArrayAccess bin, BA.ByteArray bout) => c -> IV c -> bin -> bout nettle_cbcDecrypt c iv src = assert_blockSize c src $ blockmode_run (nbc_decrypt_ctx_offset `witness` c) c_cbc_decrypt (nbc_fun_decrypt `witness` c) (nc_ctx c) iv src -nettle_cfbEncrypt :: NettleBlockCipher c => c -> IV c -> B.ByteString -> B.ByteString +nettle_cfbEncrypt :: (CCT.BlockCipher c, NettleBlockCipher c, BA.ByteArrayAccess bin, BA.ByteArray bout) => c -> IV c -> bin -> bout nettle_cfbEncrypt c iv src = assert_blockSize c src $ blockmode_run (nbc_encrypt_ctx_offset `witness` c) c_cfb_encrypt (nbc_fun_encrypt `witness` c) (nc_ctx c) iv src -nettle_cfbDecrypt :: NettleBlockCipher c => c -> IV c -> B.ByteString -> B.ByteString +nettle_cfbDecrypt :: (CCT.BlockCipher c, NettleBlockCipher c, BA.ByteArrayAccess bin, BA.ByteArray bout) => c -> IV c -> bin -> bout nettle_cfbDecrypt c iv src = assert_blockSize c src $ blockmode_run (nbc_encrypt_ctx_offset `witness` c) c_cfb_decrypt (nbc_fun_encrypt `witness` c) (nc_ctx c) iv src -nettle_ctrCombine :: NettleBlockCipher c => c -> IV c -> B.ByteString -> B.ByteString +nettle_ctrCombine :: (CCT.BlockCipher c, NettleBlockCipher c, BA.ByteArrayAccess bin, BA.ByteArray bout) => c -> IV c -> bin -> bout nettle_ctrCombine c = blockmode_run (nbc_encrypt_ctx_offset `witness` c) c_ctr_crypt (nbc_fun_encrypt `witness` c) (nc_ctx c) -nettle_streamCombine :: NettleStreamCipher c => c -> B.ByteString -> (B.ByteString, c) +nettle_streamCombine :: (NettleStreamCipher c, BA.ByteArrayAccess bin, BA.ByteArray bout) => c -> bin -> (bout, c) nettle_streamCombine c indata = let (r, c') = stream_crypt (nsc_streamCombine `witness` c) (nc_ctx c) indata in (r, nc_Ctx c') nettle_streamSetNonce :: NettleStreamCipher c => c -> B.ByteString -> Maybe c nettle_streamSetNonce c nonce = case nsc_setNonce `witness` c of Nothing -> Nothing - Just setnonce -> unsafeDupablePerformIO $ - secureMemCopy (nc_ctx c) >>= \ctx' -> - withSecureMemPtr ctx' $ \ctxptr -> + Just setnonce -> let ctx' = copyScrubbedBytes (nc_ctx c) in + unsafeDupablePerformIO $ + BA.withByteArray ctx' $ \ctxptr -> withByteStringPtr nonce $ \noncelen nonceptr -> setnonce ctxptr noncelen nonceptr >> return (Just $ nc_Ctx ctx') -nettle_blockedStreamCombine :: NettleBlockedStreamCipher c => c -> B.ByteString -> (B.ByteString, c) -nettle_blockedStreamCombine c indata = if B.length indata == 0 then (indata, c) else +nettle_blockedStreamCombine :: (NettleBlockedStreamCipher c, BA.ByteArray bin, BA.ByteArray bout) => c -> bin -> (bout, c) +nettle_blockedStreamCombine c indata = if BA.length indata == 0 then (BA.convert indata, c) else let inc = nbsc_incompleteState c; blocksiz = nbsc_blockSize `witness` c in if B.length inc /= 0 then let -- first xor remaining block, then combine the rest - (i1, i2) = B.splitAt (B.length inc) indata - (inc1, inc2) = B.splitAt (B.length indata) inc - r1 = B.pack $ B.zipWith xor i1 inc1 + (i1, i2) = BA.splitAt (B.length inc) indata + (inc1, inc2) = B.splitAt (BA.length indata) inc + r1 = BA.xor i1 inc1 c' = if B.length inc2 == 0 then nc_Ctx $ nc_ctx c else nbsc_IncompleteState c inc2 (r, c'') = nettle_blockedStreamCombine c' i2 - in (B.append r1 r, c'') - else if B.length indata `mod` blocksiz /= 0 + in (BA.append r1 r, c'') + else if BA.length indata `mod` blocksiz /= 0 then let - padding = B.replicate (blocksiz - (B.length indata `mod` blocksiz)) 0 - (r', c') = stream_crypt (nbsc_streamCombine `witness` c) (nc_ctx c) (B.append indata padding) - (r, inc') = B.splitAt (B.length indata) r' - in (r, nbsc_IncompleteState (nc_Ctx c') inc') + padding = BA.replicate (blocksiz - (BA.length indata `mod` blocksiz)) 0 + (r', c') = stream_crypt (nbsc_streamCombine `witness` c) (nc_ctx c) (BA.append indata padding) + (r, inc') = BA.splitAt (BA.length indata) r' + in (r, nbsc_IncompleteState (nc_Ctx c') (BA.convert inc')) else let (r, c') = stream_crypt (nbsc_streamCombine `witness` c) (nc_ctx c) indata in (r, nc_Ctx c') nettle_blockedStreamSetNonce :: NettleBlockedStreamCipher c => c -> B.ByteString -> Maybe c nettle_blockedStreamSetNonce c nonce = case nbsc_setNonce `witness` c of Nothing -> Nothing - Just setnonce -> unsafeDupablePerformIO $ - secureMemCopy (nc_ctx c) >>= \ctx' -> - withSecureMemPtr ctx' $ \ctxptr -> + Just setnonce -> let ctx' = copyScrubbedBytes (nc_ctx c) in + unsafeDupablePerformIO $ + BA.withByteArray ctx' $ \ctxptr -> withByteStringPtr nonce $ \noncelen nonceptr -> setnonce ctxptr noncelen nonceptr >> return (Just $ nc_Ctx ctx') -nettle_gcm_aeadInit :: (NettleBlockCipher c, AEADModeImpl c NettleGCM, Byteable iv) => c -> iv -> Maybe (AEAD c) -nettle_gcm_aeadInit c iv = if nbc_blockSize `witness` c == 16 then Just $ AEAD c $ AEADState $ gcm_init (nbc_encrypt_ctx_offset `witness` c) (nbc_fun_encrypt `witness` c) (nc_ctx c) iv else Nothing -nettle_gcm_aeadStateAppendHeader :: t -> NettleGCM -> B.ByteString -> NettleGCM +nettle_gcm_aeadInit :: (NettleBlockCipher c, NettleAeadModeImpl c NettleGCM, BA.ByteArrayAccess iv) => c -> iv -> CryptoFailable (CCT.AEAD c) +nettle_gcm_aeadInit c iv = if nbc_blockSize `witness` c == 16 then CryptoPassed $ CCT.AEAD {CCT.aeadModeImpl = nettle_aead_mode_impl c, CCT.aeadState = gcm_init (nbc_encrypt_ctx_offset `witness` c) (nbc_fun_encrypt `witness` c) (nc_ctx c) iv} else CryptoFailed CryptoError_AEADModeNotSupported +nettle_gcm_aeadStateAppendHeader :: BA.ByteArrayAccess ba => t -> NettleGCM -> ba -> NettleGCM nettle_gcm_aeadStateAppendHeader _ = gcm_update -nettle_gcm_aeadStateEncrypt :: NettleBlockCipher c => c -> NettleGCM -> B.ByteString -> (B.ByteString, NettleGCM) +nettle_gcm_aeadStateEncrypt :: (NettleBlockCipher c, BA.ByteArrayAccess bin, BA.ByteArray bout) => c -> NettleGCM -> bin -> (bout, NettleGCM) nettle_gcm_aeadStateEncrypt c = gcm_crypt c_gcm_encrypt (nbc_encrypt_ctx_offset `witness` c) (nbc_fun_encrypt `witness` c) (nc_ctx c) -nettle_gcm_aeadStateDecrypt :: NettleBlockCipher c => c -> NettleGCM -> B.ByteString -> (B.ByteString, NettleGCM) +nettle_gcm_aeadStateDecrypt :: (NettleBlockCipher c, BA.ByteArrayAccess bin, BA.ByteArray bout) => c -> NettleGCM -> bin -> (bout, NettleGCM) nettle_gcm_aeadStateDecrypt c = gcm_crypt c_gcm_decrypt (nbc_encrypt_ctx_offset `witness` c) (nbc_fun_encrypt `witness` c) (nc_ctx c) -nettle_gcm_aeadStateFinalize :: NettleBlockCipher c => c -> NettleGCM -> Int -> AuthTag +nettle_gcm_aeadStateFinalize :: NettleBlockCipher c => c -> NettleGCM -> Int -> CCT.AuthTag nettle_gcm_aeadStateFinalize c = gcm_digest (nbc_encrypt_ctx_offset `witness` c) (nbc_fun_encrypt `witness` c) (nc_ctx c) key_init - :: ToSecureMem k + :: BA.ByteArrayAccess k => (Ptr Word8 -> Word -> Ptr Word8 -> IO ()) - -> Int -> k -> SecureMem -key_init initfun size k = unsafeCreateSecureMem size $ \ctxptr -> - withSecureMemPtrSz (toSecureMem k) $ \ksize kptr -> initfun ctxptr (fromIntegral ksize) kptr + -> Int -> k -> BA.ScrubbedBytes +key_init initfun size k = BA.unsafeCreate size $ \ctxptr -> + BA.withByteArray k $ \kptr -> initfun ctxptr (fromIntegral $ BA.length k) kptr -- run encryption/decryption with same length for in and output c_run_crypt - :: (Ptr Word8 -> Ptr Word8) + :: (BA.ByteArrayAccess bin, + BA.ByteArray bout) + => (Ptr Word8 -> Ptr Word8) -> NettleCryptFunc - -> SecureMem -> B.ByteString -> B.ByteString -c_run_crypt ctxoffset cfun ctx indata = unsafeDupablePerformIO $ withSecureMemPtr ctx $ \ctxptr -> - withByteStringPtr indata $ \indatalen indataptr -> - B.create (B.length indata) $ \outptr -> - cfun (ctxoffset ctxptr) indatalen outptr indataptr + -> BA.ScrubbedBytes -> bin -> bout +c_run_crypt ctxoffset cfun ctx indata = unsafeDupablePerformIO $ BA.withByteArray ctx $ \ctxptr -> + BA.withByteArray indata $ \indataptr -> + BA.create (BA.length indata) $ \outptr -> + cfun (ctxoffset ctxptr) (fromIntegral $ BA.length indata) outptr indataptr blockmode_run - :: (Byteable iv) + :: (BA.ByteArrayAccess iv, + BA.ByteArrayAccess bin, + BA.ByteArray bout) => (Ptr Word8 -> Ptr Word8) -> NettleBlockMode -> FunPtr NettleCryptFunc - -> SecureMem -> iv -> B.ByteString -> B.ByteString -blockmode_run ctxoffset mode crypt ctx iv indata = unsafeDupablePerformIO $ withSecureMemPtr ctx $ \ctxptr -> - withByteStringPtr indata $ \indatalen indataptr -> - withSecureMemPtrSz (toSecureMem $ toBytes iv) $ \ivlen ivptr -> -- copy IV, may get modified - B.create (B.length indata) $ \outptr -> - mode (ctxoffset ctxptr) crypt (fromIntegral ivlen) ivptr indatalen outptr indataptr + -> BA.ScrubbedBytes -> iv -> bin -> bout +blockmode_run ctxoffset mode crypt ctx iv indata = let iv' = copyAndConvertToScrubbedBytes iv in -- copy IV, may get modified + unsafeDupablePerformIO $ BA.withByteArray ctx $ \ctxptr -> + BA.withByteArray indata $ \indataptr -> + BA.withByteArray iv' $ \ivptr -> + BA.create (BA.length indata) $ \outptr -> + mode (ctxoffset ctxptr) crypt (fromIntegral $ BA.length iv') ivptr (fromIntegral $ BA.length indata) outptr indataptr -data NettleGCM = NettleGCM !SecureMem !SecureMem +data NettleGCM = NettleGCM !Int !BA.ScrubbedBytes !Int !BA.ScrubbedBytes +-- Nettle 4's GCM implementation uses 16-byte aligned accesses on its contexts, +-- while @ram@'s 'ScrubbedBytes' only guarantees 8-byte alignment. The GCM +-- context buffers are therefore over-allocated with padding, and the pointer +-- handed to C is aligned to a 16-byte boundary. The byte offset to the aligned +-- start of a buffer is stored alongside it; because 'copyScrubbedBytes' would +-- not preserve the alignment of the copied data, copies re-place the context +-- struct into the aligned region of a freshly allocated buffer. +gcm_alignment :: Int +gcm_alignment = 16 + +gcm_alignedSize :: Int -> Int +gcm_alignedSize n = n + gcm_alignment - 1 + +gcm_alignedOffset :: BA.ScrubbedBytes -> Int +gcm_alignedOffset ba = unsafeDupablePerformIO $ + BA.withByteArray ba $ \p -> + return (fromIntegral ((fromIntegral gcm_alignment - ptrToWordPtr p `mod` fromIntegral gcm_alignment) `mod` fromIntegral gcm_alignment)) + +-- | Copy the @size@-byte struct from @src@ (located at @srcOff@) into the +-- aligned region of a fresh zeroed buffer. +gcm_copyAligned + :: Int + -> BA.ScrubbedBytes + -> Int + -> IO (BA.ScrubbedBytes, Int) +gcm_copyAligned size src srcOff = do + dst <- BA.create (gcm_alignedSize size) (return . const ()) + let dstOff = gcm_alignedOffset dst + BA.withByteArray dst $ \dptr -> + BA.withByteArray src $ \sptr -> + copyBytes (dptr `plusPtr` dstOff) (sptr `plusPtr` srcOff) size + return (dst, dstOff) + gcm_init - :: (Byteable iv) + :: BA.ByteArrayAccess iv => (Ptr Word8 -> Ptr Word8) -> FunPtr NettleCryptFunc - -> SecureMem -> iv -> NettleGCM + -> BA.ScrubbedBytes -> iv -> NettleGCM gcm_init encctxoffset encrypt encctx iv = unsafeDupablePerformIO $ - withBytePtr iv $ \ivptr -> - withSecureMemPtr encctx $ \encctxptr -> do - h <- createSecureMem c_gcm_key_size $ \hptr -> - c_gcm_set_key hptr (encctxoffset encctxptr) encrypt - withSecureMemPtr h $ \hptr -> do - ctx <- createSecureMem c_gcm_ctx_size $ \ctxptr -> - c_gcm_set_iv ctxptr hptr (fromIntegral $ byteableLength iv) ivptr - return (NettleGCM ctx h) + BA.withByteArray iv $ \ivptr -> + BA.withByteArray encctx $ \encctxptr -> do + h <- BA.create (gcm_alignedSize c_gcm_key_size) $ \hptr -> + c_gcm_set_key (alignPtr hptr gcm_alignment) (encctxoffset encctxptr) encrypt + ctx <- BA.create (gcm_alignedSize c_gcm_ctx_size) $ \ctxptr -> + BA.withByteArray h $ \hptr -> + c_gcm_set_iv (alignPtr ctxptr gcm_alignment) (alignPtr hptr gcm_alignment) (fromIntegral $ BA.length iv) ivptr + return $ NettleGCM (gcm_alignedOffset ctx) ctx (gcm_alignedOffset h) h -- independent of cipher gcm_update - :: NettleGCM -> B.ByteString -> NettleGCM -gcm_update (NettleGCM ctx h) indata = unsafeDupablePerformIO $ - secureMemCopy ctx >>= \ctx' -> - withSecureMemPtr ctx' $ \ctxptr -> - withSecureMemPtr h $ \hptr -> - withByteStringPtr indata $ \indatalen indataptr -> - c_gcm_update ctxptr hptr indatalen indataptr >> - return (NettleGCM ctx' h) + :: BA.ByteArrayAccess ba => NettleGCM -> ba -> NettleGCM +gcm_update (NettleGCM offCtx ctx offKey h) indata = unsafeDupablePerformIO $ do + (ctx', offCtx') <- gcm_copyAligned c_gcm_ctx_size ctx offCtx + BA.withByteArray ctx' $ \ctxptr -> + BA.withByteArray h $ \hptr -> + BA.withByteArray indata $ \indataptr -> + c_gcm_update (ctxptr `plusPtr` offCtx') (hptr `plusPtr` offKey) (fromIntegral $ BA.length indata) indataptr >> + return (NettleGCM offCtx' ctx' offKey h) gcm_crypt - :: NettleGCMMode + :: (BA.ByteArrayAccess bin, + BA.ByteArray bout) + => NettleGCMMode -> (Ptr Word8 -> Ptr Word8) -> FunPtr NettleCryptFunc - -> SecureMem -> NettleGCM -> B.ByteString -> (B.ByteString, NettleGCM) -gcm_crypt mode encctxoffset encrypt encctx (NettleGCM ctx h) indata = unsafeDupablePerformIO $ - secureMemCopy ctx >>= \ctx' -> - withSecureMemPtr ctx' $ \ctxptr -> - withSecureMemPtr h $ \hptr -> - withSecureMemPtr encctx $ \encctxptr -> - withByteStringPtr indata $ \indatalen indataptr -> do - outdata <- B.create (B.length indata) $ \outptr -> - mode ctxptr hptr (encctxoffset encctxptr) encrypt indatalen outptr indataptr - return (outdata, NettleGCM ctx' h) + -> BA.ScrubbedBytes -> NettleGCM -> bin -> (bout, NettleGCM) +gcm_crypt mode encctxoffset encrypt encctx (NettleGCM offCtx ctx offKey h) indata = unsafeDupablePerformIO $ do + (ctx', offCtx') <- gcm_copyAligned c_gcm_ctx_size ctx offCtx + BA.withByteArray ctx' $ \ctxptr -> + BA.withByteArray h $ \hptr -> + BA.withByteArray encctx $ \encctxptr -> + BA.withByteArray indata $ \indataptr -> do + outdata <- BA.create (BA.length indata) $ \outptr -> + mode (ctxptr `plusPtr` offCtx') (hptr `plusPtr` offKey) (encctxoffset encctxptr) encrypt (fromIntegral $ BA.length indata) outptr indataptr + return (outdata, NettleGCM offCtx' ctx' offKey h) gcm_digest :: (Ptr Word8 -> Ptr Word8) -> FunPtr NettleCryptFunc - -> SecureMem -> NettleGCM -> Int -> AuthTag -gcm_digest encctxoffset encrypt encctx (NettleGCM ctx h) taglen = unsafeDupablePerformIO $ - secureMemCopy ctx >>= \ctx' -> - withSecureMemPtr ctx' $ \ctxptr -> - withSecureMemPtr h $ \hptr -> - withSecureMemPtr encctx $ \encctxptr -> do - tag <- B.create (fromIntegral taglen) $ \tagptr -> - c_gcm_digest ctxptr hptr (encctxoffset encctxptr) encrypt (fromIntegral taglen) tagptr - return $ AuthTag tag + -> BA.ScrubbedBytes -> NettleGCM -> Int -> CCT.AuthTag +gcm_digest encctxoffset encrypt encctx (NettleGCM offCtx ctx offKey h) taglen = unsafeDupablePerformIO $ do + (ctx', offCtx') <- gcm_copyAligned c_gcm_ctx_size ctx offCtx + BA.withByteArray ctx' $ \ctxptr -> + BA.withByteArray h $ \hptr -> + BA.withByteArray encctx $ \encctxptr -> do + tag <- BA.create (fromIntegral taglen) $ \tagptr -> + callNettleGcmDigest (ctxptr `plusPtr` offCtx') (hptr `plusPtr` offKey) (encctxoffset encctxptr) encrypt (fromIntegral taglen) tagptr + return $ CCT.AuthTag tag stream_crypt - :: NettleCryptFunc - -> SecureMem -> B.ByteString -> (B.ByteString, SecureMem) -stream_crypt crypt ctx indata = unsafeDupablePerformIO $ - secureMemCopy ctx >>= \ctx' -> - withSecureMemPtr ctx' $ \ctxptr -> - withByteStringPtr indata $ \indatalen indataptr -> do - outdata <- B.create (B.length indata) $ \outptr -> - crypt ctxptr indatalen outptr indataptr + :: (BA.ByteArrayAccess bin, + BA.ByteArray bout) + => NettleCryptFunc + -> BA.ScrubbedBytes -> bin -> (bout, BA.ScrubbedBytes) +stream_crypt crypt ctx indata = let ctx' = copyScrubbedBytes ctx in + unsafeDupablePerformIO $ + BA.withByteArray ctx' $ \ctxptr -> + BA.withByteArray indata $ \indataptr -> do + outdata <- BA.create (BA.length indata) $ \outptr -> + crypt ctxptr (fromIntegral $ BA.length indata) outptr indataptr return (outdata, ctx') diff --git a/src/Crypto/Nettle/EAX.hs b/src/Crypto/Nettle/EAX.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Nettle/EAX.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +{- | +Module : Crypto.Nettle.EAX +Copyright : (c) 2026 Clint Adams +License : MIT-style (see the file COPYING) + +Maintainer : clint@debian.org +Stability : experimental +Portability : portable + +This module exports the EAX authenticated-encryption with associated-data +(AEAD) construction (Bellare, Rogaway, Wagner; NIST) based on AES-128, +as supported by nettle: + +-} +module Crypto.Nettle.EAX + ( -- * EAX + + -- + -- No streaming interface is provided, as this basically violates the + -- spirit of the "AEAD-should-be-simple-to-use" concept - you only can + -- use the decrypted data after it got successfully verified. + + eaxAES128Encrypt + , eaxAES128Decrypt + ) where + +import qualified Data.ByteArray as BA +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B + +import Crypto.Nettle.Ciphers.ForeignImports +import Nettle.Utils + +{- | +Encrypt plain text and create a verification tag for the encrypted text and some additional data. +@key@ and @nonce@ must not be reused together. +The returned tag is 16 bytes long, but may be shortened for verification (losing security). +-} +eaxAES128Encrypt + :: B.ByteString + -- ^ @key@ (must be 16 bytes) + -> B.ByteString + -- ^ @nonce@ + -> B.ByteString + -- ^ @aad@ additional data to be verified + -> B.ByteString + -- ^ @plain@ data to encrypt + -> (B.ByteString, B.ByteString) + -- ^ returns (@cipher@, @tag@) ciphertext and verification tag +eaxAES128Encrypt key nonce aad plain = unsafeDupablePerformIO $ do + let k = copyAndConvertToScrubbedBytes key + tag <- B.create 16 (\_ -> return ()) + cipher <- B.create (B.length plain) (\_ -> return ()) + _ <- withByteStringPtr plain $ \psize pptr -> + withByteStringPtr aad $ \aadsize aadptr -> + withByteStringPtr cipher $ \_ cipherptr -> + withByteStringPtr tag $ \_ tagptr -> + alignedCtxCreate c_eax_aes128_ctx_size $ \ctxptr -> + BA.withByteArray k $ \kptr -> + if BA.length k /= 16 + then error "Invalid key length" + else withByteStringPtr nonce $ \noncesize nonceptr -> do + c_eax_aes128_set_key ctxptr kptr + c_eax_aes128_set_nonce ctxptr noncesize nonceptr + c_eax_aes128_update ctxptr aadsize aadptr + c_eax_aes128_encrypt ctxptr psize cipherptr pptr + callNettleHashDigest c_eax_aes128_digest 16 ctxptr tagptr + return (cipher, tag) + +{- | +Decrypt cipher text and verify a (possible shortened) tag for the encrypted text and some additional data. +@key@ and @nonce@ must not be reused together. +-} +eaxAES128Decrypt + :: B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> Maybe B.ByteString +eaxAES128Decrypt key nonce aad cipher verifytag = unsafeDupablePerformIO $ do + let k = copyAndConvertToScrubbedBytes key + tag <- B.create 16 (\_ -> return ()) + plain <- B.create (B.length cipher) (\_ -> return ()) + _ <- withByteStringPtr cipher $ \psize pptr -> + withByteStringPtr aad $ \aadsize aadptr -> + withByteStringPtr plain $ \_ plainptr -> + withByteStringPtr tag $ \_ tagptr -> + alignedCtxCreate c_eax_aes128_ctx_size $ \ctxptr -> + BA.withByteArray k $ \kptr -> + if BA.length k /= 16 + then error "Invalid key length" + else withByteStringPtr nonce $ \noncesize nonceptr -> do + c_eax_aes128_set_key ctxptr kptr + c_eax_aes128_set_nonce ctxptr noncesize nonceptr + c_eax_aes128_update ctxptr aadsize aadptr + c_eax_aes128_decrypt ctxptr psize plainptr pptr + callNettleHashDigest c_eax_aes128_digest 16 ctxptr tagptr + if B.take (B.length verifytag) tag == verifytag + then return $ Just plain + else return Nothing diff --git a/src/Crypto/Nettle/Hash.hs b/src/Crypto/Nettle/Hash.hs --- a/src/Crypto/Nettle/Hash.hs +++ b/src/Crypto/Nettle/Hash.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - ----------------------------------------------------------------------------- -- | -- Module : Crypto.Nettle.Hash @@ -15,6 +13,8 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE CPP #-} + module Crypto.Nettle.Hash ( -- * HashAlgorithm class HashAlgorithm(..) @@ -58,13 +58,18 @@ , SHA3_256 , SHA3_384 , SHA3_512 + -- ** SM3 + , SM3 + -- ** STREEBOG + , STREEBOG512 + , STREEBOG256 ) where import Crypto.Nettle.Hash.ForeignImports import Crypto.Nettle.Hash.Types import Nettle.Utils -import Data.SecureMem +import qualified Data.ByteArray as BA import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B @@ -81,23 +86,23 @@ nettleHashInit = untagSelf $ do size <- nha_ctx_size initfun <- nha_init - return $ nha_Ctx $ unsafeCreateSecureMem size $ \ctxptr -> + return $ nha_Ctx $ BA.unsafeCreate size $ \ctxptr -> initfun ctxptr nettleHashUpdate :: NettleHashAlgorithm a => a -> B.ByteString -> a nettleHashUpdate c msg = untagSelf $ do updatefun <- nha_update - return $ nha_Ctx $ unsafeDupablePerformIO $ - withSecureMemCopy (nha_ctx c) $ \ctxptr -> + return $ nha_Ctx $ BA.copyAndFreeze (nha_ctx c) $ \ctxptr -> withByteStringPtr msg $ \msglen msgptr -> updatefun ctxptr msglen msgptr nettleHashFinalize :: NettleHashAlgorithm a => a -> B.ByteString nettleHashFinalize c = flip witness c $ do + let ctx = copyScrubbedBytes (nha_ctx c) digestSize <- nha_digest_size digestfun <- nha_digest return $ unsafeDupablePerformIO $ B.create digestSize $ \digestptr -> do - _ <- withSecureMemCopy (nha_ctx c) $ \ctxptr -> - digestfun ctxptr (fromIntegral digestSize) digestptr + _ <- BA.withByteArray ctx $ \ctxptr -> + callNettleHashDigest digestfun digestSize ctxptr digestptr return () class NettleHashAlgorithm a where @@ -108,8 +113,8 @@ nha_init :: Tagged a NettleHashInit nha_update :: Tagged a NettleHashUpdate nha_digest :: Tagged a NettleHashDigest - nha_ctx :: a -> SecureMem - nha_Ctx :: SecureMem -> a + nha_ctx :: a -> BA.ScrubbedBytes + nha_Ctx :: BA.ScrubbedBytes -> a #define INSTANCE_HASH(Typ) \ instance HashAlgorithm Typ where \ @@ -123,7 +128,7 @@ -- | The GOST94 or GOST R 34.11-94 hash algorithm is a Soviet-era algorithm used in Russian government standards (see RFC 4357). -- It outputs message digests of 32 bytes (256 bits). -data GOSTHASH94 = GOSTHASH94 { gosthash94_ctx :: SecureMem } +data GOSTHASH94 = GOSTHASH94 { gosthash94_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm GOSTHASH94 where nha_ctx_size = Tagged c_gosthash94_ctx_size nha_block_size = Tagged c_gosthash94_block_size @@ -139,7 +144,7 @@ -- | 'MD2' is a hash function of Ronald Rivest's, described in RFC 1319. It outputs message digests of 16 bytes (128 bits). -data MD2 = MD2 { md2_ctx :: SecureMem } +data MD2 = MD2 { md2_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm MD2 where nha_ctx_size = Tagged c_md2_ctx_size nha_block_size = Tagged c_md2_block_size @@ -153,7 +158,7 @@ INSTANCE_HASH(MD2) -- | 'MD4' is a hash function of Ronald Rivest's, described in RFC 1320. It outputs message digests of 16 bytes (128 bits). -data MD4 = MD4 { md4_ctx :: SecureMem } +data MD4 = MD4 { md4_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm MD4 where nha_ctx_size = Tagged c_md4_ctx_size nha_block_size = Tagged c_md4_block_size @@ -167,7 +172,7 @@ INSTANCE_HASH(MD4) -- | 'MD5' is a hash function of Ronald Rivest's, described in RFC 1321. It outputs message digests of 16 bytes (128 bits). -data MD5 = MD5 { md5_ctx :: SecureMem } +data MD5 = MD5 { md5_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm MD5 where nha_ctx_size = Tagged c_md5_ctx_size nha_block_size = Tagged c_md5_block_size @@ -182,7 +187,7 @@ -- | 'RIPEMD160' is a hash function designed by Hans Dobbertin, Antoon Bosselaers, and Bart Preneel, as a strengthened version of RIPEMD. -- It produces message digests of 20 bytes (160 bits). -data RIPEMD160 = RIPEMD160 { ripemd160_ctx :: SecureMem } +data RIPEMD160 = RIPEMD160 { ripemd160_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm RIPEMD160 where nha_ctx_size = Tagged c_ripemd160_ctx_size nha_block_size = Tagged c_ripemd160_block_size @@ -198,7 +203,7 @@ -- | 'SHA1' is a hash function specified by NIST (The U.S. National Institute for Standards and Technology). -- It produces message digests of 20 bytes (160 bits). -data SHA1 = SHA1 { sha1_ctx :: SecureMem } +data SHA1 = SHA1 { sha1_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm SHA1 where nha_ctx_size = Tagged c_sha1_ctx_size nha_block_size = Tagged c_sha1_block_size @@ -212,7 +217,7 @@ INSTANCE_HASH(SHA1) -- | 'SHA224' is a member of the SHA2 family which outputs messages digests of 28 bytes (224 bits). -data SHA224 = SHA224 { sha224_ctx :: SecureMem } +data SHA224 = SHA224 { sha224_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm SHA224 where nha_ctx_size = Tagged c_sha224_ctx_size nha_block_size = Tagged c_sha224_block_size @@ -226,7 +231,7 @@ INSTANCE_HASH(SHA224) -- | 'SHA256' is a member of the SHA2 family which outputs messages digests of 32 bytes (256 bits). -data SHA256 = SHA256 { sha256_ctx :: SecureMem } +data SHA256 = SHA256 { sha256_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm SHA256 where nha_ctx_size = Tagged c_sha256_ctx_size nha_block_size = Tagged c_sha256_block_size @@ -240,7 +245,7 @@ INSTANCE_HASH(SHA256) -- | 'SHA384' is a member of the SHA2 family which outputs messages digests of 48 bytes (384 bits). -data SHA384 = SHA384 { sha384_ctx :: SecureMem } +data SHA384 = SHA384 { sha384_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm SHA384 where nha_ctx_size = Tagged c_sha384_ctx_size nha_block_size = Tagged c_sha384_block_size @@ -254,7 +259,7 @@ INSTANCE_HASH(SHA384) -- | 'SHA512' is a member of the SHA2 family which outputs messages digests of 64 bytes (512 bits). -data SHA512 = SHA512 { sha512_ctx :: SecureMem } +data SHA512 = SHA512 { sha512_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm SHA512 where nha_ctx_size = Tagged c_sha512_ctx_size nha_block_size = Tagged c_sha512_block_size @@ -268,7 +273,7 @@ INSTANCE_HASH(SHA512) -- | 'SHA3_224' is a member of the SHA3 family which outputs messages digests of 28 bytes (224 bits). -data SHA3_224 = SHA3_224 { sha3_224_ctx :: SecureMem } +data SHA3_224 = SHA3_224 { sha3_224_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm SHA3_224 where nha_ctx_size = Tagged c_sha3_224_ctx_size nha_block_size = Tagged c_sha3_224_block_size @@ -282,7 +287,7 @@ INSTANCE_HASH(SHA3_224) -- | 'SHA3_256' is a member of the SHA3 family which outputs messages digests of 32 bytes (256 bits). -data SHA3_256 = SHA3_256 { sha3_256_ctx :: SecureMem } +data SHA3_256 = SHA3_256 { sha3_256_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm SHA3_256 where nha_ctx_size = Tagged c_sha3_256_ctx_size nha_block_size = Tagged c_sha3_256_block_size @@ -296,7 +301,7 @@ INSTANCE_HASH(SHA3_256) -- | 'SHA3_384' is a member of the SHA3 family which outputs messages digests of 48 bytes (384 bits). -data SHA3_384 = SHA3_384 { sha3_384_ctx :: SecureMem } +data SHA3_384 = SHA3_384 { sha3_384_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm SHA3_384 where nha_ctx_size = Tagged c_sha3_384_ctx_size nha_block_size = Tagged c_sha3_384_block_size @@ -310,7 +315,7 @@ INSTANCE_HASH(SHA3_384) -- | 'SHA3_512' is a member of the SHA3 family which outputs messages digests of 64 bytes (512 bits). -data SHA3_512 = SHA3_512 { sha3_512_ctx :: SecureMem } +data SHA3_512 = SHA3_512 { sha3_512_ctx :: BA.ScrubbedBytes } instance NettleHashAlgorithm SHA3_512 where nha_ctx_size = Tagged c_sha3_512_ctx_size nha_block_size = Tagged c_sha3_512_block_size @@ -322,3 +327,51 @@ nha_ctx = sha3_512_ctx nha_Ctx = SHA3_512 INSTANCE_HASH(SHA3_512) + +-- | 'SM3' is a Chinese national standard hash function (GB/T 32905-2016), +-- used in the Chinese National Cryptography Standard. It outputs message +-- digests of 32 bytes (256 bits). +data SM3 = SM3 { sm3_ctx :: BA.ScrubbedBytes } +instance NettleHashAlgorithm SM3 where + nha_ctx_size = Tagged c_sm3_ctx_size + nha_block_size = Tagged c_sm3_block_size + nha_digest_size = Tagged c_sm3_digest_size + nha_name = Tagged "SM3" + nha_init = Tagged c_sm3_init + nha_update = Tagged c_sm3_update + nha_digest = Tagged c_sm3_digest + nha_ctx = sm3_ctx + nha_Ctx = SM3 +INSTANCE_HASH(SM3) + +-- | 'STREEBOG512' is the 512-bit variant of STREEBOG, the Russian national +-- standard hash function (GOST R 34.11-2012). It outputs message digests of +-- 64 bytes (512 bits). +data STREEBOG512 = STREEBOG512 { streebog512_ctx :: BA.ScrubbedBytes } +instance NettleHashAlgorithm STREEBOG512 where + nha_ctx_size = Tagged c_streebog512_ctx_size + nha_block_size = Tagged c_streebog512_block_size + nha_digest_size = Tagged c_streebog512_digest_size + nha_name = Tagged "STREEBOG512" + nha_init = Tagged c_streebog512_init + nha_update = Tagged c_streebog512_update + nha_digest = Tagged c_streebog512_digest + nha_ctx = streebog512_ctx + nha_Ctx = STREEBOG512 +INSTANCE_HASH(STREEBOG512) + +-- | 'STREEBOG256' is the 256-bit variant of STREEBOG, the Russian national +-- standard hash function (GOST R 34.11-2012). It outputs message digests of +-- 32 bytes (256 bits). +data STREEBOG256 = STREEBOG256 { streebog256_ctx :: BA.ScrubbedBytes } +instance NettleHashAlgorithm STREEBOG256 where + nha_ctx_size = Tagged c_streebog256_ctx_size + nha_block_size = Tagged c_streebog256_block_size + nha_digest_size = Tagged c_streebog256_digest_size + nha_name = Tagged "STREEBOG256" + nha_init = Tagged c_streebog256_init + nha_update = Tagged c_streebog256_update + nha_digest = Tagged c_streebog256_digest + nha_ctx = streebog256_ctx + nha_Ctx = STREEBOG256 +INSTANCE_HASH(STREEBOG256) diff --git a/src/Crypto/Nettle/Hash/ForeignImports.hsc b/src/Crypto/Nettle/Hash/ForeignImports.hsc --- a/src/Crypto/Nettle/Hash/ForeignImports.hsc +++ b/src/Crypto/Nettle/Hash/ForeignImports.hsc @@ -1,11 +1,13 @@ {-# OPTIONS_HADDOCK hide #-} -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ForeignFunctionInterface, CPP #-} module Crypto.Nettle.Hash.ForeignImports ( NettleHashInit , NettleHashUpdate , NettleHashDigest + , callNettleHashDigest + , c_sha256_ctx_size , c_sha256_digest_size , c_sha256_block_size @@ -34,6 +36,10 @@ , c_sha384_update , c_sha384_digest +#if (NETTLE_VERSION_MAJOR > 3) + , c_sha3_init +#endif + , c_sha3_224_ctx_size , c_sha3_224_digest_size , c_sha3_224_block_size @@ -62,6 +68,35 @@ , c_sha3_512_update , c_sha3_512_digest + , c_sm3_ctx_size + , c_sm3_digest_size + , c_sm3_block_size + , c_sm3_init + , c_sm3_update + , c_sm3_digest + + , c_streebog512_ctx_size + , c_streebog512_digest_size + , c_streebog512_block_size + , c_streebog512_init + , c_streebog512_update + , c_streebog512_digest + + , c_streebog256_ctx_size + , c_streebog256_digest_size + , c_streebog256_block_size + , c_streebog256_init + , c_streebog256_update + , c_streebog256_digest + +#if (NETTLE_VERSION_MAJOR > 3 || (NETTLE_VERSION_MAJOR == 3 && NETTLE_VERSION_MINOR >= 10)) + , c_sha3_128_ctx_size + , c_sha3_128_init + , c_sha3_128_update + , c_sha3_128_shake +#endif + , c_sha3_256_shake + , c_md5_ctx_size , c_md5_digest_size , c_md5_block_size @@ -131,6 +166,28 @@ , c_umac128_set_nonce , c_umac128_update , c_umac128_digest + + , c_cmac_aes128_ctx_size + , c_cmac_aes128_set_key + , c_cmac_aes128_update + , c_cmac_aes128_digest + + , c_cmac_aes256_ctx_size + , c_cmac_aes256_set_key + , c_cmac_aes256_update + , c_cmac_aes256_digest + + , c_cmac_des3_ctx_size + , c_cmac_des3_set_key + , c_cmac_des3_update + , c_cmac_des3_digest + + , c_poly1305_aes_ctx_size + , c_poly1305_aes_digest_size + , c_poly1305_aes_set_key + , c_poly1305_aes_set_nonce + , c_poly1305_aes_update + , c_poly1305_aes_digest ) where import Nettle.Utils @@ -142,14 +199,29 @@ type NettleHashInit = Ptr Word8 -> IO () type NettleHashUpdate = Ptr Word8 -> Word -> Ptr Word8 -> IO () +#if (NETTLE_VERSION_MAJOR > 3) +type NettleHashDigest = Ptr Word8 -> Ptr Word8 -> IO () +#else type NettleHashDigest = Ptr Word8 -> Word -> Ptr Word8 -> IO () +#endif +-- | Call a nettle @*_digest@ function, adapting to the Nettle API. +-- Nettle 4 dropped the @digest_size@ argument; the @digestSize@ argument +-- is only used on Nettle 3.x. +callNettleHashDigest :: NettleHashDigest -> Int -> Ptr Word8 -> Ptr Word8 -> IO () +#if (NETTLE_VERSION_MAJOR > 3) +callNettleHashDigest digestfun _digestSize ctxptr digestptr = digestfun ctxptr digestptr +#else +callNettleHashDigest digestfun digestSize ctxptr digestptr = digestfun ctxptr (fromIntegral digestSize) digestptr +#endif + + c_sha256_ctx_size :: Int c_sha256_ctx_size = #{size struct sha256_ctx} c_sha256_digest_size :: Int c_sha256_digest_size = #{const SHA256_DIGEST_SIZE} c_sha256_block_size :: Int -c_sha256_block_size = #{const SHA256_DATA_SIZE} +c_sha256_block_size = #{const SHA256_BLOCK_SIZE} foreign import ccall unsafe "nettle_sha256_init" c_sha256_init :: NettleHashInit foreign import ccall unsafe "nettle_sha256_update" @@ -162,7 +234,7 @@ c_sha224_digest_size :: Int c_sha224_digest_size = #{const SHA224_DIGEST_SIZE} c_sha224_block_size :: Int -c_sha224_block_size = #{const SHA224_DATA_SIZE} +c_sha224_block_size = #{const SHA224_BLOCK_SIZE} foreign import ccall unsafe "nettle_sha224_init" c_sha224_init :: NettleHashInit foreign import ccall unsafe "nettle_sha256_update" @@ -175,7 +247,7 @@ c_sha512_digest_size :: Int c_sha512_digest_size = #{const SHA512_DIGEST_SIZE} c_sha512_block_size :: Int -c_sha512_block_size = #{const SHA512_DATA_SIZE} +c_sha512_block_size = #{const SHA512_BLOCK_SIZE} foreign import ccall unsafe "nettle_sha512_init" c_sha512_init :: NettleHashInit foreign import ccall unsafe "nettle_sha512_update" @@ -188,7 +260,7 @@ c_sha384_digest_size :: Int c_sha384_digest_size = #{const SHA384_DIGEST_SIZE} c_sha384_block_size :: Int -c_sha384_block_size = #{const SHA384_DATA_SIZE} +c_sha384_block_size = #{const SHA384_BLOCK_SIZE} foreign import ccall unsafe "nettle_sha384_init" c_sha384_init :: NettleHashInit foreign import ccall unsafe "nettle_sha512_update" @@ -201,9 +273,30 @@ c_sha3_224_digest_size :: Int c_sha3_224_digest_size = #{const SHA3_224_DIGEST_SIZE} c_sha3_224_block_size :: Int -c_sha3_224_block_size = #{const SHA3_224_DATA_SIZE} +c_sha3_224_block_size = #{const SHA3_224_BLOCK_SIZE} +#if (NETTLE_VERSION_MAJOR > 3) +foreign import ccall unsafe "nettle_sha3_init" + c_sha3_init :: NettleHashInit + +-- Nettle 4 uses one context struct and init function for all SHA3 variants +c_sha3_224_init :: NettleHashInit +c_sha3_224_init = c_sha3_init +c_sha3_256_init :: NettleHashInit +c_sha3_256_init = c_sha3_init +c_sha3_384_init :: NettleHashInit +c_sha3_384_init = c_sha3_init +c_sha3_512_init :: NettleHashInit +c_sha3_512_init = c_sha3_init +#else foreign import ccall unsafe "nettle_sha3_224_init" c_sha3_224_init :: NettleHashInit +foreign import ccall unsafe "nettle_sha3_256_init" + c_sha3_256_init :: NettleHashInit +foreign import ccall unsafe "nettle_sha3_384_init" + c_sha3_384_init :: NettleHashInit +foreign import ccall unsafe "nettle_sha3_512_init" + c_sha3_512_init :: NettleHashInit +#endif foreign import ccall unsafe "nettle_sha3_224_update" c_sha3_224_update :: NettleHashUpdate foreign import ccall unsafe "nettle_sha3_224_digest" @@ -214,9 +307,7 @@ c_sha3_256_digest_size :: Int c_sha3_256_digest_size = #{const SHA3_256_DIGEST_SIZE} c_sha3_256_block_size :: Int -c_sha3_256_block_size = #{const SHA3_256_DATA_SIZE} -foreign import ccall unsafe "nettle_sha3_256_init" - c_sha3_256_init :: NettleHashInit +c_sha3_256_block_size = #{const SHA3_256_BLOCK_SIZE} foreign import ccall unsafe "nettle_sha3_256_update" c_sha3_256_update :: NettleHashUpdate foreign import ccall unsafe "nettle_sha3_256_digest" @@ -227,9 +318,7 @@ c_sha3_384_digest_size :: Int c_sha3_384_digest_size = #{const SHA3_384_DIGEST_SIZE} c_sha3_384_block_size :: Int -c_sha3_384_block_size = #{const SHA3_384_DATA_SIZE} -foreign import ccall unsafe "nettle_sha3_384_init" - c_sha3_384_init :: NettleHashInit +c_sha3_384_block_size = #{const SHA3_384_BLOCK_SIZE} foreign import ccall unsafe "nettle_sha3_384_update" c_sha3_384_update :: NettleHashUpdate foreign import ccall unsafe "nettle_sha3_384_digest" @@ -240,20 +329,77 @@ c_sha3_512_digest_size :: Int c_sha3_512_digest_size = #{const SHA3_512_DIGEST_SIZE} c_sha3_512_block_size :: Int -c_sha3_512_block_size = #{const SHA3_512_DATA_SIZE} -foreign import ccall unsafe "nettle_sha3_512_init" - c_sha3_512_init :: NettleHashInit +c_sha3_512_block_size = #{const SHA3_512_BLOCK_SIZE} foreign import ccall unsafe "nettle_sha3_512_update" c_sha3_512_update :: NettleHashUpdate foreign import ccall unsafe "nettle_sha3_512_digest" c_sha3_512_digest :: NettleHashDigest +c_sm3_ctx_size :: Int +c_sm3_ctx_size = #{size struct sm3_ctx} +c_sm3_digest_size :: Int +c_sm3_digest_size = #{const SM3_DIGEST_SIZE} +c_sm3_block_size :: Int +c_sm3_block_size = #{const SM3_BLOCK_SIZE} +foreign import ccall unsafe "nettle_sm3_init" + c_sm3_init :: NettleHashInit +foreign import ccall unsafe "nettle_sm3_update" + c_sm3_update :: NettleHashUpdate +foreign import ccall unsafe "nettle_sm3_digest" + c_sm3_digest :: NettleHashDigest + +c_streebog512_ctx_size :: Int +c_streebog512_ctx_size = #{size struct streebog512_ctx} +c_streebog512_digest_size :: Int +c_streebog512_digest_size = #{const STREEBOG512_DIGEST_SIZE} +c_streebog512_block_size :: Int +c_streebog512_block_size = #{const STREEBOG512_BLOCK_SIZE} +foreign import ccall unsafe "nettle_streebog512_init" + c_streebog512_init :: NettleHashInit +foreign import ccall unsafe "nettle_streebog512_update" + c_streebog512_update :: NettleHashUpdate +foreign import ccall unsafe "nettle_streebog512_digest" + c_streebog512_digest :: NettleHashDigest + +c_streebog256_ctx_size :: Int +c_streebog256_ctx_size = #{size struct streebog256_ctx} +c_streebog256_digest_size :: Int +c_streebog256_digest_size = #{const STREEBOG256_DIGEST_SIZE} +c_streebog256_block_size :: Int +c_streebog256_block_size = #{const STREEBOG256_BLOCK_SIZE} +foreign import ccall unsafe "nettle_streebog256_init" + c_streebog256_init :: NettleHashInit +foreign import ccall unsafe "nettle_streebog512_update" + c_streebog256_update :: NettleHashUpdate +foreign import ccall unsafe "nettle_streebog256_digest" + c_streebog256_digest :: NettleHashDigest + +-- SHAKE128 was added in Nettle 3.10 and is not available in 3.9.x. +-- SHAKE256 reuses the SHA3-256 context and update function from above. +#if (NETTLE_VERSION_MAJOR > 3 || (NETTLE_VERSION_MAJOR == 3 && NETTLE_VERSION_MINOR >= 10)) +c_sha3_128_ctx_size :: Int +c_sha3_128_ctx_size = #{size struct sha3_128_ctx} +#if (NETTLE_VERSION_MAJOR > 3) +foreign import ccall unsafe "nettle_sha3_init" + c_sha3_128_init :: NettleHashInit +#else +foreign import ccall unsafe "nettle_sha3_128_init" + c_sha3_128_init :: NettleHashInit +#endif +foreign import ccall unsafe "nettle_sha3_128_update" + c_sha3_128_update :: NettleHashUpdate +foreign import ccall unsafe "nettle_sha3_128_shake" + c_sha3_128_shake :: Ptr Word8 -> Word -> Ptr Word8 -> IO () +#endif +foreign import ccall unsafe "nettle_sha3_256_shake" + c_sha3_256_shake :: Ptr Word8 -> Word -> Ptr Word8 -> IO () + c_md5_ctx_size :: Int c_md5_ctx_size = #{size struct md5_ctx} c_md5_digest_size :: Int c_md5_digest_size = #{const MD5_DIGEST_SIZE} c_md5_block_size :: Int -c_md5_block_size = #{const MD5_DATA_SIZE} +c_md5_block_size = #{const MD5_BLOCK_SIZE} foreign import ccall unsafe "nettle_md5_init" c_md5_init :: NettleHashInit foreign import ccall unsafe "nettle_md5_update" @@ -266,7 +412,7 @@ c_md2_digest_size :: Int c_md2_digest_size = #{const MD2_DIGEST_SIZE} c_md2_block_size :: Int -c_md2_block_size = #{const MD2_DATA_SIZE} +c_md2_block_size = #{const MD2_BLOCK_SIZE} foreign import ccall unsafe "nettle_md2_init" c_md2_init :: NettleHashInit foreign import ccall unsafe "nettle_md2_update" @@ -279,7 +425,7 @@ c_md4_digest_size :: Int c_md4_digest_size = #{const MD4_DIGEST_SIZE} c_md4_block_size :: Int -c_md4_block_size = #{const MD4_DATA_SIZE} +c_md4_block_size = #{const MD4_BLOCK_SIZE} foreign import ccall unsafe "nettle_md4_init" c_md4_init :: NettleHashInit foreign import ccall unsafe "nettle_md4_update" @@ -292,7 +438,7 @@ c_ripemd160_digest_size :: Int c_ripemd160_digest_size = #{const RIPEMD160_DIGEST_SIZE} c_ripemd160_block_size :: Int -c_ripemd160_block_size = #{const RIPEMD160_DATA_SIZE} +c_ripemd160_block_size = #{const RIPEMD160_BLOCK_SIZE} foreign import ccall unsafe "nettle_ripemd160_init" c_ripemd160_init :: NettleHashInit foreign import ccall unsafe "nettle_ripemd160_update" @@ -305,7 +451,7 @@ c_sha1_digest_size :: Int c_sha1_digest_size = #{const SHA1_DIGEST_SIZE} c_sha1_block_size :: Int -c_sha1_block_size = #{const SHA1_DATA_SIZE} +c_sha1_block_size = #{const SHA1_BLOCK_SIZE} foreign import ccall unsafe "nettle_sha1_init" c_sha1_init :: NettleHashInit foreign import ccall unsafe "nettle_sha1_update" @@ -318,7 +464,7 @@ c_gosthash94_digest_size :: Int c_gosthash94_digest_size = #{const GOSTHASH94_DIGEST_SIZE} c_gosthash94_block_size :: Int -c_gosthash94_block_size = #{const GOSTHASH94_DATA_SIZE} +c_gosthash94_block_size = #{const GOSTHASH94_BLOCK_SIZE} foreign import ccall unsafe "nettle_gosthash94_init" c_gosthash94_init :: NettleHashInit foreign import ccall unsafe "nettle_gosthash94_update" @@ -338,7 +484,7 @@ foreign import ccall unsafe "nettle_umac32_update" c_umac32_update :: Ptr Word8 -> Word -> Ptr Word8 -> IO () foreign import ccall unsafe "nettle_umac32_digest" - c_umac32_digest :: Ptr Word8 -> Word -> Ptr Word8 -> IO () + c_umac32_digest :: NettleHashDigest c_umac64_ctx_size :: Int c_umac64_ctx_size = #{size struct umac64_ctx} @@ -351,7 +497,7 @@ foreign import ccall unsafe "nettle_umac64_update" c_umac64_update :: Ptr Word8 -> Word -> Ptr Word8 -> IO () foreign import ccall unsafe "nettle_umac64_digest" - c_umac64_digest :: Ptr Word8 -> Word -> Ptr Word8 -> IO () + c_umac64_digest :: NettleHashDigest c_umac96_ctx_size :: Int c_umac96_ctx_size = #{size struct umac96_ctx} @@ -364,7 +510,7 @@ foreign import ccall unsafe "nettle_umac96_update" c_umac96_update :: Ptr Word8 -> Word -> Ptr Word8 -> IO () foreign import ccall unsafe "nettle_umac96_digest" - c_umac96_digest :: Ptr Word8 -> Word -> Ptr Word8 -> IO () + c_umac96_digest :: NettleHashDigest c_umac128_ctx_size :: Int c_umac128_ctx_size = #{size struct umac128_ctx} @@ -377,4 +523,44 @@ foreign import ccall unsafe "nettle_umac128_update" c_umac128_update :: Ptr Word8 -> Word -> Ptr Word8 -> IO () foreign import ccall unsafe "nettle_umac128_digest" - c_umac128_digest :: Ptr Word8 -> Word -> Ptr Word8 -> IO () + c_umac128_digest :: NettleHashDigest + +c_cmac_aes128_ctx_size :: Int +c_cmac_aes128_ctx_size = #{size struct cmac_aes128_ctx} +foreign import ccall unsafe "nettle_cmac_aes128_set_key" + c_cmac_aes128_set_key :: Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_cmac_aes128_update" + c_cmac_aes128_update :: Ptr Word8 -> Word -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_cmac_aes128_digest" + c_cmac_aes128_digest :: NettleHashDigest + +c_cmac_aes256_ctx_size :: Int +c_cmac_aes256_ctx_size = #{size struct cmac_aes256_ctx} +foreign import ccall unsafe "nettle_cmac_aes256_set_key" + c_cmac_aes256_set_key :: Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_cmac_aes256_update" + c_cmac_aes256_update :: Ptr Word8 -> Word -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_cmac_aes256_digest" + c_cmac_aes256_digest :: NettleHashDigest + +c_cmac_des3_ctx_size :: Int +c_cmac_des3_ctx_size = #{size struct cmac_des3_ctx} +foreign import ccall unsafe "nettle_cmac_des3_set_key" + c_cmac_des3_set_key :: Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_cmac_des3_update" + c_cmac_des3_update :: Ptr Word8 -> Word -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_cmac_des3_digest" + c_cmac_des3_digest :: NettleHashDigest + +c_poly1305_aes_ctx_size :: Int +c_poly1305_aes_ctx_size = #{size struct poly1305_aes_ctx} +c_poly1305_aes_digest_size :: Int +c_poly1305_aes_digest_size = #{const POLY1305_AES_DIGEST_SIZE} +foreign import ccall unsafe "nettle_poly1305_aes_set_key" + c_poly1305_aes_set_key :: Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_poly1305_aes_set_nonce" + c_poly1305_aes_set_nonce :: Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_poly1305_aes_update" + c_poly1305_aes_update :: Ptr Word8 -> Word -> Ptr Word8 -> IO () +foreign import ccall unsafe "nettle_poly1305_aes_digest" + c_poly1305_aes_digest :: NettleHashDigest diff --git a/src/Crypto/Nettle/OCB.hs b/src/Crypto/Nettle/OCB.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Nettle/OCB.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +{- | +Module : Crypto.Nettle.OCB +Copyright : (c) 2026 Clint Adams +License : MIT-style (see the file COPYING) + +Maintainer : clint@debian.org +Stability : experimental +Portability : portable + +This module exports the OCB authenticated-encryption with associated-data +(AEAD) construction (Rogaway, "Efficient Authenticated Encryption with +Associated Data") based on AES-128, as supported by nettle: + + +The one-shot @ocb_aes128_decrypt_message@ function in Nettle 4.0 is broken +(it passes the address of the decryption context instead of the context +itself, breaking messages of 16 bytes or larger); the streaming primitives +are used instead, which work on all supported Nettle versions. +-} +module Crypto.Nettle.OCB + ( -- * OCB + + -- + -- No streaming interface is provided, as this basically violates the + -- spirit of the "AEAD-should-be-simple-to-use" concept - you only can + -- use the decrypted data after it got successfully verified. + + ocbAES128Encrypt + , ocbAES128Decrypt + ) where + +import qualified Data.ByteArray as BA +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B + +import Crypto.Nettle.Ciphers.ForeignImports +import Nettle.Utils + +{- | +Encrypt plain text and create a verification tag for the encrypted text and some additional data. +@key@ and @nonce@ must not be reused together. @nonce@ must not be longer than 15 bytes. +The returned tag is 16 bytes long, but may be shortened for verification (losing security). +-} +ocbAES128Encrypt + :: B.ByteString + -- ^ @key@ (must be 16 bytes) + -> B.ByteString + -- ^ @nonce@ (must not be longer than 15 bytes) + -> B.ByteString + -- ^ @aad@ additional data to be verified + -> B.ByteString + -- ^ @plain@ data to encrypt + -> (B.ByteString, B.ByteString) + -- ^ returns (@cipher@, @tag@) ciphertext and verification tag +ocbAES128Encrypt key nonce aad plain = unsafeDupablePerformIO $ do + let k = copyAndConvertToScrubbedBytes key + cipher <- B.create (B.length plain) (\_ -> return ()) + tag <- B.create 16 (\_ -> return ()) + _ <- withByteStringPtr plain $ \psize pptr -> + withByteStringPtr aad $ \aadsize aadptr -> + withByteStringPtr nonce $ \noncesize nonceptr -> + withByteStringPtr cipher $ \_ cipherptr -> + withByteStringPtr tag $ \_ tagptr -> + withAlignedContext c_ocb_aes128_key_ctx_size $ \keyctxptr -> + withAlignedContext c_ocb_aes128_ctx_size $ \ctxptr -> + BA.withByteArray k $ \kptr -> + if BA.length k /= 16 + then error "Invalid key length" + else + if noncesize > 15 + then error "Invalid nonce length" + else do + c_ocb_aes128_set_encrypt_key keyctxptr kptr + c_ocb_aes128_set_nonce ctxptr keyctxptr 16 noncesize nonceptr + c_ocb_aes128_update ctxptr keyctxptr aadsize aadptr + c_ocb_aes128_encrypt ctxptr keyctxptr psize cipherptr pptr + callNettleOcbDigest + c_ocb_aes128_digest + 16 + ctxptr + keyctxptr + tagptr + return (cipher, tag) + +{- | +Decrypt cipher text and verify a (possible shortened) tag for the encrypted text and some additional data. +@key@ and @nonce@ must not be reused together. +-} +ocbAES128Decrypt + :: B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> Maybe B.ByteString +ocbAES128Decrypt key nonce aad cipher verifytag = unsafeDupablePerformIO $ do + let k = copyAndConvertToScrubbedBytes key + plain <- B.create (B.length cipher) (\_ -> return ()) + tag <- B.create 16 (\_ -> return ()) + _ <- withByteStringPtr cipher $ \psize pptr -> + withByteStringPtr aad $ \aadsize aadptr -> + withByteStringPtr nonce $ \noncesize nonceptr -> + withByteStringPtr plain $ \_ plainptr -> + withByteStringPtr tag $ \_ tagptr -> + withAlignedContext c_ocb_aes128_key_ctx_size $ \keyctxptr -> + withAlignedContext c_aes128_ctx_size $ \decryptptr -> + withAlignedContext c_ocb_aes128_ctx_size $ \ctxptr -> + BA.withByteArray k $ \kptr -> + if BA.length k /= 16 + then error "Invalid key length" + else + if noncesize > 15 + then error "Invalid nonce length" + else do + c_ocb_aes128_set_decrypt_key keyctxptr decryptptr kptr + c_ocb_aes128_set_nonce ctxptr keyctxptr 16 noncesize nonceptr + c_ocb_aes128_update ctxptr keyctxptr aadsize aadptr + c_ocb_aes128_decrypt + ctxptr + keyctxptr + decryptptr + psize + plainptr + pptr + callNettleOcbDigest + c_ocb_aes128_digest + 16 + ctxptr + keyctxptr + tagptr + if B.take (B.length verifytag) tag == verifytag + then return $ Just plain + else return Nothing diff --git a/src/Crypto/Nettle/Poly1305.hs b/src/Crypto/Nettle/Poly1305.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Nettle/Poly1305.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +{- | +Module : Crypto.Nettle.Poly1305 +Copyright : (c) 2026 Clint Adams +License : MIT-style (see the file COPYING) + +Maintainer : clint@debian.org +Stability : experimental +Portability : portable + +This module exports the Poly1305-AES message authentication code supported +by nettle: + + +Poly1305-AES is the (deprecated) original construction by D. J. Bernstein, +where the one-time pad is generated with AES from a nonce. The modern +Poly1305 construction used by ChaCha-Poly1305 (RFC 7539) is available via +'Crypto.Nettle.ChaChaPoly1305'. +-} +module Crypto.Nettle.Poly1305 + ( -- * Poly1305-AES + poly1305AES + , poly1305AESInit + , poly1305AESUpdate + , poly1305AESFinalize + , Poly1305AES + ) where + +import qualified Data.ByteArray as BA +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B + +import Crypto.Nettle.Hash.ForeignImports +import Nettle.Utils + +-- internal functions are not camelCase on purpose +{-# ANN module "HLint: ignore Use camelCase" #-} + +-- | Incremental state of a Poly1305-AES MAC computation. +newtype Poly1305AES = Poly1305AES AlignedContext + +poly1305aesInit + :: B.ByteString + -- ^ @key@ (32 bytes: 16 byte \"r\", 16 byte \"s\") + -> Poly1305AES +poly1305aesInit key = Poly1305AES $ + unsafeDupablePerformIO $ + alignedCtxCreate c_poly1305_aes_ctx_size $ \ctxptr -> + BA.withByteArray key $ \keyptr -> + if BA.length key /= 32 + then error "Invalid key length" + else + c_poly1305_aes_set_key ctxptr keyptr + +poly1305aesSetNonce :: Poly1305AES -> B.ByteString -> Poly1305AES +poly1305aesSetNonce (Poly1305AES c) nonce = Poly1305AES $ + unsafeDupablePerformIO $ + alignedCtxCopy c c_poly1305_aes_ctx_size $ \ctxptr -> + BA.withByteArray nonce $ \nonceptr -> + if BA.length nonce /= 16 + then error "Invalid nonce length" + else + c_poly1305_aes_set_nonce ctxptr nonceptr + +poly1305aesUpdate :: Poly1305AES -> B.ByteString -> Poly1305AES +poly1305aesUpdate (Poly1305AES c) msg = Poly1305AES $ + unsafeDupablePerformIO $ + alignedCtxCopy c c_poly1305_aes_ctx_size $ \ctxptr -> + withByteStringPtr msg $ \msglen msgptr -> + c_poly1305_aes_update ctxptr msglen msgptr + +poly1305aesFinalize :: Poly1305AES -> B.ByteString +poly1305aesFinalize (Poly1305AES c) = unsafeDupablePerformIO $ + B.create c_poly1305_aes_digest_size $ \digestptr -> + BA.withByteArray (alignedCtxBuffer c) $ \ctxptr -> + callNettleHashDigest + c_poly1305_aes_digest + c_poly1305_aes_digest_size + (ctxptr `plusPtr` alignedCtxOffset c) + digestptr + +{- | +Initialize a Poly1305-AES MAC computation with a @key@ (32 bytes) and @nonce@ (16 bytes). +-} +poly1305AESInit :: B.ByteString -> B.ByteString -> Poly1305AES +poly1305AESInit key nonce = poly1305aesSetNonce (poly1305aesInit key) nonce + +{- | +Add more message data to a Poly1305-AES MAC computation. +-} +poly1305AESUpdate :: Poly1305AES -> B.ByteString -> Poly1305AES +poly1305AESUpdate = poly1305aesUpdate + +{- | +Produce the final 16 byte (128 bit) tag of a Poly1305-AES MAC computation. +-} +poly1305AESFinalize :: Poly1305AES -> B.ByteString +poly1305AESFinalize = poly1305aesFinalize + +{- | +One-shot Poly1305-AES MAC: calculate the 16 byte tag for a @key@ (32 bytes), +@nonce@ (16 bytes) and @msg@. +-} +poly1305AES + :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString +poly1305AES key nonce msg = + poly1305aesFinalize $ + poly1305aesUpdate + (poly1305aesSetNonce (poly1305aesInit key) nonce) + msg diff --git a/src/Crypto/Nettle/SIV.hs b/src/Crypto/Nettle/SIV.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Nettle/SIV.hs @@ -0,0 +1,217 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +{- | +Module : Crypto.Nettle.SIV +Copyright : (c) 2026 Clint Adams +License : MIT-style (see the file COPYING) + +Maintainer : clint@debian.org +Stability : experimental +Portability : portable + +This module exports the SIV authenticated-encryption with associated-data +(AEAD) construction (RFC 5297, AES-SIV) based on AES-CMAC, as supported by +nettle: + +-} +module Crypto.Nettle.SIV + ( -- * SIV + + -- + -- No streaming interface is provided, as this basically violates the + -- spirit of the "AEAD-should-be-simple-to-use" concept - you only can + -- use the decrypted data after it got successfully verified. + + sivAES128Encrypt + , sivAES128Decrypt + , sivAES256Encrypt + , sivAES256Decrypt + ) where + +import qualified Data.ByteArray as BA +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B +import Foreign.C.Types (CInt) + +import Crypto.Nettle.Ciphers.ForeignImports +import Nettle.Utils + +{- | +Encrypt plain text and create a verification tag for the encrypted text and some additional data. +SIV is deterministic: the @nonce@ is used only as additional data, and is not required to be unique. +The returned tag is 16 bytes long, but may be shortened for verification (losing security). +-} +sivAES128Encrypt + :: B.ByteString + -- ^ @key@ (must be 32 bytes) + -> B.ByteString + -- ^ @nonce@ (must not be empty) + -> B.ByteString + -- ^ @aad@ additional data to be verified + -> B.ByteString + -- ^ @plain@ data to encrypt + -> (B.ByteString, B.ByteString) + -- ^ returns (@cipher@, @tag@) ciphertext and verification tag +sivAES128Encrypt = + sivEncrypt + c_siv_cmac_aes128_ctx_size + c_siv_cmac_aes128_set_key + c_siv_cmac_aes128_encrypt_message + 32 + +{- | +Decrypt cipher text and verify a (possible shortened) tag for the encrypted text and some additional data. +-} +sivAES128Decrypt + :: B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> Maybe B.ByteString +sivAES128Decrypt = + sivDecrypt + c_siv_cmac_aes128_ctx_size + c_siv_cmac_aes128_set_key + c_siv_cmac_aes128_decrypt_message + 32 + +{- | +Encrypt plain text and create a verification tag for the encrypted text and some additional data. +SIV is deterministic: the @nonce@ is used only as additional data, and is not required to be unique. +The returned tag is 16 bytes long, but may be shortened for verification (losing security). +-} +sivAES256Encrypt + :: B.ByteString + -- ^ @key@ (must be 64 bytes) + -> B.ByteString + -- ^ @nonce@ (must not be empty) + -> B.ByteString + -- ^ @aad@ additional data to be verified + -> B.ByteString + -- ^ @plain@ data to encrypt + -> (B.ByteString, B.ByteString) + -- ^ returns (@cipher@, @tag@) ciphertext and verification tag +sivAES256Encrypt = + sivEncrypt + c_siv_cmac_aes256_ctx_size + c_siv_cmac_aes256_set_key + c_siv_cmac_aes256_encrypt_message + 64 + +{- | +Decrypt cipher text and verify a (possible shortened) tag for the encrypted text and some additional data. +-} +sivAES256Decrypt + :: B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> Maybe B.ByteString +sivAES256Decrypt = + sivDecrypt + c_siv_cmac_aes256_ctx_size + c_siv_cmac_aes256_set_key + c_siv_cmac_aes256_decrypt_message + 64 + +sivEncrypt + :: Int + -> (Ptr Word8 -> Ptr Word8 -> IO ()) + -> ( Ptr Word8 + -> Word + -> Ptr Word8 + -> Word + -> Ptr Word8 + -> Word + -> Ptr Word8 + -> Ptr Word8 + -> IO () + ) + -> Int + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> (B.ByteString, B.ByteString) +sivEncrypt ctxsize setkey encmsg keysize key nonce aad plain = unsafeDupablePerformIO $ do + let k = copyAndConvertToScrubbedBytes key + let clength = B.length plain + 16 + out <- B.create clength (\_ -> return ()) + _ <- withByteStringPtr plain $ \_ pptr -> + withByteStringPtr aad $ \aadsize aadptr -> + withByteStringPtr nonce $ \noncesize nonceptr -> + withByteStringPtr out $ \_ outptr -> + withAlignedContext ctxsize $ \ctxptr -> + BA.withByteArray k $ \kptr -> + if BA.length k /= keysize + then error "Invalid key length" + else + if noncesize == 0 + then error "Invalid nonce length" + else do + setkey ctxptr kptr + encmsg + ctxptr + noncesize + nonceptr + aadsize + aadptr + (fromIntegral clength) + outptr + pptr + return (B.drop 16 out, B.take 16 out) + +sivDecrypt + :: Int + -> (Ptr Word8 -> Ptr Word8 -> IO ()) + -> ( Ptr Word8 + -> Word + -> Ptr Word8 + -> Word + -> Ptr Word8 + -> Word + -> Ptr Word8 + -> Ptr Word8 + -> IO CInt + ) + -> Int + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> Maybe B.ByteString +sivDecrypt ctxsize setkey decmsg keysize key nonce aad cipher verifytag = unsafeDupablePerformIO $ do + let k = copyAndConvertToScrubbedBytes key + let src = verifytag `B.append` cipher + plain <- B.create (B.length cipher) (\_ -> return ()) + ok <- withByteStringPtr src $ \_ srcptr -> + withByteStringPtr aad $ \aadsize aadptr -> + withByteStringPtr nonce $ \noncesize nonceptr -> + withByteStringPtr plain $ \_ plainptr -> + withAlignedContext ctxsize $ \ctxptr -> + BA.withByteArray k $ \kptr -> + if BA.length k /= keysize + then error "Invalid key length" + else + if noncesize == 0 + then error "Invalid nonce length" + else do + setkey ctxptr kptr + decmsg + ctxptr + noncesize + nonceptr + aadsize + aadptr + (fromIntegral (B.length cipher)) + plainptr + srcptr + if ok /= 0 then return $ Just plain else return Nothing diff --git a/src/Crypto/Nettle/UMAC.hs b/src/Crypto/Nettle/UMAC.hs --- a/src/Crypto/Nettle/UMAC.hs +++ b/src/Crypto/Nettle/UMAC.hs @@ -25,8 +25,8 @@ , umacInitKeyedHash ) where -import Data.SecureMem import Data.Tagged +import qualified Data.ByteArray as BA import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy as L @@ -93,9 +93,9 @@ nu_set_key :: Tagged u (Ptr Word8 -> Ptr Word8 -> IO ()) nu_set_nonce :: Tagged u (Ptr Word8 -> Word -> Ptr Word8 -> IO ()) nu_update :: Tagged u (Ptr Word8 -> Word -> Ptr Word8 -> IO ()) - nu_digest :: Tagged u (Ptr Word8 -> Word -> Ptr Word8 -> IO ()) - nu_ctx :: u -> SecureMem - nu_Ctx :: SecureMem -> u + nu_digest :: Tagged u NettleHashDigest + nu_ctx :: u -> BA.ScrubbedBytes + nu_Ctx :: BA.ScrubbedBytes -> u nettleUmacDigestSize :: NettleUMAC u => Tagged u Int nettleUmacDigestSize = nu_digest_size @@ -105,7 +105,7 @@ go = do size <- nu_ctx_size set_key <- nu_set_key - return $ nu_Ctx $ unsafeCreateSecureMem size $ \ctxptr -> + return $ nu_Ctx $ BA.unsafeCreate size $ \ctxptr -> withByteStringPtr key $ \_ keyptr -> set_key ctxptr keyptr nettleUmacSetNonce :: NettleUMAC u => u -> B.ByteString -> u @@ -114,7 +114,7 @@ go ctx = do set_nonce <- nu_set_nonce return $ nu_Ctx $ unsafeDupablePerformIO $ - withSecureMemCopy (nu_ctx ctx) $ \ctxptr -> + BA.copy (nu_ctx ctx) $ \ctxptr -> withByteStringPtr nonce $ \noncelen nonceptr -> set_nonce ctxptr noncelen nonceptr nettleUmacUpdate :: NettleUMAC u => u -> B.ByteString -> u @@ -123,7 +123,7 @@ go ctx = do update <- nu_update return $ nu_Ctx $ unsafeDupablePerformIO $ - withSecureMemCopy (nu_ctx ctx) $ \ctxptr -> + BA.copy (nu_ctx ctx) $ \ctxptr -> withByteStringPtr msg $ \msglen msgptr -> update ctxptr msglen msgptr nettleUmacUpdateLazy :: NettleUMAC u => u -> L.ByteString -> u @@ -132,7 +132,7 @@ go ctx = do update <- nu_update return $ nu_Ctx $ unsafeDupablePerformIO $ - withSecureMemCopy (nu_ctx ctx) $ \ctxptr -> + BA.copy (nu_ctx ctx) $ \ctxptr -> forM_ (L.toChunks msg) $ \chunk -> withByteStringPtr chunk $ \chunklen chunkptr -> update ctxptr chunklen chunkptr @@ -143,10 +143,10 @@ digestSize <- nu_digest_size digest <- nu_digest return $ unsafeDupablePerformIO $ do - ctx' <- secureMemCopy (nu_ctx ctx) - dig <- withSecureMemPtr ctx' $ \ctxptr -> + let ctx' = copyScrubbedBytes (nu_ctx ctx) + dig <- BA.withByteArray ctx' $ \ctxptr -> B.create digestSize $ \digestptr -> - digest ctxptr (fromIntegral digestSize) digestptr + callNettleHashDigest digest digestSize ctxptr digestptr return (dig, nu_Ctx ctx') #define INSTANCE_UMAC(Typ) \ @@ -170,7 +170,7 @@ {-| 'UMAC32' is the 32-bit (4 byte) digest variant. See 'umacInitKeyedHash' for the 'KeyedHashAlgorithm' instance. -} -newtype UMAC32 = UMAC32 { umac32_ctx :: SecureMem } +newtype UMAC32 = UMAC32 { umac32_ctx :: BA.ScrubbedBytes } instance NettleUMAC UMAC32 where nu_ctx_size = Tagged c_umac32_ctx_size nu_digest_size = Tagged c_umac32_digest_size @@ -185,7 +185,7 @@ {-| 'UMAC64' is the 64-bit (8 byte) digest variant. See 'umacInitKeyedHash' for the 'KeyedHashAlgorithm' instance. -} -newtype UMAC64 = UMAC64 { umac64_ctx :: SecureMem } +newtype UMAC64 = UMAC64 { umac64_ctx :: BA.ScrubbedBytes } instance NettleUMAC UMAC64 where nu_ctx_size = Tagged c_umac64_ctx_size nu_digest_size = Tagged c_umac64_digest_size @@ -200,7 +200,7 @@ {-| 'UMAC96' is the 96-bit (12 byte) digest variant. See 'umacInitKeyedHash' for the 'KeyedHashAlgorithm' instance. -} -newtype UMAC96 = UMAC96 { umac96_ctx :: SecureMem } +newtype UMAC96 = UMAC96 { umac96_ctx :: BA.ScrubbedBytes } instance NettleUMAC UMAC96 where nu_ctx_size = Tagged c_umac96_ctx_size nu_digest_size = Tagged c_umac96_digest_size @@ -215,7 +215,7 @@ {-| 'UMAC128' is the 128-bit (16 byte) digest variant. See 'umacInitKeyedHash' for the 'KeyedHashAlgorithm' instance. -} -newtype UMAC128 = UMAC128 { umac128_ctx :: SecureMem } +newtype UMAC128 = UMAC128 { umac128_ctx :: BA.ScrubbedBytes } instance NettleUMAC UMAC128 where nu_ctx_size = Tagged c_umac128_ctx_size nu_digest_size = Tagged c_umac128_digest_size diff --git a/src/Crypto/Nettle/XOF.hsc b/src/Crypto/Nettle/XOF.hsc new file mode 100644 --- /dev/null +++ b/src/Crypto/Nettle/XOF.hsc @@ -0,0 +1,172 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +#include + +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +{- | +Module : Crypto.Nettle.XOF +Copyright : (c) 2026 Clint Adams +License : MIT-style (see the file COPYING) + +Maintainer : clint@debian.org +Stability : experimental +Portability : portable + +This module exports extendable-output functions (XOF) supported by nettle: + +-} +module Crypto.Nettle.XOF + ( -- * XOF class + XOF (..) + , shake + , shake' + + -- * XOF algorithms +#if (NETTLE_VERSION_MAJOR > 3 || (NETTLE_VERSION_MAJOR == 3 && NETTLE_VERSION_MINOR >= 10)) + , SHAKE128 +#endif + , SHAKE256 + ) where + +import qualified Data.ByteArray as BA +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B +import Data.Tagged + +import Crypto.Nettle.Hash.ForeignImports +import Nettle.Utils + +-- internal functions are not camelCase on purpose +{-# ANN module "HLint: ignore Use camelCase" #-} + +{- | +'XOF' is a class for extendable-output functions: like a hash, they absorb a +message, but they can produce an arbitrary number of output bytes. +-} +class XOF a where + -- | Name of the XOF algorithm + xofName :: Tagged a String + + -- | Initialize a new context for this XOF algorithm + xofInit :: a + + -- | Update the context with a bytestring, and return a new context with the updates. + xofUpdate :: a -> B.ByteString -> a + + -- | Finalize a context and return @outlen@ bytes of output. + xofFinalize :: a -> Int -> B.ByteString + +nettleXOFName :: NettleXOF a => Tagged a String +nettleXOFName = xof_name +nettleXOFInit :: NettleXOF a => a +nettleXOFInit = untagSelf $ do + size <- xof_ctx_size + initfun <- xof_init + return $ xof_Ctx $ BA.unsafeCreate size $ \ctxptr -> + initfun ctxptr +nettleXOFUpdate :: NettleXOF a => a -> B.ByteString -> a +nettleXOFUpdate c msg = untagSelf $ do + updatefun <- xof_update + return $ xof_Ctx $ BA.copyAndFreeze (xof_ctx c) $ \ctxptr -> + withByteStringPtr msg $ \msglen msgptr -> + updatefun ctxptr msglen msgptr +nettleXOFFinalize :: NettleXOF a => a -> Int -> B.ByteString +nettleXOFFinalize c outlen = flip witness c $ do + let ctx = copyScrubbedBytes (xof_ctx c) + shakefun <- xof_shake + return $ + unsafeDupablePerformIO $ + B.create outlen $ \outptr -> + BA.withByteArray ctx $ \ctxptr -> + shakefun ctxptr (fromIntegral outlen) outptr + +class NettleXOF a where + xof_ctx_size :: Tagged a Int + xof_name :: Tagged a String + xof_init :: Tagged a NettleHashInit + xof_update :: Tagged a NettleHashUpdate + xof_shake + :: Tagged a (Ptr Word8 -> Word -> Ptr Word8 -> IO ()) + xof_ctx :: a -> BA.ScrubbedBytes + xof_Ctx :: BA.ScrubbedBytes -> a + +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +{- | +Helper to run an XOF over a single (strict) 'B.ByteString', producing @outlen@ bytes. + +Example: + +> untag (shake (fromString "abc") 64 :: Tagged SHAKE256 B.ByteString) +-} +shake + :: XOF a + => B.ByteString + -- ^ @msg@ argument + -> Int + -- ^ @outlen@ argument + -> Tagged a B.ByteString +shake msg outlen = + (flip xofFinalize outlen) + <$> (flip xofUpdate msg <$> tagSelf xofInit) + +{- | +Untagged variant of 'shake'; takes a (possible 'undefined') typed 'XOF' context as parameter. + +Example: + +> shake' (undefined :: SHAKE256) (fromString "abc") 64 +-} +shake' :: XOF a => a -> B.ByteString -> Int -> B.ByteString +shake' a msg outlen = shake msg outlen `witness` a + +#if (NETTLE_VERSION_MAJOR > 3 || (NETTLE_VERSION_MAJOR == 3 && NETTLE_VERSION_MINOR >= 10)) +{- | 'SHAKE128' is an extendable-output function based on the Keccak permutation. + It produces arbitrary-length output with a security strength of 128 bits. + It is only available with Nettle >= 3.10. +-} +data SHAKE128 = SHAKE128 {shake128_ctx :: BA.ScrubbedBytes} + +instance NettleXOF SHAKE128 where + xof_ctx_size = Tagged c_sha3_128_ctx_size + xof_name = Tagged "SHAKE128" + xof_init = Tagged c_sha3_128_init + xof_update = Tagged c_sha3_128_update + xof_shake = Tagged c_sha3_128_shake + xof_ctx = shake128_ctx + xof_Ctx = SHAKE128 + +instance XOF SHAKE128 where + xofName = nettleXOFName + xofInit = nettleXOFInit + xofUpdate = nettleXOFUpdate + xofFinalize = nettleXOFFinalize +#endif + +{- | 'SHAKE256' is an extendable-output function based on the Keccak permutation. + It produces arbitrary-length output with a security strength of 256 bits. +-} +data SHAKE256 = SHAKE256 {shake256_ctx :: BA.ScrubbedBytes} + +instance NettleXOF SHAKE256 where + xof_ctx_size = Tagged c_sha3_256_ctx_size + xof_name = Tagged "SHAKE256" + xof_init = Tagged c_sha3_256_init + xof_update = Tagged c_sha3_256_update + xof_shake = Tagged c_sha3_256_shake + xof_ctx = shake256_ctx + xof_Ctx = SHAKE256 + +instance XOF SHAKE256 where + xofName = nettleXOFName + xofInit = nettleXOFInit + xofUpdate = nettleXOFUpdate + xofFinalize = nettleXOFFinalize diff --git a/src/Nettle/Utils.hs b/src/Nettle/Utils.hs --- a/src/Nettle/Utils.hs +++ b/src/Nettle/Utils.hs @@ -23,14 +23,27 @@ , forM_ , unsafeDupablePerformIO , withByteStringPtr + , copyScrubbedBytes + , copyAndConvertToScrubbedBytes + , createScrubbedBytes + , concatToScrubbedBytes , netEncode + + , AlignedContext + , alignedCtxCreate + , alignedCtxCopy + , alignedCtxBuffer + , alignedCtxOffset + , withAlignedContext ) where +import qualified Data.ByteArray as BA import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B -import Foreign.Ptr (Ptr, plusPtr, FunPtr) +import Foreign.Ptr (Ptr, plusPtr, FunPtr, ptrToWordPtr) import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Marshal.Utils (copyBytes) import Data.Word (Word8, Word) import Control.Monad (forM_) @@ -44,9 +57,95 @@ where (fptr, off, len) = B.toForeignPtr b {-| +Copy a 'BA.ScrubbedBytes'. +-} +copyScrubbedBytes :: BA.ScrubbedBytes -> BA.ScrubbedBytes +copyScrubbedBytes ba = BA.copyAndFreeze ba (\_ -> return ()) + +{-| +Make a copy of a 'BA.ByteArrayAccess' that gets scrubbed. +-} +copyAndConvertToScrubbedBytes :: BA.ByteArrayAccess a => a -> BA.ScrubbedBytes +copyAndConvertToScrubbedBytes = BA.convert + +{-| +Create a 'BA.ScrubbedBytes'. Used for type hinting. +-} +createScrubbedBytes :: Int -> (Ptr p -> IO ()) -> IO BA.ScrubbedBytes +createScrubbedBytes = BA.create + +{-| +Concatenate a 'BA.ByteArrayAccess' to a 'BA.ScrubbedBytes'. Used for type hinting. +-} +concatToScrubbedBytes :: BA.ByteArrayAccess a => [a] -> BA.ScrubbedBytes +concatToScrubbedBytes = BA.concat + +{-| Encode any 'Integral' @value@ in @bytes@ 'Word8' as big endian value. -} netEncode :: (Integral n) => Int {- ^ @bytes@ argument -} -> n {- ^ @value@ argument -} -> [Word8] netEncode bytes = _work bytes [] where _work 0 r _ = r _work n r v = let (d, m) = divMod v 256 in _work (n-1) (fromIntegral m:r) d + +-- Nettle 4 implementations (GCM, CMAC, EAX, OCB, SIV, ...) use 16-byte +-- aligned accesses on parts of their contexts, while @ram@'s 'ScrubbedBytes' +-- only guarantees 8-byte alignment. Contexts are therefore over-allocated +-- with padding, and the pointer handed to C is aligned to a 16-byte boundary. +-- The byte offset to the aligned start of a buffer is stored alongside it; +-- because 'copyScrubbedBytes' would not preserve the alignment of the copied +-- data, copies re-place the context struct into the aligned region of a +-- freshly allocated buffer. + +-- | The alignment required by Nettle contexts that contain 16-byte aligned members. +alignedCtxAlignment :: Int +alignedCtxAlignment = 16 + +-- | An over-allocated 'BA.ScrubbedBytes' buffer together with the offset of the +-- aligned start of the context struct within it. +data AlignedContext = AlignedContext !Int !BA.ScrubbedBytes + +alignedCtxSize :: Int -> Int +alignedCtxSize n = n + alignedCtxAlignment - 1 + +alignedCtxOffset :: AlignedContext -> Int +alignedCtxOffset (AlignedContext off _) = off + +alignedCtxBuffer :: AlignedContext -> BA.ScrubbedBytes +alignedCtxBuffer (AlignedContext _ buf) = buf + +-- | The offset (relative to the buffer start) of the 16-byte aligned region. +alignedCtxOffsetFromBase :: BA.ScrubbedBytes -> Int +alignedCtxOffsetFromBase ba = unsafeDupablePerformIO $ + BA.withByteArray ba $ \p -> + return (fromIntegral ((fromIntegral alignedCtxAlignment - ptrToWordPtr p `mod` fromIntegral alignedCtxAlignment) `mod` fromIntegral alignedCtxAlignment)) + +-- | Run an IO action with a pointer to the aligned start of a freshly allocated, +-- zeroed, over-allocated buffer; returns the resulting context with offset. +alignedCtxCreate :: Int -> (Ptr Word8 -> IO ()) -> IO AlignedContext +alignedCtxCreate size act = do + buf <- BA.create (alignedCtxSize size) (return . const ()) + let off = alignedCtxOffsetFromBase buf + BA.withByteArray buf $ \p -> act (p `plusPtr` off) + return $ AlignedContext off buf + +-- | Run an IO action with a pointer to the aligned start of a freshly allocated, +-- zeroed, over-allocated buffer; returns the result of the action. +withAlignedContext :: Int -> (Ptr Word8 -> IO a) -> IO a +withAlignedContext size act = do + buf <- BA.create (alignedCtxSize size) (return . const ()) + let off = alignedCtxOffsetFromBase buf + BA.withByteArray buf $ \p -> act (p `plusPtr` off) + +-- | Copy the @size@-byte context struct from @src@ into the aligned region of a +-- fresh zeroed buffer, then run an IO action with a pointer to it; returns the +-- resulting context with offset. +alignedCtxCopy :: AlignedContext -> Int -> (Ptr Word8 -> IO ()) -> IO AlignedContext +alignedCtxCopy (AlignedContext srcOff src) size act = do + dst <- BA.create (alignedCtxSize size) (return . const ()) + let dstOff = alignedCtxOffsetFromBase dst + BA.withByteArray dst $ \dptr -> + BA.withByteArray src $ \sptr -> + copyBytes (dptr `plusPtr` dstOff) (sptr `plusPtr` srcOff) size + BA.withByteArray dst $ \p -> act (p `plusPtr` dstOff) + return $ AlignedContext dstOff dst diff --git a/src/Tests/AEAD.hs b/src/Tests/AEAD.hs new file mode 100644 --- /dev/null +++ b/src/Tests/AEAD.hs @@ -0,0 +1,228 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Data.Bits (xor) +import qualified Data.ByteString as B + +import Crypto.Nettle.EAX +import Crypto.Nettle.OCB +import Crypto.Nettle.SIV +import TestUtils + +assertEncryptDecrypt + :: ( B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> (B.ByteString, B.ByteString) + ) + -> ( B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> B.ByteString + -> Maybe B.ByteString + ) + -> ( B.ByteString + , B.ByteString + , B.ByteString + , B.ByteString + , B.ByteString + , B.ByteString + ) + -> Assertion +assertEncryptDecrypt encrypt decrypt (key, nonce, aad, plain, cipher, tag) = do + let badtag = B.cons (B.head tag `xor` 0x01) (B.tail tag) + assertEqualHex + "cipher" + cipher + (fst (encrypt key nonce aad plain)) + assertEqualHex "tag" tag (snd (encrypt key nonce aad plain)) + assertEqual + "decrypt" + (Just plain) + (decrypt key nonce aad cipher tag) + assertEqual + "decrypt wrong tag" + Nothing + (decrypt key nonce aad cipher badtag) + assertEqual + "decrypt corrupt cipher" + Nothing + ( decrypt + key + nonce + aad + (B.take (B.length cipher - 1) cipher `B.append` B.singleton 0x00) + tag + ) + +testEAX :: Test +testEAX = + testCases + "testing EAX" + -- source: the EAX specification (Bellare, Rogaway, Wagner), + -- http://www.cs.ucdavis.edu/~rogaway/papers/eax.pdf + -- output layout: ciphertext || tag + [ assertEncryptDecrypt + eaxAES128Encrypt + eaxAES128Decrypt + ( hs "233952DEE4D5ED5F9B9C6D6FF80FF478" + , hs "62EC67F9C3A4A407FCB2A8C49031A8B3" + , hs "6BFB914FD07EAE6B" + , hs "" + , hs "" + , hs "E037830E8389F27B025A2D6527E79D01" + ) + , assertEncryptDecrypt + eaxAES128Encrypt + eaxAES128Decrypt + ( hs "91945D3F4DCBEE0BF45EF52255F095A4" + , hs "BECAF043B0A23D843194BA972C66DEBD" + , hs "FA3BFD4806EB53FA" + , hs "F7FB" + , hs "19DD" + , hs "5C4C9331049D0BDAB0277408F67967E5" + ) + , assertEncryptDecrypt + eaxAES128Encrypt + eaxAES128Decrypt + ( hs "01F74AD64077F2E704C0F60ADA3DD523" + , hs "70C3DB4F0D26368400A10ED05D2BFF5E" + , hs "234A3463C1264AC6" + , hs "1A47CB4933" + , hs "D851D5BAE0" + , hs "3A59F238A23E39199DC9266626C40F80" + ) + , assertEncryptDecrypt + eaxAES128Encrypt + eaxAES128Decrypt + ( hs "D07CF6CBB7F313BDDE66B727AFD3C5E8" + , hs "8408DFFF3C1A2B1292DC199E46B7D617" + , hs "33CCE2EABFF5A79D" + , hs "481C9E39B1" + , hs "632A9D131A" + , hs "D4C168A4225D8E1FF755939974A7BEDE" + ) + ] + +testOCB :: Test +testOCB = + testCases + "testing OCB" + -- source: RFC 7253 test vectors + -- output layout: ciphertext || tag + [ assertEncryptDecrypt + ocbAES128Encrypt + ocbAES128Decrypt + ( hs "000102030405060708090A0B0C0D0E0F" + , hs "BBAA99887766554433221100" + , hs "" + , hs "" + , hs "" + , hs "785407BFFFC8AD9EDCC5520AC9111EE6" + ) + , assertEncryptDecrypt + ocbAES128Encrypt + ocbAES128Decrypt + ( hs "000102030405060708090A0B0C0D0E0F" + , hs "BBAA99887766554433221101" + , hs "0001020304050607" + , hs "0001020304050607" + , hs "6820B3657B6F615A" + , hs "5725BDA0D3B4EB3A257C9AF1F8F03009" + ) + , assertEncryptDecrypt + ocbAES128Encrypt + ocbAES128Decrypt + ( hs "000102030405060708090A0B0C0D0E0F" + , hs "BBAA99887766554433221103" + , hs "" + , hs "0001020304050607" + , hs "45DD69F8F5AAE724" + , hs "14054CD1F35D82760B2CD00D2F99BFA9" + ) + , assertEncryptDecrypt + ocbAES128Encrypt + ocbAES128Decrypt + ( hs "000102030405060708090A0B0C0D0E0F" + , hs "BBAA9988776655443322110A" + , hs + "000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F" + , hs + "000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F" + , hs + "BD6F6C496201C69296C11EFD138A467ABD3C707924B964DEAFFC40319AF5A485" + , hs "40FBBA186C5553C68AD9F592A79A4240" + ) + ] + +testSIV128 :: Test +testSIV128 = + testCases + "testing SIV (AES-128)" + -- source: RFC 5297 test vectors + -- output layout: tag || ciphertext + [ assertEncryptDecrypt + sivAES128Encrypt + sivAES128Decrypt + ( hs + "fffefdfcfbfaf9f8f7f6f5f4f3f2f1f0f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff" + , hs "01" + , hs "" + , hs "" + , hs "" + , hs "c696f84fdf92aba3c31c23d5f2087513" + ) + , assertEncryptDecrypt + sivAES128Encrypt + sivAES128Decrypt + ( hs + "fffefdfcfbfaf9f8f7f6f5f4f3f2f1f0f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff" + , hs "02" + , hs "" + , hs "00112233445566778899aabbccddeeff" + , hs "1f259d405bfa260b9ba1d60aa287fd0b" + , hs "5027b101589747b8865a9790d3fd51d7" + ) + , assertEncryptDecrypt + sivAES128Encrypt + sivAES128Decrypt + ( hs + "7f7e7d7c7b7a79787776757473727170404142434445464748494a4b4c4d4e4f" + , hs "020304" + , hs + "00112233445566778899aabbccddeeffdeaddadadeaddadaffeeddccbbaa99887766554433221100" + , hs + "7468697320697320736f6d6520706c61696e7465787420746f20656e6372797074207573696e67205349562d414553" + , hs + "a4ffb87fdba97c8944a62325f133b4e01ca55276e2261c1a1d1d4248d1da30ba52b9c8d7955d65c8d2ce6eb7e367d0" + , hs "f1dba33de5b3369e883f67b6fc823cee" + ) + ] + +testSIV256 :: Test +testSIV256 = + testCases + "testing SIV (AES-256)" + -- source: RFC 5297 test vectors + -- output layout: tag || ciphertext + [ assertEncryptDecrypt + sivAES256Encrypt + sivAES256Decrypt + ( hs + "fffefdfcfbfaf9f8f7f6f5f4f3f2f1f06f6e6d6c6b6a69686766656463626160f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff000102030405060708090a0b0c0d0e0f" + , hs "02" + , hs "101112131415161718191a1b1c1d1e1f2021222324252627" + , hs "112233445566778899aabbccddee" + , hs "ad9e6ff14ea97c32ab315e67464c" + , hs "6f740b421e2972d85e76189e99842843" + ) + ] + +main = + defaultMain + [ testEAX + , testOCB + , testSIV128 + , testSIV256 + ] diff --git a/src/Tests/ChaChaPoly1305.hs b/src/Tests/ChaChaPoly1305.hs new file mode 100644 --- /dev/null +++ b/src/Tests/ChaChaPoly1305.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Data.Bits (xor) +import qualified Data.ByteString as B + +import Crypto.Nettle.ChaChaPoly1305 +import TestUtils + +assertChaChaPoly1305 + :: ( B.ByteString + , B.ByteString + , B.ByteString + , B.ByteString + , B.ByteString + , B.ByteString + ) + -> Assertion +assertChaChaPoly1305 (key, nonce, aad, plain, cipher, tag) = do + let (cipher', tag') = chaChaPoly1305Encrypt key nonce aad plain + assertEqualHex "cipher" cipher cipher' + assertEqualHex "tag" tag tag' + assertEqual + "decrypt" + (Just plain) + (chaChaPoly1305Decrypt key nonce aad cipher tag) + assertEqual + "decrypt wrong tag" + Nothing + ( chaChaPoly1305Decrypt + key + nonce + aad + cipher + (B.cons (B.head tag `xor` 1) (B.tail tag)) + ) + +testChaChaPoly1305 :: Test +testChaChaPoly1305 = + testCases + "testing ChaChaPoly1305" + -- source: RFC 8439 section 2.8.2 (A.5) + [ assertChaChaPoly1305 + ( hs + "808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9f" + , hs "070000004041424344454647" + , hs "50515253c0c1c2c3c4c5c6c7" + , B.pack + ( map + (fromIntegral . fromEnum) + "Ladies and Gentlemen of the class of '99: If I could offer you only one tip for the future, sunscreen would be it." + ) + , hs + "d31a8d34648e60db7b86afbc53ef7ec2a4aded51296e08fea9e2b5a736ee62d63dbea45e8ca9671282fafb69da92728b1a71de0a9e060b2905d6a5b67ecd3b3692ddbd7f2d778b8c9803aee328091b58fab324e4fad675945585808b4831d7bc3ff4def08e4b7a9de576d26586cec64b6116" + , hs "1ae10b594f09e26a7e902ecbd0600691" + ) + ] + +main = + defaultMain + [ testChaChaPoly1305 + ] diff --git a/src/Tests/Ciphers.hs b/src/Tests/Ciphers.hs --- a/src/Tests/Ciphers.hs +++ b/src/Tests/Ciphers.hs @@ -1,52 +1,21 @@ import Test.Framework (defaultMain, testGroup, Test(..)) import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Gen(..), elements, choose, vectorOf, label, conjoin) +import Test.QuickCheck (Gen(..), choose, label, conjoin) import Crypto.Nettle.Ciphers import Crypto.Cipher.Types -import Crypto.Cipher.Tests import qualified Data.ByteString as B import Data.Word (Word8) import qualified Numeric as N import Data.Maybe (fromJust) -import Control.Monad (liftM) +import Ciphers.PropertyTests +import Ciphers.Utils import KAT.AES - -fromRight :: Either a b -> b -fromRight (Right x) = x -fromRight _ = error "expected Right" - -genByteString :: Int -> Gen B.ByteString -genByteString len = liftM B.pack $ vectorOf len (choose (0,255)) - -runEither :: (Monad m, Show e) => Either e x -> m x -runEither (Left e) = error $ show e -runEither (Right x) = return x - -runMaybe :: (Monad m) => Maybe x -> m x -runMaybe Nothing = error "got nothing" -runMaybe (Just x) = return x - -genKey' :: KeySizeSpecifier -> Gen B.ByteString -genKey' spec = case spec of - KeySizeRange bot top -> choose (bot, top) >>= genByteString - KeySizeEnum list -> elements list >>= genByteString - KeySizeFixed f -> genByteString f - -genKey :: Cipher c => c -> Gen (Key c) -genKey c = genKey' (cipherKeySize c) >>= runEither . makeKey - -genCipher :: Cipher c => c -> Gen c -genCipher c = liftM cipherInit $ genKey c - -genIV :: BlockCipher c => c -> Gen (IV c) -genIV c = genByteString (blockSize c) >>= runMaybe . makeIV - -genBlockCipherInput :: BlockCipher c => c -> Int -> Gen B.ByteString -genBlockCipherInput c blocks = genByteString (blockSize c * blocks) +import KAT.SM4 +import KAT.Utils genBlockTest :: BlockCipher c => c -> Test genBlockTest = genBlockTest' . genCipher @@ -95,7 +64,7 @@ genStreamNonceTest c' = testProperty ("generated " ++ cipherName c' ++ " stream cipher with nonce test") $ do c'' <- genCipher c' nonce <- genKey' (streamNonceSize c') - let Just c = streamSetNonce c'' nonce + let c = fromJust $ streamSetNonce c'' nonce let run i = fst $ streamCombine c i let run2 (i1, i2) = fst $ let (o1, c') = streamCombine c i1; (o2, c'') = streamCombine c' i2 in (B.append o1 o2, c'') input1 <- choose (1, 256) >>= genByteString @@ -109,7 +78,7 @@ genStreamNonceWord64Test c' = testProperty ("generated " ++ cipherName c' ++ " stream cipher with word64 nonce test") $ do c'' <- genCipher c' nonce <- choose (minBound,maxBound) - let Just c = streamSetNonceWord64 c'' nonce + let c = fromJust $ streamSetNonceWord64 c'' nonce let run i = fst $ streamCombine c i let run2 (i1, i2) = fst $ let (o1, c') = streamCombine c i1; (o2, c'') = streamCombine c' i2 in (B.append o1 o2, c'') input1 <- choose (1, 256) >>= genByteString @@ -123,12 +92,12 @@ genArctwoInitEKB = do k <- genKey (undefined :: ARCTWO) ekb <- choose (0, 1024) - return $ arctwoInitEKB k ekb + return $ runCryptoFailable $ arctwoInitEKB k ekb genArctwoInitGutmann :: Gen ARCTWO genArctwoInitGutmann = do k <- genKey (undefined :: ARCTWO) - return $ arctwoInitGutmann k + return $ runCryptoFailable $ arctwoInitGutmann k main = defaultMain -- own KATs + generated tests (from crypto-cipher-tests) @@ -147,6 +116,7 @@ , testBlockCipher defaultKATs (undefined :: DES_EDE3) , testBlockCipher defaultKATs (undefined :: TWOFISH) , testBlockCipher defaultKATs (undefined :: SERPENT) + , testBlockCipher katSM4 (undefined :: SM4) , testStreamCipher defaultStreamKATs (undefined :: ARCFOUR) , testStreamCipher defaultStreamKATs (undefined :: CHACHA) , testStreamCipher defaultStreamKATs (undefined :: SALSA20) @@ -170,6 +140,7 @@ , genBlockTest (undefined :: DES_EDE3) , genBlockTest (undefined :: TWOFISH) , genBlockTest (undefined :: SERPENT) + , genBlockTest (undefined :: SM4) , genStreamTest (undefined :: ARCFOUR) , genStreamTest (undefined :: CHACHA) , genStreamTest (undefined :: SALSA20) diff --git a/src/Tests/Ciphers/KAT.hs b/src/Tests/Ciphers/KAT.hs new file mode 100644 --- /dev/null +++ b/src/Tests/Ciphers/KAT.hs @@ -0,0 +1,41 @@ + +module Ciphers.KAT + ( testKATs + , testStreamKATs + ) where + +import Test.Framework (Test, TestName, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit ((@?=)) +import Crypto.Cipher.Types as CCT +import qualified Data.ByteArray as BA + +import Ciphers.Utils +import KAT.Utils + +-- | tests related to KATs +testKATs :: CCT.BlockCipher cipher + => KATs + -> cipher + -> Test +testKATs kats cipher = testGroup "KAT" + ( maybeGroup makeECBTest "ECB" (kat_ECB kats) + ) + where makeECBTest i d = + [ testCase ("E" ++ i) (CCT.ecbEncrypt ctx (ecbPlaintext d) @?= ecbCiphertext d) + , testCase ("D" ++ i) (CCT.ecbDecrypt ctx (ecbCiphertext d) @?= ecbPlaintext d) + ] + where ctx = initCipher (Key cipher (ecbKey d)) + +testStreamKATs :: CCT.StreamCipher cipher => [KAT_Stream] -> cipher -> Test +testStreamKATs kats cipher = testGroup "KAT" $ maybeGroup makeStreamTest "Stream" kats + where makeStreamTest i d = + [ testCase ("E" ++ i) (fst (CCT.streamCombine ctx (streamPlaintext d)) @?= streamCiphertext d) + , testCase ("D" ++ i) (fst (CCT.streamCombine ctx (streamCiphertext d)) @?= streamPlaintext d) + ] + where ctx = initCipher (Key cipher (streamKey d)) + +maybeGroup :: (String -> t -> [Test]) -> TestName -> [t] -> [Test] +maybeGroup mkTest groupName l + | null l = [] + | otherwise = [testGroup groupName (concatMap (\(i, d) -> mkTest (show i) d) $ zip [0..] l)] diff --git a/src/Tests/Ciphers/PropertyTests.hs b/src/Tests/Ciphers/PropertyTests.hs new file mode 100644 --- /dev/null +++ b/src/Tests/Ciphers/PropertyTests.hs @@ -0,0 +1,28 @@ +module Ciphers.PropertyTests + ( testBlockCipher + , testStreamCipher + ) where + +-- source: crypto-cipher-tests + +import Test.Framework (Test, testGroup) + +import Crypto.Cipher.Types + +import Ciphers.KAT +import Ciphers.TestModes +import KAT.Utils + +-- | Return tests for a specific blockcipher and a list of KATs +testBlockCipher :: BlockCipher a => KATs -> a -> Test +testBlockCipher kats cipher = testGroup (cipherName cipher) + ( (if kats == defaultKATs then [] else [testKATs kats cipher]) + ++ testModes cipher + ) + +-- | Return tests for a specific streamcipher and a list of KATs +testStreamCipher :: StreamCipher a => [KAT_Stream] -> a -> Test +testStreamCipher kats cipher = testGroup (cipherName cipher) + ( (if kats == defaultStreamKATs then [] else [testStreamKATs kats cipher]) + ++ testStream cipher + ) diff --git a/src/Tests/Ciphers/TestModes.hs b/src/Tests/Ciphers/TestModes.hs new file mode 100644 --- /dev/null +++ b/src/Tests/Ciphers/TestModes.hs @@ -0,0 +1,192 @@ + +module Ciphers.TestModes + ( testModes + , testStream + ) where + +-- source: crypto-cipher-tests + +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck + +import Control.Monad (liftM) +import Crypto.Cipher.Types as CCT +import Crypto.Error +import qualified Data.ByteString as B + +import Ciphers.Utils +import KAT.Utils + +-- | a ECB unit test +data ECBUnit a = ECBUnit B.ByteString a B.ByteString + deriving (Eq) + +instance Show (ECBUnit a) where + show (ECBUnit k _ b) = "ECB(key=" ++ show k ++ ",input=" ++ show b ++ ")" + +-- | a CBC unit test +data CBCUnit a = CBCUnit B.ByteString a (IV a) B.ByteString + deriving (Eq) + +instance (CCT.BlockCipher a) => Show (CBCUnit a) where + show (CBCUnit k _ iv b) = "CBC(key=" ++ show k ++ ",iv=" ++ show (convertToShowable iv) ++ ",input=" ++ show b ++ ")" + +-- | a CFB unit test +data CFBUnit a = CFBUnit B.ByteString a (IV a) B.ByteString + deriving (Eq) + +instance (CCT.BlockCipher a) => Show (CFBUnit a) where + show (CFBUnit k _ iv b) = "CFB(key=" ++ show k ++ ",iv=" ++ show (convertToShowable iv) ++ ",input=" ++ show b ++ ")" + +-- | a CTR unit test +data CTRUnit a = CTRUnit B.ByteString a (IV a) B.ByteString + deriving (Eq) + +instance (CCT.BlockCipher a) => Show (CTRUnit a) where + show (CTRUnit k _ iv b) = "CTR(key=" ++ show k ++ ",iv=" ++ show (convertToShowable iv) ++ ",input=" ++ show b ++ ")" + +-- | a AEAD unit test +data AEADUnit a = AEADUnit B.ByteString a (IV a) B.ByteString B.ByteString + deriving (Eq) + +instance (CCT.BlockCipher a) => Show (AEADUnit a) where + show (AEADUnit k _ iv aad b) = "AEAD(key=" ++ show k ++ ",iv=" ++ show (convertToShowable iv) ++ ",aad=" ++ show aad ++ ",input=" ++ show b ++ ")" + +-- | a Stream unit test +data StreamUnit a = StreamUnit B.ByteString a B.ByteString + deriving (Eq) + +instance Show (StreamUnit a) where + show (StreamUnit k _ b) = "Stream(key=" ++ show k ++ ",input=" ++ show b ++ ")" + +getKey :: Key a b -> b +getKey (Key _ b) = b + +genPlaintextBlocks :: CCT.BlockCipher cipher => Gen cipher -> Gen B.ByteString +genPlaintextBlocks c = do + c' <- c + blocks <- choose (1,128) + genBlockCipherInput c' blocks + +genPlaintext :: CCT.Cipher cipher => Gen cipher -> Gen B.ByteString +genPlaintext c = do + c' <- c + blocks <- choose (1,324) + genUnalignedBlockCipherInput c' blocks + +instance CCT.BlockCipher a => Arbitrary (ECBUnit a) where + arbitrary = let + k = genTypedKey undefined + c = liftM initCipher k + p = genPlaintextBlocks c + in ECBUnit <$> (liftM getKey k) <*> c <*> p + +instance CCT.BlockCipher a => Arbitrary (CBCUnit a) where + arbitrary = let + k = genTypedKey undefined + c = liftM initCipher k + iv = c >>= genIV + p = genPlaintextBlocks c + in CBCUnit <$> (liftM getKey k) <*> c <*> iv <*> p + +instance CCT.BlockCipher a => Arbitrary (CFBUnit a) where + arbitrary = let + k = genTypedKey undefined + c = liftM initCipher k + iv = c >>= genIV + p = genPlaintextBlocks c + in CFBUnit <$> (liftM getKey k) <*> c <*> iv <*> p + +instance CCT.BlockCipher a => Arbitrary (CTRUnit a) where + arbitrary = let + k = genTypedKey undefined + c = liftM initCipher k + iv = c >>= genIV + p = genPlaintext c + in CTRUnit <$> (liftM getKey k) <*> c <*> iv <*> p + +instance CCT.BlockCipher a => Arbitrary (AEADUnit a) where + arbitrary = let + k = genTypedKey undefined + c = liftM initCipher k + iv = c >>= genIV + aad = genPlaintext c + p = genPlaintext c + in AEADUnit <$> (liftM getKey k) <*> c <*> iv <*> aad <*> p + +instance CCT.StreamCipher a => Arbitrary (StreamUnit a) where + arbitrary = let + k = genTypedKey undefined + c = liftM initCipher k + p = genPlaintext c + in StreamUnit <$> (liftM getKey k) <*> c <*> p + +-- | Test a generic block cipher for properties +-- related to block cipher modes. +testModes :: CCT.BlockCipher a => a -> [Test] +testModes cipher = + [ testGroup "decrypt.encrypt==id" + (testBlockCipherBasic cipher ++ testBlockCipherModes cipher ++ testBlockCipherAEAD cipher) + ] + +testBlockCipherBasic :: CCT.BlockCipher a => a -> [Test] +testBlockCipherBasic cipher = [ testProperty "ECB" ecbProp ] + where ecbProp = toTests cipher + toTests :: CCT.BlockCipher a => a -> ECBUnit a -> Bool + toTests _ = testProperty_ECB + testProperty_ECB (ECBUnit _ ctx plaintext) = + plaintext `assertEq` CCT.ecbDecrypt ctx (CCT.ecbEncrypt ctx plaintext) + +testBlockCipherModes :: CCT.BlockCipher a => a -> [Test] +testBlockCipherModes cipher = + [ testProperty "CBC" cbcProp + , testProperty "CFB" cfbProp + , testProperty "CTR" ctrProp + ] + where (cbcProp,cfbProp,ctrProp) = toTests cipher + toTests :: CCT.BlockCipher a + => a + -> ((CBCUnit a -> Bool), (CFBUnit a -> Bool), (CTRUnit a -> Bool)) + toTests _ = (testProperty_CBC + ,testProperty_CFB + ,testProperty_CTR + ) + testProperty_CBC (CBCUnit _ ctx testIV plaintext) = + plaintext `assertEq` CCT.cbcDecrypt ctx testIV (CCT.cbcEncrypt ctx testIV plaintext) + + testProperty_CFB (CFBUnit _ ctx testIV plaintext) = + plaintext `assertEq` CCT.cfbDecrypt ctx testIV (CCT.cfbEncrypt ctx testIV plaintext) + + testProperty_CTR (CTRUnit _ ctx testIV plaintext) = + plaintext `assertEq` CCT.ctrCombine ctx testIV (CCT.ctrCombine ctx testIV plaintext) + +testBlockCipherAEAD :: CCT.BlockCipher a => a -> [Test] +testBlockCipherAEAD cipher = + [ testProperty "OCB" (aeadProp CCT.AEAD_OCB) + , testProperty "CCM" (aeadProp (CCT.AEAD_CCM 0 CCM_M16 CCM_L2)) + , testProperty "EAX" (aeadProp CCT.AEAD_EAX) + , testProperty "CWC" (aeadProp CCT.AEAD_CWC) + , testProperty "GCM" (aeadProp CCT.AEAD_GCM) + ] + where aeadProp = toTests cipher + toTests :: CCT.BlockCipher a => a -> (CCT.AEADMode -> AEADUnit a -> Bool) + toTests _ = testProperty_AEAD + testProperty_AEAD mode (AEADUnit _ ctx testIV aad plaintext) = + case aeadInit mode ctx testIV of + CryptoPassed iniAead -> + let aead = CCT.aeadAppendHeader iniAead aad + (eText, aeadE) = CCT.aeadEncrypt aead plaintext + (dText, aeadD) = CCT.aeadDecrypt aead eText + eTag = CCT.aeadFinalize aeadE (blockSize ctx) + dTag = CCT.aeadFinalize aeadD (blockSize ctx) + in (plaintext `assertEq` dText) && (eTag `assertEq` dTag) + CryptoFailed _ -> True + +-- | Test stream mode +testStream :: CCT.StreamCipher a => a -> [Test] +testStream cipher = [testProperty "combine.combine==id" (testStreamUnit cipher)] + where testStreamUnit :: CCT.StreamCipher a => a -> (StreamUnit a -> Bool) + testStreamUnit _ (StreamUnit _ ctx plaintext) = + let cipherText = fst $ CCT.streamCombine ctx plaintext + in fst (CCT.streamCombine ctx cipherText) `assertEq` plaintext diff --git a/src/Tests/Ciphers/Utils.hs b/src/Tests/Ciphers/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Tests/Ciphers/Utils.hs @@ -0,0 +1,71 @@ + +module Ciphers.Utils + ( Key(..) + , genByteString + , genKey' + , genKey + , genTypedKey + , runCryptoFailable + , genCipher + , genIV + , genUnalignedBlockCipherInput + , genBlockCipherInput + , initCipher + , convertToShowable + , assertEq + ) where + +import Test.QuickCheck (Gen(..), elements, choose, vectorOf) + +import Control.Monad (liftM) +import Crypto.Cipher.Types as CCT +import Crypto.Error +import qualified Data.ByteArray as BA +import qualified Data.ByteString as B + +data Key c a = Key c a + +genByteString :: Int -> Gen B.ByteString +genByteString len = liftM B.pack $ vectorOf len (choose (0,255)) + +runMaybe :: (Monad m) => Maybe x -> m x +runMaybe Nothing = error "got nothing" +runMaybe (Just x) = return x + +genKey' :: CCT.KeySizeSpecifier -> Gen B.ByteString +genKey' spec = case spec of + CCT.KeySizeRange bot top -> choose (bot, top) >>= genByteString + CCT.KeySizeEnum list -> elements list >>= genByteString + CCT.KeySizeFixed f -> genByteString f + +genKey :: CCT.Cipher c => c -> Gen (B.ByteString) +genKey c = genKey' (CCT.cipherKeySize c) + +genTypedKey :: CCT.Cipher c => c -> Gen (Key c B.ByteString) +genTypedKey c = liftM (Key c) $ genKey' (CCT.cipherKeySize c) + +runCryptoFailable :: CCT.Cipher c => CryptoFailable c -> c +runCryptoFailable (CryptoFailed e) = error $ show e +runCryptoFailable (CryptoPassed x) = x + +genCipher :: CCT.Cipher c => c -> Gen c +genCipher c = liftM (runCryptoFailable . CCT.cipherInit) $ (genKey c) + +genIV :: CCT.BlockCipher c => c -> Gen (IV c) +genIV c = genByteString (CCT.blockSize c) >>= runMaybe . CCT.makeIV + +genBlockCipherInput :: CCT.BlockCipher c => c -> Int -> Gen B.ByteString +genBlockCipherInput c blocks = genByteString (CCT.blockSize c * blocks) + +genUnalignedBlockCipherInput :: CCT.Cipher c => c -> Int -> Gen B.ByteString +genUnalignedBlockCipherInput c bytes = genByteString bytes + +initCipher :: (CCT.Cipher c, BA.ByteArray ba) => Key c ba -> c +initCipher (Key _ k) = runCryptoFailable $ CCT.cipherInit k + +convertToShowable :: BA.ByteArrayAccess a => a -> BA.Bytes +convertToShowable = BA.convert + +assertEq :: (BA.ByteArrayAccess a, BA.ByteArrayAccess b) => a -> b -> Bool +assertEq b1 b2 | BA.eq b1 b2 = True + | otherwise = error ("b1: " ++ show (convertToShowable b1) ++ " b2: " ++ show (convertToShowable b2)) diff --git a/src/Tests/Hash.hs b/src/Tests/Hash.hs --- a/src/Tests/Hash.hs +++ b/src/Tests/Hash.hs @@ -35,4 +35,7 @@ , testHash `witness` (undefined :: SHA3_256) , testHash `witness` (undefined :: SHA3_384) , testHash `witness` (undefined :: SHA3_512) + , testHash `witness` (undefined :: SM3) + , testHash `witness` (undefined :: STREEBOG512) + , testHash `witness` (undefined :: STREEBOG256) ] diff --git a/src/Tests/HexUtils.hs b/src/Tests/HexUtils.hs --- a/src/Tests/HexUtils.hs +++ b/src/Tests/HexUtils.hs @@ -15,6 +15,7 @@ import qualified Numeric as N +import Data.Maybe (fromJust) import Data.Word (Word8) import qualified Data.ByteString as B import qualified Data.Array.IArray as A @@ -32,7 +33,7 @@ readHex' _ = error "invalid hex encoding" readHex :: String -> [Word8] -readHex s = let Just r = readHex' s in r +readHex = fromJust . readHex' toString :: [Word8] -> String toString = map (toEnum . fromIntegral) diff --git a/src/Tests/KAT/SM4.hs b/src/Tests/KAT/SM4.hs new file mode 100644 --- /dev/null +++ b/src/Tests/KAT/SM4.hs @@ -0,0 +1,30 @@ +module KAT.SM4 + ( katSM4 + ) where + +import HexUtils +import KAT.Utils + +-- source: GB/T 32907-2016 (SM4 block cipher) test vectors and nettle tests +katSM4 :: KATs +katSM4 = + defaultKATs + { kat_ECB = + [ KAT_ECB + (hs "0123456789abcdeffedcba9876543210") + (hs "0123456789abcdeffedcba9876543210") + (hs "681edf34d206965e86b3e94f536e4246") + , KAT_ECB + (hs "0123456789abcdeffedcba9876543210") + (hs "000102030405060708090a0b0c0d0e0f") + (hs "06989c613da668ad2a8df782e1a8f96a") + , KAT_ECB + (hs "0123456789abcdeffedcba9876543210") + ( hs + "000102030405060708090a0b0c0d0e0f 101112131415161718191a1b1c1d1e1f" + ) + ( hs + "06989c613da668ad2a8df782e1a8f96a 4b910651754b5553f10cfa0c8a09e9e5" + ) + ] + } diff --git a/src/Tests/KAT/Utils.hs b/src/Tests/KAT/Utils.hs --- a/src/Tests/KAT/Utils.hs +++ b/src/Tests/KAT/Utils.hs @@ -1,13 +1,48 @@ module KAT.Utils - ( module Crypto.Cipher.Tests + ( KATs(..) + , KAT_ECB(..) + , KAT_Stream(..) + , defaultKATs + , defaultStreamKATs , concatKATs ) where -import Crypto.Cipher.Tests +import qualified Data.ByteString as B +-- source: crypto-cipher-tests +-- | all the KATs. use defaultKATs to prevent compilation error +-- from future expansion of this data structure +data KATs = KATs + { kat_ECB :: [KAT_ECB] + } deriving (Show,Eq) + +-- | ECB KAT +data KAT_ECB = KAT_ECB + { ecbKey :: B.ByteString -- ^ Key + , ecbPlaintext :: B.ByteString -- ^ Plaintext + , ecbCiphertext :: B.ByteString -- ^ Ciphertext + } deriving (Show,Eq) + +-- | KAT for Stream cipher +data KAT_Stream = KAT_Stream + { streamKey :: B.ByteString + , streamPlaintext :: B.ByteString + , streamCiphertext :: B.ByteString + } deriving (Show,Eq) + +-- | the empty KATs +defaultKATs :: KATs +defaultKATs = KATs + { kat_ECB = [] + } + +-- | the empty KATs for stream +defaultStreamKATs :: [KAT_Stream] +defaultStreamKATs = [] + concatKATs :: [KATs] -> KATs -concatKATs l = KATs (m kat_ECB) (m kat_CBC) (m kat_CFB) (m kat_CTR) (m kat_XTS) (m kat_AEAD) +concatKATs l = KATs (m kat_ECB) where m :: (KATs -> [x]) -> [x] m sel = concat $ map sel l diff --git a/src/Tests/MAC.hs b/src/Tests/MAC.hs new file mode 100644 --- /dev/null +++ b/src/Tests/MAC.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE OverloadedStrings #-} + +import qualified Data.ByteString as B + +import Crypto.Nettle.CMAC +import Crypto.Nettle.KeyedHash +import Crypto.Nettle.Poly1305 +import TestUtils + +assertKeyedHash + :: KeyedHashAlgorithm k + => (B.ByteString, B.ByteString, String) -> Tagged k Assertion +assertKeyedHash (key, msg, tag) = do + t' <- keyedHash key msg + return $ assertEqualHex "" (hs tag) t' + +testCMAC :: KeyedHashAlgorithm k => Tagged k Test +testCMAC = do + name <- implKeyedHashName + results <- mapM assertKeyedHash (cmacTestVectors name) + return $ testCases ("testing CMAC " ++ name) results + +cmacTestVectors + :: String -> [(B.ByteString, B.ByteString, String)] +cmacTestVectors "CMAC-AES128" = + -- source: NIST SP 800-38B test vectors + [ + ( hs "2b7e151628aed2a6abf7158809cf4f3c" + , "" + , "bb1d6929e95937287fa37d129b756746" + ) + , + ( hs "2b7e151628aed2a6abf7158809cf4f3c" + , hs "6bc1bee22e409f96e93d7e117393172a" + , "070a16b46b4d4144f79bdd9dd04a287c" + ) + , + ( hs "2b7e151628aed2a6abf7158809cf4f3c" + , hs + "6bc1bee22e409f96e93d7e117393172a ae2d8a571e03ac9c9eb76fac45af8e51 30c81c46a35ce411" + , "dfa66747de9ae63030ca32611497c827" + ) + ] +cmacTestVectors "CMAC-AES256" = + -- source: NIST SP 800-38B test vectors + [ + ( hs + "603deb1015ca71be2b73aef0857d7781 1f352c073b6108d72d9810a30914dff4" + , "" + , "028962f61b7bf89efc6b551f4667d983" + ) + , + ( hs + "603deb1015ca71be2b73aef0857d7781 1f352c073b6108d72d9810a30914dff4" + , hs "6bc1bee22e409f96e93d7e117393172a" + , "28a7023f452e8f82bd4bf28d8c37c35c" + ) + ] +cmacTestVectors "CMAC-DES3" = + -- source: nettle tests + [ + ( hs "0123456789abcdeffedcba9876543210 0123456789abcdef" + , hs "6bc1bee22e409f96e93d7e117393172a" + , "b45081a29a5df4d0" + ) + ] +cmacTestVectors _ = [] + +assertPoly1305 + :: (B.ByteString, B.ByteString, B.ByteString, String) -> Assertion +assertPoly1305 (key, nonce, msg, tag) = + assertEqualHex "" (hs tag) (poly1305AES key nonce msg) + +testPoly1305 :: Test +testPoly1305 = + testCases + "testing Poly1305-AES" + -- source: D. J. Bernstein "The Poly1305-AES message-authentication code", + -- as used in the nettle test suite + [ assertPoly1305 + ( hs + "75deaa25c09f208e1dc4ce6b5cad3fbfa0f3080000f46400d0c7e9076c834403" + , hs "61ee09218d29b0aaed7e154a2c5509cc" + , hs "" + , "dd3fab2251f11ac759f0887129cc2ee7" + ) + , assertPoly1305 + ( hs + "ec074c835580741701425b623235add6851fc40c3467ac0be05cc20404f3f700" + , hs "fb447350c4e868c52ac3275cf9d4327e" + , hs "f3f6" + , "f4c633c3044fc145f84f335cb81953de" + ) + , assertPoly1305 + ( hs + "6acb5f61a7176dd320c5c1eb2edcdc74 48443d0bb0d21109c89a100b5ce2c208" + , hs "ae212a55399729595dea458bc621ff0e" + , hs + "663cea190ffb83d89593f3f476b6bc24 d7e679107ea26adb8caf6652d0656136" + , "0ee1c16bb73f0f4fd19881753c01cdbe" + ) + , assertPoly1305 + ( hs + "e1a5668a4d5b66a5f68cc5424ed5982d 12976a08c4426d0ce8a82407c4f48207" + , hs "9ae831e743978d3a23527c7128149e3a" + , hs + "ab0812724a7f1e342742cbed374d94d1 36c6b8795d45b3819830f2c04491 faf0990c62e48b8018b2c3e4a0fa3134 cb67fa83e158c994d961c4cb21095c1bf9" + , "5154ad0d2cb26e01274fc51148491f1b" + ) + ] + +main = + defaultMain + [ testCMAC `witness` (undefined :: CMAC_AES128) + , testCMAC `witness` (undefined :: CMAC_AES256) + , testCMAC `witness` (undefined :: CMAC_DES3) + , testPoly1305 + ] diff --git a/src/Tests/Shake.hs b/src/Tests/Shake.hs new file mode 100644 --- /dev/null +++ b/src/Tests/Shake.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC + +import Crypto.Nettle.XOF +import TestUtils +import Shake128 (shake128Tests) + +assertShake + :: XOF a => (B.ByteString, String, Int) -> Tagged a Assertion +assertShake (src, out, outlen) = do + h' <- shake src outlen + return $ assertEqualHex "" (hs out) h' + +testShake :: XOF a => Tagged a Test +testShake = do + name <- xofName + results <- mapM assertShake (xofTestVectors name) + return $ testCases ("testing XOF " ++ name) results + +xofTestVectors :: String -> [(B.ByteString, String, Int)] +xofTestVectors "SHAKE256" = + [ + ( "" + , "46b9dd2b0ba88d13233b3feb743eeb243fcd52ea62b81b82b50c27646ed5762f" + , 32 + ) + , + ( "abc" + , "483366601360a8771c6863080cc4114d8db44530f8f1e1ee4f94ea37e78b5739" + , 32 + ) + , ("abc", "483366601360a8771c6863080cc4114d", 16) + ] +xofTestVectors _ = [] + +-- incremental updates should produce the same result as a single update +testIncremental :: forall a. XOF a => Tagged a Test +testIncremental = do + name <- xofName + let msg = BC.pack "abcdefghijklmnopqrstuvwxyz" + one <- shake msg 64 + let c1 = xofUpdate (xofInit :: a) (B.take 3 msg) + c2 = xofUpdate c1 (B.drop 3 (B.take 11 msg)) + c3 = xofUpdate c2 (B.drop 11 msg) + multi = xofFinalize c3 64 + return $ + testCase ("incremental update " ++ name) $ + assertEqual "incremental SHAKE output equals one-shot" one multi + +main = + defaultMain + (shake128Tests + ++ [ testShake `witness` (undefined :: SHAKE256) + , testIncremental `witness` (undefined :: SHAKE256) + ] + ) diff --git a/src/Tests/Shake128.hsc b/src/Tests/Shake128.hsc new file mode 100644 --- /dev/null +++ b/src/Tests/Shake128.hsc @@ -0,0 +1,56 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +#include + +#if (NETTLE_VERSION_MAJOR > 3 || (NETTLE_VERSION_MAJOR == 3 && NETTLE_VERSION_MINOR >= 10)) +module Shake128 (shake128Tests) where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC + +import Crypto.Nettle.XOF +import TestUtils + +shake128Vectors :: [(B.ByteString, String, Int)] +shake128Vectors = + [ ("", "7f9c2ba4e88f827d616045507605853ed73b8093f6efbc88eb1a6eacfa66ef26", 32) + , ("abc", "5881092dd818bf5cf8a3ddb793fbcba74097d5c526a6d35f97b83351940f2cc8", 32) + , ("abc", "5881092dd818bf5cf8a3ddb793fbcba7", 16) + ] + +testShake128 :: Tagged SHAKE128 Test +testShake128 = do + results <- mapM assertShake shake128Vectors + return $ testCases "testing XOF SHAKE128" results + where + assertShake (src, out, outlen) = do + h' <- shake src outlen + return $ assertEqualHex "" (hs out) h' + +testIncremental128 :: Tagged SHAKE128 Test +testIncremental128 = do + let msg = BC.pack "abcdefghijklmnopqrstuvwxyz" + one <- shake msg 64 + let c1 = xofUpdate (xofInit :: SHAKE128) (B.take 3 msg) + c2 = xofUpdate c1 (B.drop 3 (B.take 11 msg)) + c3 = xofUpdate c2 (B.drop 11 msg) + multi = xofFinalize c3 64 + return $ + testCase "incremental SHAKE128 output equals one-shot" $ + assertEqual "incremental SHAKE128" one multi + +shake128Tests :: [Test] +shake128Tests = + [ testShake128 `witness` (undefined :: SHAKE128) + , testIncremental128 `witness` (undefined :: SHAKE128) + ] +#else +module Shake128 (shake128Tests) where + +import TestUtils + +shake128Tests :: [Test] +shake128Tests = [] +#endif diff --git a/src/Tests/VectorsHash.hs b/src/Tests/VectorsHash.hs --- a/src/Tests/VectorsHash.hs +++ b/src/Tests/VectorsHash.hs @@ -1195,6 +1195,30 @@ , (hs "83167FF53704C3AA19E9FB3303539759C46DD4091A52DDAE9AD86408B69335989E61414BC20AB4D01220E35241EFF5C9522B079FBA597674C8D716FE441E566110B6211531CECCF8FD06BC8E511D00785E57788ED9A1C5C73524F01830D2E1148C92D0EDC97113E3B7B5CD3049627ABDB8B39DD4D6890E0EE91993F92B03354A88F52251C546E64434D9C3D74544F23FB93E5A2D2F1FB15545B4E1367C97335B0291944C8B730AD3D4789273FA44FB98D78A36C3C3764ABEEAC7C569C1E43A352E5B770C3504F87090DEE075A1C4C85C0C39CF421BDCC615F9EFF6CB4FE6468004AECE5F30E1ECC6DB22AD9939BB2B0CCC96521DFBF4AE008B5B46BC006E", "2BE71EE9ACE2DBCFD43D6D020C07244554DAC8A2CF1571D0FA1D004933739E8978323056797E04C333F5BF187E64F1D881E502672567F204DE0E73CE26E7190D") , (hs "3A3A819C48EFDE2AD914FBF00E18AB6BC4F14513AB27D0C178A188B61431E7F5623CB66B23346775D386B50E982C493ADBBFC54B9A3CD383382336A1A0B2150A15358F336D03AE18F666C7573D55C4FD181C29E6CCFDE63EA35F0ADF5885CFC0A3D84A2B2E4DD24496DB789E663170CEF74798AA1BBCD4574EA0BBA40489D764B2F83AADC66B148B4A0CD95246C127D5871C4F11418690A5DDF01246A0C80A43C70088B6183639DCFDA4125BD113A8F49EE23ED306FAAC576C3FB0C1E256671D817FC2534A52F5B439F72E424DE376F4C565CCA82307DD9EF76DA5B7C4EB7E085172E328807C02D011FFBF33785378D79DC266F6A5BE6BB0E4A92ECEEBAEB1", "6E8B8BD195BDD560689AF2348BDC74AB7CD05ED8B9A57711E9BE71E9726FDA4591FEE12205EDACAF82FFBBAF16DFF9E702A708862080166C2FF6BA379BC7FFC2") ]) + , ( "SM3", + [ ("", "1ab21d8355cfa17f8e61194831e81a8f22bec8c728fefb747ed035eb5082aa2b") + , ("a", "623476ac18f65a2909e43c7fec61b49c7e764a91a18ccb82f1917a29c86c5e88") + , ("abc", "66c7f0f462eeedd9d1f2d46bdc10e4e24167c4875cf2f7a2297da02b8f4ba8e0") + , ("message digest", "c522a942e89bd80d97dd666e7a5531b36188c9817149e9b258dfe51ece98ed77") + , ("abcdefghijklmnopqrstuvwxyz", "b80fe97a4da24afc277564f66a359ef440462ad28dcc6d63adb24d5c20a61595") + , ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789", "2971d10c8842b70c979e55063480c50bacffd90e98e2e60d2512ab8abfdfcec5") + ]) + , ( "STREEBOG512", + [ ("", "8e945da209aa869f0455928529bcae4679e9873ab707b55315f56ceb98bef0a7362f715528356ee83cda5f2aac4c6ad2ba3a715c1bcd81cb8e9f90bf4c1c1a8a") + , ("a", "8b2a40ecab7b7496bc4cc0f773595452baf658849b495acc3ba017206810efb00420ccd73fb3297e0f7890941b84ac4a8bc27e3c95e1f97c094609e2136abb7e") + , ("abc", "28156e28317da7c98f4fe2bed6b542d0dab85bb224445fcedaf75d46e26d7eb8d5997f3e0915dd6b7f0aab08d9c8beb0d8c64bae2ab8b3c8c6bc53b3bf0db728") + , ("message digest", "96b52f322e3ecf6348d177608e2ddb084309c1642a94923c0bc50e41e4cc50e851d1dd94e4b7a35c30503caf87e3e2ac334e2c805adb99b5adb5443dd4ac23c8") + , ("abcdefghijklmnopqrstuvwxyz", "ec7b127dcca6b0d741b10ed42062cc4487b4a93f96cfc7faf2e7f79778b1f44159089c91fb0910bec0eee7cdca524fcf291cf933fff406f4f3a03872f2341ff8") + , ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789", "cc49b68c195d18d3fef26f3d4a6554db62298b96d19fbefa52a139e8558d0528535569ebdea172692857ede3351c02fe9d749ef7273dcecaca5b3e295511650b") + ]) + , ( "STREEBOG256", + [ ("", "3f539a213e97c802cc229d474c6aa32a825a360b2a933a949fd925208d9ce1bb") + , ("a", "ba31099b9cc84ec2a671e9313572378920a705b363b031a1cb4fc03e01ce8df3") + , ("abc", "4e2919cf137ed41ec4fb6270c61826cc4fffb660341e0af3688cd0626d23b481") + , ("message digest", "0d45451b2004234de7fbd289b89c665a494ffefe93c2ff6d6f99677c99086bff") + , ("abcdefghijklmnopqrstuvwxyz", "c9086ed61fb0a090aaf4438efd39f0d060cb3ec7e25343b5c4c350054bfd3e27") + , ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789", "74f945f366ab17dd1e7d114ab9adf68b97a8d6a1cbbe299cba06b77735457f94") + ]) ] findHashTestVectors :: Monad m => String -> m [(B.ByteString, String)] diff --git a/src/nettle-ciphers.c b/src/nettle-ciphers.c --- a/src/nettle-ciphers.c +++ b/src/nettle-ciphers.c @@ -167,3 +167,8 @@ break; } } + +void hs_nettle_sm4_init(struct hs_sm4_ctx *ctx, const char *key) { + sm4_set_encrypt_key(&ctx->encrypt, key); + sm4_set_decrypt_key(&ctx->decrypt, key); +} diff --git a/src/nettle-ciphers.h b/src/nettle-ciphers.h --- a/src/nettle-ciphers.h +++ b/src/nettle-ciphers.h @@ -4,7 +4,7 @@ #include -#if (NETTLE_VERSION_MAJOR != 3) +#if (NETTLE_VERSION_MAJOR < 3 || NETTLE_VERSION_MAJOR > 4) #error unsupported nettle version #endif @@ -21,6 +21,7 @@ #include #include #include +#include #include /* stream ciphers */ @@ -30,6 +31,9 @@ /* AEAD ciphers */ #include +#include +#include +#include #if (CHACHA_POLY1305_NONCE_SIZE != CHACHA_NONCE96_SIZE) #error unsupported nettle version, require 96-bit nonce chacha-poly1305 variant @@ -102,5 +106,10 @@ void hs_nettle_camellia_init(struct hs_camellia_ctx *ctx, unsigned int key_size, const char *key); void hs_nettle_camellia_encrypt(const struct hs_camellia_ctx *ctx, size_t length, uint8_t *dst, const uint8_t *src); void hs_nettle_camellia_decrypt(const struct hs_camellia_ctx *ctx, size_t length, uint8_t *dst, const uint8_t *src); + +struct hs_sm4_ctx { + struct sm4_ctx encrypt, decrypt; +}; +void hs_nettle_sm4_init(struct hs_sm4_ctx *ctx, const char *key); #endif diff --git a/src/nettle-hash.h b/src/nettle-hash.h --- a/src/nettle-hash.h +++ b/src/nettle-hash.h @@ -4,7 +4,7 @@ #include -#if (NETTLE_VERSION_MAJOR != 3) +#if (NETTLE_VERSION_MAJOR < 3 || NETTLE_VERSION_MAJOR > 4) #error unsupported nettle version #endif #if (NETTLE_VERSION_MAJOR == 3 && NETTLE_VERSION_MINOR < 2) @@ -25,7 +25,13 @@ #include #include #include +#include +#include #include + +/* message authentication codes */ +#include +#include #endif