[#500] Trails: Error when the version is not supported.

projects/trails/src/Mirza/Trails/Handlers/Trails.hs

@@ -20,6 +20,8 @@ import           Database.Beam.Query                      hiding (time)
 import           Servant
 
 import           Control.Lens.Extras
+import           Control.Lens.Type (AReview)
+import           Control.Monad.Error.Lens                 (throwing_)
 
 import           Control.Monad.Identity
 
@@ -138,6 +140,13 @@ addTrail trail = do
   pure NoContent
 
 
+throwing_If :: MonadError e m => Control.Lens.Type.AReview e () -> Bool -> m ()
+throwing_If x result = if result then
+                         throwing_ x
+                       else
+                         pure ()
+
+
 addEntryQuery :: (AsTrailsServiceError err)
               => [TrailEntry] -> DB context err ()
 addEntryQuery entriesRaw = do
@@ -146,6 +155,9 @@ addEntryQuery entriesRaw = do
   -- Note: We only need to check if the signature exists (and not that the full event contents match) since the signature guarantees that they events are the same.
   let newEntries = filter (\entry -> not $ elem (trailEntrySignature entry) $ trailEntrySignature <$> existingEntries) entriesRaw
 
+  -- Check that the event versions are all valid.
+  throwing_If _InvalidEntryVersionTSE $ not $ all (== 1) $ trailEntryVersion <$> newEntries
+
   let entries = trailEntryToEntriesT <$> newEntries
   let previous = concat $ trailEntryToParentsT <$> newEntries
   _ <- pg $ runInsertReturningList $ insert (_entries trailsDB)

projects/trails/src/Mirza/Trails/Service.hs

@@ -108,6 +108,7 @@ trailsErrorToHttpError trailsError =
     (DBErrorTE _)                   -> unexpectedError trailsError
     (SignatureNotFoundTSE)          -> httpError err404 "A trail with a matching signature was not found."
     (EventIdNotFoundTSE)            -> httpError err404 "A trail with the matching EventId was not found."
+    (InvalidEntryVersionTSE)        -> httpError err400 "Only version 1 trail entries are currently supported by this service."
     (UnmatchedUniqueViolationTSE _) -> unexpectedError trailsError
 
 -- | A generic internal server error has occured. We include no more information in the result returned to the user to

projects/trails/src/Mirza/Trails/Types.hs

@@ -190,6 +190,7 @@ data TrailsServiceError
   = DBErrorTE SqlError
   | SignatureNotFoundTSE
   | EventIdNotFoundTSE
+  | InvalidEntryVersionTSE
   | UnmatchedUniqueViolationTSE SqlError
   deriving (Show)
 $(makeClassyPrisms ''TrailsServiceError)