{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | This module contains previous implementations for Addr and CoompactAddr
-- deserialization. This is used as an alternative implementation for testing and as a
-- perforance reference for benchmarking.
module Test.Cardano.Ledger.Core.Address (
  deserialiseAddrOld,
  deserialiseRewardAccountOld,
  decompactAddrOld,
  decompactAddrOldLazy,
)
where

import qualified Cardano.Crypto.Hash.Class as Hash
import Cardano.Ledger.Address (
  Addr (..),
  BootstrapAddress (BootstrapAddress),
  CompactAddr,
  RewardAccount (..),
  Word7 (..),
  toWord7,
  unCompactAddr,
 )
import Cardano.Ledger.BaseTypes (CertIx (..), SlotNo (..), TxIx (..), word8ToNetwork)
import Cardano.Ledger.Binary (byronProtVer, decodeFull, decodeFull')
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (
  Credential (..),
  PaymentCredential,
  Ptr (..),
  StakeReference (..),
 )
import Control.Monad (ap)
import qualified Control.Monad.Fail
import Data.Binary (Get)
import qualified Data.Binary.Get as B
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.ByteString.Short as SBS (ShortByteString, fromShort, index, length)
import Data.ByteString.Short.Internal as SBS (ShortByteString (SBS))
import Data.Foldable as F (foldl')
import Data.Maybe (fromMaybe)
import qualified Data.Primitive.ByteArray as BA
import Data.String (fromString)
import Data.Text (Text, unpack)
import Data.Word (Word64, Word8)

------------------------------------------------------------------------------------------
-- Old Address Deserializer --------------------------------------------------------------
------------------------------------------------------------------------------------------

-- | Deserialise an address from the external format. This will fail if the
-- input data is not in the right format (or if there is trailing data).
deserialiseAddrOld :: MonadFail m => BS.ByteString -> m Addr
deserialiseAddrOld :: forall (m :: * -> *). MonadFail m => ByteString -> m Addr
deserialiseAddrOld ByteString
bs = case forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, [Char]) (ByteString, ByteOffset, a)
B.runGetOrFail Get Addr
getAddr (ByteString -> ByteString
BSL.fromStrict ByteString
bs) of
  Left (ByteString
_remaining, ByteOffset
_offset, [Char]
message) ->
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Old Addr decoder failed: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
message
  Right (ByteString
remaining, ByteOffset
_offset, Addr
result) ->
    if ByteString -> Bool
BSL.null ByteString
remaining
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure Addr
result
      else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Old Addr decoder did not consume all input"

-- | Deserialise an reward account from the external format. This will fail if the
-- input data is not in the right format (or if there is trailing data).
deserialiseRewardAccountOld :: MonadFail m => BS.ByteString -> m RewardAccount
deserialiseRewardAccountOld :: forall (m :: * -> *). MonadFail m => ByteString -> m RewardAccount
deserialiseRewardAccountOld ByteString
bs = case forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, [Char]) (ByteString, ByteOffset, a)
B.runGetOrFail Get RewardAccount
getRewardAccount (ByteString -> ByteString
BSL.fromStrict ByteString
bs) of
  Left (ByteString
_remaining, ByteOffset
_offset, [Char]
message) ->
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Old RewardAccount decoder failed: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
message
  Right (ByteString
remaining, ByteOffset
_offset, RewardAccount
result) ->
    if ByteString -> Bool
BSL.null ByteString
remaining
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure RewardAccount
result
      else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Old RewardAccount decoder did not consume all input"

byron :: Int
byron :: Int
byron = Int
7

notBaseAddr :: Int
notBaseAddr :: Int
notBaseAddr = Int
6

isEnterpriseAddr :: Int
isEnterpriseAddr :: Int
isEnterpriseAddr = Int
5

stakeCredIsScript :: Int
stakeCredIsScript :: Int
stakeCredIsScript = Int
5

payCredIsScript :: Int
payCredIsScript :: Int
payCredIsScript = Int
4

rewardCredIsScript :: Int
rewardCredIsScript :: Int
rewardCredIsScript = Int
4

getAddr :: Get Addr
getAddr :: Get Addr
getAddr = do
  Word8
header <- forall a. Get a -> Get a
B.lookAhead Get Word8
B.getWord8
  if forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
byron
    then Get Addr
getByron
    else do
      Word8
_ <- Get Word8
B.getWord8 -- read past the header byte
      let addrNetId :: Word8
addrNetId = Word8
header forall a. Bits a => a -> a -> a
.&. Word8
0x0F -- 0b00001111 is the mask for the network id
      case Word8 -> Maybe Network
word8ToNetwork Word8
addrNetId of
        Just Network
n -> Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Get PaymentCredential
getPayCred Word8
header forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> Get StakeReference
getStakeReference Word8
header
        Maybe Network
Nothing ->
          forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [[Char]
"Address with unknown network Id. (", forall a. Show a => a -> [Char]
show Word8
addrNetId, [Char]
")"]

getRewardAccount :: Get RewardAccount
getRewardAccount :: Get RewardAccount
getRewardAccount = do
  Word8
header <- Get Word8
B.getWord8
  let rewardAccountPrefix :: Word8
rewardAccountPrefix = Word8
0xE0 -- 0b11100000 are always set for reward accounts
      isRewardAccount :: Bool
isRewardAccount = (Word8
header forall a. Bits a => a -> a -> a
.&. Word8
rewardAccountPrefix) forall a. Eq a => a -> a -> Bool
== Word8
rewardAccountPrefix
      netId :: Word8
netId = Word8
header forall a. Bits a => a -> a -> a
.&. Word8
0x0F -- 0b00001111 is the mask for the network id
  case (Word8 -> Maybe Network
word8ToNetwork Word8
netId, Bool
isRewardAccount) of
    (Maybe Network
Nothing, Bool
_) ->
      forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"Reward account with unknown network Id. (", forall a. Show a => a -> [Char]
show Word8
netId, [Char]
")"]
    (Maybe Network
_, Bool
False) ->
      forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"Expected reward account. Got account with header: ", forall a. Show a => a -> [Char]
