HTTPS.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE CPP #-}

-- | This is a log scribe that writes logs to logz.io's bulk
-- <https://app.logz.io/#/dashboard/data-sources/Bulk-HTTPS HTTPS
-- API>.
module Katip.Scribes.LogzIO.HTTPS
  ( -- * Scribe construction
    mkLogzIOScribe,

    -- * Types
    BulkAPIError (..),
    LogzIOScribeConfiguration (..),
    Scheme (..),
    APIToken (..),
    LoggingError (..),

    -- ** Presets for configuration
    usRegionHost,
    euRegionHost,
    httpsPort,
    httpPort,
    defaultRetryPolicy,
    defaultLogzIOScribeConfiguration,

    -- * Internal API exported for testing
    renderLineTruncated,
    renderLineTruncated',
    maxPayloadBytes,
    maxLogLineLength,
    BulkBuffer (..),
    LogAction (..),
    bufferItem,
    bufferItem',
    forceFlush,
    Bytes (..),
  )
where

-------------------------------------------------------------------------------
import Control.Applicative
import qualified Control.Concurrent.Async as Async
import qualified Control.Concurrent.STM as STM
import qualified Control.Concurrent.STM.TBMQueue as STM
import qualified Control.Error as E
import qualified Control.Exception.Safe as EX
import Control.Monad
import qualified Control.Retry as Retry
import qualified Data.Aeson as A
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBS8
#if MIN_VERSION_aeson (2, 0, 0)
import qualified Data.Aeson.Key as A
import qualified Data.Aeson.KeyMap as A
#else
import qualified Data.HashMap.Strict as HM
#endif
import Data.Int
import qualified Data.Scientific as Scientific
import Data.Semigroup as Semigroup
import Data.String (IsString)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Time as Time
import qualified Katip as K
import Katip.Core (LocJs (..))
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.TLS as HTTPS
import qualified Network.HTTP.Types as HTypes
import qualified System.Posix.Types as POSIX
import qualified URI.ByteString as URIBS

-------------------------------------------------------------------------------

-- | This is returned when the bulk import was a partial success
data BulkAPIError = BulkAPIError
  { -- | The number of log lines which are not well-formed JSON. This
    -- indicates a __library bug__. Please file an issue on GitHub.
    bulkAPIError_malformedLines :: Int,
    -- | The number of log lines received successfully.
    bulkAPIError_successfulLines :: Int,
    -- | The number of log lines which exceed the line length
    -- limit. katip-logzio makes a best effort to truncate logs that
    -- exceed the size limit. This probably indicates a __library bug__
    -- and should be reported as an issue on GitHub.
    bulkAPIError_oversizedLines :: Int,
    -- | The number of log lines which were empty. There isnt' really a
    -- concept of a truly empty log line in katip, so this most likely
    -- indicates a __library bug__ and should be reported as an issue on
    -- GitHub.
    bulkAPIError_emptyLogLines :: Int
  }
  deriving (Show, Eq)

instance A.FromJSON BulkAPIError where
  parseJSON = A.withObject "BulkAPIError" $ \o -> do
    malformedLines <- o A..: "malformedLines"
    successfulLines <- o A..: "successfulLines"
    oversizedLines <- o A..: "oversizedLines"
    emptyLogLines <- o A..: "emptyLogLines"
    pure $
      BulkAPIError
        { bulkAPIError_malformedLines = malformedLines,
          bulkAPIError_successfulLines = successfulLines,
          bulkAPIError_oversizedLines = oversizedLines,
          bulkAPIError_emptyLogLines = emptyLogLines
        }

-------------------------------------------------------------------------------
data LogzIOScribeConfiguration = LogzIOScribeConfiguration
  { -- | Will flush the log buffer if this many items is in the buffer
    -- __or__ 'logzIOScribeConfiguration_bufferTimeout' is reached,
    -- whichever is first
    logzIOScribeConfiguration_bufferItems :: Int,
    -- | Will flush the buffer if it has been this long since the last
    -- flush __or__ 'logzIOScribeConfiguration_bufferItems' items are
    -- accumulated, whichever is first. NominalDiffTime has a Num
    -- instance, so you can use a literal to specify seconds, e.g. 30 =
    -- 30s.
    logzIOScribeConfiguration_bufferTimeout :: Time.NominalDiffTime,
    logzIOScribeConfiguration_scheme :: Scheme,
    logzIOScribeConfiguration_host :: URIBS.Host,
    logzIOScribeConfiguration_port :: URIBS.Port,
    logzIOScribeConfiguration_token :: APIToken,
    -- | How should exceptions during writes be retried?
    logzIOScribeConfiguration_retry :: Retry.RetryPolicyM IO,
    logzIOScribeConfiguration_onError :: LoggingError -> IO ()
  }

-- | A default configuration:
--
--    * 100 item buffering
--
--    * 30 second buffer timeout
--
--    * US, HTTPS logging endpoint (listener.logz.io:8071)
--
--    * 'defaultRetryPolicy' of 25ms exponential backoff, 5 retries
--
--    * Ignore logging errors
defaultLogzIOScribeConfiguration :: APIToken -> LogzIOScribeConfiguration
defaultLogzIOScribeConfiguration token =
  LogzIOScribeConfiguration
    { logzIOScribeConfiguration_bufferItems = 100,
      logzIOScribeConfiguration_bufferTimeout = 30,
      logzIOScribeConfiguration_scheme = HTTPS,
      logzIOScribeConfiguration_host = usRegionHost,
      logzIOScribeConfiguration_port = httpsPort,
      logzIOScribeConfiguration_token = token,
      logzIOScribeConfiguration_retry = defaultRetryPolicy,
      logzIOScribeConfiguration_onError = const (pure ())
    }

-------------------------------------------------------------------------------

-- | You can retrieve your account or sub-account's API token on the
-- <https://app.logz.io/#/dashboard/settings/manage-accounts manage
-- accounts page>. Note that APIToken has an IsString instance,
-- meaning that you can use a string literal with OverloadedStrings
-- enabled.
newtype APIToken = APIToken
  { apiToken :: T.Text
  }
  deriving (Show, Eq, IsString)

-- | This particular bulk API only supports HTTP or HTTPS. HTTPS is
-- strongly recommended for security reasons.
data Scheme
  = -- | HTTPs should always be used except for local testing.
    HTTPS
  | HTTP
  deriving (Show, Eq)

-- | See
-- <https://support.logz.io/hc/en-us/articles/210206365-What-IP-addresses-should-I-open-in-my-firewall-to-ship-logs-to-Logz-io-
-- this> for a list of listeners. This is the US region host,
-- listener.logz.io
usRegionHost :: URIBS.Host
usRegionHost = URIBS.Host "listener.logz.io"

-- | See
-- <https://support.logz.io/hc/en-us/articles/210206365-What-IP-addresses-should-I-open-in-my-firewall-to-ship-logs-to-Logz-io-
-- this> for a list of listeners. This is the EU region host,
-- listener.logz.io
euRegionHost :: URIBS.Host
euRegionHost = URIBS.Host "listener-eu.logz.io"

-- | Logz.io uses port 8071 for HTTPS
httpsPort :: URIBS.Port
httpsPort = URIBS.Port 8071

-- | Logz.io uses port 8070 for HTTP
httpPort :: URIBS.Port
httpPort = URIBS.Port 8070

-- | A reasonable retry policy: exponential backoff with 25ms base
-- delay up to 5 retries, for a total cumulative delay of 775ms.
defaultRetryPolicy :: (Monad m) => Retry.RetryPolicyM m
defaultRetryPolicy = Retry.exponentialBackoff 25000 `mappend` Retry.limitRetries 5

-------------------------------------------------------------------------------
mkLogzIOScribe ::
  LogzIOScribeConfiguration ->
  K.PermitFunc ->
  K.Verbosity ->
  IO K.Scribe
mkLogzIOScribe config permitItem verbosity = do
  -- This size is actually somewhat arbitrary. We're just making sure
  -- it isn't infinite so we don't consume the whole backlog right
  -- away and take up lots of memory.. Katip above us does bounded
  -- buffering and load-shedding when there's too much of a
  -- backlog. Our writes are blocking to apply backpressure up to
  -- katip. This value just holds onto values temporarily while we
  -- concatenate them into a buffer.
  ingestionQueue <- STM.newTBMQueueIO (itemBufferSize * 10)

  let newTimer = STM.registerDelay itemBufferTimeoutMicros
  timerRef <- STM.newTVarIO =<< newTimer

  -- Set up a connection manager for requests
  mgr <- case scheme of
    HTTPS -> HTTPS.newTlsManager
    HTTP -> HTTP.newManager HTTP.defaultManagerSettings

  -- An STM transaction that will return true when writes are stopped
  -- and backlog is emptied.
  let workExhausted :: STM.STM Bool
      workExhausted =
        (&&)
          <$> STM.isClosedTBMQueue ingestionQueue
          <*> STM.isEmptyTBMQueue ingestionQueue
  -- Block until there's no more work
  let waitWorkExhausted :: STM.STM ()
      waitWorkExhausted = STM.check =<< workExhausted
  let pop :: STM.STM (Tick AnyLogItem)
      pop = maybe WorkExhausted NewItem <$> STM.readTBMQueue ingestionQueue

  let timeExpired :: STM.STM (Tick a)
      timeExpired = do
        isExpired <- STM.readTVar =<< STM.readTVar timerRef
        STM.check isExpired
        pure TimeExpired

  -- Circular transaction that checks for completion of work, time
  -- expiration, or new events.
  let nextTick :: STM.STM (Tick AnyLogItem)
      nextTick =
        timeExpired
          <|> pop
          <|> (WorkExhausted <$ waitWorkExhausted)

  -- Blocking push. This applies backpressure upstream to katip, which does its own buffering
  let push :: AnyLogItem -> STM.STM ()
      push = void . STM.writeTBMQueue ingestionQueue

  let sealQueue = STM.atomically (STM.closeTBMQueue ingestionQueue)

  -- Replace the timer with a new one
  let resetTimer = STM.atomically . STM.writeTVar timerRef =<< newTimer

  -- Send the buffer and then reset the timer
  let flush curBuffer = do
        res <- flushBuffer config mgr curBuffer
        case res of
          Left e -> onErrorSafe e
          Right () -> pure ()
        resetTimer

  let flushLoop :: BulkBuffer -> IO ()
      flushLoop curBuffer = do
        tick <- STM.atomically nextTick
        case tick of
          WorkExhausted -> do
            flush curBuffer -- flush what you've got
            pure () -- stop looping
          TimeExpired -> do
            flush curBuffer
            flushLoop mempty
          NewItem (AnyLogItem item) -> do
            case bufferItem (logzIOScribeConfiguration_bufferItems config) verbosity item curBuffer of
              Buffered newBuffer -> flushLoop newBuffer
              FlushNow flushThis newBuffer -> do
                flush flushThis
                flushLoop newBuffer

  flushThread <- Async.async (flushLoop mempty)

  let close = do
        sealQueue
        _ <- Async.waitCatch flushThread
        pure ()

  pure $
    K.Scribe
      { K.liPush = STM.atomically . push . AnyLogItem,
        K.scribeFinalizer = close,
        K.scribePermitItem = permitItem
      }
  where
    itemBufferSize = logzIOScribeConfiguration_bufferItems config
    itemBufferTimeoutMicros = ndtToMicros (logzIOScribeConfiguration_bufferTimeout config)
    scheme = logzIOScribeConfiguration_scheme config
    onErrorSafe ex = do
      _ <- EX.tryAny (logzIOScribeConfiguration_onError config ex)
      pure ()

data AnyLogItem where
  AnyLogItem :: K.LogItem a => K.Item a -> AnyLogItem

-------------------------------------------------------------------------------
data Tick a
  = TimeExpired
  | NewItem !a
  | WorkExhausted

-------------------------------------------------------------------------------
-- Match the native resolution of NominalDiffTime, which is excessive
-- for our needs
ndtPicos :: Time.NominalDiffTime -> Int64
ndtPicos = round . (* picos)
  where
    picos :: Time.NominalDiffTime
    picos = 10 ^ (9 :: Int)

-------------------------------------------------------------------------------
ndtToMicros :: Time.NominalDiffTime -> Int
ndtToMicros t = round ((fromIntegral (ndtPicos t) :: Double) / picosInMicro)
  where
    picosInMicro = 10 ^ (3 :: Int)

-------------------------------------------------------------------------------
data LoggingError
  = -- | The URI generated was invalid. Check your configuration
    URIError HTTP.HttpException
  | -- | We encountered an exception while sending the batch request
    RequestError HTTP.HttpException
  | -- | Some or all of the request was rejected. Check the logz.io UI
    -- for indexing errors.
    PartialFailure BulkAPIError
  | -- | Your API token was rejected.
    BadToken
  | -- | An error returned, but it could not be decoded into a
    -- 'BulkAPIError'. This may indicate a __library bug__, which should
    -- be reported to the issue tracker.
    UnknownFailureResponse HTypes.Status LBS.ByteString
  deriving (Show)

-------------------------------------------------------------------------------
flushBuffer ::
  LogzIOScribeConfiguration ->
  HTTP.Manager ->
  BulkBuffer ->
  IO (Either LoggingError ())
flushBuffer config mgr bulkBuffer
  | bulkBuffer_itemCount bulkBuffer <= 0 = pure (Right ())
  | otherwise = do
    E.runExceptT $ do
      req <- E.fmapLT URIError (E.ExceptT (EX.try (configureRequest <$> HTTP.parseRequest uriStr)))
      resp <- E.fmapLT RequestError $
        E.ExceptT $
          EX.try $
            Retry.recovering retryPolicy [\_stat -> EX.Handler handleHttpException] $ \_stat ->
              HTTP.httpLbs req mgr
      let respLBS = HTTP.responseBody resp
      let respStatus = HTTP.responseStatus resp
      if HTypes.statusIsSuccessful respStatus
        then pure ()
        else case A.decode @BulkAPIError respLBS of
          Nothing
            | HTypes.statusCode respStatus == 401 -> E.throwE BadToken
            | otherwise -> E.throwE (UnknownFailureResponse respStatus respLBS)
          Just bulkError -> E.throwE (PartialFailure bulkError)
  where
    configureRequest req =
      req
        { HTTP.method = HTypes.methodPost,
          HTTP.requestBody = HTTP.RequestBodyLBS (BB.toLazyByteString (bulkBuffer_payload bulkBuffer))
        }

    retryPolicy = logzIOScribeConfiguration_retry config
    apiTokenBS = TE.encodeUtf8 (apiToken (logzIOScribeConfiguration_token config))

    handleHttpException :: (Applicative m) => HTTP.HttpException -> m Bool
    handleHttpException _ = pure True

    uriStr = LBS8.unpack (BB.toLazyByteString (URIBS.serializeURIRef uri))

    authority =
      URIBS.Authority
        { URIBS.authorityUserInfo = Nothing,
          URIBS.authorityHost = logzIOScribeConfiguration_host config,
          URIBS.authorityPort = Just (logzIOScribeConfiguration_port config)
        }

    uri =
      URIBS.URI
        { URIBS.uriScheme = case logzIOScribeConfiguration_scheme config of
            HTTPS -> URIBS.Scheme "https"
            HTTP -> URIBS.Scheme "http",
          URIBS.uriAuthority = Just authority,
          URIBS.uriPath = "/",
          URIBS.uriQuery =
            URIBS.Query
              [ ("token", apiTokenBS)
              ],
          URIBS.uriFragment = Nothing
        }

-------------------------------------------------------------------------------
newtype Bytes = Bytes
  { bytes :: Int64
  }
  deriving (Show, Eq, Num, Ord, Bounded)

-- | How big of a body can we send? The limit is defined
-- <https://app.logz.io/#/dashboard/data-sources/Bulk-HTTPS here>.
maxPayloadBytes :: Bytes
maxPayloadBytes = 10485760

-- | How long can each serialized payload be (let's assume including
-- the trailing newline). The limit is defined
-- <https://app.logz.io/#/dashboard/data-sources/Bulk-HTTPS here>.
maxLogLineLength :: Bytes
maxLogLineLength = 500000

measureJSONLine :: A.ToJSON a => a -> (BB.Builder, Bytes)
measureJSONLine a = (BB.lazyByteString lbs, Bytes (LBS.length lbs))
  where
    lbs = A.encode a <> "\n"

-- | Fully-rendered JSON object for an item
fullItemObject :: K.LogItem a => K.Verbosity -> K.Item a -> A.Object
fullItemObject verbosity item =
#if MIN_VERSION_aeson (2, 0, 0)
  A.fromList
#else
  HM.fromList
