-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Core primitive Tezos types.

module Tezos.Core
  (
    -- * Mutez
    Mutez (unMutez)
  , mkMutez
  , mkMutez'
  , unsafeMkMutez
  , toMutez
  , addMutez
  , unsafeAddMutez
  , subMutez
  , unsafeSubMutez
  , mulMutez
  , divModMutez
  , divModMutezInt
  , mutezToInt64
  , zeroMutez
  , oneMutez
  , prettyTez

    -- * Timestamp
  , Timestamp (..)
  , timestampToSeconds
  , timestampFromSeconds
  , timestampFromUTCTime
  , timestampToUTCTime
  , timestampPlusSeconds
  , formatTimestamp
  , parseTimestamp
  , timestampQuote
  , getCurrentTime
  , farFuture
  , farPast

    -- * ChainId
  , ChainId (..)
  , mkChainId
  , mkChainIdUnsafe
  , dummyChainId
  , formatChainId
  , mformatChainId
  , parseChainId
  , chainIdLength
  ) where

import Data.Aeson (FromJSON(..), ToJSON(..))
import qualified Data.Aeson as Aeson
import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Data.Scientific
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
import Data.Time.Format (defaultTimeLocale, parseTimeM)
import Data.Time.LocalTime (utc, utcToZonedTime)
import Data.Time.RFC3339 (formatTimeRFC3339)
import Fmt (Buildable(build), fmt, hexF, pretty)
import qualified Language.Haskell.TH.Quote as TH
import Language.Haskell.TH.Syntax (liftData)
import qualified Options.Applicative as Opt

import Michelson.Text
import Tezos.Crypto
import Util.Aeson
import Util.CLI
import Util.Num

----------------------------------------------------------------------------
-- Mutez
----------------------------------------------------------------------------

-- | Mutez is a wrapper over integer data type. 1 mutez is 1 token (μTz).
newtype Mutez = Mutez
  { Mutez -> Word64
unMutez :: Word64
  } deriving stock (Int -> Mutez -> ShowS
[Mutez] -> ShowS
Mutez -> String
(Int -> Mutez -> ShowS)
-> (Mutez -> String) -> ([Mutez] -> ShowS) -> Show Mutez
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mutez] -> ShowS
$cshowList :: [Mutez] -> ShowS
show :: Mutez -> String
$cshow :: Mutez -> String
showsPrec :: Int -> Mutez -> ShowS
$cshowsPrec :: Int -> Mutez -> ShowS
Show, Mutez -> Mutez -> Bool
(Mutez -> Mutez -> Bool) -> (Mutez -> Mutez -> Bool) -> Eq Mutez
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mutez -> Mutez -> Bool
$c/= :: Mutez -> Mutez -> Bool
== :: Mutez -> Mutez -> Bool
$c== :: Mutez -> Mutez -> Bool
Eq, Eq Mutez
Eq Mutez =>
(Mutez -> Mutez -> Ordering)
-> (Mutez -> Mutez -> Bool)
-> (Mutez -> Mutez -> Bool)
-> (Mutez -> Mutez -> Bool)
-> (Mutez -> Mutez -> Bool)
-> (Mutez -> Mutez -> Mutez)
-> (Mutez -> Mutez -> Mutez)
-> Ord Mutez
Mutez -> Mutez -> Bool
Mutez -> Mutez -> Ordering
Mutez -> Mutez -> Mutez
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 :: Mutez -> Mutez -> Mutez
$cmin :: Mutez -> Mutez -> Mutez
max :: Mutez -> Mutez -> Mutez
$cmax :: Mutez -> Mutez -> Mutez
>= :: Mutez -> Mutez -> Bool
$c>= :: Mutez -> Mutez -> Bool
> :: Mutez -> Mutez -> Bool
$c> :: Mutez -> Mutez -> Bool
<= :: Mutez -> Mutez -> Bool
$c<= :: Mutez -> Mutez -> Bool
< :: Mutez -> Mutez -> Bool
$c< :: Mutez -> Mutez -> Bool
compare :: Mutez -> Mutez -> Ordering
$ccompare :: Mutez -> Mutez -> Ordering
$cp1Ord :: Eq Mutez
Ord, Typeable Mutez
DataType
Constr
Typeable Mutez =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Mutez -> c Mutez)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Mutez)
-> (Mutez -> Constr)
-> (Mutez -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Mutez))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mutez))
-> ((forall b. Data b => b -> b) -> Mutez -> Mutez)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mutez -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mutez -> r)
-> (forall u. (forall d. Data d => d -> u) -> Mutez -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Mutez -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Mutez -> m Mutez)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Mutez -> m Mutez)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Mutez -> m Mutez)
-> Data Mutez
Mutez -> DataType
Mutez -> Constr
(forall b. Data b => b -> b) -> Mutez -> Mutez
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mutez -> c Mutez
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mutez
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Mutez -> u
forall u. (forall d. Data d => d -> u) -> Mutez -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mutez -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mutez -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mutez -> m Mutez
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mutez -> m Mutez
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mutez
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mutez -> c Mutez
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mutez)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mutez)
$cMutez :: Constr
$tMutez :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Mutez -> m Mutez
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mutez -> m Mutez
gmapMp :: (forall d. Data d => d -> m d) -> Mutez -> m Mutez
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mutez -> m Mutez
gmapM :: (forall d. Data d => d -> m d) -> Mutez -> m Mutez
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mutez -> m Mutez
gmapQi :: Int -> (forall d. Data d => d -> u) -> Mutez -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mutez -> u
gmapQ :: (forall d. Data d => d -> u) -> Mutez -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Mutez -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mutez -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mutez -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mutez -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mutez -> r
gmapT :: (forall b. Data b => b -> b) -> Mutez -> Mutez
$cgmapT :: (forall b. Data b => b -> b) -> Mutez -> Mutez
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mutez)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mutez)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Mutez)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mutez)
dataTypeOf :: Mutez -> DataType
$cdataTypeOf :: Mutez -> DataType
toConstr :: Mutez -> Constr
$ctoConstr :: Mutez -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mutez
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mutez
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mutez -> c Mutez
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mutez -> c Mutez
$cp1Data :: Typeable Mutez
Data, (forall x. Mutez -> Rep Mutez x)
-> (forall x. Rep Mutez x -> Mutez) -> Generic Mutez
forall x. Rep Mutez x -> Mutez
forall x. Mutez -> Rep Mutez x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mutez x -> Mutez
$cfrom :: forall x. Mutez -> Rep Mutez x
Generic)
    deriving newtype Int -> Mutez
