{-# LANGUAGE DerivingStrategies #-}

{- | Wire-level data model and byte serialisation for the Singular naming
contract, transcribed exactly from the accepted epic-15 contract's
@simulator/naming-wire.mjs@ and @simulator/naming.mjs@ (v0.2.0, commit
@13231f58833b8feb57f4b0f9b1117bfcfba0c07d@, asset sha256
@acbabdf54a271251bd73bf9d84ab2c901107045a7dd77d28a391f22cdd53b0e5@).

The serialiser and parser mirror the reference function for function:
same canonical heads, same refusals, same requirement to consume the
whole input. Where this module and the reference disagree, the
reference is right and this module is wrong.
-}
module Naming.Wire
    ( WireData (..)
    , serialiseWireData
    , deserialiseWireData
    , PaymentCredential (..)
    , AddressForm (..)
    , Address (..)
    , decodeAddress
    , encodeAddress
    , canonicalAddress
    , guardWire
    ) where

import Data.ByteString (ByteString)
import Data.ByteString qualified as BS

{- | Untyped PlutusData-shaped wire value: exactly the four shapes the
contract's @serialiseWireData@ accepts.
-}
data WireData
    = Constr Int [WireData]
    | WBytes ByteString
    | WInt Integer
    | WList [WireData]
    deriving stock (WireData -> WireData -> Bool
(WireData -> WireData -> Bool)
-> (WireData -> WireData -> Bool) -> Eq WireData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WireData -> WireData -> Bool
== :: WireData -> WireData -> Bool
$c/= :: WireData -> WireData -> Bool
/= :: WireData -> WireData -> Bool
Eq, Int -> WireData -> ShowS
[WireData] -> ShowS
WireData -> String
(Int -> WireData -> ShowS)
-> (WireData -> String) -> ([WireData] -> ShowS) -> Show WireData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WireData -> ShowS
showsPrec :: Int -> WireData -> ShowS
$cshow :: WireData -> String
show :: WireData -> String
$cshowList :: [WireData] -> ShowS
showList :: [WireData] -> ShowS
Show)

{- | Serialise to the contract's byte form. @constr(i, fields)@ becomes
@D8 (79+i) 9F … FF@ with @i < 7@; byte strings are at most 64 bytes
with the canonical head (direct length below 24, otherwise @58@ plus
one length byte); unsigned integers use the canonical unsigned head
(direct below 24, @18@ below 256, @19@ plus two bytes below 65536);
lists are indefinite (@9F … FF@). Nothing else serialises.
-}
serialiseWireData :: WireData -> Maybe ByteString
serialiseWireData :: WireData -> Maybe ByteString
serialiseWireData (Constr Int
index [WireData]
fields)
    | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7 = do
        parts <- (WireData -> Maybe ByteString) -> [WireData] -> Maybe [ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse WireData -> Maybe ByteString
serialiseWireData [WireData]
fields
        pure $
            BS.pack [0xd8, 0x79 + fromIntegral index, 0x9f]
                <> BS.concat parts
                <> BS.singleton 0xff
serialiseWireData (WBytes ByteString
b)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64 =
        ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
            if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24
                then Word8 -> ByteString -> ByteString
BS.cons (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
0x40 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)) ByteString
b
                else [Word8] -> ByteString
BS.pack [Word8
0x58, Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b
  where
    n :: Int
n = ByteString -> Int
BS.length ByteString
b
serialiseWireData (WInt Integer
v)
    | Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
24 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Word8] -> ByteString
BS.pack [Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v])
    | Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0, Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
256 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Word8] -> ByteString
BS.pack [Word8
0x18, Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v])
    | Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
    , Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
