[CAD-779] Fix JSON return type, return original JSON.

src/DB.hs

@@ -17,11 +17,11 @@ module DB
 
 import           Cardano.Prelude
 
-import           Data.Aeson (encode, eitherDecode)
+import           Data.Aeson (eitherDecode)
 import qualified Data.Map as Map
 import           Data.IORef (IORef, readIORef, modifyIORef)
 
-import qualified Data.ByteString as BS
+import qualified Data.Text as T
 import qualified Data.ByteString.Lazy as BL
 
 import           Types
@@ -46,11 +46,9 @@ import           Cardano.Db.Error as X
 -- but currently there is no complexity involved for that to be a sane choice.
 data DataLayer = DataLayer
     { dlGetPoolMetadataSimple   :: PoolHash -> IO (Either DBFail Text)
-    --{ dlGetPoolMetadataSimple   :: PoolHash -> IO (Either DBFail ByteString)
     , dlGetPoolMetadata         :: PoolHash -> IO (Either DBFail PoolOfflineMetadata)
     , dlAddPoolMetadata         :: PoolHash -> PoolOfflineMetadata -> IO (Either DBFail PoolOfflineMetadata)
     , dlAddPoolMetadataSimple   :: PoolHash -> Text -> IO (Either DBFail TxMetadataId)
-    --, dlAddPoolMetadataSimple   :: PoolHash -> ByteString -> IO (Either DBFail TxMetadataId)
     , dlGetBlacklistedPools     :: IO (Either DBFail [PoolHash])
     , dlAddBlacklistedPool      :: PoolHash -> IO (Either DBFail PoolHash)
     }
@@ -111,10 +109,6 @@ postgresqlDataLayer = DataLayer
         let metadata :: Text
             metadata = txMetadataMetadata txMetadata
 
-        --BS.putStrLn metadata
-        --putTextLn $ decodeUtf8 metadata
-
-        --return $ first (\m -> UnknownError (toS m)) $ eitherDecode $ BL.fromStrict metadata
         return $ first (\m -> UnknownError (toS m)) $ eitherDecode $ BL.fromStrict (encodeUtf8 metadata)
 
     , dlGetPoolMetadataSimple = \poolHash -> do
@@ -124,14 +118,18 @@ postgresqlDataLayer = DataLayer
     , dlAddPoolMetadata     = \poolHash poolMetadata -> panic "To implement!"
 
     , dlAddPoolMetadataSimple     = \poolHash poolMetadata -> do
+        --putTextLn poolMetadata
         let poolHashBytestring = (encodeUtf8 $ getPoolHash poolHash)
-        let poolEncodedMetadata = poolMetadata
-        let hashFromMetadata = B16.encode $ Crypto.digest (Proxy :: Proxy Crypto.Blake2b_256) $ (encodeUtf8 poolEncodedMetadata)
+        let hashFromMetadata = B16.encode $ Crypto.digest (Proxy :: Proxy Crypto.Blake2b_256) (encodeUtf8 poolMetadata)
+
+        putTextLn poolMetadata
 
-        when (hashFromMetadata /= poolHashBytestring) $
-            panic "TxMetadataHashMismatch"
+        -- Let us just ignore the newlines.
+        let cleanPoolMetadata = T.unwords . T.lines $ poolMetadata
 
-        fmap Right $ runDbAction Nothing $ insertTxMetadata $ TxMetadata poolHashBytestring poolEncodedMetadata
+        if hashFromMetadata /= poolHashBytestring
+            then return $ Left TxMetadataHashMismatch
+            else fmap Right $ runDbAction Nothing $ insertTxMetadata $ TxMetadata poolHashBytestring cleanPoolMetadata
 
     , dlGetBlacklistedPools = panic "To implement!"
     , dlAddBlacklistedPool  = \poolHash -> panic "To implement!"

src/Lib.hs

@@ -10,15 +10,14 @@ module Lib
     , DBFail (..) -- We need to see errors clearly outside
     , defaultConfiguration
     , runApp
+    , runAppStubbed
     , runPoolInsertion
     ) where
 
 import           Cardano.Prelude
 
-import qualified Data.ByteString as B
 import           Data.IORef               (newIORef)
-import           Data.Swagger             (Info (..), Swagger (..), ToSchema)
-
+import           Data.Swagger             (Info (..), Swagger (..))
 
 import           Network.Wai.Handler.Warp (defaultSettings, runSettings,
                                            setBeforeMainLoop, setPort)
@@ -39,8 +38,11 @@ import           Types
 -- The basic auth.
 type BasicAuthURL = BasicAuth "smash" User
 
+-- | Shortcut for common api result types.
+type ApiRes verb a = verb '[JSON] (Either DBFail a)
+
 -- GET api/v1/metadata/{hash}
-type OfflineMetadataAPI = "api" :> "v1" :> "metadata" :> Capture "hash" PoolHash :> Get '[JSON] PoolMetadataWrapped
+type OfflineMetadataAPI = "api" :> "v1" :> "metadata" :> Capture "hash" PoolHash :> ApiRes Get PoolMetadataWrapped
 -- POST api/v1/blacklist |-> {"blacklistPool" : "pool"}
 type BlacklistPoolAPI = BasicAuthURL :> "api" :> "v1" :> "blacklist" :> ReqBody '[JSON] BlacklistPool :> Post '[JSON] PoolOfflineMetadata
 
