cacophony 0.7.0 → 0.8.0

raw patch · 13 files changed

+139/−97 lines, 13 filesdep +exceptionsdep +safe-exceptionsPVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions, safe-exceptions

API changes (from Hackage documentation)

Files

• .travis.yml +0/−1
• cacophony.cabal +3/−1
• changelog.md +13/−0
• examples/echo-server/Main.hs +1/−1
• src/Crypto/Noise.hs +16/−14
• src/Crypto/Noise/HandshakePatterns.hs +24/−4
• src/Crypto/Noise/Internal/CipherState.hs +14/−11
• src/Crypto/Noise/Internal/Handshake.hs +5/−7
• src/Crypto/Noise/Internal/HandshakePattern.hs +6/−6
• src/Crypto/Noise/Internal/NoiseState.hs +26/−25
• src/Crypto/Noise/Internal/SymmetricState.hs +16/−15
• src/Crypto/Noise/Internal/Types.hs +4/−0
• tests/vectors/Verify.hs +11/−12

@@ -57,7 +57,6 @@       rm -rf $HOME/.cabsnap;       mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;       cabal install --only-dependencies --enable-tests --enable-benchmarks -fbuild-examples cacophony.cabal;-      if [ "$GHCVER" = "7.10.1" ]; then cabal install Cabal-1.22.4.0; fi;     fi    # snapshot package-db on cache miss

@@ -1,5 +1,5 @@ name:          cacophony-version:       0.7.0+version:       0.8.0 synopsis:      A library implementing the Noise protocol. license:       PublicDomain license-file:  LICENSE@@ -57,11 +57,13 @@     bytestring,     cryptonite >=0.16,     deepseq,+    exceptions >=0.8.3,     free,     lens,     memory,     monad-coroutine,     mtl,+    safe-exceptions,     transformers   hs-source-dirs:   src   default-language: Haskell2010

@@ -1,3 +1,16 @@+# 0.8.0++* Exceptions are now provided by the safe-exceptions package+  (breaking API change)++* Added Noise\_XXfallback pattern++* Minor improvements to handshake pattern definition++* Updated non-standard handshake patterns to conform with rev 30++* Fixed bug which caused echo-server to read wrong public key+ # 0.7.0  * Major API overhaul and refactoring

@@ -52,7 +52,7 @@ processOptions (Options{..}, [port, pskFile]) = do   local25519 <- processPrivateKey "server_key_25519"   local448 <- processPrivateKey "server_key_448"-  remote25519 <- readPublicKey "client_key_448.pub"+  remote25519 <- readPublicKey "client_key_25519.pub"   remote448 <- readPublicKey "client_key_448.pub"   psk <- readPSK pskFile 

