ntf: e2e encrypt notifications, clean up encryption (#1698)

src/Simplex/Messaging/Crypto.hs

@@ -215,24 +215,29 @@ import Control.Exception (Exception)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Trans.Except
-import Crypto.Cipher.AES (AES256, AES128)
+import Crypto.Cipher.AES (AES128, AES256)
 import qualified Crypto.Cipher.Types as AES
 import qualified Crypto.Cipher.XSalsa as XSalsa
 import qualified Crypto.Error as CE
-import Crypto.Hash (Digest, SHA3_256, SHA3_384, SHA256 (..), SHA512 (..), hash, hashDigestSize)
+import Crypto.Hash (Digest, SHA256 (..), SHA3_256, SHA3_384, SHA512 (..), hash, hashDigestSize)
 import qualified Crypto.KDF.HKDF as H
 import qualified Crypto.MAC.Poly1305 as Poly1305
 import qualified Crypto.PubKey.Curve25519 as X25519
 import qualified Crypto.PubKey.Curve448 as X448
+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
+import qualified Crypto.PubKey.ECC.Types as ECC
 import qualified Crypto.PubKey.Ed25519 as Ed25519
 import qualified Crypto.PubKey.Ed448 as Ed448
 import Crypto.Random (ChaChaDRG, MonadPseudoRandom, drgNew, randomBytesGenerate, withDRG)
+import qualified Crypto.Store.PKCS8 as PK
 import Data.ASN1.BinaryEncoding
 import Data.ASN1.Encoding
 import Data.ASN1.Types
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (bimap, first)
+import qualified Data.Binary as Bin
+import qualified Data.Bits as Bits
 import Data.ByteArray (ByteArrayAccess)
 import qualified Data.ByteArray as BA
 import Data.ByteString.Base64 (decode, encode)
@@ -240,13 +245,14 @@ import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Lazy (fromStrict, toStrict)
+import qualified Data.ByteString.Lazy as LB
 import Data.Constraint (Dict (..))
 import Data.Kind (Constraint, Type)
 import qualified Data.List.NonEmpty as L
 import Data.String
 import Data.Type.Equality
 import Data.Typeable (Proxy (Proxy), Typeable)
-import Data.Word (Word32)
+import Data.Word (Word32, Word64)
 import qualified Data.X509 as X
 import Data.X509.Validation (Fingerprint (..), getFingerprint)
 import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (+))
@@ -256,12 +262,6 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll, parseString)
 import Simplex.Messaging.Util ((<$?>))
-import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
-import qualified Crypto.Store.PKCS8 as PK
-import qualified Crypto.PubKey.ECC.Types as ECC
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Binary as Bin
-import qualified Data.Bits as Bits
 
 -- | Cryptographic algorithms.
 data Algorithm = Ed25519 | Ed448 | X25519 | X448
@@ -1262,11 +1262,11 @@ instance SignatureAlgorithmX509 pk => SignatureAlgorithmX509 (a, pk) where
 -- | A wrapper to marshall signed ASN1 objects, like certificates.
 newtype SignedObject a = SignedObject {getSignedExact :: X.SignedExact a}
 
-instance (Typeable a, Eq a, Show a, ASN1Object a) => FromField (SignedObject a) where
+instance (Typeable a, Eq a, Show a, ASN1Object a) => FromField (SignedObject a)
 #if defined(dbPostgres)
-  fromField f dat = SignedObject <$> blobFieldDecoder X.decodeSignedObject f dat
+  where fromField f dat = SignedObject <$> blobFieldDecoder X.decodeSignedObject f dat
 #else
-  fromField = fmap SignedObject . blobFieldDecoder X.decodeSignedObject
+  where fromField = fmap SignedObject . blobFieldDecoder X.decodeSignedObject
 #endif
 
 instance (Eq a, Show a, ASN1Object a) => ToField (SignedObject a) where
@@ -1562,46 +1562,44 @@ readECPrivateKey f = do
 -- | Elliptic-Curve-Point-to-Octet-String Conversion without compression
 -- | as required by RFC8291
 -- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3
