Attestation.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

{- | Attestation types and functions for OpenTimestamps.

This module provides data types and functions for working with
different types of attestations that can be attached to timestamps,
including Bitcoin attestations, pending attestations, and unknown attestations.
-}
module OpenTimestamps.Attestation
  ( Attestation (..)
  , isPending
  , isBitcoinAttestation
  , isLitecoinAttestation
  , isUnknownAttestation
  , bitcoinTag
  , pendingTag
  , getAttestation
  , putAttestation
  ) where

import Data.Binary.Get (Get, getByteString, runGetOrFail)
import Data.Binary.Put (Put, putByteString, runPut)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word (Word32)
import OpenTimestamps.Config as Config
import OpenTimestamps.VarInt

{- | Attestation types that can be attached to timestamps.

Bitcoin attestations contain the block height at which the commitment
was confirmed. Pending attestations contain a URI for a calendar
service. Unknown attestations are used for future extensibility.
-}
data Attestation where
  Bitcoin :: {height' :: Word32} -> Attestation
  Pending :: {uri' :: T.Text} -> Attestation
  Unknown ::
    {tag' :: BS.ByteString, data' :: BS.ByteString} ->
    Attestation
  deriving (Eq, Show, Ord)

-- | Check if an attestation is a pending attestation.
isPending :: Attestation -> Bool
isPending (Pending _) = True
isPending _ = False

-- | Check if an attestation is a Bitcoin attestation.
isBitcoinAttestation :: Attestation -> Bool
isBitcoinAttestation (Bitcoin _) = True
isBitcoinAttestation _ = False

{- | Check if an attestation is a Litecoin attestation.
Currently always returns False as Litecoin attestations are not implemented.
-}
isLitecoinAttestation :: Attestation -> Bool
isLitecoinAttestation _ = False -- Placeholder, as Litecoin is not in Attestation yet

-- | Check if an attestation is an unknown attestation.
isUnknownAttestation :: Attestation -> Bool
isUnknownAttestation (Unknown _ _) = True
isUnknownAttestation _ = False

-- | Tag byte sequence identifying Bitcoin attestations.
bitcoinTag :: BS.ByteString
bitcoinTag = "\x05\x88\x96\x0d\x73\xd7\x19\x01"

-- | Tag byte sequence identifying pending attestations.
pendingTag :: BS.ByteString
pendingTag = "\x83\xdf\xe3\x0d\x2e\xf9\x0c\x8e"

-- | Deserialize an attestation from binary format.
getAttestation :: Get Attestation
getAttestation = do
  tag <- getByteString 8
  len <- getVarInt
  payload <- getByteString len
  if tag == bitcoinTag
    then case runGetOrFail getVarInt (BSL.fromStrict payload) of
      Left (_, _, err) -> fail $ "Bitcoin attestation deserialization error: " ++ err
      Right (_, _, h) -> pure $ Bitcoin (fromIntegral h)
    else
      if tag == pendingTag
        then case runGetOrFail (getVarBytes Config.attestationMaxVarBytesLength 0) (BSL.fromStrict payload) of
          Left (_, _, err) -> fail $ "Pending attestation deserialization error: " ++ err
          Right (_, _, uriBs) -> pure $ Pending (TE.decodeUtf8 uriBs)
        else
          pure $ Unknown tag payload

-- | Serialize an attestation to binary format.
putAttestation :: Attestation -> Put
putAttestation att = do
  let (tag, payloadPut) = case att of
        Bitcoin h -> (bitcoinTag, putVarInt (fromIntegral h))
        Pending u -> (pendingTag, putVarBytes (TE.encodeUtf8 u))
        Unknown t d -> (t, putByteString d)

  putByteString tag
  let payloadBS = BSL.toStrict (runPut payloadPut)
  putVarBytes payloadBS