show Word8
header]
    (Just Network
network, Bool
True) -> do
      Credential 'Staking
cred <- case forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
rewardCredIsScript of
        Bool
True -> forall (kr :: KeyRole). Get (Credential kr)
getScriptHash
        Bool
False -> forall (kr :: KeyRole). Get (Credential kr)
getKeyHash
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
network Credential 'Staking
cred

getHash :: forall h a. Hash.HashAlgorithm h => Get (Hash.Hash h a)
getHash :: forall h a. HashAlgorithm h => Get (Hash h a)
getHash = do
  ByteString
bytes <- Int -> Get ByteString
B.getByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash ([] @h)
  case forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes ByteString
bytes of
    Maybe (Hash h a)
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"getHash: implausible hash length mismatch"
    Just !Hash h a
h -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Hash h a
h

getPayCred :: Word8 -> Get PaymentCredential
getPayCred :: Word8 -> Get PaymentCredential
getPayCred Word8
header = case forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
payCredIsScript of
  Bool
True -> forall (kr :: KeyRole). Get (Credential kr)
getScriptHash
  Bool
False -> forall (kr :: KeyRole). Get (Credential kr)
getKeyHash

getScriptHash :: Get (Credential kr)
getScriptHash :: forall (kr :: KeyRole). Get (Credential kr)
getScriptHash = forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h a. HashAlgorithm h => Get (Hash h a)
getHash

getKeyHash :: Get (Credential kr)
getKeyHash :: forall (kr :: KeyRole). Get (Credential kr)
getKeyHash = forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h a. HashAlgorithm h => Get (Hash h a)
getHash

getStakeReference :: Word8 -> Get StakeReference
getStakeReference :: Word8 -> Get StakeReference
getStakeReference Word8
header = case forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
notBaseAddr of
  Bool
True -> case forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
isEnterpriseAddr of
    Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeReference
StakeRefNull
    Bool
False -> Ptr -> StakeReference
StakeRefPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Ptr
getPtr
  Bool
False -> case forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
stakeCredIsScript of
    Bool
True -> Credential 'Staking -> StakeReference
StakeRefBase forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (kr :: KeyRole). Get (Credential kr)
getScriptHash
    Bool
False -> Credential 'Staking -> StakeReference
StakeRefBase forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (kr :: KeyRole). Get (Credential kr)
getKeyHash

