{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

module Shelley.Spec.Ledger.BaseTypes
  ( FixedPoint,
    (==>),
    (⭒),
    Network (..),
    networkToWord8,
    word8ToNetwork,
    Nonce (..),
    Seed (..),
    UnitInterval,
    fpPrecision,
    interval0,
    intervalValue,
    unitIntervalToRational,
    unitIntervalFromRational,
    invalidKey,
    mkNonceFromOutputVRF,
    mkNonceFromNumber,
    mkUnitInterval,
    truncateUnitInterval,
    StrictMaybe (..),
    strictMaybeToMaybe,
    maybeToStrictMaybe,
    fromSMaybe,
    Url,
    urlToText,
    textToUrl,
    DnsName,
    dnsToText,
    textToDns,
    Port (..),
    ActiveSlotCoeff,
    mkActiveSlotCoeff,
    activeSlotVal,
    activeSlotLog,

    -- * STS Base
    Globals (..),
    ShelleyBase,
  )
where

import Cardano.Binary
  ( Decoder,
    DecoderError (..),
    FromCBOR (fromCBOR),
    ToCBOR (toCBOR),
    decodeBreakOr,
    decodeListLenOrIndef,
    encodeListLen,
  )
import Cardano.Crypto.Hash
import Cardano.Crypto.Util (SignableRepresentation (..))
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Prelude (NFData, cborError)
import Cardano.Slotting.EpochInfo
import qualified Control.Monad.Fail
import Control.Monad.Trans.Reader (ReaderT)
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Binary.Put as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Coders (invalidKey)
import qualified Data.Fixed as FP (Fixed, HasResolution, resolution)
import Data.Functor.Identity
import Data.Ratio (Ratio, denominator, numerator, (%))
import Data.Scientific (Scientific)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word16, Word64, Word8)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)
import Shelley.Spec.Ledger.Serialization (decodeRecordSum, ratioFromCBOR, ratioToCBOR)
import Shelley.Spec.NonIntegral (ln')

data E34

instance FP.HasResolution E34 where
  resolution :: p E34 -> Integer
resolution p E34
_ = (Integer
10 :: Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
34 :: Integer)

type Digits34 = FP.Fixed E34

type FixedPoint = Digits34

fpPrecision :: FixedPoint
fpPrecision :: FixedPoint
fpPrecision = (FixedPoint
10 :: FixedPoint) FixedPoint -> Integer -> FixedPoint
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
34 :: Integer)

-- | Type to represent a value in the unit interval [0; 1]
newtype UnitInterval = UnsafeUnitInterval (Ratio Word64)
  deriving (Int -> UnitInterval -> ShowS
[UnitInterval] -> ShowS
UnitInterval -> String
(Int -> UnitInterval -> ShowS)
-> (UnitInterval -> String)
-> ([UnitInterval] -> ShowS)
-> Show UnitInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnitInterval] -> ShowS
$cshowList :: [UnitInterval] -> ShowS
show :: UnitInterval -> String
$cshow :: UnitInterval -> String
showsPrec :: Int -> UnitInterval -> ShowS
$cshowsPrec :: Int -> UnitInterval -> ShowS
Show, Eq UnitInterval
Eq UnitInterval
-> (UnitInterval -> UnitInterval -> Ordering)
-> (UnitInterval -> UnitInterval -> Bool)
-> (UnitInterval -> UnitInterval -> Bool)
-> (UnitInterval -> UnitInterval -> Bool)
-> (UnitInterval -> UnitInterval -> Bool)
-> (UnitInterval -> UnitInterval -> UnitInterval)
-> (UnitInterval -> UnitInterval -> UnitInterval)
-> Ord UnitInterval
UnitInterval -> UnitInterval -> Bool
UnitInterval -> UnitInterval -> Ordering
UnitInterval -> UnitInterval -> UnitInterval
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 :: UnitInterval -> UnitInterval -> UnitInterval
$cmin :: UnitInterval -> UnitInterval -> UnitInterval
max :: UnitInterval -> UnitInterval -> UnitInterval
$cmax :: UnitInterval -> UnitInterval -> UnitInterval
>= :: UnitInterval -> UnitInterval -> Bool
$c>= :: UnitInterval -> UnitInterval -> Bool
> :: UnitInterval -> UnitInterval -> Bool
$c> :: UnitInterval -> UnitInterval -> Bool
<= :: UnitInterval -> UnitInterval -> Bool
$c<= :: UnitInterval -> UnitInterval -> Bool
< :: UnitInterval -> UnitInterval -> Bool
$c< :: UnitInterval -> UnitInterval -> Bool
compare :: UnitInterval -> UnitInterval -> Ordering
$ccompare :: UnitInterval -> UnitInterval -> Ordering
$cp1Ord :: Eq UnitInterval
Ord, UnitInterval -> UnitInterval -> Bool
(UnitInterval -> UnitInterval -> Bool)
-> (UnitInterval -> UnitInterval -> Bool) -> Eq UnitInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnitInterval -> UnitInterval -> Bool
$c/= :: UnitInterval -> UnitInterval -> Bool
== :: UnitInterval -> UnitInterval -> Bool
$c== :: UnitInterval -> UnitInterval -> Bool
Eq, (forall x. UnitInterval -> Rep UnitInterval x)
-> (forall x. Rep UnitInterval x -> UnitInterval)
-> Generic UnitInterval
forall x. Rep UnitInterval x -> UnitInterval
forall x. UnitInterval -> Rep UnitInterval x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnitInterval x -> UnitInterval
$cfrom :: forall x. UnitInterval -> Rep UnitInterval x
Generic)
  deriving newtype (Context -> UnitInterval -> IO (Maybe ThunkInfo)
Proxy UnitInterval -> String
(Context -> UnitInterval -> IO (Maybe ThunkInfo))
-> (Context -> UnitInterval -> IO (Maybe ThunkInfo))
-> (Proxy UnitInterval -> String)
-> NoThunks UnitInterval
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy UnitInterval -> String
$cshowTypeOf :: Proxy UnitInterval -> String
wNoThunks :: Context -> UnitInterval -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UnitInterval -> IO (Maybe ThunkInfo)
noThunks :: Context -> UnitInterval -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> UnitInterval -> IO (Maybe ThunkInfo)
NoThunks, UnitInterval -> ()
(UnitInterval -> ()) -> NFData UnitInterval
forall a. (a -> ()) -> NFData a
rnf :: UnitInterval -> ()
$crnf :: UnitInterval -> ()
NFData)

instance ToCBOR UnitInterval where
  toCBOR :: UnitInterval -> Encoding
toCBOR (UnsafeUnitInterval Ratio Word64
u) = Ratio Word64 -> Encoding
forall a. ToCBOR a => Ratio a -> Encoding
ratioToCBOR Ratio Word64
u

instance FromCBOR UnitInterval where
  fromCBOR :: Decoder s UnitInterval
fromCBOR = do
    Ratio Word64
r <- Decoder s (Ratio Word64)
forall a s. (Integral a, FromCBOR a) => Decoder s (Ratio a)
ratioFromCBOR
    case Ratio Word64 -> Maybe UnitInterval
mkUnitInterval Ratio Word64
r of
      Maybe UnitInterval
Nothing -> DecoderError -> Decoder s UnitInterval
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s UnitInterval)
-> DecoderError -> Decoder s UnitInterval
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"UnitInterval" (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> String
forall a. Show a => a -> String
show Ratio Word64
r)
      Just UnitInterval
u -> UnitInterval -> Decoder s UnitInterval
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitInterval
u

instance ToJSON UnitInterval where
  toJSON :: UnitInterval -> Value
toJSON UnitInterval
ui = Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON (Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational (UnitInterval -> Rational
unitIntervalToRational UnitInterval
ui) :: Scientific)

instance FromJSON UnitInterval where
  parseJSON :: Value -> Parser UnitInterval
parseJSON Value
v = do
    Scientific
d <- Value -> Parser Scientific
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    case Ratio Word64 -> Maybe UnitInterval
mkUnitInterval (Scientific -> Ratio Word64
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Scientific
d :: Scientific) :: Ratio Word64) of
      Just UnitInterval
u -> UnitInterval -> Parser UnitInterval
forall (m :: * -> *) a. Monad m => a -> m a
return UnitInterval
u
      Maybe UnitInterval
Nothing -> String -> Parser UnitInterval
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"The value must be between 0 and 1 (inclusive)"