-uncompressEncodePoint :: ECC.Point -> BL.ByteString
+uncompressEncodePoint :: ECC.Point -> ByteString
 uncompressEncodePoint (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y
 uncompressEncodePoint ECC.PointO = "\0"
 
-uncompressDecodePoint :: BL.ByteString -> Either CE.CryptoError ECC.Point
+uncompressDecodePoint :: ByteString -> Either String ECC.Point
 uncompressDecodePoint "\0" = pure ECC.PointO
 uncompressDecodePoint s
-  | BL.take 1 s /= prefix = Left CE.CryptoError_PointFormatUnsupported
-  | BL.length s /= 65 = Left CE.CryptoError_KeySizeInvalid
+  | B.take 1 s /= prefix = Left "PointFormatUnsupported"
+  | B.length s /= 65 = Left "KeySizeInvalid"
   | otherwise = do
-    let s' = BL.drop 1 s
-    x <- decodeBigInt $ BL.take 32 s'
-    y <- decodeBigInt $ BL.drop 32 s'
-    pure $ ECC.Point x y
+      let s' = B.drop 1 s
+      x <- decodeBigInt $ B.take 32 s'
+      y <- decodeBigInt $ B.drop 32 s'
+      pure $ ECC.Point x y
   where
-    prefix = "\x04" :: BL.ByteString
+    prefix = "\x04" :: ByteString
 
 -- Used to test encryption against the RFC8291 Example - which gives the AS private key
-uncompressDecodePrivateNumber :: BL.ByteString -> Either CE.CryptoError ECC.PrivateNumber
+uncompressDecodePrivateNumber :: ByteString -> Either String ECC.PrivateNumber
 uncompressDecodePrivateNumber s
-  | BL.length s /= 32 = Left CE.CryptoError_KeySizeInvalid
-  | otherwise = do
-    decodeBigInt s
+  | B.length s /= 32 = Left "KeySizeInvalid"
+  | otherwise = decodeBigInt s
 
-encodeBigInt :: Integer -> BL.ByteString
-encodeBigInt i = do
+encodeBigInt :: Integer -> ByteString
+encodeBigInt i =
   let s1 = Bits.shiftR i 64
       s2 = Bits.shiftR s1 64
       s3 = Bits.shiftR s2 64
-  Bin.encode (w64 s3, w64 s2, w64 s1, w64 i)
+   in LB.toStrict $ Bin.encode (w64 s3, w64 s2, w64 s1, w64 i)
   where
-    w64 :: Integer -> Bin.Word64
+    w64 :: Integer -> Word64
     w64 = fromIntegral
 
-decodeBigInt :: BL.ByteString -> Either CE.CryptoError Integer
+decodeBigInt :: ByteString -> Either String Integer
 decodeBigInt s
-  | BL.length s /= 32 = Left CE.CryptoError_PointSizeInvalid
-  | otherwise = do
-      let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 )
-      pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0
+  | B.length s /= 32 = Left "PointSizeInvalid"
+  | otherwise =
+      let (w3, w2, w1, w0) = Bin.decode (LB.fromStrict s) :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64)
+       in Right $ shift 3 w3 + shift 2 w2 + shift 1 w1 + fromIntegral w0
   where
     shift i w = Bits.shiftL (fromIntegral w) (64 * i)
-

src/Simplex/Messaging/Notifications/Protocol.hs

@@ -28,6 +28,7 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock.System
 import Data.Type.Equality
 import Data.Word (Word16)
+import Network.HTTP.Client (Request, parseUrlThrow)
 import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts)
 import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
@@ -36,11 +37,6 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Transport (NTFVersion, invalidReasonNTFVersion, ntfClientHandshake)
 import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..))
 import Simplex.Messaging.Util (eitherToMaybe, (<$?>))
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Binary as Bin
-import qualified Crypto.Error as CE
-import qualified Data.Bits as Bits
-import Network.HTTP.Client (Request, parseUrlThrow)
 
 data NtfEntity = Token | Subscription
   deriving (Show)
@@ -487,11 +483,13 @@ data WPKey = WPKey
   }
   deriving (Eq, Ord, Show)
 
-uncompressEncode :: WPP256dh -> BL.ByteString
+uncompressEncode :: WPP256dh -> ByteString
 uncompressEncode (WPP256dh p) = C.uncompressEncodePoint p