@@ -37,6 +37,7 @@   ) where  import Control.Arrow+import Control.Exception.Safe import Control.Lens import Data.ByteString (ByteString) import Data.Maybe      (isJust)@@ -58,18 +59,18 @@ -- --   To prevent catastrophic key re-use, this function may only be used to --   secure 2^64 post-handshake messages.-writeMessage :: (Cipher c, Hash h)+writeMessage :: (MonadThrow m, Cipher c, Hash h)              => NoiseState c d h              -> ScrubbedBytes-             -> Either NoiseException (ByteString, NoiseState c d h)-writeMessage ns msg = right toByteString $-  maybe (runHandshake msg ns)-        (right (ctToBytes *** updateState) . encryptAndIncrement "" msg)-        (ns ^. nsSendingCipherState)+             -> m (ByteString, NoiseState c d h)+writeMessage ns msg = maybe+  (first convertArr <$> runHandshake msg ns)+  (\cs -> (ctToBytes *** updateState) <$> encryptAndIncrement "" msg cs)+  (ns ^. nsSendingCipherState)   where-    ctToBytes    = arr cipherTextToBytes+    convertArr   = arr convert+    ctToBytes    = convertArr . arr cipherTextToBytes     updateState  = arr $ \cs -> ns & nsSendingCipherState .~ Just cs-    toByteString = first (arr convert)  -- | Reads a Noise message and returns the embedded payload. If the --   handshake fails, a 'HandshakeError' will be returned. After the handshake@@ -77,15 +78,16 @@ -- --   To prevent catastrophic key re-use, this function may only be used to --   receive 2^64 post-handshake messages.-readMessage :: (Cipher c, Hash h)+readMessage :: (MonadThrow m, Cipher c, Hash h)             => NoiseState c d h             -> ByteString-            -> Either NoiseException (ScrubbedBytes, NoiseState c d h)-readMessage ns ct =-  maybe (runHandshake (convert ct) ns)-        ((right . second) updateState . (decryptAndIncrement "" . cipherBytesToText . convert) ct)-        (ns ^. nsReceivingCipherState)+            -> m (ScrubbedBytes, NoiseState c d h)+readMessage ns ct = maybe+  (runHandshake (convert ct) ns)+  (\cs -> second updateState <$> decryptAndIncrement "" ct' cs)+  (ns ^. nsReceivingCipherState)   where+    ct'         = cipherBytesToText . convert $ ct     updateState = arr $ \cs -> ns & nsReceivingCipherState .~ Just cs  -- | For handshake patterns where the remote party's static key is

@@ -33,6 +33,7 @@   , noiseN   , noiseK   , noiseX+  , noiseXXfallback   ) where  import Crypto.Noise.Internal.HandshakePattern@@ -113,8 +114,8 @@ noiseNE :: HandshakePattern noiseNE = HandshakePattern "NE" $ do   preResponder $ do-    s     e+    s    initiator $ do     e@@ -138,8 +139,8 @@   preInitiator s    preResponder $ do-    s     e+    s    initiator $ do     e@@ -266,8 +267,8 @@ noiseXE :: HandshakePattern noiseXE = HandshakePattern "XE" $ do   preResponder $ do-    s     e+    s    initiator $ do     e@@ -292,8 +293,8 @@ noiseIE :: HandshakePattern noiseIE = HandshakePattern "IE" $ do   preResponder $ do-    s     e+    s    initiator $ do     e@@ -382,3 +383,22 @@     dhes     s     dhss++-- | @Noise_XXfallback(s, rs, re):+--  <- e+--  ...+--  -> e, dhee, s, dhse+--  <- s, dhse+noiseXXfallback :: HandshakePattern+noiseXXfallback = HandshakePattern "XXfallback" $ do+  preResponder e++  initiator $ do+    e+    dhee+    s+    dhse++  responder $ do+    s+    dhse

@@ -9,6 +9,7 @@  module Crypto.Noise.Internal.CipherState where +import Control.Exception.Safe import Control.Lens  import Crypto.Noise.Cipher@@ -22,28 +23,30 @@  $(makeLenses ''CipherState) -encryptAndIncrement :: Cipher c+encryptAndIncrement :: (MonadThrow m, Cipher c)                     => AssocData                     -> Plaintext                     -> CipherState c-                    -> Either NoiseException (Ciphertext c, CipherState c)-encryptAndIncrement ad plaintext cs | allow     = Right (ct, newState)-                                    | otherwise = Left $ MessageLimitReached "encryptAndIncrement"+                    -> m (Ciphertext c, CipherState c)+encryptAndIncrement ad plaintext cs+  | allow     = return (ct, newState)+  | otherwise = throwM $ MessageLimitReached "encryptAndIncrement"   where     ct       = cipherEncrypt (cs ^. csk) (cs ^. csn) ad plaintext     newState = cs & csn %~ cipherIncNonce     allow    = cs ^. csCount < 2 ^ (64 :: Integer) -decryptAndIncrement :: Cipher c+decryptAndIncrement :: (MonadThrow m, Cipher c)                     => AssocData                     -> Ciphertext c                     -> CipherState c-                    -> Either NoiseException (Plaintext, CipherState c)-decryptAndIncrement ad ct cs | allow     =-  maybe (Left $ DecryptionError "decryptAndIncrement")-        (\x -> Right (x, newState))-        pt-                             | otherwise = Left $ MessageLimitReached "decryptAndIncrement"+                    -> m (Plaintext, CipherState c)+decryptAndIncrement ad ct cs+  | allow     =+    maybe (throwM (DecryptionError "decryptAndIncrement"))+          (\x -> return (x, newState))+          pt+  | otherwise = throwM $ MessageLimitReached "decryptAndIncrement"   where     pt       = cipherDecrypt (cs ^. csk) (cs ^. csn) ad ct     newState = maybe cs (const (cs & csn %~ cipherIncNonce)) pt

