{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Ledger.CompactAddress
  ( compactAddr,
    decompactAddr,
    CompactAddr (..),
    substring,
    isPayCredScriptCompactAddr,
    isBootstrapCompactAddr,
    -- Faster Address deserialization
    decodeAddr,
    decodeAddrShort,
    decodeAddrEither,
    decodeAddrShortEither,
    fromCborAddr,
    fromCborBothAddr,
    fromCborCompactAddr,
    fromCborBackwardsBothAddr,
    decodeRewardAcnt,
    fromCborRewardAcnt,

    -- * Exported for benchmarking only
    fromCborCompactAddrOld,
    decompactAddrLazy,
  )
where

import Cardano.Binary
  ( Decoder,
    DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeFull',
  )
import qualified Cardano.Crypto.Hash.Class as Hash
import Cardano.Ledger.Address
  ( Addr (..),
    BootstrapAddress (..),
    RewardAcnt (..),
    Word7 (..),
    byron,
    getAddr,
    isEnterpriseAddr,
    notBaseAddr,
    payCredIsScript,
    serialiseAddr,
    stakeCredIsScript,
    toWord7,
    word7sToWord64,
  )
import Cardano.Ledger.BaseTypes (CertIx (..), Network (..), TxIx (..), word8ToNetwork)
import Cardano.Ledger.Credential
  ( Credential (KeyHashObj, ScriptHashObj),
    PaymentCredential,
    Ptr (..),
    StakeReference (..),
  )
import Cardano.Ledger.Crypto (ADDRHASH)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Hashes (ScriptHash (..))
import Cardano.Ledger.Keys (KeyHash (..))
import Cardano.Ledger.Slot (SlotNo (..))
import Cardano.Prelude (panic)
import Control.DeepSeq (NFData)
import Control.Monad (ap, guard, unless, when)
import qualified Control.Monad.Fail
import Control.Monad.Trans.State (StateT, evalStateT, get, modify', state)
import qualified Data.Binary.Get as B
import Data.Bits (Bits, clearBit, shiftL, testBit, (.&.), (.|.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.ByteString.Short as SBS (fromShort, index, length, toShort)
import Data.ByteString.Short.Internal as SBS (ShortByteString (SBS), unsafeIndex)
import qualified Data.ByteString.Unsafe as BS (unsafeDrop, unsafeIndex)
import Data.Coders (cborError)
import Data.Maybe (fromMaybe)
import qualified Data.Primitive.ByteArray as BA
import Data.Proxy (Proxy (..))
import Data.String (fromString)
import Data.Text (Text)
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Show (intToDigit)
import Numeric (showIntAtBase)

newtype CompactAddr crypto = UnsafeCompactAddr ShortByteString
  deriving (CompactAddr crypto -> CompactAddr crypto -> Bool
(CompactAddr crypto -> CompactAddr crypto -> Bool)
-> (CompactAddr crypto -> CompactAddr crypto -> Bool)
-> Eq (CompactAddr crypto)
forall crypto. CompactAddr crypto -> CompactAddr crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactAddr crypto -> CompactAddr crypto -> Bool
$c/= :: forall crypto. CompactAddr crypto -> CompactAddr crypto -> Bool
== :: CompactAddr crypto -> CompactAddr crypto -> Bool
$c== :: forall crypto. CompactAddr crypto -> CompactAddr crypto -> Bool
Eq, Eq (CompactAddr crypto)
Eq (CompactAddr crypto)
-> (CompactAddr crypto -> CompactAddr crypto -> Ordering)
-> (CompactAddr crypto -> CompactAddr crypto -> Bool)
-> (CompactAddr crypto -> CompactAddr crypto -> Bool)
-> (CompactAddr crypto -> CompactAddr crypto -> Bool)
-> (CompactAddr crypto -> CompactAddr crypto -> Bool)
-> (CompactAddr crypto -> CompactAddr crypto -> CompactAddr crypto)
-> (CompactAddr crypto -> CompactAddr crypto -> CompactAddr crypto)
-> Ord (CompactAddr crypto)
CompactAddr crypto -> CompactAddr crypto -> Bool
CompactAddr crypto -> CompactAddr crypto -> Ordering
CompactAddr crypto -> CompactAddr crypto -> CompactAddr crypto
forall crypto. Eq (CompactAddr crypto)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall crypto. CompactAddr crypto -> CompactAddr crypto -> Bool
forall crypto. CompactAddr crypto -> CompactAddr crypto -> Ordering
forall crypto.
CompactAddr crypto -> CompactAddr crypto -> CompactAddr crypto
min :: CompactAddr crypto -> CompactAddr crypto -> CompactAddr crypto
$cmin :: forall crypto.
CompactAddr crypto -> CompactAddr crypto -> CompactAddr crypto
max :: CompactAddr crypto -> CompactAddr crypto -> CompactAddr crypto
$cmax :: forall crypto.
CompactAddr crypto -> CompactAddr crypto -> CompactAddr crypto
>= :: CompactAddr crypto -> CompactAddr crypto -> Bool
$c>= :: forall crypto. CompactAddr crypto -> CompactAddr crypto -> Bool
> :: CompactAddr crypto -> CompactAddr crypto -> Bool
$c> :: forall crypto. CompactAddr crypto -> CompactAddr crypto -> Bool
<= :: CompactAddr crypto -> CompactAddr crypto -> Bool
$c<= :: forall crypto. CompactAddr crypto -> CompactAddr crypto -> Bool
< :: CompactAddr crypto -> CompactAddr crypto -> Bool
$c< :: forall crypto. CompactAddr crypto -> CompactAddr crypto -> Bool
compare :: CompactAddr crypto -> CompactAddr crypto -> Ordering
$ccompare :: forall crypto. CompactAddr crypto -> CompactAddr crypto -> Ordering
$cp1Ord :: forall crypto. Eq (CompactAddr crypto)
Ord, CompactAddr crypto -> ()
(CompactAddr crypto -> ()) -> NFData (CompactAddr crypto)
forall crypto. CompactAddr crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: CompactAddr crypto -> ()
$crnf :: forall crypto. CompactAddr crypto -> ()
NFData)

instance CC.Crypto c => Show (CompactAddr c) where
  show :: CompactAddr c -> String
show CompactAddr c
c = Addr c -> String
forall a. Show a => a -> String
show (CompactAddr c -> Addr c
forall crypto. Crypto crypto => CompactAddr crypto -> Addr crypto
decompactAddr CompactAddr c
c)

compactAddr :: Addr crypto -> CompactAddr crypto
compactAddr :: Addr crypto -> CompactAddr crypto
compactAddr = ShortByteString -> CompactAddr crypto
forall crypto. ShortByteString -> CompactAddr crypto
UnsafeCompactAddr (ShortByteString -> CompactAddr crypto)
-> (Addr crypto -> ShortByteString)
-> Addr crypto
-> CompactAddr crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (Addr crypto -> ByteString) -> Addr crypto -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr crypto -> ByteString
forall crypto. Addr crypto -> ByteString
serialiseAddr
{-# INLINE compactAddr #-}

decompactAddr :: forall crypto. CC.Crypto crypto => CompactAddr crypto -> Addr crypto
decompactAddr :: CompactAddr crypto -> Addr crypto
decompactAddr (UnsafeCompactAddr ShortByteString
sbs) =
  case ShortByteString -> Maybe (Addr crypto)
forall crypto (m :: * -> *).
(Crypto crypto, MonadFail m) =>
ShortByteString -> m (Addr crypto)
decodeAddrShort ShortByteString
sbs of
    Just Addr crypto
addr -> Addr crypto
addr
    Maybe (Addr crypto)
Nothing -> ShortByteString -> Addr crypto
forall crypto. Crypto crypto => ShortByteString -> Addr crypto
decompactAddrOld ShortByteString
sbs
{-# INLINE decompactAddr #-}

decompactAddrOld :: CC.Crypto crypto => ShortByteString -> Addr crypto
decompactAddrOld :: ShortByteString -> Addr crypto
decompactAddrOld ShortByteString
short = (Int, Addr crypto) -> Addr crypto
forall a b. (a, b) -> b
snd ((Int, Addr crypto) -> Addr crypto)
-> (Maybe (Int, Addr crypto) -> (Int, Addr crypto))
-> Maybe (Int, Addr crypto)
-> Addr crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Int, Addr crypto) -> (Int, Addr crypto)
forall a. Text -> Maybe a -> a
unwrap Text
"CompactAddr" (Maybe (Int, Addr crypto) -> Addr crypto)
-> Maybe (Int, Addr crypto) -> Addr crypto
forall a b. (a -> b) -> a -> b
$ GetShort (Addr crypto)
-> Int -> ShortByteString -> Maybe (Int, Addr crypto)
forall a. GetShort a -> Int -> ShortByteString -> Maybe (Int, a)
runGetShort GetShort (Addr crypto)
forall crypto. Crypto crypto => GetShort (Addr crypto)
getShortAddr Int
0 ShortByteString
short
  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 :: Text -> Maybe a -> a
unwrap Text
name = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Text -> a
forall a. HasCallStack => Text -> a
panic (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Text
"Impossible failure when decoding " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)
{-# NOINLINE decompactAddrOld #-}

------------------------------------------------------------------------------------------
-- Fast Address Serializer ---------------------------------------------------------------
------------------------------------------------------------------------------------------

fromCborAddr :: forall crypto s. CC.Crypto crypto => Decoder s (Addr crypto)
fromCborAddr :: Decoder s (Addr crypto)
fromCborAddr = do
  ShortByteString
sbs <- Decoder s ShortByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
  ShortByteString -> Decoder s (Addr crypto)
forall crypto (m :: * -> *).
(Crypto crypto, MonadFail m) =>
ShortByteString -> m (Addr crypto)
decodeAddrShort @crypto ShortByteString
sbs
{-# INLINE fromCborAddr #-}

fromCborBothAddr :: forall crypto s. CC.Crypto crypto => Decoder s (Addr crypto, CompactAddr crypto)
fromCborBothAddr :: Decoder s (Addr crypto, CompactAddr crypto)
fromCborBothAddr = do
  ShortByteString
sbs <- Decoder s ShortByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
  Addr crypto
addr <- ShortByteString -> Decoder s (Addr crypto)
forall crypto (m :: * -> *).
(Crypto crypto, MonadFail m) =>
ShortByteString -> m (Addr crypto)
decodeAddrShort @crypto ShortByteString
sbs
  (Addr crypto, CompactAddr crypto)
-> Decoder s (Addr crypto, CompactAddr crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Addr crypto
addr, ShortByteString -> CompactAddr crypto
forall crypto. ShortByteString -> CompactAddr crypto
UnsafeCompactAddr ShortByteString
sbs)
{-# INLINE fromCborBothAddr #-}

fromCborCompactAddr :: forall crypto s. CC.Crypto crypto => Decoder s (CompactAddr crypto)
fromCborCompactAddr :: Decoder s (CompactAddr crypto)
fromCborCompactAddr = do
  -- Ensure bytes can be decoded as Addr
  (Addr crypto
_addr, CompactAddr crypto
cAddr) <- Decoder s (Addr crypto, CompactAddr crypto)
forall crypto s.
Crypto crypto =>
Decoder s (Addr crypto, CompactAddr crypto)
fromCborBothAddr
  CompactAddr crypto -> Decoder s (CompactAddr crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompactAddr crypto
cAddr
{-# INLINE fromCborCompactAddr #-}

-- This is a fallback deserializer that preserves old behavior. It will almost never be
-- invoked, that is why it is not inlined.
fromCborAddrFallback :: CC.Crypto crypto => ShortByteString -> Decoder s (Addr crypto)
fromCborAddrFallback :: ShortByteString -> Decoder s (Addr crypto)
fromCborAddrFallback ShortByteString
sbs =
  case Get (Addr crypto)
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, Addr crypto)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
B.runGetOrFail Get (Addr crypto)
forall crypto. Crypto crypto => Get (Addr crypto)
getAddr (ByteString
 -> Either
      (ByteString, ByteOffset, String)
      (ByteString, ByteOffset, Addr crypto))
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, Addr crypto)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
SBS.fromShort ShortByteString
sbs of
    Right (ByteString
_remaining, ByteOffset
_offset, Addr crypto
value) -> Addr crypto -> Decoder s (Addr crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Addr crypto
value
    Left (ByteString
_remaining, ByteOffset
_offset, String
message) ->
      DecoderError -> Decoder s (Addr crypto)
forall e s a. Buildable e => e -> Decoder s a
cborError (Text -> Text -> DecoderError
DecoderErrorCustom Text
"Addr" (Text -> DecoderError) -> Text -> DecoderError
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
message)
{-# NOINLINE fromCborAddrFallback #-}

fromCborCompactAddrOld :: forall s crypto. CC.Crypto crypto => Decoder s (CompactAddr crypto)
fromCborCompactAddrOld :: Decoder s (CompactAddr crypto)
fromCborCompactAddrOld = do
  ShortByteString
sbs <- Decoder s ShortByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
  ShortByteString -> CompactAddr crypto
forall crypto. ShortByteString -> CompactAddr crypto
UnsafeCompactAddr ShortByteString
sbs CompactAddr crypto
-> Decoder s (Addr crypto) -> Decoder s (CompactAddr crypto)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ShortByteString -> Decoder s (Addr crypto)
forall crypto s.
Crypto crypto =>
ShortByteString -> Decoder s (Addr crypto)
fromCborAddrFallback @crypto ShortByteString
sbs
{-# INLINE fromCborCompactAddrOld #-}

fromCborBackwardsBothAddr ::
  forall crypto s.
  CC.Crypto crypto =>
  Decoder s (Addr crypto, CompactAddr crypto)
fromCborBackwardsBothAddr :: Decoder s (Addr crypto, CompactAddr crypto)
fromCborBackwardsBothAddr = do
  ShortByteString
sbs <- Decoder s ShortByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
  Addr crypto
addr <-
    case ShortByteString -> Either String (Addr crypto)
forall crypto.
Crypto crypto =>
ShortByteString -> Either String (Addr crypto)
decodeAddrShortEither @crypto ShortByteString
sbs of
      Right Addr crypto
a -> Addr crypto -> Decoder s (Addr crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Addr crypto
a
      Left String
_err -> ShortByteString -> Decoder s (Addr crypto)
forall crypto s.
Crypto crypto =>
ShortByteString -> Decoder s (Addr crypto)
fromCborAddrFallback ShortByteString
sbs
  (Addr crypto, CompactAddr crypto)
-> Decoder s (Addr crypto, CompactAddr crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Addr crypto
addr, ShortByteString -> CompactAddr crypto
forall crypto. ShortByteString -> CompactAddr crypto
UnsafeCompactAddr ShortByteString
sbs)
{-# INLINE fromCborBackwardsBothAddr #-}

class AddressBuffer b where
  bufLength :: b -> Int

  bufUnsafeIndex :: b -> Int -> Word8

  bufToByteString :: b -> BS.ByteString

  bufGetHash :: Hash.HashAlgorithm h => b -> Int -> Maybe (Hash.Hash h a)

instance AddressBuffer ShortByteString where
  bufLength :: ShortByteString -> Int
bufLength = ShortByteString -> Int
SBS.length
  {-# INLINE bufLength #-}
  bufUnsafeIndex :: ShortByteString -> Int -> Word8
bufUnsafeIndex = ShortByteString -> Int -> Word8
SBS.unsafeIndex
  {-# INLINE bufUnsafeIndex #-}
  bufToByteString :: ShortByteString -> ByteString
bufToByteString = ShortByteString -> ByteString
SBS.fromShort
  {-# INLINE bufToByteString #-}
  bufGetHash :: ShortByteString -> Int -> Maybe (Hash h a)
bufGetHash = ShortByteString -> Int -> Maybe (Hash h a)
forall h a.
HashAlgorithm h =>
ShortByteString -> Int -> Maybe (Hash h a)
Hash.hashFromOffsetBytesShort
  {-# INLINE bufGetHash #-}

instance AddressBuffer BS.ByteString where
  bufLength :: ByteString -> Int
bufLength = ByteString -> Int
BS.length
  {-# INLINE bufLength #-}
  bufUnsafeIndex :: ByteString -> Int -> Word8
bufUnsafeIndex = ByteString -> Int -> Word8
BS.unsafeIndex
  {-# INLINE bufUnsafeIndex #-}
  bufToByteString :: ByteString -> ByteString
bufToByteString = ByteString -> ByteString
forall a. a -> a
id
  {-# INLINE bufToByteString #-}
  bufGetHash :: ByteString -> Int -> Maybe (Hash h a)
bufGetHash ByteString
bs Int
offset = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
BS.length ByteString
bs)
    ByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes (Int -> ByteString -> ByteString
BS.unsafeDrop Int
offset ByteString
bs)
  {-# INLINE bufGetHash #-}

-- | Address header byte truth table:
newtype Header = Header Word8
  deriving (Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq, Eq Header
Eq Header
-> (Header -> Header -> Ordering)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Header)
-> (Header -> Header -> Header)
-> Ord Header
Header -> Header -> Bool
Header -> Header -> Ordering
Header -> Header -> Header
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Header -> Header -> Header
$cmin :: Header -> Header -> Header
max :: Header -> Header -> Header
$cmax :: Header -> Header -> Header
>= :: Header -> Header -> Bool
$c>= :: Header -> Header -> Bool
> :: Header -> Header -> Bool
$c> :: Header -> Header -> Bool
<= :: Header -> Header -> Bool
$c<= :: Header -> Header -> Bool
< :: Header -> Header -> Bool
$c< :: Header -> Header -> Bool
compare :: Header -> Header -> Ordering
$ccompare :: Header -> Header -> Ordering
$cp1Ord :: Eq Header
Ord, Eq Header
Header
Eq Header
-> (Header -> Header -> Header)
-> (Header -> Header -> Header)
-> (Header -> Header -> Header)
-> (Header -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> Header
-> (Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Bool)
-> (Header -> Maybe Int)
-> (Header -> Int)
-> (Header -> Bool)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int)
-> Bits Header
Int -> Header
Header -> Bool
Header -> Int
Header -> Maybe Int
Header -> Header
Header -> Int -> Bool
Header -> Int -> Header
Header -> Header -> Header
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Header -> Int
$cpopCount :: Header -> Int
rotateR :: Header -> Int -> Header
$crotateR :: Header -> Int -> Header
rotateL :: Header -> Int -> Header
$crotateL :: Header -> Int -> Header
unsafeShiftR :: Header -> Int -> Header
$cunsafeShiftR :: Header -> Int -> Header
shiftR :: Header -> Int -> Header
$cshiftR :: Header -> Int -> Header
unsafeShiftL :: Header -> Int -> Header
$cunsafeShiftL :: Header -> Int -> Header
shiftL :: Header -> Int -> Header
$cshiftL :: Header -> Int -> Header
isSigned :: Header -> Bool
$cisSigned :: Header -> Bool
bitSize :: Header -> Int
$cbitSize :: Header -> Int
bitSizeMaybe :: Header -> Maybe Int
$cbitSizeMaybe :: Header -> Maybe Int
testBit :: Header -> Int -> Bool
$ctestBit :: Header -> Int -> Bool
complementBit :: Header -> Int -> Header
$ccomplementBit :: Header -> Int -> Header
clearBit :: Header -> Int -> Header
$cclearBit :: Header -> Int -> Header
setBit :: Header -> Int -> Header
$csetBit :: Header -> Int -> Header
bit :: Int -> Header
$cbit :: Int -> Header
zeroBits :: Header
$czeroBits :: Header
rotate :: Header -> Int -> Header
$crotate :: Header -> Int -> Header
shift :: Header -> Int -> Header
$cshift :: Header -> Int -> Header
complement :: Header -> Header
$ccomplement :: Header -> Header
xor :: Header -> Header -> Header
$cxor :: Header -> Header -> Header
.|. :: Header -> Header -> Header
$c.|. :: Header -> Header -> Header
.&. :: Header -> Header -> Header
$c.&. :: Header -> Header -> Header
$cp1Bits :: Eq Header
Bits, Integer -> Header
Header -> Header
Header -> Header -> Header
(Header -> Header -> Header)
-> (Header -> Header -> Header)
-> (Header -> Header -> Header)
-> (Header -> Header)
-> (Header -> Header)
-> (Header -> Header)
-> (Integer -> Header)
-> Num Header
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Header
$cfromInteger :: Integer -> Header
signum :: Header -> Header
$csignum :: Header -> Header
abs :: Header -> Header
$cabs :: Header -> Header
negate :: Header -> Header
$cnegate :: Header -> Header
* :: Header -> Header -> Header
$c* :: Header -> Header -> Header
- :: Header -> Header -> Header
$c- :: Header -> Header -> Header
+ :: Header -> Header -> Header
$c+ :: Header -> Header -> Header
Num)

instance Show Header where
  show :: Header -> String
show (Header Word8
header) = (String
"0b" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> (Int -> Char) -> Word8 -> ShowS
forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase Word8
2 Int -> Char
intToDigit Word8
header ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
""

-- | Every Byron address starts with @[TkListLen 2]@, which encodes as 130 (or 0x80)
headerByron :: Header
headerByron :: Header
headerByron = Header
0b10000010 -- 0x80

isByronAddress :: Header -> Bool
isByronAddress :: Header -> Bool
isByronAddress = (Header -> Header -> Bool
forall a. Eq a => a -> a -> Bool
== Header
headerByron)
{-# INLINE isByronAddress #-}

headerNonShelleyBits :: Header
headerNonShelleyBits :: Header
headerNonShelleyBits = Header
headerByron Header -> Header -> Header
forall a. Bits a => a -> a -> a
.|. Header
0b00001100

headerNetworkId :: Header -> Network
headerNetworkId :: Header -> Network
headerNetworkId Header
header
  | Header
header Header -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
0 = Network
Mainnet
  | Bool
otherwise = Network
Testnet
{-# INLINE headerNetworkId #-}

headerIsPaymentScript :: Header -> Bool
headerIsPaymentScript :: Header -> Bool
headerIsPaymentScript = (Header -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
4)
{-# INLINE headerIsPaymentScript #-}

headerIsEnterpriseAddr :: Header -> Bool
headerIsEnterpriseAddr :: Header -> Bool
headerIsEnterpriseAddr = (Header -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
5)
{-# INLINE headerIsEnterpriseAddr #-}

headerIsStakingScript :: Header -> Bool
headerIsStakingScript :: Header -> Bool
headerIsStakingScript = (Header -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
5)
{-# INLINE headerIsStakingScript #-}

headerIsBaseAddress :: Header -> Bool
headerIsBaseAddress :: Header -> Bool
headerIsBaseAddress = Bool -> Bool
not (Bool -> Bool) -> (Header -> Bool) -> Header -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
6)
{-# INLINE headerIsBaseAddress #-}

newtype Fail a = Fail {Fail a -> Either String a
runFail :: Either String a}
  deriving (a -> Fail b -> Fail a
(a -> b) -> Fail a -> Fail b
(forall a b. (a -> b) -> Fail a -> Fail b)
-> (forall a b. a -> Fail b -> Fail a) -> Functor Fail
forall a b. a -> Fail b -> Fail a
forall a b. (a -> b) -> Fail a -> Fail b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Fail b -> Fail a
$c<$ :: forall a b. a -> Fail b -> Fail a
fmap :: (a -> b) -> Fail a -> Fail b
$cfmap :: forall a b. (a -> b) -> Fail a -> Fail b
Functor, Functor Fail
a -> Fail a
Functor Fail
-> (forall a. a -> Fail a)
-> (forall a b. Fail (a -> b) -> Fail a -> Fail b)
-> (forall a b c. (a -> b -> c) -> Fail a -> Fail b -> Fail c)
-> (forall a b. Fail a -> Fail b -> Fail b)
-> (forall a b. Fail a -> Fail b -> Fail a)
-> Applicative Fail
Fail a -> Fail b -> Fail b
Fail a -> Fail b -> Fail a
Fail (a -> b) -> Fail a -> Fail b
(a -> b -> c) -> Fail a -> Fail b -> Fail c
forall a. a -> Fail a
forall a b. Fail a -> Fail b -> Fail a
forall a b. Fail a -> Fail b -> Fail b
forall a b. Fail (a -> b) -> Fail a -> Fail b
forall a b c. (a -> b -> c) -> Fail a -> Fail b -> Fail c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Fail a -> Fail b -> Fail a
$c<* :: forall a b. Fail a -> Fail b -> Fail a
*> :: Fail a -> Fail b -> Fail b
$c*> :: forall a b. Fail a -> Fail b -> Fail b
liftA2 :: (a -> b -> c) -> Fail a -> Fail b -> Fail c
$cliftA2 :: forall a b c. (a -> b -> c) -> Fail a -> Fail b -> Fail c
<*> :: Fail (a -> b) -> Fail a -> Fail b
$c<*> :: forall a b. Fail (a -> b) -> Fail a -> Fail b
pure :: a -> Fail a
$cpure :: forall a. a -> Fail a
$cp1Applicative :: Functor Fail
Applicative, Applicative Fail
a -> Fail a
Applicative Fail
-> (forall a b. Fail a -> (a -> Fail b) -> Fail b)
-> (forall a b. Fail a -> Fail b -> Fail b)
-> (forall a. a -> Fail a)
-> Monad Fail
Fail a -> (a -> Fail b) -> Fail b
Fail a -> Fail b -> Fail b
forall a. a -> Fail a
forall a b. Fail a -> Fail b -> Fail b
forall a b. Fail a -> (a -> Fail b) -> Fail b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Fail a
$creturn :: forall a. a -> Fail a
>> :: Fail a -> Fail b -> Fail b
$c>> :: forall a b. Fail a -> Fail b -> Fail b
>>= :: Fail a -> (a -> Fail b) -> Fail b
$c>>= :: forall a b. Fail a -> (a -> Fail b) -> Fail b
$cp1Monad :: Applicative Fail
Monad)

instance MonadFail Fail where
  fail :: String -> Fail a
fail = Either String a -> Fail a
forall a. Either String a -> Fail a
Fail (Either String a -> Fail a)
-> (String -> Either String a) -> String -> Fail a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left

decodeAddrEither ::
  forall crypto.
  CC.Crypto crypto =>
  BS.ByteString ->
  Either String (Addr crypto)
decodeAddrEither :: ByteString -> Either String (Addr crypto)
decodeAddrEither ByteString
sbs = Fail (Addr crypto) -> Either String (Addr crypto)
forall a. Fail a -> Either String a
runFail (Fail (Addr crypto) -> Either String (Addr crypto))
-> Fail (Addr crypto) -> Either String (Addr crypto)
forall a b. (a -> b) -> a -> b
$ StateT Int Fail (Addr crypto) -> Int -> Fail (Addr crypto)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ByteString -> StateT Int Fail (Addr crypto)
forall crypto (m :: * -> *) b.
(Crypto crypto, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Addr crypto)
decodeAddrStateT ByteString
sbs) Int
0
{-# INLINE decodeAddrEither #-}

decodeAddrShortEither ::
  forall crypto.
  CC.Crypto crypto =>
  ShortByteString ->
  Either String (Addr crypto)
decodeAddrShortEither :: ShortByteString -> Either String (Addr crypto)
decodeAddrShortEither ShortByteString
sbs = Fail (Addr crypto) -> Either String (Addr crypto)
forall a. Fail a -> Either String a
runFail (Fail (Addr crypto) -> Either String (Addr crypto))
-> Fail (Addr crypto) -> Either String (Addr crypto)
forall a b. (a -> b) -> a -> b
$ StateT Int Fail (Addr crypto) -> Int -> Fail (Addr crypto)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ShortByteString -> StateT Int Fail (Addr crypto)
forall crypto (m :: * -> *) b.
(Crypto crypto, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Addr crypto)
decodeAddrStateT ShortByteString
sbs) Int
0
{-# INLINE decodeAddrShortEither #-}

decodeAddrShort ::
  forall crypto m.
  (CC.Crypto crypto, MonadFail m) =>
  ShortByteString ->
  m (Addr crypto)
decodeAddrShort :: ShortByteString -> m (Addr crypto)
decodeAddrShort ShortByteString
sbs = StateT Int m (Addr crypto) -> Int -> m (Addr crypto)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ShortByteString -> StateT Int m (Addr crypto)
forall crypto (m :: * -> *) b.
(Crypto crypto, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Addr crypto)
decodeAddrStateT ShortByteString
sbs) Int
0
{-# INLINE decodeAddrShort #-}

decodeAddr ::
  forall crypto m.
  (CC.Crypto crypto, MonadFail m) =>
  BS.ByteString ->
  m (Addr crypto)
decodeAddr :: ByteString -> m (Addr crypto)
decodeAddr ByteString
sbs = StateT Int m (Addr crypto) -> Int -> m (Addr crypto)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ByteString -> StateT Int m (Addr crypto)
forall crypto (m :: * -> *) b.
(Crypto crypto, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Addr crypto)
decodeAddrStateT ByteString
sbs) Int
0
{-# INLINE decodeAddr #-}

-- | While decoding an Addr the header (the first byte in the buffer) is
-- expected to be in a certain format. Here are the meaning of all the bits:
--
-- @@@
--
-- ┏━━━━━━━━━━━━━━━━┳━┯━┯━┯━┯━┯━┯━┯━┓
-- ┃  Byron Address ┃1┊0┊0┊0┊0┊0┊1┊0┃
-- ┣━━━━━━━━━━━━━━━━╋━┿━┿━┿━┿━┿━┿━┿━┫
-- ┃Shelley Address ┃0┊x┊x┊x┊0┊0┊0┊x┃
-- ┗━━━━━━━━━━━━━━━━╋━┿━┿━┿━┿━┿━┿━┿━╋━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
--                  ┃0┊0┊0┊0┊0┊0┊0┊0┃ Testnet PaymentKey    StakingKey    ┃
--                  ┃0┊0┊0┊0┊0┊0┊0┊1┃ Mainnet PaymentKey    StakingKey    ┃
--                  ┃0┊0┊0┊1┊0┊0┊0┊0┃ Testnet PaymentScript StakingKey    ┃
--                  ┃0┊0┊0┊1┊0┊0┊0┊1┃ Mainnet PaymentScript StakingKey    ┃
--                  ┃0┊0┊1┊0┊0┊0┊0┊0┃ Testnet PaymentKey    StakingScript ┃
--                  ┃0┊0┊1┊0┊0┊0┊0┊1┃ Mainnet PaymentKey    StakingScript ┃
--                  ┃0┊0┊1┊1┊0┊0┊0┊0┃ Testnet PaymentScript StakingScript ┃
--                  ┃0┊0┊1┊1┊0┊0┊0┊1┃ Mainnet PaymentScript StakingScript ┃
--                  ┃0┊1┊0┊0┊0┊0┊0┊0┃ Testnet PaymentKey    StakingPtr    ┃
--                  ┃0┊1┊0┊0┊0┊0┊0┊1┃ Mainnet PaymentKey    StakingPtr    ┃
--                  ┃0┊1┊0┊1┊0┊0┊0┊0┃ Testnet PaymentScript StakingPtr    ┃
--                  ┃0┊1┊0┊1┊0┊0┊0┊1┃ Mainnet PaymentScript StakingPtr    ┃
--                  ┃0┊1┊1┊0┊0┊0┊0┊0┃ Testnet PaymentKey    StakingNull   ┃
--                  ┃0┊1┊1┊0┊0┊0┊0┊1┃ Mainnet PaymentKey    StakingNull   ┃
--                  ┃0┊1┊1┊1┊0┊0┊0┊0┃ Testnet PaymentScript StakingNull   ┃
--                  ┃0┊1┊1┊1┊0┊0┊0┊1┃ Mainnet PaymentScript StakingNull   ┃
--                  ┗━┷━┷━┷━┷━┷━┷━┷━┻━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
--                      \ \ \       \
--                       \ \ \       `Is Mainnet Address
--                        \ \ `Payment Credential is a Script
--                         \ `Staking Credential is a Script / No Staking Credential
--                          `Not a Base Address
-- @@@
decodeAddrStateT ::
  (CC.Crypto crypto, MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m (Addr crypto)
decodeAddrStateT :: b -> StateT Int m (Addr crypto)
decodeAddrStateT b
buf = do
  String -> Int -> b -> StateT Int m ()
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> Int -> b -> StateT Int m ()
guardLength String
"Header" Int
1 b
buf
  let header :: Header
header = Word8 -> Header
Header (Word8 -> Header) -> Word8 -> Header
forall a b. (a -> b) -> a -> b
$ b -> Int -> Word8
forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
0
  Addr crypto
addr <-
    if Header -> Bool
isByronAddress Header
header
      then BootstrapAddress crypto -> Addr crypto
forall crypto. BootstrapAddress crypto -> Addr crypto
AddrBootstrap (BootstrapAddress crypto -> Addr crypto)
-> StateT Int m (BootstrapAddress crypto)
-> StateT Int m (Addr crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (BootstrapAddress crypto)
forall crypto (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m (BootstrapAddress crypto)
decodeBootstrapAddress b
buf
      else do
        -- Ensure there are no unexpected bytes in the header
        Bool -> StateT Int m () -> StateT Int m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Header
header Header -> Header -> Header
forall a. Bits a => a -> a -> a
.&. Header
headerNonShelleyBits Header -> Header -> Bool
forall a. Eq a => a -> a -> Bool
== Header
0) (StateT Int m () -> StateT Int m ())
-> StateT Int m () -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$
          String -> String -> StateT Int m ()
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding
            String
"Shelley Address"
            (String -> StateT Int m ()) -> String -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid header. Unused bits are not suppose to be set: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Header -> String
forall a. Show a => a -> String
show Header
header
        -- Advance one byte for the consumed header
        (Int -> Int) -> StateT Int m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        PaymentCredential crypto
payment <- Header -> b -> StateT Int m (PaymentCredential crypto)
forall crypto (m :: * -> *) b.
(Crypto crypto, MonadFail m, AddressBuffer b) =>
Header -> b -> StateT Int m (PaymentCredential crypto)
decodePaymentCredential Header
header b
buf
        StakeReference crypto
staking <- Header -> b -> StateT Int m (StakeReference crypto)
forall crypto (m :: * -> *) b.
(Crypto crypto, MonadFail m, AddressBuffer b) =>
Header -> b -> StateT Int m (StakeReference crypto)
decodeStakeReference Header
header b
buf
        Addr crypto -> StateT Int m (Addr crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Addr crypto -> StateT Int m (Addr crypto))
-> Addr crypto -> StateT Int m (Addr crypto)
forall a b. (a -> b) -> a -> b
$ Network
-> PaymentCredential crypto -> StakeReference crypto -> Addr crypto
forall crypto.
Network
-> PaymentCredential crypto -> StakeReference crypto -> Addr crypto
Addr (Header -> Network
headerNetworkId Header
header) PaymentCredential crypto
payment StakeReference crypto
staking
  Addr crypto
addr Addr crypto -> StateT Int m () -> StateT Int m (Addr crypto)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> b -> StateT Int m ()
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m ()
ensureBufIsConsumed String
"Addr" b
buf
{-# INLINE decodeAddrStateT #-}

-- | Checks that the current offset is exactly at the end of the buffer.
ensureBufIsConsumed ::
  forall m b.
  (MonadFail m, AddressBuffer b) =>
  -- | Name for error reporting
  String ->
  -- | Buffer that should have been consumed.
  b ->
  StateT Int m ()
ensureBufIsConsumed :: String -> b -> StateT Int m ()
ensureBufIsConsumed String
name b
buf = do
  Int
lastOffset <- StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let len :: Int
len = b -> Int
forall b. AddressBuffer b => b -> Int
bufLength b
buf
  Bool -> StateT Int m () -> StateT Int m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
lastOffset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len) (StateT Int m () -> StateT Int m ())
-> StateT Int m () -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$
    String -> String -> StateT Int m ()
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name (String -> StateT Int m ()) -> String -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$ String
"Left over bytes: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lastOffset)
{-# INLINE ensureBufIsConsumed #-}

-- | This decoder assumes the whole `ShortByteString` is occupied by the `BootstrapAddress`
decodeBootstrapAddress ::
  forall crypto m b.
  (MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m (BootstrapAddress crypto)
decodeBootstrapAddress :: b -> StateT Int m (BootstrapAddress crypto)
decodeBootstrapAddress b
buf =
  case ByteString -> Either DecoderError Address
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull' (ByteString -> Either DecoderError Address)
-> ByteString -> Either DecoderError Address
forall a b. (a -> b) -> a -> b
$ b -> ByteString
forall b. AddressBuffer b => b -> ByteString
bufToByteString b
buf of
    Left DecoderError
e -> String -> StateT Int m (BootstrapAddress crypto)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> StateT Int m (BootstrapAddress crypto))
-> String -> StateT Int m (BootstrapAddress crypto)
forall a b. (a -> b) -> a -> b
$ DecoderError -> String
forall a. Show a => a -> String
show DecoderError
e
    Right Address
addr -> Address -> BootstrapAddress crypto
forall crypto. Address -> BootstrapAddress crypto
BootstrapAddress Address
addr BootstrapAddress crypto
-> StateT Int m () -> StateT Int m (BootstrapAddress crypto)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Int -> Int) -> StateT Int m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall b. AddressBuffer b => b -> Int
bufLength b
buf)
{-# INLINE decodeBootstrapAddress #-}

decodePaymentCredential ::
  (CC.Crypto crypto, MonadFail m, AddressBuffer b) =>
  Header ->
  b ->
  StateT Int m (PaymentCredential crypto)
decodePaymentCredential :: Header -> b -> StateT Int m (PaymentCredential crypto)
decodePaymentCredential Header
header b
buf
  | Header -> Bool
headerIsPaymentScript Header
header = ScriptHash crypto -> PaymentCredential crypto
forall (kr :: KeyRole) crypto.
ScriptHash crypto -> Credential kr crypto
ScriptHashObj (ScriptHash crypto -> PaymentCredential crypto)
-> StateT Int m (ScriptHash crypto)
-> StateT Int m (PaymentCredential crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (ScriptHash crypto)
forall crypto (m :: * -> *) b.
(Crypto crypto, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (ScriptHash crypto)
decodeScriptHash b
buf
  | Bool
otherwise = KeyHash 'Payment crypto -> PaymentCredential crypto
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
KeyHashObj (KeyHash 'Payment crypto -> PaymentCredential crypto)
-> StateT Int m (KeyHash 'Payment crypto)
-> StateT Int m (PaymentCredential crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (KeyHash 'Payment crypto)
forall crypto (m :: * -> *) b (kr :: KeyRole).
(Crypto crypto, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr crypto)
decodeKeyHash b
buf
{-# INLINE decodePaymentCredential #-}

decodeStakeReference ::
  (CC.Crypto crypto, MonadFail m, AddressBuffer b) =>
  Header ->
  b ->
  StateT Int m (StakeReference crypto)
decodeStakeReference :: Header -> b -> StateT Int m (StakeReference crypto)
decodeStakeReference Header
header b
buf
  | Header -> Bool
headerIsBaseAddress Header
header =
      if Header -> Bool
headerIsStakingScript Header
header
        then StakeCredential crypto -> StakeReference crypto
forall crypto. StakeCredential crypto -> StakeReference crypto
StakeRefBase (StakeCredential crypto -> StakeReference crypto)
-> (ScriptHash crypto -> StakeCredential crypto)
-> ScriptHash crypto
-> StakeReference crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash crypto -> StakeCredential crypto
forall (kr :: KeyRole) crypto.
ScriptHash crypto -> Credential kr crypto
ScriptHashObj (ScriptHash crypto -> StakeReference crypto)
-> StateT Int m (ScriptHash crypto)
-> StateT Int m (StakeReference crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (ScriptHash crypto)
forall crypto (m :: * -> *) b.
(Crypto crypto, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (ScriptHash crypto)
decodeScriptHash b
buf
        else StakeCredential crypto -> StakeReference crypto
forall crypto. StakeCredential crypto -> StakeReference crypto
StakeRefBase (StakeCredential crypto -> StakeReference crypto)
-> (KeyHash 'Staking crypto -> StakeCredential crypto)
-> KeyHash 'Staking crypto
-> StakeReference crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Staking crypto -> StakeCredential crypto
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
KeyHashObj (KeyHash 'Staking crypto -> StakeReference crypto)
-> StateT Int m (KeyHash 'Staking crypto)
-> StateT Int m (StakeReference crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (KeyHash 'Staking crypto)
forall crypto (m :: * -> *) b (kr :: KeyRole).
(Crypto crypto, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr crypto)
decodeKeyHash b
buf
  | Bool
otherwise =
      if Header -> Bool
headerIsEnterpriseAddr Header
header
        then StakeReference crypto -> StateT Int m (StakeReference crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeReference crypto
forall crypto. StakeReference crypto
StakeRefNull
        else Ptr -> StakeReference crypto
forall crypto. Ptr -> StakeReference crypto
StakeRefPtr (Ptr -> StakeReference crypto)
-> StateT Int m Ptr -> StateT Int m (StakeReference crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m Ptr
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Ptr
decodePtr b
buf
{-# INLINE decodeStakeReference #-}

decodeKeyHash ::
  (CC.Crypto crypto, MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m (KeyHash kr crypto)
decodeKeyHash :: b -> StateT Int m (KeyHash kr crypto)
decodeKeyHash b
buf = Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> KeyHash kr crypto
forall (discriminator :: KeyRole) crypto.
Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> KeyHash discriminator crypto
KeyHash (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
 -> KeyHash kr crypto)
-> StateT
     Int m (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)))
-> StateT Int m (KeyHash kr crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b
-> StateT
     Int m (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)))
forall a h (m :: * -> *) b.
(HashAlgorithm h, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Hash h a)
decodeHash b
buf
{-# INLINE decodeKeyHash #-}

decodeScriptHash ::
  (CC.Crypto crypto, MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m (ScriptHash crypto)
decodeScriptHash :: b -> StateT Int m (ScriptHash crypto)
decodeScriptHash b
buf = Hash (ADDRHASH crypto) EraIndependentScript -> ScriptHash crypto
forall crypto.
Hash (ADDRHASH crypto) EraIndependentScript -> ScriptHash crypto
ScriptHash (Hash (ADDRHASH crypto) EraIndependentScript -> ScriptHash crypto)
-> StateT Int m (Hash (ADDRHASH crypto) EraIndependentScript)
-> StateT Int m (ScriptHash crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (Hash (ADDRHASH crypto) EraIndependentScript)
forall a h (m :: * -> *) b.
(HashAlgorithm h, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Hash h a)
decodeHash b
buf
{-# INLINE decodeScriptHash #-}

decodeHash ::
  forall a h m b.
  (Hash.HashAlgorithm h, MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m (Hash.Hash h a)
decodeHash :: b -> StateT Int m (Hash h a)
decodeHash b
buf = do
  Int
offset <- StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
  case b -> Int -> Maybe (Hash h a)
forall b h a.
(AddressBuffer b, HashAlgorithm h) =>
b -> Int -> Maybe (Hash h a)
bufGetHash b
buf Int
offset of
    Just Hash h a
h -> Hash h a
h Hash h a -> StateT Int m () -> StateT Int m (Hash h a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Int -> Int) -> StateT Int m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hashLen)
    Maybe (Hash h a)
Nothing
      | Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 ->
          String -> String -> StateT Int m (Hash h a)
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
"Hash" (String -> StateT Int m (Hash h a))
-> String -> StateT Int m (Hash h a)
forall a b. (a -> b) -> a -> b
$
            String
"Not enough bytes supplied: "
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (b -> Int
forall b. AddressBuffer b => b -> Int
bufLength b
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset)
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Expected: "
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
hashLen
    Maybe (Hash h a)
Nothing -> String -> StateT Int m (Hash h a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Impossible: Negative offset"
  where
    hashLen :: Int
    hashLen :: Int
hashLen = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h))
{-# INLINE decodeHash #-}

decodePtr ::
  (MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m Ptr
decodePtr :: b -> StateT Int m Ptr
decodePtr b
buf =
  SlotNo -> TxIx -> CertIx -> Ptr
Ptr
    (SlotNo -> TxIx -> CertIx -> Ptr)
-> StateT Int m SlotNo -> StateT Int m (TxIx -> CertIx -> Ptr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> (Word32 -> Word64) -> Word32 -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Word64) (Word32 -> SlotNo) -> StateT Int m Word32 -> StateT Int m SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> b -> StateT Int m Word32
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word32
decodeVariableLengthWord32 String
"SlotNo" b
buf)
    StateT Int m (TxIx -> CertIx -> Ptr)
-> StateT Int m TxIx -> StateT Int m (CertIx -> Ptr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> TxIx
TxIx (Word64 -> TxIx) -> (Word16 -> Word64) -> Word16 -> TxIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Word64) (Word16 -> TxIx) -> StateT Int m Word16 -> StateT Int m TxIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> b -> StateT Int m Word16
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word16
decodeVariableLengthWord16 String
"TxIx" b
buf)
    StateT Int m (CertIx -> Ptr)
-> StateT Int m CertIx -> StateT Int m Ptr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> CertIx
CertIx (Word64 -> CertIx) -> (Word16 -> Word64) -> Word16 -> CertIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Word64) (Word16 -> CertIx) -> StateT Int m Word16 -> StateT Int m CertIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> b -> StateT Int m Word16
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word16
decodeVariableLengthWord16 String
"CertIx" b
buf)
{-# INLINE decodePtr #-}

guardLength ::
  (MonadFail m, AddressBuffer b) =>
  -- | Name for what is being decoded for the error message
  String ->
  Int ->
  b ->
  StateT Int m ()
guardLength :: String -> Int -> b -> StateT Int m ()
guardLength String
name Int
expectedLength b
buf = do
  Int
offset <- StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
  Bool -> StateT Int m () -> StateT Int m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> b -> Int
forall b. AddressBuffer b => b -> Int
bufLength b
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
expectedLength) (StateT Int m () -> StateT Int m ())
-> StateT Int m () -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$
    String -> String -> StateT Int m ()
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name String
"Not enough bytes for decoding"
{-# INLINE guardLength #-}

-- | Decode a variable length integral value that is encoded with 7 bits of data
-- and the most significant bit (MSB), the 8th bit is set whenever there are
-- more bits following. Continuation style allows us to avoid
-- rucursion. Removing loops is good for performance.
decode7BitVarLength ::
  (Num a, Bits a, AddressBuffer b, MonadFail m) =>
  -- | Name of what is being decoded for error reporting
  String ->
  -- | Buffer that contains encoded number
  b ->
  -- | Continuation that will be invoked if MSB is set
  (a -> StateT Int m a) ->
  -- | Accumulator
  a ->
  StateT Int m a
decode7BitVarLength :: String -> b -> (a -> StateT Int m a) -> a -> StateT Int m a
decode7BitVarLength String
name b
buf a -> StateT Int m a
cont !a
acc = do
  String -> Int -> b -> StateT Int m ()
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> Int -> b -> StateT Int m ()
guardLength String
name Int
1 b
buf
  Int
offset <- (Int -> (Int, Int)) -> StateT Int m Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (\Int
off -> (Int
off, Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  let b8 :: Word8
b8 = b -> Int -> Word8
forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
offset
  if Word8
b8 Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7
    then a -> StateT Int m a
cont (a
acc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
7 a -> a -> a
forall a. Bits a => a -> a -> a
.|. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b8 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Int
7))
    else a -> StateT Int m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
acc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
7 a -> a -> a
forall a. Bits a => a -> a -> a
.|. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b8)
{-# INLINE decode7BitVarLength #-}

failDecoding :: MonadFail m => String -> String -> m a
failDecoding :: String -> String -> m a
failDecoding String
name String
msg = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Decoding " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
{-# NOINLINE failDecoding #-}

decodeVariableLengthWord16 ::
  forall m b.
  (MonadFail m, AddressBuffer b) =>
  String ->
  b ->
  StateT Int m Word16
decodeVariableLengthWord16 :: String -> b -> StateT Int m Word16
decodeVariableLengthWord16 String
name b
buf = do
  Int
off0 <- StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let d7 :: (Word16 -> StateT Int m Word16) -> Word16 -> StateT Int m Word16
d7 = String
-> b
-> (Word16 -> StateT Int m Word16)
-> Word16
-> StateT Int m Word16
forall a b (m :: * -> *).
(Num a, Bits a, AddressBuffer b, MonadFail m) =>
String -> b -> (a -> StateT Int m a) -> a -> StateT Int m a
decode7BitVarLength String
name b
buf
      d7last :: Word16 -> StateT Int m Word16
      d7last :: Word16 -> StateT Int m Word16
d7last Word16
acc = do
        Word16
res <- String
-> b
-> (Word16 -> StateT Int m Word16)
-> Word16
-> StateT Int m Word16
forall a b (m :: * -> *).
(Num a, Bits a, AddressBuffer b, MonadFail m) =>
String -> b -> (a -> StateT Int m a) -> a -> StateT Int m a
decode7BitVarLength String
name b
buf (\Word16
_ -> String -> String -> StateT Int m Word16
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name String
"too many bytes.") Word16
acc
        -- Only while decoding the last 7bits we check if there was too many
        -- bits supplied at the beginning.
        Bool -> StateT Int m () -> StateT Int m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (b -> Int -> Word8
forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
off0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b01111100 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (StateT Int m () -> StateT Int m ())
-> StateT Int m () -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$
          String -> String -> StateT Int m ()
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name String
"More than 16bits was supplied"
        Word16 -> StateT Int m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
res
  (Word16 -> StateT Int m Word16) -> Word16 -> StateT Int m Word16
d7 ((Word16 -> StateT Int m Word16) -> Word16 -> StateT Int m Word16
d7 Word16 -> StateT Int m Word16
d7last) Word16
0
{-# INLINE decodeVariableLengthWord16 #-}

decodeVariableLengthWord32 ::
  forall m b.
  (MonadFail m, AddressBuffer b) =>
  String ->
  b ->
  StateT Int m Word32
decodeVariableLengthWord32 :: String -> b -> StateT Int m Word32
decodeVariableLengthWord32 String
name b
buf = do
  Int
off0 <- StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let d7 :: (Word32 -> StateT Int m Word32) -> Word32 -> StateT Int m Word32
d7 = String
-> b
-> (Word32 -> StateT Int m Word32)
-> Word32
-> StateT Int m Word32
forall a b (m :: * -> *).
(Num a, Bits a, AddressBuffer b, MonadFail m) =>
String -> b -> (a -> StateT Int m a) -> a -> StateT Int m a
decode7BitVarLength String
name b
buf
      d7last :: Word32 -> StateT Int m Word32
      d7last :: Word32 -> StateT Int m Word32
d7last Word32
acc = do
        Word32
res <- String
-> b
-> (Word32 -> StateT Int m Word32)
-> Word32
-> StateT Int m Word32
forall a b (m :: * -> *).
(Num a, Bits a, AddressBuffer b, MonadFail m) =>
String -> b -> (a -> StateT Int m a) -> a -> StateT Int m a
decode7BitVarLength String
name b
buf (\Word32
_ -> String -> String -> StateT Int m Word32
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name String
"too many bytes.") Word32
acc
        -- Only while decoding the last 7bits we check if there was too many
        -- bits supplied at the beginning.
        Bool -> StateT Int m () -> StateT Int m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (b -> Int -> Word8
forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
off0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b01110000 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (StateT Int m () -> StateT Int m ())
-> StateT Int m () -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$
          String -> String -> StateT Int m ()
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name String
"More than 32bits was supplied"
        Word32 -> StateT Int m Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
res
  (Word32 -> StateT Int m Word32) -> Word32 -> StateT Int m Word32
d7 ((Word32 -> StateT Int m Word32) -> Word32 -> StateT Int m Word32
d7 ((Word32 -> StateT Int m Word32) -> Word32 -> StateT Int m Word32
d7 ((Word32 -> StateT Int m Word32) -> Word32 -> StateT Int m Word32
d7 Word32 -> StateT Int m Word32
d7last))) Word32
0
{-# INLINE decodeVariableLengthWord32 #-}

------------------------------------------------------------------------------------------
-- Reward Account Deserializer -----------------------------------------------------------
------------------------------------------------------------------------------------------

decodeRewardAcnt ::
  forall crypto b m.
  (CC.Crypto crypto, AddressBuffer b, MonadFail m) =>
  b ->
  m (RewardAcnt crypto)
decodeRewardAcnt :: b -> m (RewardAcnt crypto)
decodeRewardAcnt b
buf = StateT Int m (RewardAcnt crypto) -> Int -> m (RewardAcnt crypto)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (b -> StateT Int m (RewardAcnt crypto)
forall (m :: * -> *) crypto b.
(MonadFail m, Crypto crypto, AddressBuffer b) =>
b -> StateT Int m (RewardAcnt crypto)
decodeRewardAccountT b
buf) Int
0
{-# INLINE decodeRewardAcnt #-}

fromCborRewardAcnt :: forall crypto s. CC.Crypto crypto => Decoder s (RewardAcnt crypto)
fromCborRewardAcnt :: Decoder s (RewardAcnt crypto)
fromCborRewardAcnt = do
  ShortByteString
sbs :: ShortByteString <- Decoder s ShortByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
  ShortByteString -> Decoder s (RewardAcnt crypto)
forall crypto b (m :: * -> *).
(Crypto crypto, AddressBuffer b, MonadFail m) =>
b -> m (RewardAcnt crypto)
decodeRewardAcnt @crypto ShortByteString
sbs
{-# INLINE fromCborRewardAcnt #-}

headerIsRewardAccount :: Header -> Bool
headerIsRewardAccount :: Header -> Bool
headerIsRewardAccount Header
header = Header
header Header -> Header -> Header
forall a. Bits a => a -> a -> a
.&. Header
0b11101110 Header -> Header -> Bool
forall a. Eq a => a -> a -> Bool
== Header
0b11100000
{-# INLINE headerIsRewardAccount #-}

headerRewardAccountIsScript :: Header -> Bool
headerRewardAccountIsScript :: Header -> Bool
headerRewardAccountIsScript = (Header -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
4)
{-# INLINE headerRewardAccountIsScript #-}

-- | Reward Account Header.
--
-- @@@
--
-- ┏━━━━━━━━━━━━━━━━┳━┯━┯━┯━┯━┯━┯━┯━┓
-- ┃ Reward Account ┃1┊1┊1┊x┊0┊0┊0┊x┃
-- ┗━━━━━━━━━━━━━━━━╋━┿━┿━┿━┿━┿━┿━┿━╋━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
--                  ┃1┊1┊1┊0┊0┊0┊0┊0┃ Testnet PaymentKey    StakingKey    ┃
--                  ┃1┊1┊1┊0┊0┊0┊0┊1┃ Mainnet PaymentKey    StakingKey    ┃
--                  ┃1┊1┊1┊1┊0┊0┊0┊0┃ Testnet PaymentScript StakingKey    ┃
--                  ┃1┊1┊1┊1┊0┊0┊0┊1┃ Mainnet PaymentScript StakingKey    ┃
--                  ┗━┷━┷━┷━┷━┷━┷━┷━┻━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
--                          \       \
--                           \       `Is Mainnet Address
--                            `Account Credential is a Script
-- @@@
decodeRewardAccountT ::
  (MonadFail m, CC.Crypto crypto, AddressBuffer b) =>
  b ->
  StateT Int m (RewardAcnt crypto)
decodeRewardAccountT :: b -> StateT Int m (RewardAcnt crypto)
decodeRewardAccountT b
buf = do
  String -> Int -> b -> StateT Int m ()
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> Int -> b -> StateT Int m ()
guardLength String
"Header" Int
1 b
buf
  (Int -> Int) -> StateT Int m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  let header :: Header
header = Word8 -> Header
Header (Word8 -> Header) -> Word8 -> Header
forall a b. (a -> b) -> a -> b
$ b -> Int -> Word8
forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
0
  Bool -> StateT Int m () -> StateT Int m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Header -> Bool
headerIsRewardAccount Header
header) (StateT Int m () -> StateT Int m ())
-> StateT Int m () -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$
    String -> StateT Int m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> StateT Int m ()) -> String -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid header for the reward account: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Header -> String
forall a. Show a => a -> String
show Header
header
  Credential 'Staking crypto
account <-
    if Header -> Bool
headerRewardAccountIsScript Header
header
      then ScriptHash crypto -> Credential 'Staking crypto
forall (kr :: KeyRole) crypto.
ScriptHash crypto -> Credential kr crypto
ScriptHashObj (ScriptHash crypto -> Credential 'Staking crypto)
-> StateT Int m (ScriptHash crypto)
-> StateT Int m (Credential 'Staking crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (ScriptHash crypto)
forall crypto (m :: * -> *) b.
(Crypto crypto, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (ScriptHash crypto)
decodeScriptHash b
buf
      else KeyHash 'Staking crypto -> Credential 'Staking crypto
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
KeyHashObj (KeyHash 'Staking crypto -> Credential 'Staking crypto)
-> StateT Int m (KeyHash 'Staking crypto)
-> StateT Int m (Credential 'Staking crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (KeyHash 'Staking crypto)
forall crypto (m :: * -> *) b (kr :: KeyRole).
(Crypto crypto, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr crypto)
decodeKeyHash b
buf
  String -> b -> StateT Int m ()
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m ()
ensureBufIsConsumed String
"RewardsAcnt" b
buf
  RewardAcnt crypto -> StateT Int m (RewardAcnt crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RewardAcnt crypto -> StateT Int m (RewardAcnt crypto))
-> RewardAcnt crypto -> StateT Int m (RewardAcnt crypto)
forall a b. (a -> b) -> a -> b
$! Network -> Credential 'Staking crypto -> RewardAcnt crypto
forall crypto.
Network -> Credential 'Staking crypto -> RewardAcnt crypto
RewardAcnt (Header -> Network
headerNetworkId Header
header) Credential 'Staking crypto
account
{-# INLINE decodeRewardAccountT #-}

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

-- | This lazy deserializer is kept around purely for benchmarking, so we can
-- verify that new deserializer `decodeAddrStateT` is doing the work lazily.
decompactAddrLazy :: forall crypto. CC.Crypto crypto => CompactAddr crypto -> Addr crypto
decompactAddrLazy :: CompactAddr crypto -> Addr crypto
decompactAddrLazy (UnsafeCompactAddr ShortByteString
bytes) =
  if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
byron
    then BootstrapAddress crypto -> Addr crypto
forall crypto. BootstrapAddress crypto -> Addr crypto
AddrBootstrap (BootstrapAddress crypto -> Addr crypto)
-> BootstrapAddress crypto -> Addr crypto
forall a b. (a -> b) -> a -> b
$ Text
-> Int
-> ShortByteString
-> GetShort (BootstrapAddress crypto)
-> BootstrapAddress crypto
forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
"byron address" Int
0 ShortByteString
bytes GetShort (BootstrapAddress crypto)
forall crypto. GetShort (BootstrapAddress crypto)
getBootstrapAddress
    else Network
-> PaymentCredential crypto -> StakeReference crypto -> Addr crypto
forall crypto.
Network
-> PaymentCredential crypto -> StakeReference crypto -> Addr crypto
Addr Network
addrNetId PaymentCredential crypto
paycred StakeReference crypto
stakecred
  where
    run :: forall a. Text -> Int -> ShortByteString -> GetShort a -> a
    run :: Text -> Int -> ShortByteString -> GetShort a -> a
run Text
name Int
i ShortByteString
sbs GetShort a
g = (Int, a) -> a
forall a b. (a, b) -> b
snd ((Int, a) -> a)
-> (Maybe (Int, a) -> (Int, a)) -> Maybe (Int, a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Int, a) -> (Int, a)
forall a. Text -> Maybe a -> a
unwrap Text
name (Maybe (Int, a) -> a) -> Maybe (Int, a) -> a
forall a b. (a -> b) -> a -> b
$ GetShort a -> Int -> ShortByteString -> Maybe (Int, a)
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 :: Text -> Maybe a -> a
unwrap Text
name = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Text -> a
forall a. HasCallStack => Text -> a
panic (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Text
"Impossible failure when decoding " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)
    header :: Word8
header = Text -> Int -> ShortByteString -> GetShort Word8 -> Word8
forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
"address header" Int
0 ShortByteString
bytes GetShort Word8
getWord
    addrNetId :: Network
addrNetId =
      Text -> Maybe Network -> Network
forall a. Text -> Maybe a -> a
unwrap Text
"address network id" (Maybe Network -> Network) -> Maybe Network -> Network
forall a b. (a -> b) -> a -> b
$
        Word8 -> Maybe Network
word8ToNetwork (Word8 -> Maybe Network) -> Word8 -> Maybe Network
forall a b. (a -> b) -> a -> b
$ Word8
header Word8 -> Word8 -> Word8
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 crypto
paycred = Text
-> Int
-> ShortByteString
-> GetShort (PaymentCredential crypto)
-> PaymentCredential crypto
forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
"payment credential" Int
1 ShortByteString
bytes (Word8 -> GetShort (PaymentCredential crypto)
forall crypto.
Crypto crypto =>
Word8 -> GetShort (PaymentCredential crypto)
getPayCred Word8
header)
    stakecred :: StakeReference crypto
stakecred = Text
-> Int
-> ShortByteString
-> GetShort (StakeReference crypto)
-> StakeReference crypto
forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
"staking credential" Int
1 ShortByteString
bytes (GetShort (StakeReference crypto) -> StakeReference crypto)
-> GetShort (StakeReference crypto) -> StakeReference crypto
forall a b. (a -> b) -> a -> b
$ do
      [ADDRHASH crypto] -> GetShort ()
forall (proxy :: * -> *) h.
HashAlgorithm h =>
proxy h -> GetShort ()
skipHash ([] @(ADDRHASH crypto))
      Word8 -> GetShort (StakeReference crypto)
forall crypto.
Crypto crypto =>
Word8 -> GetShort (StakeReference crypto)
getStakeReference Word8
header
    skipHash :: forall proxy h. Hash.HashAlgorithm h => proxy h -> GetShort ()
    skipHash :: proxy h -> GetShort ()
skipHash proxy h
p = Int -> GetShort ()
skip (Int -> GetShort ()) -> (Word -> Int) -> Word -> GetShort ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> GetShort ()) -> Word -> GetShort ()
forall a b. (a -> b) -> a -> b
$ proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash proxy h
p
    skip :: Int -> GetShort ()
    skip :: Int -> GetShort ()
skip Int
n = (Int -> ShortByteString -> Maybe (Int, ())) -> GetShort ()
forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort ((Int -> ShortByteString -> Maybe (Int, ())) -> GetShort ())
-> (Int -> ShortByteString -> Maybe (Int, ())) -> GetShort ()
forall a b. (a -> b) -> a -> b
$ \Int
i ShortByteString
sbs ->
      let offsetStop :: Int
offsetStop = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
       in if Int
offsetStop Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ShortByteString -> Int
SBS.length ShortByteString
sbs
            then (Int, ()) -> Maybe (Int, ())
forall a. a -> Maybe a
Just (Int
offsetStop, ())
            else Maybe (Int, ())
forall a. Maybe a
Nothing

instance CC.Crypto crypto => ToCBOR (CompactAddr crypto) where
  toCBOR :: CompactAddr crypto -> Encoding
toCBOR (UnsafeCompactAddr ShortByteString
bytes) = ShortByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ShortByteString
bytes

instance CC.Crypto crypto => FromCBOR (CompactAddr crypto) where
  fromCBOR :: Decoder s (CompactAddr crypto)
fromCBOR = do
    (Addr crypto
_addr, CompactAddr crypto
cAddr) <- Decoder s (Addr crypto, CompactAddr crypto)
forall crypto s.
Crypto crypto =>
Decoder s (Addr crypto, CompactAddr crypto)
fromCborBackwardsBothAddr
    CompactAddr crypto -> Decoder s (CompactAddr crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompactAddr crypto
cAddr
  {-# INLINE fromCBOR #-}

newtype GetShort a = GetShort {GetShort a -> Int -> ShortByteString -> Maybe (Int, a)
runGetShort :: Int -> ShortByteString -> Maybe (Int, a)}
  deriving (a -> GetShort b -> GetShort a
(a -> b) -> GetShort a -> GetShort b
(forall a b. (a -> b) -> GetShort a -> GetShort b)
-> (forall a b. a -> GetShort b -> GetShort a) -> Functor GetShort
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
<$ :: a -> GetShort b -> GetShort a
$c<$ :: forall a b. a -> GetShort b -> GetShort a
fmap :: (a -> b) -> GetShort a -> GetShort b
$cfmap :: forall a b. (a -> b) -> GetShort a -> GetShort b
Functor)

instance Applicative GetShort where
  pure :: a -> GetShort a
pure a
a = (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort ((Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a)
-> (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
forall a b. (a -> b) -> a -> b
$ \Int
i ShortByteString
_sbs -> (Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
i, a
a)
  <*> :: GetShort (a -> b) -> GetShort a -> GetShort 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) >>= :: GetShort a -> (a -> GetShort b) -> GetShort b
>>= a -> GetShort b
f = (Int -> ShortByteString -> Maybe (Int, b)) -> GetShort b
forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort ((Int -> ShortByteString -> Maybe (Int, b)) -> GetShort b)
-> (Int -> ShortByteString -> Maybe (Int, b)) -> GetShort b
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 -> Maybe (Int, b)
forall a. Maybe a
Nothing
      Just (Int
i', a
x) -> GetShort b -> Int -> ShortByteString -> Maybe (Int, b)
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 :: String -> GetShort a
fail String
_ = (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort ((Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a)
-> (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
forall a b. (a -> b) -> a -> b
$ \Int
_ ShortByteString
_ -> Maybe (Int, a)
forall a. Maybe a
Nothing

getShortAddr :: CC.Crypto crypto => GetShort (Addr crypto)
getShortAddr :: GetShort (Addr crypto)
getShortAddr = do
  Word8
header <- GetShort Word8
peekWord8
  if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
byron
    then BootstrapAddress crypto -> Addr crypto
forall crypto. BootstrapAddress crypto -> Addr crypto
AddrBootstrap (BootstrapAddress crypto -> Addr crypto)
-> GetShort (BootstrapAddress crypto) -> GetShort (Addr crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort (BootstrapAddress crypto)
forall crypto. GetShort (BootstrapAddress crypto)
getBootstrapAddress
    else do
      Word8
_ <- GetShort Word8
getWord -- read past the header byte
      let addrNetId :: Word8
addrNetId = Word8
header Word8 -> Word8 -> Word8
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 crypto
c <- Word8 -> GetShort (PaymentCredential crypto)
forall crypto.
Crypto crypto =>
Word8 -> GetShort (PaymentCredential crypto)
getPayCred Word8
header
          StakeReference crypto
h <- Word8 -> GetShort (StakeReference crypto)
forall crypto.
Crypto crypto =>
Word8 -> GetShort (StakeReference crypto)
getStakeReference Word8
header
          Addr crypto -> GetShort (Addr crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network
-> PaymentCredential crypto -> StakeReference crypto -> Addr crypto
forall crypto.
Network
-> PaymentCredential crypto -> StakeReference crypto -> Addr crypto
Addr Network
n PaymentCredential crypto
c StakeReference crypto
h)
        Maybe Network
Nothing ->
          String -> GetShort (Addr crypto)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetShort (Addr crypto))
-> String -> GetShort (Addr crypto)
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [String
"Address with unknown network Id. (", Word8 -> String
forall a. Show a => a -> String
show Word8
addrNetId, String
")"]

getBootstrapAddress :: GetShort (BootstrapAddress crypto)
getBootstrapAddress :: GetShort (BootstrapAddress crypto)
getBootstrapAddress = do
  ByteString
bs <- GetShort ByteString
getRemainingAsByteString
  case ByteString -> Either DecoderError Address
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull' ByteString
bs of
    Left DecoderError
e -> String -> GetShort (BootstrapAddress crypto)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetShort (BootstrapAddress crypto))
-> String -> GetShort (BootstrapAddress crypto)
forall a b. (a -> b) -> a -> b
$ DecoderError -> String
forall a. Show a => a -> String
show DecoderError
e
    Right Address
r -> BootstrapAddress crypto -> GetShort (BootstrapAddress crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BootstrapAddress crypto -> GetShort (BootstrapAddress crypto))
-> BootstrapAddress crypto -> GetShort (BootstrapAddress crypto)
forall a b. (a -> b) -> a -> b
$ Address -> BootstrapAddress crypto
forall crypto. Address -> BootstrapAddress crypto
BootstrapAddress Address
r

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

peekWord8 :: GetShort Word8
peekWord8 :: GetShort Word8
peekWord8 = (Int -> ShortByteString -> Maybe (Int, Word8)) -> GetShort Word8
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ShortByteString -> Int
SBS.length ShortByteString
sbs then (Int, Word8) -> Maybe (Int, Word8)
forall a. a -> Maybe a
Just (Int
i, ShortByteString -> Int -> Word8
SBS.index ShortByteString
sbs Int
i) else Maybe (Int, Word8)
forall a. Maybe a
Nothing

getRemainingAsByteString :: GetShort BS.ByteString
getRemainingAsByteString :: GetShort ByteString
getRemainingAsByteString = (Int -> ShortByteString -> Maybe (Int, ByteString))
-> GetShort ByteString
forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort ((Int -> ShortByteString -> Maybe (Int, ByteString))
 -> GetShort ByteString)
-> (Int -> ShortByteString -> Maybe (Int, ByteString))
-> GetShort ByteString
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l
        then (Int, ByteString) -> Maybe (Int, ByteString)
forall a. a -> Maybe a
Just (Int
l, ShortByteString -> ByteString
SBS.fromShort (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int -> Int -> ShortByteString
substring ShortByteString
sbs Int
i Int
l)
        else Maybe (Int, ByteString)
forall a. Maybe a
Nothing

getHash :: forall a h. Hash.HashAlgorithm h => GetShort (Hash.Hash h a)
getHash :: GetShort (Hash h a)
getHash = (Int -> ShortByteString -> Maybe (Int, Hash h a))
-> GetShort (Hash h a)
forall a. (Int -> ShortByteString -> Maybe (Int, a)) -> GetShort a
GetShort ((Int -> ShortByteString -> Maybe (Int, Hash h a))
 -> GetShort (Hash h a))
-> (Int -> ShortByteString -> Maybe (Int, Hash h a))
-> GetShort (Hash h a)
forall a b. (a -> b) -> a -> b
$ \Int
i ShortByteString
sbs ->
  let hashLen :: Word
hashLen = [h] -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash ([] @h)
      offsetStop :: Int
offsetStop = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
hashLen
   in if Int
offsetStop Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ShortByteString -> Int
SBS.length ShortByteString
sbs
        then do
          Hash h a
hash <- ShortByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
Hash.hashFromBytesShort (ShortByteString -> Maybe (Hash h a))
-> ShortByteString -> Maybe (Hash h a)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int -> Int -> ShortByteString
substring ShortByteString
sbs Int
i Int
offsetStop
          (Int, Hash h a) -> Maybe (Int, Hash h a)
forall a. a -> Maybe a
Just (Int
offsetStop, Hash h a
hash)
        else Maybe (Int, Hash h a)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) of
    BA.ByteArray ByteArray#
ba' -> ByteArray# -> ShortByteString
SBS ByteArray#
ba'

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

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

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

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

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

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

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

-- | Efficiently check whether compated adddress is an address with a credential
-- that is a payment script.
isPayCredScriptCompactAddr :: CompactAddr crypto -> Bool
isPayCredScriptCompactAddr :: CompactAddr crypto -> Bool
isPayCredScriptCompactAddr (UnsafeCompactAddr ShortByteString
bytes) =
  Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (ShortByteString -> Int -> Word8
SBS.index ShortByteString
bytes Int
0) Int
payCredIsScript

-- | Efficiently check whether compated adddress is a Byron address.
isBootstrapCompactAddr :: CompactAddr crypto -> Bool
isBootstrapCompactAddr :: CompactAddr crypto -> Bool
isBootstrapCompactAddr (UnsafeCompactAddr ShortByteString
bytes) = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (ShortByteString -> Int -> Word8
SBS.index ShortByteString
bytes Int
0) Int
byron