Add endpoint to find Owner by ID

src/Owner.hs

@@ -287,3 +287,8 @@ upsertOwner o = do
 -- | Function to get an Owner
 findOwner :: T.Text -> Action IO (Maybe Document)
 findOwner zaddy = findOne (select ["address" =: zaddy] "owners")
+
+-- | Function to get an Owner by id
+findOwnerById :: T.Text -> Action IO (Maybe Document)
+findOwnerById i =
+  findOne (select ["_id" =: (read (T.unpack i) :: ObjectId)] "owners")

src/ZGoBackend.hs

@@ -586,6 +586,22 @@ routes pipe config = do
                  [ "message" .= ("Owner found!" :: String)
                  , "owner" .= toJSON (q :: Owner)
                  ])
+  get "/api/ownerid" $ do
+    id <- param "id"
+    owner <- liftIO $ run (findOwnerById id)
+    case owner of
+      Nothing -> status noContent204
+      Just o -> do
+        let pOwner = cast' (Doc o)
+        case pOwner of
+          Nothing -> status internalServerError500
+          Just q -> do
+            status ok200
+            Web.Scotty.json
+              (object
+                 [ "message" .= ("Owner found!" :: String)
+                 , "owner" .= toJSON (q :: Owner)
+                 ])
   --Upsert owner to DB
   post "/api/owner" $ do
     o <- jsonData

test/Spec.hs

@@ -139,7 +139,7 @@ main = do
             getResponseStatus res `shouldBe` ok200
         describe "Owner endpoint" $ do
           prop "add owner" testOwnerAdd
-          it "return owner" $ do
+          it "return owner by address" $ do
             req <-
               testGet
                 "/api/owner"
@@ -149,6 +149,11 @@ main = do
                 ]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
+          it "return owner by id" $ do
+            req <-
+              testGet "/api/ownerid" [("id", Just "627ad3492b05a76be3000001")]
+            res <- httpLBS req
+            getResponseStatus res `shouldBe` ok200
         describe "Order endpoint" $ do
           prop "upsert order" testOrderAdd
           it "get order by session" $ do