diff --git a/src/Network/GemServ.hs b/src/Network/GemServ.hs index 26b8979..5dd2fd3 100644 --- a/src/Network/GemServ.hs +++ b/src/Network/GemServ.hs @@ -24,10 +24,11 @@ License along with this program. If not, see -} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase, OverloadedStrings, RecordWildCards #-} module Network.GemServ ( encodeGemURL, + decodeGemURL, escapeString, unescapeString ) where @@ -56,6 +57,49 @@ encodeGemURL url = Nothing -> "" Just q -> '?' : escapeString q +-- | Decodes a 'GemURL' from a 'String' (if possible) +decodeGemURL :: String -> Maybe GemURL +decodeGemURL str = do + let txt = T.pack str + + noProt <- case T.splitOn "://" txt of + [prot, rest] -> if T.toLower prot == "gemini" + then Just rest + else Nothing + _ -> Nothing + + noFrag <- case T.splitOn "#" noProt of + [x, _] -> Just x + [x] -> Just x + _ -> Nothing + + (noQuery, query) <- case T.splitOn "?" noFrag of + [nq, q] -> Just (nq, Just q) + [nq] -> Just (nq, Nothing) + _ -> Nothing + + gemQuery <- case query of + Just q -> Just <$> unescapeString (T.unpack q) + Nothing -> Just Nothing + + (auth, path) <- case T.splitOn "/" noQuery of + [a] -> Just (a, []) + [a, ""] -> Just (a, []) + a:ps -> Just (a, ps) + _ -> Nothing + + gemPath <- mapM (unescapeString . T.unpack) path + + (host, gemPort) <- case T.splitOn ":" auth of + [h, p] -> case reads $ T.unpack p of + [(n, "")] -> Just (h, Just n) + _ -> Nothing + [h] -> Just (h, Nothing) + _ -> Nothing + + let gemHost = T.unpack host + Just GemURL {..} + -- | add required escape sequences to a string escapeString :: String -> String escapeString = concatMap diff --git a/test/Network/GemServSpec.hs b/test/Network/GemServSpec.hs index 16f126f..b9c90e7 100644 --- a/test/Network/GemServSpec.hs +++ b/test/Network/GemServSpec.hs @@ -30,6 +30,7 @@ import Network.GemServ.Types spec :: Spec spec = describe "Network.GemServ" $ do encodeGemURLSpec + decodeGemURLSpec escapeStringSpec unescapeStringSpec @@ -68,6 +69,50 @@ encodeGemURLSpec = describe "encodeGemURL" $ mapM_ withEscapeExp = "gemini://example.com/foo%20bar?baz%20quux" +decodeGemURLSpec :: Spec +decodeGemURLSpec = describe "decodeGemURL" $ mapM_ + ( \(str, expected) -> context (show str) $ + it ("should be " ++ show expected) $ + decodeGemURL str `shouldBe` expected + ) + + -- URL string, expected + [ ( simpleStr, Just simpleURL ) + , ( withSlashStr, Just simpleURL ) + , ( withPathStr, Just withPathURL ) + , ( withQueryStr, Just withQueryURL ) + , ( pathQueryStr, Just pathQueryURL ) + , ( blankQueryStr, Just blankQueryURL ) + , ( withFragmentStr, Just simpleURL ) + , ( escapedStr, Just escapedURL ) + , ( httpStr, Nothing ) + , ( malformed, Nothing ) + , ( "", Nothing ) + ] + + where + simpleStr = "gemini://example.com" + simpleURL = newGemURL "example.com" + withSlashStr = simpleStr ++ "/" + withPathStr = simpleStr ++ "/foo/bar" + withPathURL = simpleURL { gemPath = ["foo", "bar"] } + withQueryStr = simpleStr ++ "?foo" + withQueryURL = simpleURL { gemQuery = Just "foo" } + pathQueryStr = withPathStr ++ "?baz" + pathQueryURL = withPathURL { gemQuery = Just "baz" } + blankQueryStr = simpleStr ++"?" + blankQueryURL = simpleURL { gemQuery = Just "" } + withFragmentStr = simpleStr ++ "#foo" + escapedStr = simpleStr ++ "/foo%20bar/baz?quux%20stuff" + + escapedURL = simpleURL + { gemPath = ["foo bar", "baz"] + , gemQuery = Just "quux stuff" + } + + httpStr = "http://example.com" + malformed = "foo" + escapeStringSpec :: Spec escapeStringSpec = describe "escapeString" $ mapM_ ( \(input, expected) -> context (show input) $