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

module Shelley.Spec.Ledger.CompactAddr
  ( compactAddr,
    decompactAddr,
    CompactAddr (..),
    substring,
  )
where

import Cardano.Binary
  ( DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeFull',
  )
import qualified Cardano.Crypto.Hash.Class as Hash
import Cardano.Ledger.Crypto (ADDRHASH)
import Cardano.Ledger.Era (Crypto (..))
import Cardano.Prelude (Text, cborError, panic)
import Control.Monad (ap)
import qualified Control.Monad.Fail
import Data.Bits (testBit, (.&.))
import Data.ByteString (ByteString)
import Data.ByteString.Short as SBS
import Data.ByteString.Short.Internal (ShortByteString (SBS))
import Data.Maybe (fromMaybe)
import qualified Data.Primitive.ByteArray as BA
import Data.Word (Word8)
import Numeric.Natural (Natural)
import Shelley.Spec.Ledger.Address (Addr (..), BootstrapAddress (..), Word7 (..), byron, isEnterpriseAddr, notBaseAddr, payCredIsScript, serialiseAddr, stakeCredIsScript, toWord7, word7sToNat)
import Shelley.Spec.Ledger.BaseTypes (word8ToNetwork)
import Shelley.Spec.Ledger.Credential
  ( Credential (KeyHashObj, ScriptHashObj),
    PaymentCredential,
    Ptr (..),
    StakeReference (..),
  )
import Shelley.Spec.Ledger.Keys (KeyHash (..))
import Shelley.Spec.Ledger.Scripts (ScriptHash (..))
import Shelley.Spec.Ledger.Slot (SlotNo (..))

newtype CompactAddr era = UnsafeCompactAddr ShortByteString
  deriving (CompactAddr era -> CompactAddr era -> Bool
(CompactAddr era -> CompactAddr era -> Bool)
-> (CompactAddr era -> CompactAddr era -> Bool)
-> Eq (CompactAddr era)
forall era. CompactAddr era -> CompactAddr era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactAddr era -> CompactAddr era -> Bool
$c/= :: forall era. CompactAddr era -> CompactAddr era -> Bool
== :: CompactAddr era -> CompactAddr era -> Bool
$c== :: forall era. CompactAddr era -> CompactAddr era -> Bool
Eq, Eq (CompactAddr era)
Eq (CompactAddr era)
-> (CompactAddr era -> CompactAddr era -> Ordering)
-> (CompactAddr era -> CompactAddr era -> Bool)
-> (CompactAddr era -> CompactAddr era -> Bool)
-> (CompactAddr era -> CompactAddr era -> Bool)
-> (CompactAddr era -> CompactAddr era -> Bool)
-> (CompactAddr era -> CompactAddr era -> CompactAddr era)
-> (CompactAddr era -> CompactAddr era -> CompactAddr era)
-> Ord (CompactAddr era)
CompactAddr era -> CompactAddr era -> Bool
CompactAddr era -> CompactAddr era -> Ordering
CompactAddr era -> CompactAddr era -> CompactAddr era
forall era. Eq (CompactAddr era)
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 era. CompactAddr era -> CompactAddr era -> Bool
forall era. CompactAddr era -> CompactAddr era -> Ordering
forall era. CompactAddr era -> CompactAddr era -> CompactAddr era
min :: CompactAddr era -> CompactAddr era -> CompactAddr era
$cmin :: forall era. CompactAddr era -> CompactAddr era -> CompactAddr era
max :: CompactAddr era -> CompactAddr era -> CompactAddr era
$cmax :: forall era. CompactAddr era -> CompactAddr era -> CompactAddr era
>= :: CompactAddr era -> CompactAddr era -> Bool
$c>= :: forall era. CompactAddr era -> CompactAddr era -> Bool
> :: CompactAddr era -> CompactAddr era -> Bool
$c> :: forall era. CompactAddr era -> CompactAddr era -> Bool
<= :: CompactAddr era -> CompactAddr era -> Bool
$c<= :: forall era. CompactAddr era -> CompactAddr era -> Bool
< :: CompactAddr era -> CompactAddr era -> Bool
$c< :: forall era. CompactAddr era -> CompactAddr era -> Bool
compare :: CompactAddr era -> CompactAddr era -> Ordering
$ccompare :: forall era. CompactAddr era -> CompactAddr era -> Ordering
$cp1Ord :: forall era. Eq (CompactAddr era)
Ord)