@@ -14,7 +14,7 @@ import Control.Lens import Control.Monad.Coroutine import Control.Monad.Coroutine.SuspensionFunctors-import Control.Monad.Except (MonadError(..), Except)+import Control.Monad.Catch.Pure import Control.Monad.State  (MonadState(..), StateT) import Control.Monad.Trans.Class (MonadTrans(lift)) @@ -22,7 +22,6 @@ import Crypto.Noise.DH import Crypto.Noise.Internal.HandshakePattern import Crypto.Noise.Internal.SymmetricState-import Crypto.Noise.Internal.Types import Data.ByteArray.Extend  -- | Represents the side of the conversation upon which a party resides.@@ -54,17 +53,16 @@ $(makeLenses ''HandshakeState)  newtype Handshake c d h r =-  Handshake { runHandshake' :: Coroutine (Request ScrubbedBytes ScrubbedBytes) (StateT (HandshakeState c d h) (Except NoiseException)) r+  Handshake { runHandshake' :: Coroutine (Request ScrubbedBytes ScrubbedBytes) (StateT (HandshakeState c d h) Catch) r             } deriving ( Functor                        , Applicative                        , Monad-                       , MonadError NoiseException+                       , MonadThrow                        , MonadState (HandshakeState c d h)                        ) -instance (Functor f, MonadError e m) => MonadError e (Coroutine f m) where-  throwError = lift . throwError-  catchError m _ = m+instance (Functor f, MonadThrow m) => MonadThrow (Coroutine f m) where+  throwM = lift . throwM  instance (Functor f, MonadState s m) => MonadState s (Coroutine f m) where   get = lift get

@@ -10,7 +10,7 @@ module Crypto.Noise.Internal.HandshakePattern where  import Control.Lens-import Control.Monad.Trans.Free.Church+import Control.Monad.Free.Church import Control.Monad.Free.TH import Data.ByteString (ByteString) @@ -26,10 +26,10 @@ $(makeFree ''TokenF)  data HandshakePatternF next-  = PreInitiator (FT TokenF Identity ()) next-  | PreResponder (FT TokenF Identity ()) next-  | Initiator (FT TokenF Identity ()) next-  | Responder (FT TokenF Identity ()) next+  = PreInitiator (F TokenF ()) next+  | PreResponder (F TokenF ()) next+  | Initiator (F TokenF ()) next+  | Responder (F TokenF ()) next   deriving Functor  $(makeFree ''HandshakePatternF)@@ -38,7 +38,7 @@ --   Free Monad. data HandshakePattern =   HandshakePattern { _hpName    :: ByteString-                   , _hpActions :: FT HandshakePatternF Identity ()+                   , _hpActions :: F HandshakePatternF ()                    }  $(makeLenses ''HandshakePattern)

