Main.hs (6734B)
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 = (decodeLenient . B8.pack) <$> A.many1 hex_digit where 133 decodeLenient bs = case B16.decode bs of 134 Nothing -> error "bang" 135 Just v -> v 136 137 parse_kv :: BS.ByteString -> A.Parser BS.ByteString 138 parse_kv k = 139 A.string k 140 *> A.skipSpace 141 *> A.char '=' 142 *> parse_v 143 where 144 parse_v = 145 (A.endOfLine *> pure mempty) 146 <|> (A.skipSpace *> parse_hex <* A.endOfLine) 147 148 parse_case :: A.Parser Case 149 parse_case = do 150 caseCount <- A.string "COUNT = " *> A.decimal <* A.endOfLine 151 caseEntropy0 <- parse_kv "EntropyInput" 152 caseNonce <- parse_kv "Nonce" 153 casePs <- parse_kv "PersonalizationString" 154 A.string "** INSTANTIATE:" *> A.endOfLine 155 caseV0 <- parse_kv "\tV" 156 caseK0 <- parse_kv "\tKey" 157 caseAddl1 <- parse_kv "AdditionalInput" 158 caseEntropy1 <- parse_kv "EntropyInputPR" 159 A.string "** GENERATE (FIRST CALL):" *> A.endOfLine 160 caseV1 <- parse_kv "\tV" 161 caseK1 <- parse_kv "\tKey" 162 caseAddl2 <- parse_kv "AdditionalInput" 163 caseEntropy2 <- parse_kv "EntropyInputPR" 164 caseReturned <- parse_kv "ReturnedBits" 165 A.string "** GENERATE (SECOND CALL):" *> A.endOfLine 166 caseV2 <- parse_kv "\tV" 167 caseK2 <- parse_kv "\tKey" 168 return Case {..} 169 170 parse_cases :: A.Parser [Case] 171 parse_cases = parse_case `A.sepBy` A.endOfLine 172 173 parse_header :: BS.ByteString -> A.Parser BlockHeader 174 parse_header sha = do 175 A.string ("[" <> sha <> "]") *> A.endOfLine 176 A.string "[PredictionResistance = True]" *> A.endOfLine 177 bh_EntropyInputLen <- 178 A.string "[EntropyInputLen = " *> A.decimal <* A.string "]" <* A.endOfLine 179 bh_NonceLen <- 180 A.string "[NonceLen = " *> A.decimal <* A.string "]" <* A.endOfLine 181 bh_PersonalizationStringLen <- 182 A.string "[PersonalizationStringLen = " *> A.decimal <* A.string "]" 183 <* A.endOfLine 184 bh_AdditionalInputLen <- 185 A.string "[AdditionalInputLen = " *> A.decimal <* A.string "]" 186 <* A.endOfLine 187 bh_ReturnedBitsLen <- 188 A.string "[ReturnedBitsLen = " *> A.decimal <* A.string "]" 189 <* A.endOfLine 190 A.endOfLine 191 pure BlockHeader {..} 192 193 parse_sha256_block :: A.Parser CaseBlock 194 parse_sha256_block = do 195 cb_blockHeader <- parse_header "SHA-256" 196 cb_cases <- parse_cases 197 A.endOfLine 198 pure CaseBlock {..} 199 200 parse_sha256_blocks :: A.Parser [CaseBlock] 201 parse_sha256_blocks = A.many1 parse_sha256_block 202 203 parse_sha512_block :: A.Parser CaseBlock 204 parse_sha512_block = do 205 cb_blockHeader <- parse_header "SHA-512" 206 cb_cases <- parse_cases 207 A.endOfLine 208 pure CaseBlock {..} 209 210 parse_sha512_blocks :: A.Parser [CaseBlock] 211 parse_sha512_blocks = A.many1 parse_sha512_block 212