unitIntervalToRational :: UnitInterval -> Rational
unitIntervalToRational :: UnitInterval -> Rational
unitIntervalToRational (UnsafeUnitInterval Ratio Word64
x) =
  (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> Word64
forall a. Ratio a -> a
numerator Ratio Word64
x) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> Word64
forall a. Ratio a -> a
denominator Ratio Word64
x)

unitIntervalFromRational :: Rational -> UnitInterval
unitIntervalFromRational :: Rational -> UnitInterval
unitIntervalFromRational = Ratio Word64 -> UnitInterval
truncateUnitInterval (Ratio Word64 -> UnitInterval)
-> (Rational -> Ratio Word64) -> Rational -> UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Ratio Word64
forall a. Fractional a => Rational -> a
fromRational

-- | Return a `UnitInterval` type if `r` is in [0; 1].
mkUnitInterval :: Ratio Word64 -> Maybe UnitInterval
mkUnitInterval :: Ratio Word64 -> Maybe UnitInterval
mkUnitInterval Ratio Word64
r = if Ratio Word64
r Ratio Word64 -> Ratio Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ratio Word64
1 Bool -> Bool -> Bool
&& Ratio Word64
r Ratio Word64 -> Ratio Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ratio Word64
0 then UnitInterval -> Maybe UnitInterval
forall a. a -> Maybe a
Just (UnitInterval -> Maybe UnitInterval)
-> UnitInterval -> Maybe UnitInterval
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> UnitInterval
UnsafeUnitInterval Ratio Word64
r else Maybe UnitInterval
forall a. Maybe a
Nothing

-- | Convert a rational to a `UnitInterval` by ignoring its integer part.
truncateUnitInterval :: Ratio Word64 -> UnitInterval
truncateUnitInterval :: Ratio Word64 -> UnitInterval
truncateUnitInterval (Ratio Word64 -> Ratio Word64
forall a. Num a => a -> a
abs -> Ratio Word64
r) = case (Ratio Word64 -> Word64
forall a. Ratio a -> a
numerator Ratio Word64
r, Ratio Word64 -> Word64
forall a. Ratio a -> a
denominator Ratio Word64
r) of
  (Word64
n, Word64
d) | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
d -> Ratio Word64 -> UnitInterval
UnsafeUnitInterval (Ratio Word64 -> UnitInterval) -> Ratio Word64 -> UnitInterval
forall a b. (a -> b) -> a -> b
$ (Word64
n Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` Word64
d) Word64 -> Word64 -> Ratio Word64
forall a. Integral a => a -> a -> Ratio a
% Word64
d
  (Word64, Word64)
_ -> Ratio Word64 -> UnitInterval
UnsafeUnitInterval Ratio Word64
r

-- | Get rational value of `UnitInterval` type
intervalValue :: UnitInterval -> Ratio Word64
intervalValue :: UnitInterval -> Ratio Word64
intervalValue (UnsafeUnitInterval Ratio Word64
v) = Ratio Word64
v

interval0 :: UnitInterval
interval0 :: UnitInterval
interval0 = Ratio Word64 -> UnitInterval
UnsafeUnitInterval Ratio Word64
0

-- | Evolving nonce type.
data Nonce
  = Nonce !(Hash Blake2b_256 Nonce)
  | -- | Identity element
    NeutralNonce
  deriving (Nonce -> Nonce -> Bool
(Nonce -> Nonce -> Bool) -> (Nonce -> Nonce -> Bool) -> Eq Nonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nonce -> Nonce -> Bool
$c/= :: Nonce -> Nonce -> Bool
== :: Nonce -> Nonce -> Bool
$c== :: Nonce -> Nonce -> Bool
Eq, (forall x. Nonce -> Rep Nonce x)
-> (forall x. Rep Nonce x -> Nonce) -> Generic Nonce
forall x. Rep Nonce x -> Nonce
forall x. Nonce -> Rep Nonce x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Nonce x -> Nonce
$cfrom :: forall x. Nonce -> Rep Nonce x
Generic, Eq Nonce
Eq Nonce
-> (Nonce -> Nonce -> Ordering)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Nonce)
-> (Nonce -> Nonce -> Nonce)
-> Ord Nonce
Nonce -> Nonce -> Bool
Nonce -> Nonce -> Ordering
Nonce -> Nonce -> Nonce
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 :: Nonce -> Nonce -> Nonce
$cmin :: Nonce -> Nonce -> Nonce
max :: Nonce -> Nonce -> Nonce
$cmax :: Nonce -> Nonce -> Nonce
>= :: Nonce -> Nonce -> Bool
$c>= :: Nonce -> Nonce -> Bool
> :: Nonce -> Nonce -> Bool
$c> :: Nonce -> Nonce -> Bool
<= :: Nonce -> Nonce -> Bool
$c<= :: Nonce -> Nonce -> Bool
< :: Nonce -> Nonce -> Bool
$c< :: Nonce -> Nonce -> Bool
compare :: Nonce -> Nonce -> Ordering
$ccompare :: Nonce -> Nonce -> Ordering
$cp1Ord :: Eq Nonce
Ord, Int -> Nonce -> ShowS
[Nonce] -> ShowS
Nonce -> String
(Int -> Nonce -> ShowS)
-> (Nonce -> String) -> ([Nonce] -> ShowS) -> Show Nonce
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nonce] -> ShowS
$cshowList :: [Nonce] -> ShowS
show :: Nonce -> String
$cshow :: Nonce -> String
showsPrec :: Int -> Nonce -> ShowS
$cshowsPrec :: Int -> Nonce -> ShowS
Show, Nonce -> ()
(Nonce -> ()) -> NFData Nonce
forall a. (a -> ()) -> NFData a
rnf :: Nonce -> ()
$crnf :: Nonce -> ()
NFData)

instance NoThunks Nonce

instance ToCBOR Nonce where
  toCBOR :: Nonce -> Encoding
toCBOR Nonce
NeutralNonce = Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8)
  toCBOR (Nonce Hash Blake2b_256 Nonce
n) = Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
1 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash Blake2b_256 Nonce -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Hash Blake2b_256 Nonce
n

instance FromCBOR Nonce where
  fromCBOR :: Decoder s Nonce
fromCBOR = String -> (Word -> Decoder s (Int, Nonce)) -> Decoder s Nonce
forall s a. String -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum String
"Nonce" ((Word -> Decoder s (Int, Nonce)) -> Decoder s Nonce)
-> (Word -> Decoder s (Int, Nonce)) -> Decoder s Nonce
forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 -> (Int, Nonce) -> Decoder s (Int, Nonce)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, Nonce
NeutralNonce)
      Word
1 -> do
        Hash Blake2b_256 Nonce
x <- Decoder s (Hash Blake2b_256 Nonce)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, Nonce) -> Decoder s (Int, Nonce)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, Hash Blake2b_256 Nonce -> Nonce
Nonce Hash Blake2b_256 Nonce
x)
      Word
k -> Word -> Decoder s (Int, Nonce)
forall s a. Word -> Decoder s a
invalidKey Word
k

deriving anyclass instance ToJSON Nonce

deriving anyclass instance FromJSON Nonce

-- | Evolve the nonce
(⭒) :: Nonce -> Nonce -> Nonce
Nonce Hash Blake2b_256 Nonce
a ⭒ :: Nonce -> Nonce -> Nonce
 Nonce Hash Blake2b_256 Nonce
b =
  Hash Blake2b_256 Nonce -> Nonce
Nonce (Hash Blake2b_256 Nonce -> Nonce)
-> (Hash Blake2b_256 ByteString -> Hash Blake2b_256 Nonce)
-> Hash Blake2b_256 ByteString
-> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 ByteString -> Hash Blake2b_256 Nonce
forall h a b. Hash h a -> Hash h b
castHash (Hash Blake2b_256 ByteString -> Nonce)
-> Hash Blake2b_256 ByteString -> Nonce
forall a b. (a -> b) -> a -> b
$
    (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith ByteString -> ByteString
forall a. a -> a
id (Hash Blake2b_256 Nonce -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash Blake2b_256 Nonce
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Hash Blake2b_256 Nonce -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash Blake2b_256 Nonce
b)
Nonce
x  Nonce
NeutralNonce = Nonce
x
Nonce
NeutralNonce  Nonce
x = Nonce
x

-- | Make a nonce from the VRF output bytes
mkNonceFromOutputVRF :: VRF.OutputVRF v -> Nonce
mkNonceFromOutputVRF :: OutputVRF v -> Nonce
mkNonceFromOutputVRF =
  Hash Blake2b_256 Nonce -> Nonce
Nonce
    (Hash Blake2b_256 Nonce -> Nonce)
-> (OutputVRF v -> Hash Blake2b_256 Nonce) -> OutputVRF v -> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall v. Hash Blake2b_256 (OutputVRF v) -> Hash Blake2b_256 Nonce
forall h a b. Hash h a -> Hash h b
castHash :: Hash Blake2b_256 (VRF.OutputVRF v) -> Hash Blake2b_256 Nonce)
    (Hash Blake2b_256 (OutputVRF v) -> Hash Blake2b_256 Nonce)
-> (OutputVRF v -> Hash Blake2b_256 (OutputVRF v))
-> OutputVRF v
-> Hash Blake2b_256 Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OutputVRF v -> ByteString)
-> OutputVRF v -> Hash Blake2b_256 (OutputVRF v)
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith OutputVRF v -> ByteString
forall v. OutputVRF v -> ByteString
VRF.getOutputVRFBytes

-- | Make a nonce from a number.
mkNonceFromNumber :: Word64 -> Nonce
mkNonceFromNumber :: Word64 -> Nonce
mkNonceFromNumber =
  Hash Blake2b_256 Nonce -> Nonce
Nonce
    (Hash Blake2b_256 Nonce -> Nonce)
-> (Word64 -> Hash Blake2b_256 Nonce) -> Word64 -> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hash Blake2b_256 Word64 -> Hash Blake2b_256 Nonce
forall h a b. Hash h a -> Hash h b
castHash :: Hash Blake2b_256 Word64 -> Hash Blake2b_256 Nonce)
    (Hash Blake2b_256 Word64 -> Hash Blake2b_256 Nonce)
-> (Word64 -> Hash Blake2b_256 Word64)
-> Word64
-> Hash Blake2b_256 Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> ByteString) -> Word64 -> Hash Blake2b_256 Word64
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith (ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Word64 -> ByteString) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
B.runPut (Put -> ByteString) -> (Word64 -> Put) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Put
B.putWord64be)

-- | Seed to the verifiable random function.
--
--   We do not expose the constructor to `Seed`. Instead, a `Seed` should be
--   created using `mkSeed` for a VRF calculation.
newtype Seed = Seed (Hash Blake2b_256 Seed)
  deriving (Seed -> Seed -> Bool
(Seed -> Seed -> Bool) -> (Seed -> Seed -> Bool) -> Eq Seed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seed -> Seed -> Bool
$c/= :: Seed -> Seed -> Bool
== :: Seed -> Seed -> Bool
$c== :: Seed -> Seed -> Bool
Eq, Eq Seed
Eq Seed
-> (Seed -> Seed -> Ordering)
-> (Seed -> Seed -> Bool)
-> (Seed -> Seed -> Bool)
-> (Seed -> Seed -> Bool)
-> (Seed -> Seed -> Bool)
-> (Seed -> Seed -> Seed)
-> (Seed -> Seed -> Seed)
-> Ord Seed
Seed -> Seed -> Bool
Seed -> Seed -> Ordering
Seed -> Seed -> Seed
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 :: Seed -> Seed -> Seed
$cmin :: Seed -> Seed -> Seed
max :: Seed -> Seed -> Seed
$cmax :: Seed -> Seed -> Seed
>= :: Seed -> Seed -> Bool
$c>= :: Seed -> Seed -> Bool
> :: Seed -> Seed -> Bool
$c> :: Seed -> Seed -> Bool
<= :: Seed -> Seed -> Bool
$c<= :: Seed -> Seed -> Bool
< :: Seed -> Seed -> Bool
$c< :: Seed -> Seed -> Bool
compare :: Seed -> Seed -> Ordering
$ccompare :: Seed -> Seed -> Ordering
$cp1Ord :: Eq Seed
Ord, Int -> Seed -> ShowS
[Seed] -> ShowS
Seed -> String
(Int -> Seed -> ShowS)
-> (Seed -> String) -> ([Seed] -> ShowS) -> Show Seed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seed] -> ShowS
$cshowList :: [Seed] -> ShowS
show :: Seed -> String
$cshow :: Seed -> String
showsPrec :: Int -> Seed -> ShowS
$cshowsPrec :: Int -> Seed -> ShowS
Show, (forall x. Seed -> Rep Seed x)
-> (forall x. Rep Seed x -> Seed) -> Generic Seed
forall x. Rep Seed x -> Seed
forall x. Seed -> Rep Seed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Seed x -> Seed
$cfrom :: forall x. Seed -> Rep Seed x
Generic)
  deriving newtype (Context -> Seed -> IO (Maybe ThunkInfo)
Proxy Seed -> String
(Context -> Seed -> IO (Maybe ThunkInfo))
-> (Context -> Seed -> IO (Maybe ThunkInfo))
-> (Proxy Seed -> String)
-> NoThunks Seed
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy Seed -> String
$cshowTypeOf :: Proxy Seed -> String
wNoThunks :: Context -> Seed -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Seed -> IO (Maybe ThunkInfo)
noThunks :: Context -> Seed -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Seed -> IO (Maybe ThunkInfo)
NoThunks, Typeable Seed
Typeable Seed
-> (Seed -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy Seed -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Seed] -> Size)
-> ToCBOR Seed
Seed -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Seed] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy Seed -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Seed] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Seed] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Seed -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Seed -> Size
toCBOR :: Seed -> Encoding
$ctoCBOR :: Seed -> Encoding
$cp1ToCBOR :: Typeable Seed
ToCBOR)

instance SignableRepresentation Seed where
  getSignableRepresentation :: Seed -> ByteString
getSignableRepresentation (Seed Hash Blake2b_256 Seed
x) = Hash Blake2b_256 Seed -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash Blake2b_256 Seed
x

(==>) :: Bool -> Bool -> Bool
Bool
a ==> :: Bool -> Bool -> Bool
==> Bool
b = Bool -> Bool
not Bool
a Bool -> Bool -> Bool
|| Bool
b

infix 1 ==>

-- | Strict 'Maybe'.
--
-- TODO move to @cardano-prelude@
data StrictMaybe a
  = SNothing
  | SJust !a
  deriving (StrictMaybe a -> StrictMaybe a -> Bool
(StrictMaybe a -> StrictMaybe a -> Bool)
-> (StrictMaybe a -> StrictMaybe a -> Bool) -> Eq (StrictMaybe a)
forall a. Eq a => StrictMaybe a -> StrictMaybe a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StrictMaybe a -> StrictMaybe a -> Bool
$c/= :: forall a. Eq a => StrictMaybe a -> StrictMaybe a -> Bool
== :: StrictMaybe a -> StrictMaybe a -> Bool
$c== :: forall a. Eq a => StrictMaybe a -> StrictMaybe a -> Bool
Eq, Eq (StrictMaybe a)
Eq (StrictMaybe a)
-> (StrictMaybe a -> StrictMaybe a -> Ordering)
-> (StrictMaybe a -> StrictMaybe a -> Bool)
-> (StrictMaybe a -> StrictMaybe a -> Bool)
-> (StrictMaybe a -> StrictMaybe a -> Bool)
-> (StrictMaybe a -> StrictMaybe a -> Bool)
-> (StrictMaybe a -> StrictMaybe a -> StrictMaybe a)
-> (StrictMaybe a -> StrictMaybe a -> StrictMaybe a)
-> Ord (StrictMaybe a)
StrictMaybe a -> StrictMaybe a -> Bool
StrictMaybe a -> StrictMaybe a -> Ordering
StrictMaybe a -> StrictMaybe a -> StrictMaybe a
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 a. Ord a => Eq (StrictMaybe a)
forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Bool
forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Ordering
forall a. Ord a => StrictMaybe a -> StrictMaybe a -> StrictMaybe a
min :: StrictMaybe a -> StrictMaybe a -> StrictMaybe a
$cmin :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> StrictMaybe a
max :: StrictMaybe a -> StrictMaybe a -> StrictMaybe a
$cmax :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> StrictMaybe a
>= :: StrictMaybe a -> StrictMaybe a -> Bool
$c>= :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Bool
> :: StrictMaybe a -> StrictMaybe a -> Bool
$c> :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Bool
<= :: StrictMaybe a -> StrictMaybe a -> Bool
$c<= :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Bool
< :: StrictMaybe a -> StrictMaybe a -> Bool
$c< :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Bool
compare :: StrictMaybe a -> StrictMaybe a -> Ordering
$ccompare :: forall a. Ord a => StrictMaybe a -> StrictMaybe a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (StrictMaybe a)
Ord, Int -> StrictMaybe a -> ShowS
[StrictMaybe a] -> ShowS
StrictMaybe a -> String
(Int -> StrictMaybe a -> ShowS)
-> (StrictMaybe a -> String)
-> ([StrictMaybe a] -> ShowS)
-> Show (StrictMaybe a)
forall a. Show a => Int -> StrictMaybe a -> ShowS
forall a. Show a => [StrictMaybe a] -> ShowS
forall a. Show a => StrictMaybe a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StrictMaybe a] -> ShowS
$cshowList :: forall a. Show a => [StrictMaybe a] -> ShowS
show :: StrictMaybe a -> String
$cshow :: forall a. Show a => StrictMaybe a -> String
showsPrec :: Int -> StrictMaybe a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StrictMaybe a -> ShowS
Show, (forall x. StrictMaybe a -> Rep (StrictMaybe a) x)
-> (forall x. Rep (StrictMaybe a) x -> StrictMaybe a)
-> Generic (StrictMaybe a)
forall x. Rep (StrictMaybe a) x -> StrictMaybe a
forall x. StrictMaybe a -> Rep (StrictMaybe a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (StrictMaybe a) x -> StrictMaybe a
forall a x. StrictMaybe a -> Rep (StrictMaybe a) x
$cto :: forall a x. Rep (StrictMaybe a) x -> StrictMaybe a
$cfrom :: forall a x. StrictMaybe a -> Rep (StrictMaybe a) x
Generic, a -> StrictMaybe b -> StrictMaybe a
(a -> b) -> StrictMaybe a -> StrictMaybe b
(forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b)
-> (forall a b. a -> StrictMaybe b -> StrictMaybe a)
-> Functor StrictMaybe
forall a b. a -> StrictMaybe b -> StrictMaybe a
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StrictMaybe b -> StrictMaybe a
$c<$ :: forall a b. a -> StrictMaybe b -> StrictMaybe a
fmap :: (a -> b) -> StrictMaybe a -> StrictMaybe b
$cfmap :: forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
Functor, StrictMaybe a -> Bool
(a -> m) -> StrictMaybe a -> m
(a -> b -> b) -> b -> StrictMaybe a -> b
(forall m. Monoid m => StrictMaybe m -> m)
-> (forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m)
-> (forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m)
-> (forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b)
-> (forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b)
-> (forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b)
-> (forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b)
-> (forall a. (a -> a -> a) -> StrictMaybe a -> a)
-> (forall a. (a -> a -> a) -> StrictMaybe a -> a)
-> (forall a. StrictMaybe a -> [a])
-> (forall a. StrictMaybe a -> Bool)
-> (forall a. StrictMaybe a -> Int)
-> (forall a. Eq a => a -> StrictMaybe a -> Bool)
-> (forall a. Ord a => StrictMaybe a -> a)
-> (forall a. Ord a => StrictMaybe a -> a)
-> (forall a. Num a => StrictMaybe a -> a)
-> (forall a. Num a => StrictMaybe a -> a)
-> Foldable StrictMaybe
forall a. Eq a => a -> StrictMaybe a -> Bool
forall a. Num a => StrictMaybe a -> a
forall a. Ord a => StrictMaybe a -> a
forall m. Monoid m => StrictMaybe m -> m
forall a. StrictMaybe a -> Bool
forall a. StrictMaybe a -> Int
forall a. StrictMaybe a -> [a]
forall a. (a -> a -> a) -> StrictMaybe a -> a
forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b
forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: StrictMaybe a -> a
$cproduct :: forall a. Num a => StrictMaybe a -> a
sum :: StrictMaybe a -> a
$csum :: forall a. Num a => StrictMaybe a -> a
minimum :: StrictMaybe a -> a
$cminimum :: forall a. Ord a => StrictMaybe a -> a
maximum :: StrictMaybe a -> a
$cmaximum :: forall a. Ord a => StrictMaybe a -> a
elem :: a -> StrictMaybe a -> Bool
$celem :: forall a. Eq a => a -> StrictMaybe a -> Bool
length :: StrictMaybe a -> Int
$clength :: forall a. StrictMaybe a -> Int
null :: StrictMaybe a -> Bool
$cnull :: forall a. StrictMaybe a -> Bool
toList :: StrictMaybe a -> [a]
$ctoList :: forall a. StrictMaybe a -> [a]
foldl1 :: (a -> a -> a) -> StrictMaybe a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> StrictMaybe a -> a
foldr1 :: (a -> a -> a) -> StrictMaybe a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> StrictMaybe a -> a
foldl' :: (b -> a -> b) -> b -> StrictMaybe a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b
foldl :: (b -> a -> b) -> b -> StrictMaybe a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> StrictMaybe a -> b
foldr' :: (a -> b -> b) -> b -> StrictMaybe a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b
foldr :: (a -> b -> b) -> b -> StrictMaybe a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> StrictMaybe a -> b
foldMap' :: (a -> m) -> StrictMaybe a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
foldMap :: (a -> m) -> StrictMaybe a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
fold :: StrictMaybe m -> m
$cfold :: forall m. Monoid m => StrictMaybe m -> m
Foldable, Functor StrictMaybe
Foldable StrictMaybe
Functor StrictMaybe
-> Foldable StrictMaybe
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> StrictMaybe a -> f (StrictMaybe b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    StrictMaybe (f a) -> f (StrictMaybe a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> StrictMaybe a -> m (StrictMaybe b))
-> (forall (m :: * -> *) a.
    Monad m =>
    StrictMaybe (m a) -> m (StrictMaybe a))
-> Traversable StrictMaybe
(a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
StrictMaybe (m a) -> m (StrictMaybe a)
forall (f :: * -> *) a.
Applicative f =>
StrictMaybe (f a) -> f (StrictMaybe a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StrictMaybe a -> m (StrictMaybe b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
sequence :: StrictMaybe (m a) -> m (StrictMaybe a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
StrictMaybe (m a) -> m (StrictMaybe a)
mapM :: (a -> m b) -> StrictMaybe a -> m (StrictMaybe b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StrictMaybe a -> m (StrictMaybe b)
sequenceA :: StrictMaybe (f a) -> f (StrictMaybe a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
StrictMaybe (f a) -> f (StrictMaybe a)
traverse :: (a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
$cp2Traversable :: Foldable StrictMaybe
$cp1Traversable :: Functor StrictMaybe
Traversable)

instance NoThunks a => NoThunks (StrictMaybe a)

instance NFData a => NFData (StrictMaybe a)

instance Applicative StrictMaybe where
  pure :: a -> StrictMaybe a
pure = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust

  SJust a -> b
f <*> :: StrictMaybe (a -> b) -> StrictMaybe a -> StrictMaybe b
<*> StrictMaybe a
m = (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f StrictMaybe a
m
  StrictMaybe (a -> b)
SNothing <*> StrictMaybe a
_m = StrictMaybe b
forall a. StrictMaybe a
SNothing

  SJust a
_m1 *> :: StrictMaybe a -> StrictMaybe b -> StrictMaybe b
*> StrictMaybe b
m2 = StrictMaybe b
m2
  StrictMaybe a
SNothing *> StrictMaybe b
_m2 = StrictMaybe b
forall a. StrictMaybe a
SNothing

instance Monad StrictMaybe where
  SJust a
x >>= :: StrictMaybe a -> (a -> StrictMaybe b) -> StrictMaybe b
>>= a -> StrictMaybe b
k = a -> StrictMaybe b
k a
x
  StrictMaybe a
SNothing >>= a -> StrictMaybe b
_ = StrictMaybe b
forall a. StrictMaybe a
SNothing

  >> :: StrictMaybe a -> StrictMaybe b -> StrictMaybe b
(>>) = StrictMaybe a -> StrictMaybe b -> StrictMaybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

  return :: a -> StrictMaybe a
return = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust

instance Control.Monad.Fail.MonadFail StrictMaybe where
  fail :: String -> StrictMaybe a
fail String
_ = StrictMaybe a
forall a. StrictMaybe a
SNothing

instance ToCBOR a => ToCBOR (StrictMaybe a) where
  toCBOR :: StrictMaybe a -> Encoding
toCBOR StrictMaybe a
SNothing = Word -> Encoding
encodeListLen Word
0
  toCBOR (SJust a
x) = Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
x

instance FromCBOR a => FromCBOR (StrictMaybe a) where
  fromCBOR :: Decoder s (StrictMaybe a)
fromCBOR = do
    Maybe Int
maybeN <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
    case Maybe Int
maybeN of
      Just Int
0 -> StrictMaybe a -> Decoder s (StrictMaybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe a
forall a. StrictMaybe a
SNothing
      Just Int
1 -> a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust (a -> StrictMaybe a) -> Decoder s a -> Decoder s (StrictMaybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Just Int
_ -> String -> Decoder s (StrictMaybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too many elements in length-style decoding of StrictMaybe."
      Maybe Int
Nothing -> do
        Bool
isBreak <- Decoder s Bool
forall s. Decoder s Bool
decodeBreakOr
        if Bool
isBreak
          then StrictMaybe a -> Decoder s (StrictMaybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe a
forall a. StrictMaybe a
SNothing
          else do
            a
x <- Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
            Bool
isBreak2 <- Decoder s Bool
forall s. Decoder s Bool
decodeBreakOr
            if Bool
isBreak2
              then StrictMaybe a -> Decoder s (StrictMaybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
x)
              else String -> Decoder s (StrictMaybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too many elements in break-style decoding of StrictMaybe."

instance ToJSON a => ToJSON (StrictMaybe a) where
  toJSON :: StrictMaybe a -> Value
toJSON = Maybe a -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe a -> Value)
-> (StrictMaybe a -> Maybe a) -> StrictMaybe a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe a -> Maybe a
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe

instance FromJSON a => FromJSON (StrictMaybe a) where
  parseJSON :: Value -> Parser (StrictMaybe a)
parseJSON Value
v = Maybe a -> StrictMaybe a
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe a -> StrictMaybe a)
-> Parser (Maybe a) -> Parser (StrictMaybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Maybe a)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

strictMaybeToMaybe :: StrictMaybe a -> Maybe a
strictMaybeToMaybe :: StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe a
SNothing = Maybe a
forall a. Maybe a
Nothing
strictMaybeToMaybe (SJust a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

maybeToStrictMaybe :: Maybe a -> StrictMaybe a
maybeToStrictMaybe :: Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe a
Nothing = StrictMaybe a
forall a. StrictMaybe a
SNothing
maybeToStrictMaybe (Just a
x) = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
x

fromSMaybe :: a -> StrictMaybe a -> a
fromSMaybe :: a -> StrictMaybe a -> a
fromSMaybe a
d StrictMaybe a
SNothing = a
d
fromSMaybe a
_ (SJust a
x) = a
x

--
-- Helper functions for text with a 64 byte bound
--

text64 :: Text -> Maybe Text
text64 :: Text -> Maybe Text
text64 Text
t =
  if (ByteString -> Int
BS.length (ByteString -> Int) -> (Text -> ByteString) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8) Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64
    then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
    else Maybe Text
forall a. Maybe a
Nothing

text64FromCBOR :: Decoder s Text
text64FromCBOR :: Decoder s Text
text64FromCBOR = do
  Text
t <- Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR
  if (ByteString -> Int
BS.length (ByteString -> Int) -> (Text -> ByteString) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8) Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64
    then DecoderError -> Decoder s Text
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s Text) -> DecoderError -> Decoder s Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"text exceeds 64 bytes:" Text
t
    else Text -> Decoder s Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

--
-- Types used in the Stake Pool Relays
--

newtype Url = Url {Url -> Text
urlToText :: Text}
  deriving (Url -> Url -> Bool
(Url -> Url -> Bool) -> (Url -> Url -> Bool) -> Eq Url
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Url -> Url -> Bool
$c/= :: Url -> Url -> Bool
== :: Url -> Url -> Bool
$c== :: Url -> Url -> Bool
Eq, Eq Url
Eq Url
-> (Url -> Url -> Ordering)
-> (Url -> Url -> Bool)
-> (Url -> Url -> Bool)
-> (Url -> Url -> Bool)
-> (Url -> Url -> Bool)
-> (Url -> Url -> Url)
-> (Url -> Url -> Url)
-> Ord Url
Url -> Url -> Bool
Url -> Url -> Ordering
Url -> Url -> Url
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 :: Url -> Url -> Url
$cmin :: Url -> Url -> Url
max :: Url -> Url -> Url
$cmax :: Url -> Url -> Url
>= :: Url -> Url -> Bool
$c>= :: Url -> Url -> Bool
> :: Url -> Url -> Bool
$c> :: Url -> Url -> Bool
<= :: Url -> Url -> Bool
$c<= :: Url -> Url -> Bool
< :: Url -> Url -> Bool
$c< :: Url -> Url -> Bool
compare :: Url -> Url -> Ordering
$ccompare :: Url -> Url -> Ordering
$cp1Ord :: Eq Url
Ord, (forall x. Url -> Rep Url x)
-> (forall x. Rep Url x -> Url) -> Generic Url
forall x. Rep Url x -> Url
forall x. Url -> Rep Url x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Url x -> Url
$cfrom :: forall x. Url -> Rep Url x
Generic, Int -> Url -> ShowS
[Url] -> ShowS
Url -> String
(Int -> Url -> ShowS)
-> (Url -> String) -> ([Url] -> ShowS) -> Show Url
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Url] -> ShowS
$cshowList :: [Url] -> ShowS
show :: Url -> String
$cshow :: Url -> String
showsPrec :: Int -> Url -> ShowS
$cshowsPrec :: Int -> Url -> ShowS
Show)
  deriving newtype (Typeable Url
Typeable Url
-> (Url -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy Url -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Url] -> Size)
-> ToCBOR Url
Url -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Url] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy Url -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Url] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Url] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Url -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Url -> Size
toCBOR :: Url -> Encoding
$ctoCBOR :: Url -> Encoding
$cp1ToCBOR :: Typeable Url
ToCBOR, Url -> ()
(Url -> ()) -> NFData Url
forall a. (a -> ()) -> NFData a
rnf :: Url -> ()
$crnf :: Url -> ()
NFData, Context -> Url -> IO (Maybe ThunkInfo)
Proxy Url -> String
(Context -> Url -> IO (Maybe ThunkInfo))
-> (Context -> Url -> IO (Maybe ThunkInfo))
-> (Proxy Url -> String)
-> NoThunks Url
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy Url -> String
$cshowTypeOf :: Proxy Url -> String
wNoThunks :: Context -> Url -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Url -> IO (Maybe ThunkInfo)
noThunks :: Context -> Url -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Url -> IO (Maybe ThunkInfo)
NoThunks, Value -> Parser [Url]
Value -> Parser Url
(Value -> Parser Url) -> (Value -> Parser [Url]) -> FromJSON Url
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Url]
$cparseJSONList :: Value -> Parser [Url]
parseJSON :: Value -> Parser Url
$cparseJSON :: Value -> Parser Url
FromJSON, [Url] -> Encoding
[Url] -> Value
Url -> Encoding
Url -> Value
(Url -> Value)
-> (Url -> Encoding)
-> ([Url] -> Value)
-> ([Url] -> Encoding)
-> ToJSON Url
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Url] -> Encoding
$ctoEncodingList :: [Url] -> Encoding
toJSONList :: [Url] -> Value
$ctoJSONList :: [Url] -> Value
toEncoding :: Url -> Encoding
$ctoEncoding :: Url -> Encoding
toJSON :: Url -> Value
$ctoJSON :: Url -> Value
ToJSON)

textToUrl :: Text -> Maybe Url
textToUrl :: Text -> Maybe Url
textToUrl Text
t = Text -> Url
Url (Text -> Url) -> Maybe Text -> Maybe Url
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
text64 Text
t

instance FromCBOR Url where
  fromCBOR :: Decoder s Url
fromCBOR = Text -> Url
Url (Text -> Url) -> Decoder s Text -> Decoder s Url
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
text64FromCBOR

newtype DnsName = DnsName {DnsName -> Text
dnsToText :: Text}
  deriving (DnsName -> DnsName -> Bool
(DnsName -> DnsName -> Bool)
-> (DnsName -> DnsName -> Bool) -> Eq DnsName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DnsName -> DnsName -> Bool
$c/= :: DnsName -> DnsName -> Bool
== :: DnsName -> DnsName -> Bool
$c== :: DnsName -> DnsName -> Bool
Eq, Eq DnsName
Eq DnsName
-> (DnsName -> DnsName -> Ordering)
-> (DnsName -> DnsName -> Bool)
-> (DnsName -> DnsName -> Bool)
-> (DnsName -> DnsName -> Bool)
-> (DnsName -> DnsName -> Bool)
-> (DnsName -> DnsName -> DnsName)
-> (DnsName -> DnsName -> DnsName)
-> Ord DnsName
DnsName -> DnsName -> Bool
DnsName -> DnsName -> Ordering
DnsName -> DnsName -> DnsName
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 :: DnsName -> DnsName -> DnsName
$cmin :: DnsName -> DnsName -> DnsName
max :: DnsName -> DnsName -> DnsName
$cmax :: DnsName -> DnsName -> DnsName
>= :: DnsName -> DnsName -> Bool
$c>= :: DnsName -> DnsName -> Bool
> :: DnsName -> DnsName -> Bool
$c> :: DnsName -> DnsName -> Bool
<= :: DnsName -> DnsName -> Bool
$c<= :: DnsName -> DnsName -> Bool
< :: DnsName -> DnsName -> Bool
$c< :: DnsName -> DnsName -> Bool
compare :: DnsName -> DnsName -> Ordering
$ccompare :: DnsName -> DnsName -> Ordering
$cp1Ord :: Eq DnsName
Ord, (forall x. DnsName -> Rep DnsName x)
-> (forall x. Rep DnsName x -> DnsName) -> Generic DnsName
forall x. Rep DnsName x -> DnsName
forall x. DnsName -> Rep DnsName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DnsName x -> DnsName
$cfrom :: forall x. DnsName -> Rep DnsName x
Generic, Int -> DnsName -> ShowS
[DnsName] -> ShowS
DnsName -> String
(Int -> DnsName -> ShowS)
-> (DnsName -> String) -> ([DnsName] -> ShowS) -> Show DnsName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DnsName] -> ShowS
$cshowList :: [DnsName] -> ShowS
show :: DnsName -> String
$cshow :: DnsName -> String
showsPrec :: Int -> DnsName -> ShowS
$cshowsPrec :: Int -> DnsName -> ShowS
Show)
  deriving newtype (Typeable DnsName
Typeable DnsName
-> (DnsName -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy DnsName -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [DnsName] -> Size)
-> ToCBOR DnsName
DnsName -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [DnsName] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy DnsName -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [DnsName] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [DnsName] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy DnsName -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy DnsName -> Size
toCBOR :: DnsName -> Encoding
$ctoCBOR :: DnsName -> Encoding
$cp1ToCBOR :: Typeable DnsName
ToCBOR, Context -> DnsName -> IO (Maybe ThunkInfo)
Proxy DnsName -> String
(Context -> DnsName -> IO (Maybe ThunkInfo))
-> (Context -> DnsName -> IO (Maybe ThunkInfo))
-> (Proxy DnsName -> String)
-> NoThunks DnsName
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy DnsName -> String
$cshowTypeOf :: Proxy DnsName -> String
wNoThunks :: Context -> DnsName -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> DnsName -> IO (Maybe ThunkInfo)
noThunks :: Context -> DnsName -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> DnsName -> IO (Maybe ThunkInfo)
NoThunks, DnsName -> ()
(DnsName -> ()) -> NFData DnsName
forall a. (a -> ()) -> NFData a
rnf :: DnsName -> ()
$crnf :: DnsName -> ()
NFData, Value -> Parser [DnsName]
Value -> Parser DnsName
(Value -> Parser DnsName)
-> (Value -> Parser [DnsName]) -> FromJSON DnsName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [DnsName]
$cparseJSONList :: Value -> Parser [DnsName]
parseJSON :: Value -> Parser DnsName
$cparseJSON :: Value -> Parser DnsName
FromJSON, [DnsName] -> Encoding
[DnsName] -> Value
DnsName -> Encoding
DnsName -> Value
(DnsName -> Value)
-> (DnsName -> Encoding)
-> ([DnsName] -> Value)
-> ([DnsName] -> Encoding)
-> ToJSON DnsName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [DnsName] -> Encoding
$ctoEncodingList :: [DnsName] -> Encoding
toJSONList :: [DnsName] -> Value
$ctoJSONList :: [DnsName] -> Value
toEncoding :: DnsName -> Encoding
$ctoEncoding :: DnsName -> Encoding
toJSON :: DnsName -> Value
$ctoJSON :: DnsName -> Value
ToJSON)

textToDns :: Text -> Maybe DnsName
textToDns :: Text -> Maybe DnsName
textToDns Text
t = Text -> DnsName
DnsName (Text -> DnsName) -> Maybe Text -> Maybe DnsName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
text64 Text
t

instance FromCBOR DnsName where
  fromCBOR :: Decoder s DnsName
fromCBOR = Text -> DnsName
DnsName (Text -> DnsName) -> Decoder s Text -> Decoder s DnsName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
text64FromCBOR

newtype Port = Port {Port -> Word16
portToWord16 :: Word16}
  deriving (Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c== :: Port -> Port -> Bool
Eq, Eq Port
Eq Port
-> (Port -> Port -> Ordering)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> Ord Port
Port -> Port -> Bool
Port -> Port -> Ordering
Port -> Port -> Port
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 :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmax :: Port -> Port -> Port
>= :: Port -> Port -> Bool
$c>= :: Port -> Port -> Bool
> :: Port -> Port -> Bool
$c> :: Port -> Port -> Bool
<= :: Port -> Port -> Bool
$c<= :: Port -> Port -> Bool
< :: Port -> Port -> Bool
$c< :: Port -> Port -> Bool
compare :: Port -> Port -> Ordering
$ccompare :: Port -> Port -> Ordering
$cp1Ord :: Eq Port
Ord, (forall x. Port -> Rep Port x)
-> (forall x. Rep Port x -> Port) -> Generic Port
forall x. Rep Port x -> Port
forall x. Port -> Rep Port x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Port x -> Port
$cfrom :: forall x. Port -> Rep Port x
Generic, Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
(Int -> Port -> ShowS)
-> (Port -> String) -> ([Port] -> ShowS) -> Show Port
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Port] -> ShowS
$cshowList :: [Port] -> ShowS
show :: Port -> String
$cshow :: Port -> String
showsPrec :: Int -> Port -> ShowS
$cshowsPrec :: Int -> Port -> ShowS
Show)
  deriving newtype (Integer -> Port
Port -> Port
Port -> Port -> Port
(Port -> Port -> Port)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> (Port -> Port)
-> (Port -> Port)
-> (Port -> Port)
-> (Integer -> Port)
-> Num Port
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Port
$cfromInteger :: Integer -> Port
signum :: Port -> Port
$csignum :: Port -> Port
abs :: Port -> Port
$cabs :: Port -> Port
negate :: Port -> Port
$cnegate :: Port -> Port
* :: Port -> Port -> Port
$c* :: Port -> Port -> Port
- :: Port -> Port -> Port
$c- :: Port -> Port -> Port
+ :: Port -> Port -> Port
$c+ :: Port -> Port -> Port
Num, Typeable Port
Decoder s Port
Typeable Port
-> (forall s. Decoder s Port)
-> (Proxy Port -> Text)
-> FromCBOR Port
Proxy Port -> Text
forall s. Decoder s Port
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy Port -> Text
$clabel :: Proxy Port -> Text
fromCBOR :: Decoder s Port
$cfromCBOR :: forall s. Decoder s Port
$cp1FromCBOR :: Typeable Port
FromCBOR, Typeable Port
Typeable Port
-> (Port -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy Port -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Port] -> Size)
-> ToCBOR Port
Port -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Port] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy Port -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Port] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Port] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Port -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Port -> Size
toCBOR :: Port -> Encoding
$ctoCBOR :: Port -> Encoding
$cp1ToCBOR :: Typeable Port
ToCBOR, Port -> ()
(Port -> ()) -> NFData Port
forall a. (a -> ()) -> NFData a
rnf :: Port -> ()
$crnf :: Port -> ()
NFData, Context -> Port -> IO (Maybe ThunkInfo)
Proxy Port -> String
(Context -> Port -> IO (Maybe ThunkInfo))
-> (Context -> Port -> IO (Maybe ThunkInfo))
-> (Proxy Port -> String)
-> NoThunks Port
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy Port -> String
$cshowTypeOf :: Proxy Port -> String
wNoThunks :: Context -> Port -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Port -> IO (Maybe ThunkInfo)
noThunks :: Context -> Port -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Port -> IO (Maybe ThunkInfo)
NoThunks, [Port] -> Encoding
[Port] -> Value
Port -> Encoding
Port -> Value
(Port -> Value)
-> (Port -> Encoding)
-> ([Port] -> Value)
-> ([Port] -> Encoding)
-> ToJSON Port
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Port] -> Encoding
$ctoEncodingList :: [Port] -> Encoding
toJSONList :: [Port] -> Value
$ctoJSONList :: [Port] -> Value
toEncoding :: Port -> Encoding
$ctoEncoding :: Port -> Encoding
toJSON :: Port -> Value
$ctoJSON :: Port -> Value
ToJSON, Value -> Parser [Port]
Value -> Parser Port
(Value -> Parser Port) -> (Value -> Parser [Port]) -> FromJSON Port
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Port]
$cparseJSONList :: Value -> Parser [Port]
parseJSON :: Value -> Parser Port
$cparseJSON :: Value -> Parser Port
FromJSON)

--------------------------------------------------------------------------------
-- Active Slot Coefficent, named f in
-- "Ouroboros Praos: An adaptively-secure, semi-synchronous proof-of-stake protocol"
--------------------------------------------------------------------------------

data ActiveSlotCoeff = ActiveSlotCoeff
  { ActiveSlotCoeff -> UnitInterval
unActiveSlotVal :: !UnitInterval,
    ActiveSlotCoeff -> Integer
unActiveSlotLog :: !Integer -- TODO mgudemann make this FixedPoint,
    -- currently a problem because of
    -- NoThunks instance for FixedPoint
  }
  deriving (ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
(ActiveSlotCoeff -> ActiveSlotCoeff -> Bool)
-> (ActiveSlotCoeff -> ActiveSlotCoeff -> Bool)
-> Eq ActiveSlotCoeff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
$c/= :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
== :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
$c== :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
Eq, Eq ActiveSlotCoeff
Eq ActiveSlotCoeff
-> (ActiveSlotCoeff -> ActiveSlotCoeff -> Ordering)
-> (ActiveSlotCoeff -> ActiveSlotCoeff -> Bool)
-> (ActiveSlotCoeff -> ActiveSlotCoeff -> Bool)
-> (ActiveSlotCoeff -> ActiveSlotCoeff -> Bool)
-> (ActiveSlotCoeff -> ActiveSlotCoeff -> Bool)
-> (ActiveSlotCoeff -> ActiveSlotCoeff -> ActiveSlotCoeff)
-> (ActiveSlotCoeff -> ActiveSlotCoeff -> ActiveSlotCoeff)
-> Ord ActiveSlotCoeff
ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
ActiveSlotCoeff -> ActiveSlotCoeff -> Ordering
ActiveSlotCoeff -> ActiveSlotCoeff -> ActiveSlotCoeff
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 :: ActiveSlotCoeff -> ActiveSlotCoeff -> ActiveSlotCoeff
$cmin :: ActiveSlotCoeff -> ActiveSlotCoeff -> ActiveSlotCoeff
max :: ActiveSlotCoeff -> ActiveSlotCoeff -> ActiveSlotCoeff
$cmax :: ActiveSlotCoeff -> ActiveSlotCoeff -> ActiveSlotCoeff
>= :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
$c>= :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
> :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
$c> :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
<= :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
$c<= :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
< :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
$c< :: ActiveSlotCoeff -> ActiveSlotCoeff -> Bool
compare :: ActiveSlotCoeff -> ActiveSlotCoeff -> Ordering
$ccompare :: ActiveSlotCoeff -> ActiveSlotCoeff -> Ordering
$cp1Ord :: Eq ActiveSlotCoeff
Ord, Int -> ActiveSlotCoeff -> ShowS
[ActiveSlotCoeff] -> ShowS
ActiveSlotCoeff -> String
(Int -> ActiveSlotCoeff -> ShowS)
-> (ActiveSlotCoeff -> String)
-> ([ActiveSlotCoeff] -> ShowS)
-> Show ActiveSlotCoeff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActiveSlotCoeff] -> ShowS
$cshowList :: [ActiveSlotCoeff] -> ShowS
show :: ActiveSlotCoeff -> String
$cshow :: ActiveSlotCoeff -> String
showsPrec :: Int -> ActiveSlotCoeff -> ShowS
$cshowsPrec :: Int -> ActiveSlotCoeff -> ShowS
Show, (forall x. ActiveSlotCoeff -> Rep ActiveSlotCoeff x)
-> (forall x. Rep ActiveSlotCoeff x -> ActiveSlotCoeff)
-> Generic ActiveSlotCoeff
forall x. Rep ActiveSlotCoeff x -> ActiveSlotCoeff
forall x. ActiveSlotCoeff -> Rep ActiveSlotCoeff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActiveSlotCoeff x -> ActiveSlotCoeff
$cfrom :: forall x. ActiveSlotCoeff -> Rep ActiveSlotCoeff x
Generic)

instance NoThunks ActiveSlotCoeff

instance FromCBOR ActiveSlotCoeff where
  fromCBOR :: Decoder s ActiveSlotCoeff
fromCBOR = do
    UnitInterval
v <- Decoder s UnitInterval
forall a s. FromCBOR a => Decoder s a
fromCBOR
    ActiveSlotCoeff -> Decoder s ActiveSlotCoeff
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActiveSlotCoeff -> Decoder s ActiveSlotCoeff)
-> ActiveSlotCoeff -> Decoder s ActiveSlotCoeff
forall a b. (a -> b) -> a -> b
$ UnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff UnitInterval
v

instance ToCBOR ActiveSlotCoeff where
  toCBOR :: ActiveSlotCoeff -> Encoding
toCBOR
    ( ActiveSlotCoeff
        { unActiveSlotVal :: ActiveSlotCoeff -> UnitInterval
unActiveSlotVal = UnitInterval
slotVal,
          unActiveSlotLog :: ActiveSlotCoeff -> Integer
unActiveSlotLog = Integer
_logVal
        }
      ) =
      UnitInterval -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR UnitInterval
slotVal

mkActiveSlotCoeff :: UnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff :: UnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff UnitInterval
v =
  ActiveSlotCoeff :: UnitInterval -> Integer -> ActiveSlotCoeff
ActiveSlotCoeff
    { unActiveSlotVal :: UnitInterval
unActiveSlotVal = UnitInterval
v,
      unActiveSlotLog :: Integer
unActiveSlotLog =
        if (UnitInterval -> Ratio Word64
intervalValue UnitInterval
v) Ratio Word64 -> Ratio Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Word64
1
          then -- If the active slot coefficient is equal to one,
          -- then nearly every stake pool can produce a block every slot.
          -- In this degenerate case, where ln (1-f) is not defined,
          -- we set the unActiveSlotLog to zero.
            Integer
0
          else
            FixedPoint -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor
              ( FixedPoint
fpPrecision
                  FixedPoint -> FixedPoint -> FixedPoint
forall a. Num a => a -> a -> a
* ( FixedPoint -> FixedPoint
forall a. (RealFrac a, Enum a, Show a) => a -> a
ln' (FixedPoint -> FixedPoint) -> FixedPoint -> FixedPoint
forall a b. (a -> b) -> a -> b
$ (FixedPoint
1 :: FixedPoint) FixedPoint -> FixedPoint -> FixedPoint
forall a. Num a => a -> a -> a
- (Rational -> FixedPoint
forall a. Fractional a => Rational -> a
fromRational (Rational -> FixedPoint) -> Rational -> FixedPoint
forall a b. (a -> b) -> a -> b
$ UnitInterval -> Rational
unitIntervalToRational UnitInterval
v)
                    )
              )
    }

activeSlotVal :: ActiveSlotCoeff -> UnitInterval
activeSlotVal :: ActiveSlotCoeff -> UnitInterval
activeSlotVal = ActiveSlotCoeff -> UnitInterval
unActiveSlotVal

activeSlotLog :: ActiveSlotCoeff -> FixedPoint
activeSlotLog :: ActiveSlotCoeff -> FixedPoint
activeSlotLog ActiveSlotCoeff
f = (Integer -> FixedPoint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> FixedPoint) -> Integer -> FixedPoint
forall a b. (a -> b) -> a -> b
$ ActiveSlotCoeff -> Integer
unActiveSlotLog ActiveSlotCoeff
f) FixedPoint -> FixedPoint -> FixedPoint
forall a. Fractional a => a -> a -> a
/ FixedPoint
fpPrecision

--------------------------------------------------------------------------------
-- Base monad for all STS systems
--------------------------------------------------------------------------------

data Globals = Globals
  { Globals -> EpochInfo Identity
epochInfo :: !(EpochInfo Identity),
    Globals -> Word64
slotsPerKESPeriod :: !Word64,
    -- | The window size in which our chosen chain growth property
    --   guarantees at least k blocks. From the paper
    --   "Ouroboros praos: An adaptively-secure, semi-synchronous proof-of-stake protocol".
    --   The 'stabilityWindow' constant is used in a number of places; for example,
    --   protocol updates must be submitted at least twice this many slots before an epoch boundary.
    Globals -> Word64
stabilityWindow :: !Word64,
    -- | Number of slots before the end of the epoch at which we stop updating
    --   the candidate nonce for the next epoch.
    Globals -> Word64
randomnessStabilisationWindow :: !Word64,
    -- | Maximum number of blocks we are allowed to roll back
    Globals -> Word64
securityParameter :: !Word64,
    -- | Maximum number of KES iterations
    Globals -> Word64
maxKESEvo :: !Word64,
    -- | Quorum for update system votes and MIR certificates
    Globals -> Word64
quorum :: !Word64,
    -- | All blocks invalid after this protocol version
    Globals -> Natural
maxMajorPV :: !Natural,
    -- | Maximum number of lovelace in the system
    Globals -> Word64
maxLovelaceSupply :: !Word64,
    -- | Active Slot Coefficient, named f in
    -- "Ouroboros Praos: An adaptively-secure, semi-synchronous proof-of-stake protocol"
    Globals -> ActiveSlotCoeff
activeSlotCoeff :: !ActiveSlotCoeff,
    -- | The network ID
    Globals -> Network
networkId :: !Network
  }
  deriving ((forall x. Globals -> Rep Globals x)
-> (forall x. Rep Globals x -> Globals) -> Generic Globals
forall x. Rep Globals x -> Globals
forall x. Globals -> Rep Globals x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Globals x -> Globals
$cfrom :: forall x. Globals -> Rep Globals x
Generic)

instance NoThunks Globals

type ShelleyBase = ReaderT Globals Identity

data Network
  = Testnet
  | Mainnet
  deriving (Network -> Network -> Bool
(Network -> Network -> Bool)
-> (Network -> Network -> Bool) -> Eq Network
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Network -> Network -> Bool
$c/= :: Network -> Network -> Bool
== :: Network -> Network -> Bool
$c== :: Network -> Network -> Bool
Eq, Eq Network
Eq Network
-> (Network -> Network -> Ordering)
-> (Network -> Network -> Bool)
-> (Network -> Network -> Bool)
-> (Network -> Network -> Bool)
-> (Network -> Network -> Bool)
-> (Network -> Network -> Network)
-> (Network -> Network -> Network)
-> Ord Network
Network -> Network -> Bool
Network -> Network -> Ordering
Network -> Network -> Network
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 :: Network -> Network -> Network
$cmin :: Network -> Network -> Network
max :: Network -> Network -> Network
$cmax :: Network -> Network -> Network
>= :: Network -> Network -> Bool
$c>= :: Network -> Network -> Bool
> :: Network -> Network -> Bool
$c> :: Network -> Network -> Bool
<= :: Network -> Network -> Bool
$c<= :: Network -> Network -> Bool
< :: Network -> Network -> Bool
$c< :: Network -> Network -> Bool
compare :: Network -> Network -> Ordering
$ccompare :: Network -> Network -> Ordering
$cp1Ord :: Eq Network
Ord, Int -> Network
Network -> Int
Network -> [Network]
Network -> Network
Network -> Network -> [Network]
Network -> Network -> Network -> [Network]
(Network -> Network)
-> (Network -> Network)
-> (Int -> Network)
-> (Network -> Int)
-> (Network -> [Network])
-> (Network -> Network -> [Network])
-> (Network -> Network -> [Network])
-> (Network -> Network -> Network -> [Network])
-> Enum Network
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Network -> Network -> Network -> [Network]
$cenumFromThenTo :: Network -> Network -> Network -> [Network]
enumFromTo :: Network -> Network -> [Network]
$cenumFromTo :: Network -> Network -> [Network]
enumFromThen :: Network -> Network -> [Network]
$cenumFromThen :: Network -> Network -> [Network]
enumFrom :: Network -> [Network]
$cenumFrom :: Network -> [Network]
fromEnum :: Network -> Int
$cfromEnum :: Network -> Int
toEnum :: Int -> Network
$ctoEnum :: Int -> Network
pred :: Network -> Network
$cpred :: Network -> Network
succ :: Network -> Network
$csucc :: Network -> Network
Enum, Network
Network -> Network -> Bounded Network
forall a. a -> a -> Bounded a
maxBound :: Network
$cmaxBound :: Network
minBound :: Network
$cminBound :: Network
Bounded, Int -> Network -> ShowS
[Network] -> ShowS
Network -> String
(Int -> Network -> ShowS)
-> (Network -> String) -> ([Network] -> ShowS) -> Show Network
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Network] -> ShowS
$cshowList :: [Network] -> ShowS
show :: Network -> String
$cshow :: Network -> String
showsPrec :: Int -> Network -> ShowS
$cshowsPrec :: Int -> Network -> ShowS
Show, (forall x. Network -> Rep Network x)
-> (forall x. Rep Network x -> Network) -> Generic Network
forall x. Rep Network x -> Network
forall x. Network -> Rep Network x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Network x -> Network
$cfrom :: forall x. Network -> Rep Network x
Generic, Network -> ()
(Network -> ()) -> NFData Network
forall a. (a -> ()) -> NFData a
rnf :: Network -> ()
$crnf :: Network -> ()
NFData, [Network] -> Encoding
[Network] -> Value
Network -> Encoding
Network -> Value
(Network -> Value)
-> (Network -> Encoding)
-> ([Network] -> Value)
-> ([Network] -> Encoding)
-> ToJSON Network
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Network] -> Encoding
$ctoEncodingList :: [Network] -> Encoding
toJSONList :: [Network] -> Value
$ctoJSONList :: [Network] -> Value
toEncoding :: Network -> Encoding
$ctoEncoding :: Network -> Encoding
toJSON :: Network -> Value
$ctoJSON :: Network -> Value
ToJSON, Value -> Parser [Network]
Value -> Parser Network
(Value -> Parser Network)
-> (Value -> Parser [Network]) -> FromJSON Network
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Network]
$cparseJSONList :: Value -> Parser [Network]
parseJSON :: Value -> Parser Network
$cparseJSON :: Value -> Parser Network
FromJSON, Context -> Network -> IO (Maybe ThunkInfo)
Proxy Network -> String
(Context -> Network -> IO (Maybe ThunkInfo))
-> (Context -> Network -> IO (Maybe ThunkInfo))
-> (Proxy Network -> String)
-> NoThunks Network
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy Network -> String
$cshowTypeOf :: Proxy Network -> String
wNoThunks :: Context -> Network -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Network -> IO (Maybe ThunkInfo)
noThunks :: Context -> Network -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Network -> IO (Maybe ThunkInfo)
NoThunks)

networkToWord8 :: Network -> Word8
networkToWord8 :: Network -> Word8
networkToWord8 = Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> (Network -> Int) -> Network -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Int
forall a. Enum a => a -> Int
fromEnum

word8ToNetwork :: Word8 -> Maybe Network
word8ToNetwork :: Word8 -> Maybe Network
word8ToNetwork Word8
e
  | Word8 -> Int
forall a. Enum a => a -> Int
fromEnum Word8
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Network -> Int
forall a. Enum a => a -> Int
fromEnum (Network
forall a. Bounded a => a
maxBound :: Network) = Maybe Network
forall a. Maybe a
Nothing
  | Word8 -> Int
forall a. Enum a => a -> Int
fromEnum Word8
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Network -> Int
forall a. Enum a => a -> Int
fromEnum (Network
forall a. Bounded a => a
minBound :: Network) = Maybe Network
forall a. Maybe a
Nothing
  | Bool
otherwise = Network -> Maybe Network
forall a. a -> Maybe a
Just (Network -> Maybe Network) -> Network -> Maybe Network
forall a b. (a -> b) -> a -> b
$ Int -> Network
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a. Enum a => a -> Int
fromEnum Word8
e)

instance ToCBOR Network where
  toCBOR :: Network -> Encoding
toCBOR = Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8 -> Encoding) -> (Network -> Word8) -> Network -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Word8
networkToWord8

instance FromCBOR Network where
  fromCBOR :: Decoder s Network
fromCBOR =
    Word8 -> Maybe Network
word8ToNetwork (Word8 -> Maybe Network)
-> Decoder s Word8 -> Decoder s (Maybe Network)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word8
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Maybe Network)
-> (Maybe Network -> Decoder s Network) -> Decoder s Network
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Network
Nothing -> DecoderError -> Decoder s Network
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s Network)
-> DecoderError -> Decoder s Network
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"Network" Text
"Unknown network id"
      Just Network
n -> Network -> Decoder s Network
forall (f :: * -> *) a. Applicative f => a -> f a
pure Network
n