-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Core primitive Tezos types.

module Morley.Tezos.Core
  (
    -- * Mutez
    Mutez (..)
  , tz
  , mkMutez
  , toMutez
  , addMutez
  , unsafeAddMutez
  , subMutez
  , unsafeSubMutez
  , mulMutez
  , unsafeMulMutez
  , divModMutez
  , divModMutezInt
  , zeroMutez
  , oneMutez
  , prettyTez

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

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

import Data.Aeson (FromJSON(..), ToJSON(..))
import Data.Aeson qualified as Aeson
import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Data.Scientific
  (FPFormat(Fixed), Scientific, floatingOrInteger, formatScientific, isFloating, scientificP,
  toBoundedInteger)
import Data.Text qualified 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 Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Quote qualified as TH
import Language.Haskell.TH.Syntax (liftData)
import Options.Applicative qualified as Opt
import Text.ParserCombinators.ReadP (ReadP, eof, readP_to_S, skipSpaces, string, (+++))
import Unsafe qualified (unsafeM)

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

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

-- | Mutez is a wrapper over integer data type. 1 mutez is 1 token (μTz).
--
-- The constructor is marked "Unsafe" since GHC does not warn on overflowing
-- literals (exceeding custom 'Word63' type bounds), thus the resultant
-- 'Mutez' value may get truncated silently.
--
-- >>> UnsafeMutez 9223372036854775809
-- UnsafeMutez {unMutez = 1}
newtype Mutez = UnsafeMutez
  { Mutez -> Word63
unMutez :: Word63
  } 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
Ord, (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, Mutez
Mutez -> Mutez -> Bounded Mutez
forall a. a -> a -> Bounded a
maxBound :: Mutez
$cmaxBound :: Mutez
minBound :: Mutez
$cminBound :: Mutez
Bounded)

instance Buildable Mutez where
  build :: Mutez -> Builder
build (UnsafeMutez Word63
w) = Word63 -> Builder
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word63
w Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" μꜩ"

instance NFData Mutez where
  rnf :: Mutez -> ()
rnf (UnsafeMutez !Word63
_) = ()

instance HasCLReader Mutez where
  getReader :: ReadM Mutez
getReader = (Text -> ReadM Mutez)
-> (Mutez -> ReadM Mutez) -> Either Text Mutez -> ReadM Mutez
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ReadM Mutez
forall a. String -> ReadM a
readerError (String -> ReadM Mutez) -> (Text -> String) -> Text -> ReadM Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString) Mutez -> ReadM Mutez
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Mutez -> ReadM Mutez)
-> (Word64 -> Either Text Mutez) -> Word64 -> ReadM Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => i -> Either Text Mutez
mkMutez @Word64 (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 = String
"MUTEZ"

{- | Quotes a 'Mutez' value.

The value is in XTZ, i.e. 1e6 'Mutez', with optional suffix representing
a unit:

* @k@, @kilo@ -- 1000 XTZ
* @M@, @Mega@, @mega@ -- 1000000 XTZ
* @m@, @milli@ -- 0.001 XTZ
* @u@, @μ@, @micro@ -- 0.000001 XTZ

This is the safest and recommended way to create 'Mutez' from a numeric literal.

The suffix can be separated from the number by whitespace.
You can also use underscores as a delimiter (those will be ignored), and
scientific notation, e.g. @123.456e6@. Note that if the scientific notation
represents a mutez fraction, that is a compile-time error.

>>> [tz|123|]
UnsafeMutez {unMutez = 123000000}

>>> [tz|123k|]
UnsafeMutez {unMutez = 123000000000}

>>> [tz|123 kilo|]
UnsafeMutez {unMutez = 123000000000}

>>> [tz|123M|]
UnsafeMutez {unMutez = 123000000000000}

>>> [tz|123 Mega|]
UnsafeMutez {unMutez = 123000000000000}

>>> [tz|123 mega|]
UnsafeMutez {unMutez = 123000000000000}

>>> [tz|123e6|]
UnsafeMutez {unMutez = 123000000000000}

>>> [tz|123m|]
UnsafeMutez {unMutez = 123000}

>>> [tz|123 milli|]
UnsafeMutez {unMutez = 123000}

>>> [tz|123u|]
UnsafeMutez {unMutez = 123}

>>> [tz|123μ|]
UnsafeMutez {unMutez = 123}

>>> [tz|123 micro|]
UnsafeMutez {unMutez = 123}

>>> [tz| 123.456_789 |]
UnsafeMutez {unMutez = 123456789}

>>> [tz|123.456u|]
...
... error:
...  • The number is a mutez fraction. The smallest possible subdivision is 0.000001 XTZ
...

>>> [tz|0.012_345_6|]
...
... error:
...  • The number is a mutez fraction. The smallest possible subdivision is 0.000001 XTZ
...

>>> [tz| 9223372.036854775807 M |]
UnsafeMutez {unMutez = 9223372036854775807}

>>> [tz| 9223372.036854775808 M |]
...
... error:
...  • The number is out of mutez bounds. It must be between 0 and 9223372036854.775807 XTZ (inclusive).
...

>>> [tz| -1 |]
...
... error:
...  • The number is out of mutez bounds. It must be between 0 and 9223372036854.775807 XTZ (inclusive).
...
-}
tz :: TH.QuasiQuoter
tz :: QuasiQuoter
tz = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
TH.QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp = \String
inp -> do
      Word64
val <- forall t (m :: * -> *).
(CheckIntSubType Word63 t, Integral t, MonadFail m) =>
String -> m t
parseTez @Word64 String
inp
      [| UnsafeMutez val |]
  , quotePat :: String -> Q Pat
quotePat = \String
inp -> do
      Integer
val <- forall t (m :: * -> *).
(CheckIntSubType Word63 t, Integral t, MonadFail m) =>
String -> m t
parseTez @Integer String
inp
      [p| UnsafeMutez $(pure $ TH.LitP $ TH.IntegerL val) |]
  , quoteType :: String -> Q Type
quoteType = Q Type -> String -> Q Type
forall a b. a -> b -> a
const (Q Type -> String -> Q Type) -> Q Type -> String -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot be used as type"
  , quoteDec :: String -> Q [Dec]
quoteDec = Q [Dec] -> String -> Q [Dec]
forall a b. a -> b -> a
const (Q [Dec] -> String -> Q [Dec]) -> Q [Dec] -> String -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot be used as dec"
  }
  where
    parseTez :: forall t m. (CheckIntSubType Word63 t, Integral t, MonadFail m) => String -> m t
    parseTez :: forall t (m :: * -> *).