getByron :: Get Addr
getByron :: Get Addr
getByron =
  forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull Version
byronProtVer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
B.getRemainingLazyByteString forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left DecoderError
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall a. Show a => a -> [Char]
show DecoderError
e)
    Right Address
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ BootstrapAddress -> Addr
AddrBootstrap forall a b. (a -> b) -> a -> b
$ Address -> BootstrapAddress
BootstrapAddress Address
r

getPtr :: Get Ptr
getPtr :: Get Ptr
getPtr =
  SlotNo -> TxIx -> CertIx -> Ptr
Ptr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SlotNo
SlotNo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getVariableLengthWord64)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> TxIx
TxIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getVariableLengthWord64)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> CertIx
CertIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getVariableLengthWord64)

getWord7s :: Get [Word7]
getWord7s :: Get [Word7]
getWord7s = do
  Word8
next <- Get Word8
B.getWord8
  -- is the high bit set?
  if forall a. Bits a => a -> Int -> Bool
testBit Word8
next Int
7
    then -- if so, grab more words
      (:) (Word8 -> Word7
toWord7 Word8
next) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word7]
getWord7s
    else -- otherwise, this is the last one
      forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word8 -> Word7
Word7 Word8
next]

-- invariant: length [Word7] < 8
word7sToWord64 :: [Word7] -> Word64
word7sToWord64 :: [Word7] -> Word64
word7sToWord64 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall {a}. (Bits a, Num a) => a -> Word7 -> a
f Word64
0
  where
    f :: a -> Word7 -> a
f a
n (Word7 Word8
r) = forall a. Bits a => a -> Int -> a
shiftL a
n Int
7 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
r

getVariableLengthWord64 :: Get Word64
getVariableLengthWord64 :: Get Word64
getVariableLengthWord64 = [Word7] -> Word64
word7sToWord64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word7]
getWord7s

------------------------------------------------------------------------------------------
-- Old Compact Address Deserializer ------------------------------------------------------
------------------------------------------------------------------------------------------

newtype GetShort a = GetShort {forall a. GetShort a -> Int -> ShortByteString -> Maybe (Int, a)
runGetShort :: Int -> ShortByteString -> Maybe (Int, a)}
  deriving (forall a b. a -> GetShort b -> GetShort a
forall a b. (a -> b) -> GetShort a -> GetShort b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GetShort b -> GetShort a
$c<$ :: forall a b. a -> GetShort b -> GetShort a
fmap :: forall a b. (a -> b) -> GetShort a -> GetShort b
$cfmap :: forall a b. (a -> b) -> GetShort a -> GetShort b
Functor)

instance Applicative GetShort where
  pure :: forall a. a -> GetShort a
pure a
a = forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort forall a b. (a -> b) -> a -> b
$ \Int
i ShortByteString
_sbs -> forall a. a -> Maybe a
Just (Int
i, a
a)
  <*> :: forall a b. GetShort (a -> b) -> GetShort a -> GetShort b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad GetShort where
  (GetShort Int -> ShortByteString -> Maybe (Int, a)
g) >>= :: forall a b. GetShort a -> (a -> GetShort b) -> GetShort b
>>= a -> GetShort b
f = forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort forall a b. (a -> b) -> a -> b
$ \Int
i ShortByteString
sbs ->
    case Int -> ShortByteString -> Maybe (Int, a)
g Int
i ShortByteString
sbs of
      Maybe (Int, a)
Nothing -> forall a. Maybe a
Nothing
      Just (Int
i', a
x) -> forall a. GetShort a -> Int -> ShortByteString -> Maybe (Int, a)
runGetShort (a -> GetShort b
f a
x) Int
i' ShortByteString
sbs

instance Control.Monad.Fail.MonadFail GetShort where
  fail :: forall a. [Char] -> GetShort a
fail [Char]
_ = forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort forall a b. (a -> b) -> a -> b
$ \Int
_ ShortByteString
_ -> forall a. Maybe a
Nothing

getShortBootstrapAddress :: GetShort BootstrapAddress
getShortBootstrapAddress :: GetShort BootstrapAddress
getShortBootstrapAddress = do
  ByteString
bs <- GetShort ByteString
getShortRemainingAsByteString
  case forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' Version
