-----------------------------------------------------------------------------
--
-- Module      :  $Headers
-- Copyright   :  (c) 2021 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <code@functionally.io>
-- Stability   :  Experimental
-- Portability :  Portable
--
-- | Types for the pig-image service.
--
-----------------------------------------------------------------------------


{-# LANGUAGE RecordWildCards #-}


module Pigy.Types (
-- * Configuration
  Configuration(..)
, readConfiguration
-- * Context
, Context(..)
, makeContext
-- * Operations
, Mode(..)
-- * Keys
, KeyInfo(..)
, KeyedAddress(..)
, readKeyedAddress
) where


import Cardano.Api            (AddressInEra(..), AssetId(..), AsType (AsAssetName, AsPolicyId), CardanoMode, ConsensusModeParams(CardanoModeParams), EpochSlots(..), Hash, MaryEra, NetworkId(..), NetworkMagic(..), PaymentKey, PaymentExtendedKey, SigningKey, anyAddressInShelleyBasedEra, deserialiseFromRawBytes, deserialiseFromRawBytesHex)
import Cardano.Api.Shelley    (ProtocolParameters)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Word              (Word32, Word64)
import Mantis.Query           (queryProtocol)
import Mantis.Types           (MantisM, foistMantisMaybe)
import Mantis.Wallet          (SomePaymentVerificationKey, makeVerificationKeyHash, readAddress, readSigningKey, readVerificationKey)
import System.Random          (StdGen, getStdGen)
import System.Random.Stateful (IOGenM, newIOGenM)

import qualified Data.ByteString.Char8 as BS (pack)


-- | The service configuration.
data Configuration =
  Configuration
  {
    Configuration -> FilePath
socketPath  :: FilePath     -- ^ The path for the Cardano node's socket.
  , Configuration -> Maybe Word32
magic       :: Maybe Word32 -- ^ The magic number for the Cardano network, unless using mainnet.
  , Configuration -> Word64
epochSlots  :: Word64       -- ^ The number of slots per epoch.
  , Configuration -> FilePath
policyId    :: String       -- ^ The policy ID of the payment token.
  , Configuration -> FilePath
assetName   :: String       -- ^ The asset name of the payment token.
  , Configuration -> KeyInfo
keyInfo     :: KeyInfo      -- ^ The service's key.
  , Configuration -> FilePath
ipfsScript  :: FilePath     -- ^ The path to the IPFS pinning script.
  , Configuration -> FilePath
imageFolder :: FilePath     -- ^ The path to the folder of images.
  , Configuration -> Mode
mode        :: Mode         -- ^ The operational mode.
  , Configuration -> Bool
quiet       :: Bool         -- ^ The verbosity.
  }
    deriving (ReadPrec [Configuration]
ReadPrec Configuration
Int -> ReadS Configuration
ReadS [Configuration]
(Int -> ReadS Configuration)
-> ReadS [Configuration]
-> ReadPrec Configuration
-> ReadPrec [Configuration]
-> Read Configuration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Configuration]
$creadListPrec :: ReadPrec [Configuration]
readPrec :: ReadPrec Configuration
$creadPrec :: ReadPrec Configuration
readList :: ReadS [Configuration]
$creadList :: ReadS [Configuration]
readsPrec :: Int -> ReadS Configuration
$creadsPrec :: Int -> ReadS Configuration
Read, Int -> Configuration -> ShowS
[Configuration] -> ShowS
Configuration -> FilePath
(Int -> Configuration -> ShowS)
-> (Configuration -> FilePath)
-> ([Configuration] -> ShowS)
-> Show Configuration
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Configuration] -> ShowS
$cshowList :: [Configuration] -> ShowS
show :: Configuration -> FilePath
$cshow :: Configuration -> FilePath
showsPrec :: Int -> Configuration -> ShowS
$cshowsPrec :: Int -> Configuration -> ShowS
Show)


-- | The operational mode.
data Mode =
    Strict     -- ^ Only accept requests as single transactions.
  | Lenient    -- ^ Accept split transactions, processing when idle.
  | Aggressive -- ^ Accept split transactions, processing as soon as possible.
    deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Eq Mode
