module Network.IPFS.CID.Types
  ( CID (..)
  , mkCID
  ) where

import qualified RIO.ByteString.Lazy as Lazy
import           RIO.Char
import qualified RIO.Text            as Text

import Data.Swagger
import Servant

import qualified Network.IPFS.Internal.UTF8 as UTF8
import           Network.IPFS.Prelude

newtype CID = CID { CID -> Text
unaddress :: Text }
  deriving          ( CID -> CID -> Bool
(CID -> CID -> Bool) -> (CID -> CID -> Bool) -> Eq CID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CID -> CID -> Bool
$c/= :: CID -> CID -> Bool
== :: CID -> CID -> Bool
$c== :: CID -> CID -> Bool
Eq
                    , (forall x. CID -> Rep CID x)
-> (forall x. Rep CID x -> CID) -> Generic CID
forall x. Rep CID x -> CID
forall x. CID -> Rep CID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CID x -> CID
$cfrom :: forall x. CID -> Rep CID x
Generic
                    , Eq CID
Eq CID
-> (CID -> CID -> Ordering)
-> (CID -> CID -> Bool)
-> (CID -> CID -> Bool)
-> (CID -> CID -> Bool)
-> (CID -> CID -> Bool)
-> (CID -> CID -> CID)
-> (CID -> CID -> CID)
-> Ord CID
CID -> CID -> Bool
CID -> CID -> Ordering
CID -> CID -> CID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CID -> CID -> CID
$cmin :: CID -> CID -> CID
max :: CID -> CID -> CID
$cmax :: CID -> CID -> CID
>= :: CID -> CID -> Bool
$c>= :: CID -> CID -> Bool
> :: CID -> CID -> Bool
$c> :: CID -> CID -> Bool
<= :: CID -> CID -> Bool
$c<= :: CID -> CID -> Bool
< :: CID -> CID -> Bool
$c< :: CID -> CID -> Bool
compare :: CID -> CID -> Ordering
$ccompare :: CID -> CID -> Ordering
$cp1Ord :: Eq CID
Ord
                    , ReadPrec [CID]
ReadPrec CID
Int -> ReadS CID
ReadS [CID]
(Int -> ReadS CID)
-> ReadS [CID] -> ReadPrec CID -> ReadPrec [CID] -> Read CID
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CID]
$creadListPrec :: ReadPrec [CID]
readPrec :: ReadPrec CID
$creadPrec :: ReadPrec CID
readList :: ReadS [CID]
$creadList :: ReadS [CID]
readsPrec :: Int -> ReadS CID
$creadsPrec :: Int -> ReadS CID
Read
                    , Int -> CID -> ShowS
[CID] -> ShowS
CID -> String
(Int -> CID -> ShowS)
-> (CID -> String) -> ([CID] -> ShowS) -> Show CID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CID] -> ShowS
$cshowList :: [CID] -> ShowS
show :: CID -> String
$cshow :: CID -> String
showsPrec :: Int -> CID -> ShowS
$cshowsPrec :: Int -> CID -> ShowS
Show
                    )
  deriving anyclass ( (forall (t :: SwaggerKind *). Proxy CID -> ParamSchema t)
-> ToParamSchema CID
forall a.
(forall (t :: SwaggerKind *). Proxy a -> ParamSchema t)
-> ToParamSchema a
forall (t :: SwaggerKind *). Proxy CID -> ParamSchema t
toParamSchema :: Proxy CID -> ParamSchema t
$ctoParamSchema :: forall (t :: SwaggerKind *). Proxy CID -> ParamSchema t
ToParamSchema )
  deriving newtype  ( String -> CID
(String -> CID) -> IsString CID
forall a. (String -> a) -> IsString a
fromString :: String -> CID
$cfromString :: String -> CID
IsString
                    , CID -> ByteString
CID -> Builder
CID -> Text
(CID -> Text)
-> (CID -> Builder)
-> (CID -> ByteString)
-> (CID -> Text)
-> ToHttpApiData CID
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: CID -> Text
$ctoQueryParam :: CID -> Text
toHeader :: CID -> ByteString
$ctoHeader :: CID -> ByteString
toEncodedUrlPiece :: CID -> Builder
$ctoEncodedUrlPiece :: CID -> Builder
toUrlPiece :: CID -> Text
$ctoUrlPiece :: CID -> Text
ToHttpApiData
                    )

