{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE RecordWildCards #-}

-- | Types related to Share and Codeservers.
module Unison.Share.Types
  ( CodeserverURI (..),
    CodeserverId (..),
    Scheme (..),
    codeserverFromURI,
    codeserverIdFromURI,
    codeserverToURI,
    codeserverIdFromCodeserverURI,
    codeserverBaseURL,
  )
where

import Data.Aeson
import Data.List qualified as List
import Data.List.Extra qualified as List
import Data.Text
import Data.Text qualified as Text
import Network.URI
import Servant.Client qualified as Servant
import Unison.Prelude

data Scheme = Http | Https
  deriving (Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
/= :: Scheme -> Scheme -> Bool
Eq, Eq Scheme
Eq Scheme =>
(Scheme -> Scheme -> Ordering)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Scheme)
-> (Scheme -> Scheme -> Scheme)
-> Ord Scheme
Scheme -> Scheme -> Bool
Scheme -> Scheme -> Ordering
Scheme -> Scheme -> Scheme
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
$ccompare :: Scheme -> Scheme -> Ordering
compare :: Scheme -> Scheme -> Ordering
$c< :: Scheme -> Scheme -> Bool
< :: Scheme -> Scheme -> Bool
$c<= :: Scheme -> Scheme -> Bool
<= :: Scheme -> Scheme -> Bool
$c> :: Scheme -> Scheme -> Bool
> :: Scheme -> Scheme -> Bool
$c>= :: Scheme -> Scheme -> Bool
>= :: Scheme -> Scheme -> Bool
$cmax :: Scheme -> Scheme -> Scheme
max :: Scheme -> Scheme -> Scheme
$cmin :: Scheme -> Scheme -> Scheme
min :: Scheme -> Scheme -> Scheme
Ord, Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
(Int -> Scheme -> ShowS)
-> (Scheme -> String) -> ([Scheme] -> ShowS) -> Show Scheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scheme -> ShowS
showsPrec :: Int -> Scheme -> ShowS
$cshow :: Scheme -> String
show :: Scheme -> String
$cshowList :: [Scheme] -> ShowS
showList :: [Scheme] -> ShowS
Show)

-- | This type is expanded out into all of its fields because we require certain pieces
-- which are optional in a URI, and also to make it more typesafe to eventually convert into a
-- BaseURL for servant clients.
data CodeserverURI = CodeserverURI
  { CodeserverURI -> Scheme
codeserverScheme :: Scheme,
    CodeserverURI -> String
codeserverUserInfo :: String,
    CodeserverURI -> String
codeserverRegName :: String,
    -- A custom port, if one was specified.
    CodeserverURI -> Maybe Int
codeserverPort :: Maybe Int,
    CodeserverURI -> [String]
codeserverPath :: [String]
  }
  deriving stock (CodeserverURI -> CodeserverURI -> Bool
(CodeserverURI -> CodeserverURI -> Bool)
-> (CodeserverURI -> CodeserverURI -> Bool) -> Eq CodeserverURI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeserverURI -> CodeserverURI -> Bool
== :: CodeserverURI -> CodeserverURI -> Bool
$c/= :: CodeserverURI -> CodeserverURI -> Bool
/= :: CodeserverURI -> CodeserverURI -> Bool
Eq, Eq CodeserverURI
Eq CodeserverURI =>
(CodeserverURI -> CodeserverURI -> Ordering)
-> (CodeserverURI -> CodeserverURI -> Bool)
-> (CodeserverURI -> CodeserverURI -> Bool)
-> (CodeserverURI -> CodeserverURI -> Bool)
-> (CodeserverURI -> CodeserverURI -> Bool)
-> (CodeserverURI -> CodeserverURI -> CodeserverURI)
-> (CodeserverURI -> CodeserverURI -> CodeserverURI)
-> Ord CodeserverURI
CodeserverURI -> CodeserverURI -> Bool
CodeserverURI -> CodeserverURI -> Ordering
CodeserverURI -> CodeserverURI -> CodeserverURI
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
$ccompare :: CodeserverURI -> CodeserverURI -> Ordering
compare :: CodeserverURI -> CodeserverURI -> Ordering
$c< :: CodeserverURI -> CodeserverURI -> Bool
< :: CodeserverURI -> CodeserverURI -> Bool
$c<= :: CodeserverURI -> CodeserverURI -> Bool
<= :: CodeserverURI -> CodeserverURI -> Bool
$c> :: CodeserverURI -> CodeserverURI -> Bool
> :: CodeserverURI -> CodeserverURI -> Bool
$c>= :: CodeserverURI -> CodeserverURI -> Bool
>= :: CodeserverURI -> CodeserverURI -> Bool
$cmax :: CodeserverURI -> CodeserverURI -> CodeserverURI
max :: CodeserverURI -> CodeserverURI -> CodeserverURI
$cmin :: CodeserverURI -> CodeserverURI -> CodeserverURI
min :: CodeserverURI -> CodeserverURI -> CodeserverURI
Ord)

