{-# LANGUAGE PatternSynonyms #-}

module Signet.Unstable where

import qualified Control.Monad.Catch as Exception
import qualified Control.Monad.IO.Class as MonadIO
import qualified Data.Bifunctor as Bifunctor
import qualified Data.ByteString as ByteString
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Time as Time
import qualified Signet.Unstable.Exception.InvalidId as InvalidId
import qualified Signet.Unstable.Exception.InvalidMessage as InvalidMessage
import qualified Signet.Unstable.Exception.InvalidSignature as InvalidSignature
import qualified Signet.Unstable.Exception.InvalidSigner as InvalidSigner
import qualified Signet.Unstable.Exception.InvalidTimestamp as InvalidTimestamp
import qualified Signet.Unstable.Exception.InvalidVerifier as InvalidVerifier
import qualified Signet.Unstable.Exception.SignetException as SignetException
import qualified Signet.Unstable.Exception.UnknownSignature as UnknownSignature
import qualified Signet.Unstable.Extra.Either as Either
import qualified Signet.Unstable.Type.AsymmetricSignature as AsymmetricSignature
import qualified Signet.Unstable.Type.Id as Id
import qualified Signet.Unstable.Type.Message as Message
import qualified Signet.Unstable.Type.Payload as Payload
import qualified Signet.Unstable.Type.PublicKey as PublicKey
import qualified Signet.Unstable.Type.Secret as Secret
import qualified Signet.Unstable.Type.SecretKey as SecretKey
import qualified Signet.Unstable.Type.Signature as Signature
import qualified Signet.Unstable.Type.Signatures as Signatures
import qualified Signet.Unstable.Type.Signer as Signer
import qualified Signet.Unstable.Type.SymmetricSignature as SymmetricSignature
import qualified Signet.Unstable.Type.Timestamp as Timestamp
import qualified Signet.Unstable.Type.Tolerance as Tolerance
import qualified Signet.Unstable.Type.Verifier as Verifier

-- | Verifies a webhook with 'Text.Text' values. This is a wrapper around
-- 'verifyWebhookByteString' that assumes all values are encoded as UTF-8.
verifyWebhookText ::
  (MonadIO.MonadIO m, Exception.MonadThrow m) =>
  -- | A 'Verifier.Verifier' for the webhook. Typically this will be
  -- @"whsec_..."@ or @"whpk_..."@.
  Text.Text ->
  -- | The webhook's unique 'Id.Id'. Typically this will come from the
  -- 'Signet.Unstable.Extra.Http.hWebhookId' header and look like @"msg_..."@.
  Text.Text ->
  -- | The webhook's 'Timestamp.Timestamp'. This is an integer number of
  -- seconds since the Unix epoch. Typically this will come from the
  -- 'Signet.Unstable.Extra.Http.hWebhookTimestamp' header. For example
  -- @"981173106"@ for @2001-02-03T04:05:06Z@.
  Text.Text ->
  -- | The webhook's raw 'Payload.Payload'. Typically this will be a JSON
  -- object like @{"event_type":"ping",...}@.
  Text.Text ->
  -- | The webhook's 'Signatures.Signatures'. Typically this will come from the
  -- 'Signet.Unstable.Extra.Http.hWebhookSignature' header and look like
  -- @"v1_..."@ or @"v1a_..."@.
  Text.Text ->
  m Signature.Signature
verifyWebhookText :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Text -> Text -> Text -> Text -> Text -> m Signature
verifyWebhookText Text
v Text
i Text
t Text
p Text
s =
  ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> m Signature
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> m Signature
verifyWebhookByteString
    (Text -> ByteString
Text.encodeUtf8 Text
v)
    (Text -> ByteString
Text.encodeUtf8 Text
i)
    (Text -> ByteString
Text.encodeUtf8 Text
t)
    (Text -> ByteString
Text.encodeUtf8 Text
p)
    (Text -> ByteString
Text.encodeUtf8 Text
s)

-- | Verifies a webhook with 'ByteString.ByteString' values. This is a
-- wrapper around 'verifyWebhook'. See 'verifyWebhookText' for a description of
-- the arguments.
verifyWebhookByteString ::
  (MonadIO.MonadIO m, Exception.MonadThrow m) =>
  -- | 'Verifier.Verifier'
  ByteString.ByteString ->
  -- | 'Id.Id'
  ByteString.ByteString ->
  -- | 'Timestamp.Timestamp'
  ByteString.ByteString ->
  -- | 'Payload.Payload'
  ByteString.ByteString ->
  -- | 'Signatures.Signatures'
  ByteString.ByteString ->
  m Signature.Signature
verifyWebhookByteString :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> m Signature
verifyWebhookByteString ByteString
v ByteString
i ByteString
t ByteString
p ByteString
s = do
  verifier <- Either InvalidVerifier Verifier -> m Verifier
forall e (m :: * -> *) a.
(Exception e, MonadThrow m) =>
Either e a -> m a
Either.throw (Either InvalidVerifier Verifier -> m Verifier)
-> Either InvalidVerifier Verifier -> m Verifier
forall a b. (a -> b) -> a -> b
$ ByteString -> Either InvalidVerifier Verifier
parseVerifier ByteString
v
  id_ <- Either.throw $ parseId i
  timestamp <- Either.throw $ parseTimestamp t
  let payload = ByteString -> Payload
Payload.MkPayload ByteString
p
  let message =
        Message.MkMessage
          { id_ :: Id
Message.id_ = Id
id_,
            timestamp :: Timestamp
Message.timestamp = Timestamp
timestamp,
            payload :: Payload
Message.payload = Payload
payload
          }
  (_, signatures) <- Either.throw $ parseSignatures s
  verifyWebhook verifier message signatures

-- | Verifies a webhook. This is a wrapper around 'verifyWebhookWith' that uses
-- 'typicalTolerance' and the current time.
--
-- Throws an exception if the webhook is invalid.
verifyWebhook ::
  (MonadIO.MonadIO m, Exception.MonadThrow m) =>
  Verifier.Verifier ->
  Message.Message ->
  Signatures.Signatures ->
  m Signature.Signature
verifyWebhook :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Verifier -> Message -> Signatures -> m Signature
verifyWebhook Verifier
verifier Message
message Signatures
signatures = do
  now <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MonadIO.liftIO IO UTCTime
Time.getCurrentTime
  Either.throw $ verifyWebhookWith typicalTolerance now verifier message signatures

-- | Verifies a webhook. This is the lowest-level function that gives you the
-- most control. If you're looking for something that's easier to use and
-- assumes some reasonable defaults, consider 'verifyWebhook'.
verifyWebhookWith ::
  -- | Often 'typicalTolerance'.
  Tolerance.Tolerance ->
  -- | Usually 'Time.getCurrentTime'.
  Time.UTCTime ->
  -- | See 'parseVerifier'.
  Verifier.Verifier ->
  -- | See 'parseMessage'. Or 'Message.MkMessage' along with 'parseId',
  -- 'parseTimestamp', and 'Payload.MkPayload'.
  Message.Message ->
  -- | See 'parseSignatures'.
  Signatures.Signatures ->
  Either SignetException.SignetException Signature.Signature
verifyWebhookWith :: Tolerance
-> UTCTime
-> Verifier
-> Message
-> Signatures
-> Either SignetException Signature
verifyWebhookWith Tolerance
tolerance UTCTime
now Verifier
verifier Message
message Signatures
signatures = do
  (ToleranceException -> SignetException)
-> Either ToleranceException () -> Either SignetException ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first ToleranceException -> SignetException
SignetException.ToleranceException
    (Either ToleranceException () -> Either SignetException ())
-> (Timestamp -> Either ToleranceException ())
-> Timestamp
-> Either SignetException ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tolerance -> UTCTime -> Timestamp -> Either ToleranceException ()
Tolerance.check Tolerance
tolerance UTCTime
now
    (Timestamp -> Either SignetException ())
-> Timestamp -> Either SignetException ()
forall a b. (a -> b) -> a -> b
$ Message -> Timestamp
Message.timestamp Message
message
  (VerificationException -> SignetException)
-> Either VerificationException Signature
-> Either SignetException Signature
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first VerificationException -> SignetException
SignetException.VerificationException (Either VerificationException Signature
 -> Either SignetException Signature)
-> Either VerificationException Signature
-> Either SignetException Signature
forall a b. (a -> b) -> a -> b
$
    Verifier
-> Message -> Signatures -> Either VerificationException Signature
Verifier.verify Verifier
verifier Message
message Signatures
signatures

-- | Alias for 'Tolerance.typical'.
typicalTolerance :: Tolerance.Tolerance
typicalTolerance :: Tolerance
typicalTolerance = Tolerance
Tolerance.typical

-- | Alias for 'Verifier.parse'.
parseVerifier :: ByteString.ByteString -> Either InvalidVerifier.InvalidVerifier Verifier.Verifier
parseVerifier :: ByteString -> Either InvalidVerifier Verifier
parseVerifier = ByteString -> Either InvalidVerifier Verifier
Verifier.parse

-- | Alias for 'Id.parse'.
parseId :: ByteString.ByteString -> Either InvalidId.InvalidId Id.Id
parseId :: ByteString -> Either InvalidId Id
parseId = ByteString -> Either InvalidId Id
Id.parse

-- | Alias for 'Timestamp.parse'.
parseTimestamp :: ByteString.ByteString -> Either InvalidTimestamp.InvalidTimestamp Timestamp.Timestamp
parseTimestamp :: ByteString -> Either InvalidTimestamp Timestamp
parseTimestamp = ByteString -> Either InvalidTimestamp Timestamp
Timestamp.parse

-- | Alias for 'Message.parse'.
parseMessage :: ByteString.ByteString -> Either InvalidMessage.InvalidMessage Message.Message
parseMessage :: ByteString -> Either InvalidMessage Message
parseMessage = ByteString -> Either InvalidMessage Message
Message.parse

-- | Alias for 'Signatures.parse'.
parseSignatures ::
  ByteString.ByteString ->
  Either InvalidSignature.InvalidSignature ([UnknownSignature.UnknownSignature], Signatures.Signatures)
parseSignatures :: ByteString
-> Either InvalidSignature ([UnknownSignature], Signatures)
parseSignatures = ByteString
-> Either InvalidSignature ([UnknownSignature], Signatures)
Signatures.parse

-- | Alias for 'Verifier.Asymmetric'.
pattern AsymmetricVerifier :: PublicKey.PublicKey -> Verifier.Verifier
pattern $bAsymmetricVerifier :: PublicKey -> Verifier
$mAsymmetricVerifier :: forall {r}. Verifier -> (PublicKey -> r) -> ((# #) -> r) -> r
AsymmetricVerifier publicKey = Verifier.Asymmetric publicKey

-- | Alias for 'Verifier.Symmetric'.
pattern SymmetricVerifier :: Secret.Secret -> Verifier.Verifier
pattern $bSymmetricVerifier :: Secret -> Verifier
$mSymmetricVerifier :: forall {r}. Verifier -> (Secret -> r) -> ((# #) -> r) -> r
SymmetricVerifier secret = Verifier.Symmetric secret

{-# COMPLETE AsymmetricVerifier, SymmetricVerifier #-}

-- | Alias for 'Signer.sign'.
signWebhook :: Signer.Signer -> Message.Message -> Signature.Signature
signWebhook :: Signer -> Message -> Signature
signWebhook = Signer -> Message -> Signature
Signer.sign

-- | Alias for 'Signer.parse'.
parseSigner :: ByteString.ByteString -> Either InvalidSigner.InvalidSigner Signer.Signer
parseSigner :: ByteString -> Either InvalidSigner Signer
parseSigner = ByteString -> Either InvalidSigner Signer
Signer.parse

-- | Alias for 'Signer.Asymmetric'.
pattern AsymmetricSigner :: SecretKey.SecretKey -> Signer.Signer
pattern $bAsymmetricSigner :: SecretKey -> Signer
$mAsymmetricSigner :: forall {r}. Signer -> (SecretKey -> r) -> ((# #) -> r) -> r
AsymmetricSigner secretKey = Signer.Asymmetric secretKey

-- | Alias for 'Signer.Symmetric'.
pattern SymmetricSigner :: Secret.Secret -> Signer.Signer
pattern $bSymmetricSigner :: Secret -> Signer
$mSymmetricSigner :: forall {r}. Signer -> (Secret -> r) -> ((# #) -> r) -> r
SymmetricSigner secret = Signer.Symmetric secret

{-# COMPLETE AsymmetricSigner, SymmetricSigner #-}

-- | Alias for 'Signature.Asymmetric'.
pattern AsymmetricSignature :: AsymmetricSignature.AsymmetricSignature -> Signature.Signature
pattern $bAsymmetricSignature :: AsymmetricSignature -> Signature
$mAsymmetricSignature :: forall {r}.
Signature -> (AsymmetricSignature -> r) -> ((# #) -> r) -> r
AsymmetricSignature asymmetricSignature = Signature.Asymmetric asymmetricSignature

-- | Alias for 'Signature.Symmetric'.
pattern SymmetricSignature :: SymmetricSignature.SymmetricSignature -> Signature.Signature
pattern $bSymmetricSignature :: SymmetricSignature -> Signature
$mSymmetricSignature :: forall {r}.
Signature -> (SymmetricSignature -> r) -> ((# #) -> r) -> r
SymmetricSignature symmetricSignature = Signature.Symmetric symmetricSignature

{-# COMPLETE AsymmetricSignature, SymmetricSignature #-}