WIP: Use edwards curve point types from Crypto.ECC.Edwards25519

This changes Pass to decode the Ed.Point directly in the type,
instead of having the packed Atom representation or raw ByteStrings.
Added conversion quickchecks and also decoded data off the Ethereum
contracts.

pkg/king/lib/Arvo/Event.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wwarn #-}
 module Arvo.Event where
 
 import UrbitPrelude hiding (Term)
@@ -9,12 +10,14 @@ import Arvo.Common (Header(..), HttpEvent)
 import Arvo.Common (AmesDest, Ipv4, Ipv6, Port, Turf)
 import Arvo.Common (ReOrg(..), reorgThroughNoun)
 
+import qualified Crypto.ECC.Edwards25519   as Ed
+import qualified Crypto.Error              as Ed
+import qualified Data.ByteString.Char8     as C
 import qualified Network.HTTP.Types.Method as H
 
-
 -- Misc Types ------------------------------------------------------------------
 
-type Pass = Atom -- Public Key
+--type Pass = Atom -- Public Key
 type Rift = Atom -- Continuity number
 type Life = Word -- Number of Azimoth key revs.
 type Bloq = Atom -- TODO
@@ -22,6 +25,9 @@ type Ring = Atom -- Private Key
 type Oath = Atom -- Signature
 
 
+
+
+
 -- Parsed URLs -----------------------------------------------------------------
 
 type Host = Either Turf Ipv4
@@ -37,6 +43,61 @@ deriveNoun ''PUrl
 
 -- Dawn Records ----------------------------------------------------------------
 
+-- A Pass is the Atom concatenation of 'b', the public encryption key, and the
+-- public authentication key. (see +pass-from-eth.)
+data Pass = Pass Ed.Point Ed.Point
+  deriving (Eq, Show)
+
+instance ToNoun Pass where
+  toNoun (Pass crypt sign) =
+    Atom $ (reverse bs) ^. from atomBytes
+    where
+      -- TODO: I'm confused. The 'B' must be the most significant digit, but
+      -- only is if we reverse the string.
+      bs = (C.singleton 'B' <> (Ed.pointEncode crypt) <> (Ed.pointEncode sign))
+
+instance FromNoun Pass where
+  parseNoun n = named "Pass" $ do
+    MkBytes backwards <- parseNoun n
+    let bs = (C.reverse backwards)
+    when ((length bs) /= 65) $ do
+      fail "Expecting ByteString of length 65"
+    when ((C.head bs) /= 'B') $ do
+      fail "Expecting 'B' prefix in public key structure"
+    let removedPrefix = C.tail bs
+    let cryptPoint =
+          Ed.throwCryptoError $ Ed.pointDecode (take 32 removedPrefix)
+    let signPoint =
+          Ed.throwCryptoError $ Ed.pointDecode (drop 32 removedPrefix)
+    pure $ Pass cryptPoint signPoint
+
+
+-- -- A Ring is the concatenation of 'B', the private encryption key, and the
+-- -- private authentication key. (see +nol:nu:crub:crypto.)
+-- data Ring = Ring ByteString ByteString
+--   deriving (Eq, Ord, Show)
+
+-- instance ToNoun Ring where
+--   toNoun (Ring crypt sign) =
+--     Atom $ (reverse bs) ^. from atomBytes
+--     where
+--       -- TODO: I'm confused. The 'b' must be the most significant digit, but
+--       -- only is if we reverse the string.
+--       bs = (C.singleton 'b' <> crypt <> sign)
+
+-- instance FromNoun Ring where
+--   parseNoun n = named "Ring" $ do
+--     MkBytes backwards <- parseNoun n
+--     let bs = (C.reverse backwards)
+--     when ((length bs) /= 65) $ do
+--       fail "Expecting ByteString of length 65"
+--     when ((C.head bs) /= 'b') $ do
+--       fail "Expecting 'b' prefix in public key structure"
+--     let removedPrefix = C.tail bs
+--     pure $ Ring (take 32 removedPrefix) (drop 32 removedPrefix)
+
+
+
 data Seed = Seed Ship Life Ring (Maybe Oath)
   deriving (Eq, Ord, Show)
 
