Stubbed comet mining

This commit is contained in:
Elliot Glaysher 2019-10-09 13:39:11 -07:00
parent e1ef550ffc
commit a511b3aba8
4 changed files with 83 additions and 27 deletions

View File

@ -103,6 +103,7 @@ import Data.Default (def)
import KingApp (runApp)
import System.Environment (getProgName)
import System.Posix.Signals (Handler(Catch), installHandler, sigTERM)
import System.Random (randomIO)
import Text.Show.Pretty (pPrint)
import Urbit.Time (Wen)
import Vere.Dawn
@ -335,8 +336,15 @@ validateNounVal inpVal = do
newShip :: HasLogFunc e => CLI.New -> CLI.Opts -> RIO e ()
newShip CLI.New{..} opts
| CLI.BootComet <- nBootType =
error "Comets don't work yet"
| CLI.BootComet <- nBootType = do
putStrLn "boot: retrieving list of stars currently accepting comets"
starList <- dawnCometList
putStrLn ("boot: " ++ (tshow $ length starList) ++ " star(s) currently accepting comets")
putStrLn "boot: mining a comet. May take up to an hour."
putStrLn "boot: If you want to boot faster, get an Azimuth point."
eny <- io $ randomIO
let seed = mineComet (Set.fromList starList) eny
putStrLn ("boot: found comet " ++ (renderShip (sShip seed)))
| CLI.BootFake name <- nBootType =
let ship = shipFrom name
@ -423,6 +431,10 @@ checkComet = do
putStrLn "Stars currently accepting comets:"
let starNames = map (Ob.renderPatp . Ob.patp . fromIntegral) starList
print starNames
putStrLn "Trying to mine a comet..."
eny <- io $ randomIO
let s = mineComet (Set.fromList starList) eny
print s
main :: IO ()
main = do

View File

@ -47,13 +47,13 @@ padByteString bs length | remaining > 0 = bs <> (BS.replicate remaining 0)
data Pass = Pass { passSign :: Ed.PublicKey, passCrypt :: Ed.PublicKey }
deriving (Eq, Ord, Show)
passToBS :: Pass -> BS.ByteString
passToBS Pass{..} = C.singleton 'b' <>
(padByteString (Ed.unPublicKey passSign) 32) <>
(padByteString (Ed.unPublicKey passCrypt) 32)
instance ToNoun Pass where
toNoun Pass{..} =
Atom $ bs ^. from atomBytes
where
bs = (C.singleton 'b' <>
(padByteString (Ed.unPublicKey passSign) 32) <>
(padByteString (Ed.unPublicKey passCrypt) 32))
toNoun p = Atom $ (passToBS p) ^. from atomBytes
instance FromNoun Pass where
parseNoun n = named "Pass" $ do
@ -71,7 +71,7 @@ instance FromNoun Pass where
-- encryption key derivation seed, and the authentication key derivation
-- seed. These aren't actually private keys, but public/private keypairs which
-- can be derived from these seeds.
data Ring = Ring { ringSign :: ByteString, ringCrypt :: ByteString }
data Ring = Ring { ringSign :: BS.ByteString, ringCrypt :: BS.ByteString }
deriving (Eq)
instance ToNoun Ring where

View File

@ -6,9 +6,9 @@ import Arvo.Event hiding (Address)
import Azimuth.Azimuth
import UrbitPrelude hiding (Call, rights, to)
import Data.Bits (xor)
import Data.List (nub)
import Data.Maybe
import Data.Solidity.Abi.Codec (encode)
import Data.Text (splitOn)
import Network.Ethereum.Account
import Network.Ethereum.Api.Eth
@ -17,12 +17,16 @@ import Network.Ethereum.Api.Types hiding (blockNumber)
import Network.Ethereum.Web3
import Network.HTTP.Client.TLS
import qualified Crypto.Sign.Ed25519 as Ed
import qualified Data.ByteArray as BA
import qualified Data.Map.Strict as M
import qualified Network.Ethereum.Ens as Ens
import qualified Network.HTTP.Client as C
import qualified Urbit.Ob as Ob
import qualified Crypto.Hash.SHA512 as SHA512
import qualified Crypto.Sign.Ed25519 as Ed
import qualified Data.Binary as B
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import qualified Data.Map.Strict as M
import qualified Network.Ethereum.Ens as Ens
import qualified Network.HTTP.Client as C
import qualified Urbit.Ob as Ob
-- During boot, use the infura provider
provider = HttpProvider
@ -30,19 +34,10 @@ provider = HttpProvider
-- Conversion Utilities --------------------------------------------------------
bsToAtom :: ByteString -> Atom
bsToAtom x = x ^. from atomBytes
-- Takes the web3's bytes representation and changes the endianness.
bytes32ToBS :: BytesN 32 -> ByteString
bytes32ToBS = reverse . BA.pack . BA.unpack
-- web3 doesn't export unAddress.
addressToBS :: Address -> ByteString
addressToBS = reverse . encode
addressToAtom = bsToAtom . addressToBS
toBloq :: Quantity -> Bloq
toBloq = fromIntegral . unQuantity
@ -262,11 +257,59 @@ dawnCometList = do
fromNounErr noun & either (throwIO . uncurry ParseErr) pure
mineComet :: Set Ship -> Word128 -> Seed
-- Comet Mining ----------------------------------------------------------------
mix :: BS.ByteString -> BS.ByteString -> BS.ByteString
mix a b = BS.pack $ BS.zipWith xor a b
-- TODO: a/b ordering?
shaf :: BS.ByteString -> BS.ByteString -> BS.ByteString
shaf salt ruz = (mix a b)
where
haz = shas salt ruz
a = (take 32 haz)
b = (drop 32 haz)
shas :: BS.ByteString -> BS.ByteString -> BS.ByteString
shas salt ruz =
SHA512.hash $ mix salt $ SHA512.hash ruz
-- Mining a comet:
--
-- A comet fingerprint is the "salted hash" of the +pass, where we mix %bfig
-- into the 65 bytes long 'b' prefixed pass in a specific way.
--
-- (shaf %bfig pub) => (shas %bfig pub) and then mixes both sides.
--
cometFingerprint :: Pass -> Ship -- Word128
cometFingerprint = Ship . B.decode . fromStrict . (shas bfig) . passToBS
where
bfig = C.pack "bfig"
tryMineComet :: Set Ship -> Word64 -> Maybe Seed
tryMineComet ships seed =
if member shipSponsor ships
then Just $ Seed shipName 1 ring Nothing
else Nothing
where
-- Hash the incoming seed into a 64 bytes.
baseHash = SHA512.hash $ toStrict $ B.encode seed
signSeed = (take 32 baseHash)
ringSeed = (drop 32 baseHash)
ring = Ring signSeed ringSeed
pass = getPassFromRing ring
shipName = cometFingerprint pass
shipSponsor = shipSein shipName
mineComet :: Set Ship -> Word64 -> Seed
mineComet ships = loop
where
loop eny =
loop (eny + 1)
case (tryMineComet ships eny) of
Nothing -> loop (eny + 1)
Just x -> x
-- dawnCome :: RIO e (Either Text Dawn)
-- dawnCome = do

View File

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