instance Show CodeserverURI where
  show :: CodeserverURI -> String
show = URI -> String
forall a. Show a => a -> String
show (URI -> String)
-> (CodeserverURI -> URI) -> CodeserverURI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeserverURI -> URI
codeserverToURI

codeserverToURI :: CodeserverURI -> URI
codeserverToURI :: CodeserverURI -> URI
codeserverToURI cs :: CodeserverURI
cs@(CodeserverURI {String
[String]
Maybe Int
Scheme
$sel:codeserverScheme:CodeserverURI :: CodeserverURI -> Scheme
$sel:codeserverUserInfo:CodeserverURI :: CodeserverURI -> String
$sel:codeserverRegName:CodeserverURI :: CodeserverURI -> String
$sel:codeserverPort:CodeserverURI :: CodeserverURI -> Maybe Int
$sel:codeserverPath:CodeserverURI :: CodeserverURI -> [String]
codeserverScheme :: Scheme
codeserverUserInfo :: String
codeserverRegName :: String
codeserverPort :: Maybe Int
codeserverPath :: [String]
..}) =
  let scheme :: String
scheme = case Scheme
codeserverScheme of
        Scheme
Http -> String
"http:"
        Scheme
Https -> String
"https:"
      authority :: URIAuth
authority = CodeserverURI -> URIAuth
codeserverAuthority CodeserverURI
cs
   in URI
        { uriScheme :: String
uriScheme = String
scheme,
          uriAuthority :: Maybe URIAuth
uriAuthority = URIAuth -> Maybe URIAuth
forall a. a -> Maybe a
Just URIAuth
authority,
          uriPath :: String
uriPath = case [String]
codeserverPath of
            [] -> String
""
            [String]
segs -> String
"/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"/" [String]
segs,
          uriQuery :: String
uriQuery = String
"",
          uriFragment :: String
uriFragment = String
""
        }

codeserverAuthority :: CodeserverURI -> URIAuth
codeserverAuthority :: CodeserverURI -> URIAuth
codeserverAuthority (CodeserverURI {String
[String]
Maybe Int
Scheme
$sel:codeserverScheme:CodeserverURI :: CodeserverURI -> Scheme
$sel:codeserverUserInfo:CodeserverURI :: CodeserverURI -> String
$sel:codeserverRegName:CodeserverURI :: CodeserverURI -> String
$sel:codeserverPort:CodeserverURI :: CodeserverURI -> Maybe Int
$sel:codeserverPath:CodeserverURI :: CodeserverURI -> [String]
codeserverScheme :: Scheme
codeserverUserInfo :: String
codeserverRegName :: String
codeserverPort :: Maybe Int
codeserverPath :: [String]
..}) =
  URIAuth
    { uriUserInfo :: String
uriUserInfo = String
codeserverUserInfo,
      uriPort :: String
uriPort = case Maybe Int
codeserverPort of
        Maybe Int
Nothing -> String
""
        Just Int
p -> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
p,
      uriRegName :: String
uriRegName = String
codeserverRegName
    }