@@ -53,7 +114,7 @@ data EthPoint = EthPoint
     , epNet :: Maybe (Life, Pass, ContNum, (Bool, Ship), Maybe Ship)
     , epKid :: Maybe (EthAddr, NounSet Ship)
     }
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Show)
 
 data EthEventId = EthEventId
     { eeiBlock :: Atom
@@ -70,7 +131,7 @@ data EthBookmark = EthBookmark
 data Snap = Snap (NounMap Ship Public)
                  (Dnses, NounMap Ship EthPoint)
                  EthBookmark
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Show)
 
 data Dawn = MkDawn
     { dSeed    :: Seed
@@ -80,7 +141,7 @@ data Dawn = MkDawn
     , dBloq    :: Bloq
     , dNode    :: (Maybe PUrl)
     }
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Show)
 
 deriveNoun ''EthEventId
 deriveNoun ''EthBookmark
@@ -209,7 +270,7 @@ deriveNoun ''SyncEv
 data LegacyBootEvent
     = Fake Ship
     | Dawn Dawn
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Show)
 
 data ArrowKey = D | L | R | U
   deriving (Eq, Ord, Show)
@@ -230,7 +291,7 @@ data TermEv
     | TermEvBoot (UD, ()) LegacyBootEvent
     | TermEvHail (UD, ()) ()
     | TermEvCrud Path       Cord Tang
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Show)
 
 deriveNoun ''LegacyBootEvent
 deriveNoun ''ArrowKey
@@ -250,7 +311,7 @@ data BlipEv
     | BlipEvNewt       NewtEv
     | BlipEvSync       SyncEv
     | BlipEvTerm       TermEv
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Show)
 
 deriveNoun ''BlipEv
 
@@ -287,7 +348,7 @@ deriveNoun ''ZuseEv
 data Ev
     = EvBlip BlipEv
     | EvVane Vane
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Show)
 
 instance ToNoun Ev where
   toNoun = \case

pkg/king/lib/Vere/Dawn.hs

@@ -16,10 +16,12 @@ import Network.Ethereum.Web3
 
 import Data.Text (splitOn)
 
-import qualified Data.ByteArray       as BA
-import qualified Data.Map.Strict      as M
-import qualified Network.Ethereum.Ens as Ens
-import qualified Urbit.Ob             as Ob
+import qualified Crypto.ECC.Edwards25519 as Ed
+import qualified Crypto.Error            as Ed
+import qualified Data.ByteArray          as BA
+import qualified Data.Map.Strict         as M
+import qualified Network.Ethereum.Ens    as Ens
+import qualified Urbit.Ob                as Ob
 
 {-TODOs:
 
@@ -58,9 +60,10 @@ addressToAtom = bsToAtom . addressToBS
 
 -- A Pass is the encryptionKey and authenticationKey concatenated together.
 passFromEth :: BytesN 32 -> BytesN 32 -> UIntN 32 -> Pass
-passFromEth enc aut sut | sut /= 1 = 0
-passFromEth enc aut sut            =
-  ((bytes32ToBS enc) <> (bytes32ToBS aut)) ^. from atomBytes
+passFromEth enc aut sut | sut /= 1 = error "Invalid crypto suite number"
+passFromEth enc aut sut = Pass (decode enc) (decode aut)
+  where
+    decode = Ed.throwCryptoError . Ed.pointDecode . bytes32ToBS
 
 clanFromShip :: Ship -> Ob.Class
 clanFromShip = Ob.clan . Ob.patp . fromIntegral
@@ -68,8 +71,22 @@ clanFromShip = Ob.clan . Ob.patp . fromIntegral
 shipSein :: Ship -> Ship
 shipSein = Ship . fromIntegral . Ob.fromPatp . Ob.sein . Ob.patp . fromIntegral
 
+
+
+
 -- Data Validation -------------------------------------------------------------
 
+-- for =(who.seed `@`fix:ex:cub)
+getFingerprintFromKey :: Ring -> Atom
+getFingerprintFromKey = undefined
+
+-- getPassFromKey :: Ring -> Pass
+-- getPassFromKey (Ring crypt sign) = (Pass pubCrypt pubSign)
+--   where
+--     pubCrypt = decode crypt
+--     pubSign = decode sign
+--     decode = Ed.throwCryptoError . Ed.pointDecode
+
 -- Validates the keys, life, discontinuity, etc. If everything is ok, return
 -- the sponsoring ship for Seed.
 validateAndGetSponsor :: Seed -> EthPoint -> Either Text Ship
@@ -164,12 +181,12 @@ retrieveGalaxyTable bloq azimuth =
     withAzimuth bloq azimuth $ M.fromList <$> mapM getRow [0..5]
   where
     getRow idx = do
-      -- TODO: should we be building a `passFromEth` here instead of converting
-      -- pubKey?
-      (pubKey, _, _, _, _, _, _, _, keyRev, continuity) <- points idx
-      pure (fromIntegral idx, (fromIntegral continuity,
-                               fromIntegral keyRev,
-                               bytes32ToAtom pubKey))
+      (encryptionKey, authenticationKey, _, _, _, _, _, cryptoSuite,
+       keyRev, continuity) <- points idx
+      pure (fromIntegral idx,
+            (fromIntegral continuity,
+              fromIntegral keyRev,
+              (passFromEth encryptionKey authenticationKey cryptoSuite)))
 
 -- Reads the three Ames domains from Ethereum.
 readAmesDomains :: Quantity -> Address -> Web3 ([Turf])
@@ -199,7 +216,9 @@ dawnVent (Seed (Ship ship) life ring oaf) = do
     print ("Azimuth: " ++ (show azimuth))
 
     -- TODO: We're retrieving point information, but we don't have
-    p <- retrievePoint dBloq azimuth 0
+    --
+    -- TODO: Comets don't go through retrievePoint.
+    p <- retrievePoint dBloq azimuth (fromIntegral ship)
     print $ show p
 
     -- Retrieve the galaxy table [MUST FIX s/5/255/]

pkg/king/lib/Vere/Pier/Types.hs

@@ -49,7 +49,7 @@ deriveNoun ''Pill
 -- Jobs ------------------------------------------------------------------------
 
 data Work = Work EventId Mug Wen Ev
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Show)
 
 data LifeCyc = LifeCyc EventId Mug Nock
   deriving (Eq, Show)