#endif
    [ "app" A..= K._itemApp item,
      "env" A..= K._itemEnv item,
      "sev" A..= K._itemSeverity item,
      "thread" A..= K.getThreadIdText (K._itemThread item),
      "host" A..= K._itemHost item,
      "pid" A..= pidInt,
      "data" A..= annotateKeys (K.payloadObject verbosity (K._itemPayload item)),
      -- Slight deviation, logz.io uses "message" instead of "msg"
      "message" A..= TB.toLazyText (K.unLogStr (K._itemMessage item)),
      -- Another slight deviation, logz.io uses "@timestamp" instead of
      -- "at". Note, your logs should be sent roughly close to when they
      -- are created. They are assigned to indexes based on index date, so
      -- time searches act strange if you backfill too far from the
      -- past. They seem to support 3 decimal places of
      -- precision. Formatting like this requires time 1.8.0.2, which is
      -- reflected in the cabal file.
      "@timestamp" A..= A.String (T.pack (Time.formatTime Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%03QZ" (K._itemTime item))),
      "ns" A..= K._itemNamespace item,
      "loc" A..= (LocJs <$> K._itemLoc item)
    ]
  where
    POSIX.CPid pidInt = K._itemProcess item

-- | A version of 'renderLine' which renders a line and stays under
-- the maximum line size of 500,000 bytes. If the default rendering is
-- too large, the log will be reduced to a timestamp and a potentially
-- truncated message.
renderLineTruncated :: K.LogItem a => K.Verbosity -> K.Item a -> (BB.Builder, Bytes)
renderLineTruncated = renderLineTruncated' maxLogLineLength

-- | A generalized renderLineTruncated that takes a custom line length
-- limit. This is exclusively for testing.
renderLineTruncated' ::
  K.LogItem a =>
  -- | Custom max log line length. Be careful, too low and no amount
  -- of shrinking can get under the size, breaking the invariant. For
  -- the production limit, we are guraanteed always able to come in
  -- under the limit.
  Bytes ->
  K.Verbosity ->
  K.Item a ->
  (BB.Builder, Bytes)
renderLineTruncated' customMaxLogLineLength verbosity item =
  if fullSize <= customMaxLogLineLength
    then (fullLine, fullSize)
    else (fallbackLine, fallbackSize)
  where
    fullObject = fullItemObject verbosity item
    (fullLine, fullSize) = measureJSONLine fullObject
    -- only the absolutely necessary keys, with message stripped out
    -- to help us calculate how much of the message we can keep. these
    -- are lazily evaluated and as such won't be computed unless the
    -- item is too big
    blankObject :: A.Object
    blankObject =
#if MIN_VERSION_aeson (2, 0, 0)
      A.fromList
#else
      HM.fromList
#endif
        [ "message" A..= A.String "", -- we'll start with a blank message
          "@timestamp" A..= K._itemTime item
        ]
    (_, blankObjectSize) = measureJSONLine blankObject
    messageBytesAllowed = maxLogLineLength - blankObjectSize
    (fallbackLine, fallbackSize) = measureJSONLine fallbackObject
    fallbackObject :: A.Object
    fallbackObject =
#if MIN_VERSION_aeson (2, 0, 0)
      A.fromList
#else
      HM.fromList
#endif
        [ "message" A..= A.toJSON (TL.take (bytes messageBytesAllowed) (TB.toLazyText (K.unLogStr (K._itemMessage item)))),
          "@timestamp" A..= A.toJSON (K._itemTime item)
        ]

data BulkBuffer = BulkBuffer
  { bulkBuffer_bytesUsed :: !Bytes,
    bulkBuffer_payload :: !BB.Builder,
    bulkBuffer_itemCount :: !Int
  }

instance Semigroup.Semigroup BulkBuffer where
  (BulkBuffer bytesUsedA bufferA itemCountA)
    <> (BulkBuffer bytesUsedB bufferB itemCountB) =
      BulkBuffer
        (bytesUsedA + bytesUsedB)
        (bufferA <> bufferB)
        (itemCountA + itemCountB)

instance Monoid BulkBuffer where
  mempty = BulkBuffer 0 mempty 0
  mappend = (<>)

data LogAction buf
  = -- | New buffer
    Buffered
      buf
  | FlushNow
      buf
      -- ^ Buffer to flush
      buf
      -- ^ New buffer

bufferItem ::
  K.LogItem a =>
  -- | Maximum items before flushing
  Int ->
  K.Verbosity ->
  K.Item a ->
  BulkBuffer ->
  LogAction BulkBuffer
bufferItem = bufferItem' maxPayloadBytes maxLogLineLength

-- | An internal version with a configurable max item size and max
-- message size for testing. Be careful with this: if you set the
-- values too low, some of the guarantees about reducability of
-- messages break down.
bufferItem' ::
  (K.LogItem a) =>
  -- | Max payload size
  Bytes ->
  -- | Max item size
  Bytes ->
  -- | Maximum items before flushing
  Int ->
  K.Verbosity ->
  K.Item a ->
  BulkBuffer ->
  LogAction BulkBuffer
bufferItem' customMaxPayload customMaxItem maxItems verb item bulkBuffer =
  let (encodedLine, spaceNeeded) = renderLineTruncated' customMaxItem verb item
      newBytesUsed = bulkBuffer_bytesUsed bulkBuffer + spaceNeeded
      newItemCount = bulkBuffer_itemCount bulkBuffer + 1
   in if newItemCount >= maxItems || newBytesUsed >= customMaxPayload
        then
          FlushNow
            bulkBuffer
            BulkBuffer
              { bulkBuffer_bytesUsed = spaceNeeded,
                bulkBuffer_payload = encodedLine,
                bulkBuffer_itemCount = 1
              }
        else
          Buffered $
            BulkBuffer
              { bulkBuffer_bytesUsed = newBytesUsed,
                bulkBuffer_payload = bulkBuffer_payload bulkBuffer <> encodedLine,
                bulkBuffer_itemCount = newItemCount
              }

-- | When time has run out on a flush, splits the buffer. n.b. this
-- will always return 'FlushNow' with an empty new buffer.
forceFlush :: (Monoid buf) => buf -> LogAction buf
forceFlush buf = FlushNow buf mempty

-------------------------------------------------------------------------------
-- Annotation borrowed from katip-elasticsearch. There are fixed
-- fields in katip logs which should stay the same type forever and
-- thus won't need annotation. However, any code in userland may
-- choose to add akey to their log's metadata with a type that's
-- incompatible with the mapping. If the first value that's picked up
-- restrictive (e.g. a long), subsequent values will be rejected. By
-- differentiating types by their name, this is guaranteed not to
-- happen.

annotateValue :: A.Value -> A.Value
annotateValue (A.Object o) = A.Object (annotateKeys o)
annotateValue (A.Array a) = A.Array (annotateValue <$> a)
annotateValue x = x

annotateKeys :: A.Object -> A.Object
#if MIN_VERSION_aeson (2, 0, 0)
annotateKeys = A.fromList . map go . A.toList
  where
    go (k, A.Object o) = (k, A.Object (annotateKeys o))
    go (k, A.Array a) = (k, A.Array (annotateValue <$> a))
    go (k, s@(A.String _)) = (A.fromText (A.toText k <> stringAnn), s)
    go (k, n@(A.Number sci)) =
      if Scientific.isFloating sci
        then (A.fromText (A.toText k <> doubleAnn), n)
        else (A.fromText (A.toText k <> longAnn), n)
    go (k, b@(A.Bool _)) = (A.fromText (A.toText k <> booleanAnn), b)
    go (k, A.Null) = (A.fromText (A.toText k <> nullAnn), A.Null)
#else
annotateKeys = HM.fromList . map go . HM.toList
  where
    go (k, A.Object o) = (k, A.Object (annotateKeys o))
    go (k, A.Array a) = (k, A.Array (annotateValue <$> a))
    go (k, s@(A.String _)) = (k <> stringAnn, s)
    go (k, n@(A.Number sci)) =
      if Scientific.isFloating sci
        then (k <> doubleAnn, n)
        else (k <> longAnn, n)
    go (k, b@(A.Bool _)) = (k <> booleanAnn, b)
    go (k, A.Null) = (k <> nullAnn, A.Null)
#endif

-------------------------------------------------------------------------------
-- Annotation Constants
-------------------------------------------------------------------------------

stringAnn :: T.Text
stringAnn = "::s"

doubleAnn :: T.Text
doubleAnn = "::d"

longAnn :: T.Text
longAnn = "::l"

booleanAnn :: T.Text
booleanAnn = "::b"

nullAnn :: T.Text
nullAnn = "::n"