@@ -9,11 +9,11 @@  module Crypto.Noise.Internal.NoiseState where +import Control.Monad.Catch.Pure import Control.Monad.Coroutine import Control.Monad.Coroutine.SuspensionFunctors-import Control.Monad.Except (MonadError(..), runExcept) import Control.Monad.State  (MonadState(..), runStateT, get, put)-import Control.Monad.Trans.Free.Church+import Control.Monad.Free.Church import Control.Lens import Data.ByteString      (ByteString) import Data.Maybe           (isJust)@@ -93,15 +93,16 @@     ss'  = mixHash (ho ^. hoPrologue) ss     ss'' = maybe ss' (`mixPSK` ss') $ ho ^. hoPreSharedKey -runHandshake :: (Cipher c, Hash h)+runHandshake :: (MonadThrow m, Cipher c, Hash h)              => ScrubbedBytes              -> NoiseState c d h-             -> Either NoiseException (ScrubbedBytes, NoiseState c d h)-runHandshake msg ns = runExcept $ do+             -> m (ScrubbedBytes, NoiseState c d h)+runHandshake msg ns = reThrow . runCatch $ do   ((res, ns''), hs') <- runStateT st $ ns ^. nsHandshakeState   return (res, ns'' & nsHandshakeState .~ hs')    where+    reThrow = either throwM return     st = do       x <- resume . runHandshake' . (ns ^. nsHandshakeSuspension) $ msg       case x of@@ -130,8 +131,8 @@    where     hs        = handshakeState ho :: HandshakeState c d h-    coroutine = iterM evalPattern $ hoistFT (return . runIdentity) (ho ^. hoPattern . hpActions)-    (suspension, hs'') = case runExcept (runStateT (resume (runHandshake' coroutine)) hs) of+    coroutine = iterM evalPattern $ ho ^. hoPattern . hpActions+    (suspension, hs'') = case runCatch (runStateT (resume (runHandshake' coroutine)) hs) of             Left err -> error $ "handshake pattern interpreter threw exception: " <> show err             Right result -> case result of               (Left (Request _ resp), hs') -> (Handshake . resp, hs')@@ -139,7 +140,7 @@  processPatternOp :: (Cipher c, DH d, Hash h)                  => HandshakeRole-                 -> FT TokenF Identity ()+                 -> F TokenF ()                  -> Handshake c d h ()                  -> Handshake c d h () processPatternOp opRole t next = do@@ -149,19 +150,19 @@    if opRole == hs' ^. hsOpts . hoRole then do     put $ hs' & hsMsgBuffer .~ mempty-    iterM (evalMsgToken opRole) $ hoistFT (return . runIdentity) t+    iterM (evalMsgToken opRole) t      hs'' <- get      let enc = encryptAndHash (convert input) $ hs'' ^. hsSymmetricState -    (ep, ss) <- either throwError return enc+    (ep, ss) <- either throwM return enc      put $ hs'' & hsMsgBuffer      %~ (flip mappend . convert) ep                & hsSymmetricState .~ ss   else do     put $ hs' & hsMsgBuffer .~ input-    iterM (evalMsgToken opRole) $ hoistFT (return . runIdentity) t+    iterM (evalMsgToken opRole) t      hs'' <- get @@ -169,7 +170,7 @@         dec       = decryptAndHash (cipherBytesToText (convert remaining))                     $ hs'' ^. hsSymmetricState -    (dp, ss) <- either (const . throwError . HandshakeError $ "handshake payload failed to decrypt") return dec+    (dp, ss) <- either (const . throwM . HandshakeError $ "handshake payload failed to decrypt") return dec      put $ hs'' & hsMsgBuffer      .~ convert dp                & hsSymmetricState .~ ss@@ -180,11 +181,11 @@             => HandshakePatternF (Handshake c d h ())             -> Handshake c d h () evalPattern (PreInitiator t next) = do-  iterM (evalPreMsgToken InitiatorRole) $ hoistFT (return . runIdentity) t+  iterM (evalPreMsgToken InitiatorRole) t   next  evalPattern (PreResponder t next) = do-  iterM (evalPreMsgToken ResponderRole) $ hoistFT (return . runIdentity) t+  iterM (evalPreMsgToken ResponderRole) t   next  evalPattern (Initiator t next) = processPatternOp InitiatorRole t next@@ -215,7 +216,7 @@         ss''      = if ss ^. ssHasPSK then mixKey reBytes ss' else ss'         theirKey  = dhBytesToPub reBytes -    theirKey' <- maybe (throwError . HandshakeError $ "invalid remote ephemeral key") return theirKey+    theirKey' <- maybe (throwM . HandshakeError $ "invalid remote ephemeral key") return theirKey      put $ hs & hsOpts . hoRemoteEphemeral .~ Just theirKey'              & hsSymmetricState           .~ ss''@@ -231,13 +232,13 @@     let ss  = hs ^. hsSymmetricState         enc = encryptAndHash (convert pk) ss -    (ct, ss') <- either throwError return enc+    (ct, ss') <- either throwM return enc      put $ hs & hsSymmetricState .~ ss'              & hsMsgBuffer      %~ (flip mappend . convert) ct   else     if isJust (hs ^. hsOpts ^. hoRemoteStatic)-      then throwError . InvalidHandshakeOptions $ "unable to overwrite remote static key"+      then throwM . InvalidHandshakeOptions $ "unable to overwrite remote static key"       else do         let hasKey    = hs ^. hsSymmetricState . ssHasKey             len       = dhLength (Proxy :: Proxy d)@@ -248,8 +249,8 @@             ss        = hs ^. hsSymmetricState             dec       = decryptAndHash ct ss -        (pt, ss')     <- either (const . throwError . HandshakeError $ "failed to decrypt remote static key") return dec-        theirKey'     <- maybe (throwError . HandshakeError $ "invalid remote static key provided") return $ dhBytesToPub pt+        (pt, ss')     <- either (const . throwM . HandshakeError $ "failed to decrypt remote static key") return dec+        theirKey'     <- maybe (throwM . HandshakeError $ "invalid remote static key provided") return $ dhBytesToPub pt          put $ hs & hsOpts . hoRemoteStatic .~ Just theirKey'                  & hsSymmetricState        .~ ss'@@ -354,36 +355,36 @@  getLocalStatic :: HandshakeState c d h                -> Handshake c d h (KeyPair d)-getLocalStatic hs = maybe (throwError (InvalidHandshakeOptions "local static key not set"))+getLocalStatic hs = maybe (throwM (InvalidHandshakeOptions "local static key not set"))                           return                           (hs ^. hsOpts ^. hoLocalStatic)  getLocalSemiEphemeral :: HandshakeState c d h                       -> Handshake c d h (KeyPair d)-getLocalSemiEphemeral hs = maybe (throwError (InvalidHandshakeOptions "local semi-ephemeral key not set"))+getLocalSemiEphemeral hs = maybe (throwM (InvalidHandshakeOptions "local semi-ephemeral key not set"))                                  return                                  (hs ^. hsOpts ^. hoLocalSemiEphemeral)  getLocalEphemeral :: HandshakeState c d h                   -> Handshake c d h (KeyPair d)-getLocalEphemeral hs = maybe (throwError (InvalidHandshakeOptions "local ephemeral key not set"))+getLocalEphemeral hs = maybe (throwM (InvalidHandshakeOptions "local ephemeral key not set"))                              return                              (hs ^. hsOpts ^. hoLocalEphemeral)  getRemoteStatic :: HandshakeState c d h                 -> Handshake c d h (PublicKey d)-getRemoteStatic hs = maybe (throwError (InvalidHandshakeOptions "remote static key not set"))+getRemoteStatic hs = maybe (throwM (InvalidHandshakeOptions "remote static key not set"))                            return                            (hs ^. hsOpts ^. hoRemoteStatic)  getRemoteSemiEphemeral :: HandshakeState c d h                        -> Handshake c d h (PublicKey d)-getRemoteSemiEphemeral hs = maybe (throwError (InvalidHandshakeOptions "remote semi-ephemeral key not set"))+getRemoteSemiEphemeral hs = maybe (throwM (InvalidHandshakeOptions "remote semi-ephemeral key not set"))                                   return                                   (hs ^. hsOpts ^. hoRemoteSemiEphemeral)  getRemoteEphemeral :: HandshakeState c d h                    -> Handshake c d h (PublicKey d)-getRemoteEphemeral hs = maybe (throwError (InvalidHandshakeOptions "remote ephemeral key not set"))+getRemoteEphemeral hs = maybe (throwM (InvalidHandshakeOptions "remote ephemeral key not set"))                               return                               (hs ^. hsOpts ^. hoRemoteEphemeral)

