{-# 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 qualified Data.ByteString.Lazy as L (ByteString)
import           Data.Has
-- import           Data.Text.Encoding       (decodeUtf8With)
-- import           Data.Text.Encoding.Error (lenientDecode)
import           Network.HTTP.Types   (hContentType)
import           Network.Wai
import           RIO
import           Servant

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

-- | Creates and throws a simple text/plain ServerError.
throwErrText :: MonadThrow u => ServerError -> L.ByteString -> u a
throwErrText :: ServerError -> ByteString -> u a
throwErrText ServerError
e ByteString
t = ServerError -> u a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ServerError -> u a) -> ServerError -> u a
forall a b. (a -> b) -> a -> b
$ ServerError -> ByteString -> ServerError
errText ServerError
e ByteString
t

-- | Throws Unauthorized error
throwUnauthorized :: MonadThrow u => u a
throwUnauthorized :: u a
throwUnauthorized = ServerError -> u a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ServerError -> u a) -> ServerError -> u a
forall a b. (a -> b) -> a -> b
$ ServerError -> ByteString -> ServerError
errText ServerError
err401 ByteString
"Unauthorized access!"

-- | Custom JSON payload error formatter
jsonErrorFormatter :: ErrorFormatter
jsonErrorFormatter :: ErrorFormatter
jsonErrorFormatter TypeRep
_tr Request
_req String
err =
  ServerError
err400 {errBody :: ByteString
errBody = String -> ByteString
forall a. ToJSON a => a -> ByteString
encode String
err, errHeaders :: [Header]
errHeaders = [(HeaderName
"Content-Type", ByteString
"application/json; charset=utf-8")]}

-- | Custom JSON payload error formatter for 404
notFoundFormatter :: NotFoundErrorFormatter
notFoundFormatter :: NotFoundErrorFormatter
notFoundFormatter Request
req =
  ServerError
err404
    { errBody :: ByteString
errBody = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
b
    , errHeaders :: [Header]
errHeaders = [(HeaderName
"Content-Type", ByteString
"application/json; charset=utf-8")]
    }
  where
    dl :: ByteString -> Text
dl = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode
    b :: Value
b =
      [Pair] -> Value
object
        [ Text
"error_code" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
dl ByteString
"404"
        , Text
"error_message" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
dl ByteString
"NotFound"
        , Text
"path" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
dl (Request -> ByteString
rawPathInfo Request
req)
        ]

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

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