Compare commits

...

4 Commits

4 changed files with 14 additions and 15 deletions

2
.gitignore vendored
View File

@ -1,2 +1,2 @@
result result*
dist/ dist/

View File

@ -16,6 +16,7 @@ let
_pkgs.binutils-unwrapped _pkgs.binutils-unwrapped
haskellPackages.ghcid haskellPackages.ghcid
haskellPackages.hasktags haskellPackages.hasktags
haskellPackages.cabal-install
(haskellPackages.ghcWithHoogle (_: pkg.buildInputs ++ pkg.propagatedBuildInputs)) (haskellPackages.ghcWithHoogle (_: pkg.buildInputs ++ pkg.propagatedBuildInputs))
]; ];
}; };

View File

@ -5,16 +5,16 @@
{-# Language OverloadedStrings #-} {-# Language OverloadedStrings #-}
module API where module API where
import Servant.API import Servant.API
import ClassyPrelude import ClassyPrelude
import qualified API.IPFS as IPFS import qualified API.IPFS as IPFS
import Text.Pandoc.Readers.Markdown (readMarkdown) import Network.HTTP.Media ((//), (/:))
import Text.Pandoc.Writers.HTML (writeHtml5String) import Text.Pandoc.Class (runPure)
import Text.Pandoc.Class (runPure, PandocMonad) import Text.Pandoc.Options (def)
import Text.Pandoc.Options (def) import Text.Pandoc.Readers.Markdown (readMarkdown)
import Network.HTTP.Media ((//), (/:)) import Text.Pandoc.Writers.HTML (writeHtml5String)
data HTML data HTML
@ -31,5 +31,5 @@ instance Accept HTML where
type API = "ipfs" :> IPFS.API type API = "ipfs" :> IPFS.API
type DocumentedAPI = API type DocumentedAPI = "api" :> API
:<|> "help" :> Get '[PlainText, HTML] Docs :<|> "help" :> Get '[PlainText, HTML] Docs

View File

@ -5,12 +5,10 @@
module Server.IPFS where module Server.IPFS where
import API.IPFS import API.IPFS
import Servant import ClassyPrelude hiding (hash)
import ClassyPrelude
import Network.DNS
import Control.Lens (over, _Left) import Control.Lens (over, _Left)
import Network.DNS
import Servant
handler :: Server API handler :: Server API
handler = liftIO getHash >>= either (const (throwError err500)) return handler = liftIO getHash >>= either (const (throwError err500)) return
@ -23,6 +21,6 @@ handler = liftIO getHash >>= either (const (throwError err500)) return
-- This is terrible -- This is terrible
return (eTxt >>= maybe (Left "Could not find dnslink") Right . hash) return (eTxt >>= maybe (Left "Could not find dnslink") Right . hash)
hash [x] = case x of hash [x] = case x of
(stripPrefix "dnslink" -> Just h) -> Just . VersionHash . decodeUtf8 $ h (stripPrefix "dnslink=" -> Just h) -> Just . VersionHash . decodeUtf8 $ h
_ -> Nothing _ -> Nothing
hash _ = Nothing hash _ = Nothing