Complete runtime resilience and audit controls

src/Nuthatch/App.hs

@@ -16,11 +16,13 @@ module Nuthatch.App
 import           Control.Concurrent (threadDelay)
 import           Control.Concurrent.Async (mapConcurrently_)
 import           Control.Exception
-  ( SomeException
+  ( IOException
+  , SomeException
+  , fromException
   , throwIO
-  , try
+  , tryJust
   )
-import           Control.Monad (forM, forever, when)
+import           Control.Monad (forM, forM_, forever, when)
 import           Control.Monad.IO.Class (liftIO)
 import           Control.Retry
   ( retrying )
@@ -35,7 +37,7 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import qualified Data.Text.IO as TIO
 import           Data.Word (Word64)
-import           Database.PostgreSQL.Simple (Only (..))
+import           Database.PostgreSQL.Simple (Only (..), SqlError)
 import           GHC.Clock (getMonotonicTimeNSec)
 import           Network.HTTP.Types
   ( hContentType
@@ -51,7 +53,7 @@ import           Network.HTTP.Types
 import qualified Network.HTTP.Types.URI as URI
 import           Network.Wai (Request (..), responseFile, responseLBS)
 import           Nuthatch.Api
-import           Nuthatch.Audit (audit)
+import           Nuthatch.Audit (audit, objectKeyFields)
 import           Nuthatch.Config (Config (..))
 import           Nuthatch.Db (Db, ensurePersonalPool, withTransaction)
 import qualified Nuthatch.Db as Db
@@ -60,6 +62,7 @@ import           Nuthatch.Paths
 import           Nuthatch.Protocol
 import           Nuthatch.Redis
   ( Redis
+  , cacheGeneration
   , cacheGet
   , cacheInvalidatePrefixes
   , cacheSet
@@ -68,6 +71,7 @@ import           Nuthatch.Redis
   )
 import           Nuthatch.Recovery
   ( recoveryRetryPolicy
+  , trySynchronous
   )
 import           Nuthatch.S3
   ( ListPage (..)
@@ -242,10 +246,20 @@ authenticationHandler cfg = mkAuthHandler $ \request -> do
   let cookies = requestCookies request
       sessionName = TE.encodeUtf8 (cfgCookieName cfg)
       csrfName = TE.encodeUtf8 (cfgCsrfCookieName cfg)
-  token <- maybe (throwError loginRequired) pure (lookup sessionName cookies)
+  token <- case lookup sessionName cookies of
+    Nothing -> do
+      liftIO $ audit "authentication" "rejected" Nothing
+        [("reason", A.String "missing_session")]
+      throwError loginRequired
+    Just value -> pure value
   sessionToken <- parseCookieValue validateSessionToken token
   verified <- liftIO (verifySession cfg sessionToken)
-  user <- either (const (throwError loginRequired)) pure verified
+  user <- case verified of
+    Left _ -> do
+      liftIO $ audit "authentication" "rejected" Nothing
+        [("reason", A.String "invalid_session")]
+      throwError loginRequired
+    Right value -> pure value
   csrf <- traverse
     (parseCookieValue validateCsrfToken)
     (lookup csrfName cookies)
@@ -260,17 +274,19 @@ authenticationHandler cfg = mkAuthHandler $ \request -> do
       }
     parseCookieValue validate bytes =
       case TE.decodeUtf8' bytes of
-        Left _ -> throwOperationError err400 MalformedAuthentication
+        Left _ -> rejectMalformed
         Right value ->
-          either
-            (const (throwOperationError err400 MalformedAuthentication))
-            pure
-            (validate value)
+          either (const rejectMalformed) pure (validate value)
+    rejectMalformed = do
+      liftIO $ audit "authentication" "rejected" Nothing
+        [("reason", A.String "malformed_credential")]
+      throwOperationError err400 MalformedAuthentication
 
 handleReady :: Env -> Handler ReadyResponse
 handleReady env = do
   pg <- liftIO $
-    try (Db.query_ (envDb env) "SELECT 1") :: Handler (Either SomeException [Only Int])
+    trySynchronous (Db.query_ (envDb env) "SELECT 1")
+      :: Handler (Either SomeException [Only Int])
   case pg of
     Right _ -> pure (ReadyResponse True)
     Left _ -> throwOperationError err503 ReadyDependencyUnavailable
@@ -281,10 +297,13 @@ handleLoginRequest
 handleLoginRequest env = do
   let cfg = envConfig env
   authorizationResult <- liftIO (beginAuthorization cfg)
-  authorization <- either
-    (const (throwOperationError err502 OidcAuthorizationFailed))
-    pure
-    authorizationResult
+  authorization <- case authorizationResult of
+    Left _ -> do
+      liftIO $ audit "login_start" "rejected" Nothing
+        [("reason", A.String "provider_unavailable")]
+      throwOperationError err502 OidcAuthorizationFailed
+    Right value -> pure value
+  liftIO $ audit "login_start" "ok" Nothing []
   pure $
     addHeader
       (cookieValue
@@ -304,10 +323,12 @@ handleOidcCallback env code state cookieHeader = do
   let cfg = envConfig env
       cookies = parseCookies (TE.encodeUtf8 cookieHeader)
       transactionName = TE.encodeUtf8 (cfgOidcTransactionCookieName cfg)
-  transaction <- maybe
-    (throwOperationError err400 OidcCallbackRejected)
-    (parseCookieValueText OidcCallbackRejected)
-    (lookup transactionName cookies)
+  transactionBytes <- case lookup transactionName cookies of
+    Nothing -> rejectCallback "missing_transaction"
+    Just value -> pure value
+  transaction <- case TE.decodeUtf8' transactionBytes of
+    Right value | not (T.null value) && T.length value <= 8192 -> pure value
+    _ -> rejectCallback "malformed_transaction"
   identityResult <- liftIO (redeemAuthorizationCode cfg transaction state code)
   identity <- case identityResult of
     Left reason -> do
@@ -323,12 +344,21 @@ handleOidcCallback env code state cookieHeader = do
       (identitySubject identity)
       (identityDisplay identity)
   token <- either
-    (const (throwOperationError err500 (SessionCreationFailed "session creation failed")))
+    (\_ -> do
+      liftIO $ audit "login" "rejected" (Just (unUserId uid))
+        [("reason", A.String "session_creation_failed")]
+      throwOperationError err500
+        (SessionCreationFailed "session creation failed"))
     pure
     tokenResult
   csrf <- liftIO newCsrfToken
   liftIO $ audit "login" "ok" (Just (unUserId uid)) []
   pure (loginResponse cfg token csrf)
+  where
+    rejectCallback reason = do
+      liftIO $ audit "login" "rejected" Nothing
+        [("reason", A.String reason)]
+      throwOperationError err400 OidcCallbackRejected
 
 loginResponse :: Config -> SessionToken -> CsrfToken -> LoginSuccess
 loginResponse cfg token csrf =
@@ -346,8 +376,10 @@ handleLogoutRequest
   -> CsrfToken
   -> Handler LogoutSuccess
 handleLogoutRequest env session providedCsrf = do
-  requireCsrf LogoutCsrfRejected session providedCsrf
+  requireCsrf "logout" LogoutCsrfRejected session providedCsrf
   let cfg = envConfig env
+  liftIO $ audit "logout" "ok"
+    (Just (unUserId (suUserId (sessionUser session)))) []
   pure $
     addHeader (expiredCookieValue (cfgCookieName cfg) "/") $
       addHeader (expiredCookieValue (cfgCsrfCookieName cfg) "/") $
@@ -414,9 +446,9 @@ handleDownloadRequest env session root path requestedRange = do
   let inspect = inspectBandwidth env user
       body = getObjectSource (envS3 env) key (transferPieceSize env) inspect
   liftIO $ audit "download" "ok" (Just (unUserId (suUserId user)))
-    [ ("root", A.toJSON (rootLabel root))
-    , ("bytes", A.toJSON (oiSize info))
-    ]
+    ([ ("root", A.toJSON (rootLabel root))
+     , ("bytes", A.toJSON (oiSize info))
+     ] <> objectKeyAudit (envConfig env) path)
   let filename = basename path
   pure $
     addHeader (contentDisposition filename) $
@@ -436,24 +468,49 @@ handleUploadRequest
   -> SourceIO BS.ByteString
   -> Handler UploadResponse
 handleUploadRequest env session root path operation declaredSize contentIdentity providedCsrf bodySource = do
-  requireCsrf UploadCsrfRejected session providedCsrf
+  requireCsrf "put" UploadCsrfRejected session providedCsrf
   let user = sessionUser session
       size = unDeclaredSize declaredSize
       configuredMaximum = cfgMaxObjectBytes (envConfig env)
-  when (size > configuredMaximum) $
+  when (size > configuredMaximum) $ do
+    liftIO $ audit "put" "rejected" (Just (unUserId (suUserId user)))
+      ([ ("root", A.toJSON (rootLabel root))
+       , ("bytes", A.toJSON size)
+       , ("operation_id", A.toJSON (unOperationId operation))
+       , ("reason", A.String "object_too_large")
+       ] <> objectKeyAudit (envConfig env) path)
     throwOperationError err413 UploadTooLarge
-  requireUploadBandwidth env user size
-  outcome <- liftIO $
-    runPut env user root path operation size contentIdentity bodySource
-  result <- either
-    throwPutFailure
-    pure
-    outcome
+  requireUploadBandwidth env user root path operation size
+  putAttempt <- liftIO $
+    tryRecoveryDependency
+      (runPut env user root path operation size contentIdentity bodySource)
+  outcome <- case putAttempt of
+    Left _ -> do
+      liftIO $ audit "put" "failed" (Just (unUserId (suUserId user)))
+        ([ ("root", A.toJSON (rootLabel root))
+         , ("bytes", A.toJSON size)
+         , ("operation_id", A.toJSON (unOperationId operation))
+         , ("reason", A.String "database_unavailable")
+         ] <> objectKeyAudit (envConfig env) path)
+      throwOperationError err503
+        (UploadMutationRejected "database unavailable")
+    Right value -> pure value
+  result <- case outcome of
+    Left failure -> do
+      liftIO $ audit "put" "failed" (Just (unUserId (suUserId user)))
+        ([ ("root", A.toJSON (rootLabel root))
+         , ("bytes", A.toJSON size)
+         , ("operation_id", A.toJSON (unOperationId operation))
+         , ("reason", A.String (putFailureReason failure))
+         ] <> objectKeyAudit (envConfig env) path)
+      throwPutFailure failure
+    Right value -> pure value
   liftIO $ audit "put" (mutationAuditResult result) (Just (unUserId (suUserId user)))
-    [ ("root", A.toJSON (rootLabel root))
-    , ("bytes", A.toJSON size)
-    , ("operation_id", A.toJSON (unOperationId operation))
-    ]
+    ([ ("root", A.toJSON (rootLabel root))
+     , ("bytes", A.toJSON size)
+     , ("operation_id", A.toJSON (unOperationId operation))
+     ] <> mutationReasonFields result
+       <> objectKeyAudit (envConfig env) path)
   pure UploadResponse
     { uploadResponseOperationId = operation
     , uploadResponseResult = result
@@ -474,8 +531,15 @@ requireDownloadBandwidth env user size = do
     Right False -> throwOperationError err429 DownloadBandwidthExceeded
     Right True -> pure ()
 
-requireUploadBandwidth :: Env -> SessionUser -> Integer -> Handler ()
-requireUploadBandwidth env user size = do
+requireUploadBandwidth
+  :: Env
+  -> SessionUser
+  -> Root
+  -> RelativePath
+  -> OperationId
+  -> Integer
+  -> Handler ()
+requireUploadBandwidth env user root path operation size = do
   available <- liftIO $
     throttleCheck
       (envRedis env)
@@ -483,9 +547,19 @@ requireUploadBandwidth env user size = do
       (suUserId user)
       (min size (toInteger (transferPieceSize env)))
   case available of
-    Left _ -> throwOperationError err503 UploadThrottleUnavailable
-    Right False -> throwOperationError err429 UploadBandwidthExceeded
+    Left _ -> reject "throttle_unavailable" err503 UploadThrottleUnavailable
+    Right False ->
+      reject "bandwidth_exceeded" err429 UploadBandwidthExceeded
     Right True -> pure ()
+  where
+    reject reason status response = do
+      liftIO $ audit "put" "rejected" (Just (unUserId (suUserId user)))
+        ([ ("root", A.toJSON (rootLabel root))
+         , ("bytes", A.toJSON size)
+         , ("operation_id", A.toJSON (unOperationId operation))
+         , ("reason", A.String reason)
+         ] <> objectKeyAudit (envConfig env) path)
+      throwOperationError status response
 
 inspectBandwidth :: Env -> SessionUser -> BS.ByteString -> IO ()
 inspectBandwidth env user chunk = do
@@ -509,21 +583,40 @@ handleDeleteRequest
   -> DeleteRequest
   -> Handler DeleteResponse
 handleDeleteRequest env session request = do
-  requireCsrf DeleteCsrfRejected session (deleteCsrf request)
+  requireCsrf "delete" DeleteCsrfRejected session (deleteCsrf request)
   let user = sessionUser session
       operation = deleteOperationId request
       root = deleteRoot request
-  outcome <- liftIO $
-    runDelete env user root (deletePath request) operation
-  result <- either
-    (throwOperationError err409 . DeleteMutationRejected)
-    pure
-    outcome
+  deleteAttempt <- liftIO $
+    tryRecoveryDependency
+      (runDelete env user root (deletePath request) operation)
+  outcome <- case deleteAttempt of
+    Left _ -> do
+      liftIO $ audit "delete" "failed"
+        (Just (unUserId (suUserId user)))
+        ([ ("root", A.toJSON (rootLabel root))
+         , ("operation_id", A.toJSON (unOperationId operation))
+         , ("reason", A.String "database_unavailable")
+         ] <> objectKeyAudit (envConfig env) (deletePath request))
+      throwOperationError err503
+        (DeleteMutationRejected "database unavailable")
+    Right value -> pure value
+  result <- case outcome of
+    Left reason -> do
+      liftIO $ audit "delete" "failed"
+        (Just (unUserId (suUserId user)))
+        ([ ("root", A.toJSON (rootLabel root))
+         , ("operation_id", A.toJSON (unOperationId operation))
+         , ("reason", A.String "object_store_unavailable")
+         ] <> objectKeyAudit (envConfig env) (deletePath request))
+      throwOperationError err409 (DeleteMutationRejected reason)
+    Right value -> pure value
   liftIO $ audit "delete" (mutationAuditResult result)
     (Just (unUserId (suUserId user)))
-    [ ("root", A.toJSON (rootLabel root))
-    , ("operation_id", A.toJSON (unOperationId operation))
-    ]
+    ([ ("root", A.toJSON (rootLabel root))
+     , ("operation_id", A.toJSON (unOperationId operation))
+     ] <> mutationReasonFields result
+       <> objectKeyAudit (envConfig env) (deletePath request))
   pure DeleteResponse
     { deleteResponseOperationId = operation
     , deleteResponseResult = result
@@ -536,8 +629,13 @@ handleDeletePrefixRequest
   -> SessionContext
   -> DeletePrefixRequest
   -> Handler DeletePrefixResponse
-handleDeletePrefixRequest _env session request = do
-  requireCsrf DeletePrefixCsrfRejected session (deletePrefixCsrf request)
+handleDeletePrefixRequest env session request = do
+  requireCsrf "delete_prefix" DeletePrefixCsrfRejected session (deletePrefixCsrf request)
+  liftIO $ audit "delete_prefix" "rejected"
+    (Just (unUserId (suUserId (sessionUser session))))
+    ([ ("root", A.toJSON (rootLabel (deletePrefixRoot request)))
+     , ("reason", A.String "paged_delete_required")
+     ] <> objectKeyAudit (envConfig env) (deletePrefixPath request))
   throwOperationError err409
     (DeletePrefixMutationRejected
       "use delete-plan and delete-batch with client operation ids")
@@ -585,18 +683,41 @@ handleDeleteBatchRequest
   -> DeleteBatchRequest
   -> Handler DeleteBatchResponse
 handleDeleteBatchRequest env session request = do
-  requireCsrf DeletePrefixCsrfRejected session (deleteBatchCsrf request)
+  requireCsrf "delete_batch" DeletePrefixCsrfRejected session (deleteBatchCsrf request)
   let items = deleteBatchItems request
-  when (null items || length items > cfgDeletePageSize (envConfig env)) $
+  when (null items || length items > cfgDeletePageSize (envConfig env)) $ do
+    liftIO $ audit "delete_batch" "rejected"
+      (Just (unUserId (suUserId (sessionUser session))))
+      [ ("root", A.toJSON (rootLabel (deleteBatchRoot request)))
+      , ("reason", A.String "invalid_batch_size")
+      ]
     throwOperationError err409
       (DeletePrefixMutationRejected "delete batch size is invalid")
-  results <- liftIO $ forM items $ \item -> do
-    outcome <- runDelete
-      env
-      (sessionUser session)
-      (deleteBatchRoot request)
-      (deleteBatchPath item)
-      (deleteBatchOperationId item)
+  results <- forM items $ \item -> do
+    deleteAttempt <- liftIO $ tryRecoveryDependency $
+      runDelete
+        env
+        (sessionUser session)
+        (deleteBatchRoot request)
+        (deleteBatchPath item)
+        (deleteBatchOperationId item)
+    let outcome = case deleteAttempt of
+          Left _ -> Left "database unavailable"
+          Right value -> value
+        failureReason = case deleteAttempt of
+          Left _ -> "database_unavailable"
+          Right (Left _) -> "object_store_unavailable"
+          Right (Right _) -> ""
+    liftIO $ audit "delete" (either (const "failed") mutationAuditResult outcome)
+      (Just (unUserId (suUserId (sessionUser session))))
+      ([ ("root", A.toJSON (rootLabel (deleteBatchRoot request)))
+       , ("operation_id", A.toJSON
+          (unOperationId (deleteBatchOperationId item)))
+       ] <> either
+          (const [("reason", A.String failureReason)])
+          mutationReasonFields
+          outcome
+        <> objectKeyAudit (envConfig env) (deleteBatchPath item))
     pure $ case outcome of
       Left message -> DeleteItemResponse
         { deleteItemPath = deleteBatchPath item
@@ -612,11 +733,23 @@ handleDeleteBatchRequest env session request = do
         }
   pure (DeleteBatchResponse results)
 
-requireCsrf :: A.ToJSON error => error -> SessionContext -> CsrfToken -> Handler ()
-requireCsrf csrfError session provided =
+requireCsrf
+  :: A.ToJSON error
+  => Text
+  -> error
+  -> SessionContext
+  -> CsrfToken
+  -> Handler ()
+requireCsrf action csrfError session provided =
   case sessionCsrf session of
     Just expected | constantTimeEq expected provided -> pure ()
-    _ -> throwOperationError err403 csrfError
+    _ -> do
+      liftIO $ audit "authorization" "rejected"
+        (Just (unUserId (suUserId (sessionUser session))))
+        [ ("reason", A.String "csrf_rejected")
+        , ("operation", A.String action)
+        ]
+      throwOperationError err403 csrfError
 
 throwOperationError :: A.ToJSON error => ServerError -> error -> Handler a
 throwOperationError serverError operationError =
@@ -671,6 +804,34 @@ mutationAuditResult MutationFailed    = "failed"
 mutationAuditResult MutationRejected  = "rejected"
 mutationAuditResult MutationConflict  = "conflict"
 
+mutationReasonFields :: MutationResult -> [(Text, A.Value)]
+mutationReasonFields MutationSucceeded = []
+mutationReasonFields MutationPending =
+  [("reason", A.String "settlement_pending")]
+mutationReasonFields MutationFailed =
+  [("reason", A.String "store_effect_failed")]
+mutationReasonFields MutationRejected =
+  [("reason", A.String "admission_rejected")]
+mutationReasonFields MutationConflict =
+  [("reason", A.String "operation_conflict")]
+
+putFailureReason :: PutFailure -> Text
+putFailureReason (PutDispatchFailed (PutObjectStreamError streamError)) =
+  case streamError of
+    UploadStreamInvalid _ -> "invalid_body"
+    UploadStreamSizeMismatch -> "size_mismatch"
+    UploadStreamIdentityMismatch -> "content_identity_mismatch"
+putFailureReason (PutDispatchFailed (PutObjectBandwidthError bandwidthError)) =
+  case bandwidthError of
+    BandwidthUnavailable -> "throttle_unavailable"
+    BandwidthExceeded -> "bandwidth_exceeded"
+putFailureReason (PutDispatchFailed (PutObjectStoreError _)) =
+  "object_store_unavailable"
+
+objectKeyAudit :: Config -> RelativePath -> [(Text, A.Value)]
+objectKeyAudit cfg =
+  objectKeyFields (cfgAuditObjectKeys cfg) . unRelativePath
+
 contentDisposition :: Text -> Text
 contentDisposition filename =
   "attachment; filename=\"" <> fallback <> "\"; filename*=UTF-8''" <> encoded
@@ -866,9 +1027,13 @@ listEntries
   -> Maybe Text
   -> IO (Either Text ([ListEntry], Maybe Text))
 listEntries env user root prefix continuation = do
-  let cacheKey =
+  generation <- cacheGeneration (envRedis env) (suUserId user) root
+  let cacheOwner = case root of
+        Personal -> unUserId (suUserId user)
+        Shared   -> "shared"
+      cacheKey =
         "nuthatch:list:"
-          <> unUserId (suUserId user)
+          <> cacheOwner
           <> ":"
           <> rootLabel root
           <> ":"
@@ -876,6 +1041,7 @@ listEntries env user root prefix continuation = do
           <> ":"
           <> T.pack (show (cfgBrowsePageSize (envConfig env)))
           <> ":"
+          <> maybe "unavailable" TE.decodeUtf8 generation
       s3Prefix =
         case root of
           Personal -> "users/" <> unUserId (suUserId user) <> "/" <> prefixSlash
@@ -884,9 +1050,9 @@ listEntries env user root prefix continuation = do
         | T.null prefix = ""
         | T.isSuffixOf "/" prefix = prefix
         | otherwise = prefix <> "/"
-  cached <- case continuation of
-    Nothing -> cacheGet (envRedis env) cacheKey
-    Just _ -> pure Nothing
+  cached <- case (continuation, generation) of
+    (Nothing, Just _) -> cacheGet (envRedis env) cacheKey
+    _ -> pure Nothing
   case cached >>= A.decodeStrict of
     Just result -> pure (Right result)
     Nothing -> do
@@ -928,8 +1094,11 @@ listEntries env user root prefix continuation = do
                 ]
               entries = folders <> files
               result = (entries, lpContinuationToken lp)
-          when (continuation == Nothing) $
-            cacheSet (envRedis env) cacheKey (cfgListCacheTtlSec (envConfig env))
+          when (continuation == Nothing && generation /= Nothing) $
+            cacheSet
+              (envRedis env)
+              cacheKey
+              (cfgListCacheTtlSec (envConfig env))
               (BL.toStrict (A.encode result))
           pure (Right result)
 
@@ -1018,9 +1187,26 @@ collectKeysBoundedWith currentTime listPage maxKeys deadline =
 
 runRecovery :: Env -> IO ()
 runRecovery env = forever $ do
-  recoverOnce env
+  recovered <- tryRecoveryDependency (recoverOnce env)
+  case recovered of
+    Left _ ->
+      audit "dependency_runtime" "unavailable" Nothing
+        [ ("dependency", A.String "postgresql")
+        , ("reason", A.String "recovery_cycle_failed")
+        ]
+    Right () -> pure ()
   threadDelay (5 * 1000000)
 
+tryRecoveryDependency :: IO value -> IO (Either SomeException value)
+tryRecoveryDependency =
+  tryJust $ \exception ->
+    case ( fromException exception :: Maybe SqlError
+         , fromException exception :: Maybe IOException
+         ) of
+      (Just _, _) -> Just exception
+      (_, Just _) -> Just exception
+      _ -> Nothing
+
 recoverOnce :: Env -> IO ()
 recoverOnce env = do
   let grace = cfgRecoveryGraceSec (envConfig env)
@@ -1051,6 +1237,15 @@ finalizeRecovered env rec = do
   observed <- observeObjectWithRetry env rec
   result <- withTransaction (envDb env) $ \conn ->
     finalizeFromObservation conn rec observed
+  forM_ result $ \mutationResult ->
+    audit "recovery_mutation" (mutationAuditResult mutationResult)
+      (Just (unUserId (mrUserId rec)))
+      ([ ("root", A.toJSON (rootLabel (recordRoot rec)))
+       , ("operation_id", A.toJSON (unOperationId (mrOperationId rec)))
+       ] <> mutationReasonFields mutationResult
+         <> objectKeyAudit
+           (envConfig env)
+           (mrRelativePath rec))
   when (result == Just MutationSucceeded) $
     cacheInvalidatePrefixes
       (envRedis env)
@@ -1098,13 +1293,3 @@ lastSeg t =
 requestCookies :: Request -> [(BS.ByteString, BS.ByteString)]
 requestCookies request =
   maybe [] parseCookies (lookup hCookie (requestHeaders request))
-
-parseCookieValueText
-  :: A.ToJSON error
-  => error
-  -> BS.ByteString
-  -> Handler Text
-parseCookieValueText operationError bytes =
-  case TE.decodeUtf8' bytes of
-    Right value | not (T.null value) && T.length value <= 8192 -> pure value
-    _ -> throwOperationError err400 operationError