{-# LANGUAGE DeriveDataTypeable, DerivingStrategies #-}
module Tezos.Core
(
Mutez (unMutez)
, mkMutez
, unsafeMkMutez
, toMutez
, addMutez
, unsafeAddMutez
, subMutez
, unsafeSubMutez
, mulMutez
, divModMutez
, divModMutezInt
, Timestamp (..)
, timestampToSeconds
, timestampFromSeconds
, timestampFromUTCTime
, timestampPlusSeconds
, formatTimestamp
, parseTimestamp
, getCurrentTime
) where
import Data.Aeson.TH (defaultOptions, deriveJSON)
import Data.Data (Data(..))
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
import Data.Time.LocalTime (utc, utcToZonedTime, zonedTimeToUTC)
import Data.Time.RFC3339 (formatTimeRFC3339, parseTimeRFC3339)
import Formatting.Buildable (Buildable(build))
newtype Mutez = Mutez
{ unMutez :: Word64
} deriving stock (Show, Eq, Ord, Data, Generic)
deriving newtype (Enum, Buildable)
instance Bounded Mutez where
minBound = Mutez 0
maxBound = Mutez 9223372036854775807
mkMutez :: Word64 -> Maybe Mutez
mkMutez n
| n <= unMutez maxBound = Just (Mutez n)
| otherwise = Nothing
{-# INLINE mkMutez #-}
unsafeMkMutez :: HasCallStack => Word64 -> Mutez
unsafeMkMutez n =
fromMaybe (error $ "mkMutez: overflow (" <> show n <> ")") (mkMutez n)
{-# INLINE unsafeMkMutez #-}
toMutez :: Word32 -> Mutez
toMutez = unsafeMkMutez . fromIntegral
{-# INLINE toMutez #-}
addMutez :: Mutez -> Mutez -> Maybe Mutez
addMutez (unMutez -> a) (unMutez -> b) =
mkMutez (a + b)
{-# INLINE addMutez #-}
unsafeAddMutez :: HasCallStack => Mutez -> Mutez -> Mutez
unsafeAddMutez = fromMaybe (error "unsafeAddMutez: overflow") ... addMutez
subMutez :: Mutez -> Mutez -> Maybe Mutez
subMutez (unMutez -> a) (unMutez -> b)
| a >= b = Just (Mutez (a - b))
| otherwise = Nothing
{-# INLINE subMutez #-}
unsafeSubMutez :: HasCallStack => Mutez -> Mutez -> Mutez
unsafeSubMutez = fromMaybe (error "unsafeSubMutez: underflow") ... subMutez
mulMutez :: Integral a => Mutez -> a -> Maybe Mutez
mulMutez (unMutez -> a) b
| res <= toInteger (unMutez maxBound) = Just (Mutez (fromInteger res))
| otherwise = Nothing
where
res = toInteger a * toInteger b
{-# INLINE mulMutez #-}
divModMutez :: Mutez -> Mutez -> Maybe (Word64, Mutez)
divModMutez a (unMutez -> b) = first unMutez <$> divModMutezInt a b
divModMutezInt :: Integral a => Mutez -> a -> Maybe (Mutez, Mutez)
divModMutezInt (toInteger . unMutez -> a) (toInteger -> b)
| b <= 0 = Nothing
| otherwise = Just $ bimap toMutez' toMutez' (a `divMod` b)
where
toMutez' :: Integer -> Mutez
toMutez' = Mutez . fromInteger
newtype Timestamp = Timestamp
{ unTimestamp :: POSIXTime
} deriving stock (Show, Eq, Ord, Data, Generic)
timestampToSeconds :: Integral a => Timestamp -> a
timestampToSeconds = round . unTimestamp
{-# INLINE timestampToSeconds #-}
timestampFromSeconds :: Integral a => a -> Timestamp
timestampFromSeconds = Timestamp . fromIntegral
{-# INLINE timestampFromSeconds #-}
timestampFromUTCTime :: UTCTime -> Timestamp
timestampFromUTCTime = Timestamp . utcTimeToPOSIXSeconds
{-# INLINE timestampFromUTCTime #-}
timestampPlusSeconds :: Timestamp -> Integer -> Timestamp
timestampPlusSeconds ts sec = timestampFromSeconds (timestampToSeconds ts + sec)
formatTimestamp :: Timestamp -> Text
formatTimestamp =
formatTimeRFC3339 . utcToZonedTime utc . posixSecondsToUTCTime . unTimestamp
instance Buildable Timestamp where
build = build . formatTimestamp
parseTimestamp :: Text -> Maybe Timestamp
parseTimestamp = fmap (timestampFromUTCTime . zonedTimeToUTC) . parseTimeRFC3339
getCurrentTime :: IO Timestamp
getCurrentTime = Timestamp <$> getPOSIXTime
deriveJSON defaultOptions ''Mutez
deriveJSON defaultOptions ''Timestamp