{-# 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 v i t p s = verifyWebhookByteString (Text.encodeUtf8 v) (Text.encodeUtf8 i) (Text.encodeUtf8 t) (Text.encodeUtf8 p) (Text.encodeUtf8 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 v i t p s = do verifier <- Either.throw $ parseVerifier v id_ <- Either.throw $ parseId i timestamp <- Either.throw $ parseTimestamp t let payload = Payload.MkPayload p let message = Message.MkMessage { Message.id_ = id_, Message.timestamp = timestamp, Message.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 verifier message signatures = do now <- MonadIO.liftIO 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 now verifier message signatures = do Bifunctor.first SignetException.ToleranceException . Tolerance.check tolerance now $ Message.timestamp message Bifunctor.first SignetException.VerificationException $ Verifier.verify verifier message signatures -- | Alias for 'Tolerance.typical'. typicalTolerance :: Tolerance.Tolerance typicalTolerance = Tolerance.typical -- | Alias for 'Verifier.parse'. parseVerifier :: ByteString.ByteString -> Either InvalidVerifier.InvalidVerifier Verifier.Verifier parseVerifier = Verifier.parse -- | Alias for 'Id.parse'. parseId :: ByteString.ByteString -> Either InvalidId.InvalidId Id.Id parseId = Id.parse -- | Alias for 'Timestamp.parse'. parseTimestamp :: ByteString.ByteString -> Either InvalidTimestamp.InvalidTimestamp Timestamp.Timestamp parseTimestamp = Timestamp.parse -- | Alias for 'Message.parse'. parseMessage :: ByteString.ByteString -> Either InvalidMessage.InvalidMessage Message.Message parseMessage = Message.parse -- | Alias for 'Signatures.parse'. parseSignatures :: ByteString.ByteString -> Either InvalidSignature.InvalidSignature ([UnknownSignature.UnknownSignature], Signatures.Signatures) parseSignatures = Signatures.parse -- | Alias for 'Verifier.Asymmetric'. pattern AsymmetricVerifier :: PublicKey.PublicKey -> Verifier.Verifier pattern AsymmetricVerifier publicKey = Verifier.Asymmetric publicKey -- | Alias for 'Verifier.Symmetric'. pattern SymmetricVerifier :: Secret.Secret -> Verifier.Verifier pattern SymmetricVerifier secret = Verifier.Symmetric secret {-# COMPLETE AsymmetricVerifier, SymmetricVerifier #-} -- | Alias for 'Signer.sign'. signWebhook :: Signer.Signer -> Message.Message -> Signature.Signature signWebhook = Signer.sign -- | Alias for 'Signer.parse'. parseSigner :: ByteString.ByteString -> Either InvalidSigner.InvalidSigner Signer.Signer parseSigner = Signer.parse -- | Alias for 'Signer.Asymmetric'. pattern AsymmetricSigner :: SecretKey.SecretKey -> Signer.Signer pattern AsymmetricSigner secretKey = Signer.Asymmetric secretKey -- | Alias for 'Signer.Symmetric'. pattern SymmetricSigner :: Secret.Secret -> Signer.Signer pattern SymmetricSigner secret = Signer.Symmetric secret {-# COMPLETE AsymmetricSigner, SymmetricSigner #-} -- | Alias for 'Signature.Asymmetric'. pattern AsymmetricSignature :: AsymmetricSignature.AsymmetricSignature -> Signature.Signature pattern AsymmetricSignature asymmetricSignature = Signature.Asymmetric asymmetricSignature -- | Alias for 'Signature.Symmetric'. pattern SymmetricSignature :: SymmetricSignature.SymmetricSignature -> Signature.Signature pattern SymmetricSignature symmetricSignature = Signature.Symmetric symmetricSignature {-# COMPLETE AsymmetricSignature, SymmetricSignature #-}