-- |
-- >>> import Data.Maybe (fromJust)
-- >>> codeserverFromURI . fromJust $ parseURI "http://localhost:8080"
-- Just http://localhost:8080
-- >>> codeserverFromURI . fromJust $ parseURI "http://localhost:80"
-- Just http://localhost:80
-- >>> codeserverFromURI . fromJust $ parseURI "https://share.unison-lang.org/api"
-- Just https://share.unison-lang.org/api
-- >>> codeserverFromURI . fromJust $ parseURI "http://share.unison-lang.org/api"
-- Just http://share.unison-lang.org/api
codeserverFromURI :: URI -> Maybe CodeserverURI
codeserverFromURI :: URI -> Maybe CodeserverURI
codeserverFromURI URI {String
Maybe URIAuth
uriScheme :: URI -> String
uriAuthority :: URI -> Maybe URIAuth
uriPath :: URI -> String
uriQuery :: URI -> String
uriFragment :: URI -> String
uriScheme :: String
uriAuthority :: Maybe URIAuth
uriPath :: String
uriQuery :: String
uriFragment :: String
..} = do
  URIAuth {String
uriUserInfo :: URIAuth -> String
uriUserInfo :: String
uriUserInfo, String
uriRegName :: URIAuth -> String
uriRegName :: String
uriRegName, String
uriPort :: URIAuth -> String
uriPort :: String
uriPort} <- Maybe URIAuth
uriAuthority
  Scheme
scheme <- case String
uriScheme of
    String
"http:" -> Scheme -> Maybe Scheme
forall a. a -> Maybe a
Just Scheme
Http
    String
"https:" -> Scheme -> Maybe Scheme
forall a. a -> Maybe a
Just Scheme
Https
    String
_ -> Maybe Scheme
forall a. Maybe a
Nothing
  let port :: Maybe Int
port = case String
uriPort of
        (Char
':' : String
p) -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
p
        String
_ -> Maybe Int
forall a. Maybe a
Nothing
  pure $
    CodeserverURI
      { $sel:codeserverScheme:CodeserverURI :: Scheme
codeserverScheme = Scheme
scheme,
        $sel:codeserverUserInfo:CodeserverURI :: String
codeserverUserInfo = String
uriUserInfo,
        $sel:codeserverRegName:CodeserverURI :: String
codeserverRegName = String
uriRegName,
        $sel:codeserverPort:CodeserverURI :: Maybe Int
codeserverPort = Maybe Int
port,
        $sel:codeserverPath:CodeserverURI :: [String]
codeserverPath =
          let unprefixed :: String
unprefixed =
                case String
uriPath of
                  (Char
'/' : String
path) -> String
path
                  String
path -> String
path
           in case String -> String -> [String]
forall a. (Partial, Eq a) => [a] -> [a] -> [[a]]
List.splitOn String
"/" String
unprefixed of
                [String
""] -> []
                [String]
p -> [String]
p
      }

