Main.hs (6645B)
1 {-# OPTIONS_GHC -fno-warn-type-defaults #-} 2 {-# LANGUAGE OverloadedStrings #-} 3 {-# LANGUAGE RecordWildCards #-} 4 5 module Main where 6 7 import Control.Applicative ((<|>)) 8 import qualified Crypto.Hash.SHA256 as SHA256 9 import qualified Crypto.Hash.SHA512 as SHA512 10 import qualified Crypto.DRBG.HMAC as DRBG 11 import qualified Data.Attoparsec.ByteString.Char8 as A 12 import qualified Data.ByteString as BS 13 import qualified Data.ByteString.Char8 as B8 14 import qualified Data.ByteString.Base16 as B16 15 import Test.Tasty 16 import Test.Tasty.HUnit 17 18 -- CAVP source: 19 -- 20 -- https://raw.githubusercontent.com/coruus/nist-testvectors/refs/heads/master/csrc.nist.gov/groups/STM/cavp/documents/drbg/drbgtestvectors/drbgvectors_pr_true/HMAC_DRBG.txt 21 -- 22 -- spec: 23 -- 24 -- https://csrc.nist.gov/CSRC/media/Projects/Cryptographic-Algorithm-Validation-Program/documents/drbg/DRBGVS.pdf 25 26 main :: IO () 27 main = do 28 sha256_vectors <- BS.readFile "etc/HMAC_DRBG_SHA256.txt" 29 sha512_vectors <- BS.readFile "etc/HMAC_DRBG_SHA512.txt" 30 let sha256_cases = case A.parseOnly parse_sha256_blocks sha256_vectors of 31 Left _ -> error "ppad-hmac-drbg (test): parse error" 32 Right cs -> cs 33 34 sha512_cases = case A.parseOnly parse_sha512_blocks sha512_vectors of 35 Left _ -> error "ppad-hmac-drbg (test): parse error" 36 Right cs -> cs 37 38 defaultMain (cavp_14_3 sha256_cases sha512_cases) 39 40 cavp_14_3 :: [CaseBlock] -> [CaseBlock] -> TestTree 41 cavp_14_3 cs ds = testGroup "CAVP 14.3" [ 42 testGroup "HMAC-SHA256" (fmap (execute_caseblock SHA256.hmac) cs) 43 , testGroup "HMAC-SHA512" (fmap (execute_caseblock SHA512.hmac) ds) 44 ] 45 46 data CaseBlock = CaseBlock { 47 cb_blockHeader :: !BlockHeader 48 , cb_cases :: ![Case] 49 } deriving Show 50 51 data BlockHeader = BlockHeader { 52 bh_EntropyInputLen :: !Int 53 , bh_NonceLen :: !Int 54 , bh_PersonalizationStringLen :: !Int 55 , bh_AdditionalInputLen :: !Int 56 , bh_ReturnedBitsLen :: !Int 57 } deriving Show 58 59 -- test case spec 60 data Case = Case { 61 caseCount :: !Int 62 -- instantiate 63 , caseEntropy0 :: !BS.ByteString 64 , caseNonce :: !BS.ByteString 65 , casePs :: !BS.ByteString 66 , caseV0 :: !BS.ByteString 67 , caseK0 :: !BS.ByteString 68 -- first generate 69 , caseAddl1 :: !BS.ByteString 70 , caseEntropy1 :: !BS.ByteString 71 , caseV1 :: !BS.ByteString 72 , caseK1 :: !BS.ByteString 73 -- second generate 74 , caseAddl2 :: !BS.ByteString 75 , caseEntropy2 :: !BS.ByteString 76 , caseV2 :: !BS.ByteString 77 , caseK2 :: !BS.ByteString 78 , caseReturned :: !BS.ByteString 79 } deriving Show 80 81 execute_caseblock :: DRBG.HMAC -> CaseBlock -> TestTree 82 execute_caseblock hmac CaseBlock {..} = 83 testGroup msg (fmap (execute hmac) cb_cases) 84 where 85 BlockHeader {..} = cb_blockHeader 86 msg = "bitlens: " <> 87 "ent " <> show bh_EntropyInputLen <> " " <> 88 "non " <> show bh_NonceLen <> " " <> 89 "per " <> show bh_PersonalizationStringLen <> " " <> 90 "add " <> show bh_AdditionalInputLen <> " " <> 91 "ret " <> show bh_ReturnedBitsLen 92 93 -- execute test case 94 execute :: DRBG.HMAC -> Case -> TestTree 95 execute hmac Case {..} = testCase ("count " <> show caseCount) $ do 96 let bytes = fromIntegral (BS.length caseReturned) 97 98 drbg <- DRBG.new hmac caseEntropy0 caseNonce casePs 99 v0 <- DRBG._read_v drbg 100 k0 <- DRBG._read_k drbg 101 102 assertEqual "v0" v0 caseV0 103 assertEqual "k0" k0 caseK0 104 105 DRBG.reseed caseEntropy1 caseAddl1 drbg 106 _ <- DRBG.gen mempty bytes drbg 107 v1 <- DRBG._read_v drbg 108 k1 <- DRBG._read_k drbg 109 110 assertEqual "v1" v1 caseV1 111 assertEqual "k1" k1 caseK1 112 113 DRBG.reseed caseEntropy2 caseAddl2 drbg 114 returned <- DRBG.gen mempty bytes drbg 115 v2 <- DRBG._read_v drbg 116 k2 <- DRBG._read_k drbg 117 118 assertEqual "returned_bytes" returned caseReturned 119 assertEqual "v2" v2 caseV2 120 assertEqual "k2" k2 caseK2 121 122 -- CAVP vector parsers 123 124 hex_digit :: A.Parser Char 125 hex_digit = A.satisfy hd where 126 hd c = 127 (c >= '0' && c <= '9') 128 || (c >= 'a' && c <= 'f') 129 || (c >= 'A' && c <= 'F') 130 131 parse_hex :: A.Parser BS.ByteString 132 parse_hex = (B16.decodeLenient . B8.pack) <$> A.many1 hex_digit 133 134 parse_kv :: BS.ByteString -> A.Parser BS.ByteString 135 parse_kv k = 136 A.string k 137 *> A.skipSpace 138 *> A.char '=' 139 *> parse_v 140 where 141 parse_v = 142 (A.endOfLine *> pure mempty) 143 <|> (A.skipSpace *> parse_hex <* A.endOfLine) 144 145 parse_case :: A.Parser Case 146 parse_case = do 147 caseCount <- A.string "COUNT = " *> A.decimal <* A.endOfLine 148 caseEntropy0 <- parse_kv "EntropyInput" 149 caseNonce <- parse_kv "Nonce" 150 casePs <- parse_kv "PersonalizationString" 151 A.string "** INSTANTIATE:" *> A.endOfLine 152 caseV0 <- parse_kv "\tV" 153 caseK0 <- parse_kv "\tKey" 154 caseAddl1 <- parse_kv "AdditionalInput" 155 caseEntropy1 <- parse_kv "EntropyInputPR" 156 A.string "** GENERATE (FIRST CALL):" *> A.endOfLine 157 caseV1 <- parse_kv "\tV" 158 caseK1 <- parse_kv "\tKey" 159 caseAddl2 <- parse_kv "AdditionalInput" 160 caseEntropy2 <- parse_kv "EntropyInputPR" 161 caseReturned <- parse_kv "ReturnedBits" 162 A.string "** GENERATE (SECOND CALL):" *> A.endOfLine 163 caseV2 <- parse_kv "\tV" 164 caseK2 <- parse_kv "\tKey" 165 return Case {..} 166 167 parse_cases :: A.Parser [Case] 168 parse_cases = parse_case `A.sepBy` A.endOfLine 169 170 parse_header :: BS.ByteString -> A.Parser BlockHeader 171 parse_header sha = do 172 A.string ("[" <> sha <> "]") *> A.endOfLine 173 A.string "[PredictionResistance = True]" *> A.endOfLine 174 bh_EntropyInputLen <- 175 A.string "[EntropyInputLen = " *> A.decimal <* A.string "]" <* A.endOfLine 176 bh_NonceLen <- 177 A.string "[NonceLen = " *> A.decimal <* A.string "]" <* A.endOfLine 178 bh_PersonalizationStringLen <- 179 A.string "[PersonalizationStringLen = " *> A.decimal <* A.string "]" 180 <* A.endOfLine 181 bh_AdditionalInputLen <- 182 A.string "[AdditionalInputLen = " *> A.decimal <* A.string "]" 183 <* A.endOfLine 184 bh_ReturnedBitsLen <- 185 A.string "[ReturnedBitsLen = " *> A.decimal <* A.string "]" 186 <* A.endOfLine 187 A.endOfLine 188 pure BlockHeader {..} 189 190 parse_sha256_block :: A.Parser CaseBlock 191 parse_sha256_block = do 192 cb_blockHeader <- parse_header "SHA-256" 193 cb_cases <- parse_cases 194 A.endOfLine 195 pure CaseBlock {..} 196 197 parse_sha256_blocks :: A.Parser [CaseBlock] 198 parse_sha256_blocks = A.many1 parse_sha256_block 199 200 parse_sha512_block :: A.Parser CaseBlock 201 parse_sha512_block = do 202 cb_blockHeader <- parse_header "SHA-512" 203 cb_cases <- parse_cases 204 A.endOfLine 205 pure CaseBlock {..} 206 207 parse_sha512_blocks :: A.Parser [CaseBlock] 208 parse_sha512_blocks = A.many1 parse_sha512_block 209