Compare commits

..

6 Commits

Author SHA1 Message Date
56e1823589 Fix api 2018-09-29 22:24:21 +03:00
0cae4d898c Rename generator 2018-09-29 21:42:27 +03:00
c883efcf41 Prefix api path with api/ 2018-09-29 21:40:18 +03:00
f2665335b3 Remove preceding equals 2018-09-29 21:35:50 +03:00
e6cf2bc659 Ignore all the nix results 2018-09-29 21:30:33 +03:00
cdaf3339c8 Add cabal-install to shell dependencies 2018-09-29 21:29:44 +03:00
5 changed files with 15 additions and 16 deletions

2
.gitignore vendored
View File

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

View File

@ -52,7 +52,7 @@ executable rauhala-api
hs-source-dirs: executables
default-language: Haskell2010
executable generator
executable rauhala-api-js-gen
main-is: generator.hs
-- other-modules:
-- other-extensions:

View File

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

View File

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

View File

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