haskell-opentimestamps-0.5.5.0: src/OpenTimestamps.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

{- | Main OpenTimestamps library module.

This module provides the primary API for OpenTimestamps functionality,
including timestamp creation, verification, upgrading, and pruning.
It re-exports functions from specialized modules for convenience.
-}
module OpenTimestamps
  ( info
  , prune
  , stamp
  , upgrade
  , verify
  , module OpenTimestamps.DetachedTimestampFile
  , module OpenTimestamps.Prune
  , module OpenTimestamps.Stamp
  , module OpenTimestamps.Verify
  )
where

import Data.Function ((&))
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
import OpenTimestamps.Attestation
  ( Attestation
  , isBitcoinAttestation
  , isLitecoinAttestation
  , isPending
  , isUnknownAttestation
  )
import OpenTimestamps.DetachedTimestampFile
  ( DetachedTimestampFile
  , deserialize
  , serialize
  , timestamp
  )
import OpenTimestamps.Prune (pruneTimestamp)
import OpenTimestamps.Stamp
  ( StampResult (..)
  , TimestampError (..)
  , stampDigest
  )
import OpenTimestamps.Types (OTsByteStream, OTsBytes)
import OpenTimestamps.Upgrade (upgradeTimestamp)
import OpenTimestamps.Verify
  ( BitcoinConfig
  , VerificationError (OtherVerificationError)
  , verifyDetachedTimestampFile
  )

-- | Helper to parse string arguments into attestation predicates.
parseAttestationArgs :: [String] -> [Attestation -> Bool]
parseAttestationArgs = map parseArg
  where
    parseArg "btc" = isBitcoinAttestation
    parseArg "ltc" = isLitecoinAttestation
    parseArg "unknown" = isUnknownAttestation
    parseArg "pending:*" = isPending
    parseArg s | "pending:" `T.isPrefixOf` T.pack s = isPending -- TODO: Refine to match specific URI
    parseArg _ = const False -- Default for unrecognised arguments

-- | Deserialize and display information about a timestamp file.
info ::
  OTsByteStream ->
  Either String DetachedTimestampFile
info = deserialize

-- | Create a timestamp by submitting a digest to calendar servers.
stamp ::
  [String] ->
  OTsBytes ->
  IO StampResult
stamp
  urls
  digest = do
    stampDigest urls digest

-- | Prune a timestamp by removing suboptimal attestations and empty branches.
prune ::
  [String] ->
  [String] ->
  OTsByteStream ->
  IO (Either String OTsByteStream)
prune
  verifyArgs
  discardArgs
  otsFileContent = do
    case deserialize otsFileContent of
      Left err -> pure $ Left $ "Failed to deserialize OTS file: " ++ err
      Right dtfs -> do
        let initialTimestamp = timestamp dtfs
        let _attestationsToVerify = parseAttestationArgs verifyArgs
        let _predicatesToDiscard = parseAttestationArgs discardArgs
        -- TODO Implement the additional prune parameters
        -- (attestationsToVerify, predicatesToDiscard and initialTimestamp)
        let prunedTimestamp = pruneTimestamp initialTimestamp
        let prunedDtfs = dtfs {timestamp = prunedTimestamp}
        pure $
          prunedDtfs
            & serialize
            & Right

-- | Upgrade a timestamp by fetching additional attestations from calendar servers.
upgrade ::
  [String] ->
  OTsByteStream ->
  IO (Either String OTsByteStream)
upgrade
  urls
  otsFileContent = do
    case deserialize otsFileContent of
      Left err -> pure $ Left $ "Failed to deserialize OTS file: " ++ err
      Right dtfs -> do
        let initialTimestamp = timestamp dtfs
        let calendarUrls = map T.pack urls
        eUpgradedTimestamp <-
          upgradeTimestamp calendarUrls initialTimestamp
        case eUpgradedTimestamp of
          Left err -> pure $ Left err
          Right upgradedTimestamp -> do
            let upgradedDtfs = dtfs {timestamp = upgradedTimestamp}
            upgradedDtfs
              & serialize
              & Right
              & pure

-- | Verify a timestamp against Bitcoin blockchain.
verify ::
  BitcoinConfig ->
  [String] ->
  OTsByteStream ->
  OTsBytes ->
  IO (Either VerificationError (Int, UTCTime))
verify
  bitcoinConfig
  urls
  otsFileContent
  targetDigest = do
    case deserialize otsFileContent of
      Left err ->
        pure $
          "Failed to deserialize OTS file: " ++ err
            & OtherVerificationError
            & Left
      Right dtfs -> do
        let calendarUrls = map T.pack urls
        verifyDetachedTimestampFile bitcoinConfig calendarUrls dtfs targetDigest