-- | This is distinct from the codeserver URI in that we store credentials by a normalized ID, since it's
-- much easier to look up that way than from an arbitrary path.
-- We may wish to use explicitly named configurations in the future.
-- This currently uses a stringified uriAuthority.
newtype CodeserverId = CodeserverId {CodeserverId -> Text
codeserverId :: Text}
  deriving newtype (Int -> CodeserverId -> ShowS
[CodeserverId] -> ShowS
CodeserverId -> String
(Int -> CodeserverId -> ShowS)
-> (CodeserverId -> String)
-> ([CodeserverId] -> ShowS)
-> Show CodeserverId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodeserverId -> ShowS
showsPrec :: Int -> CodeserverId -> ShowS
$cshow :: CodeserverId -> String
show :: CodeserverId -> String
$cshowList :: [CodeserverId] -> ShowS
showList :: [CodeserverId] -> ShowS
Show, CodeserverId -> CodeserverId -> Bool
(CodeserverId -> CodeserverId -> Bool)
-> (CodeserverId -> CodeserverId -> Bool) -> Eq CodeserverId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeserverId -> CodeserverId -> Bool
== :: CodeserverId -> CodeserverId -> Bool
$c/= :: CodeserverId -> CodeserverId -> Bool
/= :: CodeserverId -> CodeserverId -> Bool
Eq, Eq CodeserverId
Eq CodeserverId =>
(CodeserverId -> CodeserverId -> Ordering)
-> (CodeserverId -> CodeserverId -> Bool)
-> (CodeserverId -> CodeserverId -> Bool)
-> (CodeserverId -> CodeserverId -> Bool)
-> (CodeserverId -> CodeserverId -> Bool)
-> (CodeserverId -> CodeserverId -> CodeserverId)
-> (CodeserverId -> CodeserverId -> CodeserverId)
-> Ord CodeserverId
CodeserverId -> CodeserverId -> Bool
CodeserverId -> CodeserverId -> Ordering
CodeserverId -> CodeserverId -> CodeserverId
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
$ccompare :: CodeserverId -> CodeserverId -> Ordering
compare :: CodeserverId -> CodeserverId -> Ordering
$c< :: CodeserverId -> CodeserverId -> Bool
< :: CodeserverId -> CodeserverId -> Bool
$c<= :: CodeserverId -> CodeserverId -> Bool
<= :: CodeserverId -> CodeserverId -> Bool
$c> :: CodeserverId -> CodeserverId -> Bool
> :: CodeserverId -> CodeserverId -> Bool
$c>= :: CodeserverId -> CodeserverId -> Bool
>= :: CodeserverId -> CodeserverId -> Bool
$cmax :: CodeserverId -> CodeserverId -> CodeserverId
max :: CodeserverId -> CodeserverId -> CodeserverId
$cmin :: CodeserverId -> CodeserverId -> CodeserverId
min :: CodeserverId -> CodeserverId -> CodeserverId
Ord, [CodeserverId] -> Value
[CodeserverId] -> Encoding
CodeserverId -> Value
CodeserverId -> Encoding
(CodeserverId -> Value)
-> (CodeserverId -> Encoding)
-> ([CodeserverId] -> Value)
-> ([CodeserverId] -> Encoding)
-> ToJSON CodeserverId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CodeserverId -> Value
toJSON :: CodeserverId -> Value
$ctoEncoding :: CodeserverId -> Encoding
toEncoding :: CodeserverId -> Encoding
$ctoJSONList :: [CodeserverId] -> Value
toJSONList :: [CodeserverId] -> Value
$ctoEncodingList :: [CodeserverId] -> Encoding
toEncodingList :: [CodeserverId] -> Encoding
ToJSON, Value -> Parser [CodeserverId]
Value -> Parser CodeserverId
(Value -> Parser CodeserverId)
-> (Value -> Parser [CodeserverId]) -> FromJSON CodeserverId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CodeserverId
parseJSON :: Value -> Parser CodeserverId
$cparseJSONList :: Value -> Parser [CodeserverId]
parseJSONList :: Value -> Parser [CodeserverId]
FromJSON, ToJSONKeyFunction [CodeserverId]
ToJSONKeyFunction CodeserverId
ToJSONKeyFunction CodeserverId
-> ToJSONKeyFunction [CodeserverId] -> ToJSONKey CodeserverId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction CodeserverId
toJSONKey :: ToJSONKeyFunction CodeserverId
$ctoJSONKeyList :: ToJSONKeyFunction [CodeserverId]
toJSONKeyList :: ToJSONKeyFunction [CodeserverId]
ToJSONKey, FromJSONKeyFunction [CodeserverId]
FromJSONKeyFunction CodeserverId
FromJSONKeyFunction CodeserverId
-> FromJSONKeyFunction [CodeserverId] -> FromJSONKey CodeserverId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction CodeserverId
fromJSONKey :: FromJSONKeyFunction CodeserverId
$cfromJSONKeyList :: FromJSONKeyFunction [CodeserverId]
fromJSONKeyList :: FromJSONKeyFunction [CodeserverId]
FromJSONKey)