65536 =
        ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ([Word8] -> ByteString
BS.pack [Word8
0x19, Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
v Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
256), Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
v Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
256)])
serialiseWireData (WList [WireData]
fields) = do
    parts <- (WireData -> Maybe ByteString) -> [WireData] -> Maybe [ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse WireData -> Maybe ByteString
serialiseWireData [WireData]
fields
    pure (BS.singleton 0x9f <> BS.concat parts <> BS.singleton 0xff)
-- Guard fall-throughs: byte strings over 64 bytes and negative or
-- oversized integers do not serialise, exactly as in the reference.
serialiseWireData WireData
_ = Maybe ByteString
forall a. Maybe a
Nothing

{- | Parse the contract's byte form back, refusing exactly what the
reference parser refuses: non-canonical heads (a @58@ byte-string head
must carry 24..64 bytes, @18@/@19@ integer heads must be the shortest
form), unsupported heads, and truncated input — the whole input must
be consumed.
-}
deserialiseWireData :: ByteString -> Maybe WireData
deserialiseWireData :: ByteString -> Maybe WireData
deserialiseWireData ByteString
input = do
    (value, rest) <- ByteString -> Maybe (WireData, ByteString)
parseWireData ByteString
input
    guardWire (BS.null rest)
    pure value

{- | @Maybe@-flavoured guard, the analogue of the reference's repeated
@=== null@ refusals.
-}
guardWire :: Bool -> Maybe ()
guardWire :: Bool -> Maybe ()
guardWire Bool
True = () -> Maybe ()
forall a. a -> Maybe a
Just ()
guardWire Bool
False = Maybe ()
forall a. Maybe a
Nothing

parseWireData :: ByteString -> Maybe (WireData, ByteString)
parseWireData :: ByteString -> Maybe (WireData, ByteString)
parseWireData ByteString
input = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
input of
    Maybe (Word8, ByteString)
Nothing -> Maybe (WireData, ByteString)
forall a. Maybe a
Nothing
    Just (Word8
header, ByteString
rest)
        | Word8
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xd8
        , Just (Word8
tag, ByteString
rest2) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
rest
        , Word8
tag Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x79
        , Word8
tag Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80
        , Just (Word8
0x9f, ByteString
rest3) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
rest2 -> do
            (fields, remaining) <- ByteString -> Maybe ([WireData], ByteString)
parseWireItems ByteString
rest3
            pure (Constr (fromIntegral tag - 0x79) fields, remaining)
        | Word8
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x9f -> do
            (fields, remaining) <- ByteString -> Maybe ([WireData], ByteString)
parseWireItems ByteString
rest
            pure (WList fields, remaining)
        | Word8
header Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x40
        , Word8
header Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x58 ->
            let len :: Int
len = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
header Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x40)
            in  Bool -> Maybe ()
guardWire (ByteString -> Int
BS.length ByteString
rest Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len)
                    Maybe ()
-> Maybe (WireData, ByteString) -> Maybe (WireData, ByteString)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WireData, ByteString) -> Maybe (WireData, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> WireData
WBytes (Int -> ByteString -> ByteString
BS.take Int
len ByteString
rest), Int -> ByteString -> ByteString
BS.drop Int
len ByteString
rest)
        | Word8
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x58
        , Just (Word8
len8, ByteString
rest2) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
rest
        , Word8
len8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
24
        , Word8
len8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
64 ->
            let len :: Int
len = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len8
            in  Bool -> Maybe ()
guardWire (ByteString -> Int
BS.length ByteString
rest2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len)
                    Maybe ()
-> Maybe (WireData, ByteString) -> Maybe (WireData, ByteString)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WireData, ByteString) -> Maybe (WireData, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> WireData
WBytes (Int -> ByteString -> ByteString
BS.take Int
len ByteString
rest2), Int -> ByteString -> ByteString
BS.drop Int
len ByteString
rest2)
        | Word8
header Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
24 -> (WireData, ByteString) -> Maybe (WireData, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> WireData
WInt (Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
header), ByteString
rest)
        | Word8
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x18
        , Just (Word8
v, ByteString
rest2) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
rest
        , Word8
v Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
24 ->
            (WireData, ByteString) -> Maybe (WireData, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> WireData
WInt (Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v), ByteString
rest2)
        | Word8
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x19
        , Just (Word8
high, ByteString
rest2) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
rest
        , Just (Word8
low, ByteString
rest3) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
rest2
        , let v :: Integer
v = Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
high Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
256 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
low
        , Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
256 ->
            (WireData, ByteString) -> Maybe (WireData, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> WireData
WInt Integer
v, ByteString
rest3)
        | Bool
otherwise -> Maybe (WireData, ByteString)
forall a. Maybe a
Nothing

parseWireItems :: ByteString -> Maybe ([WireData], ByteString)
parseWireItems :: ByteString -> Maybe ([WireData], ByteString)
parseWireItems = [WireData] -> ByteString -> Maybe ([WireData], ByteString)
go []
  where
    go :: [WireData] -> ByteString -> Maybe ([WireData], ByteString)
go [WireData]
acc ByteString
input = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
input of
        Just (Word8
0xff, ByteString
rest) -> ([WireData], ByteString) -> Maybe ([WireData], ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WireData] -> [WireData]
forall a. [a] -> [a]
reverse [WireData]
acc, ByteString
rest)
        Just (Word8, ByteString)
_ -> do
            (value, rest) <- ByteString -> Maybe (WireData, ByteString)
parseWireData ByteString
input
            go (value : acc) rest
        Maybe (Word8, ByteString)
Nothing -> Maybe ([WireData], ByteString)
forall a. Maybe a
Nothing

