Merge pull request #495 from data61/migrations

Flatten database structure now that we plan to handle migrations independently.

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

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

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