byronProtVer ByteString
bs of
    Left DecoderError
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show DecoderError
e
    Right Address
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Address -> BootstrapAddress
BootstrapAddress Address
r

getShortWord :: GetShort Word8
getShortWord :: GetShort Word8
getShortWord = forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort forall a b. (a -> b) -> a -> b
$ \Int
i ShortByteString
sbs ->
  if Int
i forall a. Ord a => a -> a -> Bool
< ShortByteString -> Int
SBS.length ShortByteString
sbs
    then forall a. a -> Maybe a
Just (Int
i forall a. Num a => a -> a -> a
+ Int
1, HasCallStack => ShortByteString -> Int -> Word8
SBS.index ShortByteString
sbs Int
i)
    else forall a. Maybe a
Nothing

peekWord8 :: GetShort Word8
peekWord8 :: GetShort Word8
peekWord8 = forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort Int -> ShortByteString -> Maybe (Int, Word8)
peek
  where
    peek :: Int -> ShortByteString -> Maybe (Int, Word8)
peek Int
i ShortByteString
sbs = if Int
i forall a. Ord a => a -> a -> Bool
< ShortByteString -> Int
SBS.length ShortByteString
sbs then forall a. a -> Maybe a
Just (Int
i, HasCallStack => ShortByteString -> Int -> Word8
SBS.index ShortByteString
sbs Int
i) else forall a. Maybe a
Nothing

getShortRemainingAsByteString :: GetShort BS.ByteString
getShortRemainingAsByteString :: GetShort ByteString
getShortRemainingAsByteString = forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort forall a b. (a -> b) -> a -> b
$ \Int
i ShortByteString
sbs ->
  let l :: Int
l = ShortByteString -> Int
SBS.length ShortByteString
sbs
   in if Int
i forall a. Ord a => a -> a -> Bool
< Int
l
        then forall a. a -> Maybe a
Just (Int
l, ShortByteString -> ByteString
SBS.fromShort forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int -> Int -> ShortByteString
substring ShortByteString
sbs Int
i Int
l)
        else forall a. Maybe a
Nothing

getShortHash :: forall a h. Hash.HashAlgorithm h => GetShort (Hash.Hash h a)
getShortHash :: forall a h. HashAlgorithm h => GetShort (Hash h a)
getShortHash = forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort forall a b. (a -> b) -> a -> b
$ \Int
i ShortByteString
sbs ->
  let hashLen :: Word
hashLen = forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash ([] @h)
      offsetStop :: Int
offsetStop = Int
i forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
hashLen
   in if Int
offsetStop forall a. Ord a => a -> a -> Bool
<= ShortByteString -> Int
SBS.length ShortByteString
sbs
        then do
          Hash h a
hash <- forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
Hash.hashFromBytesShort forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int -> Int -> ShortByteString
substring ShortByteString
sbs Int
i Int
offsetStop
          forall a. a -> Maybe a
Just (Int
offsetStop, Hash h a
hash)
        else forall a. Maybe a
Nothing

-- start is the first index copied
-- stop is the index after the last index copied
substring :: ShortByteString -> Int -> Int -> ShortByteString
substring :: ShortByteString -> Int -> Int -> ShortByteString
substring (SBS ByteArray#
ba) Int
start Int
stop =
  case ByteArray -> Int -> Int -> ByteArray
BA.cloneByteArray (ByteArray# -> ByteArray
BA.ByteArray ByteArray#
ba) Int
start (Int
stop forall a. Num a => a -> a -> a
- Int
start) of
    BA.ByteArray ByteArray#
ba' -> ByteArray# -> ShortByteString
SBS ByteArray#
ba'

getShortWord7s :: GetShort [Word7]
getShortWord7s :: GetShort [Word7]
getShortWord7s = do
  Word8
next <- GetShort Word8
getShortWord
  -- is the high bit set?
  if forall a. Bits a => a -> Int -> Bool
testBit Word8
next Int
7
    then -- if so, grab more words
      (:) (Word8 -> Word7
toWord7 Word8
next) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort [Word7]
getShortWord7s
    else -- otherwise, this is the last one
      forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word8 -> Word7
Word7 Word8
next]

getShortVariableLengthWord64 :: GetShort Word64
getShortVariableLengthWord64 :: GetShort Word64
getShortVariableLengthWord64 = [Word7] -> Word64
word7sToWord64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort [Word7]
getShortWord7s