Eq Mode
-> (Mode -> Mode -> Ordering)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Mode)
-> (Mode -> Mode -> Mode)
-> Ord Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
$cp1Ord :: Eq Mode
Ord, ReadPrec [Mode]
ReadPrec Mode
Int -> ReadS Mode
ReadS [Mode]
(Int -> ReadS Mode)
-> ReadS [Mode] -> ReadPrec Mode -> ReadPrec [Mode] -> Read Mode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mode]
$creadListPrec :: ReadPrec [Mode]
readPrec :: ReadPrec Mode
$creadPrec :: ReadPrec Mode
readList :: ReadS [Mode]
$creadList :: ReadS [Mode]
readsPrec :: Int -> ReadS Mode
$creadsPrec :: Int -> ReadS Mode
Read, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> FilePath
(Int -> Mode -> ShowS)
-> (Mode -> FilePath) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> FilePath
$cshow :: Mode -> FilePath
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show)


-- | Key information.
data KeyInfo =
  KeyInfo
  {
    KeyInfo -> FilePath
addressString       :: String   -- ^ The address.
  , KeyInfo -> FilePath
verificationKeyFile :: FilePath -- ^ The path to the verification key file.
  , KeyInfo -> FilePath
signingKeyFile      :: FilePath -- ^ The path to the signing key file.
  }
    deriving (ReadPrec [KeyInfo]
ReadPrec KeyInfo
Int -> ReadS KeyInfo
ReadS [KeyInfo]
(Int -> ReadS KeyInfo)
-> ReadS [KeyInfo]
-> ReadPrec KeyInfo
-> ReadPrec [KeyInfo]
-> Read KeyInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KeyInfo]
$creadListPrec :: ReadPrec [KeyInfo]
readPrec :: ReadPrec KeyInfo
$creadPrec :: ReadPrec KeyInfo
readList :: ReadS [KeyInfo]
$creadList :: ReadS [KeyInfo]
readsPrec :: Int -> ReadS KeyInfo
$creadsPrec :: Int -> ReadS KeyInfo
Read, Int -> KeyInfo -> ShowS
[KeyInfo] -> ShowS
KeyInfo -> FilePath
(Int -> KeyInfo -> ShowS)
-> (KeyInfo -> FilePath) -> ([KeyInfo] -> ShowS) -> Show KeyInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [KeyInfo] -> ShowS
$cshowList :: [KeyInfo] -> ShowS
show :: KeyInfo -> FilePath
$cshow :: KeyInfo -> FilePath
showsPrec :: Int -> KeyInfo -> ShowS
$cshowsPrec :: Int -> KeyInfo -> ShowS
Show)


-- | The contetual parameters for the service.
data Context =
  Context
  {
    Context -> FilePath
socket       :: FilePath                        -- ^ The path for the Cardano node's socket.  
  , Context -> ConsensusModeParams CardanoMode
protocol     :: ConsensusModeParams CardanoMode -- ^ The Cardano consensus mode.
  , Context -> NetworkId
network      :: NetworkId                       -- ^ The Cardano network.
  , Context -> ProtocolParameters
pparams      :: ProtocolParameters              -- ^ The Cardano protocol.
  , Context -> AssetId
token        :: AssetId                         -- ^ The asset ID for the payment token.
  , Context -> KeyedAddress
keyedAddress :: KeyedAddress                    -- ^ The service address.
  , Context -> IOGenM StdGen
gRandom      :: IOGenM StdGen                   -- ^ The random-number generator.
  , Context -> FilePath
ipfsPin      :: FilePath                        -- ^ The path to the IPFS script for pinning images.
  , Context -> FilePath
images       :: FilePath                        -- ^ The path to the folder for images.
  , Context -> Mode
operation    :: Mode                            -- ^ The operational mode.
  , Context -> Bool
verbose      :: Bool                            -- ^ The verbosity.
  }


-- | A key and it hashes.
data KeyedAddress =
  KeyedAddress
  {
    KeyedAddress -> AddressInEra MaryEra
keyAddress       :: AddressInEra MaryEra          -- ^ The address.
  , KeyedAddress -> Hash PaymentKey
verificationHash :: Hash PaymentKey               -- ^ The hash of the verification key.
  , KeyedAddress -> SomePaymentVerificationKey
verification     :: SomePaymentVerificationKey    -- ^ The verification key.
  , KeyedAddress -> SigningKey PaymentExtendedKey
signing          :: SigningKey PaymentExtendedKey -- ^ The signing key.
  }
    deriving (Int -> KeyedAddress -> ShowS
[KeyedAddress] -> ShowS
KeyedAddress -> FilePath
(Int -> KeyedAddress -> ShowS)
-> (KeyedAddress -> FilePath)
-> ([KeyedAddress] -> ShowS)
-> Show KeyedAddress
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [KeyedAddress] -> ShowS
$cshowList :: [KeyedAddress] -> ShowS
show :: KeyedAddress -> FilePath
$cshow :: KeyedAddress -> FilePath
showsPrec :: Int -> KeyedAddress -> ShowS
$cshowsPrec :: Int -> KeyedAddress -> ShowS
Show)