@@ -9,6 +9,8 @@  module Crypto.Noise.Internal.SymmetricState where +import Control.Arrow+import Control.Exception.Safe import Control.Lens import Data.ByteString (empty) import Data.Proxy@@ -17,7 +19,6 @@ import Crypto.Noise.Cipher import Crypto.Noise.Hash import Crypto.Noise.Internal.CipherState-import Crypto.Noise.Internal.Types import Data.ByteArray.Extend  data SymmetricState c h =@@ -71,29 +72,29 @@         -> SymmetricState c h mixHash d ss = ss & ssh %~ Right . hash . (`mappend` d) . sshBytes -encryptAndHash :: (Cipher c, Hash h)+encryptAndHash :: (MonadThrow m, Cipher c, Hash h)                => Plaintext                -> SymmetricState c h-               -> Either NoiseException (ScrubbedBytes, SymmetricState c h)+               -> m (ScrubbedBytes, SymmetricState c h) encryptAndHash pt ss-  | ss ^. ssHasKey = either Left (\(ct, cs') -> Right (cipherTextToBytes ct, kss ct cs')) enc-  | otherwise      = Right (pt, nkss)+  | ss ^. ssHasKey = mix . first toBytes <$> enc+  | otherwise      = return (pt, mixHash pt ss)   where-    enc       = encryptAndIncrement (sshBytes (ss ^. ssh)) pt (ss ^. ssCipher)-    kss ct cs = mixHash (cipherTextToBytes ct) ss & ssCipher .~ cs-    nkss      = mixHash pt ss+    enc          = encryptAndIncrement (sshBytes (ss ^. ssh)) pt (ss ^. ssCipher)+    mix (cb, cs) = (cb, mixHash cb ss & ssCipher .~ cs)+    toBytes      = arr cipherTextToBytes -decryptAndHash :: (Cipher c, Hash h)+decryptAndHash :: (MonadThrow m, Cipher c, Hash h)                => Ciphertext c                -> SymmetricState c h-               -> Either NoiseException (Plaintext, SymmetricState c h)+               -> m (Plaintext, SymmetricState c h) decryptAndHash ct ss-  | ss ^. ssHasKey = either Left (\(pt, cs') -> Right (pt, kss cs')) dec-  | otherwise      = Right (cipherTextToBytes ct, nkss)+  | ss ^. ssHasKey = second kss <$> dec+  | otherwise      = return (ct', mixHash ct' ss)   where-    dec    = decryptAndIncrement (sshBytes (ss ^. ssh)) ct (ss ^. ssCipher)-    kss cs = mixHash (cipherTextToBytes ct) ss & ssCipher .~ cs-    nkss   = mixHash (cipherTextToBytes ct) ss+    dec  = decryptAndIncrement (sshBytes (ss ^. ssh)) ct (ss ^. ssCipher)+    kss  = arr $ \cs -> mixHash ct' ss & ssCipher .~ cs+    ct'  = cipherTextToBytes ct  split :: (Cipher c, Hash h)       => SymmetricState c h

