Safe Haskell | None |
---|---|
Language | Haskell2010 |
Data.Blockchain.Types
- data Validated
- data Unvalidated
- data Blockchain a
- blockchainConfig :: Blockchain a -> BlockchainConfig
- blockchainNode :: Blockchain a -> BlockchainNode
- data BlockchainNode = BlockchainNode {
- nodeBlock :: Block
- nodeNodes :: [BlockchainNode]
- data ValidationException
- data BlockException
- = BlockAlreadyExists
- | NoParentFound
- | TimestampTooOld
- | TimestampTooFarIntoFuture
- | InvalidDifficultyReference
- | InvalidDifficulty
- | InvalidCoinbaseTransactionHash
- | InvalidTransactionHashTreeRoot
- | InvalidCoinbaseTransactionValue
- | InvalidTransactionValues
- | TransactionOutRefNotFound
- | InvalidTransactionSignature
- construct :: BlockchainConfig -> BlockchainNode -> Blockchain Unvalidated
- validate :: Blockchain Unvalidated -> Either ValidationException (Blockchain Validated)
- unvalidate :: Blockchain Validated -> Blockchain Unvalidated
- addBlock :: Block -> Blockchain Validated -> Either BlockException (Blockchain Validated)
- validateTransaction :: Blockchain Validated -> Transaction -> Either BlockException ()
- validateTransactions :: Blockchain Validated -> [Transaction] -> Either BlockException ()
- blockHeaderHashDifficulty :: Hex256 -> BlockHeader -> Difficulty
- addressValues :: Blockchain Validated -> HashMap PublicKey Word
- unspentTransactionOutputs :: Blockchain Validated -> HashMap PublicKey [(TransactionOutRef, TransactionOut)]
- longestChain :: Blockchain Validated -> NonEmpty Block
- flatten :: Blockchain Validated -> NonEmpty (NonEmpty Block)
- data Block = Block {}
- data BlockHeader = BlockHeader {}
- data BlockchainConfig = BlockchainConfig {}
- defaultConfig :: BlockchainConfig
- targetReward :: BlockchainConfig -> Word -> Word
- targetDifficulty :: BlockchainConfig -> [Block] -> Difficulty
- newtype Difficulty = Difficulty {}
- newtype Hex256 = Hex256 {}
- hex256 :: String -> Maybe Hex256
- hex256LeadingZeros :: Word -> Hex256
- data Transaction = Transaction {}
- newtype CoinbaseTransaction = CoinbaseTransaction {}
- data TransactionIn = TransactionIn {}
- data TransactionOutRef = TransactionOutRef {}
- data TransactionOut = TransactionOut {}
- signTransaction :: PrivateKey -> TransactionOut -> IO Signature
- verifyTransactionSignature :: Signature -> TransactionOut -> Bool
Documentation
data Unvalidated Source #
Instances
data Blockchain a Source #
Core blockchain data type. Uses a validation tag to declare if it is known to abide by expected blockchain rules.
Will be either
or Blockchain
Validated
.Blockchain
Unvalidated
Note: both
and Blockchain
Validated
can be serialized to json,
while only Blockchain
Unvalidated
can be deserialized from json.Blockchain
Unvalidated
Instances
Eq (Blockchain a) Source # | |
Show (Blockchain a) Source # | |
Generic (Blockchain a) Source # | |
ToJSON (Blockchain a) Source # | |
FromJSON (Blockchain Unvalidated) Source # | |
type Rep (Blockchain a) Source # | |
blockchainNode :: Blockchain a -> BlockchainNode Source #
data BlockchainNode Source #
Constructors
BlockchainNode | |
Fields
|
data ValidationException Source #
Constructors
GenesisBlockHasTransactions | |
GenesisBlockException BlockException | |
BlockValidationException BlockException |
Instances
data BlockException Source #
Constructors
Instances
Construction
construct :: BlockchainConfig -> BlockchainNode -> Blockchain Unvalidated Source #
Constructs an unvalidated blockchain from a config and a node. Allows arbitrary blockchains to be constructed. However, blockchains are generally not useful until validated.
validate :: Blockchain Unvalidated -> Either ValidationException (Blockchain Validated) Source #
Validates a blockchain. Returns a ValidationException
if provided blockchain does not meet expected rules.
unvalidate :: Blockchain Validated -> Blockchain Unvalidated Source #
Isomorphic - useful for sending api responses
addBlock :: Block -> Blockchain Validated -> Either BlockException (Blockchain Validated) Source #
Adds a block to a validated blockchain. Returns a BlockException
if block is not able to be inserted into the blockchain.
Validation
validateTransaction :: Blockchain Validated -> Transaction -> Either BlockException () Source #
validateTransactions :: Blockchain Validated -> [Transaction] -> Either BlockException () Source #
Chain inspection
unspentTransactionOutputs :: Blockchain Validated -> HashMap PublicKey [(TransactionOutRef, TransactionOut)] Source #
Constructors
Block | |
Fields |
data BlockchainConfig Source #
Constructors
BlockchainConfig | |
defaultConfig :: BlockchainConfig Source #
A reasonable default config to use for testing. Mines blocks quickly and changes difficulty and rewards frequently. Note: reward will go to zero after 1100 blocks, which will take about 180 minutes of mining.
defaultConfig :: BlockchainConfig defaultConfig = BlockchainConfig { initialDifficulty = Difficulty 1 , difficulty1Target = hex256LeadingZeros 4 , targetSecondsPerBlock = 10 , difficultyRecalculationHeight = 50 , initialMiningReward = 1024 , miningRewardHalvingHeight = 100 }
targetReward :: BlockchainConfig -> Word -> Word Source #
Calculates the target reward for a blockchain. Uses the longest chain.
targetDifficulty :: BlockchainConfig -> [Block] -> Difficulty Source #
Calculates the target difficulty for a blockchain. Uses the longest chain.
newtype Difficulty Source #
Constructors
Difficulty | |
Fields |
hex256LeadingZeros :: Word -> Hex256 Source #
Create a Hex256 value with the specificed amount of leading zeros.
Useful for creating a difficulty1Target
when creating a blockchain.
>>>
hex256LeadingZeros 4
0000ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
newtype CoinbaseTransaction Source #
Constructors
CoinbaseTransaction | |
Fields |
data TransactionIn Source #
Constructors
TransactionIn | |
Fields
|
data TransactionOutRef Source #
Pointer to a specific TransactionOut
Constructors
TransactionOutRef | |
Fields |
data TransactionOut Source #
Constructors
TransactionOut | |
Fields
|
signTransaction :: PrivateKey -> TransactionOut -> IO Signature Source #