instance ToJSON CID where
  toJSON :: CID -> Value
toJSON (CID Text
cid) = Text
cid Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> Text
normalize Text -> (Text -> Value) -> Value
forall a b. a -> (a -> b) -> b
|> Text -> Value
forall a. ToJSON a => a -> Value
toJSON
    where
      normalize :: Text -> Text
normalize (Int -> Text -> Text
Text.take Int
1 -> Text
"\"") = Natural -> Text -> Text
UTF8.stripN Natural
1 Text
cid
      normalize Text
cid'                  = Text
cid'

instance FromJSON CID where
  parseJSON :: Value -> Parser CID
parseJSON = String -> (Text -> Parser CID) -> Value -> Parser CID
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ContentAddress" (CID -> Parser CID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CID -> Parser CID) -> (Text -> CID) -> Text -> Parser CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CID
CID)

instance ToSchema CID where
  declareNamedSchema :: Proxy CID -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy CID
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
|> (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_   ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
|> (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"QmW2WQi7j6c7UgJTarActp7tDNikE4B2qXtFCfLPdsgaTQ"
      Schema -> (Schema -> NamedSchema) -> NamedSchema
forall a b. a -> (a -> b) -> b
|> Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"IPFSAddress")
      NamedSchema
-> (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
forall a b. a -> (a -> b) -> b
|> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Display CID where
  textDisplay :: CID -> Text
textDisplay = CID -> Text
unaddress

instance MimeRender PlainText CID where
  mimeRender :: Proxy PlainText -> CID -> ByteString
mimeRender Proxy PlainText
_ = Text -> ByteString
UTF8.textToLazyBS (Text -> ByteString) -> (CID -> Text) -> CID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CID -> Text
unaddress

instance MimeRender OctetStream CID where
  mimeRender :: Proxy OctetStream -> CID -> ByteString
mimeRender Proxy OctetStream
_ = Text -> ByteString
UTF8.textToLazyBS (Text -> ByteString) -> (CID -> Text) -> CID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CID -> Text
unaddress

instance MimeUnrender PlainText CID where
  mimeUnrender :: Proxy PlainText -> ByteString -> Either String CID
mimeUnrender Proxy PlainText
_proxy ByteString
bs =
    case ByteString -> Either UnicodeException Text
decodeUtf8' (ByteString -> Either UnicodeException Text)
-> ByteString -> Either UnicodeException Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Lazy.toStrict ByteString
bs of
      Left UnicodeException
err  -> String -> Either String CID
forall a b. a -> Either a b
Left (String -> Either String CID) -> String -> Either String CID
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
err
      Right Text
txt -> CID -> Either String CID
forall a b. b -> Either a b
Right (CID -> Either String CID) -> CID -> Either String CID
forall a b. (a -> b) -> a -> b
$ Text -> CID
CID Text
txt

instance MimeUnrender PlainText [CID] where
  mimeUnrender :: Proxy PlainText -> ByteString -> Either String [CID]
mimeUnrender Proxy PlainText
proxy ByteString
bs = [Either String CID] -> Either String [CID]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Either String CID]
cids
    where
      cids :: [Either String CID]
      cids :: [Either String CID]
cids = Proxy PlainText -> ByteString -> Either String CID
forall k (ctype :: k) a.
MimeUnrender ctype a =>
Proxy ctype -> ByteString -> Either String a
mimeUnrender Proxy PlainText
proxy (ByteString -> Either String CID)
-> [ByteString] -> [Either String CID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> ByteString -> [ByteString]
Lazy.split (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
',') ByteString
bs

instance FromHttpApiData CID where
  parseUrlPiece :: Text -> Either Text CID
parseUrlPiece = CID -> Either Text CID
forall a b. b -> Either a b
Right (CID -> Either Text CID)
-> (Text -> CID) -> Text -> Either Text CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CID
CID

-- | Smart constructor for @CID@
mkCID :: Text -> CID
mkCID :: Text -> CID
mkCID = Text -> CID
CID (Text -> CID) -> (Text -> Text) -> Text -> CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip