1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
-- from base
import Control.Applicative ((<$>))
import Control.Monad (forM_, unless)
import Data.Char (isNumber)
import Data.Maybe (catMaybes)
import Text.Printf
-- from bytestring
import qualified Data.ByteString as B
--import qualified Data.ByteString.Lazy as L
-- from cereal
import Data.Serialize (encode)
-- from tagged
import Data.Tagged (Tagged(..))
-- from crypto-api
import Crypto.Classes
-- from filepath
import System.FilePath ((</>))
-- from transformers
import Control.Monad.Trans.Writer.Lazy (Writer)
-- from hspec
import Test.Hspec.Monadic
--import Test.Hspec.QuickCheck
import Test.Hspec.HUnit ()
-- from this package
import Paths_skein (getDataFileName)
import Crypto.Skein
main :: IO ()
main = do
skein_golden_kat_txt <- getDataFileName ("tests" </> "skein_golden_kat.txt")
kats <- parseKats <$> readFile skein_golden_kat_txt
putStrLn $ "Parsed " ++ show (length kats) ++ " known answer tests"
hspecX $ do
describe "Skein golden known answer tests" $ do
skeinKats kats (undefined :: Skein_512_512)
skeinKats kats (undefined :: Skein_1024_1024)
skeinKats kats (undefined :: Skein_256_256)
skeinKats kats (undefined :: Skein_256_128)
skeinKats kats (undefined :: Skein_256_160)
skeinKats kats (undefined :: Skein_256_224)
skeinKats kats (undefined :: Skein_512_128)
skeinKats kats (undefined :: Skein_512_160)
skeinKats kats (undefined :: Skein_512_224)
skeinKats kats (undefined :: Skein_512_256)
skeinKats kats (undefined :: Skein_512_384)
skeinKats kats (undefined :: Skein_1024_384)
skeinKats kats (undefined :: Skein_1024_512)
readMsg :: Read a => String -> String -> a
readMsg msg str = case readsPrec 0 str of
[(r, "")] -> r
_ -> error msg
----------------------------------------------------------------------
data Kat = Kat { skeinType :: SkeinType
, message :: B.ByteString
, macKey :: Maybe B.ByteString
, result :: B.ByteString
}
data SkeinType = Skein !Int !Int deriving (Eq)
instance Show SkeinType where
show (Skein s o) = printf "Skein-%d-%d" s o
parseKats :: String -> [Kat]
parseKats = catMaybes . map parseKat . groupKats . lines . filter (/= '\r')
groupKats :: [String] -> [[String]]
groupKats = go []
where
sep = "--------------------------------"
go acc (x:xs) | x == sep = reverse acc : go [] xs
| otherwise = go (x:acc) xs
go [] [] = []
go (_:_) [] = error "groupKats: didn't find last separator"
parseKat :: [String] -> Maybe Kat
parseKat ("":xs) = parseKat xs
parseKat (header:"":rest) =
case (isTree header, parseMsgLen header, parseBlocks rest) of
(_, msgLen, _) | msgLen `mod` 8 /= 0 -> Nothing
(False, _, [Message msg, Result ret]) -> kat msg Nothing ret
(False, _, [Message msg, MACKey mac, Result ret]) -> kat msg (Just mac) ret
_ -> Nothing
where kat msg mac ret = Just $ Kat (parseSkeinType header) msg mac ret
parseKat _ = Nothing
isTree :: String -> Bool
isTree ('T':'r':'e':'e':':':_) = True
isTree (_:xs) = isTree xs
isTree [] = False
parseMsgLen :: String -> Int
parseMsgLen ('m':'s':'g':'L':'e':'n':' ':'=':xs) = readMsg "parseMsgLen" $ take 6 xs
parseMsgLen (_:xs) = parseMsgLen xs
parseMsgLen [] = error "parseMsgLen: didn't find msgLen"
parseSkeinType :: String -> SkeinType
parseSkeinType xs0 =
let (":Skein", '-':xs1) = break (== '-') xs0
(stateS, xs2) = span isNumber xs1
(':':_, xs3) = break isNumber xs2
(outputS, _) = span isNumber xs3
in Skein (readMsg "stateS" stateS) (readMsg "outputS" outputS)
data Block = Message B.ByteString | MACKey B.ByteString | Result B.ByteString
block :: String -> B.ByteString -> Block
block "Message data:" = Message
block "Result:" = Result
block ('M':'A':'C':_) = MACKey
block x = error $ "block: unknown block type " ++ x
parseBlocks :: [String] -> [Block]
parseBlocks [] = []
parseBlocks (header:rest)
| last header /= ':' = error "parseBlocks: something went wrong"
| otherwise = let (data_, rest') = span ((== ' ') . head) rest
in block header (parseData data_) : parseBlocks rest'
parseData :: [String] -> B.ByteString
parseData [' ':' ':' ':' ':'(':'n':'o':'n':'e':')':_] = B.empty
parseData xs = B.pack $ map (readMsg "parseData" . ("0x"++)) $ concatMap words xs
----------------------------------------------------------------------
skeinKats :: (SkeinMAC skeinCtx, Hash skeinCtx digest) =>
[Kat] -> digest -> Writer [Spec] ()
skeinKats kats digest =
let get t@(Tagged x) = x
where
f :: Tagged d a -> d
f = undefined
p = f t `asTypeOf` digest
skeinType = Skein (get blockLength) (get outputLength)
myHashKats = [(msg, ret) | Kat t msg Nothing ret <- kats, t == skeinType]
myMacKats = [(msg, macKey, ret) | Kat t msg (Just macKey) ret <- kats, t == skeinType]
lenHashKats = length myHashKats
lenMacKats = length myMacKats
testName =
if lenHashKats + lenMacKats == 0
then printf "has no tests for %s =(" (show skeinType)
else printf "works for %s (%d hash tests, %d MAC tests)"
(show skeinType) lenHashKats lenMacKats
in it testName $ do
putStrLn "Testing hashes..."
forM_ myHashKats $ \(msg, ret) -> do
let myHash = hash' msg `asTypeOf` digest
unless (encode myHash == ret) $ fail $ concat ["Message: ", show msg,
"\nExpected: ", show ret,
"\nCalculated: ", show (encode myHash)]
putStrLn "Testing MACs..."
forM_ myMacKats $ \(msg, macKey, ret) -> do
let myMAC = skeinMAC' macKey msg `asTypeOf` digest
unless (encode myMAC == ret) $ fail $ concat ["Message: ", show msg,
"MAC Key: ", show macKey,
"\nExpected: ", show ret,
"\nCalculated: ", show (encode myMAC)]
|