-- | Gets the part of the CodeserverURI that we use for identifying that codeserver in
-- credentials files.
--
-- >>> import Data.Maybe (fromJust)
-- >>> import Network.URI (parseURI)
-- >>> codeserverIdFromURI (fromJust $ parseURI "http://localhost:5424/api")
-- >>> codeserverIdFromURI (fromJust $ parseURI "https://share.unison-lang.org/api")
-- Right "localhost:5424"
-- Right "share.unison-lang.org"
codeserverIdFromURI :: URI -> Either Text CodeserverId
codeserverIdFromURI :: URI -> Either Text CodeserverId
codeserverIdFromURI URI
uri =
  case URI -> Maybe URIAuth
uriAuthority URI
uri of
    Maybe URIAuth
Nothing -> Text -> Either Text CodeserverId
forall a b. a -> Either a b
Left (Text -> Either Text CodeserverId)
-> Text -> Either Text CodeserverId
forall a b. (a -> b) -> a -> b
$ Text
"No URI Authority for URI " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> URI -> Text
forall a. Show a => a -> Text
tShow URI
uri
    Just URIAuth
ua -> CodeserverId -> Either Text CodeserverId
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodeserverId -> Either Text CodeserverId)
-> CodeserverId -> Either Text CodeserverId
forall a b. (a -> b) -> a -> b
$ URIAuth -> CodeserverId
codeserverIdFromURIAuth URIAuth
ua

-- | Builds a CodeserverId from a URIAuth
codeserverIdFromURIAuth :: URIAuth -> CodeserverId
codeserverIdFromURIAuth :: URIAuth -> CodeserverId
codeserverIdFromURIAuth URIAuth
ua =
  (Text -> CodeserverId
CodeserverId (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ URIAuth -> String
uriRegName URIAuth
ua String -> ShowS
forall a. Semigroup a => a -> a -> a
<> URIAuth -> String
uriPort URIAuth
ua))

-- | Gets the CodeserverId for a given CodeserverURI
codeserverIdFromCodeserverURI :: CodeserverURI -> CodeserverId
codeserverIdFromCodeserverURI :: CodeserverURI -> CodeserverId
codeserverIdFromCodeserverURI =
  URIAuth -> CodeserverId
codeserverIdFromURIAuth (URIAuth -> CodeserverId)
-> (CodeserverURI -> URIAuth) -> CodeserverURI -> CodeserverId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeserverURI -> URIAuth
codeserverAuthority

-- | Builds a servant-compatible BaseUrl for a given CodeserverURI.
codeserverBaseURL :: CodeserverURI -> Servant.BaseUrl
codeserverBaseURL :: CodeserverURI -> BaseUrl
codeserverBaseURL (CodeserverURI {String
[String]
Maybe Int
Scheme
$sel:codeserverScheme:CodeserverURI :: CodeserverURI -> Scheme
$sel:codeserverUserInfo:CodeserverURI :: CodeserverURI -> String
$sel:codeserverRegName:CodeserverURI :: CodeserverURI -> String
$sel:codeserverPort:CodeserverURI :: CodeserverURI -> Maybe Int
$sel:codeserverPath:CodeserverURI :: CodeserverURI -> [String]
codeserverScheme :: Scheme
codeserverUserInfo :: String
codeserverRegName :: String
codeserverPort :: Maybe Int
codeserverPath :: [String]
..}) =
  let (Scheme
scheme, Int
defaultPort) = case Scheme
codeserverScheme of
        Scheme
Https -> (Scheme
Servant.Https, Int
443)
        Scheme
Http -> (Scheme
Servant.Http, Int
80)
      host :: String
host = String
codeserverUserInfo String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
codeserverRegName
   in Scheme -> String -> Int -> String -> BaseUrl
Servant.BaseUrl Scheme
scheme String
host (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defaultPort Maybe Int
codeserverPort) (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"/" [String]
codeserverPath)