View on GitHub
File Changes
  hs-source-dirs:      src
  exposed-modules:     Oddchain
  build-depends:       base >=4.11 && <5
+
                     , binary
                     , bytestring
                     , containers
                     , cryptonite

                      
import           Prelude hiding (flip)

                      
-
import           Control.Monad.Except (runExcept, throwError)
+
import           Control.Monad.Except (throwError)
import           Crypto.Random (MonadRandom)
+
import qualified Data.Binary.Get as Get
+
import qualified Data.Binary.Put as Put
import qualified Data.ByteString as Strict
-
import           Data.Either (either, isRight)
+
import           Data.Either (isRight)
import           Data.FingerTree (Measured, measure)
import           Data.Map.Strict ((!))
import           Data.Maybe (catMaybes)
-
import           Data.Proxy (Proxy)
+
import           Data.Proxy (Proxy (Proxy))
import           Data.Time.Clock (UTCTime)
import           Data.Word (Word64)
import           GHC.Generics (Generic)
import           Cardano.Crypto.DSIGN.Mock ()
import           Cardano.Crypto.Hash.Class (hash)
import qualified Cardano.Crypto.Hash.Class as Crypto.Hash
+
import qualified Cardano.Crypto.Hash.Class
import           Cardano.Crypto.Hash.Short (ShortHash)
import           Cardano.Prelude (NoUnexpectedThunks)
import           Ouroboros.Consensus.Block (GetHeader, Header, SupportedBlock,
                     getHeader, validateView)
import           Ouroboros.Consensus.BlockchainTime.SlotLengths
                     (SystemStart (SystemStart))
+
import           Ouroboros.Consensus.HeaderValidation (HasAnnTip,
+
                     ValidateEnvelope)
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState,
                     ledgerState)
import           Ouroboros.Consensus.Mempool.API (ApplyTx, ApplyTxErr, GenTx,
-
                     HasTxId (TxId, txId), applyTx, reapplyTx,
-
                     reapplyTxSameState, txSize)
+
                     HasTxId (TxId, txId), applyTx, reapplyTx, txSize)
+
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
+
                     (HasNetworkProtocolVersion)
import           Ouroboros.Consensus.Node.Run.Abstract (RunNode,
                     nodeAddHeaderEnvelope, nodeBlockEncodingOverhead,
                     nodeBlockFetchSize, nodeBlockMatchesHeader,
import           Ouroboros.Storage.Common (BinaryInfo (BinaryInfo), EpochNo,
                     EpochSize (EpochSize), binaryBlob, headerOffset,
                     headerSize)
+
import           Ouroboros.Storage.ImmutableDB.Types (HashInfo (HashInfo),
+
                     getHash, hashSize, putHash)
+

                      

                      
data OddBlock
  = OddBlock
    { oddBlockHeader  :: !(Header OddBlock)
    , oddBlockPayload :: ![Tx]
-
    }
+
    } deriving (HasAnnTip, ValidateEnvelope, HasNetworkProtocolVersion)

                      
type Hash a = Crypto.Hash.Hash ShortHash a

                      

                      
  reapplyTx = applyTx

                      
-
  reapplyTxSameState cfg tx st =
-
    either err id (runExcept $ applyTx cfg tx st)
-
    where
-
      err = error $  "Applying the transaction shouldn't have failed "
-
                  ++ "if it didn't fail when it was applied in the same state."
-

                      
checkTx :: LedgerState OddBlock -> Tx -> Maybe OddTxError
checkTx LedgerState { phase } (Tx i) =
  if odd i

                      
  nodeProtocolMagicId _ _ = ProtocolMagicId 0

                      
-
  -- nodeHashInfo
+
  nodeHashInfo :: Proxy OddBlock -> HashInfo (Hash (Header OddBlock))
+
  --
+
  -- This means we need to return:
+
  --
+
  -- > data HashInfo hash = HashInfo
+
  -- > { hashSize :: !Word32
+
  -- >  -- ^ A fixed size
+
  -- > , getHash  :: !(Get hash)
+
  -- > , putHash  :: !(hash -> Put)
+
  -- > }
+
  --
+
  --
+
  nodeHashInfo _ =
+
    HashInfo
+
    -- NOTE: for some strange reason the 'byteCount' is supposed to return a
+
    -- Natural, instead of a 'Word'. I don't think we'd need more than 2^32
+
    -- bytes for encoding hashes, since that's about 4GB.
+
    { hashSize = hashSize'
+
    , getHash =
+
        Crypto.Hash.UnsafeHash <$> Get.getByteString (fromIntegral hashSize')
+
    , putHash = \h -> Put.putByteString (Crypto.Hash.getHash h)
+
    }
+
    where
+
      hashSize' = fromIntegral
+
                $ Cardano.Crypto.Hash.Class.byteCount (Proxy :: Proxy ShortHash)
+
  -- See:
+
  --
+
  --
+
  -- > byronHashInfo :: HashInfo ByronHash
+
  -- > byronHashInfo = HashInfo { hashSize, getHash, putHash }
+
  -- >   where
+
  -- >     hashSize :: Word32
+
  -- >     hashSize = fromIntegral $ CC.hashDigestSize' @Crypto.Blake2b_256
+
  -- >
+
  -- >     getHash :: Get ByronHash
+
  -- >     getHash = do
+
  -- >       bytes <- Get.getByteString (fromIntegral hashSize)
+
  -- >       case Crypto.digestFromByteString bytes of
+
  -- >         Nothing     -> fail "digestFromByteString failed"
+
  -- >         Just digest -> return $ ByronHash $ CC.AbstractHash digest
+
  -- >
+
  -- >     putHash :: ByronHash -> Put
+
  -- >     putHash (ByronHash (CC.AbstractHash digest)) =
+
  -- >       Put.putByteString $ ByteArray.convert digest
+
  -- >
+
  --
+
  -- in @module [email protected]

                      
  -- We don't have a variable block size for now. We use 1M blocks
  nodeMaxBlockSize  = const $ 2^(20 :: Int)
    , headerSize   = fromIntegral $ Strict.length $ serialize' $ getHeader blk
    }

                      
-
  nodeEncodeHeader _ = toCBOR
+
  nodeEncodeHeader _ _ = toCBOR

                      
  nodeEncodeGenTx = toCBOR

                      
  nodeEncodeGenTxId = toCBOR

                      
  nodeEncodeHeaderHash _ = toCBOR

                      
-
  nodeEncodeHeaderHash _ = toCBOR
-

                      
  nodeEncodeLedgerState _ = toCBOR

                      
  nodeEncodeChainState _ _ = toCBOR
m
+14/-15

                      
extra-deps:
  - git: https://github.com/input-output-hk/ouroboros-network
-
    commit: 8e7e5912816e4ce8b3df9d9466fbba99472b49a6
+
    commit: f5741efd37c5558d8a29d0d2b142e01f650a3d45
    subdirs:
      - ouroboros-consensus
      - io-sim-classes
    subdirs:
      - contra-tracer

                      
-
  - git: https://github.com/input-output-hk/cardano-prelude
-
    commit: 00487726c4bc21b4744e59d913334ebfeac7d68e
-
    subdirs:
-
      - .
-
      - test
-

                      
  - git: https://github.com/input-output-hk/cardano-base
-
    commit: 965b8b143632faea16680a195e6de57091382700
+
    commit: 474622cfde663730e10e2e0d5de0ed06a867a844
    subdirs:
      - binary
      - binary/test
      - byron/ledger/executable-spec
      - byron/chain/executable-spec

                      
+
  - git: https://github.com/input-output-hk/goblins
+
    commit: 26d35ad52fe9ade3391532dbfeb2f416f07650bc
+
  - moo-1.2
+
  - gray-code-0.3.1
+

                      
  - git: https://github.com/input-output-hk/cardano-ledger
-
    commit: e8475e33772e7408e83ff22e4406673ea73f93fd
+
    commit: 6d533b72d4a91b756cd8ffe164928d5f5eebcfa0
    subdirs:
      - cardano-ledger
      - cardano-ledger/test
      - crypto
      - crypto/test

                      
+
  - git: https://github.com/input-output-hk/cardano-prelude
+
    commit: 00487726c4bc21b4744e59d913334ebfeac7d68e
+
    subdirs:
+
      - .
+
      - test
+

                      
  # Needed for cardano-ledger-specs
  - Unique-0.4.7.6

                      
-
  # Needed for goblins, which is in turn needed for cardano-ledger-specs :(
-
  - git: https://github.com/input-output-hk/goblins
-
    commit: 26d35ad52fe9ade3391532dbfeb2f416f07650bc
-
  - moo-1.2
-
  - gray-code-0.3.1
-

                      
  # Needed for lentil
  - [email protected]:ba857f3424ddb1034125163a9a384e9baab22e55de968259b046892c20ec0526,2257