module Cachix.Types.NarFileName
  ( NarFileName (..),
  )
where

import Data.Swagger (ToParamSchema (..))
import qualified Data.Text as T
import Protolude
import Servant.API

-- | <hash>.nar.<extension> file
data NarFileName = NarFileName
  { NarFileName -> Text
contentHash :: Text,
    NarFileName -> Text
extension :: Text
  }
  deriving ((forall x. NarFileName -> Rep NarFileName x)
-> (forall x. Rep NarFileName x -> NarFileName)
-> Generic NarFileName
forall x. Rep NarFileName x -> NarFileName
forall x. NarFileName -> Rep NarFileName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NarFileName -> Rep NarFileName x
from :: forall x. NarFileName -> Rep NarFileName x
$cto :: forall x. Rep NarFileName x -> NarFileName
to :: forall x. Rep NarFileName x -> NarFileName
Generic)

instance FromHttpApiData NarFileName where
  parseUrlPiece :: Text -> Either Text NarFileName
parseUrlPiece Text
s =
    case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." Text
s of
      [Text
filename, Text
"nar", Text
ext] ->
        NarFileName -> Either Text NarFileName
forall a b. b -> Either a b
Right (NarFileName -> Either Text NarFileName)
-> NarFileName -> Either Text NarFileName
forall a b. (a -> b) -> a -> b
$ Text -> Text -> NarFileName
NarFileName Text
filename Text
ext
      [Text]
_ -> Text -> Either Text NarFileName
forall a b. a -> Either a b
Left (Text -> Either Text NarFileName)
-> Text -> Either Text NarFileName
forall a b. (a -> b) -> a -> b
$ Text
"Wrong nar filename: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s

instance ToHttpApiData NarFileName where
  toUrlPiece :: NarFileName -> Text
toUrlPiece NarFileName
narfilename = NarFileName -> Text
contentHash NarFileName
narfilename Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".nar." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NarFileName -> Text
extension NarFileName
narfilename

instance ToParamSchema NarFileName where
  toParamSchema :: forall (t :: SwaggerKind (*)). Proxy NarFileName -> ParamSchema t
toParamSchema Proxy NarFileName
_ = Proxy Text -> ParamSchema t
forall a (t :: SwaggerKind (*)).
ToParamSchema a =>
Proxy a -> ParamSchema t
forall (t :: SwaggerKind (*)). Proxy Text -> ParamSchema t
toParamSchema (Proxy Text
forall {k} (t :: k). Proxy t
Proxy :: Proxy Text)