diff --git a/projects/trails/src/Mirza/Trails/API.hs b/projects/trails/src/Mirza/Trails/API.hs index 8cfbc6d9..dbd09b84 100644 --- a/projects/trails/src/Mirza/Trails/API.hs +++ b/projects/trails/src/Mirza/Trails/API.hs @@ -4,7 +4,7 @@ module Mirza.Trails.API where -import Mirza.Trails.Types (SignaturePlaceholder, TrailEntryResponse) +import Mirza.Trails.Types (SignaturePlaceholder, TrailEntry) import Mirza.Common.Types (HealthResponse) @@ -34,6 +34,6 @@ serverAPI = Proxy type PublicAPI = "healthz" :> Get '[JSON] HealthResponse :<|> "version" :> Get '[JSON] String - :<|> "trail" :> Capture "eventId" EventId :> Get '[JSON] [TrailEntryResponse] - :<|> "trail" :> Capture "signature" SignaturePlaceholder :> Get '[JSON] [TrailEntryResponse] - :<|> "trail" :> ReqBody '[JSON] [TrailEntryResponse] :> Post '[JSON] NoContent -- TODO: Should fix this type so that its the correct status code. + :<|> "trail" :> Capture "eventId" EventId :> Get '[JSON] [TrailEntry] + :<|> "trail" :> Capture "signature" SignaturePlaceholder :> Get '[JSON] [TrailEntry] + :<|> "trail" :> ReqBody '[JSON] [TrailEntry] :> Post '[JSON] NoContent -- TODO: Should fix this type so that its the correct status code. diff --git a/projects/trails/src/Mirza/Trails/Client/Servant.hs b/projects/trails/src/Mirza/Trails/Client/Servant.hs index 55249ce2..bac0e8ca 100644 --- a/projects/trails/src/Mirza/Trails/Client/Servant.hs +++ b/projects/trails/src/Mirza/Trails/Client/Servant.hs @@ -24,9 +24,9 @@ import Servant.Client health :: ClientM HealthResponse versionInfo :: ClientM String -getTrailByEventId :: EventId -> ClientM [TrailEntryResponse] -getTrailBySignature :: SignaturePlaceholder -> ClientM [TrailEntryResponse] -addTrail :: [TrailEntryResponse] -> ClientM NoContent +getTrailByEventId :: EventId -> ClientM [TrailEntry] +getTrailBySignature :: SignaturePlaceholder -> ClientM [TrailEntry] +addTrail :: [TrailEntry] -> ClientM NoContent _api :: Client ClientM ServerAPI diff --git a/projects/trails/src/Mirza/Trails/Handlers/Trails.hs b/projects/trails/src/Mirza/Trails/Handlers/Trails.hs index aa816e11..fb853eef 100644 --- a/projects/trails/src/Mirza/Trails/Handlers/Trails.hs +++ b/projects/trails/src/Mirza/Trails/Handlers/Trails.hs @@ -23,13 +23,13 @@ import Control.Monad.Identity getTrailByEventId :: ( Member context '[HasEnvType, HasConnPool, HasKatipContext, HasKatipLogEnv] , Member err '[AsTrailsServiceError, AsSqlError]) - => EventId -> AppM context err [TrailEntryResponse] + => EventId -> AppM context err [TrailEntry] getTrailByEventId eventId = do runDb $ (getTrailByEventIdQuery eventId) getTrailByEventIdQuery :: (AsTrailsServiceError err) - => EventId -> DB context err [TrailEntryResponse] + => EventId -> DB context err [TrailEntry] getTrailByEventIdQuery eventId = do entryList <- pg $ runSelectReturningList $ select $ do entry <- all_ (_entries trailsDB) @@ -42,13 +42,13 @@ getTrailByEventIdQuery eventId = do getTrailBySignature :: ( Member context '[HasEnvType, HasConnPool, HasKatipContext, HasKatipLogEnv] , Member err '[AsTrailsServiceError, AsSqlError]) - => SignaturePlaceholder -> AppM context err [TrailEntryResponse] + => SignaturePlaceholder -> AppM context err [TrailEntry] getTrailBySignature sig = do runDb $ (getTrailBySignatureQuery sig) getTrailBySignatureQuery :: (AsTrailsServiceError err) - => SignaturePlaceholder -> DB context err [TrailEntryResponse] + => SignaturePlaceholder -> DB context err [TrailEntry] getTrailBySignatureQuery searchSignature = do previousEntries <- getPreviousEntriesBySignatureQuery searchSignature followingEntries <- getPreviousEntriesQuery searchSignature @@ -56,7 +56,7 @@ getTrailBySignatureQuery searchSignature = do getPreviousEntriesQuery :: (AsTrailsServiceError err) - => SignaturePlaceholder -> DB context err [TrailEntryResponse] + => SignaturePlaceholder -> DB context err [TrailEntry] getPreviousEntriesQuery searchSignature = do followingSignatures <- pg $ runSelectReturningList $ select $ do previous <- all_ (_previous trailsDB) @@ -65,22 +65,22 @@ getPreviousEntriesQuery searchSignature = do entries <- traverse getEntryBySignature (entriesPrimaryKeyToSignature <$> followingSignatures) - followingEntries <- concat <$> traverse getPreviousEntriesQuery (trailEntryResponseSignature <$> entries) + followingEntries <- concat <$> traverse getPreviousEntriesQuery (trailEntrySignature <$> entries) pure $ followingEntries <> entries getPreviousEntriesBySignatureQuery :: (AsTrailsServiceError err) - => SignaturePlaceholder -> DB context err [TrailEntryResponse] + => SignaturePlaceholder -> DB context err [TrailEntry] getPreviousEntriesBySignatureQuery searchSignature = do entry <- getEntryBySignature searchSignature - let previous = trailEntryResponseParentSignatures entry + let previous = trailEntryParentSignatures entry previousEntries <- concat <$> traverse getPreviousEntriesBySignatureQuery previous pure $ entry : previousEntries getEntryBySignature :: (AsTrailsServiceError err) - => SignaturePlaceholder -> DB context err TrailEntryResponse + => SignaturePlaceholder -> DB context err TrailEntry getEntryBySignature searchSignature = do maybeEntry <- pg $ runSelectReturningOne $ select $ do entry <- all_ (_entries trailsDB) @@ -93,11 +93,11 @@ getEntryBySignature searchSignature = do previous <- all_ (_previous trailsDB) guard_ (previous_entry_signature previous ==. val_ (EntriesPrimaryKey searchSignature)) pure previous - pure $ buildTrailEntryResponse entry previous + pure $ buildTrailEntry entry previous -buildTrailEntryResponse :: Entries -> [Previous] -> TrailEntryResponse -buildTrailEntryResponse entries previous = TrailEntryResponse 1 +buildTrailEntry :: Entries -> [Previous] -> TrailEntry +buildTrailEntry entries previous = TrailEntry 1 (onLocalTime EntryTime $ entries_timestamp entries) (entries_gs1company_prefix entries) (EventId $ entries_event_id entries) @@ -107,17 +107,17 @@ buildTrailEntryResponse entries previous = TrailEntryResponse 1 addTrail :: ( Member context '[HasEnvType, HasConnPool, HasKatipContext, HasKatipLogEnv] , Member err '[AsTrailsServiceError, AsSqlError]) - => [TrailEntryResponse] -> AppM context err NoContent + => [TrailEntry] -> AppM context err NoContent addTrail trail = do _ <- runDb $ (addEntryQuery trail) pure NoContent addEntryQuery :: (AsTrailsServiceError err) - => [TrailEntryResponse] -> DB context err () + => [TrailEntry] -> DB context err () addEntryQuery entries_raw = do - let entries = trailEntryResponseToEntriesT <$> entries_raw - let previous = concat $ trailEntryResponseToParentsT <$> entries_raw + let entries = trailEntryToEntriesT <$> entries_raw + let previous = concat $ trailEntryToParentsT <$> entries_raw _ <- pg $ runInsertReturningList $ insert (_entries trailsDB) $ insertValues entries _ <- pg $ runInsertReturningList $ insert (_previous trailsDB) @@ -125,13 +125,13 @@ addEntryQuery entries_raw = do pure () -trailEntryResponseToEntriesT :: TrailEntryResponse -> EntriesT Identity -trailEntryResponseToEntriesT trailEntry = EntriesT (trailEntryResponseSignature trailEntry) - (toDbTimestamp $ getEntryTime $ trailEntryResponseTimestamp trailEntry) - (trailEntryResponseGS1CompanyPrefix trailEntry) - (unEventId $ trailEntryResponseEventID trailEntry) +trailEntryToEntriesT :: TrailEntry -> EntriesT Identity +trailEntryToEntriesT trailEntry = EntriesT (trailEntrySignature trailEntry) + (toDbTimestamp $ getEntryTime $ trailEntryTimestamp trailEntry) + (trailEntryGS1CompanyPrefix trailEntry) + (unEventId $ trailEntryEventID trailEntry) Nothing -trailEntryResponseToParentsT :: TrailEntryResponse -> [PreviousT Identity] -trailEntryResponseToParentsT trailEntry = (PreviousT (EntriesPrimaryKey $ trailEntryResponseSignature trailEntry)) <$> (trailEntryResponseParentSignatures trailEntry) +trailEntryToParentsT :: TrailEntry -> [PreviousT Identity] +trailEntryToParentsT trailEntry = (PreviousT (EntriesPrimaryKey $ trailEntrySignature trailEntry)) <$> (trailEntryParentSignatures trailEntry) diff --git a/projects/trails/src/Mirza/Trails/Types.hs b/projects/trails/src/Mirza/Trails/Types.hs index 890df9ca..90285f26 100644 --- a/projects/trails/src/Mirza/Trails/Types.hs +++ b/projects/trails/src/Mirza/Trails/Types.hs @@ -72,7 +72,7 @@ instance HasKatipContext (TrailsContext) where -- ***************************************************************************** --- Service Response Types +-- Service Types -- ***************************************************************************** -- Note: The definitions in this section are reverse order defined(more specific @@ -82,46 +82,46 @@ instance HasKatipContext (TrailsContext) where -- a section appears logically bottom to top, rather then the normal top -- to bottom. -data TrailEntryResponse = TrailEntryResponse - { trailEntryResponseVersion :: Integer - , trailEntryResponseTimestamp :: EntryTime - , trailEntryResponseGS1CompanyPrefix :: GS1CompanyPrefix - , trailEntryResponseEventID :: EventId - , trailEntryResponseParentSignatures :: [SignaturePlaceholder] - , trailEntryResponseSignature :: SignaturePlaceholder +data TrailEntry = TrailEntry + { trailEntryVersion :: Integer + , trailEntryTimestamp :: EntryTime + , trailEntryGS1CompanyPrefix :: GS1CompanyPrefix + , trailEntryEventID :: EventId + , trailEntryParentSignatures :: [SignaturePlaceholder] + , trailEntrySignature :: SignaturePlaceholder } deriving (Show, Generic, Eq) -instance ToSchema TrailEntryResponse - -instance ToJSON TrailEntryResponse where - toJSON (TrailEntryResponse version timestamp org eventId parentSignatures eventSignature) = object - [ trailEntryResponseJSONFieldVersion .= version - , trailEntryResponseJSONFieldTimestamp .= timestamp - , trailEntryResponseJSONFieldGS1CompanyPrefix .= org - , trailEntryResponseJSONFieldEventId .= eventId - , trailEntryResponseJSONFieldParentSignatures .= parentSignatures - , trailEntryResponseJSONFieldSignature .= eventSignature +instance ToSchema TrailEntry + +instance ToJSON TrailEntry where + toJSON (TrailEntry version timestamp org eventId parentSignatures eventSignature) = object + [ trailEntryJSONFieldVersion .= version + , trailEntryJSONFieldTimestamp .= timestamp + , trailEntryJSONFieldGS1CompanyPrefix .= org + , trailEntryJSONFieldEventId .= eventId + , trailEntryJSONFieldParentSignatures .= parentSignatures + , trailEntryJSONFieldSignature .= eventSignature ] -instance FromJSON TrailEntryResponse where - parseJSON = withObject "TrailEntryResponse" $ \o -> TrailEntryResponse - <$> o .: trailEntryResponseJSONFieldVersion - <*> o .: trailEntryResponseJSONFieldTimestamp - <*> o .: trailEntryResponseJSONFieldGS1CompanyPrefix - <*> o .: trailEntryResponseJSONFieldEventId - <*> o .: trailEntryResponseJSONFieldParentSignatures - <*> o .: trailEntryResponseJSONFieldSignature - -trailEntryResponseJSONFieldVersion :: Text -trailEntryResponseJSONFieldVersion = "version" -trailEntryResponseJSONFieldTimestamp :: Text -trailEntryResponseJSONFieldTimestamp = "timestamp" -trailEntryResponseJSONFieldGS1CompanyPrefix :: Text -trailEntryResponseJSONFieldGS1CompanyPrefix = "org" -trailEntryResponseJSONFieldEventId :: Text -trailEntryResponseJSONFieldEventId = "event_id" -trailEntryResponseJSONFieldParentSignatures :: Text -trailEntryResponseJSONFieldParentSignatures = "parent_signatures" -trailEntryResponseJSONFieldSignature :: Text -trailEntryResponseJSONFieldSignature = "signature" +instance FromJSON TrailEntry where + parseJSON = withObject "TrailEntry" $ \o -> TrailEntry + <$> o .: trailEntryJSONFieldVersion + <*> o .: trailEntryJSONFieldTimestamp + <*> o .: trailEntryJSONFieldGS1CompanyPrefix + <*> o .: trailEntryJSONFieldEventId + <*> o .: trailEntryJSONFieldParentSignatures + <*> o .: trailEntryJSONFieldSignature + +trailEntryJSONFieldVersion :: Text +trailEntryJSONFieldVersion = "version" +trailEntryJSONFieldTimestamp :: Text +trailEntryJSONFieldTimestamp = "timestamp" +trailEntryJSONFieldGS1CompanyPrefix :: Text +trailEntryJSONFieldGS1CompanyPrefix = "org" +trailEntryJSONFieldEventId :: Text +trailEntryJSONFieldEventId = "event_id" +trailEntryJSONFieldParentSignatures :: Text +trailEntryJSONFieldParentSignatures = "parent_signatures" +trailEntryJSONFieldSignature :: Text +trailEntryJSONFieldSignature = "signature" diff --git a/projects/trails/stack.yaml.lock b/projects/trails/stack.yaml.lock index c2474222..af8719e7 100644 --- a/projects/trails/stack.yaml.lock +++ b/projects/trails/stack.yaml.lock @@ -7,51 +7,51 @@ packages: - completed: subdir: beam-core cabal-file: - size: 4725 - sha256: 8b00c1a76fc13d252c7ab62cc965454b84cef1a0d4de62f63a05ac9208ea4520 + size: 5044 + sha256: 7514a7b9cc092d7e890adf2ad08c1ea3c66ea5900e263b32ff0c55c31e01bac0 name: beam-core - version: 0.7.2.1 + version: 0.8.0.0 git: https://github.com/tathougies/beam.git pantry-tree: - size: 2484 - sha256: 92688457a700af6f79b47bb4390b8ffd841082b6aebb3b6cb61e38766b214281 - commit: 2489a213cdee6341de46a3aa015c35067f4d6076 + size: 2768 + sha256: 341603452ba25539599400e589d5ce09fe17dcbd932ffb2787144d13ab008cc5 + commit: 737b73c6ec1c6aac6386bf9592a02a91f34a9478 original: subdir: beam-core git: https://github.com/tathougies/beam.git - commit: 2489a213cdee6341de46a3aa015c35067f4d6076 + commit: 737b73c6ec1c6aac6386bf9592a02a91f34a9478 - completed: subdir: beam-migrate cabal-file: - size: 4794 - sha256: 820207aa9343cd664f045b0e8e2d6f2d1572e21c5c8101c3f183d461a5ebd46b + size: 4920 + sha256: b9b1d290466ab16617dac94c481f9571a057d8a6816878a03c718a64e358b802 name: beam-migrate - version: 0.3.2.0 + version: 0.4.0.0 git: https://github.com/tathougies/beam.git pantry-tree: size: 1898 - sha256: 470500d115188b66a8532cead6202868625f4ef775078f074c11774ffee4c6db - commit: 2489a213cdee6341de46a3aa015c35067f4d6076 + sha256: c4e526df44404c52e078958e35a7180c3bd9e6c53c9679490ed2f717f682321f + commit: 737b73c6ec1c6aac6386bf9592a02a91f34a9478 original: subdir: beam-migrate git: https://github.com/tathougies/beam.git - commit: 2489a213cdee6341de46a3aa015c35067f4d6076 + commit: 737b73c6ec1c6aac6386bf9592a02a91f34a9478 - completed: subdir: beam-postgres cabal-file: - size: 3176 - sha256: d22666212ad76f30f7682c0cb21304940efe782f959c6b6b76fe4719417cb8c9 + size: 4173 + sha256: a01443ce503cfc58cbe28f476252672282347579444b65f2925a12ba6a2c13f5 name: beam-postgres - version: 0.3.2.1 + version: 0.4.0.0 git: https://github.com/tathougies/beam.git pantry-tree: - size: 1831 - sha256: aead477ca9c951bed53fa2285d8f091c3708df62d7bcc9a04cc7ce3449df3bdc - commit: 2489a213cdee6341de46a3aa015c35067f4d6076 + size: 2582 + sha256: 5d126b5a3f491f84a46c5f812396bcf64f1570c02e18071bedea29c67bfda43f + commit: 737b73c6ec1c6aac6386bf9592a02a91f34a9478 original: subdir: beam-postgres git: https://github.com/tathougies/beam.git - commit: 2489a213cdee6341de46a3aa015c35067f4d6076 + commit: 737b73c6ec1c6aac6386bf9592a02a91f34a9478 - completed: cabal-file: size: 2908