Merge pull request #83 from vst/67-revisit-types-for-further-type-safety-and-better-schema-output

Fix Invalic Date/Time JSON Schema Output

Author: vst

src/HostPatrol/Remote.hs

@@ -19,7 +19,6 @@ import qualified Data.List as List
 import Data.Maybe (fromMaybe)
 import qualified Data.Scientific as S
 import qualified Data.Text as T
-import qualified Data.Time as Time
 import qualified HostPatrol.Config as Config
 import qualified HostPatrol.Meta as Meta
 import qualified HostPatrol.Types as Types
@@ -29,6 +28,7 @@ import qualified System.Process.Typed as TP
 import Text.Read (readEither)
 import qualified Zamazingo.Ssh as Z.Ssh
 import qualified Zamazingo.Text as Z.Text
+import qualified Zamazingo.Time as Z.Time
 
 
 -- * Report
@@ -42,7 +42,7 @@ compileReport
   -> Config.Config
   -> m Types.Report
 compileReport par Config.Config {..} = do
-  now <- liftIO Time.getCurrentTime
+  now <- Z.Time.getNow
   (errs, _reportHosts) <- liftIO (compileHostReportsIO par _configHosts)
   _reportKnownSshKeys <- concat <$> mapM parseSshPublicKeys _configKnownSshKeys
   let _reportMeta =
@@ -367,7 +367,7 @@ _jsonDecoderDockerContainer =
     <$> ACD.key "Id" ACD.text
     <*> (T.dropWhile (== '/') <$> ACD.key "Name" ACD.text)
     <*> ACD.at ["Config", "Image"] ACD.text
-    <*> ACD.key "Created" ACD.utcTime
+    <*> ACD.key "Created" ACD.auto
     <*> ((==) True <$> ACD.at ["State", "Running"] ACD.bool)
 
 

src/HostPatrol/Types.hs

@@ -11,9 +11,9 @@ import qualified Data.Aeson as Aeson
 import Data.Int (Int32)
 import Data.Scientific (Scientific)
 import qualified Data.Text as T
-import qualified Data.Time as Time
 import GHC.Generics (Generic)
 import Zamazingo.Ssh (SshConfig)
+import qualified Zamazingo.Time as Z.Time
 
 
 -- * Report
@@ -51,7 +51,7 @@ data ReportMeta = ReportMeta
   { _reportMetaVersion :: !T.Text
   , _reportMetaBuildTag :: !(Maybe T.Text)
   , _reportMetaBuildHash :: !(Maybe T.Text)
-  , _reportMetaTimestamp :: !Time.UTCTime
+  , _reportMetaTimestamp :: !Z.Time.DateTime
   }
   deriving (Eq, Generic, Show)
   deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec ReportMeta)
@@ -303,7 +303,7 @@ data DockerContainer = DockerContainer
   { _dockerContainerId :: !T.Text
   , _dockerContainerName :: !T.Text
   , _dockerContainerImage :: !T.Text
-  , _dockerContainerCreated :: !Time.UTCTime
+  , _dockerContainerCreated :: !Z.Time.DateTime
   , _dockerContainerRunning :: !Bool
   }
   deriving (Eq, Generic, Show)

src/Zamazingo/Time.hs

@@ -0,0 +1,72 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | This module provides auxiliary definitions for working with
+-- date/time values.
+module Zamazingo.Time where
+
+import qualified Autodocodec as ADC
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import qualified Data.Aeson as Aeson
+import qualified Data.Text as T
+import qualified Data.Time as Time
+import qualified Data.Time.Format.ISO8601 as Time.Iso8601
+import GHC.Generics (Generic)
+
+
+-- | Data definition for date/time information.
+--
+-- The reason that this type exists is to avoid the legacy
+-- 'Time.UTCTime' type schema typing.
+newtype DateTime = DateTime
+  { _unDateTime :: Time.UTCTime
+  }
+  deriving (Eq, Generic, Show)
+  deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec DateTime)
+
+
+-- | 'ADC.HasCodec' instance for 'DateTime'.
+--
+-- >>> :set -XTypeApplications
+-- >>> import Autodocodec as ADC
+-- >>> import Autodocodec.Schema as ADC.Schema
+--
+-- >>> let now = DateTime (read "2021-09-01 12:00:00 UTC" :: Time.UTCTime)
+-- >>> Aeson.encode now
+-- "\"2021-09-01T12:00:00Z\""
+-- >>> Aeson.decode @DateTime (Aeson.encode now)
+-- Just (DateTime {_unDateTime = 2021-09-01 12:00:00 UTC})
+--
+-- >>> Aeson.encode (ADC.Schema.jsonSchemaViaCodec @DateTime)
+-- "{\"$comment\":\"Date/time in ISO8601 format.\",\"type\":\"string\"}"
+instance ADC.HasCodec DateTime where
+  codec =
+    ADC.bimapCodec (fmap DateTime . parseIso8601) (iso8601 . _unDateTime) ADC.textCodec ADC.<?> "Date/time in ISO8601 format."
+
+
+-- | Returns current date/time information.
+--
+-- > getNow
+-- DateTime {_unDateTime = 2024-04-18 00:48:15.956143715 UTC}
+getNow :: MonadIO m => m DateTime
+getNow = liftIO (DateTime <$> Time.getCurrentTime)
+
+
+-- | Parses ISO8601 date/time string.
+parseIso8601 :: T.Text -> Either String Time.UTCTime
+parseIso8601 t =
+  maybe (Left err) pure (Time.Iso8601.formatParseM Time.Iso8601.iso8601Format (T.unpack t))
+  where
+    err = "ISO8601 date/time parse error: " <> show t
+
+
+-- | Parses ISO8601 date/time string in 'MonadFail' context.
+parseIso8601M :: MonadFail m => T.Text -> m Time.UTCTime
+parseIso8601M =
+  either fail pure . parseIso8601
+
+
+-- | Formats 'Time.UTCTime' into an ISO8601 date/time string.
+iso8601 :: Time.UTCTime -> T.Text
+iso8601 = T.pack . Time.Iso8601.formatShow Time.Iso8601.iso8601Format

website/src/lib/data.ts

@@ -119,7 +119,10 @@ export const HOSTPATROL_REPORT_SCHEMA = {
                 items: {
                   $comment: 'Docker Container Information\nDockerContainer',
                   properties: {
-                    created: { $comment: 'Date/time when the container is created at.\nLocalTime', type: 'string' },
+                    created: {
+                      $comment: 'Date/time when the container is created at.\nDate/time in ISO8601 format.',
+                      type: 'string',
+                    },
                     id: { $comment: 'ID of the container..', type: 'string' },
                     image: { $comment: 'Image the container is created from.', type: 'string' },
                     name: { $comment: 'Name of the container.', type: 'string' },
@@ -275,7 +278,7 @@ export const HOSTPATROL_REPORT_SCHEMA = {
       properties: {
         buildHash: { $comment: 'Build hash of the application.', type: 'string' },
         buildTag: { $comment: 'Build tag of the application.', type: 'string' },
-        timestamp: { $comment: 'Timestamp of the report.\nLocalTime', type: 'string' },
+        timestamp: { $comment: 'Timestamp of the report.\nDate/time in ISO8601 format.', type: 'string' },
         version: { $comment: 'Version of the application.', type: 'string' },
       },
       required: ['timestamp', 'version'],