Mutez -> Int
Mutez -> [Mutez]
Mutez -> Mutez
Mutez -> Mutez -> [Mutez]
Mutez -> Mutez -> Mutez -> [Mutez]
(Mutez -> Mutez)
-> (Mutez -> Mutez)
-> (Int -> Mutez)
-> (Mutez -> Int)
-> (Mutez -> [Mutez])
-> (Mutez -> Mutez -> [Mutez])
-> (Mutez -> Mutez -> [Mutez])
-> (Mutez -> Mutez -> Mutez -> [Mutez])
-> Enum Mutez
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 :: Mutez -> Mutez -> Mutez -> [Mutez]
$cenumFromThenTo :: Mutez -> Mutez -> Mutez -> [Mutez]
enumFromTo :: Mutez -> Mutez -> [Mutez]
$cenumFromTo :: Mutez -> Mutez -> [Mutez]
enumFromThen :: Mutez -> Mutez -> [Mutez]
$cenumFromThen :: Mutez -> Mutez -> [Mutez]
enumFrom :: Mutez -> [Mutez]
$cenumFrom :: Mutez -> [Mutez]
fromEnum :: Mutez -> Int
$cfromEnum :: Mutez -> Int
toEnum :: Int -> Mutez
$ctoEnum :: Int -> Mutez
pred :: Mutez -> Mutez
$cpred :: Mutez -> Mutez
succ :: Mutez -> Mutez
$csucc :: Mutez -> Mutez
Enum

instance Buildable Mutez where
  build :: Mutez -> Builder
build (Mutez w :: Word64
w) = Word64 -> Builder
forall p. Buildable p => p -> Builder
build Word64
w Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> " μꜩ"

instance Bounded Mutez where
  minBound :: Mutez
minBound = Word64 -> Mutez
Mutez 0
  -- 2⁶³ - 1
  -- This value was checked against the reference implementation.
  maxBound :: Mutez
maxBound = Word64 -> Mutez
Mutez 9223372036854775807

instance HasCLReader Mutez where
  getReader :: ReadM Mutez
getReader = ReadM Mutez -> (Mutez -> ReadM Mutez) -> Maybe Mutez -> ReadM Mutez
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ReadM Mutez
forall a. String -> ReadM a
readerError "Invalid mutez") Mutez -> ReadM Mutez
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Mutez -> ReadM Mutez)
-> (Word64 -> Maybe Mutez) -> Word64 -> ReadM Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Maybe Mutez
mkMutez (Word64 -> ReadM Mutez) -> ReadM Word64 -> ReadM Mutez
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReadM Word64
forall a. Read a => ReadM a
Opt.auto
  getMetavar :: String
getMetavar = "MUTEZ"

instance NFData Mutez

-- | Safely create 'Mutez' checking for overflow.
mkMutez :: Word64 -> Maybe Mutez
mkMutez :: Word64 -> Maybe Mutez
mkMutez n :: Word64
n
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Mutez -> Word64
unMutez Mutez
forall a. Bounded a => a
maxBound = Mutez -> Maybe Mutez
forall a. a -> Maybe a
Just (Word64 -> Mutez
Mutez Word64
n)
  | Bool