-- | Read a configuration file.
readConfiguration :: MonadIO m
                  => FilePath                -- ^ The path to the configuration file.
                  -> MantisM m Configuration -- ^ The action returning the configuration.
readConfiguration :: FilePath -> MantisM m Configuration
readConfiguration = IO Configuration -> MantisM m Configuration
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Configuration -> MantisM m Configuration)
-> (FilePath -> IO Configuration)
-> FilePath
-> MantisM m Configuration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Configuration) -> IO FilePath -> IO Configuration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Configuration
forall a. Read a => FilePath -> a
read (IO FilePath -> IO Configuration)
-> (FilePath -> IO FilePath) -> FilePath -> IO Configuration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
readFile


-- | Convert a configuration into a service context.
makeContext :: MonadFail m
            => MonadIO m
            => Configuration     -- ^ The configuration.
            -> MantisM m Context -- ^ The action returning the context.
makeContext :: Configuration -> MantisM m Context
makeContext Configuration{Bool
FilePath
Maybe Word32
Word64
KeyInfo
Mode
quiet :: Bool
mode :: Mode
imageFolder :: FilePath
ipfsScript :: FilePath
keyInfo :: KeyInfo
assetName :: FilePath
policyId :: FilePath
epochSlots :: Word64
magic :: Maybe Word32
socketPath :: FilePath
quiet :: Configuration -> Bool
mode :: Configuration -> Mode
imageFolder :: Configuration -> FilePath
ipfsScript :: Configuration -> FilePath
keyInfo :: Configuration -> KeyInfo
assetName :: Configuration -> FilePath
policyId :: Configuration -> FilePath
epochSlots :: Configuration -> Word64
magic :: Configuration -> Maybe Word32
socketPath :: Configuration -> FilePath
..} =
  do
    PolicyId
policyId' <-
      FilePath -> Maybe PolicyId -> MantisM m PolicyId
forall (m :: * -> *) a.
Monad m =>
FilePath -> Maybe a -> MantisM m a
foistMantisMaybe FilePath
"Could not decode policy ID."
        (Maybe PolicyId -> MantisM m PolicyId)
-> (ByteString -> Maybe PolicyId)
-> ByteString
-> MantisM m PolicyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType PolicyId -> ByteString -> Maybe PolicyId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex AsType PolicyId
AsPolicyId
        (ByteString -> MantisM m PolicyId)
-> ByteString -> MantisM m PolicyId
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
BS.pack FilePath
policyId
    AssetName
assetName' <-
      FilePath -> Maybe AssetName -> MantisM m AssetName
forall (m :: * -> *) a.
Monad m =>
FilePath -> Maybe a -> MantisM m a
foistMantisMaybe FilePath
"Could not decode asset name."
        (Maybe AssetName -> MantisM m AssetName)
-> (ByteString -> Maybe AssetName)
-> ByteString
-> MantisM m AssetName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType AssetName -> ByteString -> Maybe AssetName
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes AsType AssetName
AsAssetName
        (ByteString -> MantisM m AssetName)
-> ByteString -> MantisM m AssetName
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
BS.pack FilePath
assetName
    KeyedAddress
keyedAddress <- KeyInfo -> MantisM m KeyedAddress
forall (m :: * -> *).
MonadIO m =>
KeyInfo -> MantisM m KeyedAddress
readKeyedAddress KeyInfo
keyInfo
    IOGenM StdGen
gRandom <- StdGen -> MantisM m (IOGenM StdGen)
forall (m :: * -> *) g. MonadIO m => g -> m (IOGenM g)
newIOGenM (StdGen -> MantisM m (IOGenM StdGen))
-> MantisM m StdGen -> MantisM m (IOGenM StdGen)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MantisM m StdGen
forall (m :: * -> *). MonadIO m => m StdGen
getStdGen
    let
      socket :: FilePath
socket = FilePath
socketPath
      protocol :: ConsensusModeParams CardanoMode
protocol = EpochSlots -> ConsensusModeParams CardanoMode
CardanoModeParams (EpochSlots -> ConsensusModeParams CardanoMode)
-> EpochSlots -> ConsensusModeParams CardanoMode
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochSlots
EpochSlots Word64
epochSlots
      network :: NetworkId
