module Paddle.WebHook.Signature where 

import Prelude ()
import qualified Prelude
import Protolude hiding (toS)
import Protolude.Conv
import qualified Data.Map.Strict as M
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import qualified OpenSSL as SSL
import qualified OpenSSL.EVP.Digest as SSL
import qualified OpenSSL.EVP.Verify as SSL
import qualified Data.ByteString.Base64 as Base64

import Paddle.Env (Env(..))

type SignatureBody = M.Map Text [Text]

-- Given all fields in webhook request, validate against their signature
validateSignature :: (MonadIO m) => Env -> SignatureBody -> m (Either Text ())
validateSignature :: Env -> SignatureBody -> m (Either Text ())
validateSignature Env
env SignatureBody
rawFields =
  let 
    fields :: Map ByteString ByteString
fields =  [(ByteString, ByteString)] -> Map ByteString ByteString
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ByteString, ByteString)] -> Map ByteString ByteString)
-> [(ByteString, ByteString)] -> Map ByteString ByteString
forall a b. (a -> b) -> a -> b
$ ((Text, [Text]) -> (ByteString, ByteString))
-> [(Text, [Text])] -> [(ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Text
k ,[Text]
v) -> (Text -> ByteString
forall a b. StringConv a b => a -> b
toS Text
k, Text -> ByteString
forall a b. StringConv a b => a -> b
toS (Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
forall a. a -> a
identity ([Text] -> Maybe Text
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [Text]
v)))) (SignatureBody -> [(Text, [Text])]
forall k a. Map k a -> [(k, a)]
M.toList SignatureBody
rawFields)

    signature :: Either Prelude.String ByteString
    signature :: Either String ByteString
signature = String -> Maybe ByteString -> Either String ByteString
forall e a. e -> Maybe a -> Either e a
maybeToEither String
"Missing signature field." (ByteString -> Map ByteString ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ByteString
"p_signature" Map ByteString ByteString
fields)

    signatureDecode :: ByteString -> Either Prelude.String ByteString
    signatureDecode :: ByteString -> Either String ByteString
signatureDecode = ByteString -> Either String ByteString
Base64.decode (ByteString -> Either String ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a b. StringConv a b => a -> b
toS

    -- we need to verify the signature against the PHP-serialized request parameters (excluding p_signature)
    -- here's a gist that does it in Swift: https://gist.github.com/drewmccormack/a51b18ffeda8f596a11a8623481344d8
    serializeString :: ByteString -> Builder
serializeString ByteString
str = Builder
"s:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BSB.intDec (ByteString -> Int
BS.length ByteString
str) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
str Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\";"
    serialize :: b -> Either a (ByteString, b)
serialize b
sig = (\ByteString
x -> (ByteString, b) -> Either a (ByteString, b)
forall a b. b -> Either a b
Right (ByteString
x, b
sig)) (ByteString -> Either a (ByteString, b))
-> (ByteString -> ByteString)
-> ByteString
-> Either a (ByteString, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ByteString
LBS.toStrict (ByteString -> Either a (ByteString, b))
-> ByteString -> Either a (ByteString, b)
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
            Builder
"a:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BSB.intDec (Map ByteString ByteString -> Int
forall k a. Map k a -> Int
M.size Map ByteString ByteString
fields Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":{" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
              ((ByteString, ByteString) -> Builder)
-> [(ByteString, ByteString)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\( ByteString
key, ByteString
value ) -> ByteString -> Builder
serializeString ByteString
key Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
serializeString ByteString
value) (Map ByteString ByteString -> [(ByteString, ByteString)]
forall k a. Map k a -> [(k, a)]
M.toAscList (Map ByteString ByteString -> [(ByteString, ByteString)])
-> Map ByteString ByteString -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ ByteString
-> Map ByteString ByteString -> Map ByteString ByteString
forall k a. Ord k => k -> Map k a -> Map k a
M.delete ByteString
"p_signature" Map ByteString ByteString
fields)
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
  in do
    case Either String ByteString
signature Either String ByteString
-> (ByteString -> Either String ByteString)
-> Either String ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Either String ByteString
signatureDecode Either String ByteString
-> (ByteString -> Either String (ByteString, ByteString))
-> Either String (ByteString, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Either String (ByteString, ByteString)
forall b a. b -> Either a (ByteString, b)
serialize of
      Left String
err -> Either Text () -> m (Either Text ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text () -> m (Either Text ()))
-> Either Text () -> m (Either Text ())
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a b. a -> Either a b
Left (String -> Text
forall a b. StringConv a b => a -> b
toS String
err)
      Right (ByteString
serializedFields, ByteString
sigBytes) -> IO (Either Text ()) -> m (Either Text ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Text ()) -> m (Either Text ()))
-> IO (Either Text ()) -> m (Either Text ())
forall a b. (a -> b) -> a -> b
$ IO (Either Text ()) -> IO (Either Text ())
forall a. IO a -> IO a
SSL.withOpenSSL (IO (Either Text ()) -> IO (Either Text ()))
-> IO (Either Text ()) -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ do
        Just Digest
sha1 <- String -> IO (Maybe Digest)
SSL.getDigestByName String
"SHA1"
        VerifyStatus
verifyRes <- Digest
-> ByteString -> SomePublicKey -> ByteString -> IO VerifyStatus
forall key.
PublicKey key =>
Digest -> ByteString -> key -> ByteString -> IO VerifyStatus
SSL.verifyBS Digest
sha1 ByteString
sigBytes (Env -> SomePublicKey
pctxPubKey Env
env) ByteString
serializedFields

        if (VerifyStatus
verifyRes VerifyStatus -> VerifyStatus -> Bool
forall a. Eq a => a -> a -> Bool
== VerifyStatus
SSL.VerifySuccess)
        then Either Text () -> IO (Either Text ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text () -> IO (Either Text ()))
-> Either Text () -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ () -> Either Text ()
forall a b. b -> Either a b
Right ()
        else Either Text () -> IO (Either Text ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text () -> IO (Either Text ()))
-> Either Text () -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"Request has invalid signature"