(CheckIntSubType Word63 t, Integral t, MonadFail m) =>
String -> m t
parseTez String
inp = Word63 -> t
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (Word63 -> t) -> m Word63 -> m t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      case ReadP Scientific -> ReadS Scientific
forall a. ReadP a -> ReadS a
readP_to_S (ReadP ()
skipSpaces ReadP () -> ReadP Scientific -> ReadP Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP Scientific
parser) ReadS Scientific -> ReadS Scientific
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'_') String
inp of
        [(Scientific
val, String
"")] -> Either String Word63 -> m Word63
forall (m :: * -> *) a b.
(MonadFail m, Buildable a) =>
Either a b -> m b
unsafeM (Either String Word63 -> m Word63)
-> (Maybe Word63 -> Either String Word63)
-> Maybe Word63
-> m Word63
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Word63 -> Either String Word63
forall l r. l -> Maybe r -> Either l r
maybeToRight (Scientific -> String
oobErr Scientific
val) (Maybe Word63 -> m Word63) -> Maybe Word63 -> m Word63
forall a b. (a -> b) -> a -> b
$ forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger @Word63 Scientific
val
        [(Scientific, String)]
_ -> String -> m Word63
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no parse"
    parser :: ReadP Scientific
parser = Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(*) (Scientific -> Scientific -> Scientific)
-> ReadP Scientific -> ReadP (Scientific -> Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReadP Scientific
scientificP ReadP Scientific -> ReadP () -> ReadP Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
skipSpaces) ReadP (Scientific -> Scientific)
-> ReadP Scientific -> ReadP Scientific
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReadP Scientific
unit ReadP Scientific -> ReadP () -> ReadP Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
skipSpaces) ReadP Scientific -> ReadP () -> ReadP Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
eof
    oobErr :: Scientific -> String
    oobErr :: Scientific -> String
