{-# LANGUAGE GeneralizedNewtypeDeriving, LambdaCase, OverloadedStrings, ViewPatterns #-}

module BattlePlace.WebApi.Types.Util
  ( Base64ByteString(..)
  , Base64Word64(..)
  , StrWord64(..)
  ) where

import Control.Monad
import qualified Data.Aeson as J
import qualified Data.Aeson.Types as J
import qualified Data.ByteArray as BA
import qualified Data.ByteArray.Encoding as BA
import qualified Data.ByteString as B
import Data.Either
import Data.Hashable
import qualified Data.Serialize as S
import Data.String
import qualified Data.Swagger as SW
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Word
import Foreign.Storable
import Servant.API

-- | Implementation for parseJson using base64-serialized string.
base64ParseJsonStr :: S.Serialize a => T.Text -> J.Parser a
base64ParseJsonStr = \case
  (BA.convertFromBase BA.Base64URLUnpadded . T.encodeUtf8 -> Right (S.decode -> Right object)) -> return object
  _ -> fail "wrong base64 object"

-- | Implementation for toJson using base64-serialized string.
base64ToJsonStr :: S.Serialize a => a -> T.Text
base64ToJsonStr = T.decodeUtf8 . BA.convertToBase BA.Base64URLUnpadded . S.encode

-- | Implementation for parseUrlPiece using base64-serialized string.
base64ParseUrlPiece :: S.Serialize a => T.Text -> Either T.Text a
base64ParseUrlPiece = either (Left . T.pack) (either (Left . T.pack) Right . S.decode) . BA.convertFromBase BA.Base64URLUnpadded . T.encodeUtf8

-- | ByteString which serializes to JSON as base64 string.
newtype Base64ByteString = Base64ByteString B.ByteString deriving (Eq, Ord, Semigroup, Monoid, Hashable, BA.ByteArray, BA.ByteArrayAccess)
instance J.FromJSON Base64ByteString where
  parseJSON = either fail return . BA.convertFromBase BA.Base64URLUnpadded . T.encodeUtf8 <=< J.parseJSON
instance J.ToJSON Base64ByteString where
  toJSON = J.toJSON . T.decodeUtf8 . BA.convertToBase BA.Base64URLUnpadded
  toEncoding = J.toEncoding . T.decodeUtf8 . BA.convertToBase BA.Base64URLUnpadded
instance SW.ToSchema Base64ByteString where
  declareNamedSchema _ = return $ SW.NamedSchema (Just "Base64ByteString") SW.byteSchema

-- | Word64 which serializes to JSON as base64 string.
-- Useful because 64-bit integer is not representable in javascript.
newtype Base64Word64 = Base64Word64 Word64 deriving (Eq, Ord, Num, Storable, Hashable, S.Serialize, Read, Show)
instance J.FromJSON Base64Word64 where
  parseJSON = base64ParseJsonStr <=< J.parseJSON
instance J.FromJSONKey Base64Word64 where
  fromJSONKey = J.FromJSONKeyTextParser base64ParseJsonStr
instance J.ToJSON Base64Word64 where
  toJSON = J.toJSON . base64ToJsonStr
  toEncoding = J.toEncoding . base64ToJsonStr
instance J.ToJSONKey Base64Word64 where
  toJSONKey = J.toJSONKeyText base64ToJsonStr
instance FromHttpApiData Base64Word64 where
  parseUrlPiece = base64ParseUrlPiece
instance IsString Base64Word64 where
  fromString = fromRight (error "wrong base64 word") . J.parseEither J.parseJSON . J.String . T.pack
instance SW.ToSchema Base64Word64 where
  declareNamedSchema _ = return $ SW.NamedSchema (Just "Base64Word64") SW.byteSchema

-- | Word64 which serializes to JSON as decimal string.
-- Useful because 64-bit integer is not representable in javascript.
newtype StrWord64 = StrWord64 Word64 deriving (Eq, Ord, Num, Storable, Hashable, S.Serialize, Read, Show)
instance J.FromJSON StrWord64 where
  parseJSON = f . reads <=< J.parseJSON where
    f = \case
      [(n, "")] -> return $ StrWord64 n
      _ -> fail "wrong number"
instance J.ToJSON StrWord64 where
  toJSON (StrWord64 n) = J.toJSON $ show n
instance FromHttpApiData StrWord64 where
  parseUrlPiece = f . reads <=< parseUrlPiece where
    f = \case
      [(n, "")] -> Right $ StrWord64 n
      _ -> Left "wrong number"
instance SW.ToSchema StrWord64 where
  declareNamedSchema _ = return $ SW.NamedSchema (Just "StrWord64") SW.byteSchema