otherwise = Maybe Mutez
forall a. Maybe a
Nothing
{-# INLINE mkMutez #-}

-- | Version of 'mkMutez' that accepts a number of any type.
mkMutez' :: Integral i => i -> Either Text Mutez
mkMutez' :: i -> Either Text Mutez
mkMutez' i :: i
i = do
  Word64
w :: Word64 <- i -> Either Text Word64
forall a b. (Integral a, Integral b) => a -> Either Text b
fromIntegralChecked i
i
  Word64 -> Maybe Mutez
mkMutez Word64
w
    Maybe Mutez
-> (Maybe Mutez -> Either Text Mutez) -> Either Text Mutez
forall a b. a -> (a -> b) -> b
& Text -> Maybe Mutez -> Either Text Mutez
forall l r. l -> Maybe r -> Either l r
maybeToRight "Mutez overflow"

-- | Partial function for 'Mutez' creation, it's pre-condition is that
-- the argument must not exceed the maximal 'Mutez' value.
unsafeMkMutez :: HasCallStack => Word64 -> Mutez
unsafeMkMutez :: Word64 -> Mutez
unsafeMkMutez n :: Word64
n =
  Mutez -> Maybe Mutez -> Mutez
forall a. a -> Maybe a -> a
fromMaybe (Text -> Mutez
forall a. HasCallStack => Text -> a
error (Text -> Mutez) -> Text -> Mutez
forall a b. (a -> b) -> a -> b
$ "mkMutez: overflow (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall b a. (Show a, IsString b) => a -> b
show Word64
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")") (Word64 -> Maybe Mutez
mkMutez Word64
n)
{-# INLINE unsafeMkMutez #-}

-- | Safely create 'Mutez'.
--
-- This is recommended way to create @Mutez@ from a numeric literal;
-- you can't construct all valid @Mutez@ values using this function
-- but for small values it works neat.
--
-- Warnings displayed when trying to construct invalid 'Natural' or 'Word'
-- literal are hardcoded for these types in GHC implementation, so we can only
-- exploit these existing rules.
toMutez :: Word32 -> Mutez
toMutez :: Word32 -> Mutez
toMutez = HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez (Word64 -> Mutez) -> (Word32 -> Word64) -> Word32 -> Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE toMutez #-}

-- | Addition of 'Mutez' values. Returns 'Nothing' in case of overflow.
addMutez :: Mutez -> Mutez -> Maybe Mutez
addMutez :: Mutez -> Mutez -> Maybe Mutez
addMutez (Mutez -> Word64
unMutez -> Word64
a) (Mutez -> Word64
unMutez -> Word64
b) =
  Word64 -> Maybe Mutez
mkMutez (Word64
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
b) -- (a + b) can't overflow if 'Mutez' values are valid
{-# INLINE addMutez #-}

-- | Partial addition of 'Mutez', should be used only if you're
-- sure there'll be no overflow.
unsafeAddMutez :: HasCallStack => Mutez -> Mutez -> Mutez
unsafeAddMutez :: Mutez -> Mutez -> Mutez
unsafeAddMutez = Mutez -> Maybe Mutez -> Mutez
forall a. a -> Maybe a -> a
fromMaybe (Text -> Mutez
forall a. HasCallStack => Text -> a
error "unsafeAddMutez: overflow") (Maybe Mutez -> Mutez)
-> (Mutez -> Mutez -> Maybe Mutez) -> Mutez -> Mutez -> Mutez
forall a b c. SuperComposition a b c => a -> b -> c
... Mutez -> Mutez -> Maybe Mutez
addMutez

-- | Subtraction of 'Mutez' values. Returns 'Nothing' when the
-- subtrahend is greater than the minuend, and 'Just' otherwise.
subMutez :: Mutez -> Mutez -> Maybe Mutez
subMutez :: Mutez -> Mutez -> Maybe Mutez
subMutez (Mutez -> Word64
unMutez -> Word64
a) (Mutez -> Word64
unMutez -> Word64
b)
  | Word64
a Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
b = Mutez -> Maybe Mutez
forall a. a -> Maybe a
Just (Word64 -> Mutez
Mutez (Word64
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
b))
  | Bool
otherwise = Maybe Mutez
forall a. Maybe a
Nothing
{-# INLINE subMutez #-}

-- | Partial subtraction of 'Mutez', should be used only if you're
-- sure there'll be no underflow.
unsafeSubMutez :: HasCallStack => Mutez -> Mutez -> Mutez
unsafeSubMutez :: Mutez -> Mutez -> Mutez
unsafeSubMutez = Mutez -> Maybe Mutez -> Mutez
forall a. a -> Maybe a -> a
fromMaybe (Text -> Mutez
forall a. HasCallStack => Text -> a
error "unsafeSubMutez: underflow") (Maybe Mutez -> Mutez)
-> (Mutez -> Mutez -> Maybe Mutez) -> Mutez -> Mutez -> Mutez
forall a b c. SuperComposition a b c => a -> b -> c
... Mutez -> Mutez -> Maybe Mutez
subMutez

-- | Multiplication of 'Mutez' and an integral number. Returns
-- 'Nothing' in case of overflow.
mulMutez :: Integral a => Mutez -> a -> Maybe Mutez
mulMutez :: Mutez -> a -> Maybe Mutez
mulMutez (Mutez -> Word64
unMutez -> Word64
a) b :: a
b
    | Integer
res Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Mutez -> Word64
unMutez Mutez
forall a. Bounded a => a
maxBound) = Mutez -> Maybe Mutez
forall a. a -> Maybe a
Just (Word64 -> Mutez
Mutez (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
res))
    | Bool
otherwise = Maybe Mutez
forall a. Maybe a
Nothing
  where
    res :: Integer
res = Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* a -> Integer
forall a. Integral a => a -> Integer
toInteger a
b
{-# INLINE mulMutez #-}

-- | Euclidian division of two 'Mutez' values.
divModMutez :: Mutez -> Mutez -> Maybe (Word64, Mutez)
divModMutez :: Mutez -> Mutez -> Maybe (Word64, Mutez)
divModMutez a :: Mutez
a (Mutez -> Word64
unMutez -> Word64
b) = (Mutez -> Word64) -> (Mutez, Mutez) -> (Word64, Mutez)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Mutez -> Word64
unMutez ((Mutez, Mutez) -> (Word64, Mutez))
-> Maybe (Mutez, Mutez) -> Maybe (Word64, Mutez)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutez -> Word64 -> Maybe (Mutez, Mutez)
forall a. Integral a => Mutez -> a -> Maybe (Mutez, Mutez)
divModMutezInt Mutez
a Word64
b

-- | Euclidian division of  'Mutez' and a number.
divModMutezInt :: Integral a => Mutez -> a -> Maybe (Mutez, Mutez)
divModMutezInt :: Mutez -> a -> Maybe (Mutez, Mutez)
divModMutezInt (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> (Mutez -> Word64) -> Mutez -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutez -> Word64
unMutez -> Integer
a) (a -> Integer
forall a. Integral a => a -> Integer
toInteger -> Integer
b)
  | Integer
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Maybe (Mutez, Mutez)
forall a. Maybe a
Nothing
  | Bool
otherwise = (Mutez, Mutez) -> Maybe (Mutez, Mutez)
forall a. a -> Maybe a
Just ((Mutez, Mutez) -> Maybe (Mutez, Mutez))
-> (Mutez, Mutez) -> Maybe (Mutez, Mutez)
forall a b. (a -> b) -> a -> b
$ (Integer -> Mutez)
-> (Integer -> Mutez) -> (Integer, Integer) -> (Mutez, Mutez)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Integer -> Mutez
toMutez' Integer -> Mutez
toMutez' (Integer
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
b)
  where
    toMutez' :: Integer -> Mutez
    toMutez' :: Integer -> Mutez
toMutez' = Word64 -> Mutez
Mutez (Word64 -> Mutez) -> (Integer -> Word64) -> Integer -> Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger

-- | Convert mutez to signed number.
--
-- TODO [#423]: try to provide a generic safe conversion method
mutezToInt64 :: Mutez -> Int64
mutezToInt64 :: Mutez -> Int64
mutezToInt64 = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (Mutez -> Word64) -> Mutez -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutez -> Word64
unMutez

zeroMutez :: Mutez
zeroMutez :: Mutez
zeroMutez = Word64 -> Mutez
Mutez Word64
forall a. Bounded a => a
minBound

oneMutez :: Mutez
oneMutez :: Mutez
oneMutez = Word64 -> Mutez
Mutez 1

-- |
-- >>> prettyTez (toMutez 420)
-- "0.00042 ꜩ"
-- >>> prettyTez (toMutez 42000000)
-- "42 ꜩ"
prettyTez :: Mutez -> Text
prettyTez :: Mutez -> Text
prettyTez ((Scientific -> Scientific -> Scientific
forall a. Fractional a => a -> a -> a
/ 1000000) (Scientific -> Scientific)
-> (Mutez -> Scientific) -> Mutez -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Scientific) -> (Mutez -> Word64) -> Mutez -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutez -> Word64
unMutez -> Scientific
s) =
  case Scientific -> Either Float Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
s of
    Left (Float
_ :: Float)    -> String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed Maybe Int
forall a. Maybe a
Nothing Scientific
s
    Right (Integer
n :: Integer) -> Integer -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Integer
n
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " ꜩ"

----------------------------------------------------------------------------
-- Timestamp
----------------------------------------------------------------------------

-- | Time in the real world.
-- Use the functions below to convert it to/from Unix time in seconds.
newtype Timestamp = Timestamp
  { Timestamp -> POSIXTime
unTimestamp :: POSIXTime
  } deriving stock (Int -> Timestamp -> ShowS
[Timestamp] -> ShowS
Timestamp -> String
(Int -> Timestamp -> ShowS)
-> (Timestamp -> String)
-> ([Timestamp] -> ShowS)
-> Show Timestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timestamp] -> ShowS
$cshowList :: [Timestamp] -> ShowS
show :: Timestamp -> String
$cshow :: Timestamp -> String
showsPrec :: Int -> Timestamp -> ShowS
$cshowsPrec :: Int -> Timestamp -> ShowS
Show, Timestamp -> Timestamp -> Bool
(Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool) -> Eq Timestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timestamp -> Timestamp -> Bool
$c/= :: Timestamp -> Timestamp -> Bool
== :: Timestamp -> Timestamp -> Bool
$c== :: Timestamp -> Timestamp -> Bool
Eq, Eq Timestamp
Eq Timestamp =>
(Timestamp -> Timestamp -> Ordering)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Timestamp)
-> (Timestamp -> Timestamp -> Timestamp)
-> Ord Timestamp
Timestamp -> Timestamp -> Bool
Timestamp -> Timestamp -> Ordering
Timestamp -> Timestamp -> Timestamp
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 :: Timestamp -> Timestamp -> Timestamp
$cmin :: Timestamp -> Timestamp -> Timestamp
max :: Timestamp -> Timestamp -> Timestamp
$cmax :: Timestamp -> Timestamp -> Timestamp
>= :: Timestamp -> Timestamp -> Bool
$c>= :: Timestamp -> Timestamp -> Bool
> :: Timestamp -> Timestamp -> Bool
$c> :: Timestamp -> Timestamp -> Bool
<= :: Timestamp -> Timestamp -> Bool
$c<= :: Timestamp -> Timestamp -> Bool
< :: Timestamp -> Timestamp -> Bool
$c< :: Timestamp -> Timestamp -> Bool
compare :: Timestamp -> Timestamp -> Ordering
$ccompare :: Timestamp -> Timestamp -> Ordering
$cp1Ord :: Eq Timestamp
Ord, Typeable Timestamp
DataType
Constr
Typeable Timestamp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Timestamp -> c Timestamp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Timestamp)
-> (Timestamp -> Constr)
-> (Timestamp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Timestamp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp))
-> ((forall b. Data b => b -> b) -> Timestamp -> Timestamp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Timestamp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Timestamp -> r)
-> (forall u. (forall d. Data d => d -> u) -> Timestamp -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Timestamp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp)
-> Data Timestamp
Timestamp -> DataType
Timestamp -> Constr
(forall b. Data b => b -> b) -> Timestamp -> Timestamp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timestamp -> c Timestamp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Timestamp
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Timestamp -> u
forall u. (forall d. Data d => d -> u) -> Timestamp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Timestamp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timestamp -> c Timestamp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Timestamp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp)
$cTimestamp :: Constr
$tTimestamp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
gmapMp :: (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
gmapM :: (forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Timestamp -> m Timestamp
gmapQi :: Int -> (forall d. Data d => d -> u) -> Timestamp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Timestamp -> u
gmapQ :: (forall d. Data d => d -> u) -> Timestamp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Timestamp -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timestamp -> r
gmapT :: (forall b. Data b => b -> b) -> Timestamp -> Timestamp
$cgmapT :: (forall b. Data b => b -> b) -> Timestamp -> Timestamp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Timestamp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Timestamp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Timestamp)
dataTypeOf :: Timestamp -> DataType
$cdataTypeOf :: Timestamp -> DataType
toConstr :: Timestamp -> Constr
$ctoConstr :: Timestamp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Timestamp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Timestamp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timestamp -> c Timestamp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timestamp -> c Timestamp
$cp1Data :: Typeable Timestamp
Data, (forall x. Timestamp -> Rep Timestamp x)
-> (forall x. Rep Timestamp x -> Timestamp) -> Generic Timestamp
forall x. Rep Timestamp x -> Timestamp
forall x. Timestamp -> Rep Timestamp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Timestamp x -> Timestamp
$cfrom :: forall x. Timestamp -> Rep Timestamp x
Generic)