@@ -7,6 +7,8 @@  module Crypto.Noise.Internal.Types where +import Control.Exception.Safe+ -- | Represents the various exceptions which can be thrown. -- --   * 'InvalidHandshakeOptions' occurs when a key that is needed is missing, or@@ -31,3 +33,5 @@                     | HandshakeError String                     | MessageLimitReached String                     deriving Show++instance Exception NoiseException

@@ -3,6 +3,7 @@  import Control.Arrow import Control.Concurrent.Async (mapConcurrently)+import Control.Exception        (SomeException) import Control.Monad.State import Data.Aeson               (decode) import Data.ByteString          (ByteString)@@ -67,21 +68,19 @@               => NoiseState c d h               -> NoiseState c d h               -> Message-              -> (Either NoiseException (ByteString, ByteString, NoiseState c d h),-                  Either NoiseException (ByteString, ByteString, NoiseState c d h))+              -> (Either SomeException (ByteString, ByteString, NoiseState c d h),+                  Either SomeException (ByteString, ByteString, NoiseState c d h)) verifyMessage sendingState receivingState Message{..} = (sendResult, recvResult)   where-    payload        = fromMaybe "" mPayload-    writeMsg       = writeMessage sendingState payload-    readMsg        = readMessage receivingState mCiphertext-    convertPayload = either Left (\(p, s) -> Right (convert p, convert payload, s))-    convertCt      = either Left (\(p, s) -> Right (p, mCiphertext , s))-    sendResult     = convertCt writeMsg-    recvResult     = convertPayload readMsg+    payload            = fromMaybe "" mPayload+    convertSend (p, s) = (p, mCiphertext, s)+    convertRecv (c, s) = (convert c, convert payload, s)+    sendResult         = convertSend <$> writeMessage sendingState payload+    recvResult         = convertRecv <$> readMessage receivingState mCiphertext  verifyVector :: Vector-             -> [(Either NoiseException (ByteString, ByteString),-                  Either NoiseException (ByteString, ByteString))]+             -> [(Either SomeException (ByteString, ByteString),+                  Either SomeException (ByteString, ByteString))] verifyVector v@Vector{..} =   case (vCipher, vDH, vHash) of     (WrapCipherType c, WrapDHType d, WrapHashType h) ->@@ -112,7 +111,7 @@  printFailure :: Int              -> Bool-             -> Either NoiseException (ByteString, ByteString)+             -> Either SomeException (ByteString, ByteString)              -> IO () printFailure i payload mr =   case mr of