mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-09-21 07:28:30 +03:00
89 lines
2.9 KiB
Haskell
89 lines
2.9 KiB
Haskell
module DawnTests (tests) where
|
|
|
|
import Urbit.Arvo.Event
|
|
import Urbit.Noun.Conversions
|
|
import Urbit.Prelude
|
|
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit
|
|
|
|
import qualified Urbit.Ob as Ob
|
|
import qualified Urbit.Vere.Dawn as Dawn
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- These golden cases generated in Urbit from entropy to make sure our +mix,
|
|
-- +shas, +shaf, etc. were actually calculated correctly.
|
|
|
|
cordToAtomBytes :: Text -> ByteString
|
|
cordToAtomBytes = atomBytes . cordToAtom
|
|
|
|
cordToAtom :: Text -> Atom
|
|
cordToAtom t = case cordToUW (Cord t) of
|
|
Nothing -> error "Couldn't parse constant embedded in file."
|
|
Just (UW a) -> a
|
|
|
|
testString = cordToAtomBytes $ concat
|
|
[ "0w1.XqnKc.onYJK.0zVOU.Uw142.jNx3C.oWV83.TYt6T.kmHUg.cnoq1.zla6B.bKeNa"
|
|
, ".8wUZu.6ZLHJ.c1TKV.KPcb3.9lU3~.p2G8D"
|
|
]
|
|
|
|
testSalt = cordToAtomBytes "0wc.~cOwa.Kb-DI.BrjVW.i0U37"
|
|
|
|
mixByteStrings = (Dawn.mix testSalt testString) @?= expected
|
|
where
|
|
expected = cordToAtomBytes $ concat
|
|
[ "0w1.XqnKc.onYJK.0zVOU.Uw142.jNx3C.oWV83.TYt6T.kmHUg.cnoq1.zla6B.bKeNa"
|
|
, ".8wUZu.6ZLHx.Pd5eP.0UOIL.IeHW5.b2ibw"
|
|
]
|
|
|
|
shasByteStrings = (Dawn.shas testSalt testString) @?= expected
|
|
where
|
|
expected = cordToAtomBytes
|
|
"0wfKW.mXzrj.c~IBb.lKd6k.2njoG.bRLcD.9eszA.gSSs8.mHRah"
|
|
|
|
shafByteStrings = (Dawn.shaf testSalt testString) @?= expected
|
|
where
|
|
expected = cordToAtomBytes "0w3h.Bg1Qh.ZZjoJ.23J~p.PHg-D"
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
cometShip :: Ship
|
|
cometShip = case Ob.parsePatp cometStr of
|
|
Left x -> error "Invalid ship name"
|
|
Right p -> Ship $ fromIntegral $ Ob.fromPatp p
|
|
where
|
|
cometStr = "~radmes-dilsec-sovlup-lagwep--tonred-waldeb-tocseg-marzod"
|
|
|
|
cometPass :: Pass
|
|
cometPass = case fromNoun (Atom cometPassAtom) of
|
|
Nothing -> error "Keyfile does not seem to contain a seed."
|
|
Just s -> s
|
|
where
|
|
cometPassAtom = cordToAtom $ concat
|
|
[ "0w99.P80w4.rL7Qt.0i5-h.8yta7.RhgHI.nrXjO.xBCix.Pxx5a.sJ6bv.a-Iwo.OeVBr"
|
|
, ".x8-Gs.1LLG~.FgDRk.GML3Y.X3qFZ.jtlpy"
|
|
]
|
|
|
|
cometRawBS = cordToAtomBytes "0w39.q35g-.hrd3f.q9UWK.Zxg40"
|
|
|
|
-- Verifies the internal usage of +shaf in comet derivation gets the right
|
|
-- answer.
|
|
testCometFingerprintBS = (Dawn.cometFingerprintBS cometPass) @?= cometRawBS
|
|
|
|
-- Tests that the real public interface for fingerprint generation does the
|
|
-- byte-munging correctly.
|
|
testCometFingerprint = (Dawn.cometFingerprint cometPass) @?= cometShip
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
tests :: TestTree
|
|
tests =
|
|
testGroup "Dawn"
|
|
[ testCase "Mix bytestrings of different length" $ mixByteStrings
|
|
, testCase "Shas bytestrings" $ shasByteStrings
|
|
, testCase "Shaf bytestrings" $ shafByteStrings
|
|
, testCase "Fingerprint bytestring derivation" $ testCometFingerprintBS
|
|
, testCase "Fingerprint total derivation" $ testCometFingerprint
|
|
]
|