-- | Payment credential kind, as in the contract's @naming.mjs@.
data PaymentCredential
    = PaymentKey
    | ScriptCredential
    deriving stock (PaymentCredential -> PaymentCredential -> Bool
(PaymentCredential -> PaymentCredential -> Bool)
-> (PaymentCredential -> PaymentCredential -> Bool)
-> Eq PaymentCredential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PaymentCredential -> PaymentCredential -> Bool
== :: PaymentCredential -> PaymentCredential -> Bool
$c/= :: PaymentCredential -> PaymentCredential -> Bool
/= :: PaymentCredential -> PaymentCredential -> Bool
Eq, Int -> PaymentCredential -> ShowS
[PaymentCredential] -> ShowS
PaymentCredential -> String
(Int -> PaymentCredential -> ShowS)
-> (PaymentCredential -> String)
-> ([PaymentCredential] -> ShowS)
-> Show PaymentCredential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PaymentCredential -> ShowS
showsPrec :: Int -> PaymentCredential -> ShowS
$cshow :: PaymentCredential -> String
show :: PaymentCredential -> String
$cshowList :: [PaymentCredential] -> ShowS
showList :: [PaymentCredential] -> ShowS
Show)

-- | Address form, as in the contract's @naming.mjs@.
data AddressForm
    = EnterpriseForm
    | BaseForm
    deriving stock (AddressForm -> AddressForm -> Bool
(AddressForm -> AddressForm -> Bool)
-> (AddressForm -> AddressForm -> Bool) -> Eq AddressForm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddressForm -> AddressForm -> Bool
== :: AddressForm -> AddressForm -> Bool
$c/= :: AddressForm -> AddressForm -> Bool
/= :: AddressForm -> AddressForm -> Bool
Eq, Int -> AddressForm -> ShowS
[AddressForm] -> ShowS
AddressForm -> String
(Int -> AddressForm -> ShowS)
-> (AddressForm -> String)
-> ([AddressForm] -> ShowS)
-> Show AddressForm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddressForm -> ShowS
showsPrec :: Int -> AddressForm -> ShowS
$cshow :: AddressForm -> String
show :: AddressForm -> String
$cshowList :: [AddressForm] -> ShowS
showList :: [AddressForm] -> ShowS
Show)

{- | A decoded Shelley-style address: the bytes plus the fields the
contract's @decodeAddress@ recovers from the header byte.
-}
data Address = Address
    { Address -> ByteString
addressBytes :: ByteString
    , Address -> AddressForm
addressForm :: AddressForm
    , Address -> Int
addressNetwork :: Int
    , Address -> PaymentCredential
addressPaymentCredential :: PaymentCredential
    , Address -> ByteString
addressPaymentHash :: ByteString
    , Address -> Maybe PaymentCredential
addressStakeCredential :: Maybe PaymentCredential
    , Address -> ByteString
addressStakeHash :: ByteString
    }
    deriving stock (Address -> Address -> Bool
(Address -> Address -> Bool)
-> (Address -> Address -> Bool) -> Eq Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Address -> Address -> Bool
== :: Address -> Address -> Bool
$c/= :: Address -> Address -> Bool
/= :: Address -> Address -> Bool
Eq, Int -> Address -> ShowS
[Address] -> ShowS
Address -> String
(Int -> Address -> ShowS)
-> (Address -> String) -> ([Address] -> ShowS) -> Show Address
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Address -> ShowS
showsPrec :: Int -> Address -> ShowS
$cshow :: Address -> String
show :: Address -> String
$cshowList :: [Address] -> ShowS
showList :: [Address] -> ShowS
Show)

{- | Exact mirror of the contract's @decodeAddress@: header byte kinds
6–7 are enterprise addresses (29 bytes), kinds 0–3 are base addresses
(57 bytes), everything else is refused.
-}
decodeAddress :: ByteString -> Maybe Address
decodeAddress :: ByteString -> Maybe Address
decodeAddress ByteString
bytes = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bytes of
    Maybe (Word8, ByteString)
Nothing -> Maybe Address
forall a. Maybe a
Nothing
    Just (Word8
header, ByteString
payload)
        | (Int
kind Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
|| Int
kind Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7) Bool -> Bool -> Bool
&& ByteString -> Int
BS.length ByteString
payload Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
28 ->
            Address -> Maybe Address
forall a. a -> Maybe a
Just
                Address
                    { addressBytes :: ByteString
addressBytes = ByteString
bytes
                    , addressForm :: AddressForm
addressForm = AddressForm
EnterpriseForm
                    , addressNetwork :: Int
addressNetwork = Int
network
                    , addressPaymentCredential :: PaymentCredential
addressPaymentCredential =
                        if Int
kind Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 then PaymentCredential
PaymentKey else PaymentCredential
ScriptCredential
                    , addressPaymentHash :: ByteString
addressPaymentHash = ByteString
payload
                    , addressStakeCredential :: Maybe PaymentCredential
addressStakeCredential = Maybe PaymentCredential
forall a. Maybe a
Nothing
                    , addressStakeHash :: ByteString
addressStakeHash = ByteString
BS.empty
                    }
        | Int