oobErr Scientific
val
      | Scientific -> Bool
isFloating Scientific
val = String
"The number is a mutez fraction. \
          \The smallest possible subdivision is 0.000001 XTZ"
      | Bool
otherwise = String
"The number is out of mutez bounds. \
          \It must be between 0 and 9223372036854.775807 XTZ (inclusive)."
    unit :: ReadP Scientific
    unit :: ReadP Scientific
unit = (String -> ReadP String
string String
"M" ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
+++ String -> ReadP String
string String
"Mega" ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
+++ String -> ReadP String
string String
"mega" ReadP String -> Scientific -> ReadP Scientific
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Scientific
1e12)
       ReadP Scientific -> ReadP Scientific -> ReadP Scientific
forall a. ReadP a -> ReadP a -> ReadP a
+++ (String -> ReadP String
string String
"k" ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
+++ String -> ReadP String
string String
"kilo" ReadP String -> Scientific -> ReadP Scientific
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Scientific
1e9)
       ReadP Scientific -> ReadP Scientific -> ReadP Scientific
forall a. ReadP a -> ReadP a -> ReadP a
+++ (String -> ReadP String
string String
"m" ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
+++ String -> ReadP String
string String
"milli" ReadP String -> Scientific -> ReadP Scientific
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Scientific
1e3)
       ReadP Scientific -> ReadP Scientific -> ReadP Scientific
forall a. ReadP a -> ReadP a -> ReadP a
+++ (String -> ReadP String
string String
"u" ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
+++ String -> ReadP String
string String
"μ" ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
+++ String -> ReadP String
string String
"micro" ReadP String -> Scientific -> ReadP Scientific
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Scientific
1)
       ReadP Scientific -> ReadP Scientific -> ReadP Scientific
forall a. ReadP a -> ReadP a -> ReadP a
+++ (Scientific -> ReadP Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
1e6)

-- | Safely creates 'Mutez' checking for
-- overflow and underflow. Accepts a number of any type.
mkMutez :: Integral i => i -> Either Text Mutez
mkMutez :: forall i. Integral i => i -> Either Text Mutez
mkMutez = (ArithException -> Text)
-> (Word63 -> Mutez)
-> Either ArithException Word63
-> Either Text Mutez
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text)
-> (ArithException -> String) -> ArithException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArithException -> String
forall e. Exception e => e -> String
displayException) Word63 -> Mutez
UnsafeMutez (Either ArithException Word63 -> Either Text Mutez)
-> (i -> Either ArithException Word63) -> i -> Either Text Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either ArithException Word63
forall a b.
(Integral a, Integral b) =>
a -> Either ArithException b
fromIntegralNoOverflow

-- | Safely create 'Mutez'.
--
-- When constructing literals, you'll need to specify the type of the literal.
-- GHC will check for literal overflow on builtin types like 'Word16' and
-- 'Word32', but not on 'Word62' or 'Word63', so those can overflow silently.
--
-- It's recommended to use 'tz' quasiquote for literals instead.
toMutez :: (Integral a, CheckIntSubType a Word63) => a -> Mutez
toMutez :: forall a. (Integral a, CheckIntSubType a Word63) => a -> Mutez
toMutez = Word63 -> Mutez
UnsafeMutez (Word63 -> Mutez) -> (a -> Word63) -> a -> Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word63
forall a b. (Integral a, Integral b, CheckIntSubType a 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 -> Word63
unMutez -> Word63
a) (Mutez -> Word63
unMutez -> Word63
b) =
  Either Text Mutez -> Maybe Mutez
