{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Copyright: © 2022 IOHK
-- License: Apache-2.0
--
-- Re-exports functionality provided by module 'Cardano.Ledger.Credential',
-- but with a safer interface.
--
module Cardano.Ledger.Credential.Safe
    (
      -- * Safe 'Ptr' interface
      Ptr
    , safePtr
    , safeUnwrapPtr

      -- * Conversions to and from 'Slot32'
    , SlotNo32 (..)
    , toSlotNo32
    , fromSlotNo32
    )
    where

import Prelude

import Cardano.Api
    ( SlotNo (..) )
import Cardano.Ledger.BaseTypes
    ( CertIx, TxIx )
import Cardano.Ledger.Credential
    ( Ptr (..) )
import Data.IntCast
    ( intCast, intCastMaybe )
import Data.Maybe
    ( fromMaybe )
import Data.Word
    ( Word32, Word64 )
import GHC.Stack
    ( HasCallStack )

--------------------------------------------------------------------------------
-- Safe public interface
--------------------------------------------------------------------------------

-- | Safely constructs a 'Ptr' without silent truncation of slot numbers.
--
-- Use 'toSlotNo32' to convert an ordinary 'SlotNo' to a 'SlotNo32'.
--
-- This function should satisfy the following property:
--
-- prop> safeUnwrapPtr (safePtr s t c) == (s, t, c)
--
safePtr :: SlotNo32 -> TxIx -> CertIx -> Ptr
safePtr :: SlotNo32 -> TxIx -> CertIx -> Ptr
safePtr = SlotNo -> TxIx -> CertIx -> Ptr
Ptr (SlotNo -> TxIx -> CertIx -> Ptr)
-> (SlotNo32 -> SlotNo) -> SlotNo32 -> TxIx -> CertIx -> Ptr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo32 -> SlotNo
fromSlotNo32

-- | Safely deconstructs a 'Ptr'.
--
-- Use 'fromSlotNo32' to convert the returned slot number to a 'SlotNo'.
--
-- This function should satisfy the following property:
--
-- prop> safeUnwrapPtr (safePtr s t c) == (s, t, c)
--
safeUnwrapPtr :: Ptr -> (SlotNo32, TxIx, CertIx)
safeUnwrapPtr :: Ptr -> (SlotNo32, TxIx, CertIx)
safeUnwrapPtr (Ptr SlotNo
s TxIx
t CertIx
c) = (HasCallStack => SlotNo -> SlotNo32
SlotNo -> SlotNo32
unsafeToSlotNo32 SlotNo
s, TxIx
t, CertIx
c)

-- | A 32-bit wide slot number.
--
newtype SlotNo32 = SlotNo32 Word32
    deriving newtype (SlotNo32 -> SlotNo32 -> Bool
(SlotNo32 -> SlotNo32 -> Bool)
-> (SlotNo32 -> SlotNo32 -> Bool) -> Eq SlotNo32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlotNo32 -> SlotNo32 -> Bool
$c/= :: SlotNo32 -> SlotNo32 -> Bool
== :: SlotNo32 -> SlotNo32 -> Bool
$c== :: SlotNo32 -> SlotNo32 -> Bool
Eq, Integer -> SlotNo32
SlotNo32 -> SlotNo32
SlotNo32 -> SlotNo32 -> SlotNo32
(SlotNo32 -> SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32)
-> (Integer -> SlotNo32)
-> Num SlotNo32
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> SlotNo32
$cfromInteger :: Integer -> SlotNo32
signum :: SlotNo32 -> SlotNo32
$csignum :: SlotNo32 -> SlotNo32
abs :: SlotNo32 -> SlotNo32
$cabs :: SlotNo32 -> SlotNo32
negate :: SlotNo32 -> SlotNo32
$cnegate :: SlotNo32 -> SlotNo32
* :: SlotNo32 -> SlotNo32 -> SlotNo32
$c* :: SlotNo32 -> SlotNo32 -> SlotNo32
- :: SlotNo32 -> SlotNo32 -> SlotNo32
$c- :: SlotNo32 -> SlotNo32 -> SlotNo32
+ :: SlotNo32 -> SlotNo32 -> SlotNo32
$c+ :: SlotNo32 -> SlotNo32 -> SlotNo32
Num, Eq SlotNo32
Eq SlotNo32
-> (SlotNo32 -> SlotNo32 -> Ordering)
-> (SlotNo32 -> SlotNo32 -> Bool)
-> (SlotNo32 -> SlotNo32 -> Bool)
-> (SlotNo32 -> SlotNo32 -> Bool)
-> (SlotNo32 -> SlotNo32 -> Bool)
-> (SlotNo32 -> SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32 -> SlotNo32)
-> Ord SlotNo32
SlotNo32 -> SlotNo32 -> Bool
SlotNo32 -> SlotNo32 -> Ordering
SlotNo32 -> SlotNo32 -> SlotNo32
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 :: SlotNo32 -> SlotNo32 -> SlotNo32
$cmin :: SlotNo32 -> SlotNo32 -> SlotNo32
max :: SlotNo32 -> SlotNo32 -> SlotNo32
$cmax :: SlotNo32 -> SlotNo32 -> SlotNo32
>= :: SlotNo32 -> SlotNo32 -> Bool
$c>= :: SlotNo32 -> SlotNo32 -> Bool
> :: SlotNo32 -> SlotNo32 -> Bool
$c> :: SlotNo32 -> SlotNo32 -> Bool
<= :: SlotNo32 -> SlotNo32 -> Bool
$c<= :: SlotNo32 -> SlotNo32 -> Bool
< :: SlotNo32 -> SlotNo32 -> Bool
$c< :: SlotNo32 -> SlotNo32 -> Bool
compare :: SlotNo32 -> SlotNo32 -> Ordering
$ccompare :: SlotNo32 -> SlotNo32 -> Ordering
$cp1Ord :: Eq SlotNo32
Ord)
    deriving stock Int -> SlotNo32 -> ShowS
[SlotNo32] -> ShowS
SlotNo32 -> String
(Int -> SlotNo32 -> ShowS)
-> (SlotNo32 -> String) -> ([SlotNo32] -> ShowS) -> Show SlotNo32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlotNo32] -> ShowS
$cshowList :: [SlotNo32] -> ShowS
show :: SlotNo32 -> String
$cshow :: SlotNo32 -> String
showsPrec :: Int -> SlotNo32 -> ShowS
$cshowsPrec :: Int -> SlotNo32 -> ShowS
Show