kind Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 Bool -> Bool -> Bool
&& ByteString -> Int
BS.length ByteString
payload Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
56 ->
            Address -> Maybe Address
forall a. a -> Maybe a
Just
                Address
                    { addressBytes :: ByteString
addressBytes = ByteString
bytes
                    , addressForm :: AddressForm
addressForm = AddressForm
BaseForm
                    , addressNetwork :: Int
addressNetwork = Int
network
                    , addressPaymentCredential :: PaymentCredential
addressPaymentCredential =
                        if Int -> Bool
forall a. Integral a => a -> Bool
even Int
kind then PaymentCredential
PaymentKey else PaymentCredential
ScriptCredential
                    , addressPaymentHash :: ByteString
addressPaymentHash = Int -> ByteString -> ByteString
BS.take Int
28 ByteString
payload
                    , addressStakeCredential :: Maybe PaymentCredential
addressStakeCredential =
                        PaymentCredential -> Maybe PaymentCredential
forall a. a -> Maybe a
Just (if Int
kind Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then PaymentCredential
PaymentKey else PaymentCredential
ScriptCredential)
                    , addressStakeHash :: ByteString
addressStakeHash = Int -> ByteString -> ByteString
BS.drop Int
28 ByteString
payload
                    }
        | Bool
otherwise -> Maybe Address
forall a. Maybe a
Nothing
      where
        kind :: Int
kind = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
header Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
16 :: Int
        network :: Int
network = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
header Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
16 :: Int

-- | Exact mirror of the contract's @encodeAddress@.
encodeAddress :: Address -> Maybe ByteString
encodeAddress :: Address -> Maybe ByteString
encodeAddress Address
a
    | Address -> Int
addressNetwork Address
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
16 = Maybe ByteString
forall a. Maybe a
Nothing
    | ByteString -> Int
BS.length (Address -> ByteString
addressPaymentHash Address
a) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
28 = Maybe ByteString
forall a. Maybe a
Nothing
    | Address -> AddressForm
addressForm Address
a AddressForm -> AddressForm -> Bool
forall a. Eq a => a -> a -> Bool
== AddressForm
EnterpriseForm
    , Maybe PaymentCredential
Nothing <- Address -> Maybe PaymentCredential
addressStakeCredential Address
a
    , ByteString -> Bool
BS.null (Address -> ByteString
addressStakeHash Address
a) =
        ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
            Word8 -> ByteString -> ByteString
BS.cons
                ( Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                    ( (Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PaymentCredential -> Int
credentialOffset (Address -> PaymentCredential
addressPaymentCredential Address
a)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16
                        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Address -> Int
addressNetwork Address
a
                    )
                )
                (Address -> ByteString
addressPaymentHash Address
a)
    | Address -> AddressForm
addressForm Address
a AddressForm -> AddressForm -> Bool
forall a. Eq a => a -> a -> Bool
== AddressForm
BaseForm
    , Just PaymentCredential
stake <- Address -> Maybe PaymentCredential
addressStakeCredential Address
a
    , ByteString -> Int
BS.length (Address -> ByteString
addressStakeHash Address
a) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
28 =
        ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
            Word8 -> ByteString -> ByteString
BS.cons
                ( Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                    ( ( PaymentCredential -> Int
credentialOffset (Address -> PaymentCredential
addressPaymentCredential Address
a)
                            Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* PaymentCredential -> Int
credentialOffset PaymentCredential
stake
                      )
                        Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16
                        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Address -> Int
addressNetwork Address
a
                    )
                )
                (Address -> ByteString
addressPaymentHash Address
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Address -> ByteString
addressStakeHash Address
a)
    | Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing
  where
    credentialOffset :: PaymentCredential -> Int
credentialOffset PaymentCredential
PaymentKey = Int
0 :: Int
    credentialOffset PaymentCredential
ScriptCredential = Int
1

{- | The contract's @canonicalAddress@: the bytes decode to the address
and the address encodes back to the same bytes.
-}
canonicalAddress :: Address -> Bool
canonicalAddress :: Address -> Bool
canonicalAddress Address
a =
    ByteString -> Maybe Address
decodeAddress (Address -> ByteString
addressBytes Address
a) Maybe Address -> Maybe Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address -> Maybe Address
forall a. a -> Maybe a
Just Address
a
        Bool -> Bool -> Bool
&& Address -> Maybe ByteString
encodeAddress Address
a Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Address -> ByteString
addressBytes Address
a)