db: Fix for the outsum column of the epoch table

This column is the sum of transactions outputs for the epoch. On
test networks (never been seen on mainnet) it is possible for this
sum to end up larger than the maximum positive value that can be
stored in a 64 bit signed integer ('Int64'). However, the output sum
was being stored store in a 64 bit unsigned integer ('Word64') but
the Persistent library does not correctly supported 'Word64'. Instead
it "casts" it from 'Word64' to 'Int64'. For values great that the
max positive value of an 'Int64' this results on the value wrapping
to negative and hence being rejected by the SQL domain constraint
which requres 'outsum >= 0'.

This solution switches 'outsum' in the Haskell world from 'Word64'
to 'Word128' which is incredibly unlikley to overflow given the
limitation on number of transactions per block and per epoch. On
the SQL side we use an PostgreSQL type of 'numeric (38, 0)'.

Closes: #197

Author: erikd

cardano-db/cardano-db.cabal

@@ -42,6 +42,7 @@ library
                         Cardano.Db.Run
                         Cardano.Db.Schema
                         Cardano.Db.Schema.Types
+                        Cardano.Db.Schema.Orphans
                         Cardano.Db.Types
 
 
@@ -76,6 +77,7 @@ library
                       , transformers
                       -- This is never intended to run on non-POSIX systems.
                       , unix
+                      , wide-word
 
 executable cardano-db-tool
   default-language:     Haskell2010
@@ -133,7 +135,9 @@ test-suite test
                       , aeson
                       , cardano-db
                       , cardano-ledger
+                      , persistent
                       , hedgehog
+                      , wide-word
 
 test-suite test-db
   default-language:     Haskell2010

cardano-db/src/Cardano/Db/Schema.hs

@@ -16,11 +16,14 @@
 
 module Cardano.Db.Schema where
 
+import Cardano.Db.Schema.Orphans ()
+
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
 import Data.Word (Word16, Word64)
+import Data.WideWord.Word128 (Word128)
 
 -- Do not use explicit imports from this module as the imports can change
 -- from version to version due to changes to the TH code in Persistent.
@@ -128,7 +131,7 @@ share
   -- hold 204 times the total Lovelace distribution. The chance of that much being transacted
   -- in a single epoch is relatively low.
   Epoch
-    outSum              Word64              sqltype=outsum
+    outSum              Word128             sqltype=word128
     txCount             Word64              sqltype=uinteger
     blkCount            Word64              sqltype=uinteger
     no                  Word64              sqltype=uinteger

cardano-db/src/Cardano/Db/Schema/Orphans.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Cardano.Db.Schema.Orphans where
+
+import Data.WideWord.Word128 (Word128)
+
+import qualified Data.Text as Text
+
+import Database.Persist.Class (PersistField (..))
+import Database.Persist.Types (PersistValue (..))
+
+
+instance PersistField Word128 where
+  toPersistValue = PersistText . Text.pack . show
+  fromPersistValue (PersistText bs) = Right $ read (Text.unpack bs)
+  fromPersistValue x =
+    Left $ mconcat [ "Failed to parse Haskell type Word128: ", Text.pack (show x) ]
+

cardano-db/test/Test/Property/Cardano/Db/Types.hs

@@ -9,6 +9,9 @@ import           Cardano.Chain.Common (maxLovelaceVal)
 
 import qualified Data.Aeson as Aeson
 import           Data.Word (Word64)
+import           Data.WideWord.Word128 (Word128 (..))
+
+import           Database.Persist.Class (PersistField (..))
 
 import           Cardano.Db
 
@@ -24,6 +27,12 @@ prop_roundtrip_Ada_via_JSON =
     mv <- H.forAll genAda
     H.tripping mv Aeson.encode Aeson.eitherDecode
 
+prop_roundtrip_Word128_PersistField :: Property
+prop_roundtrip_Word128_PersistField =
+  H.withTests 5000 . H.property $ do
+    w128 <- H.forAll genWord128
+    H.tripping w128 toPersistValue fromPersistValue
+
 -- -----------------------------------------------------------------------------
 
 genAda :: Gen Ada
@@ -38,6 +47,12 @@ genAda =
         , Gen.word64 (Range.linear (maxLovelaceVal - 5000) maxLovelaceVal) -- Near max.
         ]
 
+genWord128 :: Gen Word128
+genWord128 = Word128 <$> genWord64 <*> genWord64
+
+genWord64 :: Gen Word64
+genWord64 = Gen.word64 Range.constantBounded
+
 -- -----------------------------------------------------------------------------
 
 tests :: IO Bool

cardano-db/test/cardano-db-test.cabal

@@ -61,3 +61,4 @@ library
                       , transformers
                       -- This is never intended to run on non-POSIX systems.
                       , unix
+                      , wide-word

schema/migration-1-0001-20190730.sql

@@ -21,6 +21,10 @@ BEGIN
     -- Stake addresses are a 28 byte hash prepended with a byte describing the address.
     EXECUTE 'CREATE DOMAIN addr29type AS bytea CHECK (octet_length (VALUE) = 29);';
 
+    -- 'maxBound :: Word128' as a decimal has 39 digits, so we only need to check that it
+    -- is positive.
+    EXECUTE 'CREATE DOMAIN word128type AS numeric (38, 0) CHECK (VALUE >= 0);';
+
     UPDATE "schema_version" SET stage_one = 1;
     RAISE NOTICE 'DB has been migrated to stage_one version %', next_version;
   END IF;

schema/migration-1-0003-20200211.sql

@@ -9,8 +9,11 @@ BEGIN
   SELECT stage_one + 1 INTO next_version FROM "schema_version";
   IF next_version = 2 THEN
     -- Used as the sum of tx outputs for an epoch.
-    -- Need this to catch possible overflow.
-    EXECUTE 'CREATE DOMAIN outsum AS bigint CHECK (VALUE >= 0);';
+    -- Persistent does not support more precision than 'Int64' (support for 'Word64'
+    -- is done as a 'cast' to/from 'Int64' resulting in values greater than
+    -- 'maxBound :: Int64' being represented in the database as negative values.
+    -- Instead we we use 'Word128'.
+    EXECUTE 'CREATE DOMAIN outsum AS word128type;';
 
     UPDATE "schema_version" SET stage_one = next_version;
     RAISE NOTICE 'DB has been migrated to stage_one version %', next_version;