-- | Converts an ordinary 'SlotNo' into a 'SlotNo32'.
--
-- Returns 'Nothing' if the slot number could not be converted safely.
--
toSlotNo32 :: SlotNo -> Maybe SlotNo32
toSlotNo32 :: SlotNo -> Maybe SlotNo32
toSlotNo32 (SlotNo Word64
n) = Word32 -> SlotNo32
SlotNo32 (Word32 -> SlotNo32) -> Maybe Word32 -> Maybe SlotNo32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
intCastMaybe @Word64 @Word32 Word64
n

-- | Converts a 'SlotNo32' into an ordinary 'SlotNo'.
--
fromSlotNo32 :: SlotNo32 -> SlotNo
fromSlotNo32 :: SlotNo32 -> SlotNo
fromSlotNo32 (SlotNo32 Word32
n) = Word64 -> SlotNo
SlotNo (Word32 -> Word64
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast @Word32 @Word64 Word32
n)

--------------------------------------------------------------------------------
-- Unsafe internal interface
--------------------------------------------------------------------------------

unsafeToSlotNo32 :: HasCallStack => SlotNo -> SlotNo32
unsafeToSlotNo32 :: SlotNo -> SlotNo32
unsafeToSlotNo32 = SlotNo32 -> Maybe SlotNo32 -> SlotNo32
forall a. a -> Maybe a -> a
fromMaybe SlotNo32
forall a. a
reportFailure (Maybe SlotNo32 -> SlotNo32)
-> (SlotNo -> Maybe SlotNo32) -> SlotNo -> SlotNo32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> Maybe SlotNo32
toSlotNo32
  where
    reportFailure :: a
reportFailure = String -> a
forall a. HasCallStack => String -> a
error
        String
"unsafeToSlotNo32: unable to convert SlotNo to SlotNo32"