+{-# INLINE uncompressEncode #-}
 
-uncompressDecode :: BL.ByteString -> Either CE.CryptoError WPP256dh
+uncompressDecode :: ByteString -> Either String WPP256dh
 uncompressDecode bs = WPP256dh <$> C.uncompressDecodePoint bs
+{-# INLINE uncompressDecode #-}
 
 data WPTokenParams = WPTokenParams
   { wpPath :: ByteString,
@@ -508,18 +506,16 @@ instance StrEncoding WPAuth where
   strP = toWPAuth <$?> strP
 
 instance Encoding WPP256dh where
-  smpEncode p = smpEncode . BL.toStrict $ uncompressEncode p
-  smpP = smpP >>= \bs ->
-    case uncompressDecode (BL.fromStrict bs) of
-      Left _ -> fail "Invalid p256dh key"
-      Right res -> pure res
+  smpEncode = smpEncode . uncompressEncode
+  {-# INLINE smpEncode #-}
+  smpP = uncompressDecode <$?> smpP
+  {-# INLINE smpP #-}
 
 instance StrEncoding WPP256dh where
-  strEncode p = strEncode . BL.toStrict $ uncompressEncode p
-  strP = strP >>= \bs ->
-    case uncompressDecode (BL.fromStrict bs) of
-      Left _ -> fail "Invalid p256dh key"
-      Right res -> pure res
+  strEncode = strEncode . uncompressEncode
+  {-# INLINE strEncode #-}
+  strP = uncompressDecode <$?> strP
+  {-# INLINE strP #-}
 
 instance Encoding WPKey where
   smpEncode WPKey {wpAuth, wpP256dh} = smpEncode (wpAuth, wpP256dh)
@@ -594,12 +590,14 @@ instance ToJSON DeviceToken where
     APNSDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= decodeLatin1 t
     -- ToJSON/FromJSON isn't used for WPDeviceToken, we just include the pushProvider so it can fail properly if used to decrypt
     WPDeviceToken p _ -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p)
-    -- WPDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= toJSON t
+
+  -- WPDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= toJSON t
   toJSON token = case token of
     APNSDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= decodeLatin1 t]
     -- ToJSON/FromJSON isn't used for WPDeviceToken, we just include the pushProvider so it can fail properly if used to decrypt
     WPDeviceToken p _ -> J.object ["pushProvider" .= decodeLatin1 (strEncode p)]
-    -- WPDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= toJSON t]
+
+-- WPDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= toJSON t]
 
 instance FromJSON DeviceToken where
   parseJSON = J.withObject "DeviceToken" $ \o ->

src/Simplex/Messaging/Notifications/Server/Env.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -12,12 +12,15 @@ import Control.Concurrent (ThreadId)
 import Control.Logger.Simple
 import Control.Monad
 import Crypto.Random
+import Data.IORef (newIORef)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime)
 import qualified Data.X509.Validation as XV
+import Network.HTTP.Client (Manager, ManagerSettings (..), Request (..), newManager)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
 import Network.Socket
 import qualified Network.TLS as TLS
 import Numeric.Natural
@@ -27,6 +30,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push
 import Simplex.Messaging.Notifications.Server.Push.APNS
+import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushClient (..), WebPushConfig, wpPushProviderClient)
 import Simplex.Messaging.Notifications.Server.Stats
 import Simplex.Messaging.Notifications.Server.Store (newNtfSTMStore)
 import Simplex.Messaging.Notifications.Server.Store.Postgres
@@ -46,10 +50,6 @@ import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials, Transport
 import System.Exit (exitFailure)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
-import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient, WebPushConfig)
-import Network.HTTP.Client (newManager, ManagerSettings (..), Request (..), Manager)
-import Network.HTTP.Client.TLS (tlsManagerSettings)
-import Data.IORef (newIORef)
 
 data NtfServerConfig = NtfServerConfig
   { transports :: [(ServiceName, ASrvTransport, AddHTTP)],
@@ -185,16 +185,20 @@ newWPPushClient NtfPushServer {wpConfig, pushClients} pp = do
   -- We use one http manager per push server (which may be used by different clients)
   manager <- wpHTTPManager
   cache <- newIORef Nothing
-  pure $ wpPushProviderClient wpConfig cache manager
+  random <- C.newRandom
+  let client = WebPushClient {wpConfig, cache, manager, random}
+  pure $ wpPushProviderClient client
 
 wpHTTPManager :: IO Manager
-wpHTTPManager = newManager tlsManagerSettings {
-    -- Ideally, we should be able to override the domain resolution to
-    -- disable requests to non-public IPs. The risk is very limited as
-    -- we allow https only, and the body is encrypted. Disabling redirections
-    -- avoids cross-protocol redir (https => http/unix)
-    managerModifyRequest = \r -> pure r {redirectCount = 0}
-  }
+wpHTTPManager =
+  newManager
+    tlsManagerSettings
+      { -- Ideally, we should be able to override the domain resolution to
+        -- disable requests to non-public IPs. The risk is very limited as
+        -- we allow https only, and the body is encrypted. Disabling redirections
+        -- avoids cross-protocol redir (https => http/unix)
+        managerModifyRequest = \r -> pure r {redirectCount = 0}
+      }
 
 getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 getPushClient s@NtfPushServer {pushClients} pp =

src/Simplex/Messaging/Notifications/Server/Main.hs

@@ -262,7 +262,11 @@ ntfServerCLI cfgPath logPath =
                     persistErrorInterval = 0 -- seconds
                   },
               apnsConfig = defaultAPNSPushClientConfig,
-              wpConfig = WebPushConfig {vapidKey},
+              wpConfig =
+                WebPushConfig
+                  { vapidKey,
+                    paddedNtfLength = 3072
+                  },
               subsBatchSize = 900,
               inactiveClientExpiration =
                 settingIsOn "INACTIVE_CLIENTS" "disconnect" ini

src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs

@@ -4,131 +4,149 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
 {-# HLINT ignore "Use newtype instead of data" #-}
 
 module Simplex.Messaging.Notifications.Server.Push.WebPush where
 
-import Network.HTTP.Client
-import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), wpRequest, wpAud)
-import Simplex.Messaging.Notifications.Server.Store.Types
-import Simplex.Messaging.Notifications.Server.Push
-import Control.Monad.Except
+import Control.Exception (SomeException, fromException, try)
 import Control.Logger.Simple (logDebug)
-import Simplex.Messaging.Util (tshow)
-import qualified Data.ByteString as B
+import Control.Monad
+import Control.Monad.Except
 import Control.Monad.IO.Class (liftIO)
-import Control.Exception ( fromException, SomeException, try )
-import qualified Network.HTTP.Types as N
-import qualified Data.Aeson as J
-import Data.Aeson ((.=))
-import qualified Data.Binary as Bin
-import qualified Data.ByteArray as BA
-import qualified Data.ByteString.Lazy as BL
 import Control.Monad.Trans.Except (throwE)
-import Crypto.Hash.Algorithms (SHA256)
-import Crypto.Random (MonadRandom(getRandomBytes))
 import qualified Crypto.Cipher.Types as CT
+import Crypto.Hash.Algorithms (SHA256)
 import qualified Crypto.MAC.HMAC as HMAC
 import qualified Crypto.PubKey.ECC.DH as ECDH
-import qualified Crypto.PubKey.ECC.Types as ECC
 import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
+import qualified Crypto.PubKey.ECC.Types as ECC
+import Crypto.Random (ChaChaDRG, getRandomBytes)
+import Data.Aeson ((.=))
+import qualified Data.Aeson as J
+import qualified Data.Binary as Bin
+import qualified Data.ByteArray as BA
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Base64.URL as B64
+import qualified Data.ByteString.Lazy as LB
 import Data.IORef
 import Data.Int (Int64)
