urbit/pkg/hs/urbit-king/test/DawnTests.hs

module DawnTests (tests) where

import Ur.Arvo.Event
import Ur.Noun.Conversions
import Ur.Prelude

import Test.Tasty
import Test.Tasty.HUnit

import qualified Ur.Vere.Dawn as Dawn
import qualified Urbit.Ob     as Ob

--------------------------------------------------------------------------------

-- 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
    ]