pkg/king/package.yaml

@@ -37,6 +37,7 @@ dependencies:
   - classy-prelude
   - conduit
   - containers
+  - cryptonite
   - data-default
   - data-fix
   - directory

pkg/king/test/NounConversionTests.hs

@@ -1,30 +1,58 @@
 module NounConversionTests (tests) where
 
+import Arvo.Event
 import Noun.Conversions
 import UrbitPrelude
 
-import Test.QuickCheck       hiding ((.&.))
+import Crypto.Random.Types
+import Test.QuickCheck        hiding ((.&.))
+import Test.QuickCheck.Gen
+import Test.QuickCheck.Random
 import Test.Tasty
 import Test.Tasty.QuickCheck
 import Test.Tasty.TH
 
+import qualified Crypto.ECC.Edwards25519 as Ed
+import qualified Crypto.Error            as Ed
+import qualified Data.ByteArray          as BA
+
+-- String Representations of Atoms ---------------------------------------------
+
 instance Arbitrary UV where
   arbitrary = UV <$> arbitrarySizedNatural
 
 instance Arbitrary UW where
   arbitrary = UW <$> arbitrarySizedNatural
 
-
 vRoundTrip :: UV -> Bool
 vRoundTrip uv = Just uv == (fromNoun $ toNoun $ uv)
 
 wRoundTrip :: UW -> Bool
 wRoundTrip uw = Just uw == (fromNoun $ toNoun uw)
 
+-- Cryptographic Point Representations -----------------------------------------
+
+instance Crypto.Random.Types.MonadRandom Gen where
+    getRandomBytes size = BA.pack <$> vector size
+
+instance Arbitrary Ed.Point where
+  arbitrary = Ed.toPoint <$> Ed.scalarGenerate
+
+instance Arbitrary Ed.Scalar where
+  arbitrary = Ed.scalarGenerate
+
+passRoundTrip :: Ed.Point -> Ed.Point -> Bool
+passRoundTrip crypt sign =
+  Just val == (fromNoun $ toNoun val)
+  where val = (Pass2 crypt sign)
+
+
+--------------------------------------------------------------------------------
 
 tests :: TestTree
 tests =
   testGroup "Noun"
     [ testProperty "0v0 printing/parsing round trip" $ vRoundTrip
     , testProperty "0w0 printing/parsing round trip" $ wRoundTrip
+    , testProperty "Pass round trip" $ passRoundTrip
     ]