compactAddr :: Addr era -> CompactAddr era
compactAddr :: Addr era -> CompactAddr era
compactAddr = ShortByteString -> CompactAddr era
forall era. ShortByteString -> CompactAddr era
UnsafeCompactAddr (ShortByteString -> CompactAddr era)
-> (Addr era -> ShortByteString) -> Addr era -> CompactAddr era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (Addr era -> ByteString) -> Addr era -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr era -> ByteString
forall era. Addr era -> ByteString
serialiseAddr

decompactAddr :: forall era. Era era => CompactAddr era -> Addr era
decompactAddr :: CompactAddr era -> Addr era
decompactAddr (UnsafeCompactAddr ShortByteString
bytes) =
  if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
header Int
byron
    then BootstrapAddress era -> Addr era
forall era. BootstrapAddress era -> Addr era
AddrBootstrap (BootstrapAddress era -> Addr era)
-> BootstrapAddress era -> Addr era
forall a b. (a -> b) -> a -> b
$ Text
-> Int
-> ShortByteString
-> GetShort (BootstrapAddress era)
-> BootstrapAddress era
forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
"byron address" Int
0 ShortByteString
bytes GetShort (BootstrapAddress era)
forall era. GetShort (BootstrapAddress era)
getBootstrapAddress
    else Network -> PaymentCredential era -> StakeReference era -> Addr era
forall era.
Network -> PaymentCredential era -> StakeReference era -> Addr era
Addr Network
addrNetId PaymentCredential era
paycred StakeReference era
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 era))) bytes
        -- and the stake cred can vary
    paycred :: PaymentCredential era
paycred = Text
-> Int
-> ShortByteString
-> GetShort (PaymentCredential era)
-> PaymentCredential era
forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
"payment credential" Int
1 ShortByteString
bytes (Word8 -> GetShort (PaymentCredential era)
forall era. Era era => Word8 -> GetShort (PaymentCredential era)
getPayCred Word8
header)
    stakecred :: StakeReference era
stakecred = Text
-> Int
-> ShortByteString
-> GetShort (StakeReference era)
-> StakeReference era
forall a. Text -> Int -> ShortByteString -> GetShort a -> a
run Text
"staking credential" Int
1 ShortByteString
bytes (GetShort (StakeReference era) -> StakeReference era)
-> GetShort (StakeReference era) -> StakeReference era
forall a b. (a -> b) -> a -> b
$ do
      [ADDRHASH (Crypto era)] -> GetShort ()
forall (proxy :: * -> *) h.
HashAlgorithm h =>
proxy h -> GetShort ()
skipHash ([] @(ADDRHASH (Crypto era)))
      Word8 -> GetShort (StakeReference era)
forall era. Era era => Word8 -> GetShort (StakeReference era)
getStakeReference Word8
header

instance Era era => ToCBOR (CompactAddr era) where
  toCBOR :: CompactAddr era -> Encoding
toCBOR (UnsafeCompactAddr ShortByteString
bytes) = ShortByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ShortByteString
bytes

instance Era era => FromCBOR (CompactAddr era) where
  fromCBOR :: Decoder s (CompactAddr era)
fromCBOR = do
    ShortByteString
sbs <- Decoder s ShortByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
    case ShortByteString -> Maybe (Addr era)
forall era. Era era => ShortByteString -> Maybe (Addr era)
deserializeShortAddr @era ShortByteString
sbs of
      Just Addr era
_ -> CompactAddr era -> Decoder s (CompactAddr era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompactAddr era -> Decoder s (CompactAddr era))
-> CompactAddr era -> Decoder s (CompactAddr era)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> CompactAddr era
forall era. ShortByteString -> CompactAddr era
UnsafeCompactAddr ShortByteString
sbs
      Maybe (Addr era)
Nothing -> DecoderError -> Decoder s (CompactAddr era)
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s (CompactAddr era))
-> DecoderError -> Decoder s (CompactAddr era)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"Addr" Text
"invalid address"

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