instance NFData Timestamp

timestampToSeconds :: Integral a => Timestamp -> a
timestampToSeconds :: Timestamp -> a
timestampToSeconds = POSIXTime -> a
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> a) -> (Timestamp -> POSIXTime) -> Timestamp -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timestamp -> POSIXTime
unTimestamp
{-# INLINE timestampToSeconds #-}

timestampFromSeconds :: Integer -> Timestamp
timestampFromSeconds :: Integer -> Timestamp
timestampFromSeconds = POSIXTime -> Timestamp
Timestamp (POSIXTime -> Timestamp)
-> (Integer -> POSIXTime) -> Integer -> Timestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE timestampFromSeconds #-}

timestampFromUTCTime :: UTCTime -> Timestamp
timestampFromUTCTime :: UTCTime -> Timestamp
timestampFromUTCTime = POSIXTime -> Timestamp
Timestamp (POSIXTime -> Timestamp)
-> (UTCTime -> POSIXTime) -> UTCTime -> Timestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds
{-# INLINE timestampFromUTCTime #-}

timestampToUTCTime :: Timestamp -> UTCTime
timestampToUTCTime :: Timestamp -> UTCTime
timestampToUTCTime = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Timestamp -> POSIXTime) -> Timestamp -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timestamp -> POSIXTime
unTimestamp
{-# INLINE timestampToUTCTime #-}

-- | Add given amount of seconds to a 'Timestamp'.
timestampPlusSeconds :: Timestamp -> Integer -> Timestamp
timestampPlusSeconds :: Timestamp -> Integer -> Timestamp
timestampPlusSeconds ts :: Timestamp
ts sec :: Integer
sec = Integer -> Timestamp
timestampFromSeconds (Timestamp -> Integer
forall a. Integral a => Timestamp -> a
timestampToSeconds Timestamp
ts Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
sec)

-- | Display timestamp in human-readable way as used by Michelson.
-- Uses UTC timezone, though maybe we should take it as an argument.
--
-- NB: this will render timestamp with up to seconds precision.
formatTimestamp :: Timestamp -> Text
formatTimestamp :: Timestamp -> Text
formatTimestamp =
  ZonedTime -> Text
forall t. TextualMonoid t => ZonedTime -> t
formatTimeRFC3339 (ZonedTime -> Text)
-> (Timestamp -> ZonedTime) -> Timestamp -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
utc (UTCTime -> ZonedTime)
-> (Timestamp -> UTCTime) -> Timestamp -> ZonedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Timestamp -> POSIXTime) -> Timestamp -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timestamp -> POSIXTime
unTimestamp

instance Buildable Timestamp where
  build :: Timestamp -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (Timestamp -> Text) -> Timestamp -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timestamp -> Text
formatTimestamp

-- | Parse textual representation of 'Timestamp'.
parseTimestamp :: Text -> Maybe Timestamp
parseTimestamp :: Text -> Maybe Timestamp
parseTimestamp t :: Text
t
  -- `parseTimeM` does not allow to match on a single whitespace exclusively
  | Text -> Text -> Bool
T.isInfixOf "  " Text
t = Maybe Timestamp
forall a. Maybe a
Nothing
  | Bool
otherwise = (UTCTime -> Timestamp) -> Maybe UTCTime -> Maybe Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> Timestamp
timestampFromUTCTime (Maybe UTCTime -> Maybe Timestamp)
-> ([Maybe UTCTime] -> Maybe UTCTime)
-> [Maybe UTCTime]
-> Maybe Timestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe UTCTime] -> Maybe UTCTime
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum ([Maybe UTCTime] -> Maybe Timestamp)
-> [Maybe UTCTime] -> Maybe Timestamp
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe UTCTime) -> [Text] -> [Maybe UTCTime]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Maybe UTCTime
parse [Text]
formatsRFC3339
  where
    parse :: Text -> Maybe UTCTime
    parse :: Text -> Maybe UTCTime