getShortPtr :: GetShort Ptr
getShortPtr :: GetShort Ptr
getShortPtr =
  SlotNo -> TxIx -> CertIx -> Ptr
Ptr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SlotNo
SlotNo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort Word64
getShortVariableLengthWord64)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> TxIx
TxIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort Word64
getShortVariableLengthWord64)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> CertIx
CertIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort Word64
getShortVariableLengthWord64)

getShortKeyHash :: GetShort (Credential kr)
getShortKeyHash :: forall (kr :: KeyRole). GetShort (Credential kr)
getShortKeyHash = forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a h. HashAlgorithm h => GetShort (Hash h a)
getShortHash

getShortScriptHash :: GetShort (Credential kr)
getShortScriptHash :: forall (kr :: KeyRole). GetShort (Credential kr)
getShortScriptHash = forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a h. HashAlgorithm h => GetShort (Hash h a)
getShortHash

getShortStakeReference :: Word8 -> GetShort StakeReference
getShortStakeReference :: Word8 -> GetShort StakeReference
getShortStakeReference Word8
header = case forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
notBaseAddr of
  Bool
True -> case forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
isEnterpriseAddr of
    Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeReference
StakeRefNull
    Bool
False -> Ptr -> StakeReference
StakeRefPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort Ptr
getShortPtr
  Bool
False -> case forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
stakeCredIsScript of
    Bool
True -> Credential 'Staking -> StakeReference
StakeRefBase forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (kr :: KeyRole). GetShort (Credential kr)
getShortScriptHash
    Bool
False -> Credential 'Staking -> StakeReference
StakeRefBase forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (kr :: KeyRole). GetShort (Credential kr)
getShortKeyHash

getShortPayCred :: Word8 -> GetShort PaymentCredential
getShortPayCred :: Word8 -> GetShort PaymentCredential
getShortPayCred Word8
header = case forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
payCredIsScript of
  Bool
True -> forall (kr :: KeyRole). GetShort (Credential kr)
getShortScriptHash
  Bool
False -> forall (kr :: KeyRole). GetShort (Credential kr)
getShortKeyHash

getShortShortAddr :: GetShort Addr
getShortShortAddr :: GetShort Addr
getShortShortAddr = do
  Word8
header <- GetShort Word8
peekWord8
  if forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
byron
    then BootstrapAddress -> Addr
AddrBootstrap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort BootstrapAddress
getShortBootstrapAddress
    else do
      Word8
_ <- GetShort Word8
getShortWord -- read past the header byte
      let addrNetId :: Word8
addrNetId = Word8
header forall a. Bits a => a -> a -> a
.&. Word8
0x0F -- 0b00001111 is the mask for the network id
      case Word8 -> Maybe Network
word8ToNetwork Word8
addrNetId of
        Just Network
n -> do
          PaymentCredential
c <- Word8 -> GetShort PaymentCredential
getShortPayCred Word8
header
          StakeReference
h <- Word8 -> GetShort StakeReference
getShortStakeReference Word8
header
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
n PaymentCredential
c StakeReference
h)
        Maybe Network
Nothing ->
          forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [[Char]
"Address with unknown network Id. (", forall a. Show a => a -> [Char]
show Word8
addrNetId, [Char]
")"]

-- | This is an old decompacter that didn't guard against random junk at the end.
decompactAddrOld :: CompactAddr -> Addr
decompactAddrOld :: CompactAddr -> Addr
decompactAddrOld CompactAddr
cAddr =
  forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Text -> Maybe a -> a
unwrap Text
"CompactAddr" forall a b. (a -> b) -> a -> b
$ forall a. GetShort a -> Int -> ShortByteString -> Maybe (Int, a)
runGetShort GetShort Addr
getShortShortAddr Int
0 (CompactAddr -> ShortByteString
unCompactAddr CompactAddr
cAddr)
  where
    -- The reason failure is impossible here is that the only way to call this code
    -- is using a CompactAddr, which can only be constructed using compactAddr.
    -- compactAddr serializes an Addr, so this is guaranteed to work.
    unwrap :: forall a. Text -> Maybe a -> a
    unwrap :: forall a. Text -> Maybe a -> a
