{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module: Target
-- Copyright: Copyright © 2021 Kadena LLC.
-- License: MIT
-- Maintainer: Lars Kuhtz <lars@kadena.io>
-- Stability: experimental
--
-- TODO
--
module Target
(
-- * Target
Target(..)
, mkTarget
, nullTarget
, maxTarget
, avgTarget
-- * Target Words
, TargetWords(..)
, targetToWords
, targetFromWords
-- * Binary Encodings
, encodeTarget
, decodeTarget
-- * Textual Encodings
, targetToText16Le
, targetToText16Be
-- * Difficulty
, Period(..)
, HashRate(..)
, Difficulty(..)
, targetToDifficulty
, difficultyToTarget
, adjustDifficulty
-- * Difficulty Level (leading zeros)
, Level
, level
, mkTargetLevel
, getTargetLevel
, increaseLevel
, reduceLevel
, leveled
) where
import Control.Monad
import qualified Data.Aeson as A
import qualified Data.Aeson.Encoding as A
import Data.Bits
import Data.Bytes.Get
import Data.Bytes.Put
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as LB
import Data.Hashable
import Data.String
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Read as T
import Data.Word
import GHC.Generics
import Numeric.Natural
import Text.Read
-- internal modules
import Utils
-- -------------------------------------------------------------------------- --
-- Target
-- | Hash target. A little endian encoded 256 bit (unsigned) word.
--
-- Cf. https://github.com/kadena-io/chainweb-node/wiki/Block-Header-Binary-Encoding#work-header-binary-format
--
-- This is encoded as a positive integer with that it is smaller than 2^256
--
-- Binary encoding in a block header is fixed size 256 little endian format
-- (padded with zero bits).
--
-- Textual endcoding in JSON and debugging and log messages is fixed size 64
-- hexadecimal (padded with zeros).
--
-- All arithmetic is done is infinite precision rational arithmetic with
-- the final result capped at 2^256-1.
--
newtype Target = Target Natural
deriving (Generic)
deriving newtype (Eq, Ord, Enum, Hashable)
instance Bounded Target where
minBound = Target 0
maxBound = Target (2 ^ (256::Int) - 1)
mkTarget :: MonadFail m => Integral a => a -> m Target
mkTarget a
| a < 0 = fail "newTarget: target can not be smaller than zero"
| a >= 2 ^ (256 :: Int) = fail "newTarget: target can not be larger than 2^256-1"
| otherwise = return $ Target $ int a
nullTarget :: Target
nullTarget = minBound
maxTarget :: Target
maxTarget = maxBound
avgTarget :: Target -> Target -> Target
avgTarget (Target a) (Target b) = Target $ (a + b) `div` 2
{-# INLINE avgTarget #-}
-- -------------------------------------------------------------------------- --
-- Representation as Word
-- Little Endian ordered. The words themself are in host byte ordering.
--
data TargetWords = TargetWords
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
-- TODO on 64 bit platform we could use mkNatural instead
--
targetFromWords :: TargetWords -> Target
targetFromWords (TargetWords a b c d) = Target $
((int d * 0x10000000000000000 + int c) * 0x10000000000000000 + int b) * 0x10000000000000000 + int a
{-# INLINE targetFromWords #-}
-- TODO with GHC-9 and ghc-bignum we could switch the type of Target to
-- use BigNat on 64 bit systems.
--
targetToWords :: Target -> TargetWords
targetToWords (Target i0) = TargetWords (int a) (int b) (int c) (int d)
where
(i1, a) = i0 `quotRem` 0x10000000000000000
(i2, b) = i1 `quotRem` 0x10000000000000000
(d, c) = i2 `quotRem` 0x10000000000000000
{-# INLINE targetToWords #-}
-- -------------------------------------------------------------------------- --
-- Binary Encodings
decodeTarget :: MonadGet m => m Target
decodeTarget = fmap targetFromWords $
TargetWords
<$> getWord64le
<*> getWord64le
<*> getWord64le
<*> getWord64le
{-# INLINE decodeTarget #-}
encodeTarget :: MonadPut m => Target -> m ()
encodeTarget t = do
putWord64le a
putWord64le b
putWord64le c
putWord64le d
where
TargetWords a b c d = targetToWords t
{-# INLINE encodeTarget #-}
-- -------------------------------------------------------------------------- --
-- Textual Encodings
targetBuilderHexBe :: Target -> BB.Builder
targetBuilderHexBe t
= BB.word64HexFixed d
<> BB.word64HexFixed c
<> BB.word64HexFixed b
<> BB.word64HexFixed a
where
TargetWords a b c d = targetToWords t
{-# INLINE targetBuilderHexBe #-}
targetBuilderHexLe :: Target -> BB.Builder
targetBuilderHexLe t
= BB.word64HexFixed a
<> BB.word64HexFixed b
<> BB.word64HexFixed c
<> BB.word64HexFixed d
where
TargetWords a b c d = targetToWords t
{-# INLINE targetBuilderHexLe #-}
instance Show Target where
show t = "Target " <> show (targetToText16Be t)
{-# INLINE show #-}
instance Read Target where
readPrec = do
Ident "Target" <- lexP
readPrec >>= targetFromText16Be
instance IsString Target where
fromString s = case targetFromText16Be (T.pack s) of
Just x -> x
Nothing -> error "Target.IsString.fromString: failed to parse target"
{-# INLINE fromString #-}
instance A.ToJSON Target where
toEncoding = A.unsafeToEncoding . quoted . targetBuilderHexBe
toJSON = A.toJSON . targetToText16Be
{-# INLINE toEncoding #-}
{-# INLINE toJSON #-}
instance A.FromJSON Target where
parseJSON = A.withText "Target" targetFromText16Be
{-# INLINE parseJSON #-}
targetFromText16Be :: MonadFail m => T.Text -> m Target
targetFromText16Be t
| T.length t /= 64 =
fail $ "Target string has wrong length. Expected 64 ," <> " got " <> sshow (T.length t)
| otherwise = case T.hexadecimal t of
Right (n, "") -> mkTarget @_ @Natural n
Right (n, x) -> fail $ "failed to parse target: pending characters after reading " <> show n <> ": " <> T.unpack x
Left e -> fail $ "failed to parse target: " <> e
{-# INLINE targetFromText16Be #-}
-- | Represent target bytes in hexadecimal base in little endian byte order
--
targetToText16Le :: Target -> T.Text
targetToText16Le = T.decodeUtf8 . LB.toStrict . BB.toLazyByteString . targetBuilderHexLe
{-# INLINE targetToText16Le #-}
-- | Represent target bytes in hexadecimal base in big endian byte order (used by Stratum)
--
targetToText16Be :: Target -> T.Text
targetToText16Be = T.decodeUtf8 . LB.toStrict . BB.toLazyByteString . targetBuilderHexBe
{-# INLINE targetToText16Be #-}
-- -------------------------------------------------------------------------- --
-- Difficulty
-- | Difficulty measures the expected number of random Bernoulli trials for
-- solving a block, i.e. the number of nonce that a miner must try in order to
-- find a hash that matches are target. Conversely, the inverse of the
-- difficulty is the probabily that a nonce, that haven't been tried before,
-- results in a valid solution.
--
-- For pools, it measures the weight of a share within a round.
--
-- The minimum possible difficulty is 1. The maximum difficulty is 2^256, which
-- corresponds to a target value of 0.
--
-- Since Difficulty and target are related, the notion of difficuylty is
-- redundant. However, compared to the notion of target it is a more intuitive
-- representation of the work of a miner. Also, since it is represented as
-- double it is often more convenient to work with when perfect precision isn't
-- required.
--
newtype Difficulty = Difficulty Double
deriving (Show)
deriving newtype (Eq, Ord)
pruneDifficulty :: Double -> Difficulty
pruneDifficulty d = Difficulty $ min m (max 1 d)
where
m = 2^(256 :: Int)
targetToDifficulty :: Target -> Difficulty
targetToDifficulty (Target t) = Difficulty $ m / int (t + 1)
where
m = 2^(256 :: Int)
difficultyToTarget :: Difficulty -> Target
-- difficultyToTarget (Difficulty d) = Target $ floor (m / d) - 1
difficultyToTarget (Difficulty d) = Target $ floor (m / d) - 1
where
m = 2^(256 :: Int)
-- | Time per share. Usually this is used scaled to some larger number
-- of shares to account for the exponential distribution with which shares
-- arrive.
--
-- This is measured in seconds
--
newtype Period = Period Double
deriving (Show, Eq, Ord)
newtype HashRate = HashRate Double
deriving (Show, Eq, Ord)
-- | The period values must have the same denominator. (If not they must be
-- scaled.)
--
adjustDifficulty
:: Double
-- ^ dead band, tolerance for which not adjustement is performed
-- in order to reduce jitter
-> HashRate
-- ^ estimated hash rate
-> Period
-- ^ targeted period
-> Difficulty
-- ^ current difficulty
-> Difficulty
-- ^ new difficulty
adjustDifficulty tolerance estimatedHashRate trgP curD
| abs (cp - tp) / tp <= tolerance = curD
| otherwise = pruneDifficulty $ d * tp / cp
where
Difficulty d = curD
HashRate hr = estimatedHashRate
Period tp = trgP
cp = d / hr
-- -------------------------------------------------------------------------- --
-- Difficulty Levels (leading zeros)
newtype Level = Level Int
deriving (Show, Eq, Ord)
level :: Show a => Integral a => a -> Level
level i
| i < 0 || i > 256 = error $ "Invalid difficulty level. Expected [0,256]; got " <> show i
| otherwise = Level (int i)
{-# INLINE level #-}
instance A.ToJSON Level where
toJSON (Level i) = A.toJSON i
{-# INLINE toJSON #-}
instance A.FromJSON Level where
parseJSON = A.parseJSON >=> \i -> if
| i < 0 || i > 256 -> fail $ "Invalid difficulty level. Expected an integral value between 0 and 256; got " <> show i
| otherwise -> return $ Level i
{-# INLINE parseJSON #-}
mkTargetLevel :: Level -> Target
mkTargetLevel (Level i) = Target $ 2^(256-i) - 1
getTargetLevel :: Target -> Level
getTargetLevel (Target 0) = Level 256
getTargetLevel (Target i) = Level $ int $ 256 - naturalLog2 i - 1
{-# INLINE getTargetLevel #-}
reduceLevel :: Int -> Target -> Target
reduceLevel i (Target t) = Target $ shiftL t i
{-# INLINE reduceLevel #-}
increaseLevel :: Int -> Target -> Target
increaseLevel i (Target t) = Target $ shiftR t i
{-# INLINE increaseLevel #-}
leveled :: Target -> Target
leveled = mkTargetLevel . getTargetLevel
{-# INLINE leveled #-}