diff --git a/projects/or_scs/Mirza.cabal b/projects/or_scs/Mirza.cabal index a5173db8..5ec4cc54 100644 --- a/projects/or_scs/Mirza.cabal +++ b/projects/or_scs/Mirza.cabal @@ -24,7 +24,6 @@ library , Mirza.OrgRegistry.Database.Migrate , Mirza.OrgRegistry.Database.Schema , Mirza.OrgRegistry.Database.Schema.V0001 - , Mirza.OrgRegistry.Database.Schema.V0002 , Mirza.OrgRegistry.Handlers.Org , Mirza.OrgRegistry.Handlers.Health , Mirza.OrgRegistry.Handlers.Keys diff --git a/projects/or_scs/src/Mirza/OrgRegistry/Database/Schema.hs b/projects/or_scs/src/Mirza/OrgRegistry/Database/Schema.hs index c309f7f8..ba943b2d 100644 --- a/projects/or_scs/src/Mirza/OrgRegistry/Database/Schema.hs +++ b/projects/or_scs/src/Mirza/OrgRegistry/Database/Schema.hs @@ -6,24 +6,24 @@ module Mirza.OrgRegistry.Database.Schema , primaryKey ) where -import Control.Arrow ((>>>)) +--import Control.Arrow ((>>>)) -import Database.Beam (DatabaseSettings) -import Database.Beam.Migrate.Types hiding - (migrateScript) -import Database.Beam.Postgres (PgCommandSyntax, - Postgres) -import Database.Beam.Schema.Tables (primaryKey) +import Database.Beam (DatabaseSettings) +import Database.Beam.Migrate.Types hiding (migrateScript) +import Database.Beam.Postgres (PgCommandSyntax, + Postgres) +import Database.Beam.Schema.Tables (primaryKey) -import Mirza.OrgRegistry.Database.Schema.V0002 as Current hiding (migration) +import Mirza.OrgRegistry.Database.Schema.V0001 as Current hiding + (migration) import qualified Mirza.OrgRegistry.Database.Schema.V0001 as V0001 (migration) -import qualified Mirza.OrgRegistry.Database.Schema.V0002 as V0002 (migration) +--import qualified Mirza.OrgRegistry.Database.Schema.V0002 as V0002 (migration) migration :: MigrationSteps PgCommandSyntax () (CheckedDatabaseSettings Postgres Current.OrgRegistryDB) migration = migrationStep "Initial commit" V0001.migration - >>> migrationStep "Add LocationT table" V0002.migration +-- >>> migrationStep "Add LocationT table" V0002.migration orgRegistryDB :: DatabaseSettings Postgres Current.OrgRegistryDB orgRegistryDB = unCheckDatabase checkedOrgRegistryDB diff --git a/projects/or_scs/src/Mirza/OrgRegistry/Database/Schema/V0001.hs b/projects/or_scs/src/Mirza/OrgRegistry/Database/Schema/V0001.hs index e10e32d0..e4f299f8 100644 --- a/projects/or_scs/src/Mirza/OrgRegistry/Database/Schema/V0001.hs +++ b/projects/or_scs/src/Mirza/OrgRegistry/Database/Schema/V0001.hs @@ -16,6 +16,7 @@ import qualified Data.GS1.EPC as EPC import Mirza.Common.Beam (lastUpdateField) import Mirza.Common.GS1BeamOrphans import Mirza.Common.Types (PrimaryKeyType) +import Mirza.OrgRegistry.Types import Control.Lens @@ -24,6 +25,9 @@ import Data.Text (Text) import Data.Time (LocalTime) import Data.UUID (UUID) +import Servant (FromHttpApiData (parseUrlPiece), + ToHttpApiData (toUrlPiece)) + import Database.Beam as B import Database.Beam.Migrate.SQL as BSQL import Database.Beam.Migrate.Types @@ -51,10 +55,12 @@ pkSerialType = uuid -- Database data OrgRegistryDB f = OrgRegistryDB - { _orgs :: f (TableEntity OrgT) - , _users :: f (TableEntity UserT) - , _orgMapping :: f (TableEntity OrgMappingT) - , _keys :: f (TableEntity KeyT) + { _orgs :: f (TableEntity OrgT) + , _users :: f (TableEntity UserT) + , _orgMapping :: f (TableEntity OrgMappingT) + , _keys :: f (TableEntity KeyT) + , _locations :: f (TableEntity LocationT) + , _geoLocations :: f (TableEntity GeoLocationT) } deriving Generic instance Database anybackend OrgRegistryDB @@ -88,6 +94,21 @@ migration () = (field "expiration_time" (maybeType timestamp)) lastUpdateField ) + <*> createTable "location" (LocationT + (field "location_id" pkSerialType) + (field "location_gln" locationEPCType) + (OrgPrimaryKey $ field "location_org_id" gs1CompanyPrefixFieldType) + lastUpdateField + ) + <*> createTable "geo_location" (GeoLocationT + (field "geo_location_id" pkSerialType) + (LocationPrimaryKey $ field "geo_location_gln" locationEPCType) + (field "geo_location_lat" (maybeType latitudeType)) + (field "geo_location_lon" (maybeType longitudeType)) + (field "geo_location_address" (maybeType $ varchar Nothing)) + lastUpdateField + ) + -------------------------------------------------------------------------------- -- User table. @@ -223,3 +244,85 @@ instance Table KeyT where deriving Generic primaryKey = KeyPrimaryKey . key_id deriving instance Eq (PrimaryKey KeyT Identity) + + +-------------------------------------------------------------------------------- +-- Locations Table +-------------------------------------------------------------------------------- + +type Location = LocationT Identity +deriving instance Show Location + +data LocationT f = LocationT + { location_id :: C f PrimaryKeyType + , location_gln :: C f EPC.LocationEPC + , location_org_id :: PrimaryKey OrgT f + , location_last_update :: C f (Maybe LocalTime) + } + deriving Generic + +type LocationPrimaryKey = PrimaryKey LocationT Identity +deriving instance Show (PrimaryKey LocationT Identity) +instance ToSchema LocationPrimaryKey +instance ToParamSchema LocationPrimaryKey +instance ToJSON (PrimaryKey LocationT Identity) where + toJSON (LocationPrimaryKey uid) = toJSON uid +instance FromJSON (PrimaryKey LocationT Identity) where + parseJSON = fmap LocationPrimaryKey . parseJSON + +instance Beamable LocationT +instance Beamable (PrimaryKey LocationT) + +instance Table LocationT where + newtype PrimaryKey LocationT f = LocationPrimaryKey (C f EPC.LocationEPC) + deriving Generic + primaryKey = LocationPrimaryKey . location_gln +deriving instance Eq (PrimaryKey LocationT Identity) + +instance ToHttpApiData (PrimaryKey LocationT Identity) where + toUrlPiece (LocationPrimaryKey locId) = toUrlPiece locId + +instance FromHttpApiData (PrimaryKey LocationT Identity) where + parseUrlPiece t = LocationPrimaryKey <$> parseUrlPiece t + + +-------------------------------------------------------------------------------- +-- GeoLocations Table +-------------------------------------------------------------------------------- + +type GeoLocation = GeoLocationT Identity +deriving instance Show GeoLocation + +data GeoLocationT f = GeoLocationT + { geoLocation_id :: C f PrimaryKeyType + , geoLocation_gln :: PrimaryKey LocationT f + , geoLocation_latitude :: C f (Maybe Latitude) + , geoLocation_longitude :: C f (Maybe Longitude) + , geoLocation_address :: C f (Maybe Text) + , geoLocation_last_update :: C f (Maybe LocalTime) + } + deriving Generic + +type GeoLocationPrimaryKey = PrimaryKey GeoLocationT Identity +deriving instance Show (PrimaryKey GeoLocationT Identity) +instance ToSchema GeoLocationPrimaryKey +instance ToParamSchema GeoLocationPrimaryKey +instance ToJSON (PrimaryKey GeoLocationT Identity) where + toJSON (GeoLocationPrimaryKey uid) = toJSON uid +instance FromJSON (PrimaryKey GeoLocationT Identity) where + parseJSON = fmap GeoLocationPrimaryKey . parseJSON + +instance Beamable GeoLocationT +instance Beamable (PrimaryKey GeoLocationT) + +instance Table GeoLocationT where + newtype PrimaryKey GeoLocationT f = GeoLocationPrimaryKey (C f PrimaryKeyType) + deriving Generic + primaryKey = GeoLocationPrimaryKey . geoLocation_id +deriving instance Eq (PrimaryKey GeoLocationT Identity) + +instance ToHttpApiData (PrimaryKey GeoLocationT Identity) where + toUrlPiece (GeoLocationPrimaryKey locId) = toUrlPiece locId + +instance FromHttpApiData (PrimaryKey GeoLocationT Identity) where + parseUrlPiece t = GeoLocationPrimaryKey <$> parseUrlPiece t diff --git a/projects/or_scs/src/Mirza/OrgRegistry/Database/Schema/V0002.hs b/projects/or_scs/src/Mirza/OrgRegistry/Database/Schema/V0002.hs deleted file mode 100644 index 45d61d56..00000000 --- a/projects/or_scs/src/Mirza/OrgRegistry/Database/Schema/V0002.hs +++ /dev/null @@ -1,149 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} - - - -module Mirza.OrgRegistry.Database.Schema.V0002 - ( module Mirza.OrgRegistry.Database.Schema.V0002 - , module V0001 - ) where - -import qualified Data.GS1.EPC as EPC -import Mirza.Common.Beam (lastUpdateField) -import Mirza.Common.GS1BeamOrphans -import Mirza.Common.Types (PrimaryKeyType) -import Mirza.OrgRegistry.Types - -import Control.Lens -import Data.Text (Text) -import Data.Time (LocalTime) - - -import Database.Beam as B -import Database.Beam.Migrate.SQL.Tables -import Database.Beam.Migrate.Types -import Database.Beam.Postgres - -import Data.Aeson -import Data.Swagger -import Servant (FromHttpApiData (parseUrlPiece), - ToHttpApiData (toUrlPiece)) - -import GHC.Generics (Generic) - -import Mirza.OrgRegistry.Database.Schema.V0001 as V0001' hiding (OrgRegistryDB (..), - migration) -import qualified Mirza.OrgRegistry.Database.Schema.V0001 as V0001 - - - --- Database -data OrgRegistryDB f = OrgRegistryDB - { _orgs :: f (TableEntity V0001.OrgT) - , _users :: f (TableEntity V0001.UserT) - , _orgMapping :: f (TableEntity V0001.OrgMappingT) - , _keys :: f (TableEntity V0001.KeyT) - , _locations :: f (TableEntity LocationT) - , _geoLocations :: f (TableEntity GeoLocationT) - } - deriving Generic -instance Database anybackend OrgRegistryDB - - -migration :: CheckedDatabaseSettings Postgres V0001.OrgRegistryDB - -> Migration PgCommandSyntax (CheckedDatabaseSettings Postgres OrgRegistryDB) -migration v0001 = OrgRegistryDB - <$> preserve (V0001._orgs v0001) - <*> preserve (V0001._users v0001) - <*> preserve (V0001._orgMapping v0001) - <*> preserve (V0001._keys v0001) - <*> createTable "location" (LocationT - (field "location_id" V0001.pkSerialType) - (field "location_gln" locationEPCType) - (V0001.OrgPrimaryKey $ field "location_org_id" gs1CompanyPrefixFieldType) - lastUpdateField - ) - <*> createTable "geo_location" (GeoLocationT - (field "geo_location_id" V0001.pkSerialType) - (LocationPrimaryKey $ field "geo_location_gln" locationEPCType) - (field "geo_location_lat" (maybeType latitudeType)) - (field "geo_location_lon" (maybeType longitudeType)) - (field "geo_location_address" (maybeType $ varchar Nothing)) - lastUpdateField - ) - -type Location = LocationT Identity -deriving instance Show Location - -data LocationT f = LocationT - { location_id :: C f PrimaryKeyType - , location_gln :: C f EPC.LocationEPC - , location_org_id :: PrimaryKey V0001.OrgT f - , location_last_update :: C f (Maybe LocalTime) - } - deriving Generic - -type LocationPrimaryKey = PrimaryKey LocationT Identity -deriving instance Show (PrimaryKey LocationT Identity) -instance ToSchema LocationPrimaryKey -instance ToParamSchema LocationPrimaryKey -instance ToJSON (PrimaryKey LocationT Identity) where - toJSON (LocationPrimaryKey uid) = toJSON uid -instance FromJSON (PrimaryKey LocationT Identity) where - parseJSON = fmap LocationPrimaryKey . parseJSON - -instance Beamable LocationT -instance Beamable (PrimaryKey LocationT) - -instance Table LocationT where - newtype PrimaryKey LocationT f = LocationPrimaryKey (C f EPC.LocationEPC) - deriving Generic - primaryKey = LocationPrimaryKey . location_gln -deriving instance Eq (PrimaryKey LocationT Identity) - -instance ToHttpApiData (PrimaryKey LocationT Identity) where - toUrlPiece (LocationPrimaryKey locId) = toUrlPiece locId - -instance FromHttpApiData (PrimaryKey LocationT Identity) where - parseUrlPiece t = LocationPrimaryKey <$> parseUrlPiece t - - - -type GeoLocation = GeoLocationT Identity -deriving instance Show GeoLocation - -data GeoLocationT f = GeoLocationT - { geoLocation_id :: C f PrimaryKeyType - , geoLocation_gln :: PrimaryKey LocationT f - , geoLocation_latitude :: C f (Maybe Latitude) - , geoLocation_longitude :: C f (Maybe Longitude) - , geoLocation_address :: C f (Maybe Text) - , geoLocation_last_update :: C f (Maybe LocalTime) - } - deriving Generic - -type GeoLocationPrimaryKey = PrimaryKey GeoLocationT Identity -deriving instance Show (PrimaryKey GeoLocationT Identity) -instance ToSchema GeoLocationPrimaryKey -instance ToParamSchema GeoLocationPrimaryKey -instance ToJSON (PrimaryKey GeoLocationT Identity) where - toJSON (GeoLocationPrimaryKey uid) = toJSON uid -instance FromJSON (PrimaryKey GeoLocationT Identity) where - parseJSON = fmap GeoLocationPrimaryKey . parseJSON - -instance Beamable GeoLocationT -instance Beamable (PrimaryKey GeoLocationT) - -instance Table GeoLocationT where - newtype PrimaryKey GeoLocationT f = GeoLocationPrimaryKey (C f PrimaryKeyType) - deriving Generic - primaryKey = GeoLocationPrimaryKey . geoLocation_id -deriving instance Eq (PrimaryKey GeoLocationT Identity) - -instance ToHttpApiData (PrimaryKey GeoLocationT Identity) where - toUrlPiece (GeoLocationPrimaryKey locId) = toUrlPiece locId - -instance FromHttpApiData (PrimaryKey GeoLocationT Identity) where - parseUrlPiece t = GeoLocationPrimaryKey <$> parseUrlPiece t