network = NetworkId -> (Word32 -> NetworkId) -> Maybe Word32 -> NetworkId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NetworkId
Mainnet (NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId)
-> (Word32 -> NetworkMagic) -> Word32 -> NetworkId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NetworkMagic
NetworkMagic) Maybe Word32
magic
      token :: AssetId
token = PolicyId -> AssetName -> AssetId
AssetId PolicyId
policyId' AssetName
assetName'
      ipfsPin :: FilePath
ipfsPin = FilePath
ipfsScript
      images :: FilePath
images = FilePath
imageFolder
      operation :: Mode
operation = Mode
mode
      verbose :: Bool
verbose = Bool -> Bool
not Bool
quiet
    ProtocolParameters
pparams <- FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> MantisM m ProtocolParameters
forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> MantisM m ProtocolParameters
queryProtocol FilePath
socketPath ConsensusModeParams CardanoMode
protocol NetworkId
network
    Context -> MantisM m Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context :: FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> ProtocolParameters
-> AssetId
-> KeyedAddress
-> IOGenM StdGen
-> FilePath
-> FilePath
-> Mode
-> Bool
-> Context
Context{Bool
FilePath
IOGenM StdGen
ConsensusModeParams CardanoMode
NetworkId
AssetId
ProtocolParameters
KeyedAddress
Mode
pparams :: ProtocolParameters
verbose :: Bool
operation :: Mode
images :: FilePath
ipfsPin :: FilePath
token :: AssetId
network :: NetworkId
protocol :: ConsensusModeParams CardanoMode
socket :: FilePath
gRandom :: IOGenM StdGen
keyedAddress :: KeyedAddress
verbose :: Bool
operation :: Mode
images :: FilePath
ipfsPin :: FilePath
gRandom :: IOGenM StdGen
keyedAddress :: KeyedAddress
token :: AssetId
pparams :: ProtocolParameters
network :: NetworkId
protocol :: ConsensusModeParams CardanoMode
socket :: FilePath
..}


-- | Read a key.
readKeyedAddress :: MonadIO m
                 => KeyInfo                -- ^ The key information.
                 -> MantisM m KeyedAddress -- ^ The key and its hashes.
readKeyedAddress :: KeyInfo -> MantisM m KeyedAddress
readKeyedAddress KeyInfo{FilePath
signingKeyFile :: FilePath
verificationKeyFile :: FilePath
addressString :: FilePath
signingKeyFile :: KeyInfo -> FilePath
verificationKeyFile :: KeyInfo -> FilePath
addressString :: KeyInfo -> FilePath
..} =
  do
    AddressInEra MaryEra
keyAddress <- AddressAny -> AddressInEra MaryEra
forall era. IsShelleyBasedEra era => AddressAny -> AddressInEra era
anyAddressInShelleyBasedEra (AddressAny -> AddressInEra MaryEra)
-> MantisM m AddressAny -> MantisM m (AddressInEra MaryEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> MantisM m AddressAny
forall (m :: * -> *). Monad m => FilePath -> MantisM m AddressAny
readAddress FilePath
addressString
    SomePaymentVerificationKey
verification <- FilePath -> MantisM m SomePaymentVerificationKey
forall (m :: * -> *).
MonadIO m =>
FilePath -> MantisM m SomePaymentVerificationKey
readVerificationKey FilePath
verificationKeyFile
    SigningKey PaymentExtendedKey
signing <- FilePath -> MantisM m (SigningKey PaymentExtendedKey)
forall (m :: * -> *).
MonadIO m =>
FilePath -> MantisM m (SigningKey PaymentExtendedKey)
readSigningKey FilePath
signingKeyFile
    let
      verificationHash :: Hash PaymentKey
verificationHash = SomePaymentVerificationKey -> Hash PaymentKey
makeVerificationKeyHash SomePaymentVerificationKey
verification
    KeyedAddress -> MantisM m KeyedAddress
forall (m :: * -> *) a. Monad m => a -> m a
return KeyedAddress :: AddressInEra MaryEra
-> Hash PaymentKey
-> SomePaymentVerificationKey
-> SigningKey PaymentExtendedKey
-> KeyedAddress
KeyedAddress{SomePaymentVerificationKey
AddressInEra MaryEra
Hash PaymentKey
SigningKey PaymentExtendedKey
verificationHash :: Hash PaymentKey
signing :: SigningKey PaymentExtendedKey
verification :: SomePaymentVerificationKey
keyAddress :: AddressInEra MaryEra
signing :: SigningKey PaymentExtendedKey
verification :: SomePaymentVerificationKey
verificationHash :: Hash PaymentKey
keyAddress :: AddressInEra MaryEra
..}