forall l r. Either l r -> Maybe r
rightToMaybe (Either Text Mutez -> Maybe Mutez)
-> Either Text Mutez -> Maybe Mutez
forall a b. (a -> b) -> a -> b
$ forall i. Integral i => i -> Either Text Mutez
mkMutez @Word64 (Word64 -> Either Text Mutez) -> Word64 -> Either Text Mutez
forall a b. (a -> b) -> a -> b
$
    -- NB: plain @a + b@ might overflow and
    -- thus we widen the operands (and the sum)
    -- to 'Word64'
    Word63 -> Word64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral Word63
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word63 -> Word64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral Word63
b
{-# 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 :: HasCallStack => Mutez -> Mutez -> Mutez
unsafeAddMutez = Mutez -> Maybe Mutez -> Mutez
forall a. a -> Maybe a -> a
fromMaybe (Text -> Mutez
forall a. HasCallStack => Text -> a
error Text
"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 -> Word63
unMutez -> Word63
a) (Mutez -> Word63
unMutez -> Word63
b)
  | Word63
a Word63 -> Word63 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word63
b = Mutez -> Maybe Mutez
forall a. a -> Maybe a
Just (Word63 -> Mutez
UnsafeMutez (Word63
a Word63 -> Word63 -> Word63
forall a. Num a => a -> a -> a
- Word63
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 :: HasCallStack => Mutez -> Mutez -> Mutez
unsafeSubMutez = Mutez -> Maybe Mutez -> Mutez
forall a. a -> Maybe a -> a
fromMaybe (Text -> Mutez
forall a. HasCallStack => Text -> a
error Text
"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 :: forall a. Integral a => Mutez -> a -> Maybe Mutez
mulMutez (Mutez -> Word63
unMutez -> Word63
a) a
b
    | Integer
res Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word63 -> Integer
forall a. Integral a => a -> Integer
toInteger (Mutez -> Word63
unMutez Mutez
forall a. Bounded a => a
maxBound) = Mutez -> Maybe Mutez
forall a. a -> Maybe a
Just (Word63 -> Mutez
UnsafeMutez (Integer -> Word63
forall a. (HasCallStack, Integral a) => Integer -> a
fromInteger Integer
res))
    | Bool
otherwise = Maybe Mutez
forall a. Maybe a
Nothing
  where
    res :: Integer
res = Word63 -> Integer
forall a. Integral a => a -> Integer
toInteger Word63
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* a -> Integer
forall a. Integral a => a -> Integer
toInteger a
b
{-# INLINE mulMutez #-}

-- | Partial multiplication of 'Mutez' and an Natural number.
-- Should be used only if you're sure there'll be no overflow.
unsafeMulMutez :: Mutez -> Natural -> Mutez
unsafeMulMutez :: Mutez -> Natural -> Mutez
unsafeMulMutez = Mutez -> Maybe Mutez -> Mutez
forall a. a -> Maybe a -> a
fromMaybe (Text -> Mutez
forall a. HasCallStack => Text -> a
error Text
"unsafeMulMutez: overflow") (Maybe Mutez -> Mutez)
-> (Mutez -> Natural -> Maybe Mutez) -> Mutez -> Natural -> Mutez
forall a b c. SuperComposition a b c => a -> b -> c
... Mutez -> Natural -> Maybe Mutez
forall a. Integral a => Mutez -> a -> Maybe Mutez
mulMutez

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

-- | Euclidian division of  'Mutez' and a number.
divModMutezInt :: Integral a => Mutez -> a -> Maybe (Mutez, Mutez)
divModMutezInt :: forall a. Integral a => Mutez -> a -> Maybe (Mutez, Mutez)
divModMutezInt (Word63 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word63 -> Integer) -> (Mutez -> Word63) -> Mutez -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutez -> Word63
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
<= Integer
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' = Word63 -> Mutez
UnsafeMutez (Word63 -> Mutez) -> (Integer -> Word63) -> Integer -> Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word63
forall a. (HasCallStack, Integral a) => Integer -> a
fromInteger

zeroMutez :: Mutez
zeroMutez :: Mutez
zeroMutez = Word63 -> Mutez
UnsafeMutez Word63
forall a. Bounded a => a
minBound

oneMutez :: Mutez
oneMutez :: Mutez
oneMutez = Word63 -> Mutez
UnsafeMutez Word63
1

-- |
-- >>> putTextLn $ prettyTez [tz|420u|]
-- 0.00042 ꜩ
--
-- >>> putTextLn $ prettyTez [tz|42|]
-- 42 ꜩ
prettyTez :: Mutez -> Text
prettyTez :: Mutez -> Text
prettyTez ((Scientific -> Scientific -> Scientific
forall a. Fractional a => a -> a -> a
/ Scientific
1000000) (Scientific -> Scientific)
-> (Mutez -> Scientific) -> Mutez -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word63 -> Scientific
forall a b.
(Integral a, RealFrac b, CheckIntSubType a Integer) =>
a -> b
fromIntegralToRealFrac (Word63 -> Scientific) -> (Mutez -> Word63) -> Mutez -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutez -> Word63
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
<> Text
" ꜩ"

----------------------------------------------------------------------------
-- 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
Ord, Typeable Timestamp
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 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Timestamp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Timestamp -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Timestamp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Timestamp -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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 :: forall a. Integral a => 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, RealFrac b, CheckIntSubType a Integer) =>
a -> b
fromIntegralToRealFrac
{-# 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 Timestamp
ts 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 Text
t
  -- `parseTimeM` does not allow to match on a single whitespace exclusively
  | Text -> Text -> Bool
T.isInfixOf Text
"  " 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 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 <- [Text
"T", Text
" "]
      Text
fraction <- [Text
"%Q", Text
""]
      Text
zone <- [Text
"Z", Text
"%z"]
      return $ Text
"%-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
<> Text
"%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 = \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
        Maybe Timestamp
Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid timestamp, \
                        \example of valid value: `2019-02-21T16:54:12.2344523Z`"
        Just Timestamp
ts -> Timestamp -> Q Exp
forall (m :: * -> *) a. (Quote m, Data a) => a -> m Exp
liftData Timestamp
ts
  , quotePat :: String -> Q Pat
quotePat = \String
_ -> String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"timestampQuote: cannot quote pattern!"
  , quoteType :: String -> Q Type
quoteType = \String
_ -> String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"timestampQuote: cannot quote type!"
  , quoteDec :: String -> Q [Dec]
quoteDec = \String
_ -> String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 Integer
1e12  -- 33658-09-27T01:46:40Z

-- | Timestamp which is always less than result of 'getCurrentTime'.
farPast :: Timestamp
farPast :: Timestamp
farPast = Integer -> Timestamp
timestampFromSeconds Integer
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 = UnsafeChainId { 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, Eq ChainId
Eq ChainId
-> (ChainId -> ChainId -> Ordering)
-> (ChainId -> ChainId -> Bool)
-> (ChainId -> ChainId -> Bool)
-> (ChainId -> ChainId -> Bool)
-> (ChainId -> ChainId -> Bool)
-> (ChainId -> ChainId -> ChainId)
-> (ChainId -> ChainId -> ChainId)
-> Ord ChainId
ChainId -> ChainId -> Bool
ChainId -> ChainId -> Ordering
ChainId -> ChainId -> ChainId
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 :: ChainId -> ChainId -> ChainId
$cmin :: ChainId -> ChainId -> ChainId
max :: ChainId -> ChainId -> ChainId
$cmax :: ChainId -> ChainId -> ChainId
>= :: ChainId -> ChainId -> Bool
$c>= :: ChainId -> ChainId -> Bool
> :: ChainId -> ChainId -> Bool
$c> :: ChainId -> ChainId -> Bool
<= :: ChainId -> ChainId -> Bool
$c<= :: ChainId -> ChainId -> Bool
< :: ChainId -> ChainId -> Bool
$c< :: ChainId -> ChainId -> Bool
compare :: ChainId -> ChainId -> Ordering
$ccompare :: ChainId -> ChainId -> Ordering
Ord, (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 -> Either ParseChainIdError ChainId
mkChainId :: ByteString -> Either ParseChainIdError ChainId
mkChainId ByteString
bs =
  if ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
chainIdLength
  then ChainId -> Either ParseChainIdError ChainId
forall a b. b -> Either a b
Right (ChainId -> Either ParseChainIdError ChainId)
-> ChainId -> Either ParseChainIdError ChainId
forall a b. (a -> b) -> a -> b
$ ByteString -> ChainId
UnsafeChainId ByteString
bs
  else ParseChainIdError -> Either ParseChainIdError ChainId
forall a b. a -> Either a b
Left (ParseChainIdError -> Either ParseChainIdError ChainId)
-> (Int -> ParseChainIdError)
-> Int
-> Either ParseChainIdError ChainId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ParseChainIdError
ParseChainIdWrongSize (Int -> Either ParseChainIdError ChainId)
-> Int -> Either ParseChainIdError ChainId
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bs

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

-- | Pretty print 'ChainId' as it is displayed e.g. in
-- @octez-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 = Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (ChainId -> Either Text MText) -> ChainId -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> (ChainId -> Text) -> ChainId -> Either Text 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
      ParseChainIdError
ParseChainIdWrongBase58Check ->
        Builder
"Wrong base58check format"
      ParseChainIdWrongTag ByteString
tag ->
        Builder
"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 Int
s ->
        Builder
"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 =
  case ByteString -> Text -> Either B58CheckWithPrefixError ByteString
decodeBase58CheckWithPrefix ByteString
chainIdPrefix Text
text of
    Left (B58CheckWithPrefixWrongPrefix ByteString
prefix) ->
      ParseChainIdError -> Either ParseChainIdError ChainId
forall a b. a -> Either a b
Left (ByteString -> ParseChainIdError
ParseChainIdWrongTag ByteString
prefix)
    Left B58CheckWithPrefixError
B58CheckWithPrefixWrongEncoding ->
      ParseChainIdError -> Either ParseChainIdError ChainId
forall a b. a -> Either a b
Left ParseChainIdError
ParseChainIdWrongBase58Check
    Right ByteString
bs -> ByteString -> Either ParseChainIdError ChainId
mkChainId ByteString
bs

chainIdLength :: Int
chainIdLength :: Int
chainIdLength = Int
4

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

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

instance FromJSON Mutez where
  parseJSON :: Value -> Parser Mutez
parseJSON Value
v = do
    Int64
i <- forall a. FromJSON a => Value -> Parser a
parseJSON @Int64 Value
v
    Either Text Mutez -> Parser Mutez
forall (m :: * -> *) a b.
(MonadFail m, Buildable a) =>
Either a b -> m b
Unsafe.unsafeM (Either Text Mutez -> Parser Mutez)
-> Either Text Mutez -> Parser Mutez
forall a b. (a -> b) -> a -> b
$ Int64 -> Either Text Mutez
forall i. Integral i => i -> Either Text Mutez
mkMutez Int64
i

instance ToJSON Mutez where
  toJSON :: Mutez -> Value
toJSON (UnsafeMutez Word63
a) = Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (Word64 -> Value) -> Word64 -> Value
forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral @Word63 @Word64 Word63
a

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 String
"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