nettle 0.3.1.1 → 0.4
raw patch · 35 files changed
+2982/−378 lines, 35 filesdep +cryptondep +ramdep −byteabledep −crypto-cipher-testsdep −crypto-cipher-typesdep ~base
Dependencies added: crypton, ram
Dependencies removed: byteable, crypto-cipher-tests, crypto-cipher-types, securemem
Dependency ranges changed: base
Files
- README.md +1/−1
- nettle.cabal +116/−15
- src/Crypto/Nettle/CCM.hs +79/−59
- src/Crypto/Nettle/CMAC.hs +179/−0
- src/Crypto/Nettle/ChaChaPoly1305.hs +15/−13
- src/Crypto/Nettle/Ciphers.hs +89/−63
- src/Crypto/Nettle/Ciphers/ForeignImports.hsc +191/−2
- src/Crypto/Nettle/Ciphers/Internal.hs +171/−114
- src/Crypto/Nettle/EAX.hs +108/−0
- src/Crypto/Nettle/Hash.hs +77/−24
- src/Crypto/Nettle/Hash/ForeignImports.hsc +211/−25
- src/Crypto/Nettle/OCB.hs +140/−0
- src/Crypto/Nettle/Poly1305.hs +117/−0
- src/Crypto/Nettle/SIV.hs +217/−0
- src/Crypto/Nettle/UMAC.hs +15/−15
- src/Crypto/Nettle/XOF.hsc +172/−0
- src/Nettle/Utils.hs +100/−1
- src/Tests/AEAD.hs +228/−0
- src/Tests/ChaChaPoly1305.hs +61/−0
- src/Tests/Ciphers.hs +11/−40
- src/Tests/Ciphers/KAT.hs +41/−0
- src/Tests/Ciphers/PropertyTests.hs +28/−0
- src/Tests/Ciphers/TestModes.hs +192/−0
- src/Tests/Ciphers/Utils.hs +71/−0
- src/Tests/Hash.hs +3/−0
- src/Tests/HexUtils.hs +2/−1
- src/Tests/KAT/SM4.hs +30/−0
- src/Tests/KAT/Utils.hs +38/−3
- src/Tests/MAC.hs +118/−0
- src/Tests/Shake.hs +59/−0
- src/Tests/Shake128.hsc +56/−0
- src/Tests/VectorsHash.hs +24/−0
- src/nettle-ciphers.c +5/−0
- src/nettle-ciphers.h +10/−1
- src/nettle-hash.h +7/−1
README.md view
@@ -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).
nettle.cabal view
@@ -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 (<http://www.lysator.liu.se/~nisse/nettle/nettle.html>) 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 <stbuehler@web.de>@@ -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
src/Crypto/Nettle/CCM.hs view
@@ -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+ }
+ src/Crypto/Nettle/CMAC.hs view
@@ -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:+ <http://www.lysator.liu.se/~nisse/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
src/Crypto/Nettle/ChaChaPoly1305.hs view
@@ -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
src/Crypto/Nettle/Ciphers.hs view
@@ -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)
src/Crypto/Nettle/Ciphers/ForeignImports.hsc view
@@ -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
src/Crypto/Nettle/Ciphers/Internal.hs view
@@ -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')
+ src/Crypto/Nettle/EAX.hs view
@@ -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:+ <http://www.lysator.liu.se/~nisse/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
src/Crypto/Nettle/Hash.hs view
@@ -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)
src/Crypto/Nettle/Hash/ForeignImports.hsc view
@@ -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
+ src/Crypto/Nettle/OCB.hs view
@@ -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:+ <http://www.lysator.liu.se/~nisse/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
+ src/Crypto/Nettle/Poly1305.hs view
@@ -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:+ <http://www.lysator.liu.se/~nisse/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
+ src/Crypto/Nettle/SIV.hs view
@@ -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:+ <http://www.lysator.liu.se/~nisse/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
src/Crypto/Nettle/UMAC.hs view
@@ -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
+ src/Crypto/Nettle/XOF.hsc view
@@ -0,0 +1,172 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++#include <nettle/version.h>++-----------------------------------------------------------------------------++-----------------------------------------------------------------------------++{- |+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:+ <http://www.lysator.liu.se/~nisse/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
src/Nettle/Utils.hs view
@@ -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
+ src/Tests/AEAD.hs view
@@ -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+ ]
+ src/Tests/ChaChaPoly1305.hs view
@@ -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+ ]
src/Tests/Ciphers.hs view
@@ -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)
+ src/Tests/Ciphers/KAT.hs view
@@ -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)]
+ src/Tests/Ciphers/PropertyTests.hs view
@@ -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+ )
+ src/Tests/Ciphers/TestModes.hs view
@@ -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
+ src/Tests/Ciphers/Utils.hs view
@@ -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))
src/Tests/Hash.hs view
@@ -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) ]
src/Tests/HexUtils.hs view
@@ -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)
+ src/Tests/KAT/SM4.hs view
@@ -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"+ )+ ]+ }
src/Tests/KAT/Utils.hs view
@@ -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
+ src/Tests/MAC.hs view
@@ -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+ ]
+ src/Tests/Shake.hs view
@@ -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)+ ]+ )
+ src/Tests/Shake128.hsc view
@@ -0,0 +1,56 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++#include <nettle/version.h>++#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
src/Tests/VectorsHash.hs view
@@ -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)]
src/nettle-ciphers.c view
@@ -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);+}
src/nettle-ciphers.h view
@@ -4,7 +4,7 @@ #include <nettle/version.h> -#if (NETTLE_VERSION_MAJOR != 3)+#if (NETTLE_VERSION_MAJOR < 3 || NETTLE_VERSION_MAJOR > 4) #error unsupported nettle version #endif @@ -21,6 +21,7 @@ #include <nettle/cast128.h> #include <nettle/des.h> #include <nettle/serpent.h>+#include <nettle/sm4.h> #include <nettle/twofish.h> /* stream ciphers */@@ -30,6 +31,9 @@ /* AEAD ciphers */ #include <nettle/chacha-poly1305.h>+#include <nettle/eax.h>+#include <nettle/ocb.h>+#include <nettle/siv-cmac.h> #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
src/nettle-hash.h view
@@ -4,7 +4,7 @@ #include <nettle/version.h> -#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 <nettle/sha1.h> #include <nettle/sha2.h> #include <nettle/sha3.h>+#include <nettle/sm3.h>+#include <nettle/streebog.h> #include <nettle/umac.h>++/* message authentication codes */+#include <nettle/cmac.h>+#include <nettle/poly1305.h> #endif