-import Data.Time.Clock.System (systemSeconds, getSystemTime)
+import Data.Text (Text)
 import qualified Data.Text.Encoding as T
+import Data.Time.Clock.System (getSystemTime, systemSeconds)
+import Network.HTTP.Client
+import qualified Network.HTTP.Types as N
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfRegCode (..), WPAuth (..), WPKey (..), WPP256dh (..), WPTokenParams (..), encodePNMessages, wpAud, wpRequest)
+import Simplex.Messaging.Notifications.Server.Push
+import Simplex.Messaging.Notifications.Server.Store.Types
+import Simplex.Messaging.Util (liftError', safeDecodeUtf8, tshow)
+import UnliftIO.STM
 
 -- | Vapid
 -- | fp: fingerprint, base64url encoded without padding
 -- | key: privkey
 data VapidKey = VapidKey
-  { key::ECDSA.PrivateKey,
-    fp::B.ByteString
+  { key :: ECDSA.PrivateKey,
+    fp :: ByteString
   }
   deriving (Eq, Show)
 
 mkVapid :: ECDSA.PrivateKey -> VapidKey
-mkVapid key = VapidKey { key, fp }
+mkVapid key = VapidKey {key, fp}
   where
-    fp = B64.encodeUnpadded . BL.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) . ECDSA.private_d $ key
+    fp = B64.encodeUnpadded $ C.uncompressEncodePoint $ ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ ECDSA.private_d key
+
+data WebPushClient = WebPushClient
+  { wpConfig :: WebPushConfig,
+    cache :: IORef (Maybe WPCache),
+    manager :: Manager,
+    random :: TVar ChaChaDRG
+  }
 
 data WebPushConfig = WebPushConfig
-  { vapidKey :: VapidKey
+  { vapidKey :: VapidKey,
+    paddedNtfLength :: Int
   }
 
 data WPCache = WPCache
-  { vapidHeader :: B.ByteString,
+  { vapidHeader :: ByteString,
     expire :: Int64
   }
 
-getVapidHeader :: VapidKey -> IORef (Maybe WPCache) -> B.ByteString -> IO B.ByteString
+getVapidHeader :: VapidKey -> IORef (Maybe WPCache) -> ByteString -> IO ByteString
 getVapidHeader vapidK cache uriAuthority = do
   h <- readIORef cache
   now <- systemSeconds <$> getSystemTime
   case h of
     Nothing -> newCacheEntry now
     -- if it expires in 1 min, then we renew - for safety
-    Just entry -> if expire entry > now + 60 then pure $ vapidHeader entry
-      else newCacheEntry now
+    Just entry ->
+      if expire entry > now + 60
+        then pure $ vapidHeader entry
+        else newCacheEntry now
   where
-    newCacheEntry :: Int64 -> IO B.ByteString
+    newCacheEntry :: Int64 -> IO ByteString
     newCacheEntry now = do
       -- The new entry expires in one hour
       let expire = now + 3600
       vapidHeader <- mkVapidHeader vapidK uriAuthority expire
-      let entry = Just WPCache { vapidHeader, expire }
+      let entry = Just WPCache {vapidHeader, expire}
       atomicWriteIORef cache entry
       pure vapidHeader
 
 -- | With time in input for the tests
-getVapidHeader' :: Int64 -> VapidKey -> IORef (Maybe WPCache) -> B.ByteString -> IO B.ByteString
+getVapidHeader' :: Int64 -> VapidKey -> IORef (Maybe WPCache) -> ByteString -> IO ByteString
 getVapidHeader' now vapidK cache uriAuthority = do
   h <- readIORef cache
   case h of
     Nothing -> newCacheEntry
-    Just entry -> if expire entry > now then pure $ vapidHeader entry
-      else newCacheEntry
+    Just entry ->
+      if expire entry > now
+        then pure $ vapidHeader entry
+        else newCacheEntry
   where
-    newCacheEntry :: IO B.ByteString
+    newCacheEntry :: IO ByteString
     newCacheEntry = do
       -- The new entry expires in one hour
       let expire = now + 3600
       vapidHeader <- mkVapidHeader vapidK uriAuthority expire
-      let entry = Just WPCache { vapidHeader, expire }
+      let entry = Just WPCache {vapidHeader, expire}
       atomicWriteIORef cache entry
       pure vapidHeader
 
 -- | mkVapidHeader -> vapid -> endpoint -> expire -> vapid header
-mkVapidHeader :: VapidKey -> B.ByteString -> Int64 -> IO B.ByteString
+mkVapidHeader :: VapidKey -> ByteString -> Int64 -> IO ByteString
 mkVapidHeader VapidKey {key, fp} uriAuthority expire = do
   let jwtHeader = mkJWTHeader "ES256" Nothing
-      jwtClaims = JWTClaims
-        { iss = Nothing,
-          iat = Nothing,
-          exp = Just expire,
-          aud = Just $ T.decodeUtf8 uriAuthority,
-          sub = Just "https://github.com/simplex-chat/simplexmq/"
-        }
+      jwtClaims =
+        JWTClaims
+          { iss = Nothing,
+            iat = Nothing,
+            exp = Just expire,
+            aud = Just $ T.decodeUtf8 uriAuthority,
+            sub = Just "https://github.com/simplex-chat/simplexmq/"
+          }
       jwt = JWTToken jwtHeader jwtClaims
   signedToken <- signedJWTToken key jwt
   pure $ "vapid t=" <> signedToken <> ",k=" <> fp
 
-wpPushProviderClient :: WebPushConfig -> IORef (Maybe WPCache) -> Manager -> PushProviderClient
-wpPushProviderClient _ _ _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
-wpPushProviderClient conf cache mg NtfTknRec {token = token@(WPDeviceToken pp param)} pn = do
+wpPushProviderClient :: WebPushClient -> PushProviderClient
+wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
+wpPushProviderClient c@WebPushClient {wpConfig, cache, manager} tkn@NtfTknRec {token = token@(WPDeviceToken pp params)} pn = do
   -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams)
   -- parsing will happen in DeviceToken parser, so it won't fail here
   r <- wpRequest token
-  vapidH <- liftPPWPError $ getVapidHeader (vapidKey conf) cache aud
-  logDebug $ "Request to " <> tshow (host r)
-  encBody <- body
+  vapidH <- liftError' toPPWPError $ try $ getVapidHeader (vapidKey wpConfig) cache $ wpAud pp
+  logDebug $ "Web Push request to " <> tshow (host r)
+  encBody <- withExceptT PPCryptoError $ wpEncrypt c tkn params pn
   let requestHeaders =
         [ ("TTL", "2592000"), -- 30 days
           ("Urgency", "high"),
           ("Content-Encoding", "aes128gcm"),
           ("Authorization", vapidH)
-    -- TODO: topic for pings and interval
+          -- TODO: topic for pings and interval
         ]
       req =
         r
@@ -137,77 +155,66 @@ wpPushProviderClient conf cache mg NtfTknRec {token = token@(WPDeviceToken pp pa
             requestBody = RequestBodyBS encBody,
             redirectCount = 0
           }
-  _ <- liftPPWPError $ httpNoBody req mg
-  pure ()
-  where
-    body :: ExceptT PushProviderError IO B.ByteString
-    body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodeWPN pn)
-    aud = wpAud pp
+  void $ liftError' toPPWPError $ try $ httpNoBody req manager
 
 -- | encrypt :: UA key -> clear -> cipher
 -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
-wpEncrypt :: WPKey -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString
-wpEncrypt wpKey clearT = do
-  salt :: B.ByteString <- liftIO $ getRandomBytes 16
+wpEncrypt :: WebPushClient -> NtfTknRec -> WPTokenParams -> PushNotification -> ExceptT C.CryptoError IO ByteString
+wpEncrypt WebPushClient {wpConfig, random} NtfTknRec {tknDhSecret} params pn = do
+  salt <- liftIO $ getRandomBytes 16
   asPrivK <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1
-  wpEncrypt' wpKey asPrivK salt clearT
+  pn' <-
+    LB.toStrict . J.encode <$> case pn of
+      PNVerification (NtfRegCode code) -> do
+        (nonce, code') <- encrypt code
+        pure $ J.object ["nonce" .= nonce, "verification" .= code']
+      PNMessage msgData -> do
+        (nonce, msgData') <- encrypt $ encodePNMessages msgData
+        pure $ J.object ["nonce" .= nonce, "message" .= msgData']
+      PNCheckMessages -> pure $ J.object ["checkMessages" .= True]
+  wpEncrypt' (wpKey params) asPrivK salt pn'
+  where
+    encrypt :: ByteString -> ExceptT C.CryptoError IO (C.CbNonce, Text)
+    encrypt ntfData = do
+      nonce <- atomically $ C.randomCbNonce random
+      encData <- liftEither $ C.cbEncrypt tknDhSecret nonce ntfData $ paddedNtfLength wpConfig
+      pure (nonce, safeDecodeUtf8 $ B64.encode encData)
 
 -- | encrypt :: UA key -> AS key -> salt -> clear -> cipher
 -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
-wpEncrypt' :: WPKey -> ECC.PrivateNumber -> B.ByteString -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString
+wpEncrypt' :: WPKey -> ECC.PrivateNumber -> ByteString -> ByteString -> ExceptT C.CryptoError IO ByteString
 wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do
-  let uaPubKS = BL.toStrict . C.uncompressEncodePoint $ uaPubK
-  let asPubKS = BL.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK
+  let uaPubKS = C.uncompressEncodePoint uaPubK
+  let asPubKS = C.uncompressEncodePoint $ ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) asPrivK
       ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK
       prkKey = hmac (unWPAuth wpAuth) ecdhSecret
       keyInfo = "WebPush: info\0" <> uaPubKS <> asPubKS
       ikm = hmac prkKey (keyInfo <> "\x01")
       prk = hmac salt ikm
-      cekInfo = "Content-Encoding: aes128gcm\0" :: B.ByteString
-      cek = takeHM 16 $ hmac prk (cekInfo <> "\x01")
-      nonceInfo = "Content-Encoding: nonce\0" :: B.ByteString
-      nonce = takeHM 12 $ hmac prk (nonceInfo <> "\x01")
-      rs = BL.toStrict $ Bin.encode (4096 :: Bin.Word32) -- with RFC8291, it's ok to always use 4096 because there is only one single record and the final record can be smaller than rs (RFC8188)
-      idlen = BL.toStrict $ Bin.encode (65 :: Bin.Word8) -- with RFC8291, keyid is the pubkey, so always 65 bytes
+      cekInfo = "Content-Encoding: aes128gcm\0" :: ByteString
+      cek = B.take 16 $ BA.convert $ hmac prk (cekInfo <> "\x01")
+      nonceInfo = "Content-Encoding: nonce\0" :: ByteString
+      nonce = B.take 12 $ BA.convert $ hmac prk (nonceInfo <> "\x01")
+      rs = LB.toStrict $ Bin.encode (4096 :: Bin.Word32) -- with RFC8291, it's ok to always use 4096 because there is only one single record and the final record can be smaller than rs (RFC8188)
+      idlen = LB.toStrict $ Bin.encode (65 :: Bin.Word8) -- with RFC8291, keyid is the pubkey, so always 65 bytes
       header = salt <> rs <> idlen <> asPubKS
-  iv <- ivFrom nonce
+  iv <- liftEither $ C.gcmIV nonce
   -- The last record uses a padding delimiter octet set to the value 0x02
   (C.AuthTag (CT.AuthTag tag), cipherT) <- C.encryptAES128NoPad (C.Key cek) iv $ clearT <> "\x02"
   -- Uncomment to see intermediate values, to compare with RFC8291 example
-  -- liftIO . print $ strEncode (BA.convert ecdhSecret :: B.ByteString)
-  -- liftIO . print . strEncode $ takeHM 32 prkKey
+  -- liftIO . print $ strEncode (BA.convert ecdhSecret :: ByteString)
+  -- liftIO . print . strEncode $ B.take 32 $ BA.convert prkKey
   -- liftIO . print $ strEncode cek
   -- liftIO . print $ strEncode cipherT
   pure $ header <> cipherT <> BA.convert tag
   where
     hmac k v = HMAC.hmac k v :: HMAC.HMAC SHA256
-    takeHM :: Int -> HMAC.HMAC SHA256 -> B.ByteString
-    takeHM n v = BL.toStrict $ BL.pack $ take n $ BA.unpack v
-    ivFrom :: B.ByteString -> ExceptT C.CryptoError IO C.GCMIV
-    ivFrom s = case C.gcmIV s of
-      Left e -> throwE e
-      Right iv -> pure iv
-
-encodeWPN :: PushNotification -> BL.ByteString
-encodeWPN pn = J.encode $ case pn of
-  PNVerification code -> J.object ["verification" .= code]
-  -- This hack prevents sending unencrypted message metadata in notifications, as we do not use it in the client - it simply receives all messages on each notification.
-  -- If we decide to change it to pull model as used in iOS, we can change JSON key to "message" with any payload, as the current clients would interpret it as "checkMessages".
-  -- In this case an additional encryption layer would need to be added here, in the same way as with APNS notifications.
-  PNMessage _ -> J.object ["checkMessages" .= True]
-  PNCheckMessages -> J.object ["checkMessages" .= True]
-
-liftPPWPError :: IO a -> ExceptT PushProviderError IO a
-liftPPWPError = liftPPWPError' toPPWPError
-
-liftPPWPError' :: (SomeException -> PushProviderError) -> IO a -> ExceptT PushProviderError IO a
-liftPPWPError' err a = liftIO (try @SomeException a) >>= either (throwError . err) return
 
 toPPWPError :: SomeException -> PushProviderError
 toPPWPError e = case fromException e of
-    Just (InvalidUrlException _ _) -> PPWPInvalidUrl
-    Just (HttpExceptionRequest _ (StatusCodeException resp _)) -> fromStatusCode (responseStatus resp) ("" :: String)
-    _ -> PPWPOtherError e
+  Just (InvalidUrlException _ _) -> PPWPInvalidUrl
+  Just (HttpExceptionRequest _ (StatusCodeException resp _)) -> fromStatusCode (responseStatus resp) ("" :: String)
+  _ -> PPWPOtherError e
   where
     fromStatusCode status reason
       | status == N.status200 = PPWPRemovedEndpoint

tests/NtfClient.hs

@@ -16,6 +16,7 @@
 module NtfClient where
 
 import Control.Concurrent.STM (retry)
+import Control.Exception (throwIO)
 import Control.Monad
 import Control.Monad.Except (runExceptT)
 import Control.Monad.IO.Class
@@ -44,8 +45,10 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfResponse)
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
 import Simplex.Messaging.Notifications.Server.Env
+import Simplex.Messaging.Notifications.Server.Main (getVapidKey)
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
+import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushConfig (..))
 import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
@@ -60,9 +63,6 @@ import UnliftIO.Async
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
-import Control.Exception (throwIO)
-import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushConfig(..))
-import Simplex.Messaging.Notifications.Server.Main (getVapidKey)
 
 testHost :: NonEmpty TransportHost
 testHost = "localhost"
@@ -130,43 +130,45 @@ testNtfClient client = do
 ntfServerCfg :: IO NtfServerConfig
 ntfServerCfg = do
   vapidKey <- getVapidKey "tests/fixtures/vapid.privkey"
-  pure NtfServerConfig
-    { transports = [],
-      controlPort = Nothing,
-      controlPortUserAuth = Nothing,
-      controlPortAdminAuth = Nothing,
-      subIdBytes = 24,
-      regCodeBytes = 32,
-      clientQSize = 2,
-      pushQSize = 2,
-      smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 0},
-      apnsConfig =
-        defaultAPNSPushClientConfig
-          { apnsPort = apnsTestPort,
-            caStoreFile = "tests/fixtures/ca.crt"
-          },
-      wpConfig = WebPushConfig {vapidKey},
-      subsBatchSize = 900,
-      inactiveClientExpiration = Just defaultInactiveClientExpiration,
-      dbStoreConfig = ntfTestDBCfg,
-      ntfCredentials = ntfTestServerCredentials,
-      useServiceCreds = True,
-      periodicNtfsInterval = 1,
-      -- stats config
-      logStatsInterval = Nothing,
-      logStatsStartTime = 0,
-      serverStatsLogFile = "tests/ntf-server-stats.daily.log",
-      serverStatsBackupFile = Nothing,
-      prometheusInterval = Nothing,
-      prometheusMetricsFile = ntfTestPrometheusMetricsFile,
-      ntfServerVRange = supportedServerNTFVRange,
-      transportConfig = mkTransportServerConfig True (Just alpnSupportedNTFHandshakes) False,
-      startOptions = defaultStartOptions
-    }
+  pure
+    NtfServerConfig
+      { transports = [],
+        controlPort = Nothing,
+        controlPortUserAuth = Nothing,
+        controlPortAdminAuth = Nothing,
+        subIdBytes = 24,
+        regCodeBytes = 32,
+        clientQSize = 2,
+        pushQSize = 2,
+        smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 0},
+        apnsConfig =
+          defaultAPNSPushClientConfig
+            { apnsPort = apnsTestPort,
+              caStoreFile = "tests/fixtures/ca.crt"
+            },
+        wpConfig = WebPushConfig {vapidKey, paddedNtfLength = 3072},
+        subsBatchSize = 900,
+        inactiveClientExpiration = Just defaultInactiveClientExpiration,
+        dbStoreConfig = ntfTestDBCfg,
+        ntfCredentials = ntfTestServerCredentials,
+        useServiceCreds = True,
+        periodicNtfsInterval = 1,
+        -- stats config
+        logStatsInterval = Nothing,
+        logStatsStartTime = 0,
+        serverStatsLogFile = "tests/ntf-server-stats.daily.log",
+        serverStatsBackupFile = Nothing,
+        prometheusInterval = Nothing,
+        prometheusMetricsFile = ntfTestPrometheusMetricsFile,
+        ntfServerVRange = supportedServerNTFVRange,
+        transportConfig = mkTransportServerConfig True (Just alpnSupportedNTFHandshakes) False,
+        startOptions = defaultStartOptions
+      }
 
 ntfServerCfgVPrev :: IO NtfServerConfig
