{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} module Data.RdsData.Migration.Types ( MigrationRow(..), RdsClusterDetails(..), Migration(..), Delta(..), Step(..), Statement(..), CreateTableStep(..), TableSchema(..), Column(..), ForeignKey(..), ) where import Amazonka.Data (FromJSON, ToJSON, (.!=), (.:), (.:?), (.=)) import qualified Amazonka.RDS as AWS import qualified Amazonka.SecretsManager as AWS import Control.Applicative import qualified Data.Aeson as J import Data.Bool import Data.Char (isAsciiUpper, toLower) import Data.Generics.Product.Any import Data.Maybe import Data.RdsData.Orphans () import Data.Text (Text) import Data.Time import Data.ULID (ULID) import GHC.Generics import Lens.Micro -- Helper to transform field names to snake_case snakeCaseOptions :: J.Options snakeCaseOptions = J.defaultOptions { J.fieldLabelModifier = camelToSnake } -- Helper function to convert camelCase to snake_case camelToSnake :: String -> String camelToSnake [] = [] camelToSnake (x:xs) = toLower x : go xs where go [] = [] go "_" = [] go (y:ys) | isAsciiUpper y = '_' : toLower y : go ys | otherwise = y : go ys data MigrationRow = MigrationRow { uuid :: ULID , createdBy :: UTCTime , deployedBy :: Text } deriving (Eq, Show, Generic) data RdsClusterDetails = RdsClusterDetails { createDbClusterResponse :: AWS.CreateDBClusterResponse , createSecretResponse :: AWS.CreateSecretResponse } deriving (Eq, Generic, Show) data Migration = Migration { description :: Text , plan :: [Delta] } deriving (Eq, Generic, Show) instance ToJSON Migration where toJSON = J.genericToJSON snakeCaseOptions instance FromJSON Migration where parseJSON = J.genericParseJSON snakeCaseOptions data Delta = Delta { id :: ULID , description :: Text , steps :: Maybe [Step] } deriving (Eq, Generic, Show) instance ToJSON Delta where toJSON = J.genericToJSON snakeCaseOptions instance FromJSON Delta where parseJSON = J.genericParseJSON snakeCaseOptions data Step = StepOfUp UpStep | StepOfDown DownStep | StepOfCreateTable CreateTableStep | StepOfCreateIndex CreateIndexStep deriving (Eq, Show) instance ToJSON Step where toJSON = \case StepOfUp step -> J.toJSON step StepOfDown step -> J.toJSON step StepOfCreateTable table -> J.toJSON table StepOfCreateIndex index -> J.toJSON index instance FromJSON Step where parseJSON v = flip (J.withObject "Step") v $ \_ -> asum [ StepOfUp <$> J.parseJSON v , StepOfDown <$> J.parseJSON v , StepOfCreateTable <$> J.parseJSON v , StepOfCreateIndex <$> J.parseJSON v ] newtype UpStep = UpStep { up :: Statement } deriving (Eq, Generic, Show) instance ToJSON UpStep where toJSON = J.genericToJSON snakeCaseOptions instance FromJSON UpStep where parseJSON = J.genericParseJSON snakeCaseOptions newtype DownStep = DownStep { down :: Statement } deriving (Eq, Generic, Show) instance ToJSON DownStep where toJSON = J.genericToJSON snakeCaseOptions instance FromJSON DownStep where parseJSON = J.genericParseJSON snakeCaseOptions newtype Statement = Statement Text deriving (Eq, Generic, Show) deriving newtype (ToJSON, FromJSON) newtype CreateTableStep = CreateTableStep { createTable :: TableSchema } deriving (Eq, Generic, Show) instance ToJSON CreateTableStep where toJSON = J.genericToJSON snakeCaseOptions instance FromJSON CreateTableStep where parseJSON = J.genericParseJSON snakeCaseOptions newtype CreateIndexStep = CreateIndexStep { createIndex :: IndexSchema } deriving (Eq, Generic, Show) instance ToJSON CreateIndexStep where toJSON = J.genericToJSON snakeCaseOptions instance FromJSON CreateIndexStep where parseJSON = J.genericParseJSON snakeCaseOptions data TableSchema = TableSchema { name :: Text , columns :: [Column] } deriving (Eq, Generic, Show) instance ToJSON TableSchema where toJSON = J.genericToJSON snakeCaseOptions instance FromJSON TableSchema where parseJSON = J.genericParseJSON snakeCaseOptions data Column = Column { name :: Text , type_ :: Text , nullable :: Bool , primaryKey :: Bool , unique :: Bool , autoIncrement :: Bool , references :: Maybe ForeignKey } deriving (Eq, Generic, Show) instance ToJSON Column where toJSON column = J.object $ catMaybes [ "name" .=? do column ^. the @"name" & Just , "type" .=? do column ^. the @"type_" & Just , "nullable" .=? do column ^. the @"nullable" & bool Nothing (Just True) , "primary_key" .=? do column ^. the @"primaryKey" & bool Nothing (Just True) , "unique" .=? do column ^. the @"unique" & bool Nothing (Just True) , "auto_increment" .=? do column ^. the @"autoIncrement" & bool Nothing (Just True) , "references" .=? do column ^. the @"references" & Just ] (.=?) :: (J.KeyValue e kv, ToJSON v) => J.Key -> Maybe v -> Maybe kv (.=?) k mv = case mv of Just v -> Just $ k .= v Nothing -> Nothing instance FromJSON Column where parseJSON = J.withObject "Column" $ \v -> Column <$> v .: "name" <*> v .: "type" <*> v .:? "nullable" .!= False <*> v .:? "primary_key" .!= False <*> v .:? "unique" .!= False <*> v .:? "auto_increment" .!= False <*> v .:? "references" data IndexSchema = IndexSchema { name :: Text , table :: Text , columns :: [Text] } deriving (Eq, Generic, Show) instance ToJSON IndexSchema where toJSON = J.genericToJSON snakeCaseOptions instance FromJSON IndexSchema where parseJSON = J.genericParseJSON snakeCaseOptions newtype ForeignKey = ForeignKey Text deriving newtype (Eq, Show, ToJSON, FromJSON) deriving Generic