unwrap Text
name = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Text -> [Char]
unpack forall a b. (a -> b) -> a -> b
$ Text
"Impossible failure when decoding " forall a. Semigroup a => a -> a -> a
<> Text
name)

-- | This lazy deserializer is kept around purely for benchmarking, so we can
-- verify that new deserializer `decodeAddrStateT` is doing the work lazily.
decompactAddrOldLazy :: CompactAddr -> Addr
decompactAddrOldLazy :: CompactAddr -> Addr
decompactAddrOldLazy CompactAddr
cAddr =
  if forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
byron
    then BootstrapAddress -> Addr
AddrBootstrap forall a b. (a -> b) -> a -> b
$ forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
"byron address" Int
0 ShortByteString
bytes GetShort BootstrapAddress
getShortBootstrapAddress
    else Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
addrNetId PaymentCredential
paycred StakeReference
stakecred
  where
    bytes :: ShortByteString
bytes = CompactAddr -> ShortByteString
unCompactAddr CompactAddr
cAddr
    run :: forall a. Text -> Int -> ShortByteString -> GetShort a -> a
    run :: forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
name Int
i ShortByteString
sbs GetShort a
g = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Text -> Maybe a -> a
unwrap Text
name forall a b. (a -> b) -> a -> b
$ forall a. GetShort a -> Int -> ShortByteString -> Maybe (Int, a)
runGetShort GetShort a
g Int
i ShortByteString
sbs
    -- The reason failure is impossible here is that the only way to call this code
    -- is using a CompactAddr, which can only be constructed using compactAddr.
    -- compactAddr serializes an Addr, so this is guaranteed to work.
    unwrap :: forall a. Text -> Maybe a -> a
    unwrap :: forall a. Text -> Maybe a -> a
unwrap Text
name = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Text -> [Char]
unpack forall a b. (a -> b) -> a -> b
$ Text
"Impossible failure when decoding " forall a. Semigroup a => a -> a -> a
<> Text
name)
    header :: Word8
header = forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
"address header" Int
0 ShortByteString
bytes GetShort Word8
getShortWord
    addrNetId :: Network
addrNetId =
      forall a. Text -> Maybe a -> a
unwrap Text
"address network id" forall a b. (a -> b) -> a -> b
$
        Word8 -> Maybe Network
word8ToNetwork forall a b. (a -> b) -> a -> b
$
          Word8
header forall a. Bits a => a -> a -> a
.&. Word8
0x0F -- 0b00001111 is the mask for the network id
          -- The address format is
          -- header | pay cred | stake cred
          -- where the header is 1 byte
          -- the pay cred is (sizeHash (ADDRHASH crypto)) bytes
          -- and the stake cred can vary
    paycred :: PaymentCredential
paycred = forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
"payment credential" Int
1 ShortByteString
bytes (Word8 -> GetShort PaymentCredential
getShortPayCred Word8
header)
    stakecred :: StakeReference
stakecred = forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
"staking credential" Int
1 ShortByteString
bytes forall a b. (a -> b) -> a -> b
$ do
      forall (proxy :: * -> *) h.
HashAlgorithm h =>
proxy h -> GetShort ()
skipHash ([] @ADDRHASH)
      Word8 -> GetShort StakeReference
getShortStakeReference Word8
header
    skipHash :: forall proxy h. Hash.HashAlgorithm h => proxy h -> GetShort ()
    skipHash :: forall (proxy :: * -> *) h.
HashAlgorithm h =>
proxy h -> GetShort ()
skipHash proxy h
p = Int -> GetShort ()
skip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash proxy h
p
    skip :: Int -> GetShort ()
    skip :: Int -> GetShort ()
skip Int
n = forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort forall a b. (a -> b) -> a -> b
$ \Int
i ShortByteString
sbs ->
      let offsetStop :: Int
offsetStop = Int
i forall a. Num a => a -> a -> a
+ Int
n
       in if Int
offsetStop forall a. Ord a => a -> a -> Bool
<= ShortByteString -> Int
SBS.length ShortByteString
sbs
            then forall a. a -> Maybe a
Just (Int
offsetStop, ())
            else forall a. Maybe a
Nothing
{-# INLINE decompactAddrOldLazy #-}