Generalize encrypted error messages to encoded SecretBoxes

messages/uniworx/de.msg

@@ -491,11 +491,12 @@ ErrorResponseBadMethod requestMethodText@Text: Ihr Browser kann auf mehrere vers
 
 ErrorResponseEncrypted: Um keine sensiblen Daten preiszugeben wurden nähere Details verschlüsselt. Wenn Sie eine Anfrage an den Support schicken fügen Sie bitte die unten aufgeführten verschlüsselten Daten mit an.
 ErrMsgCiphertext: Verschlüsselte Fehlermeldung
-ErrMsgCiphertextTooShort: Verschlüsselte Daten zu kurz um valide zu sein
+EncodedSecretBoxCiphertextTooShort: Verschlüsselte Daten zu kurz um valide zu sein
-ErrMsgInvalidBase64 base64Err@String: Verschlüsselte Daten nicht korrekt base64url-kodiert: #{base64Err}
+EncodedSecretBoxInvalidBase64 base64Err@String: Verschlüsselte Daten nicht korrekt base64url-kodiert: #{base64Err}
-ErrMsgCouldNotDecodeNonce: Konnte secretbox-nonce nicht dekodieren
+EncodedSecretBoxInvalidPadding: Verschlüsselte Daten sind nicht korrekt padded
-ErrMsgCouldNotOpenSecretbox: Konnte libsodium-secretbox nicht öffnen (Verschlüsselte Daten sind nicht authentisch)
+EncodedSecretBoxCouldNotDecodeNonce: Konnte secretbox-nonce nicht dekodieren
-ErrMsgCouldNotDecodePlaintext utf8Err@Text: Konnte Klartext nicht UTF8-dekodieren: #{utf8Err}
+EncodedSecretBoxCouldNotOpenSecretBox: Konnte libsodium-secretbox nicht öffnen (Verschlüsselte Daten sind nicht authentisch)
+EncodedSecretBoxCouldNotDecodePlaintext aesonErr@String: Konnte Klartext nicht JSON-dekodieren: #{aesonErr}
 ErrMsgHeading: Fehlermeldung entschlüsseln
 ErrorCryptoIdMismatch: Verschlüsselte Id der Abgabe passte nicht zu anderen Daten
 

package.yaml

@@ -110,6 +110,7 @@ dependencies:
   - monad-memo
   - xss-sanitize
   - text-metrics
+  - pkcs7
 
 other-extensions:
   - GeneralizedNewtypeDeriving

src/Application.hs

@@ -137,7 +137,7 @@ makeFoundation appSettings@AppSettings{..} = do
     -- logging function. To get out of this loop, we initially create a
     -- temporary foundation without a real connection pool, get a log function
     -- from there, and then create the real foundation.
-    let mkFoundation appConnPool appSmtpPool appCryptoIDKey appSessionKey appErrorMsgKey = UniWorX {..}
+    let mkFoundation appConnPool appSmtpPool appCryptoIDKey appSessionKey appSecretBoxKey = UniWorX {..}
         -- The UniWorX {..} syntax is an example of record wild cards. For more
         -- information, see:
         -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
@@ -146,7 +146,7 @@ makeFoundation appSettings@AppSettings{..} = do
           (error "smtpPool forced in tempFoundation")
           (error "cryptoIDKey forced in tempFoundation")
           (error "sessionKey forced in tempFoundation")
-          (error "errorMsgKey forced in tempFoundation")
+          (error "secretBoxKey forced in tempFoundation")
         logFunc loc src lvl str = do
           f <- messageLoggerSource tempFoundation <$> readTVarIO (snd appLogger)
           f loc src lvl str
@@ -166,9 +166,9 @@ makeFoundation appSettings@AppSettings{..} = do
       migrateAll `runSqlPool` sqlPool
       appCryptoIDKey <- clusterSetting (Proxy :: Proxy 'ClusterCryptoIDKey) `runSqlPool` sqlPool
       appSessionKey <- clusterSetting (Proxy :: Proxy 'ClusterClientSessionKey) `runSqlPool` sqlPool
-      appErrorMsgKey <- clusterSetting (Proxy :: Proxy 'ClusterErrorMessageKey) `runSqlPool` sqlPool
+      appSecretBoxKey <- clusterSetting (Proxy :: Proxy 'ClusterSecretBoxKey) `runSqlPool` sqlPool
 
-      let foundation = mkFoundation sqlPool smtpPool appCryptoIDKey appSessionKey appErrorMsgKey
+      let foundation = mkFoundation sqlPool smtpPool appCryptoIDKey appSessionKey appSecretBoxKey
 
       handleJobs foundation
 

src/Foundation.hs

@@ -66,8 +66,6 @@ import Utils.Lens
 import Utils.Form
 import Utils.SystemMessage
 
-import Data.Aeson hiding (Error, Success)
-
 import Text.Shakespeare.Text (st)
 
 import Yesod.Form.I18n.German
@@ -76,7 +74,6 @@ import qualified Yesod.Auth.Message as Auth
 import qualified Data.Conduit.List as C
 
 import qualified Crypto.Saltine.Core.SecretBox as SecretBox
-import qualified Crypto.Saltine.Class as Saltine
 
 
 instance DisplayAble b => DisplayAble (E.CryptoID a b) where
@@ -99,19 +96,19 @@ instance DisplayAble SchoolId where
 -- starts running, such as database connections. Every handler will have
 -- access to the data present here.
 data UniWorX = UniWorX
-    { appSettings    :: AppSettings
+    { appSettings     :: AppSettings
-    , appStatic      :: Static -- ^ Settings for static file serving.
+    , appStatic       :: Static -- ^ Settings for static file serving.
-    , appConnPool    :: ConnectionPool -- ^ Database connection pool.
+    , appConnPool     :: ConnectionPool -- ^ Database connection pool.
-    , appSmtpPool    :: Maybe SMTPPool
+    , appSmtpPool     :: Maybe SMTPPool
-    , appHttpManager :: Manager
+    , appHttpManager  :: Manager
-    , appLogger      :: (ReleaseKey, TVar Logger)
+    , appLogger       :: (ReleaseKey, TVar Logger)
-    , appLogSettings :: TVar LogSettings
+    , appLogSettings  :: TVar LogSettings
-    , appCryptoIDKey :: CryptoIDKey
+    , appCryptoIDKey  :: CryptoIDKey
-    , appInstanceID  :: InstanceId
+    , appInstanceID   :: InstanceId
-    , appJobCtl      :: TVar (Map ThreadId (TMChan JobCtl))
+    , appJobCtl       :: TVar (Map ThreadId (TMChan JobCtl))
-    , appCronThread  :: TMVar (ReleaseKey, ThreadId)
+    , appCronThread   :: TMVar (ReleaseKey, ThreadId)
-    , appErrorMsgKey :: SecretBox.Key
+    , appSessionKey   :: ClientSession.Key
-    , appSessionKey  :: ClientSession.Key
+    , appSecretBoxKey :: SecretBox.Key
     }
 
 type SMTPPool = Pool SMTPConnection
@@ -201,6 +198,7 @@ embedRenderMessage ''UniWorX ''RatingException id
 embedRenderMessage ''UniWorX ''SheetGrading ("SheetGrading" <>)
 embedRenderMessage ''UniWorX ''AuthTag $ ("AuthTag" <>) . concat . drop 1 . splitCamel
 embedRenderMessage ''UniWorX ''SheetSubmissionMode ("Sheet" <>)
+embedRenderMessage ''UniWorX ''EncodedSecretBoxException id
 
 newtype SheetTypeHeader = SheetTypeHeader SheetType
 embedRenderMessageVariant ''UniWorX ''SheetTypeHeader ("SheetType" <>)
@@ -681,15 +679,12 @@ instance Yesod UniWorX where
           if
             | shouldEncrypt
             , not canDecrypt -> do
-                errKey <- getsYesod appErrorMsgKey
+                ciphertext <- encodedSecretBox SecretBoxPretty plaintextJson
-                nonce <- liftIO SecretBox.newNonce
+
-                let ciphertext = SecretBox.secretbox errKey nonce . Lazy.ByteString.toStrict $ encode plaintextJson
-                    encoded = decodeUtf8 . Base64.encode $ Saltine.encode nonce <> ciphertext
-                    formatted = Text.intercalate "\n" $ Text.chunksOf 76 encoded
                 [whamlet|
                   <p>_{MsgErrorResponseEncrypted}
                   <pre .errMsg>
-                    #{formatted}
+                    #{ciphertext}
                 |]
             | otherwise -> plaintext
 
@@ -1722,6 +1717,9 @@ instance (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => MonadCrypto
   type MonadCryptoKey m = CryptoIDKey
   cryptoIDKey f = getsYesod appCryptoIDKey >>= f
 
+instance {-# OVERLAPPING #-} (Monad m, MonadHandler m, HandlerSite m ~ UniWorX) => MonadSecretBox m where
+  secretBoxKey = getsYesod appSecretBoxKey
+
 -- Note: Some functionality previously present in the scaffolding has been
 -- moved to documentation in the Wiki. Following are some hopefully helpful
 -- links:

src/Handler/Admin.hs

@@ -4,16 +4,7 @@ import Import
 import Handler.Utils
 import Jobs
 
-import qualified Data.ByteString as BS
+import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
-
-import qualified Crypto.Saltine.Internal.ByteSizes as Saltine
-import qualified Data.ByteString.Base64.URL as Base64
-import Crypto.Saltine.Core.SecretBox (secretboxOpen)
-import qualified Crypto.Saltine.Class as Saltine
-
-import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Text
-import Data.Char (isSpace)
 
 import Control.Monad.Trans.Except
 
@@ -110,31 +101,17 @@ getAdminUserR uuid = do
 getAdminErrMsgR, postAdminErrMsgR :: Handler Html
 getAdminErrMsgR = postAdminErrMsgR
 postAdminErrMsgR = do
-  errKey <- getsYesod appErrorMsgKey
-  
   ((ctResult, ctView), ctEncoding) <- runFormPost . renderAForm FormStandard $
         (unTextarea <$> areq textareaField (fslpI MsgErrMsgCiphertext "Ciphertext") Nothing)
     <*  submitButton
 
-  plaintext <- formResultMaybe ctResult $ \(encodeUtf8 . Text.filter (not . isSpace) -> inputBS) ->
+  plaintext <- formResultMaybe ctResult $ exceptT (\err -> Nothing <$ addMessageI Error err) (return . Just) . (encodedSecretBoxOpen :: Text -> ExceptT EncodedSecretBoxException Handler Value)
-    exceptT (\err -> Nothing <$ addMessageI Error err) (return . Just) $ do
-      ciphertext <- either (throwE . MsgErrMsgInvalidBase64) return $ Base64.decode inputBS
-
-      unless (BS.length ciphertext >= Saltine.secretBoxNonce + Saltine.secretBoxMac) $
-        throwE MsgErrMsgCiphertextTooShort
-      let (nonceBS, secretbox) = BS.splitAt Saltine.secretBoxNonce ciphertext
-
-      nonce <- maybe (throwE MsgErrMsgCouldNotDecodeNonce) return $ Saltine.decode nonceBS
-
-      plainBS <- maybe (throwE MsgErrMsgCouldNotOpenSecretbox) return $ secretboxOpen errKey nonce secretbox
-
-      either (throwE . MsgErrMsgCouldNotDecodePlaintext . tshow) return $ Text.decodeUtf8' plainBS
 
   defaultLayout
     [whamlet|
       $maybe t <- plaintext
         <pre style="white-space:pre-wrap; font-family:monospace">
-          #{t}
+          #{encodePrettyToTextBuilder t}
 
       <form action=@{AdminErrMsgR} method=post enctype=#{ctEncoding}>
         ^{ctView}

src/Handler/Utils.hs

@@ -69,4 +69,3 @@ warnTermDays tid times = do
   forM_ warnholidays  $ warnI MsgDayIsAHoliday
   forM_ outoflecture  $ warnI MsgDayIsOutOfLecture
   forM_ outoftermdays $ warnI MsgDayIsOutOfTerm
-

src/Handler/Utils/Table/Pagination.hs

@@ -240,7 +240,9 @@ class (MonadHandler m, Monoid x, Monoid (DBCell m x)) => IsDBTable (m :: * -> *)
   dbCell :: Iso' (DBCell m x) ([(Text, Text)], WriterT x m Widget)
     
   -- dbWidget :: Proxy m -> Proxy x -> Iso' (DBResult m x) (Widget, DBResult' m x)
+  -- | Format @DBTable@ when sort-circuiting
   dbWidget   :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> DBResult m x -> m' Widget
+  -- | Format @DBTable@ when not short-circuiting
   dbHandler  :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> (Widget -> Widget) -> DBResult m x -> m' (DBResult m x)
   runDBTable :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => m (x, Widget) -> ReaderT SqlBackend m' (DBResult m x)
 
@@ -368,16 +370,17 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = (toPathPiece -> dbtIdent), d
       FormFailure errs'      -> first (map SomeMessage errs' <>) $ runPSValidator dbtable Nothing
       _                      -> runPSValidator dbtable Nothing
     psSorting' = map (first (dbtSorting !)) psSorting
-    sqlQuery' = E.from $ \t -> dbtSQLQuery t
-      <* E.orderBy (map (sqlSortDirection t) psSorting')
-      <* E.limit psLimit
-      <* E.offset (psPage * psLimit)
-      <* Map.foldrWithKey (\key args expr -> E.where_ (filterColumn (dbtFilter ! key) args t) >> expr) (return ()) psFilter
 
   mapM_ (addMessageI Warning) errs
 
   runDB $ do
-    rows' <- E.select $ (,) <$> pure (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64)) <*> sqlQuery'
+    rows' <- E.select . E.from $ \t -> do
+      res <- dbtSQLQuery t
+      E.orderBy (map (sqlSortDirection t) psSorting')
+      E.limit psLimit
+      E.offset (psPage * psLimit)
+      Map.foldrWithKey (\key args expr -> E.where_ (filterColumn (dbtFilter ! key) args t) >> expr) (return ()) psFilter
+      return (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64), res)
 
     let mapMaybeM f = fmap catMaybes . mapM (runMaybeT . f)
   

src/Model/Migration.hs

@@ -193,6 +193,12 @@ customMigrations = Map.fromListWith (>>)
         sheets <- [sqlQQ| SELECT "id", "type" FROM "sheet"; |]
         forM_ sheets $ \(sid, Single lsty) -> update sid [SheetType =. Legacy.sheetType lsty]                
     )
+  , ( AppliedMigrationKey [migrationVersion|6.0.0|] [version|7.0.0|]
+    , whenM (tableExists "cluster_config") $
+        [executeQQ|
+           UPDATE "cluster_config" SET "setting" = 'secret-box-key' WHERE "setting" = 'error-message-key';
+        |]
+    )
   ]
 
 

src/Settings/Cluster.hs

@@ -36,7 +36,7 @@ import qualified Data.ByteString.Base64.URL as Base64
 data ClusterSettingsKey
   = ClusterCryptoIDKey
   | ClusterClientSessionKey
-  | ClusterErrorMessageKey
+  | ClusterSecretBoxKey
   deriving (Eq, Ord, Enum, Bounded, Show, Read)
 
 instance Universe ClusterSettingsKey
@@ -108,10 +108,10 @@ instance FromJSON ClientSession.Key where
     either fail return $ Serialize.decode bytes
 
 
-instance ClusterSetting 'ClusterErrorMessageKey where
+instance ClusterSetting 'ClusterSecretBoxKey where
-  type ClusterSettingValue 'ClusterErrorMessageKey = SecretBox.Key
+  type ClusterSettingValue 'ClusterSecretBoxKey = SecretBox.Key
   initClusterSetting _ = liftIO SecretBox.newKey
-  knownClusterSetting _ = ClusterErrorMessageKey
+  knownClusterSetting _ = ClusterSecretBoxKey
 
 instance ToJSON SecretBox.Key where
   toJSON = Aeson.String . decodeUtf8 . Base64.encode . Saltine.encode

src/Utils.hs

@@ -14,7 +14,9 @@ import Data.Monoid (Sum(..))
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text as Text
 
 import Utils.DB as Utils
 import Utils.TH as Utils
@@ -27,7 +29,7 @@ import Control.Lens as Utils (none)
 
 import Text.Blaze (Markup, ToMarkup)
 
-import Data.Char (isDigit)
+import Data.Char (isDigit, isSpace)
 import Data.Text (dropWhileEnd, takeWhileEnd, justifyRight)
 import Numeric (showFFloat)
 
@@ -39,8 +41,9 @@ import qualified Data.Map as Map
 -- import qualified Data.List as List
 
 import Control.Monad.Trans.Except (ExceptT(..), throwE, runExceptT)
+import Control.Monad.Except (MonadError(..))
 import Control.Monad.Trans.Maybe (MaybeT(..))
-import Control.Monad.Catch
+import Control.Monad.Catch hiding (throwM)
 
 
 import qualified Database.Esqueleto as E (Value, unValue)
@@ -54,6 +57,12 @@ import qualified Data.Aeson as Aeson
 
 import Data.Universe
 
+import qualified Crypto.Saltine.Internal.ByteSizes as Saltine
+import qualified Data.ByteString.Base64.URL as Base64
+import qualified Crypto.Saltine.Core.SecretBox as SecretBox
+import qualified Crypto.Saltine.Class as Saltine
+import qualified Crypto.Data.PKCS7 as PKCS7
+
 
 
 -----------
@@ -391,6 +400,10 @@ exceptT f g = either f g <=< runExceptT
 catchIfMExceptT :: (MonadCatch m, Exception e) => (e -> m e') -> (e -> Bool) -> m a -> ExceptT e' m a
 catchIfMExceptT err p act = catchIf p (lift act) (throwE <=< lift . err)
 
+throwExceptT :: ( Exception e, MonadThrow m )
+             => ExceptT e m a -> m a
+throwExceptT = exceptT throwM return
+
 
 
 ------------
@@ -512,3 +525,89 @@ lookupCustomHeader ident = (>>= fromPathPiece . decodeUtf8) <$> lookupHeader (CI
 
 hasCustomHeader :: MonadHandler m => CustomHeader -> m Bool
 hasCustomHeader ident = isJust <$> lookupHeader (CI.mk . encodeUtf8 $ toPathPiece ident)
+
+------------------
+-- Cryptography --
+------------------
+
+data SecretBoxEncoding = SecretBoxShort | SecretBoxPretty
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+
+instance Universe SecretBoxEncoding
+instance Finite SecretBoxEncoding
+instance Default SecretBoxEncoding where
+  def = SecretBoxShort
+
+encodedSecretBoxBlocksize :: Word8
+-- | `encodedSecretBox'` tries to hide plaintext length by ensuring the message
+--   length (before addition of HMAC and nonce) is always a multiple of
+--   `encodedSecretBlocksize`.
+--   Bigger blocksizes hide exact message length better but lead to longer messages
+encodedSecretBoxBlocksize = maxBound
+
+
+encodedSecretBox' :: ( ToJSON a, MonadIO m )
+                  => SecretBox.Key
+                  -> SecretBoxEncoding
+                  -> a -> m Text
+encodedSecretBox' sKey pretty val = liftIO $ do
+  nonce <- SecretBox.newNonce
+  let
+    encrypt = SecretBox.secretbox sKey nonce
+    base64 = decodeUtf8 . Base64.encode
+    pad = PKCS7.padBytesN (fromIntegral encodedSecretBoxBlocksize)
+    attachNonce = mappend $ Saltine.encode nonce
+    chunk
+      | SecretBoxPretty <- pretty = Text.intercalate "\n" . Text.chunksOf 76
+      | otherwise                 = id
+
+  return . chunk . base64 . attachNonce . encrypt . pad . toStrict $ Aeson.encode val
+
+data EncodedSecretBoxException
+  = EncodedSecretBoxInvalidBase64 !String
+  | EncodedSecretBoxInvalidPadding
+  | EncodedSecretBoxCiphertextTooShort
+  | EncodedSecretBoxCouldNotDecodeNonce
+  | EncodedSecretBoxCouldNotOpenSecretBox
+  | EncodedSecretBoxCouldNotDecodePlaintext !String
+  deriving (Eq, Ord, Show, Read, Generic, Typeable)
+instance Exception EncodedSecretBoxException
+
+encodedSecretBoxOpen' :: (FromJSON a, MonadError EncodedSecretBoxException m)
+                      => SecretBox.Key
+                      -> Text -> m a
+encodedSecretBoxOpen' sKey chunked = do
+  let unchunked = Text.filter (not . isSpace) chunked
+  decoded <- either (throwError . EncodedSecretBoxInvalidBase64) return . Base64.decode $ encodeUtf8 unchunked
+
+  unless (BS.length decoded >= Saltine.secretBoxNonce + Saltine.secretBoxMac) $
+    throwError EncodedSecretBoxCiphertextTooShort
+  let (nonceBS, encrypted) = BS.splitAt Saltine.secretBoxNonce decoded
+  nonce <- maybe (throwError EncodedSecretBoxCouldNotDecodeNonce) return $ Saltine.decode nonceBS
+  padded <- maybe (throwError EncodedSecretBoxCouldNotOpenSecretBox) return $ SecretBox.secretboxOpen sKey nonce encrypted
+
+  unpadded <- maybe (throwError EncodedSecretBoxInvalidPadding) return $ PKCS7.unpadBytesN (fromIntegral encodedSecretBoxBlocksize) padded
+
+  either (throwError . EncodedSecretBoxCouldNotDecodePlaintext) return $ Aeson.eitherDecodeStrict' unpadded
+
+class Monad m => MonadSecretBox m where
+  secretBoxKey :: m SecretBox.Key
+
+instance MonadSecretBox ((->) SecretBox.Key) where
+  secretBoxKey = id
+
+instance Monad m => MonadSecretBox (ReaderT SecretBox.Key m) where
+  secretBoxKey = ask
+
+encodedSecretBox :: ( ToJSON a, MonadSecretBox m, MonadIO m )
+                 => SecretBoxEncoding
+                 -> a -> m Text
+encodedSecretBox pretty val = do
+  sKey <- secretBoxKey
+  encodedSecretBox' sKey pretty val
+
+encodedSecretBoxOpen :: ( FromJSON a, MonadError EncodedSecretBoxException m, MonadSecretBox m )
+                     => Text -> m a
+encodedSecretBoxOpen ciphertext = do
+  sKey <- secretBoxKey
+  encodedSecretBoxOpen' sKey ciphertext

stack.yaml

@@ -40,4 +40,6 @@ extra-deps:
 
   - hlint-test-0.1.0.0
 
+  - pkcs7-1.0.0.1
+
 resolver: lts-10.5

test/UtilsSpec.hs

@@ -0,0 +1,39 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module UtilsSpec where
+
+import TestImport
+import Utils
+
+import qualified Crypto.Saltine.Core.SecretBox as SecretBox
+import Data.Aeson
+
+instance Arbitrary Value where
+  arbitrary = sized $ \size -> if
+    | size <= 0 -> oneof [pure Null, bool', number, string]
+    | otherwise -> resize (size `div` 2) $ oneof [pure Null, bool', number, string, array, object']
+    where
+      bool' = Bool <$> arbitrary
+      number = Number <$> arbitrary
+      string = String <$> arbitrary
+      array = Array <$> arbitrary
+      object' = Object <$> arbitrary
+  shrink = genericShrink
+
+instance Arbitrary SecretBoxEncoding where
+  arbitrary = arbitraryBoundedEnum
+
+spec :: Spec
+spec = do
+  describe "encodedSecretBox" $ do
+    it "has comptabile encryption/decryption" . property $
+      \val pretty -> ioProperty $ do
+        sKey <- SecretBox.newKey
+        ciphertext <- encodedSecretBox' sKey pretty (val :: Value)
+        plaintext <- throwExceptT $ encodedSecretBoxOpen' sKey ciphertext
+        return $ plaintext == val
+    it "produces pretty ciphertext" . property $
+      \val -> ioProperty $ do
+        sKey <- SecretBox.newKey
+        ciphertext <- encodedSecretBox' sKey SecretBoxPretty (val :: Value)
+        return . all ((<= 76) . length) $ lines ciphertext