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.API

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

newtype CID = CID { CID -> Text
unaddress :: Text }
  deriving          ( CID -> CID -> Bool
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. 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
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
Ord
                    , ReadPrec [CID]
ReadPrec CID
Int -> ReadS CID
ReadS [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
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 a.
(forall (t :: SwaggerKind (*)). Proxy a -> ParamSchema t)
-> ToParamSchema a
forall (t :: SwaggerKind (*)). Proxy CID -> ParamSchema t
toParamSchema :: forall (t :: SwaggerKind (*)). Proxy CID -> ParamSchema t
$ctoParamSchema :: forall (t :: SwaggerKind (*)). Proxy CID -> ParamSchema t
ToParamSchema )
  deriving newtype  ( String -> CID
forall a. (String -> a) -> IsString a
fromString :: String -> CID
$cfromString :: String -> CID
IsString
                    , CID -> Builder
CID -> ByteString
CID -> Text
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 forall a b. a -> (a -> b) -> b
|> Text -> Text
normalize forall a b. a -> (a -> b) -> b
|> 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 = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ContentAddress" (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
_ =
    forall a. Monoid a => a
mempty
      forall a b. a -> (a -> b) -> b
|> forall s a. HasType s a => Lens' s a
type_   forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall (t :: SwaggerKind (*)). SwaggerType t
SwaggerString
      forall a b. a -> (a -> b) -> b
|> forall s a. HasExample s a => Lens' s a
example forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"QmW2WQi7j6c7UgJTarActp7tDNikE4B2qXtFCfLPdsgaTQ"
      forall a b. a -> (a -> b) -> b
|> Maybe Text -> Schema -> NamedSchema
NamedSchema (forall a. a -> Maybe a
Just Text
"IPFSAddress")
      forall a b. a -> (a -> b) -> b
|> 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 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 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' forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Lazy.toStrict ByteString
bs of
      Left UnicodeException
err  -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show UnicodeException
err
      Right Text
txt -> forall a b. b -> Either a b
Right 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 = 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 = forall {k} (ctype :: k) a.
MimeUnrender ctype a =>
Proxy ctype -> ByteString -> Either String a
mimeUnrender Proxy PlainText
proxy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> ByteString -> [ByteString]
Lazy.split (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
',') ByteString
bs

instance FromHttpApiData CID where
  parseUrlPiece :: Text -> Either Text CID
parseUrlPiece = forall a b. b -> Either a b
Right 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip