-- | Epoch
module Blockfrost.Types.Shared.Epoch where

import Data.Aeson (FromJSON, ToJSON)
import Data.Word (Word64)
import GHC.Generics
import Servant.API (Capture, FromHttpApiData (..), ToHttpApiData (..))
import Servant.Docs (DocCapture (..), ToCapture (..), ToSample (..), samples)

newtype Epoch = Epoch Integer
  deriving stock (Epoch -> Epoch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Epoch -> Epoch -> Bool
$c/= :: Epoch -> Epoch -> Bool
== :: Epoch -> Epoch -> Bool
$c== :: Epoch -> Epoch -> Bool
Eq, Eq Epoch
Epoch -> Epoch -> Bool
Epoch -> Epoch -> Ordering
Epoch -> Epoch -> Epoch
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 :: Epoch -> Epoch -> Epoch
$cmin :: Epoch -> Epoch -> Epoch
max :: Epoch -> Epoch -> Epoch
$cmax :: Epoch -> Epoch -> Epoch
>= :: Epoch -> Epoch -> Bool
$c>= :: Epoch -> Epoch -> Bool
> :: Epoch -> Epoch -> Bool
$c> :: Epoch -> Epoch -> Bool
<= :: Epoch -> Epoch -> Bool
$c<= :: Epoch -> Epoch -> Bool
< :: Epoch -> Epoch -> Bool
$c< :: Epoch -> Epoch -> Bool
compare :: Epoch -> Epoch -> Ordering
$ccompare :: Epoch -> Epoch -> Ordering
Ord, Int -> Epoch -> ShowS
[Epoch] -> ShowS
Epoch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Epoch] -> ShowS
$cshowList :: [Epoch] -> ShowS
show :: Epoch -> String
$cshow :: Epoch -> String
showsPrec :: Int -> Epoch -> ShowS
$cshowsPrec :: Int -> Epoch -> ShowS
Show, forall x. Rep Epoch x -> Epoch
forall x. Epoch -> Rep Epoch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Epoch x -> Epoch
$cfrom :: forall x. Epoch -> Rep Epoch x
Generic)
  deriving newtype (Integer -> Epoch
Epoch -> Epoch
Epoch -> Epoch -> Epoch
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Epoch
$cfromInteger :: Integer -> Epoch
signum :: Epoch -> Epoch
$csignum :: Epoch -> Epoch
abs :: Epoch -> Epoch
$cabs :: Epoch -> Epoch
negate :: Epoch -> Epoch
$cnegate :: Epoch -> Epoch
* :: Epoch -> Epoch -> Epoch
$c* :: Epoch -> Epoch -> Epoch
- :: Epoch -> Epoch -> Epoch
$c- :: Epoch -> Epoch -> Epoch
+ :: Epoch -> Epoch -> Epoch
$c+ :: Epoch -> Epoch -> Epoch
Num, Int -> Epoch
Epoch -> Int
Epoch -> [Epoch]
Epoch -> Epoch
Epoch -> Epoch -> [Epoch]
Epoch -> Epoch -> Epoch -> [Epoch]
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 :: Epoch -> Epoch -> Epoch -> [Epoch]
$cenumFromThenTo :: Epoch -> Epoch -> Epoch -> [Epoch]
enumFromTo :: Epoch -> Epoch -> [Epoch]
$cenumFromTo :: Epoch -> Epoch -> [Epoch]
enumFromThen :: Epoch -> Epoch -> [Epoch]
$cenumFromThen :: Epoch -> Epoch -> [Epoch]
enumFrom :: Epoch -> [Epoch]
$cenumFrom :: Epoch -> [Epoch]
fromEnum :: Epoch -> Int
$cfromEnum :: Epoch -> Int
toEnum :: Int -> Epoch
$ctoEnum :: Int -> Epoch
pred :: Epoch -> Epoch
$cpred :: Epoch -> Epoch
succ :: Epoch -> Epoch
$csucc :: Epoch -> Epoch
Enum, Num Epoch
Ord Epoch
Epoch -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Epoch -> Rational
$ctoRational :: Epoch -> Rational
Real, Enum Epoch
Real Epoch
Epoch -> Integer
Epoch -> Epoch -> (Epoch, Epoch)
Epoch -> Epoch -> Epoch
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Epoch -> Integer
$ctoInteger :: Epoch -> Integer
divMod :: Epoch -> Epoch -> (Epoch, Epoch)
$cdivMod :: Epoch -> Epoch -> (Epoch, Epoch)
quotRem :: Epoch -> Epoch -> (Epoch, Epoch)
$cquotRem :: Epoch -> Epoch -> (Epoch, Epoch)
mod :: Epoch -> Epoch -> Epoch
$cmod :: Epoch -> Epoch -> Epoch
div :: Epoch -> Epoch -> Epoch
$cdiv :: Epoch -> Epoch -> Epoch
rem :: Epoch -> Epoch -> Epoch
$crem :: Epoch -> Epoch -> Epoch
quot :: Epoch -> Epoch -> Epoch
$cquot :: Epoch -> Epoch -> Epoch
Integral, ByteString -> Either Text Epoch
Text -> Either Text Epoch
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text Epoch
$cparseQueryParam :: Text -> Either Text Epoch
parseHeader :: ByteString -> Either Text Epoch
$cparseHeader :: ByteString -> Either Text Epoch
parseUrlPiece :: Text -> Either Text Epoch
$cparseUrlPiece :: Text -> Either Text Epoch
FromHttpApiData, Epoch -> ByteString
Epoch -> Builder
Epoch -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: Epoch -> Text
$ctoQueryParam :: Epoch -> Text
toHeader :: Epoch -> ByteString
$ctoHeader :: Epoch -> ByteString
toEncodedUrlPiece :: Epoch -> Builder
$ctoEncodedUrlPiece :: Epoch -> Builder
toUrlPiece :: Epoch -> Text
$ctoUrlPiece :: Epoch -> Text
ToHttpApiData, Value -> Parser [Epoch]
Value -> Parser Epoch
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Epoch]
$cparseJSONList :: Value -> Parser [Epoch]
parseJSON :: Value -> Parser Epoch
$cparseJSON :: Value -> Parser Epoch
FromJSON, [Epoch] -> Encoding
[Epoch] -> Value
Epoch -> Encoding
Epoch -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Epoch] -> Encoding
$ctoEncodingList :: [Epoch] -> Encoding
toJSONList :: [Epoch] -> Value
$ctoJSONList :: [Epoch] -> Value
toEncoding :: Epoch -> Encoding
$ctoEncoding :: Epoch -> Encoding
toJSON :: Epoch -> Value
$ctoJSON :: Epoch -> Value
ToJSON)

unEpoch :: Epoch -> Integer
unEpoch :: Epoch -> Integer
unEpoch (Epoch Integer
i) = Integer
i

instance ToCapture (Capture "epoch_number" Epoch) where
  toCapture :: Proxy (Capture "epoch_number" Epoch) -> DocCapture
toCapture Proxy (Capture "epoch_number" Epoch)
_ = String -> String -> DocCapture
DocCapture String
"epoch_number" String
"Epoch for specific epoch slot."

instance ToSample Epoch where
  toSamples :: Proxy Epoch -> [(Text, Epoch)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Text, a)]
samples [Epoch
425, Epoch
500, Epoch
1200]

newtype EpochLength = EpochLength Word64
  deriving stock (EpochLength -> EpochLength -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EpochLength -> EpochLength -> Bool
$c/= :: EpochLength -> EpochLength -> Bool
== :: EpochLength -> EpochLength -> Bool
$c== :: EpochLength -> EpochLength -> Bool
Eq, Eq EpochLength
EpochLength -> EpochLength -> Bool
EpochLength -> EpochLength -> Ordering
EpochLength -> EpochLength -> EpochLength
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 :: EpochLength -> EpochLength -> EpochLength
$cmin :: EpochLength -> EpochLength -> EpochLength
max :: EpochLength -> EpochLength -> EpochLength
$cmax :: EpochLength -> EpochLength -> EpochLength
>= :: EpochLength -> EpochLength -> Bool
$c>= :: EpochLength -> EpochLength -> Bool
> :: EpochLength -> EpochLength -> Bool
$c> :: EpochLength -> EpochLength -> Bool
<= :: EpochLength -> EpochLength -> Bool
$c<= :: EpochLength -> EpochLength -> Bool
< :: EpochLength -> EpochLength -> Bool
$c< :: EpochLength -> EpochLength -> Bool
compare :: EpochLength -> EpochLength -> Ordering
$ccompare :: EpochLength -> EpochLength -> Ordering
Ord, Int -> EpochLength -> ShowS
[EpochLength] -> ShowS
EpochLength -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EpochLength] -> ShowS
$cshowList :: [EpochLength] -> ShowS
show :: EpochLength -> String
$cshow :: EpochLength -> String
showsPrec :: Int -> EpochLength -> ShowS
$cshowsPrec :: Int -> EpochLength -> ShowS
Show, forall x. Rep EpochLength x -> EpochLength
forall x. EpochLength -> Rep EpochLength x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EpochLength x -> EpochLength
$cfrom :: forall x. EpochLength -> Rep EpochLength x
Generic)
  deriving newtype (Integer -> EpochLength
EpochLength -> EpochLength
EpochLength -> EpochLength -> EpochLength
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> EpochLength
$cfromInteger :: Integer -> EpochLength
signum :: EpochLength -> EpochLength
$csignum :: EpochLength -> EpochLength
abs :: EpochLength -> EpochLength
$cabs :: EpochLength -> EpochLength
negate :: EpochLength -> EpochLength
$cnegate :: EpochLength -> EpochLength
* :: EpochLength -> EpochLength -> EpochLength
$c* :: EpochLength -> EpochLength -> EpochLength
- :: EpochLength -> EpochLength -> EpochLength
$c- :: EpochLength -> EpochLength -> EpochLength
+ :: EpochLength -> EpochLength -> EpochLength
$c+ :: EpochLength -> EpochLength -> EpochLength
Num, Int -> EpochLength
EpochLength -> Int
EpochLength -> [EpochLength]
EpochLength -> EpochLength
EpochLength -> EpochLength -> [EpochLength]
EpochLength -> EpochLength -> EpochLength -> [EpochLength]
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 :: EpochLength -> EpochLength -> EpochLength -> [EpochLength]
$cenumFromThenTo :: EpochLength -> EpochLength -> EpochLength -> [EpochLength]
enumFromTo :: EpochLength -> EpochLength -> [EpochLength]
$cenumFromTo :: EpochLength -> EpochLength -> [EpochLength]
enumFromThen :: EpochLength -> EpochLength -> [EpochLength]
$cenumFromThen :: EpochLength -> EpochLength -> [EpochLength]
enumFrom :: EpochLength -> [EpochLength]
$cenumFrom :: EpochLength -> [EpochLength]
fromEnum :: EpochLength -> Int
$cfromEnum :: EpochLength -> Int
toEnum :: Int -> EpochLength
$ctoEnum :: Int -> EpochLength
pred :: EpochLength -> EpochLength
$cpred :: EpochLength -> EpochLength
succ :: EpochLength -> EpochLength
$csucc :: EpochLength -> EpochLength
Enum, Num EpochLength
Ord EpochLength
EpochLength -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: EpochLength -> Rational
$ctoRational :: EpochLength -> Rational
Real, Enum EpochLength
Real EpochLength
EpochLength -> Integer
EpochLength -> EpochLength -> (EpochLength, EpochLength)
EpochLength -> EpochLength -> EpochLength
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: EpochLength -> Integer
$ctoInteger :: EpochLength -> Integer
divMod :: EpochLength -> EpochLength -> (EpochLength, EpochLength)
$cdivMod :: EpochLength -> EpochLength -> (EpochLength, EpochLength)
quotRem :: EpochLength -> EpochLength -> (EpochLength, EpochLength)
$cquotRem :: EpochLength -> EpochLength -> (EpochLength, EpochLength)
mod :: EpochLength -> EpochLength -> EpochLength
$cmod :: EpochLength -> EpochLength -> EpochLength
div :: EpochLength -> EpochLength -> EpochLength
$cdiv :: EpochLength -> EpochLength -> EpochLength
rem :: EpochLength -> EpochLength -> EpochLength
$crem :: EpochLength -> EpochLength -> EpochLength
quot :: EpochLength -> EpochLength -> EpochLength
$cquot :: EpochLength -> EpochLength -> EpochLength
Integral, ByteString -> Either Text EpochLength
Text -> Either Text EpochLength
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text EpochLength
$cparseQueryParam :: Text -> Either Text EpochLength
parseHeader :: ByteString -> Either Text EpochLength
$cparseHeader :: ByteString -> Either Text EpochLength
parseUrlPiece :: Text -> Either Text EpochLength
$cparseUrlPiece :: Text -> Either Text EpochLength
FromHttpApiData, EpochLength -> ByteString
EpochLength -> Builder
EpochLength -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: EpochLength -> Text
$ctoQueryParam :: EpochLength -> Text
toHeader :: EpochLength -> ByteString
$ctoHeader :: EpochLength -> ByteString
toEncodedUrlPiece :: EpochLength -> Builder
$ctoEncodedUrlPiece :: EpochLength -> Builder
toUrlPiece :: EpochLength -> Text
$ctoUrlPiece :: EpochLength -> Text
ToHttpApiData, Value -> Parser [EpochLength]
Value -> Parser EpochLength
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EpochLength]
$cparseJSONList :: Value -> Parser [EpochLength]
parseJSON :: Value -> Parser EpochLength
$cparseJSON :: Value -> Parser EpochLength
FromJSON, [EpochLength] -> Encoding
[EpochLength] -> Value
EpochLength -> Encoding
EpochLength -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EpochLength] -> Encoding
$ctoEncodingList :: [EpochLength] -> Encoding
toJSONList :: [EpochLength] -> Value
$ctoJSONList :: [EpochLength] -> Value
toEncoding :: EpochLength -> Encoding
$ctoEncoding :: EpochLength -> Encoding
toJSON :: EpochLength -> Value
$ctoJSON :: EpochLength -> Value
ToJSON)

unEpochLength :: EpochLength -> Word64
unEpochLength :: EpochLength -> Word64
unEpochLength (EpochLength Word64
u) = Word64
u

instance ToCapture (Capture "epoch_length" EpochLength) where
  toCapture :: Proxy (Capture "epoch_length" EpochLength) -> DocCapture
toCapture Proxy (Capture "epoch_length" EpochLength)
_ = String -> String -> DocCapture
DocCapture String
"epoch_length" String
"Epoch size in a specific Cardano era."

instance ToSample EpochLength where
  toSamples :: Proxy EpochLength -> [(Text, EpochLength)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Text, a)]
samples [EpochLength
21600, EpochLength
86400, EpochLength
432000]