deserializeShortAddr :: Era era => ShortByteString -> Maybe (Addr era)
deserializeShortAddr :: ShortByteString -> Maybe (Addr era)
deserializeShortAddr ShortByteString
short = (Int, Addr era) -> Addr era
forall a b. (a, b) -> b
snd ((Int, Addr era) -> Addr era)
-> Maybe (Int, Addr era) -> Maybe (Addr era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort (Addr era)
-> Int -> ShortByteString -> Maybe (Int, Addr era)
forall a. GetShort a -> Int -> ShortByteString -> Maybe (Int, a)
runGetShort GetShort (Addr era)
forall era. Era era => GetShort (Addr era)
getShortAddr Int
0 ShortByteString
short

getShortAddr :: forall era. Era era => GetShort (Addr era)
getShortAddr :: GetShort (Addr era)
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 era -> Addr era
forall era. BootstrapAddress era -> Addr era
AddrBootstrap (BootstrapAddress era -> Addr era)
-> GetShort (BootstrapAddress era) -> GetShort (Addr era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort (BootstrapAddress era)
forall era. GetShort (BootstrapAddress era)
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 era
c <- Word8 -> GetShort (PaymentCredential era)
forall era. Era era => Word8 -> GetShort (PaymentCredential era)
getPayCred Word8
header
          StakeReference era
h <- Word8 -> GetShort (StakeReference era)
forall era. Era era => Word8 -> GetShort (StakeReference era)
getStakeReference Word8
header
          Addr era -> GetShort (Addr era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network -> PaymentCredential era -> StakeReference era -> Addr era
forall era.
Network -> PaymentCredential era -> StakeReference era -> Addr era
Addr Network
n PaymentCredential era
c StakeReference era
h)
        Maybe Network
Nothing ->
          String -> GetShort (Addr era)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetShort (Addr era)) -> String -> GetShort (Addr era)
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 era)
getBootstrapAddress :: GetShort (BootstrapAddress era)
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 era)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetShort (BootstrapAddress era))
-> String -> GetShort (BootstrapAddress era)
forall a b. (a -> b) -> a -> b
$ DecoderError -> String
forall a. Show a => a -> String
show DecoderError
e
    Right Address
r -> BootstrapAddress era -> GetShort (BootstrapAddress era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BootstrapAddress era -> GetShort (BootstrapAddress era))
-> BootstrapAddress era -> GetShort (BootstrapAddress era)
forall a b. (a -> b) -> a -> b
$ Address -> BootstrapAddress era
forall era. Address -> BootstrapAddress era
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 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, ByteString) -> Maybe (Int, ByteString))
-> (Int, ByteString) -> Maybe (Int, ByteString)
forall a b. (a -> b) -> a -> b
$ (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

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

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 (Int, Hash h a) -> Maybe (Int, Hash h a)
forall a. a -> Maybe a
Just (Int
offsetStop, ShortByteString -> Hash h a
forall h a. ShortByteString -> Hash h a
Hash.UnsafeHash (ShortByteString -> Int -> Int -> ShortByteString
substring ShortByteString
sbs Int
i Int
offsetStop))
        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'

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

getWord7s :: GetShort [Word7]
getWord7s :: GetShort [Word7]
getWord7s = do
  Word8
next <- GetShort Word8
getWord
  case Word8
next Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80 of -- 0x80 ~ 0b10000000
  -- is the high bit set?
  -- if so, grab more words
    Word8
0x80 -> (:) (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
    -- otherwise, this is the last one
    Word8
_ -> [Word7] -> GetShort [Word7]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word8 -> Word7
Word7 Word8
next]

getVariableLengthNat :: GetShort Natural
getVariableLengthNat :: GetShort Natural
getVariableLengthNat = [Word7] -> Natural
word7sToNat ([Word7] -> Natural) -> GetShort [Word7] -> GetShort Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort [Word7]
getWord7s

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

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

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

getStakeReference :: Era era => Word8 -> GetShort (StakeReference era)
getStakeReference :: Word8 -> GetShort (StakeReference era)
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 era -> GetShort (StakeReference era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeReference era
forall era. StakeReference era
StakeRefNull
    Bool
False -> Ptr -> StakeReference era
forall era. Ptr -> StakeReference era
StakeRefPtr (Ptr -> StakeReference era)
-> GetShort Ptr -> GetShort (StakeReference era)
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 era -> StakeReference era
forall era. StakeCredential era -> StakeReference era
StakeRefBase (StakeCredential era -> StakeReference era)
-> GetShort (StakeCredential era) -> GetShort (StakeReference era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort (StakeCredential era)
forall era (kr :: KeyRole). Era era => GetShort (Credential kr era)
getScriptHash
    Bool
False -> StakeCredential era -> StakeReference era
forall era. StakeCredential era -> StakeReference era
StakeRefBase (StakeCredential era -> StakeReference era)
-> GetShort (StakeCredential era) -> GetShort (StakeReference era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetShort (StakeCredential era)
forall era (kr :: KeyRole). Era era => GetShort (Credential kr era)
getKeyHash

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