{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuasiQuotes #-}

module Cachix.Client.URI
  ( getBaseUrl,
    defaultCachixURI,
    defaultCachixBaseUrl,
  )
where

import Protolude
import Servant.Client
import qualified URI.ByteString as UBS
import URI.ByteString hiding (Scheme)
import URI.ByteString.QQ

-- TODO: make getBaseUrl internal

-- | Partial function from URI to BaseUrl
getBaseUrl :: URIRef Absolute -> BaseUrl
getBaseUrl :: URIRef Absolute -> BaseUrl
getBaseUrl uriref :: URIRef Absolute
uriref =
  case URIRef Absolute -> Maybe Authority
uriAuthority URIRef Absolute
uriref of
    Nothing -> Text -> BaseUrl
forall a. HasCallStack => Text -> a
panic "missing host in url"
    Just authority :: Authority
authority ->
      Scheme -> String -> Int -> String -> BaseUrl
BaseUrl
        Scheme
getScheme
        (ByteString -> String
forall a b. StringConv a b => a -> b
toS (Host -> ByteString
hostBS (Authority -> Host
authorityHost Authority
authority)))
        Int
getPort
        (ByteString -> String
forall a b. StringConv a b => a -> b
toS (URIRef Absolute -> ByteString
uriPath URIRef Absolute
uriref))
      where
        getScheme :: Scheme
        getScheme :: Scheme
getScheme = case URIRef Absolute -> Scheme
uriScheme URIRef Absolute
uriref of
          UBS.Scheme "http" -> Scheme
Http
          UBS.Scheme "https" -> Scheme
Https
          _ -> Text -> Scheme
forall a. HasCallStack => Text -> a
panic "uri can only be http/https"
        getPort :: Int
        getPort :: Int
getPort = Int -> (Port -> Int) -> Maybe Port -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
defaultPort Port -> Int
portNumber (Maybe Port -> Int) -> Maybe Port -> Int
forall a b. (a -> b) -> a -> b
$ Authority -> Maybe Port
authorityPort Authority
authority
        defaultPort :: Int
        defaultPort :: Int
defaultPort = case Scheme
getScheme of
          Http -> 80
          Https -> 443

defaultCachixURI :: URIRef Absolute
defaultCachixURI :: URIRef Absolute
defaultCachixURI = [uri|https://cachix.org|]

defaultCachixBaseUrl :: BaseUrl
defaultCachixBaseUrl :: BaseUrl
defaultCachixBaseUrl = URIRef Absolute -> BaseUrl
getBaseUrl URIRef Absolute
defaultCachixURI