parse frmt :: Text
frmt = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale (Text -> String
forall a. ToString a => a -> String
toString Text
frmt) (Text -> String
forall a. ToString a => a -> String
toString Text
t)

    formatsRFC3339 :: [Text]
    formatsRFC3339 :: [Text]
formatsRFC3339 = do
      Text
divider <- ["T", " "]
      Text
fraction <- ["%Q", ""]
      Text
zone <- ["Z", "%z"]
      return $ "%-Y-%m-%d" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
divider Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%T" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fraction Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
zone

-- | Quote a value of type 'Timestamp' in @yyyy-mm-ddThh:mm:ss[.sss]Z@ format.
--
-- >>> formatTimestamp [timestampQuote| 2019-02-21T16:54:12.2344523Z |]
-- "2019-02-21T16:54:12Z"
--
-- Inspired by 'time-quote' library.
timestampQuote :: TH.QuasiQuoter
timestampQuote :: QuasiQuoter
timestampQuote =
  QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
TH.QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp = \str :: String
str ->
      case Text -> Maybe Timestamp
parseTimestamp (Text -> Maybe Timestamp)
-> (Text -> Text) -> Text -> Maybe Timestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Maybe Timestamp) -> Text -> Maybe Timestamp
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText String
str of
        Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid timestamp, \
                        \example of valid value: `2019-02-21T16:54:12.2344523Z`"
        Just ts :: Timestamp
ts -> Timestamp -> Q Exp
forall a. Data a => a -> Q Exp
liftData Timestamp
ts
  , quotePat :: String -> Q Pat
quotePat = \_ -> String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "timestampQuote: cannot quote pattern!"
  , quoteType :: String -> Q Type
quoteType = \_ -> String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "timestampQuote: cannot quote type!"
  , quoteDec :: String -> Q [Dec]
quoteDec = \_ -> String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "timestampQuote: cannot quote declaration!"
  }

-- | Return current time as 'Timestamp'.
getCurrentTime :: IO Timestamp
getCurrentTime :: IO Timestamp
getCurrentTime = POSIXTime -> Timestamp
Timestamp (POSIXTime -> Timestamp) -> IO POSIXTime -> IO Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime
getPOSIXTime

-- | Timestamp which is always greater than result of 'getCurrentTime'.
farFuture :: Timestamp
farFuture :: Timestamp
farFuture = Integer -> Timestamp
timestampFromSeconds 1e12  -- 33658-09-27T01:46:40Z

-- | Timestamp which is always less than result of 'getCurrentTime'.
farPast :: Timestamp
farPast :: Timestamp
farPast = Integer -> Timestamp
timestampFromSeconds 0

----------------------------------------------------------------------------
-- Chain ID
----------------------------------------------------------------------------

{- Chain id in Tezos sources:
* https://gitlab.com/tezos/tezos/blob/de5c80b360aa396114be92a3a2e2ff2087190a61/src/lib_crypto/chain_id.ml
-}

-- | Identifier of a network (babylonnet, mainnet, test network or other).
-- Evaluated as hash of the genesis block.
--
-- The only operation supported for this type is packing.
-- Use case: multisig contract, for instance, now includes chain ID into
-- signed data "in order to add extra replay protection between the main
-- chain and the test chain".
newtype ChainId = ChainIdUnsafe { ChainId -> ByteString
unChainId :: ByteString }
  deriving stock (Int -> ChainId -> ShowS
[ChainId] -> ShowS
ChainId -> String
(Int -> ChainId -> ShowS)
-> (ChainId -> String) -> ([ChainId] -> ShowS) -> Show ChainId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainId] -> ShowS
$cshowList :: [ChainId] -> ShowS
show :: ChainId -> String
$cshow :: ChainId -> String
showsPrec :: Int -> ChainId -> ShowS
$cshowsPrec :: Int -> ChainId -> ShowS
Show, ChainId -> ChainId -> Bool
(ChainId -> ChainId -> Bool)
-> (ChainId -> ChainId -> Bool) -> Eq ChainId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainId -> ChainId -> Bool
$c/= :: ChainId -> ChainId -> Bool
== :: ChainId -> ChainId -> Bool
$c== :: ChainId -> ChainId -> Bool
Eq, (forall x. ChainId -> Rep ChainId x)
-> (forall x. Rep ChainId x -> ChainId) -> Generic ChainId
forall x. Rep ChainId x -> ChainId
forall x. ChainId -> Rep ChainId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainId x -> ChainId
$cfrom :: forall x. ChainId -> Rep ChainId x
Generic)

instance NFData ChainId

-- | Construct chain ID from raw bytes.
mkChainId :: ByteString -> Maybe ChainId
mkChainId :: ByteString -> Maybe ChainId
mkChainId bs :: ByteString
bs =
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
chainIdLength) Maybe () -> ChainId -> Maybe ChainId
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ByteString -> ChainId
ChainIdUnsafe ByteString
bs

-- | Construct chain ID from raw bytes or fail otherwise.
-- Expects exactly 4 bytes.
mkChainIdUnsafe :: HasCallStack => ByteString -> ChainId
mkChainIdUnsafe :: ByteString -> ChainId
mkChainIdUnsafe = ChainId -> Maybe ChainId -> ChainId
forall a. a -> Maybe a -> a
fromMaybe (Text -> ChainId
forall a. HasCallStack => Text -> a
error "Bad chain id") (Maybe ChainId -> ChainId)
-> (ByteString -> Maybe ChainId) -> ByteString -> ChainId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ChainId
mkChainId

-- | Identifier of a pseudo network.
dummyChainId :: ChainId
dummyChainId :: ChainId
dummyChainId = ByteString -> ChainId
ChainIdUnsafe "\0\0\0\0"

-- | Pretty print 'ChainId' as it is displayed e.g. in
-- @tezos-client rpc get /chains/main/chain_id@ call.
--
-- Example of produced value: "NetXUdfLh6Gm88t".
formatChainId :: ChainId -> Text
formatChainId :: ChainId -> Text
formatChainId (ChainId -> ByteString
unChainId -> ByteString
bs) = ByteString -> Text
encodeBase58Check (ByteString
chainIdPrefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs)

mformatChainId :: ChainId -> MText
mformatChainId :: ChainId -> MText
mformatChainId = HasCallStack => Text -> MText
Text -> MText
mkMTextUnsafe (Text -> MText) -> (ChainId -> Text) -> ChainId -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainId -> Text
formatChainId

instance Buildable ChainId where
  build :: ChainId -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (ChainId -> Text) -> ChainId -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainId -> Text
formatChainId

data ParseChainIdError
  = ParseChainIdWrongBase58Check
  | ParseChainIdWrongTag ByteString
  | ParseChainIdWrongSize Int
  deriving stock (Int -> ParseChainIdError -> ShowS
[ParseChainIdError] -> ShowS
ParseChainIdError -> String
(Int -> ParseChainIdError -> ShowS)
-> (ParseChainIdError -> String)
-> ([ParseChainIdError] -> ShowS)
-> Show ParseChainIdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseChainIdError] -> ShowS
$cshowList :: [ParseChainIdError] -> ShowS
show :: ParseChainIdError -> String
$cshow :: ParseChainIdError -> String
showsPrec :: Int -> ParseChainIdError -> ShowS
$cshowsPrec :: Int -> ParseChainIdError -> ShowS
Show, ParseChainIdError -> ParseChainIdError -> Bool
(ParseChainIdError -> ParseChainIdError -> Bool)
-> (ParseChainIdError -> ParseChainIdError -> Bool)
-> Eq ParseChainIdError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseChainIdError -> ParseChainIdError -> Bool
$c/= :: ParseChainIdError -> ParseChainIdError -> Bool
== :: ParseChainIdError -> ParseChainIdError -> Bool
$c== :: ParseChainIdError -> ParseChainIdError -> Bool
Eq)

instance Buildable ParseChainIdError where
  build :: ParseChainIdError -> Builder
build =
    \case
      ParseChainIdWrongBase58Check ->
        "Wrong base58check format"
      ParseChainIdWrongTag tag :: ByteString
tag ->
        "Wrong tag for a chain id: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
forall b. FromBuilder b => Builder -> b
fmt (ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
tag)
      ParseChainIdWrongSize s :: Int
s ->
        "Wrong size for a chain id: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall p. Buildable p => p -> Builder
build Int
s

instance Exception ParseChainIdError where
  displayException :: ParseChainIdError -> String
displayException = ParseChainIdError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

parseChainId :: Text -> Either ParseChainIdError ChainId
parseChainId :: Text -> Either ParseChainIdError ChainId
parseChainId text :: Text
text =
  case ByteString -> Text -> Either B58CheckWithPrefixError ByteString
decodeBase58CheckWithPrefix ByteString
chainIdPrefix Text
text of
    Left (B58CheckWithPrefixWrongPrefix prefix :: ByteString
prefix) ->
      ParseChainIdError -> Either ParseChainIdError ChainId
forall a b. a -> Either a b
Left (ByteString -> ParseChainIdError
ParseChainIdWrongTag ByteString
prefix)
    Left B58CheckWithPrefixWrongEncoding ->
      ParseChainIdError -> Either ParseChainIdError ChainId
forall a b. a -> Either a b
Left ParseChainIdError
ParseChainIdWrongBase58Check
    Right bs :: ByteString
bs -> case ByteString -> Maybe ChainId
mkChainId ByteString
bs of
      Just ci :: ChainId
ci -> ChainId -> Either ParseChainIdError ChainId
forall a b. b -> Either a b
Right ChainId
ci
      Nothing -> ParseChainIdError -> Either ParseChainIdError ChainId
forall a b. a -> Either a b
Left (ParseChainIdError -> Either ParseChainIdError ChainId)
-> ParseChainIdError -> Either ParseChainIdError ChainId
forall a b. (a -> b) -> a -> b
$ Int -> ParseChainIdError
ParseChainIdWrongSize (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bs)

chainIdLength :: Int
chainIdLength :: Int
chainIdLength = 4

-- | It's a magic constant used by Tezos to encode a chain ID.
-- Corresponds to "Net" part.
chainIdPrefix :: ByteString
chainIdPrefix :: ByteString
chainIdPrefix = "\87\82\0"

----------------------------------------------------------------------------
-- JSON
----------------------------------------------------------------------------

deriveJSON morleyAesonOptions ''Mutez
deriveJSON morleyAesonOptions ''Timestamp

instance ToJSON ChainId where
  toJSON :: ChainId -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (ChainId -> Text) -> ChainId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainId -> Text
formatChainId
instance FromJSON ChainId where
  parseJSON :: Value -> Parser ChainId
parseJSON = String -> (Text -> Parser ChainId) -> Value -> Parser ChainId
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText "chain id" ((Text -> Parser ChainId) -> Value -> Parser ChainId)
-> (Text -> Parser ChainId) -> Value -> Parser ChainId
forall a b. (a -> b) -> a -> b
$
    (ParseChainIdError -> Parser ChainId)
-> (ChainId -> Parser ChainId)
-> Either ParseChainIdError ChainId
-> Parser ChainId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser ChainId
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ChainId)
-> (ParseChainIdError -> String)
-> ParseChainIdError
-> Parser ChainId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseChainIdError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) ChainId -> Parser ChainId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseChainIdError ChainId -> Parser ChainId)
-> (Text -> Either ParseChainIdError ChainId)
-> Text
-> Parser ChainId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParseChainIdError ChainId
parseChainId