Util.hs

{-# LANGUAGE NoImplicitPrelude    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UnicodeSyntax        #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |As name suggests few utilities to make life easier
module Chakra.Util
where

import           Data.Aeson
import           Data.Has
import           Network.HTTP.Types  (hContentType)
import           Network.Wai
import           RIO
import qualified RIO.ByteString.Lazy as L (ByteString)
import           Servant

-- | Construct plain ServerError Type with given status code and error text
errText :: ServerError -> L.ByteString -> ServerError
errText e t =
  e {errHeaders = [(hContentType, "text/plain; charset=utf-8")], errBody = t}

-- | Creates and throws a simple text/plain ServerError.
throwErrText :: MonadThrow u => ServerError -> L.ByteString -> u a
throwErrText e t = throwM $ errText e t

-- | Throws Unauthorized error
throwUnauthorized :: MonadThrow u => u a
throwUnauthorized = throwM $ errText err401 "Unauthorized access!"

-- | Custom JSON payload error formatter
jsonErrorFormatter :: ErrorFormatter
jsonErrorFormatter _tr _req err =
  err400 {errBody = encode err, errHeaders = [("Content-Type", "application/json; charset=utf-8")]}

-- | Custom JSON payload error formatter for 404
notFoundFormatter :: NotFoundErrorFormatter
notFoundFormatter req =
  err404
    { errBody = encode b
    , errHeaders = [("Content-Type", "application/json; charset=utf-8")]
    }
  where
    dl = decodeUtf8With lenientDecode
    b =
      object
        [ "error_code" .= dl "404"
        , "error_message" .= dl "NotFound"
        , "path" .= dl (rawPathInfo req)
        ]

-- | Gets a value of any type from the context.
askObj :: (Has β α, MonadReader α μ) => μ β
askObj = asks getter

-- | Gets a thing from a value of any type from the context. (Useful for configuration fields.)
askOpt :: (Has β α, MonadReader α μ) => (β -> ψ) -> μ ψ
askOpt f = asks $ f . getter