Timestamp.hs

module Effectful.OpenTelemetry.Timestamp where

import Control.Monad (MonadPlus (mzero))
import Data.Aeson.Types (FromJSON (..), ToJSON (..), Value (..), withText)
import Data.Text qualified as Text
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Time.Clock.System (SystemTime (..), getSystemTime)
import Data.Time.Format.ISO8601 (iso8601Show)
import Data.Word (Word64)
import GHC.Generics (Generic)
import Prettyprinter (Pretty (..))
import Prettyprinter.Extra (PrettyAnn (..))
import Proto3.Wire.Encode.Class qualified as Proto
import Text.Read (readMaybe)
import Prelude

-- | UNIX timestamp with nanosecond precision.
newtype Timestamp = Timestamp {nanos :: Word64}
    deriving stock (Generic)
    deriving newtype (Show, Eq, Ord)

epoch :: Timestamp
epoch = Timestamp 0

now :: IO Timestamp
now = do
    MkSystemTime{systemSeconds, systemNanoseconds} <- getSystemTime
    pure . Timestamp $
        fromIntegral systemSeconds * 1_000_000_000 + fromIntegral systemNanoseconds

instance FromJSON Timestamp where
    parseJSON = withText "Timestamp" $ maybe mzero (pure . Timestamp) . readMaybe . Text.unpack

instance ToJSON Timestamp where
    toJSON = String . Text.show

instance {-# OVERLAPPING #-} Proto.EncodeField Timestamp where
    encodeField n = Proto.fixed64 n . nanos

-- | yyyy-mm-ddThh:mm:ss[.sss]Z (ISO 8601:2004(E) sec. 4.3.2 extended format)
instance PrettyAnn ann Timestamp where
    prettyAnn Timestamp{..} = pretty . iso8601Show . posixSecondsToUTCTime $ fromIntegral nanos / 1_000_000_000