module Data.Validator.Reference where
import Import
import Prelude
import qualified Data.Aeson.Pointer as AP
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Network.HTTP.Types.URI (urlDecode)
import System.FilePath ((</>), dropFileName)
type URIBase = Maybe Text
type URIBaseAndFragment = (Maybe Text, Maybe Text)
updateResolutionScope :: URIBase -> Maybe Text -> URIBase
updateResolutionScope mScope idKeyword
| Just t <- idKeyword = fst . baseAndFragment $ resolveScopeAgainst mScope t
| otherwise = mScope
resolveReference :: URIBase -> Text -> URIBaseAndFragment
resolveReference mScope t = baseAndFragment $ resolveScopeAgainst mScope t
resolveFragment
:: (FromJSON schema, ToJSON schema)
=> Maybe Text
-> schema
-> Maybe schema
resolveFragment Nothing schema = Just schema
resolveFragment (Just pointer) schema = do
let urlDecoded = decodeUtf8 . urlDecode True . encodeUtf8 $ pointer
p <- either (const Nothing) Just (AP.unescape urlDecoded)
x <- either (const Nothing) Just (AP.resolve p (toJSON schema))
case fromJSON x of
Error _ -> Nothing
Success schema' -> Just schema'
isRemoteReference :: Text -> Bool
isRemoteReference = T.isInfixOf "://"
baseAndFragment :: Text -> URIBaseAndFragment
baseAndFragment = f . T.splitOn "#"
where
f :: [Text] -> URIBaseAndFragment
f [x] = (g x, Nothing)
f [x,y] = (g x, g y)
f _ = (Nothing, Nothing)
g "" = Nothing
g x = Just x
resolveScopeAgainst :: Maybe Text -> Text -> Text
resolveScopeAgainst Nothing t = t
resolveScopeAgainst (Just scope) t
| isRemoteReference t = t
| otherwise = smartAppend
where
smartAppend :: Text
smartAppend =
case baseAndFragment scope of
(Just base,_) ->
case T.unpack t of
'#':_ -> base <> t
_ -> T.pack (dropFileName (T.unpack base) </> T.unpack t)
_ -> t