@@ -89,6 +91,16 @@ runApp configuration = do
 
     runSettings settings =<< mkApp configuration
 
+runAppStubbed :: Configuration -> IO ()
+runAppStubbed configuration = do
+    let port = cPortNumber configuration
+    let settings =
+          setPort port $
+          setBeforeMainLoop (hPutStrLn stderr ("listening on port " ++ show port)) $
+          defaultSettings
+
+    runSettings settings =<< mkAppStubbed configuration
+
 mkAppStubbed :: Configuration -> IO Application
 mkAppStubbed configuration = do
 
@@ -168,11 +180,11 @@ postBlacklistPool user blacklistPool = convertIOToHandler $ do
     return examplePoolOfflineMetadata
 
 -- throwError err404
-getPoolOfflineMetadata :: DataLayer -> PoolHash -> Handler PoolMetadataWrapped
+getPoolOfflineMetadata :: DataLayer -> PoolHash -> Handler (Either DBFail PoolMetadataWrapped)
 getPoolOfflineMetadata dataLayer poolHash = convertIOToHandler $ do
-    putTextLn $ show poolHash
-    fmap PoolMetadataWrapped $ either (\m -> panic $ renderLookupFail m) (\a -> a) <$> (dlGetPoolMetadataSimple dataLayer) poolHash
-    --(dlGetPoolMetadataSimple dataLayer) poolHash
+    let getPoolMetadataSimple = dlGetPoolMetadataSimple dataLayer
+    poolMetadata <- getPoolMetadataSimple poolHash
+    return $ PoolMetadataWrapped <$> poolMetadata
 
 -- | Here for checking the validity of the data type.
 --isValidPoolOfflineMetadata :: PoolOfflineMetadata -> Bool

src/Types.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric  #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 module Types
     ( ApplicationUser (..)
@@ -33,13 +33,16 @@ module Types
 
 import           Cardano.Prelude
 
-import           Data.Aeson
-import           Data.Swagger    (ToParamSchema (..), ToSchema (..), NamedSchema (..), declareSchemaRef)
+import           Data.Aeson          (FromJSON (..), ToJSON (..), object,
+                                      withObject, (.:), (.=))
+import           Data.Aeson.Encoding (unsafeToEncoding)
+import           Data.Swagger        (NamedSchema (..), ToParamSchema (..),
+                                      ToSchema (..))
+import           Data.Text.Encoding  (encodeUtf8Builder)
 
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BL
+import           Servant             (FromHttpApiData (..))
 
-import           Servant         (FromHttpApiData (..))
+import           Cardano.Db.Error
 
 -- | The basic @Configuration@.
 data Configuration = Configuration
@@ -158,10 +161,10 @@ instance ToSchema PoolHomepage
 
 -- | The bit of the pool data off the chain.
 data PoolOfflineMetadata = PoolOfflineMetadata
-    { pomName           :: !PoolName
-    , pomDescription    :: !PoolDescription
-    , pomTicker         :: !PoolTicker
-    , pomHomepage       :: !PoolHomepage
+    { pomName        :: !PoolName
+    , pomDescription :: !PoolDescription
+    , pomTicker      :: !PoolTicker
+    , pomHomepage    :: !PoolHomepage
     } deriving (Eq, Show, Ord, Generic)
 
 -- | Smart constructor, just adding one more layer of indirection.
@@ -184,8 +187,8 @@ newtype PoolPledgeAddress = PoolPledgeAddress
 -- | The bit of the pool data on the chain.
 -- This doesn't leave the internal database.
 data PoolOnlineData = PoolOnlineData
-    { podOwner          :: !PoolOwner
-    , podPledgeAddress  :: !PoolPledgeAddress
+    { podOwner         :: !PoolOwner
+    , podPledgeAddress :: !PoolPledgeAddress
     } deriving (Eq, Show, Ord, Generic)
 
 -- Required instances
@@ -217,16 +220,19 @@ instance ToSchema PoolOfflineMetadata
 
 
 newtype PoolMetadataWrapped = PoolMetadataWrapped Text
-    deriving (Eq, Show, Ord, Generic)
+    deriving (Eq, Ord, Show, Generic)
 
+-- Here we are usingg the unsafe encoding since we already have the JSON format
+-- from the database.
 instance ToJSON PoolMetadataWrapped where
-    --toJSON (PoolMetadataWrapped hash) = toJSON $ (either (\_ -> panic "Error") (\a -> a) (eitherDecode $ BL.fromStrict $ encodeUtf8 hash) :: PoolOfflineMetadata)
-
-    toJSON (PoolMetadataWrapped hash) = String $ hash
-    --toJSON (PoolMetadataWrapped hash) = String $ decodeUtf8 hash
+    toJSON (PoolMetadataWrapped metadata) = toJSON metadata
+    toEncoding (PoolMetadataWrapped metadata) = unsafeToEncoding $ encodeUtf8Builder metadata
 
 instance ToSchema PoolMetadataWrapped where
   declareNamedSchema _ =
     return $ NamedSchema (Just "PoolMetadataWrapped") $ mempty
 
+instance ToSchema DBFail where
+  declareNamedSchema _ =
+    return $ NamedSchema (Just "DBFail") $ mempty