{-# LANGUAGE OverloadedStrings #-}

module Network.GRPC.Spec.Serialization.Timeout (
    buildTimeout
  , parseTimeout
  ) where

import Control.Monad.Except
import Data.ByteString qualified as BS.Strict
import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString.Char8 qualified as BS.Strict.C8
import Data.Char (isDigit)

import Network.GRPC.Spec

{-------------------------------------------------------------------------------
  Serialization

  > Timeout      → "grpc-timeout" TimeoutValue TimeoutUnit
  > TimeoutValue → {positive integer as ASCII string of at most 8 digits}
  > TimeoutUnit  → Hour / Minute / Second / Millisecond / Microsecond / Nanosecond
  > Hour         → "H"
  > Minute       → "M"
  > Second       → "S"
  > Millisecond  → "m"
  > Microsecond  → "u"
  > Nanosecond   → "n"
-------------------------------------------------------------------------------}

-- | Serialize t'Timeout'
buildTimeout :: Timeout -> Strict.ByteString
buildTimeout :: Timeout -> ByteString
buildTimeout (Timeout TimeoutUnit
unit TimeoutValue
val) = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [
      String -> ByteString
BS.Strict.C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Word -> String
forall a. Show a => a -> String
show (Word -> String) -> Word -> String
forall a b. (a -> b) -> a -> b
$ TimeoutValue -> Word
getTimeoutValue TimeoutValue
val
    , case TimeoutUnit
unit of
        TimeoutUnit
Hour        -> ByteString
"H"
        TimeoutUnit
Minute      -> ByteString
"M"
        TimeoutUnit
Second      -> ByteString
"S"
        TimeoutUnit
Millisecond -> ByteString
"m"
        TimeoutUnit
Microsecond -> ByteString
"u"
        TimeoutUnit
Nanosecond  -> ByteString
"n"
    ]

-- | Parse t'Timeout'
parseTimeout :: forall m. MonadError String m => Strict.ByteString -> m Timeout
parseTimeout :: forall (m :: * -> *).
MonadError String m =>
ByteString -> m Timeout
parseTimeout ByteString
bs = do
    let (ByteString
bsVal, ByteString
bsUnit) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.Strict.C8.span Char -> Bool
isDigit ByteString
bs

    val <-
      if ByteString -> Int
BS.Strict.length ByteString
bsVal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| ByteString -> Int
BS.Strict.length ByteString
bsVal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8
        then m TimeoutValue
forall a. m a
invalid
        else TimeoutValue -> m TimeoutValue
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeoutValue -> m TimeoutValue)
-> (Word -> TimeoutValue) -> Word -> m TimeoutValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> TimeoutValue
TimeoutValue (Word -> m TimeoutValue) -> Word -> m TimeoutValue
forall a b. (a -> b) -> a -> b
$ String -> Word
forall a. Read a => String -> a
read (ByteString -> String
BS.Strict.C8.unpack ByteString
bsVal)

    charUnit <-
      case BS.Strict.C8.uncons bsUnit of
        Maybe (Char, ByteString)
Nothing ->
          m Char
forall a. m a
invalid
        Just (Char
u, ByteString
remainder) ->
          if ByteString -> Bool
BS.Strict.null ByteString
remainder
            then Char -> m Char
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
u
            else m Char
forall a. m a
invalid

    unit <-
      case charUnit of
        Char
'H' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Hour
        Char
'M' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Minute
        Char
'S' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Second
        Char
'm' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Millisecond
        Char
'u' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Microsecond
        Char
'n' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Nanosecond
        Char
_   -> m TimeoutUnit
forall a. m a
invalid

    return $ Timeout unit val
  where
    invalid :: m a
    invalid :: forall a. m a
invalid = String -> m a
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Could not parse timeout " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs