Add CBOR instances

flake.nix

@@ -13,10 +13,12 @@
     extra-substituters = [
       "https://cache.iog.io"
       "https://cardano-scaling.cachix.org"
+      "https://horizon.cachix.org"
     ];
     extra-trusted-public-keys = [
       "hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ="
       "cardano-scaling.cachix.org-1:QNK4nFrowZ/aIJMCBsE35m+O70fV6eewsBNdQnCSMKA="
+      "horizon.cachix.org-1:MeEEDRhRZTgv/FFGCv3479/dmJDfJ82G6kfUDxMSAw0="
     ];
     allow-import-from-derivation = true;
   };

hydra-invoices/ChangeLog.md

@@ -1,5 +1,9 @@
 # Changelog for hydra-invoices
 
+## 0.1.0.0
+
+* Derive `Serialise` instances for CBOR generation.
+
 ## 0.0.5.0
 
 * Use `hashWith id` instead of `hashWith CBOR.serialise'`.

hydra-invoices/hydra-invoices.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.8
 name:               hydra-invoices
-version:            0.0.5.0
+version:            0.1.0.0
 synopsis:           Invoice types and functions for Hydra lightning payments.
 description:        Invoice types and functions for Hydra lightning payments.
 category:           Cardano
@@ -34,9 +34,27 @@ library
   build-depends:
     , bytestring
     , cardano-api
+    , cardano-binary
     , cardano-crypto-class
     , random
     , time
 
   exposed-modules: Hydra.Invoice
   hs-source-dirs:  src
+
+test-suite tests
+  import:         lang
+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N
+  hs-source-dirs: test
+  main-is:        Main.hs
+  type:           exitcode-stdio-1.0
+  build-depends:
+    , base
+    , cardano-api
+    , cardano-api:gen
+    , cardano-binary
+    , hedgehog
+    , hydra-invoices
+    , tasty
+    , tasty-hedgehog
+    , time

hydra-invoices/src/Hydra/Invoice.hs

@@ -12,6 +12,7 @@ import "base" Control.Monad (replicateM)
 import "base" Data.Kind (Type)
 import "bytestring" Data.ByteString qualified as BS
 import "cardano-api" Cardano.Api (Address, ShelleyAddr, Value)
+import "cardano-binary" Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR))
 import "cardano-crypto-class" Cardano.Crypto.Hash qualified as Crypto
 import "random" System.Random (randomRIO)
 import "time" Data.Time (UTCTime)
@@ -25,6 +26,12 @@ data Invoice paymentIdType addressType amountType datetimeType = MkInvoice
   }
   deriving stock (Eq, Show)
 
+instance (FromCBOR p, FromCBOR a, FromCBOR m, FromCBOR d) => FromCBOR (Invoice p a m d) where
+  fromCBOR = MkInvoice <$> fromCBOR <*> fromCBOR <*> fromCBOR <*> fromCBOR
+
+instance (ToCBOR p, ToCBOR a, ToCBOR m, ToCBOR d) => ToCBOR (Invoice p a m d) where
+  toCBOR (MkInvoice p a m d) = toCBOR p <> toCBOR a <> toCBOR m <> toCBOR d
+
 type PreImage :: Type
 newtype PreImage = UnsafePreImage {fromPreImage :: BS.ByteString}
   deriving stock (Show, Eq)

hydra-invoices/test/Main.hs

@@ -0,0 +1,8 @@
+module Main where
+
+import Test.Hspec.Runner (hspec)
+
+import Spec qualified
+
+main :: IO ()
+main = hspec Spec.spec

hydra-invoices/test/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}

hydra-invoices/test/Test/Hydra/InvoiceSpec.hs

@@ -0,0 +1,41 @@
+module Test.Hydra.InvoiceSpec where
+
+import Cardano.Binary (toCBOR, fromCBOR, serialize, decodeFull)
+import Cardano.Api qualified as C
+import Hydra.Invoice
+import Hedgehog (tripping, forAll, (===), Property, Gen, property, GenT, MonadGen)
+import Hedgehog.Gen qualified as Gen
+import Hedgehog.Range qualified as Range
+import Test.Gen.Cardano.Api.Typed (genAddressShelley, genValueForTxOut)
+import Data.Time (UTCTime(UTCTime), fromGregorian, secondsToDiffTime)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.Hedgehog (testProperty)
+
+genUTCTime :: MonadGen m => m UTCTime
+genUTCTime = do
+  year <- Gen.integral (Range.linear 1900 2100)
+  month <- Gen.integral (Range.linear 1 12)
+  day <- Gen.integral (Range.linear 1 28)
+  let utcDay = fromGregorian year month day
+  seconds <- Gen.integral (Range.linear 0 86399)
+  let utcDayTime = secondsToDiffTime seconds
+  pure $ UTCTime utcDay utcDayTime
+
+genInvoiceData :: Gen (C.Address C.ShelleyAddr, C.Value, UTCTime)
+genInvoiceData = do
+  address <- genAddressShelley
+  value <- genValueForTxOut (C.shelleyBasedEra @C.ConwayEra)
+  time <- genUTCTime
+  pure (address, value, time)
+
+prop_roundtrip_standard_invoice :: Property
+prop_roundtrip_standard_invoice = property $ do
+  (address, value, time) <- forAll genInvoiceData
+  (inv, _) <- C.liftIO $ generateStandardInvoice address value time
+  tripping inv serialize decodeFull
+
+tests :: TestTree
+tests = do
+  testGroup "Hydra.Invoice"
+    [ testProperty "roundtrip standard invoice" prop_roundtrip_standard_invoice
+    ]