-ntfServerCfgVPrev = ntfServerCfg >>=
-  \cfg -> pure $ ntfServerCfgVPrev' cfg
+ntfServerCfgVPrev =
+  ntfServerCfg
+    >>= \cfg -> pure $ ntfServerCfgVPrev' cfg
 
 ntfServerCfgVPrev' :: NtfServerConfig -> NtfServerConfig
 ntfServerCfgVPrev' cfg =
@@ -180,8 +182,9 @@ ntfServerCfgVPrev' cfg =
     serverVRange' = serverVRange smpCfg'
 
 withNtfServerThreadOn :: HasCallStack => ASrvTransport -> ServiceName -> PostgresStoreCfg -> (HasCallStack => ThreadId -> IO a) -> IO a
-withNtfServerThreadOn t port' dbStoreConfig a = ntfServerCfg >>= \cfg ->
-  withNtfServerCfg cfg {transports = [(port', t, False)], dbStoreConfig} a
+withNtfServerThreadOn t port' dbStoreConfig a =
+  ntfServerCfg >>= \cfg ->
+    withNtfServerCfg cfg {transports = [(port', t, False)], dbStoreConfig} a
 
 withNtfServerCfg :: HasCallStack => NtfServerConfig -> (ThreadId -> IO a) -> IO a
 withNtfServerCfg cfg@NtfServerConfig {transports} =

tests/NtfWPTests.hs

@@ -1,33 +1,29 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE DataKinds #-}
 
 module NtfWPTests where
 
-import Test.Hspec hiding (fit, it)
-import Util
-import Simplex.Messaging.Encoding.String (StrEncoding(..))
-import qualified Data.ByteString as B
-import qualified Crypto.PubKey.ECC.Types as ECC
-import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt', encodeWPN, getVapidHeader')
+import Control.Monad (unless)
 import Control.Monad.Except (runExceptT)
-import qualified Data.ByteString.Lazy as BL
-import Simplex.Messaging.Notifications.Server.Push
-import Data.List.NonEmpty (NonEmpty ((:|)))
-import qualified Simplex.Messaging.Crypto as C
-import Data.Time.Clock.System (SystemTime(..))
+import qualified Crypto.PubKey.ECC.Types as ECC
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
 import Data.Either (isLeft)
 import Data.IORef (newIORef)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Main (getVapidKey)
-import Control.Monad (unless)
+import Simplex.Messaging.Notifications.Server.Push.WebPush (getVapidHeader', wpEncrypt')
+import Test.Hspec hiding (fit, it)
+import Util
 
 ntfWPTests :: Spec
 ntfWPTests = describe "NTF Protocol" $ do
   it "decode WPDeviceToken from string" testWPDeviceTokenStrEncoding
   it "decode invalid WPDeviceToken" testInvalidWPDeviceTokenStrEncoding
   it "Encrypt RFC8291 example" testWPEncryption
-  it "PushNotifications encoding" testPNEncoding
   it "Vapid header cache" testVapidCache
 
 testWPDeviceTokenStrEncoding :: Expectation
@@ -38,7 +34,7 @@ testWPDeviceTokenStrEncoding = do
 
   let auth = either error id $ strDecode "AQ3VfRX3_F38J3ltcmMVRg"
   let pk = either error id $ strDecode "BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
-  let params ::WPTokenParams = either error id $ strDecode "/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
+  let params :: WPTokenParams = either error id $ strDecode "/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
   wpPath params `shouldBe` "/secret"
   let key = wpKey params
   wpAuth key `shouldBe` auth
@@ -59,16 +55,16 @@ testInvalidWPDeviceTokenStrEncoding = do
   -- e.g "https://#1" is a valid URL. But that is the same parser
   -- we use to send the requests, so that's fine.
   let ts = "webpush https://localhost:/ AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
-  let t = strDecode ts :: Either String DeviceToken
+      t = strDecode ts :: Either String DeviceToken
   t `shouldSatisfy` isLeft
 
 -- | Example from RFC8291
 testWPEncryption :: Expectation
 testWPEncryption = do
-  let clearT :: B.ByteString = "When I grow up, I want to be a watermelon"
-  let pParams :: WPTokenParams = either error id $ strDecode "/push/JzLQ3raZJfFBR0aqvOMsLrt54w4rJUsV BTBZMqHH6r4Tts7J_aSIgg BCVxsr7N_eNgVRqvHtD0zTZsEc6-VV-JvLexhqUzORcxaOzi6-AYWXvTBHm4bjyPjs7Vd8pZGH6SRpkNtoIAiw4"
-  let salt :: B.ByteString = either error id $ strDecode "DGv6ra1nlYgDCS1FRnbzlw"
-  let privBS :: BL.ByteString = either error BL.fromStrict $ strDecode "yfWPiYE-n46HLnH0KqZOF1fJJU3MYrct3AELtAQ-oRw"
+  let clearT :: ByteString = "When I grow up, I want to be a watermelon"
+      pParams :: WPTokenParams = either error id $ strDecode "/push/JzLQ3raZJfFBR0aqvOMsLrt54w4rJUsV BTBZMqHH6r4Tts7J_aSIgg BCVxsr7N_eNgVRqvHtD0zTZsEc6-VV-JvLexhqUzORcxaOzi6-AYWXvTBHm4bjyPjs7Vd8pZGH6SRpkNtoIAiw4"
+      salt :: ByteString = either error id $ strDecode "DGv6ra1nlYgDCS1FRnbzlw"
+      privBS :: ByteString = either error id $ strDecode "yfWPiYE-n46HLnH0KqZOF1fJJU3MYrct3AELtAQ-oRw"
   asPriv :: ECC.PrivateNumber <- case C.uncompressDecodePrivateNumber privBS of
     Left e -> fail $ "Cannot decode PrivateNumber from b64 " <> show e
     Right p -> pure p
@@ -78,22 +74,6 @@ testWPEncryption = do
     Right c -> pure c
   strEncode cipher `shouldBe` "DGv6ra1nlYgDCS1FRnbzlwAAEABBBP4z9KsN6nGRTbVYI_c7VJSPQTBtkgcy27mlmlMoZIIgDll6e3vCYLocInmYWAmS6TlzAC8wEqKK6PBru3jl7A_yl95bQpu6cVPTpK4Mqgkf1CXztLVBSt2Ks3oZwbuwXPXLWyouBWLVWGNWQexSgSxsj_Qulcy4a-fN"
 
-testPNEncoding :: Expectation
-testPNEncoding = do
-  let pnVerif = PNVerification (NtfRegCode "abcd")
-      pnCheck = PNCheckMessages
-      pnMess = pnM "MyMessage"
-  enc pnCheck `shouldBe` "{\"checkMessages\":true}"
-  enc pnVerif `shouldBe` "{\"verification\":\"YWJjZA==\"}"
-  enc pnMess `shouldBe` "{\"checkMessages\":true}"
-  where
-    enc p = BL.toStrict $ encodeWPN p
-    pnM :: B.ByteString -> PushNotification
-    pnM m = do
-      let smpQ = either error id $ strDecode "smp://AAAA@l/AAAA"
-      let now = MkSystemTime 1761827386 0
-      PNMessage $ PNMessageData smpQ now (C.cbNonce "nonce") m :| []
-
 testVapidCache :: Expectation
 testVapidCache = do
   let wpaud = "https://localhost"
@@ -111,11 +91,11 @@ testVapidCache = do
   v3 `shouldContainBS` "vapid t=eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzI1NiJ9."
   v3 `shouldContainBS` ",k=BIk7ASkEr1A1rJRGXMKi77tAGj3dRouSgZdW6S5pee7a3h7fkvd0OYQixy4yj35UFZt8hd9TwAQiybDK_HJLwJA"
 
-shouldContainBS :: B.ByteString -> B.ByteString -> Expectation
+shouldContainBS :: ByteString -> ByteString -> Expectation
 shouldContainBS actual expected =
   unless (expected `B.isInfixOf` actual) $
     expectationFailure $
-      "Expected ByteString to contain:\n" ++
-      show expected ++
-      "\nBut got:\n" ++
-      show actual
+      "Expected ByteString to contain:\n"
+        ++ show expected
+        ++ "\nBut got:\n"
+        ++ show actual